--- /dev/null
--- /dev/null
++2003-08-16 Kenichi Handa <handa@m17n.org>
++
++ * charsets: New directory for scripts to generate charset map
++ files in ../etc/charsets/.
++
++ * charsets/Makefile, charsets/mapconv, charsets/compact.awk,
++ charsets/big5.awk charsets/gb18030-2.awk, charsets/gb18030-4.awk,
++ cahrsets/kuten.awk: New files.
++
++;; Local Variables:
++;; coding: iso-2022-7bit-unix
++;; End:
++
++ Copyright (C) 2003 Free Software Foundation, Inc.
++ Copying and distribution of this file, with or without modification,
++ are permitted provided the copyright notice and this notice are preserved.
dense colormaps (PseudoColor).
build-configs build Emacs in various configurations
check-doc-strings check doc strings against documentation
+cus-test.el tests for custom types and load problems
diff-tar-files show files added/removed between two tar files
make-emacs build Emacs in various ways
+make-tarball.txt instructions to create pretest or release tarballs
quick-install-emacs install emacs quickly (`incrementally')
revdiff get CVS diffs of files
++
++Brief description of sub-directories:
++
++charsets scripts for generating charset map files
++ in ../etc/charsets
--- /dev/null
--- /dev/null
++2003-09-08 Kenichi Handa <handa@m17n.org>
++
++ * charsets: New directory for charset mapping tables.
++
++ * charsets/README: New file.
++
++ * charsets/*.map: New files.
++
++2003-04-12 Kenichi Handa <handa@m17n.org>
++
++ * HELLO: Change "Hindi" to more common characters.
++
++2003-01-10 Kenichi Handa <handa@m17n.org>
++
++ * HELLO: Fix upcase and downcase for several languages. Change
++ the two German lines into one. Change "Nederlangs" to
++ "Dutch (Nederlands)". Add original language names to several
++ entries.
++
++2003-01-06 Kenichi Handa <handa@m17n.org>
++
++ * TUTORIAL.es: Add local variable coding: latin-1.
++
++2002-10-30 Kenichi Handa <handa@m17n.org>
++
++ * HELLO: Change indian-2-column chars of Hindi line to Unicode
++ chars.
++
++2002-05-27 Dave Love <fx@gnu.org>
++
++ * HELLO: Add pseudo-maths example.
++
++;; Local Variables:
++;; coding: iso-2022-7bit
++;; End:
++
++ Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2001, 2002
++ Free Software Foundation, Inc.
++ Copying and distribution of this file, with or without modification,
++ are permitted provided the copyright notice and this notice are preserved.
Its purpose is to illustrate a number of scripts.
---------------------------------------------------------
-Amharic (\e$(3"c!<!N"^\e(B) \e$(3!A!,!>\e(B
+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
+ Arabic (\e,GIqjHQYdG\e(B) \e,GecjdY\e(B \e,GeGdqSdG\e(B
Czech (\e,Bh\e(Besky) Dobr\e,B}\e(B den
- Danish (Dansk) Hej, Goddag
+ Danish (dansk) Hej, Goddag
+ Dutch (Nederlands) Hallo, Dag
English 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 Tere, Tervist
+ Estonian (eesti keel) Tere, Tervist
FORTRAN PROGRAM
-Finnish (suomi) Hei
+Finnish (Suomi) Hei
- French (Fran\e,Ag\e(Bais) Bonjour, Salut
- German (Deutsch Nord) Guten Tag
- German (Deutsch S\e,A|\e(Bd) Gr\e,A|_\e(B Gott
- Greek (\e,FEkkgmij\\e(B) \e,FCei\\e(B \e,Fsar\e(B
- Hebrew \e,Hylem\e(B
- 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
- Italian (Italiano) Ciao, Buon giorno
- 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
- Maltese (Malti) Bon\e,Cu\e(Bu, Sa\e,C11\e(Ba
- Nederlands, Vlaams Hallo, Dag
- Norwegian (Norsk) Hei, God dag
- Polish Dzie\e,Bq\e(B dobry! Cze\e,B6f\e(B!
- Russian (\e,L@caaZXY\e(B) \e,L7T`PRabRcYbU\e(B!
+ French (fran\e,Ag\e(Bais) Bonjour, Salut
+ 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,Hzixar\e(B) \e,Hylem\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
-Lao(\e(1>RJRERG\e(B) \e(1JP:R-4U\e(B, \e(1"mcKib*!4U\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
+ Norwegian (norsk) Hei, God dag
-Polish (j\e,Bj\e(Bzyk polski) Dzie\e,Bq\e(B dobry! Cze\e,B6f\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 (slovensky) Dobr\e,B}\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
- 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
+ Spanish (espa\e,Aq\e(Bol) \e,A!\e(BHola!
+ Swedish (svenska) Hej, Goddag
++Tamil (\e$,1<D<N<_<T<m\e(B) \e$,1<U<C<5<m<5<N<m\e(B
+ Thai (\e,T@RIRd7B\e(B) \e,TJGQJ4U$CQ:\e(B, \e,TJGQJ4U$hP\e(B
+ Tibetan (\e$(7"7"]"2!;"G#!"Q"2!;\e(B) \e$(7"7"!#C"Q!;"E"S"G!;"7"2"[!;"D"["#"G!>\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
- 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,1`\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
BIG5 -- \e$(0&x86\e(B \e$(0DeBv\e(B
Just for a test of JISX0212: \e$BqV\e$(DiQ\e(B (the second character is of JISX0212)
+
+A short test for Unicode characters:
+Czech (\e$,1 -\e(Besky) Dobr\e,A}\e(B den
+Esperanto Saluton (E\e$,1 E\e(Bo\e$,1 }\e(Ban\e$,1 =\e(Bo \e$,1 )\e(Biu\e$,1 U\e(Ba\e$,1!-\e(Bde)
+Greek (\e$,1&u';';'7'='9':',\e(B) \e$,1&s'5'9',\e(B \e$,1'C'1'B\e(B
+Hebrew \e$,1-),|,u,}\e(B
+Russian (\e$,1(@(c(a(a(Z(X(Y\e(B) \e$,1(7(T(`(P(R(a(b(R(c(Y(b(U\e(B!
+Maltese (Malti) Bon\e$,1 A\e(Bu, Sa\e$,1 G G\e(Ba
--- /dev/null
--- /dev/null
++2003-02-13 Dave Love <fx@gnu.org>
++
++ * quail/latin-post.el ("turkish-latin-3-postfix"): Make it
++ just an alias for turkish-postfix.
++
++ * quail/latin-alt.el ("turkish-latin-3-alt-postfix"): Make it
++ just an alias for turkish-alt-postfix.
++
++ * quail/cyrillic.el (ukrainian-computer): Fix duplicate `\'.
++
++2002-11-07 Kenichi Handa <handa@m17n.org>
++
++ * quail/thai.el: Don't require thai-util.
++ (quail-thai-update-translation): Function deleted.
++ (thai-generate-quail-map): Changed to a macro that directly calls
++ quail-define-rules.
++ ("thai-kesmanee", "thai-pattachote"): Don't use
++ UPDATE-TRANSLATION-FUNCTION.
++
++ * quail/indian.el (quail-indian-preceding-char-position): Function
++ deleted.
++ (quail-indian-update-preceding-char): Variable deleted.
++ (quail-indian-update-translation): Function deleted.
++ (quail-define-indian-trans-package): Don't call
++ quail-define-package with quail-indian-update-translation.
++ (quail-define-inscript-package): Likewise.
++
++2002-10-06 Dave Love <fx@gnu.org>
++
++ * quail/indian.el (quail-indian-preceding-char-position)
++ (quail-indian-update-translation, quail-define-inscript-package):
++ Use characterp, not char-valid-p.
++
++2002-07-30 Dave Love <fx@gnu.org>
++
++ * quail/welsh.el ("welsh"): Doc fix.
++
++ * quail/cyrillic.el: Reinstate some commented-out redundancies.
++ ("russian-typewriter"): Renamed from cyrillic-typewriter. Make
++ cyrillic-jcuken effectively an alias for it.
++ ("russian-computer"): New.
++ ("bulgarian-phonetic"): Renamed from bulgarian-pho.
++ ("bulgarian-bds"): Renamed from bulgarian-standard.
++
++2002-07-01 Dave Love <fx@gnu.org>
++
++ * quail/indian.el: Update from head.
++
++2002-06-27 Dave Love <fx@gnu.org>
++
++ * ja-dic/ja-dic.el: Add coding tag.
++
++2002-06-24 Dave Love <fx@gnu.org>
++
++ * latin-post.el: Recoded to utf-8.
++ ("latin-postfix"): New method.
++
++ * latin-alt.el: Recoded to utf-8.
++ ("latin-alt-postfix"): New method.
++
++ * quail/latin-pre.el: Recoded to utf-8.
++ ("latin-1-prefix", "latin-8-prefix", "latin-9-prefix"): Add nbsp.
++ ("latin-3-prefix"): Remove bogus Latin-3 characters and ~o -> \e,Cu\e(B,
++ ~O -> \e,CU\e(B.
++ ("latin-prefix"): New method.
++
++ * quail/uni-input.el (utf-8-ccl-encode): Deleted.
++ (ucs-input-method): Modified.
++
++2002-06-10 Dave Love <fx@gnu.org>
++
++ * quail/hanja3.el, quail/hanja.el, makefile.nt, Makefile.in:
++ * quail/vntelex.el: Update from trunk.
++
++ * quail/cyrillic.el: Doc fixes.
++ ("cyrillic-beylorussian"): Commented-out.
++ ("cyrillic-translit-bulgarian"): Deleted.
++ ("cyrillic-ukrainian"): Fix `q', `Q', `W', `w' bindings.
++ ("ukrainian-computer", "belarusian", "bulgarian-standard"): New.
++ ("bulgarian-pho"): Add \e,A'\e(B, \e,Lp\e(B, \e,LN\e(B.
++
++2002-05-31 Kenichi Handa <handa@etl.go.jp>
++
++ * quail/indian.el: Replace commented-out lines with a condition
++ that is always false. The same change by Eli on 2002-04-19 in
++ the HEAD trunk.
++
++2002-05-22 Kenichi Handa <handa@etl.go.jp>
++
++ * Makefile.in (RUN-EMACS): Add LC_ALL=C.
++
++;; Local Variables:
++;; coding: iso-2022-7bit-unix
++;; End:
++
++ Copyright (C) 2002 Free Software Foundation, Inc.
++ Copying and distribution of this file, with or without modification,
++ are permitted provided the copyright notice and this notice are preserved.
# Makefile for leim subdirectory in GNU Emacs.
# Copyright (C) 1997 Electrotechnical Laboratory, JAPAN.
--# Licensed to the Free Software Foundation.
++# Licensed to the Free Software Foundation.
++# Copyright (C) 2003
++# National Institute of Advanced Industrial Science and Technology (AIST)
++# Registration Number H13PRO009
# This file is part of GNU Emacs.
buildlisppath=${srcdir}/${dot}${dot}/lisp
# How to run Emacs.
- RUN-EMACS = EMACSLOADPATH=$(buildlisppath) \
-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
CHINESE-GB=${TIT-GB} ${NON-TIT-GB}
-CHINESE-BIG5=${TIT-BIG5} ${NON-TIT-BIG5}
+CHINESE-BIG5=${TIT-BIG5} ${NON-TIT-BIG5}
JAPANESE=${srcdir}/quail/japanese.elc ${srcdir}/ja-dic/ja-dic.elc
SLAVIC= \
${srcdir}/quail/czech.elc \
+ ${srcdir}/quail/croatian.elc \
${srcdir}/quail/slovak.elc
GREEK=${srcdir}/quail/greek.elc
rm -rf ${INSTALLDIR}/quail ${INSTALLDIR}/ja-dic ; \
echo "Copying leim files to ${INSTALLDIR} ..." ; \
if [ x`(cd ${srcdir} && /bin/pwd)` = x`(/bin/pwd)` ] ; then \
- tar -cf - leim-list.el quail ja-dic \
+ tar -chf - leim-list.el quail ja-dic \
| (cd ${INSTALLDIR}; umask 0; tar -xvf - && cat > /dev/null) ;\
else \
- tar -cf - leim-list.el quail \
+ tar -chf - leim-list.el quail \
| (cd ${INSTALLDIR}; umask 0; tar -xvf - && cat > /dev/null) ;\
cd ${srcdir}; \
- tar -cf - quail/* ja-dic \
+ tar -chf - quail/* ja-dic \
| (cd ${INSTALLDIR}; umask 0; tar -xvf - && cat > /dev/null) ;\
fi; \
+ rm -rf ${INSTALLDIR}/CVS ${INSTALLDIR}/*/CVS; \
+ rm -f ${INSTALLDIR}/.cvsignore ${INSTALLDIR}/*/.cvsignore; \
+ rm -f ${INSTALLDIR}/\#* ${INSTALLDIR}/*/\#* ; \
+ rm -f ${INSTALLDIR}/.\#* ${INSTALLDIR}/*/.\#* ; \
+ rm -f ${INSTALLDIR}/*~ ${INSTALLDIR}/*/*~ ; \
+ rm -f ${INSTALLDIR}/*.orig ${INSTALLDIR}/*/*.orig ; \
else true; fi
- -rm -f ${INSTALLDIR}/.cvsignore ${INSTALLDIR}/*/.cvsignore
-chmod -R a+r ${INSTALLDIR}
clean mostlyclean:
;; Copyright (C) 1997 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
;; Author: TAKAHASHI Naoto <ntakahas@m17n.org>
;; Keywords: multilingual, input method, Cyrillic, i18n
;;; Commentary:
+;; These methods use a mixture of 8859-5 and Unicode. Quail, used
+;; with ucs-tables provides suport for translating on the fly to
+;; what's appropriate for aa buffer's file coding system, so the
+;; encoding shouldn't matter too much provided it supports the
+;; necessary characters.
+
;;; Code:
(require 'quail)
;; `russian-computer' below.]
(quail-define-package
"russian-typewriter" "Russian" "\e,L69\e(B" nil
- "\e,L9FC:5=\e(B Russian typewriter layout."
+ "\e,L9FC:5=\e(B Russian typewriter layout (ISO 8859-5 encoding)."
nil t t t t nil nil nil nil nil t)
;; 1! 2" 3' 4* 5: 6, 7. 8; 9( 0) -_ =+ \e,L!\e(B
("," ?\e,LQ\e(B)
("." ?\e,Ln\e(B)
("/" ?/)
-
+
("!" ?!)
("@" ?\")
("#" ?')
;; Maintain the obsolete name for now.
(push (cons "cyrillic-jcuken"
- (cdr (assoc "russian-typewriter" input-method-alist)))
- input-method-alist)
+ (cdr (assoc "russian-typewriter" quail-package-alist)))
+ quail-package-alist)
+
+;; This needs to be seen by quail-update-leim-list-file, but cannot be
+;; commented out because quail-update-leim-list-file ignores
+;; commented-out lines.
+(if nil
+ (quail-define-package
+ "cyrillic-jcuken" "Russian" "\e,L69\e(B" nil
+ "\e,L9FC:5=\e(B Russian typewriter layout (ISO 8859-5 encoding)."))
;; See comment above. This is the variant `winkeys' from `ru' in XKB.
(quail-define-package
(">" ?\e,LN\e(B)
("?" ?,))
-;; Mikhailian couldn't check the next two.
+;; Mikhailian couldn't check the next two.
;; This seems to have the same layout for letters as mk in XKB, but at
;; 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= /? +* <>
("," ?,)
("." ?.)
("/" ?-)
-
+
("!" ?!)
("@" ?\")
("#" ?#)
;; ("n" ?\e,L]\e(B)
;; ("m" ?\e,L\\e(B)
;; ("/" ?-)
-
+
;; ("@" ?\")
;; ("^" ?&)
;; ("&" ?')
;; happily with this little change. [See "ukrainian-computer" below.]
;; Fixme: add GHE_WITH_UPTURN.
-(quail-define-package
+(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"
++ "\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)
;; 1! 2" 3# 4$ 5% 6& 7' 8( 9) 0= /? +* <>
("," ?,)
("." ?.)
("/" ?-)
-
+
("!" ?!)
("@" ?\")
("#" ?#)
(quail-define-package
"ukrainian-computer" "Ukrainian" "UK" nil
- "\e,L9FC:5=\e(B Ukrainian."
+ "\e$,1(9(F(C(:(5(=\e(B Ukrainian (Unicode-based for use with KOI8-U encoding)."
nil t t t t nil nil nil nil nil t)
-;; ' 1! 2" 3\e,Lp\e(B 4; 5% 6: 7? 8* 9( 0) -_ =+
-;; \e,L9\e(B \e,LF\e(B \e,LC\e(B \e,L:\e(B \e,L5\e(B \e,L=\e(B \e,L3\e(B \e,LH\e(B \e,LI\e(B \e,L7\e(B \e,LE\e(B \e,L'\e(B
-;; \e,LD\e(B \e,L&\e(B \e,L2\e(B \e,L0\e(B \e,L?\e(B \e,L@\e(B \e,L>\e(B \e,L;\e(B \e,L4\e(B \e,L6\e(B \e,L$\e(B \e$,1)P\e(B
-;; \e,LO\e(B \e,LG\e(B \e,LA\e(B \e,L<\e(B \e,L8\e(B \e,LB\e(B \e,LL\e(B \e,L1\e(B \e,LN\e(B .,
+;; ' 1! 2" 3\e$,1uV\e(B 4; 5% 6: 7? 8* 9( 0) -_ =+
+;; \e$,1(9\e(B \e$,1(F\e(B \e$,1(C\e(B \e$,1(:\e(B \e$,1(5\e(B \e$,1(=\e(B \e$,1(3\e(B \e$,1(H\e(B \e$,1(I\e(B \e$,1(7\e(B \e$,1(E\e(B \e$,1('\e(B
+;; \e$,1(D\e(B \e$,1(&\e(B \e$,1(2\e(B \e$,1(0\e(B \e$,1(?\e(B \e$,1(@\e(B \e$,1(>\e(B \e$,1(;\e(B \e$,1(4\e(B \e$,1(6\e(B \e$,1($\e(B \e$,1)P\e(B
+;; \e$,1(O\e(B \e$,1(G\e(B \e$,1(A\e(B \e$,1(<\e(B \e$,1(8\e(B \e$,1(B\e(B \e$,1(L\e(B \e$,1(1\e(B \e$,1(N\e(B .,
(quail-define-rules
("1" ?1)
("-" ?-)
("=" ?=)
("`" ?')
- ("q" ?\e,LY\e(B)
- ("w" ?\e,Lf\e(B)
- ("e" ?\e,Lc\e(B)
- ("r" ?\e,LZ\e(B)
- ("t" ?\e,LU\e(B)
- ("y" ?\e,L]\e(B)
- ("u" ?\e,LS\e(B)
- ("i" ?\e,Lh\e(B)
- ("o" ?\e,Li\e(B)
- ("p" ?\e,LW\e(B)
- ("[" ?\e,Le\e(B)
- ("]" ?\e,Lw\e(B)
- ("a" ?\e,Ld\e(B)
- ("s" ?\e,Lv\e(B)
- ("d" ?\e,LR\e(B)
- ("f" ?\e,LP\e(B)
- ("g" ?\e,L_\e(B)
- ("h" ?\e,L`\e(B)
- ("j" ?\e,L^\e(B)
- ("k" ?\e,L[\e(B)
- ("l" ?\e,LT\e(B)
- (";" ?\e,LV\e(B)
- ("'" ?\e,Lt\e(B)
- ("z" ?\e,Lo\e(B)
- ("x" ?\e,Lg\e(B)
- ("c" ?\e,La\e(B)
- ("v" ?\e,L\\e(B)
- ("b" ?\e,LX\e(B)
- ("n" ?\e,Lb\e(B)
- ("m" ?\e,Ll\e(B)
- ("," ?\e,LQ\e(B)
- ("." ?\e,Ln\e(B)
+ ("q" ?\e$,1(Y\e(B)
+ ("w" ?\e$,1(f\e(B)
+ ("e" ?\e$,1(c\e(B)
+ ("r" ?\e$,1(Z\e(B)
+ ("t" ?\e$,1(U\e(B)
+ ("y" ?\e$,1(]\e(B)
+ ("u" ?\e$,1(S\e(B)
+ ("i" ?\e$,1(h\e(B)
+ ("o" ?\e$,1(i\e(B)
+ ("p" ?\e$,1(W\e(B)
+ ("[" ?\e$,1(e\e(B)
+ ("]" ?\e$,1(w\e(B)
+ ("a" ?\e$,1(d\e(B)
+ ("s" ?\e$,1(v\e(B)
+ ("d" ?\e$,1(R\e(B)
+ ("f" ?\e$,1(P\e(B)
+ ("g" ?\e$,1(_\e(B)
+ ("h" ?\e$,1(`\e(B)
+ ("j" ?\e$,1(^\e(B)
+ ("k" ?\e$,1([\e(B)
+ ("l" ?\e$,1(T\e(B)
+ (";" ?\e$,1(V\e(B)
+ ("'" ?\e$,1(t\e(B)
+ ("z" ?\e$,1(o\e(B)
+ ("x" ?\e$,1(g\e(B)
+ ("c" ?\e$,1(a\e(B)
+ ("v" ?\e$,1(\\e(B)
+ ("b" ?\e$,1(X\e(B)
+ ("n" ?\e$,1(b\e(B)
+ ("m" ?\e$,1(l\e(B)
+ ("," ?\e$,1(Q\e(B)
+ ("." ?\e$,1(n\e(B)
("/" ?.)
("!" ?!)
("@" ?\")
- ("#" ?\e,Lp\e(B)
+ ("#" ?\e$,1uV\e(B)
("$" ?\;)
("%" ?%)
("^" ?:)
("_" ?_)
("+" ?+)
("~" ?')
- ("Q" ?\e,L9\e(B)
- ("W" ?\e,LF\e(B)
- ("E" ?\e,LC\e(B)
- ("R" ?\e,L:\e(B)
- ("T" ?\e,L5\e(B)
- ("Y" ?\e,L=\e(B)
- ("U" ?\e,L3\e(B)
- ("I" ?\e,LH\e(B)
- ("O" ?\e,LI\e(B)
- ("P" ?\e,L7\e(B)
- ("{" ?\e,LE\e(B)
- ("}" ?\e,L'\e(B)
- ("A" ?\e,LD\e(B)
- ("S" ?\e,L&\e(B)
- ("D" ?\e,L2\e(B)
- ("F" ?\e,L0\e(B)
- ("G" ?\e,L?\e(B)
- ("H" ?\e,L@\e(B)
- ("J" ?\e,L>\e(B)
- ("K" ?\e,L;\e(B)
- ("L" ?\e,L4\e(B)
- (":" ?\e,L6\e(B)
- ("\"" ?\e,L$\e(B)
- ("Z" ?\e,LO\e(B)
- ("X" ?\e,LG\e(B)
- ("C" ?\e,LA\e(B)
- ("V" ?\e,L<\e(B)
- ("B" ?\e,L8\e(B)
- ("N" ?\e,LB\e(B)
- ("M" ?\e,LL\e(B)
- ("<" ?\e,L1\e(B)
- (">" ?\e,LN\e(B)
+ ("Q" ?\e$,1(9\e(B)
+ ("W" ?\e$,1(F\e(B)
+ ("E" ?\e$,1(C\e(B)
+ ("R" ?\e$,1(:\e(B)
+ ("T" ?\e$,1(5\e(B)
+ ("Y" ?\e$,1(=\e(B)
+ ("U" ?\e$,1(3\e(B)
+ ("I" ?\e$,1(H\e(B)
+ ("O" ?\e$,1(I\e(B)
+ ("P" ?\e$,1(7\e(B)
+ ("{" ?\e$,1(E\e(B)
+ ("}" ?\e$,1('\e(B)
+ ("A" ?\e$,1(D\e(B)
+ ("S" ?\e$,1(&\e(B)
+ ("D" ?\e$,1(2\e(B)
+ ("F" ?\e$,1(0\e(B)
+ ("G" ?\e$,1(?\e(B)
+ ("H" ?\e$,1(@\e(B)
+ ("J" ?\e$,1(>\e(B)
+ ("K" ?\e$,1(;\e(B)
+ ("L" ?\e$,1(4\e(B)
+ (":" ?\e$,1(6\e(B)
+ ("\"" ?\e$,1($\e(B)
+ ("Z" ?\e$,1(O\e(B)
+ ("X" ?\e$,1(G\e(B)
+ ("C" ?\e$,1(A\e(B)
+ ("V" ?\e$,1(<\e(B)
+ ("B" ?\e$,1(8\e(B)
+ ("N" ?\e$,1(B\e(B)
+ ("M" ?\e$,1(L\e(B)
+ ("<" ?\e$,1(1\e(B)
+ (">" ?\e$,1(N\e(B)
("?" ?,)
("\\" ?\e$,1)Q\e(B)
("|" ?\e$,1)P\e(B))
;; Alexander Mikhailian says this is of limited use. It has been
;; popular among emigrants or foreigners who have to type in Cyrillic
;; (mostly Russian) from time to time.
-(quail-define-package
+(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.
++ "\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
("," ?,)
("." ?.)
("/" ?/)
-
+
("!" ?!)
("@" ?\e,Lq\e(B)
("#" ?\e,Lj\e(B)
("<" ?<)
(">" ?>)
("?" ??)
-
+
("/q" ?\e,Lr\e(B)
("/w" ?\e,Ls\e(B)
("/e" ?\e,Lt\e(B)
("/a" ?\e,L|\e(B)
("/s" ?\e,L~\e(B)
("/d" ?\e,L\7f\e(B)
-
+
("/Q" ?\e,L"\e(B)
("/W" ?\e,L#\e(B)
("/E" ?\e,L$\e(B)
Russian alphabet: a b v=w g d e yo=jo zh z i j=j' k l m n o p r s t
u f h=kh=x c ch sh shch=sj=/s=/sht ~ y ' e' yu=ju ya=ja=q
-Also included are Ukrainian \e,Lt\e(B (YE) = \"/e\" and \e,Lw\e(B (YI) = \"yi\",
+Also included are Ukrainian \e,Lt\e(B (YE) = \"/e\" and \e,Lw\e(B (YI) = \"yi\",
Belarusian \e,L~\e(B (SHORT U) = \"u'\",
-Serbo-Croatian \e,Lr\e(B (DJE) = \"/d\", \e,L{\e(B (CHJE)= \"/ch\",
+Serbo-Croatian \e,Lr\e(B (DJE) = \"/d\", \e,L{\e(B (CHJE)= \"/ch\",
Macedonian \e,Ls\e(B (GJE) = \"/g\", \e,Lu\e(B (DZE) = \"/s\", \e,L|\e(B (KJE) = \"/k\",
-cyrillic \e,Lv\e(B (I DECIMAL) = \"/i\", \e,Lx\e(B (JE) = \"/j\",
+cyrillic \e,Lv\e(B (I DECIMAL) = \"/i\", \e,Lx\e(B (JE) = \"/j\",
\e,Ly\e(B (LJE) = \"/l\", \e,Lz\e(B (NJE) = \"/n\" and \e,L\7f\e(B (DZE) =\"/z\"."
nil t t t t nil nil nil nil nil t)
(quail-define-rules
- ("a" ?\e,LP\e(B)("b" ?\e,LQ\e(B) ("v" ?\e,LR\e(B) ("w" ?\e,LR\e(B) ("g" ?\e,LS\e(B) ("d" ?\e,LT\e(B)
- ("e" ?\e,LU\e(B) ("je" ?\e,LU\e(B)
+ ("a" ?\e,LP\e(B)("b" ?\e,LQ\e(B) ("v" ?\e,LR\e(B) ("w" ?\e,LR\e(B) ("g" ?\e,LS\e(B) ("d" ?\e,LT\e(B)
+ ("e" ?\e,LU\e(B) ("je" ?\e,LU\e(B)
("yo" ?\e,Lq\e(B) ("jo" ?\e,Lq\e(B)
- ("zh" ?\e,LV\e(B) ("z" ?\e,LW\e(B) ("i" ?\e,LX\e(B)
+ ("zh" ?\e,LV\e(B) ("z" ?\e,LW\e(B) ("i" ?\e,LX\e(B)
("j" ?\e,LY\e(B) ("j'" ?\e,LY\e(B) ("j`" ?\e,LY\e(B) ("k" ?\e,LZ\e(B) ("l" ?\e,L[\e(B)
("m" ?\e,L\\e(B) ("n" ?\e,L]\e(B) ("o" ?\e,L^\e(B) ("p" ?\e,L_\e(B) ("r" ?\e,L`\e(B) ("s" ?\e,La\e(B) ("t" ?\e,Lb\e(B) ("u" ?\e,Lc\e(B)
("f" ?\e,Ld\e(B) ("x" ?\e,Le\e(B) ("h" ?\e,Le\e(B) ("kh" ?\e,Le\e(B)
("c" ?\e,Lf\e(B) ("ch" ?\e,Lg\e(B)
- ("sh" ?\e,Lh\e(B)
- ("shch" ?\e,Li\e(B) ("sj" ?\e,Li\e(B)
- ("/sht" ?\e,Li\e(B) ("/t" ?\e,Li\e(B)
- ("~" ?\e,Lj\e(B) ("y" ?\e,Lk\e(B) ("'" ?\e,Ll\e(B) ("`" ?\e,Ll\e(B)
- ("e'" ?\e,Lm\e(B) ("e`" ?\e,Lm\e(B) ("@" ?\e,Lm\e(B)
- ("yu" ?\e,Ln\e(B) ("ju" ?\e,Ln\e(B)
+ ("sh" ?\e,Lh\e(B)
+ ("shch" ?\e,Li\e(B) ("sj" ?\e,Li\e(B)
+ ("/sht" ?\e,Li\e(B) ("/t" ?\e,Li\e(B)
+ ("~" ?\e,Lj\e(B) ("y" ?\e,Lk\e(B) ("'" ?\e,Ll\e(B) ("`" ?\e,Ll\e(B)
+ ("e'" ?\e,Lm\e(B) ("e`" ?\e,Lm\e(B) ("@" ?\e,Lm\e(B)
+ ("yu" ?\e,Ln\e(B) ("ju" ?\e,Ln\e(B)
("ya" ?\e,Lo\e(B) ("ja" ?\e,Lo\e(B) ("q" ?\e,Lo\e(B)
- ("A" ?\e,L0\e(B) ("B" ?\e,L1\e(B) ("V" ?\e,L2\e(B) ("W" ?\e,L2\e(B) ("G" ?\e,L3\e(B) ("D" ?\e,L4\e(B)
+ ("A" ?\e,L0\e(B) ("B" ?\e,L1\e(B) ("V" ?\e,L2\e(B) ("W" ?\e,L2\e(B) ("G" ?\e,L3\e(B) ("D" ?\e,L4\e(B)
("E" ?\e,L5\e(B) ("Je" ?\e,L5\e(B) ("JE" ?\e,L5\e(B)
- ("Yo" ?\e,L!\e(B) ("YO" ?\e,L!\e(B) ("Jo" ?\e,L!\e(B) ("JO" ?\e,L!\e(B)
- ("Zh" ?\e,L6\e(B) ("ZH" ?\e,L6\e(B) ("Z" ?\e,L7\e(B) ("I" ?\e,L8\e(B)
+ ("Yo" ?\e,L!\e(B) ("YO" ?\e,L!\e(B) ("Jo" ?\e,L!\e(B) ("JO" ?\e,L!\e(B)
+ ("Zh" ?\e,L6\e(B) ("ZH" ?\e,L6\e(B) ("Z" ?\e,L7\e(B) ("I" ?\e,L8\e(B)
("J" ?\e,L9\e(B) ("J'" ?\e,L9\e(B) ("J`" ?\e,L9\e(B) ("K" ?\e,L:\e(B) ("L" ?\e,L;\e(B)
("M" ?\e,L<\e(B) ("N" ?\e,L=\e(B) ("O" ?\e,L>\e(B) ("P" ?\e,L?\e(B) ("R" ?\e,L@\e(B) ("S" ?\e,LA\e(B) ("T" ?\e,LB\e(B) ("U" ?\e,LC\e(B)
("F" ?\e,LD\e(B) ("X" ?\e,LE\e(B) ("H" ?\e,LE\e(B) ("Kh" ?\e,LE\e(B) ("KH" ?\e,LE\e(B)
- ("C" ?\e,LF\e(B) ("Ch" ?\e,LG\e(B) ("CH" ?\e,LG\e(B)
- ("Sh" ?\e,LH\e(B) ("SH" ?\e,LH\e(B)
- ("Shch" ?\e,LI\e(B) ("SHCH" ?\e,LI\e(B) ("Sj" ?\e,LI\e(B) ("SJ" ?\e,LI\e(B)
- ("/Sht" ?\e,LI\e(B) ("/SHT" ?\e,LI\e(B) ("/T" ?\e,LI\e(B)
- ("~~" "\e,LJ\e(B") ("Y" ?\e,LK\e(B) ("''" "\e,LL\e(B") ("E'" ?\e,LM\e(B) ("E`" ?\e,LM\e(B)
- ("Yu" ?\e,LN\e(B) ("YU" ?\e,LN\e(B) ("Ju" ?\e,LN\e(B) ("JU" ?\e,LN\e(B)
+ ("C" ?\e,LF\e(B) ("Ch" ?\e,LG\e(B) ("CH" ?\e,LG\e(B)
+ ("Sh" ?\e,LH\e(B) ("SH" ?\e,LH\e(B)
+ ("Shch" ?\e,LI\e(B) ("SHCH" ?\e,LI\e(B) ("Sj" ?\e,LI\e(B) ("SJ" ?\e,LI\e(B)
+ ("/Sht" ?\e,LI\e(B) ("/SHT" ?\e,LI\e(B) ("/T" ?\e,LI\e(B)
+ ("~~" "\e,LJ\e(B") ("Y" ?\e,LK\e(B) ("''" "\e,LL\e(B") ("E'" ?\e,LM\e(B) ("E`" ?\e,LM\e(B)
+ ("Yu" ?\e,LN\e(B) ("YU" ?\e,LN\e(B) ("Ju" ?\e,LN\e(B) ("JU" ?\e,LN\e(B)
("Ya" ?\e,LO\e(B) ("YA" ?\e,LO\e(B) ("Ja" ?\e,LO\e(B) ("JA" ?\e,LO\e(B) ("Q" ?\e,LO\e(B)
("/e" ?\e,Lt\e(B) ("yi" ?\e,Lw\e(B) ("u'" ?\e,L~\e(B)
("/d" ?\e,Lr\e(B) ("/ch" ?\e,L{\e(B)
("/g" ?\e,Ls\e(B) ("/s" ?\e,Lu\e(B) ("/k" ?\e,L|\e(B)
("/i" ?\e,Lv\e(B) ("/j" ?\e,Lx\e(B) ("/l" ?\e,Ly\e(B) ("/n" ?\e,Lz\e(B) ("/z" ?\e,L\7f\e(B)
- ("/E" ?\e,L$\e(B) ("YE" ?\e,L$\e(B) ("Yi" ?\e,L'\e(B) ("YI" ?\e,L'\e(B) ("U'" ?\e,L.\e(B)
+ ("/E" ?\e,L$\e(B) ("YE" ?\e,L$\e(B) ("Yi" ?\e,L'\e(B) ("YI" ?\e,L'\e(B) ("U'" ?\e,L.\e(B)
("/D" ?\e,L"\e(B) ("/Ch" ?\e,L+\e(B) ("/CH" ?\e,L+\e(B)
- ("/G" ?\e,L#\e(B) ("/S" ?\e,L%\e(B) ("/K" ?\e,L,\e(B)
+ ("/G" ?\e,L#\e(B) ("/S" ?\e,L%\e(B) ("/K" ?\e,L,\e(B)
("/I" ?\e,L&\e(B) ("/J" ?\e,L(\e(B) ("/L" ?\e,L)\e(B) ("/N" ?\e,L*\e(B) ("/Z" ?\e,L/\e(B)
)
;; <mikhailian@altern.org>, subsequently amended by AM.
(quail-define-package
"belarusian" "Belarusian" "BE" nil
- "\e,L9FC:5=\e(B keyboard layout registered as STB955-94 Belarusian standard."
+ "\e$,1(9(F(C(:(5(=\e(B keyboard layout registered as STB955-94 Belarusian standard.
+Unicode based."
nil t t t t nil nil nil nil nil t)
-;; \e,Lq!\e(B 1! 2" 3N 4; 5% 6: 7? 8* 9( 0) -_ =+
-;; \e,L9\e(B \e,LF\e(B \e,LC\e(B \e,L:\e(B \e,L5\e(B \e,L=\e(B \e,L3\e(B \e,LH\e(B \e,L.\e(B \e,L7\e(B \e,LE\e(B '
-;; \e,LD\e(B \e,LK\e(B \e,L2\e(B \e,L0\e(B \e,L?\e(B \e,L@\e(B \e,L>\e(B \e,L;\e(B \e,L4\e(B \e,L6\e(B \e,LM\e(B
-;; \e,LO\e(B \e,LG\e(B \e,LA\e(B \e,L<\e(B \e,L&\e(B \e,LB\e(B \e,LL\e(B \e,L1\e(B \e,LN\e(B .,
+;; \e$,1(q(!\e(B 1! 2" 3N 4; 5% 6: 7? 8* 9( 0) -_ =+
+;; \e$,1(9\e(B \e$,1(F\e(B \e$,1(C\e(B \e$,1(:\e(B \e$,1(5\e(B \e$,1(=\e(B \e$,1(3\e(B \e$,1(H\e(B \e$,1(.\e(B \e$,1(7\e(B \e$,1(E\e(B '
+;; \e$,1(D\e(B \e$,1(K\e(B \e$,1(2\e(B \e$,1(0\e(B \e$,1(?\e(B \e$,1(@\e(B \e$,1(>\e(B \e$,1(;\e(B \e$,1(4\e(B \e$,1(6\e(B \e$,1(M\e(B
+;; \e$,1(O\e(B \e$,1(G\e(B \e$,1(A\e(B \e$,1(<\e(B \e$,1(&\e(B \e$,1(B\e(B \e$,1(L\e(B \e$,1(1\e(B \e$,1(N\e(B .,
(quail-define-rules
- ("~" ?\e,L!\e(B)
+ ("~" ?\e$,1(!\e(B)
("@" ?\")
- ("#" ?\e,Lp\e(B)
+ ("#" ?\e$,1uV\e(B)
("$" ?\;)
("%" ?%)
("^" ?:)
("&" ??)
- ("Q" ?\e,L9\e(B)
- ("W" ?\e,LF\e(B)
- ("E" ?\e,LC\e(B)
- ("R" ?\e,L:\e(B)
- ("T" ?\e,L5\e(B)
- ("Y" ?\e,L=\e(B)
- ("U" ?\e,L3\e(B)
- ("I" ?\e,LH\e(B)
- ("O" ?\e,L.\e(B)
- ("P" ?\e,L7\e(B)
- ("{" ?\e,LE\e(B)
+ ("Q" ?\e$,1(9\e(B)
+ ("W" ?\e$,1(F\e(B)
+ ("E" ?\e$,1(C\e(B)
+ ("R" ?\e$,1(:\e(B)
+ ("T" ?\e$,1(5\e(B)
+ ("Y" ?\e$,1(=\e(B)
+ ("U" ?\e$,1(3\e(B)
+ ("I" ?\e$,1(H\e(B)
+ ("O" ?\e$,1(.\e(B)
+ ("P" ?\e$,1(7\e(B)
+ ("{" ?\e$,1(E\e(B)
("}" ?')
- ("A" ?\e,LD\e(B)
- ("S" ?\e,LK\e(B)
- ("D" ?\e,L2\e(B)
- ("F" ?\e,L0\e(B)
- ("G" ?\e,L?\e(B)
- ("H" ?\e,L@\e(B)
- ("J" ?\e,L>\e(B)
- ("K" ?\e,L;\e(B)
- ("L" ?\e,L4\e(B)
- (":" ?\e,L6\e(B)
- ("\"" ?\e,LM\e(B)
+ ("A" ?\e$,1(D\e(B)
+ ("S" ?\e$,1(K\e(B)
+ ("D" ?\e$,1(2\e(B)
+ ("F" ?\e$,1(0\e(B)
+ ("G" ?\e$,1(?\e(B)
+ ("H" ?\e$,1(@\e(B)
+ ("J" ?\e$,1(>\e(B)
+ ("K" ?\e$,1(;\e(B)
+ ("L" ?\e$,1(4\e(B)
+ (":" ?\e$,1(6\e(B)
+ ("\"" ?\e$,1(M\e(B)
("|" ?|)
- ("Z" ?\e,LO\e(B)
- ("X" ?\e,LG\e(B)
- ("C" ?\e,LA\e(B)
- ("V" ?\e,L<\e(B)
- ("B" ?\e,L&\e(B)
- ("N" ?\e,LB\e(B)
- ("M" ?\e,LL\e(B)
- ("<" ?\e,L1\e(B)
- (">" ?\e,LN\e(B)
+ ("Z" ?\e$,1(O\e(B)
+ ("X" ?\e$,1(G\e(B)
+ ("C" ?\e$,1(A\e(B)
+ ("V" ?\e$,1(<\e(B)
+ ("B" ?\e$,1(&\e(B)
+ ("N" ?\e$,1(B\e(B)
+ ("M" ?\e$,1(L\e(B)
+ ("<" ?\e$,1(1\e(B)
+ (">" ?\e$,1(N\e(B)
("?" ?,)
- ("`" ?\e,Lq\e(B)
- ("q" ?\e,LY\e(B)
- ("w" ?\e,Lf\e(B)
- ("e" ?\e,Lc\e(B)
- ("r" ?\e,LZ\e(B)
- ("t" ?\e,LU\e(B)
- ("y" ?\e,L]\e(B)
- ("u" ?\e,LS\e(B)
- ("i" ?\e,Lh\e(B)
- ("o" ?\e,L~\e(B)
- ("p" ?\e,LW\e(B)
- ("[" ?\e,Le\e(B)
+ ("`" ?\e$,1(q\e(B)
+ ("q" ?\e$,1(Y\e(B)
+ ("w" ?\e$,1(f\e(B)
+ ("e" ?\e$,1(c\e(B)
+ ("r" ?\e$,1(Z\e(B)
+ ("t" ?\e$,1(U\e(B)
+ ("y" ?\e$,1(]\e(B)
+ ("u" ?\e$,1(S\e(B)
+ ("i" ?\e$,1(h\e(B)
+ ("o" ?\e$,1(~\e(B)
+ ("p" ?\e$,1(W\e(B)
+ ("[" ?\e$,1(e\e(B)
("]" ?')
- ("a" ?\e,Ld\e(B)
- ("s" ?\e,Lk\e(B)
- ("d" ?\e,LR\e(B)
- ("f" ?\e,LP\e(B)
- ("g" ?\e,L_\e(B)
- ("h" ?\e,L`\e(B)
- ("j" ?\e,L^\e(B)
- ("k" ?\e,L[\e(B)
- ("l" ?\e,LT\e(B)
- (";" ?\e,LV\e(B)
- ("'" ?\e,Lm\e(B)
- ("z" ?\e,Lo\e(B)
- ("x" ?\e,Lg\e(B)
- ("c" ?\e,La\e(B)
- ("v" ?\e,L\\e(B)
- ("b" ?\e,Lv\e(B)
- ("n" ?\e,Lb\e(B)
- ("m" ?\e,Ll\e(B)
- ("," ?\e,LQ\e(B)
- ("." ?\e,Ln\e(B)
+ ("a" ?\e$,1(d\e(B)
+ ("s" ?\e$,1(k\e(B)
+ ("d" ?\e$,1(R\e(B)
+ ("f" ?\e$,1(P\e(B)
+ ("g" ?\e$,1(_\e(B)
+ ("h" ?\e$,1(`\e(B)
+ ("j" ?\e$,1(^\e(B)
+ ("k" ?\e$,1([\e(B)
+ ("l" ?\e$,1(T\e(B)
+ (";" ?\e$,1(V\e(B)
+ ("'" ?\e$,1(m\e(B)
+ ("z" ?\e$,1(o\e(B)
+ ("x" ?\e$,1(g\e(B)
+ ("c" ?\e$,1(a\e(B)
+ ("v" ?\e$,1(\\e(B)
+ ("b" ?\e$,1(v\e(B)
+ ("n" ?\e$,1(b\e(B)
+ ("m" ?\e$,1(l\e(B)
+ ("," ?\e$,1(Q\e(B)
+ ("." ?\e$,1(n\e(B)
("/" ?.))
;; From `Bulgarian-PHO.kmap for Yudit', Alexander Shopov
(quail-define-package
"bulgarian-phonetic" "Bulgarian" "\e$,1(6(1(D\e(B"
nil
- "Bulgarian Phonetic keyboard layout.
+ "Bulgarian Phonetic keyboard layout, producing Unicode.
The layout is similar to `cyrillic-translit', but all Bulgarian
characters are typed with a single key.
-Use /& for \e,A'\e(B (Cyrillic paragraph) and /# for \e,Lp\e(B."
+Use /& for \e,A'\e(B (Cyrillic paragraph) and /# for \e$,1uV\e(B."
nil t t t t nil nil nil nil nil t)
-;; \e,LO\e(B \e,L2\e(B \e,L5\e(B \e,L@\e(B \e,LB\e(B \e,LJ\e(B \e,LC\e(B \e,L8\e(B \e,L>\e(B \e,L?\e(B \e,LH\e(B \e,LI\e(B
-;; \e,L0\e(B \e,LA\e(B \e,L4\e(B \e,LD\e(B \e,L3\e(B \e,LE\e(B \e,L9\e(B \e,L:\e(B \e,L;\e(B \e,LG\e(B
-;; \e,LN\e(B \e,L7\e(B \e,LL\e(B \e,LF\e(B \e,L6\e(B \e,L1\e(B \e,L=\e(B \e,L<\e(B
+;; \e$,1(O\e(B \e$,1(2\e(B \e$,1(5\e(B \e$,1(@\e(B \e$,1(B\e(B \e$,1(J\e(B \e$,1(C\e(B \e$,1(8\e(B \e$,1(>\e(B \e$,1(?\e(B \e$,1(H\e(B \e$,1(I\e(B
+;; \e$,1(0\e(B \e$,1(A\e(B \e$,1(4\e(B \e$,1(D\e(B \e$,1(3\e(B \e$,1(E\e(B \e$,1(9\e(B \e$,1(:\e(B \e$,1(;\e(B \e$,1(G\e(B
+;; \e$,1(N\e(B \e$,1(7\e(B \e$,1(L\e(B \e$,1(F\e(B \e$,1(6\e(B \e$,1(1\e(B \e$,1(=\e(B \e$,1(<\e(B
(quail-define-rules
("/&" ?\e,A'\e(B)
- ("/#" ?\e,Lp\e(B)
- ("A" ?\e,L0\e(B)
- ("B" ?\e,L1\e(B)
- ("W" ?\e,L2\e(B)
- ("G" ?\e,L3\e(B)
- ("D" ?\e,L4\e(B)
- ("E" ?\e,L5\e(B)
- ("V" ?\e,L6\e(B)
- ("Z" ?\e,L7\e(B)
- ("I" ?\e,L8\e(B)
- ("J" ?\e,L9\e(B)
- ("K" ?\e,L:\e(B)
- ("L" ?\e,L;\e(B)
- ("M" ?\e,L<\e(B)
- ("N" ?\e,L=\e(B)
- ("O" ?\e,L>\e(B)
- ("P" ?\e,L?\e(B)
- ("R" ?\e,L@\e(B)
- ("S" ?\e,LA\e(B)
- ("T" ?\e,LB\e(B)
- ("U" ?\e,LC\e(B)
- ("F" ?\e,LD\e(B)
- ("H" ?\e,LE\e(B)
- ("C" ?\e,LF\e(B)
- ("~" ?\e,LG\e(B)
- ("{" ?\e,LH\e(B)
- ("}" ?\e,LI\e(B)
- ("Y" ?\e,LJ\e(B)
- ("X" ?\e,LL\e(B)
- ("|" ?\e,LN\e(B)
- ("Q" ?\e,LO\e(B)
- ("a" ?\e,LP\e(B)
- ("b" ?\e,LQ\e(B)
- ("w" ?\e,LR\e(B)
- ("g" ?\e,LS\e(B)
- ("d" ?\e,LT\e(B)
- ("e" ?\e,LU\e(B)
- ("v" ?\e,LV\e(B)
- ("z" ?\e,LW\e(B)
- ("i" ?\e,LX\e(B)
- ("j" ?\e,LY\e(B)
- ("k" ?\e,LZ\e(B)
- ("l" ?\e,L[\e(B)
- ("m" ?\e,L\\e(B)
- ("n" ?\e,L]\e(B)
- ("o" ?\e,L^\e(B)
- ("p" ?\e,L_\e(B)
- ("r" ?\e,L`\e(B)
- ("s" ?\e,La\e(B)
- ("t" ?\e,Lb\e(B)
- ("u" ?\e,Lc\e(B)
- ("f" ?\e,Ld\e(B)
- ("h" ?\e,Le\e(B)
- ("c" ?\e,Lf\e(B)
- ("`" ?\e,Lg\e(B)
- ("[" ?\e,Lh\e(B)
- ("]" ?\e,Li\e(B)
- ("y" ?\e,Lj\e(B)
- ("x" ?\e,Ll\e(B)
- ("\\" ?\e,Ln\e(B)
- ("|" ?\e,LN\e(B)
- ("q" ?\e,Lo\e(B))
+ ("/#" ?\e$,1uV\e(B)
+ ("A" ?\e$,1(0\e(B)
+ ("B" ?\e$,1(1\e(B)
+ ("W" ?\e$,1(2\e(B)
+ ("G" ?\e$,1(3\e(B)
+ ("D" ?\e$,1(4\e(B)
+ ("E" ?\e$,1(5\e(B)
+ ("V" ?\e$,1(6\e(B)
+ ("Z" ?\e$,1(7\e(B)
+ ("I" ?\e$,1(8\e(B)
+ ("J" ?\e$,1(9\e(B)
+ ("K" ?\e$,1(:\e(B)
+ ("L" ?\e$,1(;\e(B)
+ ("M" ?\e$,1(<\e(B)
+ ("N" ?\e$,1(=\e(B)
+ ("O" ?\e$,1(>\e(B)
+ ("P" ?\e$,1(?\e(B)
+ ("R" ?\e$,1(@\e(B)
+ ("S" ?\e$,1(A\e(B)
+ ("T" ?\e$,1(B\e(B)
+ ("U" ?\e$,1(C\e(B)
+ ("F" ?\e$,1(D\e(B)
+ ("H" ?\e$,1(E\e(B)
+ ("C" ?\e$,1(F\e(B)
+ ("~" ?\e$,1(G\e(B)
+ ("{" ?\e$,1(H\e(B)
+ ("}" ?\e$,1(I\e(B)
+ ("Y" ?\e$,1(J\e(B)
+ ("X" ?\e$,1(L\e(B)
+ ("|" ?\e$,1(N\e(B)
+ ("Q" ?\e$,1(O\e(B)
+ ("a" ?\e$,1(P\e(B)
+ ("b" ?\e$,1(Q\e(B)
+ ("w" ?\e$,1(R\e(B)
+ ("g" ?\e$,1(S\e(B)
+ ("d" ?\e$,1(T\e(B)
+ ("e" ?\e$,1(U\e(B)
+ ("v" ?\e$,1(V\e(B)
+ ("z" ?\e$,1(W\e(B)
+ ("i" ?\e$,1(X\e(B)
+ ("j" ?\e$,1(Y\e(B)
+ ("k" ?\e$,1(Z\e(B)
+ ("l" ?\e$,1([\e(B)
+ ("m" ?\e$,1(\\e(B)
+ ("n" ?\e$,1(]\e(B)
+ ("o" ?\e$,1(^\e(B)
+ ("p" ?\e$,1(_\e(B)
+ ("r" ?\e$,1(`\e(B)
+ ("s" ?\e$,1(a\e(B)
+ ("t" ?\e$,1(b\e(B)
+ ("u" ?\e$,1(c\e(B)
+ ("f" ?\e$,1(d\e(B)
+ ("h" ?\e$,1(e\e(B)
+ ("c" ?\e$,1(f\e(B)
+ ("`" ?\e$,1(g\e(B)
+ ("[" ?\e$,1(h\e(B)
+ ("]" ?\e$,1(i\e(B)
+ ("y" ?\e$,1(j\e(B)
+ ("x" ?\e$,1(l\e(B)
+ ("\\" ?\e$,1(n\e(B)
+ ("|" ?\e$,1(N\e(B)
+ ("q" ?\e$,1(o\e(B))
;; Based on an implementation by Ognyan Kulev <ogi@fmi.uni-sofia.bg>.
;; This follows XKB bg.
This keyboard layout is standard for Bulgarian typewriters."
nil t t t t nil nil nil nil nil t)
-;; 1! 2? 3+ 4" 5% 6= 7: 8/ 9_ 0\e,Lp\e(B -I .V
-;; ,\e,Lk\e(B \e,LC\e(B \e,L5\e(B \e,L8\e(B \e,LH\e(B \e,LI\e(B \e,L:\e(B \e,LA\e(B \e,L4\e(B \e,L7\e(B \e,LF\e(B ;\e,A'\e(B
-;; \e,Ll\e(B \e,LO\e(B \e,L0\e(B \e,L>\e(B \e,L6\e(B \e,L3\e(B \e,LB\e(B \e,L=\e(B \e,L2\e(B \e,L<\e(B \e,LG\e(B ()
-;; \e,LN\e(B \e,L9\e(B \e,LJ\e(B \e,LM\e(B \e,LD\e(B \e,LE\e(B \e,L?\e(B \e,L@\e(B \e,L;\e(B \e,L1\e(B
+;; 1! 2? 3+ 4" 5% 6= 7: 8/ 9_ 0\e$,1uV\e(B -I .V
+;; ,\e$,1(k\e(B \e$,1(C\e(B \e$,1(5\e(B \e$,1(8\e(B \e$,1(H\e(B \e$,1(I\e(B \e$,1(:\e(B \e$,1(A\e(B \e$,1(4\e(B \e$,1(7\e(B \e$,1(F\e(B ;\e,A'\e(B
+;; \e$,1(l\e(B \e$,1(O\e(B \e$,1(0\e(B \e$,1(>\e(B \e$,1(6\e(B \e$,1(3\e(B \e$,1(B\e(B \e$,1(=\e(B \e$,1(2\e(B \e$,1(<\e(B \e$,1(G\e(B ()
+;; \e$,1(N\e(B \e$,1(9\e(B \e$,1(J\e(B \e$,1(M\e(B \e$,1(D\e(B \e$,1(E\e(B \e$,1(?\e(B \e$,1(@\e(B \e$,1(;\e(B \e$,1(1\e(B
(quail-define-rules
("9" ?9)
("(" ?_)
("0" ?0)
- (")" ?\e,Lp\e(B)
+ (")" ?\e$,1uV\e(B)
("-" ?-)
("_" ?I)
("=" ?.) ("+" ?V)
- ("q" ?,) ("Q" ?\e,Lk\e(B)
- ("w" ?\e,Lc\e(B) ("W" ?\e,LC\e(B)
- ("e" ?\e,LU\e(B) ("E" ?\e,L5\e(B)
- ("r" ?\e,LX\e(B) ("R" ?\e,L8\e(B)
- ("t" ?\e,Lh\e(B) ("T" ?\e,LH\e(B)
- ("y" ?\e,Li\e(B) ("Y" ?\e,LI\e(B)
- ("u" ?\e,LZ\e(B) ("U" ?\e,L:\e(B)
- ("i" ?\e,La\e(B) ("I" ?\e,LA\e(B)
- ("o" ?\e,LT\e(B) ("O" ?\e,L4\e(B)
- ("p" ?\e,LW\e(B) ("P" ?\e,L7\e(B)
- ("[" ?\e,Lf\e(B) ("{" ?\e,LF\e(B)
+ ("q" ?,) ("Q" ?\e$,1(k\e(B)
+ ("w" ?\e$,1(c\e(B) ("W" ?\e$,1(C\e(B)
+ ("e" ?\e$,1(U\e(B) ("E" ?\e$,1(5\e(B)
+ ("r" ?\e$,1(X\e(B) ("R" ?\e$,1(8\e(B)
+ ("t" ?\e$,1(h\e(B) ("T" ?\e$,1(H\e(B)
+ ("y" ?\e$,1(i\e(B) ("Y" ?\e$,1(I\e(B)
+ ("u" ?\e$,1(Z\e(B) ("U" ?\e$,1(:\e(B)
+ ("i" ?\e$,1(a\e(B) ("I" ?\e$,1(A\e(B)
+ ("o" ?\e$,1(T\e(B) ("O" ?\e$,1(4\e(B)
+ ("p" ?\e$,1(W\e(B) ("P" ?\e$,1(7\e(B)
+ ("[" ?\e$,1(f\e(B) ("{" ?\e$,1(F\e(B)
("]" ?\;)
("}" ?\e,A'\e(B) ;; not in XKB's bg
- ("a" ?\e,Ll\e(B) ("A" ?\e,LL\e(B)
- ("s" ?\e,Lo\e(B) ("S" ?\e,LO\e(B)
- ("d" ?\e,LP\e(B) ("D" ?\e,L0\e(B)
- ("f" ?\e,L^\e(B) ("F" ?\e,L>\e(B)
- ("g" ?\e,LV\e(B) ("G" ?\e,L6\e(B)
- ("h" ?\e,LS\e(B) ("H" ?\e,L3\e(B)
- ("j" ?\e,Lb\e(B) ("J" ?\e,LB\e(B)
- ("k" ?\e,L]\e(B) ("K" ?\e,L=\e(B)
- ("l" ?\e,LR\e(B) ("L" ?\e,L2\e(B)
- (";" ?\e,L\\e(B) (":" ?\e,L<\e(B)
- ("'" ?\e,Lg\e(B) ("\"" ?\e,LG\e(B)
+ ("a" ?\e$,1(l\e(B) ("A" ?\e$,1(L\e(B)
+ ("s" ?\e$,1(o\e(B) ("S" ?\e$,1(O\e(B)
+ ("d" ?\e$,1(P\e(B) ("D" ?\e$,1(0\e(B)
+ ("f" ?\e$,1(^\e(B) ("F" ?\e$,1(>\e(B)
+ ("g" ?\e$,1(V\e(B) ("G" ?\e$,1(6\e(B)
+ ("h" ?\e$,1(S\e(B) ("H" ?\e$,1(3\e(B)
+ ("j" ?\e$,1(b\e(B) ("J" ?\e$,1(B\e(B)
+ ("k" ?\e$,1(]\e(B) ("K" ?\e$,1(=\e(B)
+ ("l" ?\e$,1(R\e(B) ("L" ?\e$,1(2\e(B)
+ (";" ?\e$,1(\\e(B) (":" ?\e$,1(<\e(B)
+ ("'" ?\e$,1(g\e(B) ("\"" ?\e$,1(G\e(B)
("`" ?\() ("~" ?\))
- ("z" ?\e,Ln\e(B) ("Z" ?\e,LN\e(B)
- ("x" ?\e,LY\e(B) ("X" ?\e,L9\e(B)
- ("c" ?\e,Lj\e(B) ("C" ?\e,LJ\e(B)
- ("v" ?\e,Lm\e(B) ("V" ?\e,LM\e(B)
- ("b" ?\e,Ld\e(B) ("B" ?\e,LD\e(B)
- ("n" ?\e,Le\e(B) ("N" ?\e,LE\e(B)
- ("m" ?\e,L_\e(B) ("M" ?\e,L?\e(B)
- ("," ?\e,L`\e(B) ("<" ?\e,L@\e(B)
- ("." ?\e,L[\e(B) (">" ?\e,L;\e(B)
- ("/" ?\e,LQ\e(B) ("?" ?\e,L1\e(B)
- ("\\" ?') ("|" ?\e,LK\e(B))
+ ("z" ?\e$,1(n\e(B) ("Z" ?\e$,1(N\e(B)
+ ("x" ?\e$,1(Y\e(B) ("X" ?\e$,1(9\e(B)
+ ("c" ?\e$,1(j\e(B) ("C" ?\e$,1(J\e(B)
+ ("v" ?\e$,1(m\e(B) ("V" ?\e$,1(M\e(B)
+ ("b" ?\e$,1(d\e(B) ("B" ?\e$,1(D\e(B)
+ ("n" ?\e$,1(e\e(B) ("N" ?\e$,1(E\e(B)
+ ("m" ?\e$,1(_\e(B) ("M" ?\e$,1(?\e(B)
+ ("," ?\e$,1(`\e(B) ("<" ?\e$,1(@\e(B)
+ ("." ?\e$,1([\e(B) (">" ?\e$,1(;\e(B)
+ ("/" ?\e$,1(Q\e(B) ("?" ?\e$,1(1\e(B)
+ ("\\" ?') ("|" ?\e$,1(K\e(B))
;; Local Variables:
;; coding: iso-2022-7bit
;;; 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)
- (make-variable-frame-local 'quail-indian-update-preceding-char)
-
- ;; 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)
-;;; update function
-
-;; CONTROL-FLAG is integer (n)
-;; quail-current-key :: keyboard input.
-;; Only first n can be translated.
-;; quail-current-string :: corresonding string. Translated when last
-;; time CONTROL-FLAG is nil.
-;; todo :: (1) put last (len-n) char to unrread-command-event.
-;; (2) put translated string to quail-current-string.
-;;
-;; CONTROL-FLAG is t (terminate) or nil (proceed the translation)
-;; quail-current-key :: keyboard input.
-;; quail-current-string :: corresponding string. Created by database.
-;; todo :: (1) put modified translated string to quail-current-string.
-
;;;
;;; 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)
indian-dev-aiba-hash "devanagari-aiba" "Devanagari" "DevAB"
"Devanagari transliteration by Aiba-method.")
+(if nil
+ (quail-define-package "punjabi-itrans" "Punjabi" "PnjIT" t "Punjabi ITRANS"))
+(quail-define-indian-trans-package
+ indian-pnj-itrans-v5-hash "punjabi-itrans" "Punjabi" "PnjIT"
+ "Punjabi transliteration by ITRANS method.")
+
+(if nil
+ (quail-define-package "gujarati-itrans" "Gujarati" "GjrIT" t "Gujarati ITRANS"))
+(quail-define-indian-trans-package
+ indian-gjr-itrans-v5-hash "gujarati-itrans" "Gujarati" "GjrIT"
+ "Gujarati transliteration by ITRANS method.")
+
+(if nil
+ (quail-define-package "oriya-itrans" "Oriya" "OriIT" t "Oriya ITRANS"))
+(quail-define-indian-trans-package
+ indian-ori-itrans-v5-hash "oriya-itrans" "Oriya" "OriIT"
+ "Oriya transliteration by ITRANS method.")
+
+(if nil
+ (quail-define-package "bengali-itrans" "Bengali" "BngIT" t "Bengali ITRANS"))
+(quail-define-indian-trans-package
+ indian-bng-itrans-v5-hash "bengali-itrans" "Bengali" "BngIT"
+ "Bengali transliteration by ITRANS method.")
+
+(if nil
+ (quail-define-package "assamese-itrans" "Assamese" "AsmIT" t "Assamese ITRANS"))
+(quail-define-indian-trans-package
+ indian-asm-itrans-v5-hash "assamese-itrans" "Assamese" "AsmIT"
+ "Assamese transliteration by ITRANS method.")
+
+(if nil
+ (quail-define-package "telugu-itrans" "Telugu" "TlgIT" t "Telugu ITRANS"))
+(quail-define-indian-trans-package
+ indian-tlg-itrans-v5-hash "telugu-itrans" "Telugu" "TlgIT"
+ "Telugu transliteration by ITRANS method.")
+
+(if nil
+ (quail-define-package "kannada-itrans" "Kannada" "KndIT" t "Kannada ITRANS"))
+(quail-define-indian-trans-package
+ indian-knd-itrans-v5-hash "kannada-itrans" "Kannada" "KndIT"
+ "Kannada transliteration by ITRANS method.")
+
+(if nil
+ (quail-define-package "malayalam-itrans" "Malayalam" "MlmIT" t "Malayalam ITRANS"))
+(quail-define-indian-trans-package
+ indian-mlm-itrans-v5-hash "malayalam-itrans" "Malayalam" "MlmIT"
+ "Malayalam transliteration by ITRANS method.")
+
+(if nil
+ (quail-define-package "tamil-itrans" "Tamil" "TmlIT" t "Tamil ITRANS"))
+(quail-define-indian-trans-package
+ indian-tml-itrans-v5-hash "tamil-itrans" "Tamil" "TmlIT"
+ "Tamil transliteration by ITRANS method.")
+
+
;;;
;;; Input by Inscript
;;;
(setq char-table (quail-indian-flatten-list char-table))
(setq key-table (quail-indian-flatten-list key-table))
(funcall 'quail-define-package pkgname lang title nil docstring
- nil nil nil nil nil nil nil nil
- 'quail-indian-update-translation)
+ nil nil nil nil nil nil nil nil)
(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 (characterp key) (char-to-string key) key)
(if (stringp val) (vector val) val))))))
;;
"devanagari-inscript" "Devanagari" "DevIS"
"Devanagari keyboard Inscript.")
+(if nil
+ (quail-define-package "punjabi-inscript" "Punjabi" "PnjIS" t "Punjabi keyboard Inscript"))
+(quail-define-inscript-package
+ indian-pnj-base-table inscript-dev-keytable
+ "punjabi-inscript" "Punjabi" "PnjIS"
+ "Punjabi keyboard Inscript.")
+
+(if nil
+ (quail-define-package "gujarati-inscript" "Gujarati" "GjrIS" t "Gujarati keyboard Inscript"))
+(quail-define-inscript-package
+ indian-gjr-base-table inscript-dev-keytable
+ "gujarati-inscript" "Gujarati" "GjrIS"
+ "Gujarati keyboard Inscript.")
+
+(if nil
+ (quail-define-package "oriya-inscript" "Oriya" "OriIS" t "Oriya keyboard Inscript"))
+(quail-define-inscript-package
+ indian-ori-base-table inscript-dev-keytable
+ "oriya-inscript" "Oriya" "OriIS"
+ "Oriya keyboard Inscript.")
+
+(if nil
+ (quail-define-package "bengali-inscript" "Bengali" "BngIS" t "Bengali keyboard Inscript"))
+(quail-define-inscript-package
+ indian-bng-base-table inscript-dev-keytable
+ "bengali-inscript" "Bengali" "BngIS"
+ "Bengali keyboard Inscript.")
+
+(if nil
+ (quail-define-package "assamese-inscript" "Assamese" "AsmIS" t "Assamese keyboard Inscript"))
+(quail-define-inscript-package
+ indian-asm-base-table inscript-dev-keytable
+ "assamese-inscript" "Assamese" "AsmIS"
+ "Assamese keyboard Inscript.")
+
+(if nil
+ (quail-define-package "telugu-inscript" "Telugu" "TlgIS" t "Telugu keyboard Inscript"))
+(quail-define-inscript-package
+ indian-dev-base-table inscript-dev-keytable
+ "telugu-inscript" "Telugu" "TlgIS"
+ "Telugu keyboard Inscript.")
+
+(if nil
+ (quail-define-package "kannada-inscript" "Kannada" "KndIS" t "Kannada keyboard Inscript"))
+(quail-define-inscript-package
+ indian-knd-base-table inscript-dev-keytable
+ "kannada-inscript" "Kannada" "KndIS"
+ "Kannada keyboard Inscript.")
+
+(if nil
+ (quail-define-package "malayalam-inscript" "Malayalam" "MlmIS" t "Malayalam keyboard Inscript"))
+(quail-define-inscript-package
+ indian-mlm-base-table inscript-dev-keytable
+ "malayalam-inscript" "Malayalam" "MlmIS"
+ "Malayalam keyboard Inscript.")
+
+(if nil
+ (quail-define-package "tamil-inscript" "Tamil" "TmlIS" t "Tamil keyboard Inscript"))
+(quail-define-inscript-package
+ indian-tml-base-table inscript-dev-keytable
+ "tamil-inscript" "Tamil" "TmlIS"
+ "Tamil keyboard Inscript.")
+
;;; indian.el ends here
- ;;; 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 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
| 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 would be natural to use comma for cedillas, but that would be
inconvenient in practice because commas are needed very often after 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)
+ ("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 would be natural to use period and comma for dots/rings and
cedillas/ogoneks, but that would 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 would be natural to use period and comma for dots and
cedillas/ogoneks, but that would 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 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,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-alt-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-alt-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-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^"])
"german-alt-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-alt-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-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
"norwegian-alt-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 Swidish, 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-alt-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)
- ("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'" ?ú)
+ ("N~" ?Ñ)
+ ("n~" ?ñ)
+ ("?/" ?¿)
+ ("!/" ?¡)
("A''" ["A'"])
("a''" ["a'"])
(quail-define-package
"swedish-alt-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"])
)
(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.
+ "turkish-alt-postfix" "Turkish" "TR«" t
+ "Turkish (Türkçe) 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-alt-postfix\" instead.
-turkish-latin-3-alt-postfix is an obsolete alisa for turkish-alt-postfix.
++turkish-latin-3-alt-postfix is an obsolete alias for turkish-alt-postfix.
- Note for I, \e,C9\e(B, \e,C)\e(B, i.
+ Note for I, ı, İ, i.
- A^ -> \e,CB\e(B
- C` -> \e,CG\e(B
- G^ -> \e,C+\e(B
+ A^ -> Â
+ C` -> Ç
+ G^ -> Äž
I -> I
- i -> \e,C9\e(B
- I/ -> \e,C)\e(B
+ i -> ı
+ I/ -> Ä°
i/ -> i
- O\" -> \e,CV\e(B
- S` -> \e,C*\e(B
- U\" -> \e,C\\e(B
- U^ -> \e,C[\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,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)
+ ("A^" ?Â)
+ ("a^" ?â)
+ ("C`" ?Ç)
+ ("c`" ?ç)
+ ("G^" ?Äž)
+ ("g^" ?ÄŸ)
+ ("I/" ?Ä°)
+ ("i" ?ı)
("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)
+ ("O\"" ?Ö)
+ ("o\"" ?ö)
+ ("S`" ?Åž)
+ ("s`" ?ÅŸ)
+ ("U\"" ?Ü)
+ ("u\"" ?ü)
+ ("U^" ?Û)
+ ("u^" ?û)
("A^^" ["A^"])
("a^^" ["a^"])
("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.
-
- 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.
-
- 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
- I -> I
- i -> \e,M}\e(B
- I/ -> \e,M]\e(B
- i/ -> i
- O\" -> \e,MV\e(B
- S` -> \e,M^\e(B
- U\" -> \e,M\\e(B
- U^ -> \e,M[\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,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)
- ("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)
-
- ("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^"])
- )
+ ;; 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
++ ("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
- "Latin character input method with postfix modifiers
+ "Latin character input method with postfix modifiers.
+This is the union of various input methods originally made for input
+of characters from a single Latin-N charset.
| 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 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2002 Free Software Foundation, Inc.
++;; Licensed to the Free Software Foundation.
+;; Copyright (C) 2001, 2002 Free Software Foundation.
++;; 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 Swidish, 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)
+ ("+" ?¿)
+ ("~" ?Ã)
+ ("{" ?É)
+ ("}" ?Ó)
+ (":" ?Ñ)
+ ("\"" ?Ã)
+ ("|" ?Ú)
("<" ?\;)
(">" ?:)
("?" ?_)
("?" ?Z)
)
-
(quail-define-package
"latin-postfix" "Latin" "L<" t
- "Latin character input method with postfix modifiers
+ "Latin character input method with postfix modifiers.
+This is the union of various input methods originally made for input
+of characters from a single Latin-N charset.
| 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~" ?ž)
("!//" ["!/"])
("///" ["//"])
("z~~" ["z~"])
)
- ("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))
+;; Derived from Slovenian.kmap from Yudit
+;; attributed as: 2001-11-11 Roman Maurer <roman.maurer@amis.net>
+(quail-define-package
+ "slovenian" "Slovenian" "Sl" t
+ "Slovenian postfix input."
+ nil t t t nil nil nil nil nil nil t)
+
+(quail-define-rules
++ ("C<" ?Č)
++ ("C'" ?Ć)
++ ("D;" ?Ä)
++ ("S<" ?Å )
++ ("Z<" ?Ž)
++ ("c<" ?Ä)
++ ("c'" ?ć)
++ ("d;" ?Ä‘)
++ ("s<" ?Å¡)
++ ("z<" ?ž))
+
;;; 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 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
;;; Commentary:
;; Key translation maps were originally copied from iso-acc.el.
-;; latin-1-prefix: extra special characters added, adapted from the vim
+;; latin-1-prefix: extra special characters added, adapted from the vim
;; digraphs (from J.H.M.Dassen <jdassen@wi.leidenuniv.nl>)
;; 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>
+;; You might make extra input sequences on the basis of the X
+;; locale/*/Compose files (which have both prefix and postfix
+;; sequences), but bear in mind that sequences which are logical in
+;; that context may not be sensible when they're not signalled with
+;; the Compose key. An example is a double space for NBSP.
+
;;; Code:
(require 'quail)
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)
- ("/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)
+ ("_+" ?±)
+ ("_y" ?Â¥)
+ ("_:" ?÷)
+ ("/c" ?¢)
+ ("/\\" ?×)
+ ("/2" ?½)
+ ("/4" ?¼)
+ ("/3" ?¾)
+ ("~s" ?§)
+ ("~p" ?¶)
+ ("~x" ?¤)
+ ("~." ?·)
+ ("~$" ?£)
+ ("~u" ?µ)
+ ("^r" ?®)
+ ("^c" ?©)
+ ("^1" ?¹)
+ ("^2" ?²)
+ ("^3" ?³)
+ ("~-" ?Â)
+ ("~|" ?¦)
+ ("/=" ?¬)
+ ("~=" ?¯)
- ("_ " ? ) ; nbsp
)
(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 | ~ / . | ~o -> Ä¡ /o -> Ä¡ .o -> Ä¡
++ 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" ?Ñ)
- ("~O" ?Õ)
+ ("~c" ?ç)
+ ("~n" ?ñ)
- ("~o" ?õ)
+ ("~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-package
"polish-slash" "Polish" "PL>" nil
- "Polish diacritics are input as `/[acelnosxzACELNOSXZ]'.
+ "Polish diacritics and slash character are input as `/[acelnosxzACELNOSXZ/]'.
For example, the character named `aogonek' is obtained by `/a'."
nil t t t nil nil nil nil nil nil t)
(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))
+ ("//" ?/)
- ("/o" ?ó)
+ ("/a" ?Ä…)
+ ("/c" ?ć)
+ ("/e" ?Ä™)
+ ("/l" ?Å‚)
+ ("/n" ?Å„)
- ("/O" ?Ó)
++ ("/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)
- ("/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)
+ ("_o" ?º)
+ ("_a" ?ª)
+ ("_+" ?±)
+ ("_y" ?Â¥)
+ ("_:" ?÷)
+ ("/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.
+;; 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
"Latin characters input method with prefix modifiers.
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" ?ž)
+ ("~|" ?¦)
+ ("~~" ?¸)
)
-
;;; latin-pre.el ends here
- ;;; 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 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
(load "quail/Punct-b5")
(quail-define-package
- "chinese-py-punct-b5" "Chinese-BIG5" "\e$AF47{\e(B"
+ "chinese-py-punct-b5" "Chinese-BIG5" "\e$(03<>K\e(B"
t
"\e$(0&d'GTT&,!J3<5x!K\e(B and `v' for \e$(0O:X5>KHATT&,\e(B
- ;;; thai.el --- Quail package for inputting Thai characters
+ ;;; thai.el --- Quail package for inputting Thai characters -*-coding: iso-2022-7bit;-*-
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
;;; Code:
(require 'quail)
- (require 'thai-util)
-
- (defun quail-thai-update-translation (control-flag)
- (if (integerp control-flag)
- ;; Non-composable character typed.
- (setq quail-current-str
- (buffer-substring (overlay-start quail-overlay)
- (overlay-end quail-overlay))
- unread-command-events
- (string-to-list
- (substring quail-current-key control-flag)))
- (setq quail-current-str
- (compose-string (quail-lookup-map-and-concat quail-current-key))))
- control-flag)
-
- (defun thai-generate-quail-map (translation-table)
- (let ((i 0)
- consonant vowel tone voweltone others)
- ;; Categorize Thai characters into one of above.
- (while (< i 128)
- (let ((trans (aref translation-table i))
- ptype)
- (if (eq trans 0)
- nil
- (if (> (length trans) 1)
- (setq ptype 'voweltone
- trans (vector (compose-string trans)))
- (setq ptype (get-char-code-property (aref trans 0) 'phonetic-type))
- (cond ((memq ptype '(vowel-upper vowel-lower))
- (setq ptype 'vowel))
- ((not (memq ptype '(consonant tone)))
- (setq ptype 'others))))
- (set ptype (cons (cons (char-to-string i) trans)
- (symbol-value ptype)))))
- (setq i (1+ i)))
-
- (quail-map-from-table
- '((base-state (consonant . vt-state)
- vowel tone voweltone others)
- (vt-state (vowel . t-state)
- voweltone tone)
- (t-state tone)))))
+
-
+ (defmacro thai-generate-quail-map (translation-table)
+ (let (map)
+ (dotimes (i (length translation-table))
+ (let ((trans (aref translation-table i)))
+ (when (not (eq trans 0))
+ (if (> (length trans) 1)
+ (setq trans (vector trans))
+ (setq trans (aref trans 0)))
+ (setq map (cons (list (char-to-string i) trans) map)))))
+ `(quail-define-rules ,@map)))
;; Thai Kesmanee keyboard support.
'\e,T_\e(B' and '\e,To\e(B' are assigned to '\\' and '|' respectively,
'\e,T#\e(B' and '\e,T%\e(B' are assigned to '`' and '~' respectively,
Don't know where to assign characters '\e,Tz\e(B' and '\e,T{\e(B'."
- nil t t t t nil nil nil 'quail-thai-update-translation 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,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
- ]))
-
+ nil t t t t nil nil nil nil nil t)
+
+ (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,TF\e(B" "\e,Tr\e(B" "\e,Ts\e(B" "\e,Tt\e(B" "\e,TQi\e(B" "\e,T'\e(B" ; SPC .. '
++ 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
++ "\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
+ ])
-
\f
;; Thai Pattachote keyboard support.
(quail-define-package
"thai-pattachote" "Thai" "\e,T!;\e(B>" t
"Thai Pattachote input method with TIS620 keyboard layout"
- nil t t t t nil nil nil 'quail-thai-update-translation 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
- ]))
+ nil t t t t nil nil nil nil nil t)
+
+ (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 .. '
++ 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.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) 1995 Free Software Foundation, Inc.
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
("O" . "T") ; Ta
("p" . "th") ; tha
("P" . "TH") ; THa
- ("[" . "d") ; da
+ ("[" . "d") ; da
("{" . "D") ; Da
("]" . "n") ; na
("}" . "N") ; Na
("hO" . "+T") ; Ta
("hp" . "+th") ; tha
("hP" . "+TH") ; THa
- ("h[" . "+d") ; da
+ ("h[" . "+d") ; da
("h{" . "+D") ; Da
("h]" . "+n") ; na
("h}" . "+N") ; Na
- ("ha" . "+p") ; pa
+ ("ha" . "+p") ; pa
("hs" . "+ph") ; pha
("hd" . "+b") ; ba
("hf" . "+m") ; ma
("(" . "\e$(7!l\e(B")
("0" . "\e$(7!P\e(B")
(")" . "\e$(7!m\e(B")
-;;; ("-" ) ; enphatic, not yet supported
+;;; ("-" ) ; enphatic, not yet supported
;;; ("_" ) ; id.
;;; ("=" ) ; special sign, not yet supported
("+" . "\e$(7!A\e(B")
|A |S |D |F\e$(7"_\e(B|G\e$(7"S\e(B|H\e$(7"e\e(B|J\e$(7"[\e(B|K |L |:\e$(7"`\e(B|\"\e$(7#>\e(B|
+-------------------------------------------+
|Z |X |C\e$(7"R\e(B|V\e$(7#B\e(B|B\e$(7#C\e(B|N\e$(7#D\e(B|M\e$(7"F\e(B|< |> |?\e$(7!=\e(B |
- +---------------------------------------+
+ +---------------------------------------+
DIFFERENCE FROM THE ORIGINAL TIBKEY:
;;; 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."
++ "Welsh postfix input method"
nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
;; "hawlfraint" (copyright). Dyma arwyddlun hawlfraint.
("(h)" ?\e$,1\7fW\e(B))
+;; (quail-define-package
+;; "welsh" "Welsh" "\e$,1!4\e(B" t
+;; "Welsh postfix input method, using Latin-8"
+;; 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,AB\e(B)
+;; ("A\"" ?\e,AD\e(B)
+;; ("a\\" ?\e,A`\e(B)
+;; ("a/" ?\e,Aa\e(B)
+;; ("a^" ?\e,Ab\e(B)
+;; ("a+" ?\e,Ab\e(B)
+;; ("a\"" ?\e,Ad\e(B)
+
+;; ("E\\" ?\e,AH\e(B)
+;; ("E/" ?\e,AI\e(B)
+;; ("E^" ?\e,AJ\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,Aj\e(B)
+;; ("e\"" ?\e,Ak\e(B)
+
+;; ("I\\" ?\e,AL\e(B)
+;; ("I/" ?\e,AM\e(B)
+;; ("I^" ?\e,AN\e(B)
+;; ("I+" ?\e,AN\e(B)
+;; ("I\"" ?\e,AO\e(B)
+;; ("i\\" ?\e,Al\e(B)
+;; ("i/" ?\e,Am\e(B)
+;; ("i^" ?\e,An\e(B)
+;; ("i+" ?\e,An\e(B)
+;; ("i\"" ?\e,Ao\e(B)
+
+;; ("O\\" ?\e,AR\e(B)
+;; ("O/" ?\e,AS\e(B)
+;; ("O^" ?\e,AT\e(B)
+;; ("O+" ?\e,AT\e(B)
+;; ("O\"" ?\e,AV\e(B)
+;; ("o\\" ?\e,Ar\e(B)
+;; ("o/" ?\e,As\e(B)
+;; ("o^" ?\e,At\e(B)
+;; ("o+" ?\e,At\e(B)
+;; ("o\"" ?\e,Av\e(B)
+
+;; ("U\\" ?\e,AY\e(B)
+;; ("U/" ?\e,AZ\e(B)
+;; ("U^" ?\e,A[\e(B)
+;; ("U+" ?\e,A[\e(B)
+;; ("U\"" ?\e,A\\e(B)
+;; ("u\\" ?\e,Ay\e(B)
+;; ("u/" ?\e,Az\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^\e(B)
+;; ("Y+" ?\e,A^\e(B)
+;; ("Y\"" ?\e,A/\e(B)
+;; ("y\\" ?\e,A<\e(B)
+;; ("y/" ?\e,A}\e(B)
+;; ("y\"" ?\e,A\7f\e(B)
+;; ("y^" ?\e,A~\e(B)
+;; ("y+" ?\e,A~\e(B)
+
+;; ("W\\" ?\e,A(\e(B)
+;; ("W/" ?\e,A*\e(B)
+;; ("W^" ?\e,AP\e(B)
+;; ("W+" ?\e,AP\e(B)
+;; ("W\"" ?\e,A=\e(B)
+;; ("w\\" ?\e,A8\e(B)
+;; ("w/" ?\e,A:\e(B)
+;; ("w^" ?\e,Ap\e(B)
+;; ("w+" ?\e,Ap\e(B)
+;; ("w\"" ?\e,A>\e(B))
+
+
;;; welsh.el ends here
--- /dev/null
--- /dev/null
++2003-06-23 Kenichi Handa <handa@m17n.org>
++
++ * international/mule-conf.el (utf-16-be): Make it an alias of
++ utf-16be-with-signature.
++ (utf-16-le): Make it an alias of utf-16le-with-signature.
++ (utf-16-be-with-signature, utf-16-le-with-signature): Remove these
++ coding system aliases.
++
++ * international/utf-7.el (utf-7-decode, utf-7-encode): Use
++ utf-16be, not utf-16-be.
++
++2003-06-06 Kenichi Handa <handa@m17n.org>
++
++ * international/mule.el (coding-system-category): New function.
++ (set-coding-priority): Re-written.
++ (make-translation-table): Re-written.
++
++ * international/mule-cmds.el (universal-coding-system-argument):
++ Check the coding system type `undecided', not `t'.
++ (sort-coding-systems): Fix for iso-2022 coding systems.
++ (find-multibyte-characters): Fix for eight-bit chars.
++ (set-language-environment): Set charset priorities according to
++ the charsets supported by the coding systems of higher priorities.
++
++2003-06-05 Kenichi Handa <handa@m17n.org>
++
++ * font-lock.el
++ (font-lock-match-c-style-declaration-item-and-skip-to-next):
++ Check (match-end 2) before goto there.
++
++2003-05-30 Kenichi Handa <handa@m17n.org>
++
++ * international/mule.el (ctext-non-standard-designations-alist):
++ Exclude entries for iso8859-1[03456]. Fix docstring.
++ (ctext-pre-write-conversion): Make it work for the case that FROM
++ is a string. Don't do unnecessary save-restriction and
++ narrow-to-region.
++
++2003-05-28 Kenichi Handa <handa@m17n.org>
++
++ * international/mule.el (ctext-non-standard-encodings-alist):
++ Renamed from non-standard-icccm-encodings-alist.
++ (ctext-non-standard-encodings-regexp): New variable
++ (ctext-post-read-conversion): Full rewrite.
++ (ctext-non-standard-designations-alist): Renamed from
++ non-standard-designations-alist.
++ (ctext-pre-write-conversion): Full rewrite.
++ (define-coding-system): Doc fix (escape '"' by '\').
++
++2003-05-24 Dave Love <fx@gnu.org>
++
++ * international/mule-conf.el (utf-16le, utf-16be-16be)
++ (utf-16le-with-signature, utf-16be-with-signature, utf-16):
++ Define :mime-text-unsuitable. `utf-16{b,l}e...' renamed from
++ `-16-{b,l}e-' and aliases defined for the old names.
++
++ * international/mule.el (define-coding-system): Doc fix.
++
++2003-05-08 Dave Love <fx@gnu.org>
++
++ * international/utf-7.el: New file.
++
++ * international/mule-conf.el (utf-7): New.
++
++2003-05-06 Kenichi Handa <handa@m17n.org>
++
++ * international/mule-conf.el (utf-16-be)
++ (utf-16-be-with-signature): Cancel the previous change.
++ (utf-16): Add :endinan 'big.
++
++ * international/mule.el (define-coding-system): Fix docstring
++ about :bom and :endian.
++
++2003-04-30 Dave Love <fx@gnu.org>
++
++ * mule-conf.el (utf-16-be)
++ (utf-16-be-with-signature): Comment-out :endian.
++
++ * mule-diag.el (describe-character-set): Fix
++ printing dimensions. Use `\e,AW\e(B', not `x'.
++
++2003-04-12 Kenichi Handa <handa@m17n.org>
++
++ * international/fontset.el: Register CDAC fonts in
++ face-font-rescale-alist instead of face-resizing-fonts.
++
++2003-03-28 Kenichi Handa <handa@m17n.org>
++
++ * international/mule-conf.el (utf-16-le): Renamed from
++ utf-16-le-nosig.
++ (utf-16-be): Renamed from utf-16-be-nosig.
++ (utf-16-le-with-signature): Renamed from utf-16-le.
++ (utf-16-be-with-signature): Renamed from utf-16-be.
++ (utf-16): Set :bom to (utf-16-le-with-signature .
++ utf-16-be-with-signature).
++
++2003-02-12 Dave Love <fx@gnu.org>
++
++ * language/georgian.el (georgian-ps, georgian-academy): New coding
++ system.
++
++ * language/chinese.el (chinese-big5-hkscs): New coding system.
++ (big5-hkscs, cn-big5-hkscs): New aliases.
++
++ * international/mule-conf.el (big5-hkscs, georgian-academy): New
++ charset.
++ (ibm1047): Doc fix.
++ (pt154): Add mime-charset.
++ (ptcp154, cp154): New aliases.
++
++2003-02-04 Dave Love <fx@gnu.org>
++
++ * international/mule.el (charset-iso-final-char)
++ (define-coding-system): Doc fix.
++
++2003-01-30 Kenichi Handa <handa@m17n.org>
++
++ * international/ccl.el (define-ccl-program): Fset charset-id
++ to charset-id-internal temporarily.
++
++2003-01-21 Kenichi Handa <handa@m17n.org>
++
++ * international/mule-diag.el (list-block-of-chars): Use
++ decode-char instead of make-char.
++
++2003-01-10 Kenichi Handa <handa@m17n.org>
++
++ * international/fontset.el: Enable the default fontset to use
++ unicode fonts for ASCII characters.
++ (x-decompose-font-name): Don't try to resolve PATTERN by
++ x-resolve-font-name.
++ (x-complement-fontset-spec): Never prepend an ASCII font.
++ (create-fontset-from-fontset-spec): If a fontset of the same name
++ already exists, override it instead of signalling an error. Don't
++ turn `ascii' into `latin'. Don't update fontset-alias-alist here.
++
++ * international/mule-conf.el (unicode-bmp): Delete duplicated
++ definition. Give it :code-offset 0.
++
++ * international/mule-diag.el (print-fontset-element): New
++ function.
++ (print-fontset): Use print-fontset-element to print the elements
++ of a fontset. Use it also to print fonts fallen back to the
++ default fontsets.
++
++ * term/x-win.el: Delete the code to create a fontset from the X
++ resource "Font".
++
++2003-01-09 Kenichi Handa <handa@m17n.org>
++
++ * international/mule-diag.el (print-fontset): Insert proper
++ newline and indentation spaces.
++
++2003-01-07 Dave Love <fx@gnu.org>
++
++ * emacs-lisp/byte-opt.el (side-effect-free-fns): Add langinfo,
++ multibyte-char-to-unibyte.
++
++ * emacs-lisp/cl-macs.el (cl-make-type-test): Use characterp.
++
++ * international/mule-cmds.el (find-coding-systems-for-charsets):
++ Use coding-system-type, coding-system-charset-list.
++ (standard-keyboard-coding-systems): Deleted.
++ (set-locale-environment): Maybe set keyboard coding system. Avoid
++ typical warning about codeset in C locale.
++
++2003-01-06 Kenichi Handa <handa@etl.go.jp>
++
++ * international/fontset.el (x-complement-fontset-spec): If a
++ fontname doesn't conform to XLFD format, try to get XLFD name by
++ x-list-fonts.
++
++2002-12-08 Dave Love <fx@gnu.org>
++
++ * international/mule-conf.el (mik, pt154): New charsets.
++
++ * language/cyrillic.el (mik, pt154): New coding systems.
++
++2002-12-05 Dave Love <fx@gnu.org>
++
++ * international/characters.el: Move parts around so that syntax
++ definitions aren't overwritten wrongly.
++
++ * international/mule-diag.el (unicode-data): Fix treatment of
++ numeric-value fields.
++
++2002-12-01 Dave Love <fx@gnu.org>
++
++ * progmodes/cap-words.el: New file.
++
++2002-11-07 Kenichi Handa <handa@m17n.org>
++
++ The following changes are to make character composition happen
++ automatically on displaying.
++
++ * composite.el: Remove all autoload cookies.
++ (composition-function-table): Variable declaration moved from
++ composite.c. Format changed.
++ (save-buffer-state): Copied from font-lock.el.
++ (auto-composition-chunk-size): New variable.
++ (auto-compose-chars): New function. Set
++ auto-composition-function to it.
++ (toggle-auto-composition): New function.
++
++ * international/characters.el: Make all chararacters in the
++ charset tibetan to tibetan script.
++
++ * international/mule-conf.el (tibetan): Fix :code-space property.
++ (tibetan-1-column): Delete :superset property, add :code-offset
++ property.
++
++ * international/quail.el (quail-input-string-to-events): Don't
++ generate compose-chars-after events.
++
++ * language/devanagari.el: Register devanagari-composable-function
++ in composition-function-table for Devanagari characters.
++
++ * language/devan-util.el: Register devanagari-composable-pattern
++ in indian-composable-pattern.
++ (devanagari-composition-function): Add autoload cookie. Change
++ arguments to conform to composition-function-table.
++
++ * language/european.el: Register combining characters in
++ composition-function-table.
++ (diacritic-composition-function): Change arguments to conform to
++ composition-function-table.
++
++ * language/indian.el (indian-composable-pattern): New variable.
++
++ * language/ind-util.el (indian-compose-region): Don't call
++ compose-chars-after, instead call a function registered in
++ composition-function-table.
++
++ * language/lao.el: Register lao-composition-function in
++ composition-function-table for Lao vowels and tones.
++ (lao): Don't use lao-post-read-conversion.
++
++ * language/lao-util.el (lao-post-read-conversion): Delete this
++ function.
++ (lao-composition-function): Change arguments to conform to
++ composition-function-table.
++
++ * language/thai.el: Register thai-composition-function in
++ composition-function-table for Thai vowels and tones.
++ (thai-tis620): Don't use thai-post-read-conversion.
++
++ * language/thai-util.el (thai-post-read-conversion): Delete this
++ function.
++ (thai-composition-function): Change arguments to conform to
++ composition-function-table.
++
++ * language/tibetan.el: Register tibetan-composition-function in
++ composition-function-table for Tibetan characters.
++
++ * language/tibet-util.el (tibetan-composition-function): Change
++ arguments to conform to composition-function-table.
++
++ * loadup.el: Load composite.
++
++2002-11-01 Dave Love <fx@gnu.org>
++
++ * international/mule-diag.el (unicode-data): Find unicodedata-file
++ literally.
++
++2002-10-31 Dave Love <fx@gnu.org>
++
++ * international/fontset.el: Doc fixes.
++ ("fontset-default"): Add iso8859-15.
++
++2002-10-30 Kenichi Handa <handa@m17n.org>
++
++ * international/fontset.el ("fontset-default"): Add an entry for
++ `indian-is13194' charset.
++
++ * international/mule-conf.el (indian-is13194): Delete :unify-map
++ property. Don't unify this charset.
++ (indian-2-column): Delete :superset property, add :code-offset
++ property.
++
++ * language/devan-util.el: Delete the superfluous autoload cookie
++ near the head of the file.
++ (devanagari-compose-region): Add autoload cookie.
++
++ * language/ind-util.el (indian-2-column-to-ucs-region): Add
++ autoload cookie.
++
++2002-10-29 Kenichi Handa <handa@m17n.org>
++
++ * international/fontset.el ("fontset-default"): Add an entry for
++ `devanagari' script and `malayalam-glyph' charset.
++ (face-resizing-fonts): Register CDAC fonts.
++
++ * international/mule-conf.el (malayalam-glyph): New charset.
++
++2002-10-28 Dave Love <fx@gnu.org>
++
++ * term/x-win.el: Fix typo in loop setting x-keysym-table.
++
++2002-10-27 Dave Love <fx@gnu.org>
++
++ * international/mule-conf.el (utf-8-emacs): Delete :mime-charset.
++
++ * term/x-win.el: Remove some ancient compatibility code. Populate
++ x-keysym-table.
++
++ * international/mule-cmds.el (wid-edit): Require when compiling.
++ (set-locale-environment): Check locale against coding system
++ aliases too.
++
++2002-10-25 Kenichi Handa <handa@m17n.org>
++
++ * language/indian.el (in-is13194-devanagari): Fix
++ :post-read-conversion and :pre-write-conversion.
++
++2002-10-16 Dave Love <fx@gnu.org>
++
++ * international/mule-cmds.el (charset): Supply doc, :tag.
++
++2002-10-16 Kenichi Handa <handa@m17n.org>
++
++ * emacs-lisp/bytecomp.el (byte-compile-lapcode): Be sure to
++ return a unibyte string.
++
++2002-10-15 Kenichi Handa <handa@m17n.org>
++
++ * international/mule-cmds.el (set-locale-environment): Delete
++ superfluous ')'s at the tail.
++
++2002-10-14 Kenichi Handa <handa@etl.go.jp>
++
++ * international/mule.el (define-coding-system): Fix typo;
++ "docode" -> "decode".
++
++2002-10-14 Dave Love <fx@gnu.org>
++
++ * emacs-lisp/byte-opt.el (side-effect-free-fns): Add
++ string-make-unibyte string-make-multibyte string-to-multibyte
++ string-as-multibyte string-as-unibyte.
++
++2002-10-11 Dave Love <fx@gnu.org>
++
++ * language/english.el (ibm1047, cp1047): New.
++
++ * international/mule-conf.el (alternativnyj): Use new table.
++ (cp866): Define standalone, not as alias.
++ (ibm866): Change alias.
++ (ibm1047): New.
++
++ * language/cyrillic.el (cyrillic-alternativnyj): Remove
++ mime-charset. Use alternativnj charset.
++ (cp866): Remove alias. Define standalone.
++
++2002-10-09 Dave Love <fx@gnu.org>
++
++ * language/european.el ("Latin-2", "Latin-5"): Doc fix.
++
++ * language/cyrillic.el ("Bulgarian"): Fix input method and
++ charset.
++ ("Tajik", "Belarusian"): Fix charset.
++
++ * international/mule-cmds.el (describe-language-environment): Be
++ case-insensitive when looking for input methods.
++ (locale-name-match): Doc fix.
++ (locale-charset-match-p): New.
++ (set-locale-environment): Warn if coding system doesn't agree
++ with system locale.
++
++2002-10-09 Kenichi Handa <handa@m17n.org>
++
++ * international/mule-cmds.el (select-safe-coding-system): If
++ :mime-charset property of a coding system is not equal to that
++ coding system, don't show that :mime-charset name.
++
++2002-10-06 Dave Love <fx@gnu.org>
++
++ * international/quail.el (quail-help): Fix underlining.
++
++ * language/chinese.el (chinese-gb18030, gb18030)
++ ("Chinese-GB18030"): New.
++
++ * international/mule-cmds.el (locale-language-names): Add GB18030.
++
++ * international/swedish.el: Don't require latin-1.
++
++2002-10-05 Dave Love <fx@gnu.org>
++
++ * language/czech.el ("Czech"):
++ * language/slovak.el ("Slovak"):
++ * language/romanian.el ("Romanian"): Remove unibyte-syntax property.
++
++ * language/greek.el ("Greek"): Remove unibyte-syntax property.
++ (cp737): New coding system.
++
++ * language/european.el: Remove unibyte-syntax properties.
++ Augment some coding-system properties.
++
++ * international/mule-cmds.el (set-language-environment): Check
++ for charset property of environment.
++ (language-info-alist): Doc fix.
++
++ * Makefile.in (DONTCOMPILE): Remove latin-N.el.
++
++ * international/characters.el: Add Latin-1.
++
++ * international/latin-1, international/latin-2, international/latin-3:
++ * international/latin-4, international/latin-5, international/latin-8:
++ * international/latin-9: Deleted.
++
++ * loadup.el: Remove international/latin-N.el.
++
++ * case-table.el (set-case-syntax-charset, set-case-syntax-1)
++ (set-case-syntax-delims, set-case-syntax-pair, set-case-syntax):
++ Undo last changes.
++
++ * international/mule-diag.el (unicode-data): Check that
++ `unicodedata-file' exists.
++
++2002-10-05 Kenichi Handa <handa@m17n.org>
++
++ * international/fontset.el (charset-script-alist): Fix script
++ names.
++
++2002-10-01 Kenichi Handa <handa@m17n.org>
++
++ * international/latin-1.el: Bind set-case-syntax-charset to
++ iso-8859-1. Never provide latin-1.
++
++ * international/latin-2.el: Bind set-case-syntax-charset to
++ iso-8859-2. Never provide latin-2.
++
++ * international/latin-3.el: Bind set-case-syntax-charset to
++ iso-8859-3. Never provide latin-3.
++
++ * international/latin-4.el: Bind set-case-syntax-charset to
++ iso-8859-4. Never provide latin-4.
++
++ * international/latin-5.el: Bind set-case-syntax-charset to
++ iso-8859-9. Never provide latin-5.
++
++ * international/latin-8.el: Bind set-case-syntax-charset to
++ iso-8859-14. Never provide latin-8.
++
++ * international/latin-9.el: Bind set-case-syntax-charset to
++ iso-8859-15. Never provide latin-9.
++
++ * case-table.el (set-case-syntax-set-multibyte): This variable
++ deleted.
++ (set-case-syntax-charset): New variable.
++ (set-case-syntax-1): New function.
++ (set-case-syntax-delims, set-case-syntax-pair, set-case-syntax):
++ Call set-case-syntax-1 on arguments.
++
++ * international/mule-cmds.el (set-language-environment): Delete
++ unnecessary setup of syntax/case for unibyte case.
++
++2002-09-27 Kenichi Handa <handa@etl.go.jp>
++
++ * international/fontset.el (generate-fontset-menu): Exclude the
++ default fontset.
++
++ * faces.el (describe-face): Describe :fontset property too.
++
++2002-09-25 Dave Love <fx@gnu.org>
++
++ * international/characters.el: Fix last change.
++
++2002-09-23 Dave Love <fx@gnu.org>
++
++ * international/characters.el: Don't set char width of CJK
++ charsets generally. Add some non-word syntax cases.
++ (korean-ksc5601): Fix ranges with symbol syntax.
++
++2002-09-14 Dave Love <fx@gnu.org>
++
++ * Makefile.in (DONTCOMPILE): Add indian.el.
++
++ * language/ind-util.el:
++ (ucs-bengali-to-is13194-alist, ucs-assamese-to-is13194-alist)
++ (ucs-gurmukhi-to-is13194-alist, ucs-gujarati-to-is13194-alist)
++ (ucs-oriya-to-is13194-alist, ucs-tamil-to-is13194-alist)
++ (ucs-telugu-to-is13194-alist, ucs-malayalam-to-is13194-alist))):
++ Remove declarations and let-bind them in re-written top-level loop
++ over scripts, including ucs-devanagari-to-is13194-alist.
++
++2002-09-14 Dave Love <fx@gnu.org>
++
++ * international/mule-cmds.el (charset): Move.
++ (language-info-custom-alist): Move. Alter :set.
++ (find-coding-systems-for-charsets): Check charset type before
++ getting :charset-list.
++
++ * language/ind-util.el (iscii-to-ucs-region): Fix typo.
++
++2002-09-12 Kenichi Handa <handa@etl.go.jp>
++
++ * international/mule-conf.el (emacs-mule, iso-2022-7bit)
++ (iso-2022-7bit-ss2, iso-2022-7bit-lock, iso-2022-8bit-ss2)
++ (compound-text, ctext-no-compositions): Cancel provious change.
++
++2002-09-09 Dave Love <fx@gnu.org>
++
++ * wid-edit.el (widget-string-complete): New.
++ (widget-coding-system-prompt-value-history): Deleted.
++ (coding-system): Use coding-system-value-history.
++
++ * international/mule-cmds.el (charset): New widget.
++ (language-info-custom-alist): Use it.
++ (default-input-method): Modify :type.
++
++2002-09-08 Dave Love <fx@gnu.org>
++
++ * language/ind-util.el (ucs-devanagari-to-is13194-alist)
++ (indian-glyph-char, indian-char-glyph): Deleted.
++ (is13194-default-repertory): Renamed from
++ is13194-default-repartory,
++ (iscii-to-ucs-region): Hoist evals from loop.
++
++ * language/devan-util.el (dev-charseq): Avoid indian-glyph-char.
++
++ * language/indian.el (indian-script-table)
++ (ccl-encode-indian-glyph-font): Deleted.
++
++ * international/mule-conf.el (emacs-mule, iso-2022-7bit)
++ (iso-2022-7bit-ss2, iso-2022-7bit-lock, iso-2022-8bit-ss2)
++ (compound-text, ctext-no-compositions): Remove :charset-list.
++
++ * international/mule-cmds.el (language-info-custom-alist): New.
++ (input-method-activate-hook, input-method-inactivate-hook)
++ (input-method-after-insert-chunk-hook)
++ (input-method-use-echo-area, set-language-environment-hook)
++ (exit-language-environment-hook): Customize.
++ (find-coding-systems-for-charsets): Rewritten.
++ (default-input-method): Add :link.
++
++2002-09-08 Dave Love <fx@gnu.org>
++
++ * international/mule-conf.el (eight-bit): Add :docstring,
++ :short-name properties.
++ (cp851): Doc fix.
++ (unicode-bmp): New.
++
++ * case-table.el (set-case-syntax-pair): Remove check on byte
++ lengths.
++
++ * language/european.el (cp858): New.
++ ("Turkish"): Add special case rules.
++
++2002-09-05 Dave Love <fx@gnu.org>
++
++ * international/characters.el: Make \e$(D*s\e(B and \e$(D+s\e(B a case pair.
++
++2002-09-03 Kenichi Handa <handa@etl.go.jp>
++
++ * international/mule-conf.el: Don't define the charset iso-8859-1
++ here, just setup its properties.
++
++2002-08-21 Kenichi Handa <handa@etl.go.jp>
++
++ * international/mule-conf.el (utf-8): Give :mime-charset property.
++
++2002-08-20 Kenichi Handa <handa@etl.go.jp>
++
++ * international/characters.el: Remove duplicated case setting for
++ Cyrillic and Greek letters. Don't setup printable-chars here.
++
++ * case-table.el (describe-buffer-case-table): Handle the case
++ that KEY is a cons within map-char-table.
++
++2002-08-19 Kenichi Handa <handa@etl.go.jp>
++
++ * international/characters.el: Fix categories ?A and ?C. Treat
++ ASCII characters as `latin' script.
++
++2002-08-18 Kenichi Handa <handa@etl.go.jp>
++
++ * international/fontset.el (fontset-plain-name): If the fontset
++ name doesn't ends with "-fontset-*", use family name as the first
++ part of the plain name.
++ (create-fontset-from-ascii-font): If "fontset-startup" is not yet
++ created, use that name for the fontset. Fix arguments to
++ subst-char-in-string.
++
++2002-08-18 Dave Love <fx@gnu.org>
++
++ * term.el (term-char-mode): Remove generic-character-list code.
++
++ * ruler-mode.el (ruler-mode-character-validate): Use characterp.
++
++ * wid-edit.el (character): Use characterp.
++
++ * international/mule-diag.el (describe-coding-system): Add utf-16
++ case.
++
++ * language/viet-util.el (viet-encode-viscii-char): Use encode-char.
++
++ * language/cyrillic.el ("Tajik", "Bulgarian", "Belarusian"): Add
++ charset.
++ ("Ukrainian"): New.
++
++ * language/georgian.el (georgian-ps): New coding system.
++
++2002-08-15 Kenichi Handa <handa@etl.go.jp>
++
++ * international/mule-cmds.el (reset-language-environment): Don't
++ set nonascii-translation-table and nonascii-insert-offset. Call
++ set-unibyte-charset, not set-primary-charset.
++ (nonascii-translation-table, nonascii-insert-offset): Declare
++ these variable as obsolete ones.
++ (set-language-environment): Call set-unibyte-charset, not
++ set-primary-charset. Call set-charset-priority with `charset'
++ info of the language environment.
++
++2002-08-08 Kenichi Handa <handa@etl.go.jp>
++
++ * tar-mode.el (tar-extract): Fix previous change.
++
++2002-08-02 Kenichi Handa <handa@etl.go.jp>
++
++ * international/characters.el (next-word-boundary-han): Don't
++ treat katakana following han characters as a part of a word.
++
++2002-08-01 Kenichi Handa <handa@etl.go.jp>
++
++ * international/characters.el: Call map-charset-chars on big5
++ (not chinese-big5-1/2) to set categories `c', `C', and `|'.
++ (next-word-boundary-han): New function. Register it in
++ next-word-boundary-function-table.
++ (next-word-boundary-kana): Likewise.
++
++2002-07-31 Kenichi Handa <handa@etl.go.jp>
++
++ * arc-mode.el (archive-file-name-coding-system): New variable.
++ Make it permanent-local.
++ (byte-after, bref, insert-unibyte): New function. Change most of
++ char-after, aref, insert to them respectively.
++ (archive-mode): Set archive-file-name-coding-system.
++ (archive-summarize): Don't change the buffer's multibyteness.
++ (archive-extract): Inherit archive-file-name-coding-system from
++ archive-superior-buffer. Bind coding-system-for-write to
++ archive-file-name-coding-system.
++ (archive-*-write-file-member): Encode ENAME by
++ archive-file-name-coding-system. Bind coding-system-for-write to
++ no-conversion.
++ (archive-rename-entry): Encode the filename by
++ archive-file-name-coding-system.
++ (archive-mode-revert): Don't change the buffer's multibyteness.
++ (archive-arc-summarize, archive-lzh-summarize,
++ archive-zoo-summarize): Don't change the buffer's multibyteness.
++ Decode filenames by archive-file-name-coding-system.
++ (archive-arc-rename-entry, archive-zip-chmod-entry): Don't change
++ the buffer's multibyteness.
++
++ * tar-mode.el (tar-file-name-coding-system): New variable. Make
++ it permanent-local.p
++ (tar-header-block-tokenize): Decode filename and linkname by
++ tar-file-name-coding-system.
++ (tar-header-block-checksum): Call multibyte-char-to-unibyte to get
++ the byte value of eight-bit chars.
++ (tar-summarize-buffer): Call set-buffer-multibyte with METHOD
++ `to'. Delete unnecessary call of position-bytes.
++ (tar-mode): Set tar-file-name-coding-system. Delete unnecessary
++ call of position-bytes.
++ (tar-extract): Simplified by calling decode-coding-region with
++ DESTINATION argument. Don't toggle multibyteness of tar buffer.
++ (tar-copy): Don't toggle multibyteness of tar buffer.
++ (tar-expunge): Likewise.
++ (tar-clear-modification-flags): Delete unnecessary call of
++ position-bytes.
++ (tar-rename-entry): Call tar-alter-one-field with encoded new
++ name.
++ (tar-alter-one-field): Don't toggle multibyteness of tar buffer.
++ Convert new-data-string by string-to-multibyte before inserting
++ it.
++ (tar-subfile-save-buffer): Don't toggle multibyteness of tar
++ buffer. Simplified by calling encoding-coding-region with
++ DESTINATION argument.
++ (tar-mode-write-file): Delete unnecessary call of
++ byte-to-position.
++
++2002-07-30 Dave Love <fx@gnu.org>
++
++ * international/titdic-cnv.el (quail-cxterm-package-ext-info): Doc
++ fix.
++
++ * emacs-lisp/copyright.el (copyright-regexp): Remove redundancy.
++
++2002-07-26 Kenichi Handa <handa@etl.go.jp>
++
++ * international/characters.el: Setup char-script-table.
++
++ * international/fontset.el: Setup the default fontset by the new
++ script based way.
++ (x-complement-fontset-spec): Change the format of arg FONTLIST to
++ an alist of charsets vs font name lists.
++ (charset-script-alist): New variable.
++ (create-fontset-from-fontset-spec): Allow script name in
++ FONTSET-SPEC. If charset is specified in FONTSET-SPEC, change it
++ to the corresponding script name.
++ (create-fontset-from-ascii-font): Slightly tuned.
++
++ * international/mule-conf.el (devanagari-glyph): New charset.
++ Unify these charsets: korean-ksc5601, ipa, tibetan, ethiopic,
++ japanese-jisx0208, japanese-jisx0212, japanese-jisx0213-1,
++ japanese-jisx0213-2.
++
++ * international/mule-diag.el (print-fontset): Use describe-vector
++ to handle a char table returned by fontset-info.
++
++ * language/indian.el: Don't register ccl-encode-indian-glyph-font
++ and ccl-encode-unicode-font in font-ccl-encoder-alist.
++
++2002-07-18 Dave Love <fx@gnu.org>
++
++ * startup.el (fancy-splash-head): Warn about status.
++ (fancy-splash-tail): Copyright up-date.
++
++2002-07-17 Kenichi Handa <handa@etl.go.jp>
++
++ * international/mule-util.el (detect-coding-with-priority): Fix
++ the place of using `,' marker in backguote form.
++
++2002-07-12 Dave Love <fx@gnu.org>
++
++ * international/mule-conf.el (mule-unicode-e000-ffff): Set
++ :max-code.
++
++ * international/mule-util.el (with-coding-priority): Fix.
++
++ * international/mule.el (set-coding-priority): Fix obsolete spec.
++
++2002-07-05 Dave Love <fx@gnu.org>
++
++ * international/mule-cmds.el (leim-list-header): Add coding tag.
++
++2002-07-05 Dave Love <fx@gnu.org>
++
++ * international/mule-cmds.el (find-coding-systems-region)
++ (language-info-alist, reset-language-environment, princ-list): Doc
++ fix.
++ (input-method-verbose-flag): Fix :type.
++ (set-locale-environment): Revert last change.
++
++2002-07-03 Dave Love <fx@gnu.org>
++
++ * international/mule.el (set-char-table-default): Make obsolete.
++
++2002-07-01 Dave Love <fx@gnu.org>
++
++ * language/devanagari.el ("Devanagari"): Fix coding-system,
++ coding-priority.
++
++ * international/mule-diag.el (describe-char-after): Modify display
++ list processing.
++ (unicodedata-file, unicodedata-find): New.
++
++2002-06-29 Dave Love <fx@gnu.org>
++
++ * emacs-lisp/bytecomp.el (batch-byte-compile-if-not-done): Add
++ autoload cookie.
++
++ * international/ja-dic-cnv.el (skkdic-convert): Add coding tag.
++
++2002-06-28 Dave Love <fx@gnu.org>
++
++ * international/mule-util.el (detect-coding-with-priority):
++ Rewritten.
++
++2002-06-27 Dave Love <fx@gnu.org>
++
++ * composite.el (compose-string): Doc fix.
++
++ * language/georgian.el ("Georgian"): Delete code-pages feature,
++ add nonascii-translation.
++
++ * language/european.el ("German", "French", "Spanish"): Add
++ latin-9 as alternative coding system.
++ ("Slovenian", "Polish"): Add windows-1250 as alternative coding
++ system.
++ ("Dutch"): Add latin-9 as alternative coding system. Add input
++ method.
++ ("Turkish"): Add windows-1254 and latin-3 as alternative coding
++ systems.
++ ("Lithuanian", "Latvian"): Add windows-1257 as alternative coding
++ system.
++
++ * emacs-lisp/byte-opt.el (side-effect-free-fns): Add decode-char,
++ encode-coding-char.
++ (side-effect-and-error-free-fns): Add charsetp, max-char,
++ primary-charset.
++
++ * simple.el: Don't require cl when compiling.
++
++ * Makefile.in (DONTCOMPILE): Fix duplicates.
++
++ * emacs-lisp/bytecomp.el (byte-compile-insert-header): Fix typo.
++
++ * international/mule.el: Doc fixes.
++ (load-with-code-conversion): Fix coding-system-type test.
++
++ * international/mule-cmds.el (sort-coding-systems): Comment out
++ iso-2022 case.
++ (encoded-string-description): Fix coding-system-type test.
++
++2002-06-24 Dave Love <fx@gnu.org>
++
++ * international/characters.el: Make korean-ksc5601 double-width.
++
++ * international/mule.el (auto-coding-regexp-alist): Recognize
++ Emacs 20/1 byte-compiled files.
++
++ * international/mule-conf.el (file-coding-system-alist): Change
++ .elc to utf-8-emacs.
++
++ * emacs-lisp/bytecomp.el (byte-recompile-directory)
++ (batch-byte-recompile-directory): Update from trunk.
++ (byte-compile-fix-header): Adjust for use of utf-8-emacs.
++ (byte-compile-insert-header): Update magic number. Add ballast.
++ (map-char-table): Use byte-compile-funarg-2.
++
++2002-06-16 Dave Love <fx@gnu.org>
++
++ * international/mule-cmds.el (set-locale-environment): Use
++ locale-codeset.
++
++2002-06-15 Dave Love <fx@gnu.org>
++
++ * language/cyrillic.el ("Belarusian"): Doc fix.
++ (cp1125, koi8-t): Doc fix.
++
++ * international/mule-cmds.el (find-multibyte-characters): Doc fix.
++ (find-multibyte-characters): Don't test for charset `unknown'.
++ (locale-language-names): Change or add: be, bs, cy, mk, ru.koi8,
++ ru, sr_YU, tg, wa, zh.gbk.
++ (locale-language-names): Change sp to Cyrillic.
++ (locale-charset-language-names): Match @euro after utf-8.
++
++2002-06-13 Dave Love <fx@gnu.org>
++
++ * language/chinese.el (chinese-gbk, gbk, cp936, windows-936): New
++ coding systems.
++ ("Chinese-GBK"): New environment.
++
++2002-06-12 Dave Love <fx@gnu.org>
++
++ * language/chinese.el (chinese-gbk, gbk, cp936, windows-936): New
++ coding systems.
++ ("Chinese-GBK"): New environment.
++
++ * language/thai-util.el: Remove redundant unicodes in
++ category-setting.
++
++ * language/lao-util.el: Remove redundant unicodes in
++ category-setting.
++
++ * international/mule-conf.el (japanese-jisx0213-1)
++ (japanese-jisx0213-2): Add unify-map.
++
++2002-06-12 Kenichi Handa <handa@etl.go.jp>
++
++ * international/quail.el (quail-update-leim-list-file): Force
++ writing the file by iso-2022-7bit.
++
++ * international/titdic-cnv.el (miscdic-convert): Force writing the
++ file by iso-2022-7bit.
++
++ * international/mule.el (define-charset): Change the attribute
++ :parents to :subset or :superset.
++
++ * international/mule-conf.el: Adjusted for the change of
++ define-charset (:parent -> :subset or :superset).
++
++ * international/characters.el: Fix the last change.
++
++2002-06-11 Dave Love <fx@gnu.org>
++
++ * language/cyril-util.el (cyrillic-encode-koi8-r-char)
++ (cyrillic-encode-alternativnyj-char): Fixed.
++ (standard-display-cyrillic-translit): Remove redundant unicodes.
++
++2002-06-10 Dave Love <fx@gnu.org>
++
++ * language/cyrillic.el ("Tajik", "Bulgarian", "Belarusian"): New
++ environments.
++
++ * international/mule-conf.el (control-1): New charset.
++ (eight-bit-control, eight-bit-graphic): Redefined to use raw-bytes
++ space.
++ (korean-ksc5601): Redefine to use code-offset and unify-map.
++
++2002-06-07 Dave Love <fx@gnu.org>
++
++ * international/mule-conf.el (tcvn-5712): New charset.
++
++ * language/vietnamese.el (vietnamese-tcvn, tcvn): New coding
++ system.
++ ("Vietnamese"): Doc fix.
++
++2002-06-06 Dave Love <fx@gnu.org>
++
++ * international/mule-conf.el (windows-936): New alias.
++
++ * cus-start.el: Add scalable-fonts-allowed.
++
++ * international/characters.el: Reinstate various CJK syntax and
++ category setup. Remove obsolete syntax setting in Greek section.
++ Optimize the char tables.
++
++ * language/thai.el ("Thai"): Add cp874, iso-8859-11 coding
++ systems.
++
++ * language/vietnamese.el ("Vietnamese"): Add windows-1258 coding
++ system.
++
++ * language/greek.el ("Greek"): Add windows-1253, cp851, cp869
++ coding systems.
++
++ * language/romanian.el ("Romanian"): Add iso-latin-10 coding
++ system.
++
++2002-06-03 Kenichi Handa <handa@etl.go.jp>
++
++ * international/characters.el (printable-chars): Setup correctly.
++
++2002-06-02 Dave Love <fx@gnu.org>
++
++ * cus-start.el: Add selection-coding-system.
++
++ * language/hebrew.el ("Hebrew"): Add windows-1255, cp862 coding
++ systems.
++
++ * language/china-util.el (post-read-decode-hz)
++ (pre-write-encode-hz): Moved from chinese.el.
++ (big5-to-flat-code, flat-code-to-big5, euc-to-flat-code)
++ (flat-code-to-euc, expand-euc-big5-alist, big5-to-cns): Deleted.
++
++ * language/chinese.el (post-read-decode-hz)
++ (pre-write-encode-hz): Moved to china-util.el.
++
++ * case-table.el (set-case-syntax-pair): Test again for equal byte
++ lengths of the pair.
++
++ * international/characters.el: Add Vietnamese category to
++ equivalent unicodes.
++
++2002-05-31 Dave Love <fx@gnu.org>
++
++ * international/mule-conf.el (chinese-sisheng, ipa)
++ (indian-is13194, tibetan, ethiopic): Add :unify-map.
++
++ * international/mule-diag.el (describe-character-set): Account for
++ more than two dimensions of possibly different size.
++ (describe-current-coding-system): Add selection-coding-system.
++
++ * international/mule-cmds.el (unify-8859-on-encoding-mode)
++ (unify-8859-on-decoding-mode): Moved from mule.el.
++
++ * international/mule.el (unify-8859-on-encoding-mode)
++ (unify-8859-on-decoding-mode): Remove :init-value.
++ (charset-chars): Add optional dimension arg.
++ (unify-8859-on-encoding-mode, unify-8859-on-decoding-mode): Moved
++ to mule-cmds.el.
++
++2002-05-31 Kenichi Handa <handa@etl.go.jp>
++
++ * international/fontset.el: Change registry for japanese-jisx0208
++ to "JISX0208*" in the default fontset.
++ (font-encoding-alist): Add an entry for "JISX0208.1983" and
++ "ISO10646.indian-1".
++
++2002-05-30 Kenichi Handa <handa@etl.go.jp>
++
++ * language/japanese.el (japanese-iso-7bit-1978-irv): Add
++ `designation' to :flags, `ascii' to :charset-list.
++
++ * international/mule.el (define-charset): New args :min-code and
++ :max-code.
++ (coding-system-iso-2022-flags): Add use-roman, use-oldjis.
++
++ * international/mule-conf.el (chinese-gbk): Change :code-offset to
++ #x160000.
++ (gb18030-2-byte, gb18030-4-byte-bmp, gb18030-4-byte-smp,
++ gb18030-4-byte-ext-1, gb18030-4-byte-ext-2, gb18030): New
++ charsets.
++
++2002-05-29 Dave Love <fx@gnu.org>
++
++ * language/thai.el (iso-8859-11): New coding system.
++
++ * international/mule-conf.el: Doc fixes.
++ (iso-8859-11): New.
++
++2002-05-28 Dave Love <fx@albion.dl.ac.uk>
++
++ * cus-start.el (scalable-fonts-allowed): Add.
++
++2002-05-27 Dave Love <fx@gnu.org>
++
++ * international/mule.el (unify-8859-on-encoding-mode)
++ (unify-8859-on-decoding-mode): Dummy versions.
++
++ * international/ucs-tables.el: Removed.
++
++ * Makefile.in (DONTCOMPILE): Add language/chinese.el,
++ language/japanese.el.
++
++ * international/mule-conf.el: Doc fixes.
++ (cp936): New alias.
++ (cp720, cp858): New charsets.
++
++ * mail/sendmail.el (mail-recover-1, mail-recover): Use utf-8-emacs
++ coding system, not emacs-mule.
++
++ * files.el (revert-buffer, recover-file): Likewise.
++
++ * desktop.el (desktop-save): Likewise.
++
++2002-05-26 Dave Love <fx@gnu.org>
++
++ * international/mule.el (with-category-table): Use make-symbol.
++ (coding-system-list): Use coding-system-aliases.
++ (make-translation-table): Don't deal with generic characters.
++
++ * international/mule-util.el: (coding-system-post-read-conversion)
++ (coding-system-pre-write-conversion)
++ (coding-system-translation-table-for-decode)
++ (coding-system-translation-table-for-encode): Get the right
++ properties.
++ (with-coding-priority): New macro.
++ (detect-coding-with-language-environment): Use it.
++ (coding-system-equal): Use coding-system-plist.
++
++ * encoded-kb.el: (encoded-kbd-setup-keymap) <ccl>:
++ Use :valid property.
++
++ * mule-cmds.el (encode-coding-char): Use
++ find-coding-systems-string. Don't use make-char.
++ (describe-language-environment): Use coding-system-aliases.
++ (prefer-coding-system): Doc fix.
++
++ * mule-diag.el (describe-current-coding-system): Fix aliases
++ listing.
++ (print-iso-2022-flags): Deleted.
++ (print-designation): Partly re-written.
++ (describe-coding-system): Deal with iso-2022 designations, flags.
++ Fix shift_jis case.
++ (describe-char-after): Use characterp. Print explicit unicode.
++ Remove some obsolete code.
++ (print-coding-system-briefly): Fix printing aliases.
++ (print-coding-system): Use coding-system-aliases.
++ (mule-diag): Don't list coding categories.
++
++ * mule-conf.el: Doc fixes. Remove redundant
++ :long-name properties. Re-order charset priorities.
++ (binary): New alias.
++ (iso-8859-16): Fix nickname.
++ (define-iso-single-byte-charset): Un-define after use.
++
++2002-05-26 Dave Love <fx@gnu.org>
++
++ * international/mule.el (coding-system-iso-2022-flags): Revert
++ last change.
++
++2002-05-25 Dave Love <fx@gnu.org>
++
++ * international/characters.el: Additional double width
++ specifications.
++
++ * international/mule-diag.el (print-coding-system): Incomplete
++ updates.
++ (describe-character-set): List more properties.
++ (print-fontset): Fix case of vector font-spec.
++ (describe-current-coding-system): Fix iso-7, iso-7-else.
++
++ * international/mule-conf.el (ibm866): Fix alias.
++ (iso-8859-16): Fix nickname.
++
++ * international/mule.el (coding-system-iso-2022-flags): Add
++ use-roman, use-oldjis.
++
++2002-05-23 Dave Love <fx@gnu.org>
++
++ * language/ind-util.el: Avoid decode-char.
++ (indian--puthash-char, indian--puthash-c, indian--puthash-cv):
++ Use characterp, not char-valid-p.
++
++ * language/devan-util.el: Add coding tag, avoid decode-char.
++
++ * international/titdic-cnv.el: Add coding tag.
++ (tit-process-header): Add coding tag to output.
++
++ * language/thai.el (cp874, ibm874): New coding systems.
++
++ * emacs-lisp/byte-opt.el <side-effect-and-error-free-fns>: Add
++ character-p.
++
++ * language/european.el (cp852, ibm852, cp857, ibm857, cp860)
++ (ibm860, cp861, ibm861, cp863, cp865, ibm865, cp437, ibm437): New
++ coding systems.
++ <set-language-info-alist>: Avoid decode-char.
++
++ * language/hebrew.el (cp862, ibm862): New coding systems.
++
++ * language/greek.el (cp851, ibm851, cp869, ibm869): New coding
++ systems.
++
++ * language/cyrillic.el (cp855, ibm855): New coding systems.
++
++ * international/mule-conf.el: Avoid decode-char in top-level code
++ for self-inserting multibyte chars.
++ (cp437, cp737, cp775, cp851, cp852, cp855, cp857, cp855, cp857)
++ (cp860, cp861, cp862, cp863, cp864, cp865, cp869, cp874): New
++ charsets.
++
++ * international/characters.el: Various simplifications and
++ additions.
++
++2002-05-22 Dave Love <fx@gnu.org>
++
++ * international/mule-conf.el (code-pages): Provide, for
++ compatibility.
++
++ * international/code-pages.el: Removed.
++
++2002-05-22 Kenichi Handa <handa@etl.go.jp>
++
++ * Makefile.in: Cancel the 2002-05-17 change of mine.
++
++ * international/fontset.el: Add setting for unicode font at the
++ end of the default fontset.
++
++2002-05-21 Dave Love <fx@gnu.org>
++
++ * international/mule-conf.el (adobe-standard-encoding, symbol):
++ Adjust :code-space.
++ (ibm850): Add :ascii-compatible-p.
++
++2002-05-21 Kenichi Handa <handa@etl.go.jp>
++
++ * international/mule-conf.el (vietnamese-viscii-lower)
++ (vietnamese-viscii-upper): Supply them :code-offset, then unify by
++ mapping table.
++
++2002-05-20 Dave Love <fx@gnu.org>
++
++ * cus-start.el: Add charset-map-directory.
++
++ * international/fontset.el (font-encoding-alist): Add
++ adobe-symbol.
++
++ * format.el (format-alist): Remove ibm, mac, hp entries (available
++ natively).
++
++ * language/romanian.el (iso-latin-10): Add :mime-charset.
++ ("Romanian"): Add doc.
++
++ * international/mule-conf.el (iso-8859-10, symbol)
++ (adobe-standard-encoding, ibm850): New charsets.
++ (iso-8859-13): Fix IR number, final char.
++ (file-coding-system-alist): Add .xml.
++
++ * language/european.el (iso-latin-6, iso-8859-10, latin-6)
++ (iso-latin-7, iso-8859-13, latin-7, hp-roman8, roman8)
++ (adobe-standard-encoding, cp850, ibm850): New coding systems.
++ ("Latin-6", "Latin-7"): New language environments.
++
++2002-05-19 Dave Love <fx@gnu.org>
++
++ * Makefile.in (DONTCOMPILE): Remove ucs-tables, utf-8,
++ utf-8-subst; add vietnamese, cyrillic, czech.
++
++ * language/romanian.el (iso-latin-10): New coding system.
++
++ * international/mule-conf.el (emacs-mule): Set :charset-list,
++ consistent with coding-system-charset-list doc.
++ (iso-8859-16): New charset.
++
++ * international/mule-diag.el (describe-coding-system): Avoid error
++ for iso-2022, emacs-mule.
++
++2002-05-17 Dave Love <fx@gnu.org>
++
++ * international/codepage.el: Most of code removed or commented
++ out.
++ (codepage-setup): Re-written as trivial, obsolete function.
++
++ * language/utf-8-lang.el ("UTF-8"): Use utf-8, not mule-utf-8.
++ Remove setup function.
++
++ * language/english.el (ebcdic-us, ebcdic-uk): New coding systems.
++
++ * Makefile.in (DONTCOMPILE): Add language/vietnamese.el,
++ language/cyrillic.el, language/czech.el.
++
++ * language/vietnamese.el (windows-1258, cp1258): New coding
++ systems.
++ (font-ccl-encoder-alist): Remove viscii, vscii.
++
++ * language/hebrew.el (windows-1255, cp1255): New coding systems.
++
++ * language/european.el (windows-1254, cp1254, windows-1257)
++ (cp1257, next, iso-latin-7, iso-8859-13, latin-7): New coding
++ systems.
++ ("Latin-7", "Lithuanian", "Latvian"): Don't require code-pages.
++
++ * language/greek.el (windows-1253, cp1253): New coding systems.
++
++ * international/mule-conf.el (ebcdic-us, ebcdic-uk): Change map
++ file name.
++ (windows-1253, windows-1254, windows-1255, windows-1256)
++ (windows-1257, windows-1258, next): New charsets.
++
++ * international/utf-8.el, international/utf-8-subst.el: Removed.
++
++ * international/mule.el: Doc fixes.
++ (charset-list, generic-char-p, set-coding-priority): Make
++ obsolete.
++ (coding-system-get): Try to convert old-style symbol to keyword.
++ (define-charset): Purecopy strings in property list.
++ (define-coding-system): Purecopy docstring.
++
++ * international/mule-diag.el (list-character-sets-2): Avoid
++ charset-bytes.
++ (list-iso-charset-chars, list-non-iso-charset-chars): Deleted.
++ (list-block-of-chars): Re-written.
++ (describe-character-set): Show more properties.
++ (describe-char-after): Correct codepoint display.
++ (print-coding-system): Use symbolic types.
++
++2002-05-17 Kenichi Handa <handa@etl.go.jp>
++
++ * Makefile.in: Be sure also to run emacs with LANG=C.
++
++2002-05-16 Dave Love <fx@gnu.org>
++
++ * international/mule-diag.el: Doc fixes.
++ (sort-charset-list, charset-multibyte-form-string): Removed.
++ (list-character-sets, list-character-sets-1)
++ (list-character-sets-2): Re-written.
++ (non-iso-charset-alist): Set to nil and made obsolete.
++ (decode-codepage-char): Re-written and made obsolete.
++ (read-charset): Don't use non-iso-charset-alist.
++ (describe-coding-system): Use keyword properties.
++ (describe-character-set): Re-written.
++
++ * international/mule-conf.el (koi8-u, koi8-t, georgian-ps)
++ (windows-1250, windows-1251, windows-1252, cp1125, ebcdic-us)
++ (ebcdic-uk): New charsets.
++
++ * language/cyrillic.el (koi8-u, koi8-t, windows-1251, cp1125): New
++ coding systems.
++
++ * language/european.el (windows-1252): New coding system.
++
++2002-05-16 Kenichi Handa <handa@etl.go.jp>
++
++ * Makefile.in: By sure to run emacs with LC_ALL=C.
++
++ * international/encoded-kb.el (encoded-kbd-handle-8bit): Call
++ encoded-kbd-self-insert-iso2022-8bit with argument 1.
++ (encoded-kbd-self-insert-charset): New function.
++ (encoded-kbd-setup-keymap): Handle a coding-system of type
++ charset.
++ (encoded-kbd-mode): Likewise.
++
++2002-05-15 Dave Love <fx@gnu.org>
++
++ * international/mule-cmds.el (set-locale-environment): Comment out
++ set-keyboard-coding-system stuff.
++
++2002-05-14 Kenichi Handa <handa@etl.go.jp>
++
++ * international/mule.el (define-coding-system): Docstring
++ fixed (sjis->shift-jis).
++
++ * international/mule-conf.el: Use decode-char instead of
++ make-char.
++
++ * international/encoded-kb.el
++ (encoded-kbd-self-insert-iso2022-8bit): New arg ARG. Directly
++ call self-insert-command. This is a temporary workaround to
++ make it work with latin-1.
++ (encoded-kbd-mode): Change `sjis' to `shift-jis'.
++
++ * international/characters.el: Setup char-width-table for CJK
++ characters.
++
++2002-05-15 Kenichi Handa <handa@etl.go.jp>
++
++ * international/ja-dic-utl.el (skkdic-jisx0208-hiragana-block):
++ Fix the initial value to specify character range of
++ japanese-jisx0208, not unicode.
++
++ * international/characters.el: Set syntax/category for
++ japanese-jisx0208.
++
++2002-05-14 Dave Love <fx@gnu.org>
++
++ * mail/sendmail.el (sendmail-send-it): Use :mime-charset, not
++ mime-charset.
++
++ * language/vietnamese.el, language/korean.el, language/japanese.el:
++ * language/hebrew.el, language/greek.el, language/chinese.el:
++ Fix :mime-charset properties.
++
++ * language/cyrillic.el (cyrillic-iso-8bit, cyrillic-koi8)
++ (cyrillic-alternativnyj): Fix :mime-charset.
++ (cp878, cp866): New alias.
++
++ * language/european.el: Fix mime-charset properties.
++
++ * international/mule-cmds.el (sort-coding-systems)
++ (select-safe-coding-system, select-message-coding-system): Use
++ :mime-charset, not 'mime-charset.
++
++ * international/mule-conf.el: Add various :mime-charset
++ properties.
++
++2002-05-13 Dave Love <fx@gnu.org>
++
++ * international/encoded-kb.el (encoded-kbd-self-insert-ccl): Fix
++ getting decoder.
++ (encoded-kbd-mode): Fix code for coding system type and
++ designations.
++
++ * international/mule-conf.el: Speling fixes.
++
++2002-05-13 Kenichi Handa <handa@etl.go.jp>
++
++ * international/fontset.el (fontset-plain-name): Handle the case
++ that size, weight, slant are not specified in the fontset name.
++
++2002-05-10 Yong Lu <lyongu@asia-infonet.com>
++
++ * language/greek.el (greek-iso-8bit): Fix typo.
++
++2002-05-10 Kenichi Handa <handa@etl.go.jp>
++
++ * language/chinese.el (chinese-big5): Change :coding-type to
++ `charset'.
++
++2002-05-09 Kenichi Handa <handa@etl.go.jp>
++
++ * international/characters.el: Change encoding to utf-8-emacs.
++ Remove apparent duplicate codes.
++
++2002-05-07 Kenichi Handa <handa@etl.go.jp>
++
++ * international/fontset.el: Change the registry for
++ chinese-gb2312 and add the registry for chinese-gbk.
++
++ * international/mule.el (charset-chars): Fix typo.
++
++ * international/mule-conf.el (chinese-gbk): New charset.
++
++ * international/titdic-cnv.el (titdic-convert): Read into a
++ unibyte buffer then make the buffer multibyte.
++
++2002-03-07 Kenichi Handa <handa@etl.go.jp>
++
++ * international/mule-conf.el (utf-16-le): Use :bom attribute
++ instead of :signature.
++ (utf-16-be): Likewise.
++
++2002-03-05 Kenichi Handa <handa@etl.go.jp>
++
++ * language/czech.el ("Czech"): Set `iso-8859-2' for
++ `nonascii-translation'.
++
++ * language/romanian.el ("Romanian"): Likewise.
++
++ * language/slovak.el ("Slovak"): Likewise.
++
++ * international/characters.el: Optimize calls of
++ modify-category-entry.
++
++2002-03-01 Kenichi Handa <handa@etl.go.jp>
++
++ * bindings.el: Don't bind multibyte characters to
++ self-insert-command here. It's done in mule-conf.el
++
++ * case-table.el (set-case-syntax-offset): Variable deleted.
++ (set-case-syntax-1): Function deleted. Callers changed.
++ (set-case-syntax-delims): Don't check byte length of characters.
++
++ * isearch.el (isearch-mode-map): Call set-char-table-range to bind
++ characters to isearch-printing-char.
++
++ * loadup.el: Don't load "international/utf-8". Don't call
++ update-coding-systems-internal. Bind coding-system-for-write to
++ `utf-8' while writing fns-XXX.el. Call clear-charset-maps before
++ dumping.
++
++ * version.el (emacs-version): Set to "22.0.0".
++
++ * emacs-lisp/regexp-opt.el (regexp-opt-charset): Adjusted for the
++ change of map-char-table.
++
++ * eshell/esh-mode.el: Adjusted for the change of map-char-table.
++
++ * international/characters.el: Adjusted for the deletion of
++ generic characters.
++
++ * international/code-pages.el (cp-make-translation-table,
++ cp-valid-codes, cp-fix-safe-chars): Deleted. Caller changed.
++ (cp-make-coding-system): Call define-coding-system.
++
++ * international/fontset.el: Mostly re-written.
++
++ * international/ja-dic-cnv.el (skkdic-get-kana-compact-codes):
++ Call encode-char instead of split-char.
++
++ * international/ja-dic-utl.el (skkdic-jisx0208-hiragana-block):
++ Value changed.
++ (skkdic-lookup-key): Call encode-char instead of split-char.
++
++ * international/titdic-cnv.el (titdic-convert): Bind
++ coding-system-for-write to 'iso-2022-7bit. Don't work on unibyte
++ buffer.
++
++ * international/latin-1.el: Don't bind set-case-syntax-offset.
++
++ * international/latin-2.el: Don't bind set-case-syntax-offset.
++
++ * international/latin-3.el: Don't bind set-case-syntax-offset.
++
++ * international/latin-4.el: Don't bind set-case-syntax-offset.
++
++ * international/latin-5.el: Don't bind set-case-syntax-offset.
++
++ * international/latin-8.el: Don't bind set-case-syntax-offset.
++
++ * international/latin-9.el: Don't bind set-case-syntax-offset.
++
++ * international/mule-cmds.el: Don't use coding category. Call
++ set-coding-system-priority instead of set-coding-priority.
++ (sort-coding-systems): Call coding-system-priority-list to get the
++ most preferred one.
++ (select-safe-coding-system): Likewise.
++ (reset-language-environment): Order of coding system priority
++ changed. Set primary charset to iso-8859-1.
++ (set-language-environment-coding-systems): Call
++ set-coding-system-priority instead of set-coding-priority.
++ (get-charset-property, put-charset-property): Moved to mule.el.
++
++ * international/mule-conf.el: Fully Re-written.
++
++ * international/mule-diag.el (print-designation): Arguments
++ changed.
++ (print-iso-2022-flags): New function.
++ (describe-coding-system): Adjusted for the new structure of coding
++ system.
++ (describe-current-coding-system): Likewise.
++
++ * international/mule.el (char-valid-p): Make it an alias of
++ characterp.
++ (define-charset): Fully re-designed.
++ (charset-quoted-standard-p): Deleted.
++ (charsetp): Moved to charset.c.
++ (charset-info, charset-id, charset-bytes, charset-width,
++ charset-directioin, charset-iso-graphic-plane,
++ charset-reverse-charset): Deleted.
++ (charset-dimension, charset-chars, charset-iso-final-char,
++ charset-description, charset-short-name, charset-long-name): Call
++ charset-plist instead of charset-info.
++ (charset-plist, set-charset-plist): Moved to charset.c.
++ (get-charset-property, put-charset-property): Moved from
++ mule-cmds.el. Call charset-plist and set-charset-plist.
++ (make-char): Deleted.
++ (generic-char-p): Make it always return nil.
++ (decode-char, encode-char): Moved to charset.c.
++ (coding-spec-XXX-idx): Variables deleted.
++ (coding-system-iso-2022-flags): New variable.
++ (define-coding-system): New function.
++ (transform-make-coding-system-args, make-coding-system): Deleted.
++ (set-coding-priority): Make it obsolete.
++ (after-insert-file-set-buffer-file-coding-system): Adjusted for
++ the new coding system structure.
++ (find-new-buffer-file-coding-system): Likewise.
++
++ * language/chinese.el, language/cyrillic.el, language/european.el,
++ language/greek.el, language/hebrew.el, language/indian.el,
++ language/japanese.el, language/korean.el, language/lao.el,
++ language/thai.el, language/tibetan.el, language/vietnamese.el:
++ Call define-coding-system instead of make-coding-system. All CCL
++ program deleted.
++
++ * textmodes/sgml-mode.el (sgml-mode-map): Use encode-char instead
++ of make-char.
++ (sgml-char-names-table): Iteration limit fixed.
++
++ * term/mac-win.el: Deleted unnecessary calls of set-fontset-font.
++ (ccl-encode-mac-roman-font): Deleted.
++
++ * Makefile.in (DONTCOMPILE): Add latin1-disp.el, ucs-tables.el,
++ utf-8.el, and utf-8-subst.el as they can't be bytecompiled
++ currently. This is just a temporary workaround.
++
++;; Local Variables:
++;; coding: iso-2022-7bit
++;; End:
++
++ Copyright (C) 2002 Free Software Foundation, Inc.
++ Copying and distribution of this file, with or without modification,
++ are permitted provided the copyright notice and this notice are preserved.
# Files which should not be compiled. If you change the name `DONTCOMPILE'
# to something different, you'll have to change make-dist as well, and
# modify the lists in $lisp and $shortlisp on src/Makefile.in.
+#
+# - emacs-lisp/cl-specs.el: only contains `def-edebug-spec's so there's
+# no point compiling it, although it doesn't hurt.
DONTCOMPILE = \
$(lisp)/cus-load.el \
$(lisp)/forms-d2.el \
$(lisp)/forms-pass.el \
$(lisp)/generic-x.el \
- $(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)/international/latin1-disp.el \
$(lisp)/international/mule-conf.el \
$(lisp)/language/czech.el \
$(lisp)/language/devanagari.el \
+ $(lisp)/language/malayalam.el \
+ $(lisp)/language/tamil.el \
$(lisp)/language/english.el \
$(lisp)/language/greek.el \
$(lisp)/language/hebrew.el \
$(lisp)/language/thai.el \
$(lisp)/language/utf-8-lang.el \
$(lisp)/language/georgian.el \
+ $(lisp)/language/vietnamese.el \
+ $(lisp)/language/cyrillic.el \
+ $(lisp)/language/chinese.el \
+ $(lisp)/language/indian.el \
$(lisp)/loaddefs.el \
$(lisp)/loadup.el \
$(lisp)/mail/blessmail.el \
# 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
esac; \
done
-finder_setwins=subdirs=`find $$wd -type d -print`; \
+setwins_almost=subdirs=`find $$wd -type d -print`; \
for file in $$subdirs; do \
case $$file in */Old | */RCS | */CVS | */CVS/* | */=* | */obsolete | */term ) ;; \
*) wins="$$wins $$file" ;; \
doit:
-cus-load.el:
+$(lisp)/cus-load.el:
touch $@
-custom-deps: cus-load.el doit
- wd=$(lisp); $(setwins); \
+custom-deps: $(lisp)/cus-load.el doit
+ wd=$(lisp); $(setwins_almost); \
echo Directories: $$wins; \
- $(EMACS) $(EMACSOPT) -l cus-dep --eval '(setq generated-custom-dependencies-file "$(lisp)/cus-load.el")' -f custom-make-dependencies $$wins
- LC_ALL=C $(EMACS) $(EMACSOPT) -l cus-dep -f custom-make-dependencies $$wins
++ LC_ALL=C $(EMACS) $(EMACSOPT) -l cus-dep --eval '(setq generated-custom-dependencies-file "$(lisp)/cus-load.el")' -f custom-make-dependencies $$wins
-finder-inf.el:
- echo "(provide 'finder-inf)" >> $@
-finder-data: finder-inf.el doit
- wd=$(lisp); $(finder_setwins); \
+finder-data: doit
+ wd=$(lisp); $(setwins_almost); \
echo Directories: $$wins; \
- $(EMACS) $(EMACSOPT) -l finder --eval '(setq generated-finder-keywords-file "$(lisp)/finder-inf.el")' -f finder-compile-keywords-make-dist $$wins
- LC_ALL=C $(EMACS) $(EMACSOPT) -l finder -f finder-compile-keywords-make-dist $$wins
++ LC_ALL=C $(EMACS) $(EMACSOPT) -l finder --eval '(setq generated-finder-keywords-file "$(lisp)/finder-inf.el")' -f finder-compile-keywords-make-dist $$wins
-loaddefs.el:
+$(lisp)/loaddefs.el:
echo ";;; loaddefs.el --- automatically extracted autoloads" >> $@
echo ";;" >> $@; echo ";;; Code:" >> $@
echo "\f" >> $@
echo ";;; no-update-autoloads: t" >> $@
echo ";;; End:" >> $@
echo ";;; loaddefs.el ends here" >> $@
-autoloads: loaddefs.el doit
+autoloads: $(lisp)/loaddefs.el doit
wd=$(lisp); $(setwins); \
echo Directories: $$wins; \
- $(EMACS) $(EMACSOPT) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins
+ LC_ALL=C $(EMACS) $(EMACSOPT) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins
-subdirs.el:
+$(lisp)/subdirs.el:
$(MAKE) $(MFLAGS) update-subdirs
update-subdirs: doit
wd=$(lisp); $(setwins); \
.SUFFIXES: .elc .el
-.el.elc: subdirs.el
+.el.elc: $(lisp)/subdirs.el
-$(emacs) -f batch-byte-compile $<
$(DONTCOMPILE:.el=.elc):
# current directory and its subdirectories, to make sure require's and
# load's in the files being compiled find the right files.
-compile: subdirs.el doit
+# NOTE about DONTCOMPILE: in the `echo <foo> | sort | uniq -u' we pass
+# $(DONTCOMPILE) twice. This is in case one of the files in DONTCOMPILE
+# is absent. -stef
+
+compile: $(lisp)/subdirs.el doit
find $(lisp) -name "*.elc" -print | xargs chmod +w >/dev/null 2>&1; \
wd=$(lisp); $(setwins); \
elpat=`echo $$wins | tr ' ' '\012\012' | \
sed -e 's|\(.\)$$|\1/|' -e 's|^\./||' -e 's|$$|*.el|'`; \
- els=`echo $$elpat $(DONTCOMPILE) $(COMPILE_FIRST) | \
+ els=`echo $$elpat $(DONTCOMPILE) $(DONTCOMPILE) $(COMPILE_FIRST) | \
tr ' ' '\012\012' | sort | uniq -u`; \
for el in $(COMPILE_FIRST) $$els; do \
- echo Compiling $$el; \
- LC_ALL=C $(emacs) -f batch-byte-compile-if-not-done $$el || exit 1; \
+ if test -f $$el; \
+ then \
+ echo Compiling $$el; \
+ $(emacs) -f batch-byte-compile-if-not-done $$el || exit 1; \
+ fi \
done
# Compile all Lisp files, except those from DONTCOMPILE. This
# is like `compile' but compiles files unconditionally.
-compile-always: subdirs.el doit
- find $(lisp) -name "*.elc" -print | xargs chmod +w >/dev/null 2>&1; \
+compile-always: $(lisp)/subdirs.el doit
+ # `|| true' prevents old Bash versions from getting confused
+ # by an error.
+ find $(lisp) -name "*.elc" -print | xargs chmod +w >/dev/null 2>&1 || true; \
wd=$(lisp); $(setwins); \
elpat=`echo $$wins | tr ' ' '\012\012' | \
sed -e 's|\(.\)$$|\1/|' -e 's|^\./||' -e 's|$$|*.el|'`; \
- els=`echo $$elpat $(DONTCOMPILE) $(COMPILE_FIRST) | \
+ els=`echo $$elpat $(DONTCOMPILE) $(DONTCOMPILE) $(COMPILE_FIRST) | \
tr ' ' '\012\012' | sort | uniq -u`; \
for el in $(COMPILE_FIRST) $$els; do \
- echo Compiling $$el; \
- LC_ALL=C $(emacs) -f batch-byte-compile $$el || exit 1; \
+ if test -f $$el; \
+ then \
+ echo Compiling $$el; \
+ $(emacs) -f batch-byte-compile $$el || exit 1; \
+ fi \
done
-compile-calc:
- for el in $(find $(lisp)/calc -name '*.el'); do \
+compile-calc:
+ for el in `find $(lisp)/calc -name '*.el'`; do \
echo Compiling $$el; \
- LC_ALL=C $(emacs) -f batch-byte-compile $$el || exit 1; \
+ $(emacs) -f batch-byte-compile $$el || exit 1; \
done
# Backup compiled Lisp files in elc.tar.gz. If that file already
# .elc is present.
recompile: doit
- $(EMACS) $(EMACSOPT) -f batch-byte-recompile-directory $(lisp)
+ LC_ALL=C $(EMACS) $(EMACSOPT) -f batch-byte-recompile-directory $(lisp)
# Prepare a bootstrap in the lisp subdirectory. Build loaddefs.el,
# because it's not sure it's up-to-date, and if it's not, that might
# bootstrap-emacs will be built from sources only.
bootstrap-clean:
- if test -f $(EMACS); then $(MAKE) $(MFLAGS) autoloads; fi
- -rm -f $(lisp)/*.elc $(lisp)/*/*.elc
+ if test -x $(EMACS); then $(MAKE) $(MFLAGS) autoloads; fi
+ cd $(lisp); rm -f *.elc */*.elc
# Generate/update files for the bootstrap process.
-bootstrap: autoloads compile-always custom-deps
+bootstrap: update-subdirs autoloads compile
+
+# Generate/update files after the bootstrap process.
+# custom-deps needs `preloaded-file-list'.
+
+bootstrap-after: finder-data custom-deps
distclean:
-rm -f ./Makefile
;;; arc-mode.el --- simple editing of archives
-;; Copyright (C) 1995, 1997, 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 1998, 2003 Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk>
;; Keywords: archives msdog editing major-mode
;;
;; LZH A series of (header,file). Headers are checksummed. No
;; interaction among members.
+;; Headers come in three flavours called level 0, 1 and 2 headers.
+;; Level 2 header is free of DOS specific restrictions and most
+;; prevalently used. Also level 1 and 2 headers consist of base
+;; and extension headers. For more details see
+;; http://homepage1.nifty.com/dangan/en/Content/Program/Java/jLHA/Notes/Notes.html
+;; http://www.osirusoft.com/joejared/lzhformat.html
;;
;; ZIP A series of (lheader,fil) followed by a "central directory"
;; which is a series of (cheader) followed by an end-of-
:group 'archive)
(defcustom archive-tmpdir
+ ;; make-temp-name is safe here because we use this name
+ ;; to create a directory.
(make-temp-name
(expand-file-name (if (eq system-type 'ms-dos) "ar" "archive.tmp")
temporary-file-directory))
;; ------------------------------
;; Zip archive configuration
-(defcustom archive-zip-use-pkzip (memq system-type '(ms-dos windows-nt))
- "*If non-nil then pkzip option are used instead of zip options.
-Only set to true for msdog systems!"
- :type 'boolean
- :group 'archive-zip)
-
(defcustom archive-zip-extract
- (if archive-zip-use-pkzip '("pkunzip" "-e" "-o-") '("unzip" "-qq" "-c"))
+ (if (locate-file "unzip" nil 'file-executable-p)
+ '("unzip" "-qq" "-c")
+ (if (locate-file "pkunzip" nil 'file-executable-p)
+ '("pkunzip" "-e" "-o-")
+ '("unzip" "-qq" "-c")))
"*Program and its options to run in order to extract a zip file member.
Extraction should happen to standard output. Archive and member name will
be added. If `archive-zip-use-pkzip' is non-nil then this program is
;; names.
(defcustom archive-zip-expunge
- (if archive-zip-use-pkzip '("pkzip" "-d") '("zip" "-d" "-q"))
+ (if (locate-file "zip" nil 'file-executable-p)
+ '("zip" "-d" "-q")
+ (if (locate-file "pkzip" nil 'file-executable-p)
+ '("pkzip" "-d")
+ '("zip" "-d" "-q")))
"*Program and its options to run in order to delete zip file members.
Archive and member names will be added."
:type '(list (string :tag "Program")
:group 'archive-zip)
(defcustom archive-zip-update
- (if archive-zip-use-pkzip '("pkzip" "-u" "-P") '("zip" "-q"))
+ (if (locate-file "zip" nil 'file-executable-p)
+ '("zip" "-q")
+ (if (locate-file "pkzip" nil 'file-executable-p)
+ '("pkzip" "-u" "-P")
+ '("zip" "-q")))
"*Program and its options to run in order to update a zip file member.
Options should ensure that specified directory will be put into the zip
file. Archive and member name will be added."
:group 'archive-zip)
(defcustom archive-zip-update-case
- (if archive-zip-use-pkzip archive-zip-update '("zip" "-q" "-k"))
+ (if (locate-file "zip" nil 'file-executable-p)
+ '("zip" "-q" "-k")
+ (if (locate-file "pkzip" nil 'file-executable-p)
+ '("pkzip" "-u" "-P")
+ '("zip" "-q" "-k")))
"*Program and its options to run in order to update a case fiddled zip member.
Options should ensure that specified directory will be put into the zip file.
Archive and member name will be added."
;; -------------------------------------------------------------------------
;; Section: Variables
-(defvar archive-subtype nil "*Symbol describing archive type.")
-(defvar archive-file-list-start nil "*Position of first contents line.")
-(defvar archive-file-list-end nil "*Position just after last contents line.")
-(defvar archive-proper-file-start nil "*Position of real archive's start.")
-(defvar archive-read-only nil "*Non-nil if the archive is read-only on disk.")
-(defvar archive-local-name nil "*Name of local copy of remote archive.")
-(defvar archive-mode-map nil "*Local keymap for archive mode listings.")
-(defvar archive-file-name-indent nil "*Column where file names start.")
+(defvar archive-subtype nil "Symbol describing archive type.")
+(defvar archive-file-list-start nil "Position of first contents line.")
+(defvar archive-file-list-end nil "Position just after last contents line.")
+(defvar archive-proper-file-start nil "Position of real archive's start.")
+(defvar archive-read-only nil "Non-nil if the archive is read-only on disk.")
+(defvar archive-local-name nil "Name of local copy of remote archive.")
+(defvar archive-mode-map nil "Local keymap for archive mode listings.")
+(defvar archive-file-name-indent nil "Column where file names start.")
-(defvar archive-remote nil "*Non-nil if the archive is outside file system.")
+(defvar archive-remote nil "Non-nil if the archive is outside file system.")
(make-variable-buffer-local 'archive-remote)
(put 'archive-remote 'permanent-local t)
(make-variable-buffer-local 'archive-member-coding-system)
(defvar archive-alternate-display nil
- "*Non-nil when alternate information is shown.")
+ "Non-nil when alternate information is shown.")
(make-variable-buffer-local 'archive-alternate-display)
(put 'archive-alternate-display 'permanent-local t)
-(defvar archive-superior-buffer nil "*In archive members, points to archive.")
+(defvar archive-superior-buffer nil "In archive members, points to archive.")
(put 'archive-superior-buffer 'permanent-local t)
-(defvar archive-subfile-mode nil "*Non-nil in archive member buffers.")
+(defvar archive-subfile-mode nil "Non-nil in archive member buffers.")
(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.
- (defsubst bref (string idx)
- "Like aref but an eight-bit char is converted to unibyte."
- (multibyte-char-to-unibyte (aref string idx)))
+ (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)
(setq i (1+ i)
- result (+ (ash result 8)
- (bref str (- len i)))))
+ result (+ (ash result 8) (aref str (- len i)))))
result))
(defun archive-int-to-mode (mode)
(second (* 2 (logand time 31)))) ; 2 seconds resolution
(format "%02d:%02d:%02d" hour minute second)))
-;;(defun archive-unixdate (low high)
-;; "Stringify unix (LOW HIGH) date."
-;; (let ((str (current-time-string (cons high low))))
-;; (format "%s-%s-%s"
-;; (substring str 8 9)
-;; (substring str 4 7)
-;; (substring str 20 24))))
+(defun archive-unixdate (low high)
+ "Stringify unix (LOW HIGH) date."
+ (let ((str (current-time-string (cons high low))))
+ (format "%s-%s-%s"
+ (substring str 8 10)
+ (substring str 4 7)
+ (substring str 20 24))))
-;;(defun archive-unixtime (low high)
-;; "Stringify unix (LOW HIGH) time."
-;; (let ((str (current-time-string (cons high low))))
-;; (substring str 11 19)))
+(defun archive-unixtime (low high)
+ "Stringify unix (LOW HIGH) time."
+ (let ((str (current-time-string (cons high low))))
+ (substring str 11 19)))
(defun archive-get-lineno ()
(if (>= (point) archive-file-list-start)
(make-local-variable 'archive-file-list-start)
(make-local-variable 'archive-file-list-end)
(make-local-variable 'archive-file-name-indent)
- (set-buffer-multibyte t 'to))
+ (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))))
;; Not a nice "solution" but it'll have to do
(define-key archive-mode-map "\C-xu" 'archive-undo)
(define-key archive-mode-map "\C-_" 'archive-undo))
- (substitute-key-definition 'undo 'archive-undo
- archive-mode-map global-map))
+ (define-key archive-mode-map [remap advertised-undo] 'archive-undo)
+ (define-key archive-mode-map [remap undo] 'archive-undo))
(define-key archive-mode-map
(if archive-lemacs 'button2 [mouse-2]) 'archive-mouse-extract)
Optional argument SHUT-UP, if non-nil, means don't print messages
when parsing the archive."
(widen)
- (set-buffer-multibyte nil)
(let (buffer-read-only)
(or shut-up
(message "Parsing archive file..."))
(apply
(function concat)
(mapcar
- (function
+ (function
(lambda (fil)
;; Using `concat' here copies the text also, so we can add
;; properties without problems.
(if (or alien (file-exists-p fullname))
(make-temp-file
(expand-file-name
- (if (and (fboundp 'msdos-long-file-names)
- (not (msdos-long-file-names)))
+ (if (if (fboundp 'msdos-long-file-names)
+ (not (msdos-long-file-names)))
"am"
"arc-mode.")
dir))
(setq last-coding-system-used coding))
(set-buffer-modified-p nil)
(kill-local-variable 'buffer-file-coding-system)
- (after-insert-file-set-buffer-file-coding-system (- (point-max)
- (point-min))))))
+ (after-insert-file-set-coding (- (point-max) (point-min))))))
(defun archive-mouse-extract (event)
"Extract a file whose name you click on."
view-p
(string-match file-name-invalid-regexp ename)))
(buffer (get-buffer bufname))
- (just-created nil))
+ (just-created nil)
+ (file-name-coding archive-file-name-coding-system))
(if buffer
nil
(setq archive (archive-maybe-copy archive))
(make-local-variable 'local-write-file-hooks)
(add-hook 'local-write-file-hooks 'archive-write-file-member)
(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 (buffer-file-name)
- (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))
(csize (archive-l-e (+ p 15) 4))
(moddate (archive-l-e (+ p 19) 2))
(modtime (archive-l-e (+ p 21) 2))
(defun archive-arc-rename-entry (archive newname descr)
(if (string-match "[:\\\\/]" newname)
- (error "File names in arc files may not contain a path"))
+ (error "File names in arc files must not contain a directory component"))
(if (> (length newname) 12)
(error "File names in arc files are limited to 12 characters"))
(let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0"
(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
(maxlen 8)
files
visual)
- (while (progn (goto-char p)
+ (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))
- (csize (archive-l-e (+ p 7) 4))
- (ucsize (archive-l-e (+ p 11) 4))
- (modtime (archive-l-e (+ p 15) 2))
- (moddate (archive-l-e (+ p 17) 2))
- (hdrlvl (byte-after (+ p 20)))
- (fnlen (byte-after (+ p 21)))
- (efnname (let ((str (buffer-substring (+ p 22) (+ p 22 fnlen))))
++ (let* ((hsize (byte-after p)) ;size of the base header (level 0 and 1)
+ (csize (archive-l-e (+ p 7) 4)) ;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)) ;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 fiddle ifnname width p2 creator
+ neh ;beginning of next extension header (level 1 and 2)
+ mode modestr uid gid text dir prname
+ 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)))
- (fiddle (string= efnname (upcase efnname)))
- (ifnname (if fiddle (downcase efnname) efnname))
- (width (string-width ifnname))
- (p2 (+ p 22 fnlen))
- (creator (if (>= (- hsize fnlen) 24) (byte-after (+ p2 2)) 0))
- mode modestr uid gid text path prname
- )
- (if (= hdrlvl 0)
- (setq mode (if (= creator ?U) (archive-l-e (+ p2 8) 2) ?\666)
- uid (if (= creator ?U) (archive-l-e (+ p2 10) 2))
- gid (if (= creator ?U) (archive-l-e (+ p2 12) 2)))
- (if (= creator ?U)
- (let* ((p3 (+ p2 3))
- (hsize (archive-l-e p3 2))
- (etype (byte-after (+ p3 2))))
- (while (not (= hsize 0))
+ (setq p2 (+ p 22 fnlen))) ;
+ (if (= hdrlvl 1)
+ (progn ;specific to level 1 header
- (setq creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))
++ (setq creator (if (>= (- hsize fnlen) 24) (byte-after (+ p2 2)) 0))
+ (setq neh (+ p2 3)))
+ (if (= hdrlvl 2)
+ (progn ;specific to level 2 header
- (setq creator (char-after (+ p 23)) )
++ (setq creator (byte-after (+ p 23)) )
+ (setq neh (+ p 24)))))
+ (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 2) (let ((i (+ p3 3)))
- (while (< i (+ p3 hsize))
- (setq path (concat path
+ ((= 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
- (byte-after i)))))
+ (char-after i)))))
(setq i (1+ i)))))
- ((= etype 80) (setq mode (archive-l-e (+ p3 3) 2)))
- ((= etype 81) (progn (setq uid (archive-l-e (+ p3 3) 2))
- (setq gid (archive-l-e (+ p3 5) 2))))
+ ((= etype 80) ;Unix file permission
+ (setq mode (archive-l-e (+ neh 3) 2)))
+ ((= etype 81) ;UNIX file group/user ID
+ (progn (setq uid (archive-l-e (+ neh 3) 2))
+ (setq gid (archive-l-e (+ neh 5) 2))))
+ ((= etype 82) ;UNIX file group name
+ (let ((i (+ neh 3)))
+ (while (< i (+ neh ehsize))
+ (setq gname (concat gname (char-to-string (char-after i))))
+ (setq i (1+ i)))))
+ ((= etype 83) ;UNIX file user name
+ (let ((i (+ neh 3)))
+ (while (< i (+ neh ehsize))
+ (setq uname (concat uname (char-to-string (char-after i))))
+ (setq i (1+ i)))))
)
- (setq p3 (+ p3 hsize))
- (setq hsize (archive-l-e p3 2))
- (setq etype (byte-after (+ p3 2)))))))
- (setq prname (if path (concat path ifnname) ifnname))
+ (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 thsize hsize))
+ (setq fiddle (if efnname (string= efnname (upcase efnname))))
+ (setq ifnname (if fiddle (downcase efnname) efnname))
+ (setq prname (if dir (concat dir ifnname) ifnname))
+ (setq width (if prname (string-width prname) 0))
(setq modestr (if mode (archive-int-to-mode mode) "??????????"))
+ (setq moddate (if (= hdrlvl 2)
+ (archive-unixdate time1 time2) ;level 2 header in UNIX format
+ (archive-dosdate time2))) ;level 0 and 1 header in DOS format
+ (setq modtime (if (= hdrlvl 2)
+ (archive-unixtime time1 time2)
+ (archive-dostime time1)))
(setq text (if archive-alternate-display
(format " %8d %5S %5S %s"
ucsize
(format " %10s %8d %-11s %-8s %s"
modestr
ucsize
- (archive-dosdate moddate)
- (archive-dostime modtime)
- ifnname)))
+ moddate
+ modtime
+ prname)))
(setq maxlen (max maxlen width)
totalsize (+ totalsize ucsize)
visual (cons (vector text
- (- (length text) (length ifnname))
+ (- (length text) (length prname))
(length text))
visual)
files (cons (vector prname ifnname fiddle mode (1- p))
- files)
- p (+ p hsize 2 csize))))
+ files))
+ (cond ((= hdrlvl 1)
+ (setq p (+ p hsize 2 csize)))
+ ((or (= hdrlvl 2) (= hdrlvl 0))
+ (setq p (+ p thsize 2 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)))
buffer-read-only)
(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-restriction
(save-excursion
(widen)
- (set-buffer-multibyte nil)
(while files
(let* ((fil (car files))
(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))
buffer-read-only)
(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)))
(setq files (cdr files))))))
(defun archive-zip-summarize ()
(goto-char (- (point-max) (- 22 18)))
(search-backward-regexp "[P]K\005\006")
- (let ((p (1+ (archive-l-e (+ (point) 16) 4)))
+ (let ((p (+ (point-min) (archive-l-e (+ (point) 16) 4)))
(maxlen 8)
(totalsize 0)
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) "??????????"))
(apply 'vector (nreverse files))))
(defun archive-zip-extract (archive name)
- (if archive-zip-use-pkzip
+ (if (equal (car archive-zip-extract) "pkzip")
(archive-*-extract archive name archive-zip-extract)
(archive-extract-by-stdout archive name archive-zip-extract)))
(save-restriction
(save-excursion
(widen)
- (set-buffer-multibyte nil)
(while files
(let* ((fil (car files))
(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))
buffer-read-only)
(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"))))
(setq files (cdr files))))))
(modtime (archive-l-e (+ p 16) 2))
(ucsize (archive-l-e (+ p 20) 4))
(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))
;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
;;; Special formatting conventions are used in this file!
;;;
-;;; a backslash-newline is used at the beginning of a documentation string
+;;; A backslash-newline is used at the beginning of a documentation string
;;; when that string should be stored in the file etc/DOCnnn, not in core.
;;;
;;; Such strings read into Lisp as numbers (during the pure-loading phase).
"Local keymap for the coding-system part of the mode line.")
+(defun mode-line-change-eol ()
+ "Cycle through the various possible kinds of end-of-line styles."
+ (interactive)
+ (let ((eol (coding-system-eol-type buffer-file-coding-system)))
+ (set-buffer-file-coding-system
+ (cond ((eq eol 0) 'dos) ((eq eol 1) 'mac) (t 'unix)))))
+
+(defvar mode-line-eol-desc-cache nil)
+
+(defun mode-line-eol-desc ()
+ (let* ((eol (coding-system-eol-type buffer-file-coding-system))
+ (mnemonic (coding-system-eol-type-mnemonic buffer-file-coding-system))
+ (desc (assq eol mode-line-eol-desc-cache)))
+ (if (and desc (eq (cadr desc) mnemonic))
+ (cddr desc)
+ (if desc (setq mode-line-eol-desc-cache nil)) ;Flush the cache if stale.
+ (setq desc
+ (propertize
+ mnemonic
+ 'help-echo (format "%s end-of-line; mouse-3 to cycle"
+ (if (eq eol 0) "Unix-style LF"
+ (if (eq eol 1) "Dos-style CRLF"
+ (if (eq eol 2) "Mac-style CR"
+ "Undecided"))))
+ 'keymap
+ (eval-when-compile
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line mouse-3] 'mode-line-change-eol)
+ map))))
+ (push (cons eol (cons mnemonic desc)) mode-line-eol-desc-cache)
+ desc)))
+
(defvar mode-line-mule-info
`(""
(current-input-method
- (:eval
- ,(purecopy
- '(propertize current-input-method-title
- 'help-echo (concat
- "Input method: "
- current-input-method
- ". mouse-2: disable, mouse-3: describe")
- 'local-map mode-line-input-method-map))))
+ (:propertize ("" current-input-method-title)
+ help-echo (concat
+ "Input method: "
+ current-input-method
+ ". mouse-2: disable, mouse-3: describe")
+ local-map ,mode-line-input-method-map))
,(propertize
- "%Z"
+ "%z"
'help-echo
- (purecopy (lambda (window object point)
- (save-window-excursion
- (select-window window)
- ;; Don't show this tip if the coding system is nil,
- ;; it reads like a bug, and is not useful anyway.
- (when buffer-file-coding-system
- (if enable-multibyte-characters
- (concat (symbol-name buffer-file-coding-system)
- " buffer; mouse-3: describe coding system")
- (concat "Unibyte "
- (symbol-name buffer-file-coding-system)
- " buffer"))))))
- 'local-map mode-line-coding-system-map))
+ #'(lambda (window object point)
+ (with-current-buffer (window-buffer window)
+ ;; Don't show this tip if the coding system is nil,
+ ;; it reads like a bug, and is not useful anyway.
+ (when buffer-file-coding-system
+ (if enable-multibyte-characters
+ (concat (symbol-name buffer-file-coding-system)
+ " buffer; mouse-3: describe coding system")
+ (concat "Unibyte " (symbol-name buffer-file-coding-system)
+ " buffer")))))
+ 'local-map mode-line-coding-system-map)
+ (:eval (mode-line-eol-desc)))
"Mode-line control for displaying information of multilingual environment.
Normally it displays current input method (if any activated) and
mnemonics of the following coding systems:
coding system for saving or writing the current buffer
coding system for keyboard input (if Emacs is running on terminal)
coding system for terminal output (if Emacs is running on terminal)"
-;;; Currently not:
-;;; coding system for decoding output of buffer process (if any)
-;;; coding system for encoding text to send to buffer process (if any)."
+ ;; Currently not:
+ ;; coding system for decoding output of buffer process (if any)
+ ;; coding system for encoding text to send to buffer process (if any)."
)
(make-variable-buffer-local 'mode-line-mule-info)
(defvar mode-line-modes nil
"Mode-line control for displaying major and minor modes.")
-(defvar mode-line-minor-mode-keymap nil "\
-Keymap to display on major and minor modes.")
+(defvar mode-line-major-mode-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line mouse-2] 'describe-mode)
+ (define-key map [mode-line down-mouse-3] 'mode-line-mode-menu-1)
+ map) "\
+Keymap to display on major mode.")
-;; Menu of minor modes.
-(let ((map (make-sparse-keymap)))
- (define-key map [mode-line down-mouse-3] 'mode-line-mode-menu-1)
- (define-key map [header-line down-mouse-3] 'mode-line-mode-menu-1)
- (setq mode-line-minor-mode-keymap map))
+(defvar mode-line-minor-mode-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line mouse-2] 'mode-line-minor-mode-help)
+ (define-key map [mode-line down-mouse-3] 'mode-line-mode-menu-1)
+ (define-key map [header-line down-mouse-3] 'mode-line-mode-menu-1)
+ map) "\
+Keymap to display on minor modes.")
(let* ((help-echo
;; The multi-line message doesn't work terribly well on the
;; "\
;; mouse-1: select window, mouse-2: delete others, mouse-3: delete,
;; drag-mouse-1: resize, C-mouse-2: split horizontally"
- "mouse-1: select (drag to resize), mouse-2: delete others, mouse-3: delete")
+ "mouse-1: select (drag to resize), mouse-2: delete others, mouse-3: delete this")
(dashes (propertize "--" 'help-echo help-echo)))
(setq-default mode-line-format
(list
'mode-line-frame-identification
'mode-line-buffer-identification
(propertize " " 'help-echo help-echo)
- 'global-mode-string
+ 'mode-line-position
+ '(vc-mode vc-mode)
+ (propertize " " 'help-echo help-echo)
'mode-line-modes
`(which-func-mode ("" which-func-format ,dashes))
- 'mode-line-position
+ `(global-mode-string (,dashes global-mode-string))
(propertize "-%-" 'help-echo help-echo)))
(setq-default mode-line-modes
(list
- (propertize " %[(" 'help-echo help-echo)
- `(:propertize ("" mode-name mode-line-process minor-mode-alist)
- help-echo "mouse-3: minor mode menu"
+ (propertize "%[(" 'help-echo help-echo)
+ `(:propertize ("" mode-name)
+ help-echo "mouse-2: help for current major mode"
+ local-map ,mode-line-major-mode-keymap)
+ `(:propertize ("" mode-line-process))
+ `(:propertize ("" minor-mode-alist)
+ help-echo "mouse-2: help for minor modes, mouse-3: minor mode menu"
local-map ,mode-line-minor-mode-keymap)
(propertize "%n" 'help-echo "mouse-2: widen"
'local-map (make-mode-line-mouse-map
(propertize ")%]--" 'help-echo help-echo)))
(setq-default mode-line-position
- `((line-number-mode (,(propertize "L%l" 'help-echo help-echo) ,dashes))
- (column-number-mode (,(propertize "C%c" 'help-echo help-echo) ,dashes))
- (-3 . ,(propertize "%p" 'help-echo help-echo)))))
+ `((-3 . ,(propertize "%p" 'help-echo help-echo))
+ (line-number-mode
+ ((column-number-mode
+ (10 ,(propertize " (%l,%c)" 'help-echo help-echo))
+ (6 ,(propertize " L%l" 'help-echo help-echo))))
+ ((column-number-mode
+ (5 ,(propertize " C%c" 'help-echo help-echo))))))))
(defvar mode-line-buffer-identification-keymap nil "\
Keymap for what is displayed by `mode-line-buffer-identification'.")
(defun last-buffer () "\
Return the last non-hidden buffer in the buffer list."
- (let ((list (reverse (buffer-list))))
- (while (eq (aref (buffer-name (car list)) 0) ? )
- (setq list (cdr list)))
- (car list)))
+ ;; This logic is more or less copied from bury-buffer,
+ ;; except that we reverse the buffer list.
+ (let ((list (nreverse (buffer-list (selected-frame))))
+ (pred (frame-parameter nil 'buffer-predicate))
+ found notsogood)
+ (while (and list (not found))
+ (unless (or (eq (aref (buffer-name (car list)) 0) ? )
+ ;; If the selected frame has a buffer_predicate,
+ ;; disregard buffers that don't fit the predicate.
+ (and pred (not (funcall pred (car list)))))
+ (if (get-buffer-window (car list) 'visible)
+ (or notsogood (eq (car list) (current-buffer)))
+ (setq found (car list))))
+ (pop list))
+ (or found notsogood
+ (get-buffer "*scratch*")
+ (progn
+ (set-buffer-major-mode
+ (get-buffer-create "*scratch*"))
+ (get-buffer "*scratch*")))))
(defun unbury-buffer () "\
Switch to the last buffer in the buffer list."
`(menu-item ,(purecopy "Hide ifdef (Ifdef)") hide-ifdef-mode
:button (:toggle . (bound-and-true-p hide-ifdef-mode))))
(define-key mode-line-mode-menu [font-lock-mode]
- `(menu-item ,(purecopy "Font-lock") font-lock-mode
+ `(menu-item ,(purecopy "Font Lock") font-lock-mode
:button (:toggle . font-lock-mode)))
(define-key mode-line-mode-menu [flyspell-mode]
`(menu-item ,(purecopy "Flyspell (Fly)") flyspell-mode
`(menu-item ,(purecopy "Column number") column-number-mode
:button (:toggle . column-number-mode)))
(define-key mode-line-mode-menu [auto-fill-mode]
- `(menu-item ,(purecopy "Auto-fill (Fill)") auto-fill-mode
+ `(menu-item ,(purecopy "Auto Fill (Fill)") auto-fill-mode
:button (:toggle . auto-fill-function)))
(define-key mode-line-mode-menu [auto-revert-mode]
`(menu-item ,(purecopy "Auto revert (ARev)") auto-revert-mode
(interactive "@e")
(x-popup-menu event mode-line-mode-menu))
+(defun mode-line-minor-mode-help (event)
+ "Describe minor mode for EVENT occured on minor modes area of the mode line."
+ (interactive "@e")
+ (let ((indicator (car (nth 4 (car (cdr event))))))
+ (describe-minor-mode-from-indicator indicator)))
+
;; Add menu of buffer operations to the buffer identification part
;; of the mode line.or header line.
;
".fasl" ".ufsl" ".fsl" ".dxl"
;; Libtool
".lo" ".la"
+ ;; Gettext
+ ".gmo" ".mo"
;; Texinfo-related
".toc" ".log" ".aux"
".cp" ".fn" ".ky" ".pg" ".tp" ".vr"
;; 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
- (set-char-table-default table (car l) 'self-insert-command)
- (setq l (cdr l))))
(setq help-event-list '(help f1))
(make-variable-buffer-local 'minor-mode-overriding-map-alist)
-;; From macros.c
-(define-key ctl-x-map "(" 'start-kbd-macro)
-(define-key ctl-x-map ")" 'end-kbd-macro)
-(define-key ctl-x-map "e" 'call-last-kbd-macro)
;; From frame.c
(global-set-key [switch-frame] 'handle-switch-frame)
+(global-set-key [select-window] 'handle-select-window)
+
+;; FIXME: Do those 3 events really ever reach the global-map ?
+;; It seems that they can't because they're handled via
+;; special-event-map which is used at very low-level. -stef
(global-set-key [delete-frame] 'handle-delete-frame)
(global-set-key [iconify-frame] 'ignore-event)
(global-set-key [make-frame-visible] 'ignore-event)
;(define-key global-map [delete] 'backward-delete-char)
;; natural bindings for terminal keycaps --- defined in X keysym order
+(define-key global-map [C-S-backspace] 'kill-whole-line)
(define-key global-map [home] 'beginning-of-line)
(define-key global-map [C-home] 'beginning-of-buffer)
(define-key global-map [M-home] 'beginning-of-buffer-other-window)
(define-key esc-map [?\C-\ ] 'mark-sexp)
(define-key esc-map "\C-d" 'down-list)
(define-key esc-map "\C-k" 'kill-sexp)
-(define-key global-map [C-M-delete] 'backward-kill-sexp)
-(define-key global-map [C-M-backspace] 'backward-kill-sexp)
+;;; These are dangerous in various situations,
+;;; so let's not encourage anyone to use them.
+;;;(define-key global-map [C-M-delete] 'backward-kill-sexp)
+;;;(define-key global-map [C-M-backspace] 'backward-kill-sexp)
(define-key esc-map [C-delete] 'backward-kill-sexp)
(define-key esc-map [C-backspace] 'backward-kill-sexp)
(define-key esc-map "\C-n" 'forward-list)
;;; Commentary:
+;; Written by:
+;; TN/ETX/TX/UMG Howard Gayle UUCP : seismo!enea!erix!howard
+;; Telefonaktiebolaget L M Ericsson Phone: +46 8 719 55 65
+;; Ericsson Telecom Telex: 14910 ERIC S
+;; S-126 25 Stockholm FAX : +46 8 719 64 82
+;; Sweden
+
;;; 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)
;; Clear out the extra slots so that they will be
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."
- (unless (= (charset-bytes (char-charset uc))
- (charset-bytes (char-charset lc)))
- (error "Can't casify chars with different `charset-bytes' values"))
- (setq uc (set-case-syntax-1 uc))
- (setq lc (set-case-syntax-1 lc))
(aset table uc lc)
(aset table lc lc)
(set-char-table-extra-slot table 0 nil)
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)
(set-char-table-extra-slot table 0 nil)
(set-char-table-extra-slot table 1 nil)
;;; Code:
- ;;;###autoload
(defconst reference-point-alist
'((tl . 0) (tc . 1) (tr . 2)
(Bl . 3) (Bc . 4) (Br . 5)
(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))
+ (error "Invalid composition rule: %S" rule))
(+ (* gref 12) nref))))
;; Decode encoded composition rule RULE-CODE. The value is a cons of
(setq i (+ i 2))))
components)
- ;;;###autoload
(defun compose-region (start end &optional components modification-func)
"Compose characters in the current region.
+Characters are composed relatively, i.e. composed by overstricking or
+stacking depending on ascent, descent and other properties.
+
When called from a program, expects these four arguments.
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.
+sequence (vector, list, or string) of integers. In this case,
+characters are composed not relatively but according to COMPONENTS.
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)
(set-buffer-modified-p modified-p)))
- ;;;###autoload
(defun decompose-region (start end)
"Decompose text in the current region.
(remove-text-properties start end '(composition nil))
(set-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
- STRING to be composed. They defaults to the beginning and the end of
+ STRING to be composed. They default to the beginning and the end of
STRING respectively.
Optional 4th argument COMPONENTS, if non-nil, is a character or a
(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.
(when tail
(save-match-data
(save-excursion
- (while (and tail (not func))
+ (while (and tail (not func))
(setq pattern (car (car tail))
func (cdr (car tail)))
(goto-char 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.
+
+ Each function is called with two arguments, POS and STRING.
+
+ If STRING is nil, POS is a position in the current buffer, and the
+ function has to compose a character at POS with surrounding characters
+ in the current buffer.
+
+ Otherwise, STRING is a string, and POS is an index to the string. In
+ this case, the function has to compose a character at POS with
+ surrounding characters in the string.
+
+ See also the command `toggle-auto-composition'.")
+
+ ;; Copied from font-lock.el.
+ (eval-when-compile
+ ;;
+ ;; We don't do this at the top-level as we only use non-autoloaded macros.
+ (require 'cl)
+ ;;
+ ;; 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))))
+ (put 'save-buffer-state 'lisp-indent-function 1)
+ ;; Fixme: This makes bootstrapping fails by this error.
+ ;; Symbol's function definition is void: eval-defun
+ ;;(def-edebug-spec save-buffer-state let)
+ )
+
+ (defvar auto-composition-chunk-size 500
+ "*Automatic composition chunks of this many characters, or smaller.")
+
+ (defun auto-compose-chars (pos string)
+ "Compose characters after the buffer position POS.
+ If STRING is non-nil, it is a string, and POS is an index to 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* ((start pos)
+ (end (if string (length string) (point-max)))
+ (limit (next-single-property-change pos 'auto-composed string
+ end))
+ (lines 0)
+ ch func newpos)
+ (if (> (- limit start) auto-composition-chunk-size)
+ (setq limit (+ start auto-composition-chunk-size)))
+ (while (and (< pos end)
+ (setq ch (if string (aref string pos)
+ (char-after pos)))
+ (or (< pos limit)
+ (/= ch ?\n)))
+ (setq func (aref composition-function-table ch))
+ (if (fboundp func)
+ (setq newpos (funcall func pos string)
+ pos (if (and (integerp newpos) (> newpos pos))
+ newpos
+ (1+ pos)))
+ (setq pos (1+ pos))))
+ (if (< pos limit)
+ (setq pos (1+ pos)))
+ (put-text-property start pos 'auto-composed t string)))))))
+
+ (setq auto-composition-function 'auto-compose-chars)
+
+ (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)
+ (put-text-property (point-min) (point-max) 'auto-composed nil)))))
\f
;;; The following codes are only for backward compatibility with Emacs
-;;; 20.4 and the earlier.
+;;; 20.4 and earlier.
- ;;;###autoload
(defun decompose-composite-char (char &optional type with-composition-rule)
"Convert CHAR to string.
-This is only for backward compatibility with Emacs 20.4 and the earlier.
If optional 2nd arg TYPE is non-nil, it is `string', `list', or
-`vector'. In this case, CHAR is converted string, list of CHAR, or
-vector of CHAR respectively."
+`vector'. In this case, CHAR is converted to string, list of CHAR, or
+vector of CHAR respectively.
+Optional 3rd arg WITH-COMPOSITION-RULE is ignored."
(cond ((or (null type) (eq type 'string)) (char-to-string char))
((eq type 'list) (list char))
(t (vector char))))
- ;;;###autoload
(make-obsolete 'decompose-composite-char 'char-to-string "21.1")
\f
;;; Code:
-(let ((all '(;; abbrev.c
+(let ((all '(;; abbrev.c
(abbrev-all-caps abbrev-mode boolean)
(pre-abbrev-expand-hook abbrev-mode hook)
;; alloc.c
(ctl-arrow display boolean)
(truncate-lines display boolean)
(selective-display-ellipses display boolean)
- (transient-mark-mode editing-basics boolean)
(indicate-empty-lines display boolean "21.1")
- (scroll-up-aggressively windows boolean "21.1")
- (scroll-down-aggressively windows boolean "21.1")
+ (scroll-up-aggressively windows
+ (choice (const :tag "off" nil) number)
+ "21.1")
+ (scroll-down-aggressively windows
+ (choice (const :tag "off" nil) number)
+ "21.1")
;; callint.c
(mark-even-if-inactive editing-basics boolean)
;; callproc.c
(exec-path execute
(repeat (choice (const :tag "default" nil)
(file :format "%v"))))
+ ;; charset.c
+ (charset-map-directory installation directory)
;; coding.c
(inhibit-eol-conversion mule boolean)
(eol-mnemonic-undecided mule string)
(function :value ignore))))
(selection-coding-system mule coding-system)
;; dired.c
- (completion-ignored-extensions dired
+ (completion-ignored-extensions dired
(repeat (string :format "%v")))
;; dispnew.c
(baud-rate display integer)
:value (nil)
(symbol :format "%v"))
(const :tag "always" t)))
- (debug-on-error debug
+ (debug-on-error debug
(choice (const :tag "off")
(repeat :menu-tag "When"
:value (nil)
(polling-period keyboard integer)
(double-click-time mouse (restricted-sexp
:match-alternatives (integerp 'nil 't)))
+ (double-click-fuzz mouse integer)
(inhibit-local-menu-bar-menus menu boolean)
(help-char keyboard character)
(help-event-list keyboard (repeat (sexp :format "%v")))
;; version-specific directories when you upgrade. We need
;; customization of the front of the list, maintaining the standard
;; value intact at the back.
-;;; (load-path environment
+;;; (load-path environment
;;; (repeat (choice :tag "[Current dir?]"
;;; :format "%[Current dir?%] %v"
;;; (const :tag " current dir" nil)
(display-buffer-function windows (choice (const nil) function))
(pop-up-frames frames boolean)
(pop-up-frame-function frames function)
- (special-display-buffer-names
- frames
+ (special-display-buffer-names
+ frames
(repeat (choice :tag "Buffer"
:value ""
(string :format "%v")
(symbol :tag "Parameter")
(sexp :tag "Value")))))))
(special-display-regexps
- frames
+ frames
(repeat (choice :tag "Buffer"
:value ""
(regexp :format "%v")
(scroll-step windows integer)
(scroll-conservatively windows integer)
(scroll-margin windows integer)
- (automatic-hscroll-margin windows integer "21.3")
- (automatic-hscroll-step windows number "21.3")
+ (hscroll-margin windows integer "21.3")
+ (hscroll-step windows number "21.3")
(truncate-partial-width-windows display boolean)
(mode-line-inverse-video modeline boolean)
(mode-line-in-non-selected-windows modeline boolean "21.3")
(x-bitmap-file-path installation
(repeat (directory :format "%v")))
;; xterm.c
- (x-autoselect-window display boolean "21.3")
+ (mouse-autoselect-window display boolean "21.3")
(x-use-underline-position-properties display boolean "21.3")
(x-stretch-cursor display boolean "21.1")))
this symbol group type native-p version
(numberp sexp))
sexp
(list 'quote sexp)))))
- (while all
+ (while all
(setq this (car all)
all (cdr all)
symbol (nth 0 this)
(message "Note, built-in variable `%S' not bound" symbol))
;; Save the standard value, unless we already did.
(or (get symbol 'standard-value)
- (put symbol 'standard-value
+ (put symbol 'standard-value
(list (funcall quoter (default-value symbol)))))
;; If this is NOT while dumping Emacs,
;; set up the rest of the customization info.
(put symbol 'custom-version version)))))
(custom-add-to-group 'iswitchb 'read-buffer-function 'custom-variable)
+(put 'selection-coding-system 'custom-set
+ (lambda (symbol value)
+ (set-selection-coding-system value)
+ (set symbol value)))
;; Record cus-start as loaded
;; if we have set up all the info that we can set up.
--- /dev/null
- item-list max-width unicode)
- (if (eq charset 'unknown)
+;;; descr-text.el --- describe text mode
+
+;; Copyright (c) 1994, 1995, 1996, 2001, 02, 03 Free Software Foundation, Inc.
+
+;; Author: Boris Goldowsky <boris@gnu.org>
+;; Keywords: faces
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Describe-Text Mode.
+
+;;; Code:
+
+(eval-when-compile (require 'button))
+
+(defun describe-text-done ()
+ "Delete the current window or bury the current buffer."
+ (interactive)
+ (if (> (count-windows) 1)
+ (delete-window)
+ (bury-buffer)))
+
+(defvar describe-text-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map widget-keymap)
+ map)
+ "Keymap for `describe-text-mode'.")
+
+(defcustom describe-text-mode-hook nil
+ "List of hook functions ran by `describe-text-mode'."
+ :type 'hook
+ :group 'facemenu)
+
+(defun describe-text-mode ()
+ "Major mode for buffers created by `describe-char'.
+
+\\{describe-text-mode-map}
+Entry to this mode calls the value of `describe-text-mode-hook'
+if that value is non-nil."
+ (kill-all-local-variables)
+ (setq major-mode 'describe-text-mode
+ mode-name "Describe-Text")
+ (use-local-map describe-text-mode-map)
+ (widget-setup)
+ (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
+ (run-hooks 'describe-text-mode-hook))
+
+;;; Describe-Text Utilities.
+
+(defun describe-text-widget (widget)
+ "Insert text to describe WIDGET in the current buffer."
+ (widget-create 'link
+ :notify `(lambda (&rest ignore)
+ (widget-browse ',widget))
+ (format "%S" (if (symbolp widget)
+ widget
+ (car widget))))
+ (widget-insert " ")
+ (widget-create 'info-link :tag "widget" "(widget)Top"))
+
+(defun describe-text-sexp (sexp)
+ "Insert a short description of SEXP in the current buffer."
+ (let ((pp (condition-case signal
+ (pp-to-string sexp)
+ (error (prin1-to-string signal)))))
+ (when (string-match "\n\\'" pp)
+ (setq pp (substring pp 0 (1- (length pp)))))
+ (if (cond ((string-match "\n" pp)
+ nil)
+ ((> (length pp) (- (window-width) (current-column)))
+ nil)
+ (t t))
+ (widget-insert pp)
+ (widget-create 'push-button
+ :tag "show"
+ :action (lambda (widget &optional event)
+ (with-output-to-temp-buffer
+ "*Pp Eval Output*"
+ (princ (widget-get widget :value))))
+ pp))))
+
+(defun describe-property-list (properties)
+ "Insert a description of PROPERTIES in the current buffer.
+PROPERTIES should be a list of overlay or text properties.
+The `category' property is made into a widget button that call
+`describe-text-category' when pushed."
+ ;; Sort the properties by the size of their value.
+ (dolist (elt (sort (let ((ret nil)
+ (key nil)
+ (val nil)
+ (len nil))
+ (while properties
+ (setq key (pop properties)
+ val (pop properties)
+ len 0)
+ (unless (or (eq key 'category)
+ (widgetp val))
+ (setq val (pp-to-string val)
+ len (length val)))
+ (push (list key val len) ret))
+ ret)
+ (lambda (a b)
+ (< (nth 2 a)
+ (nth 2 b)))))
+ (let ((key (nth 0 elt))
+ (value (nth 1 elt)))
+ (widget-insert (propertize (format " %-20s " key)
+ 'font-lock-face 'italic))
+ (cond ((eq key 'category)
+ (widget-create 'link
+ :notify `(lambda (&rest ignore)
+ (describe-text-category ',value))
+ (format "%S" value)))
+ ((widgetp value)
+ (describe-text-widget value))
+ (t
+ (widget-insert value))))
+ (widget-insert "\n")))
+\f
+;;; Describe-Text Commands.
+
+(defun describe-text-category (category)
+ "Describe a text property category."
+ (interactive "S")
+ (save-excursion
+ (with-output-to-temp-buffer "*Help*"
+ (set-buffer standard-output)
+ (widget-insert "Category " (format "%S" category) ":\n\n")
+ (describe-property-list (symbol-plist category))
+ (describe-text-mode)
+ (goto-char (point-min)))))
+
+;;;###autoload
+(defun describe-text-properties (pos &optional output-buffer)
+ "Describe widgets, buttons, overlays and text properties at POS.
+Interactively, describe them for the character after point.
+If optional second argument OUTPUT-BUFFER is non-nil,
+insert the output into that buffer, and don't initialize or clear it
+otherwise."
+ (interactive "d")
+ (if (>= pos (point-max))
+ (error "No character follows specified position"))
+ (if output-buffer
+ (describe-text-properties-1 pos output-buffer)
+ (if (not (or (text-properties-at pos) (overlays-at pos)))
+ (message "This is plain text.")
+ (let ((buffer (current-buffer)))
+ (when (eq buffer (get-buffer "*Help*"))
+ (error "Can't do self inspection"))
+ (save-excursion
+ (with-output-to-temp-buffer "*Help*"
+ (set-buffer standard-output)
+ (setq output-buffer (current-buffer))
+ (widget-insert "Text content at position " (format "%d" pos) ":\n\n")
+ (with-current-buffer buffer
+ (describe-text-properties-1 pos output-buffer))
+ (describe-text-mode)
+ (goto-char (point-min))))))))
+
+(defun describe-text-properties-1 (pos output-buffer)
+ (let* ((properties (text-properties-at pos))
+ (overlays (overlays-at pos))
+ overlay
+ (wid-field (get-char-property pos 'field))
+ (wid-button (get-char-property pos 'button))
+ (wid-doc (get-char-property pos 'widget-doc))
+ ;; If button.el is not loaded, we have no buttons in the text.
+ (button (and (fboundp 'button-at) (button-at pos)))
+ (button-type (and button (button-type button)))
+ (button-label (and button (button-label button)))
+ (widget (or wid-field wid-button wid-doc)))
+ (with-current-buffer output-buffer
+ ;; Widgets
+ (when (widgetp widget)
+ (newline)
+ (widget-insert (cond (wid-field "This is an editable text area")
+ (wid-button "This is an active area")
+ (wid-doc "This is documentation text")))
+ (widget-insert " of a ")
+ (describe-text-widget widget)
+ (widget-insert ".\n\n"))
+ ;; Buttons
+ (when (and button (not (widgetp wid-button)))
+ (newline)
+ (widget-insert "Here is a " (format "%S" button-type)
+ " button labeled `" button-label "'.\n\n"))
+ ;; Overlays
+ (when overlays
+ (newline)
+ (if (eq (length overlays) 1)
+ (widget-insert "There is an overlay here:\n")
+ (widget-insert "There are " (format "%d" (length overlays))
+ " overlays here:\n"))
+ (dolist (overlay overlays)
+ (widget-insert " From " (format "%d" (overlay-start overlay))
+ " to " (format "%d" (overlay-end overlay)) "\n")
+ (describe-property-list (overlay-properties overlay)))
+ (widget-insert "\n"))
+ ;; Text properties
+ (when properties
+ (newline)
+ (widget-insert "There are text properties here:\n")
+ (describe-property-list properties)))))
+\f
+;;; We cannot use the UnicodeData.txt file as such; it is not free.
+;;; We can turn that info a different format and release the result
+;;; as free data. When that is done, we could reinstate the code below.
+;;; For the mean time, here is a dummy placeholder.
+;;; -- rms
+(defun describe-char-unicode-data (char) nil)
+
+;;; (defcustom describe-char-unicodedata-file nil
+;;; "Location of Unicode data 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. This facility is mostly of use to people doing
+;;; multilingual development.
+
+;;; This is a fairly large file, not typically present on GNU systems. At
+;;; the time of writing it is at
+;;; <URL:ftp://www.unicode.org/Public/UNIDATA/UnicodeData.txt>."
+;;; :group 'mule
+;;; :version "21.5"
+;;; :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).
+
+;;; ;; Fixme: Check whether this needs updating for Unicode 4.
+;;; (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'."
+;;; (when describe-char-unicodedata-file
+;;; (unless (file-exists-p describe-char-unicodedata-file)
+;;; (error "`unicodedata-file' %s not found" describe-char-unicodedata-file))
+;;; (save-excursion
+;;; ;; Find file in fundamental mode to avoid, e.g. flyspell turned
+;;; ;; on for .txt. Don't use RAWFILE arg in case of DOS line endings.
+;;; (set-buffer (let ((auto-mode-alist))
+;;; (find-file-noselect describe-char-unicodedata-file)))
+;;; (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" describe-char-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)))
+;;; ;; 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))
+;;; ??)))
+;;; 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 (or (decode-char
+;;; 'ucs
+;;; (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))
+;;; ??))))
+;;; (list "Titlecase" (and (nth 13 fields)
+;;; (string (or (decode-char
+;;; 'ucs
+;;; (string-to-number
+;;; (nth 13 fields) 16))
+;;; ??)))))))))))
+\f
+;;;###autoload
+(defun describe-char (pos)
+ "Describe the character after POS (interactively, the character after point).
+The information includes character code, charset and code points in it,
+syntax, category, how the character is encoded in a file,
+character composition information (if relevant),
+as well as widgets, buttons, overlays, and text properties."
+ (interactive "d")
+ (if (>= pos (point-max))
+ (error "No character follows specified position"))
+ (let* ((char (char-after pos))
+ (charset (char-charset char))
+ (buffer (current-buffer))
+ (composition (find-composition pos nil nil t))
+ (composed (if composition (buffer-substring (car composition)
+ (nth 1 composition))))
+ (multibyte-p enable-multibyte-characters)
- ,(format "%s (0%o, %d, 0x%x) -- invalid character code"
- (if (< char 256)
- (single-key-description char)
- (char-to-string char))
- char char char))))
++ item-list max-width)
++ (if (eq charset 'eight-bit)
+ (setq item-list
+ `(("character"
- (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))))
++ ,(format "%s (0%o, %d, 0x%x) -- raw byte 0x%x"
++ (char-to-string char) char char char
++ (multibyte-char-to-unibyte char)))))
+
- ,(format "%s (0%o, %d, 0x%x%s)" (if (< char 256)
+ (setq item-list
+ `(("character"
- char char char
- (if unicode
- (format ", U+%04X" unicode)
- "")))
- ("charset"
++ ,(format "%s (0%o, %d, 0x%x)" (if (< char 256)
+ (single-key-description char)
+ (char-to-string char))
- ,(let ((split (split-char char)))
- (if (= (charset-dimension charset) 1)
- (format "%d" (nth 1 split))
- (format "%d %d" (nth 1 split) (nth 2 split)))))
++ char char char))
++ ("preferred charset"
+ ,(symbol-name charset)
+ ,(format "(%s)" (charset-description charset)))
+ ("code point"
- ,@(let ((unicodedata (and unicode
- (describe-char-unicode-data unicode))))
++ ,(let ((split (split-char char)))
++ (mapconcat #'number-to-string (cdr split) " ")))
+ ("syntax"
+ ,(let ((syntax (syntax-after pos)))
+ (with-temp-buffer
+ (internal-describe-syntax-value syntax)
+ (buffer-string))))
+ ("category"
+ ,@(let ((category-set (char-category-set char)))
+ (if (not category-set)
+ '("-- none --")
+ (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)))))
+ ("buffer code"
+ ,(encoded-string-description
+ (string-as-unibyte (char-to-string char)) nil))
+ ("file code"
+ ,@(let* ((coding buffer-file-coding-system)
+ (encoded (encode-coding-char char coding)))
+ (if encoded
+ (list (encoded-string-description encoded coding)
+ (format "(encoded by coding system %S)" coding))
+ (list "not encodable by coding system"
+ (symbol-name coding)))))
+ ,(if (display-graphic-p (selected-frame))
+ (list "font" (or (internal-char-font pos)
+ "-- none --"))
+ (list "terminal code"
+ (let* ((coding (terminal-coding-system))
+ (encoded (encode-coding-char char coding)))
+ (if encoded
+ (encoded-string-description encoded coding)
+ "not encodable"))))
- (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))
++ ,@(let ((unicodedata (unicode-data char)))
+ (if unicodedata
+ (cons (list "Unicode data" " ") unicodedata))))))
++ (setq max-width (apply #'max (mapcar #'(lambda (x)
++ (if (cadr x)
++ (length (car x))
++ 0))
+ item-list)))
+ (when (eq (current-buffer) (get-buffer "*Help*"))
+ (error "Can't describe char in Help buffer"))
+ (with-output-to-temp-buffer "*Help*"
+ (with-current-buffer standard-output
+ (set-buffer-multibyte multibyte-p)
+ (let ((formatter (format "%%%ds:" max-width)))
+ (dolist (elt item-list)
+ (when (cadr elt)
+ (insert (format formatter (car elt)))
+ (dolist (clm (cdr elt))
+ (when (>= (+ (current-column)
+ (or (string-match "\n" clm)
+ (string-width clm)) 1)
+ (frame-width))
+ (insert "\n")
+ (indent-to (1+ max-width)))
+ (insert " " clm))
+ (insert "\n"))))
+ (when composition
+ (insert "\nComposed with the "
+ (cond
+ ((eq pos (car composition)) "following ")
+ ((eq (1+ pos) (cadr composition)) "preceding ")
+ (t ""))
+ "character(s) `"
+ (cond
+ ((eq pos (car composition)) (substring composed 1))
+ ((eq (1+ pos) (cadr composition)) (substring composed 0 -1))
+ (t (concat (substring composed 0 (- pos (car composition)))
+ "' and `"
+ (substring composed (- (1+ pos) (car composition))))))
+
+ "' to form `" composed "'")
+ (if (nth 3 composition)
+ (insert ".\n")
+ (insert "\nby the rule ("
+ (mapconcat (lambda (x)
+ (format (if (consp x) "%S" "?%c") x))
+ (nth 2 composition)
+ " ")
+ ").\n"
+ "See the variable `reference-point-alist' for "
+ "the meaning of the rule.\n")))
+
+ (let ((output (current-buffer)))
+ (with-current-buffer buffer
+ (describe-text-properties pos output))
+ (describe-text-mode))))))
+
+(defalias 'describe-char-after 'describe-char)
+(make-obsolete 'describe-char-after 'describe-char "21.5")
+
+(provide 'descr-text)
+
+;;; descr-text.el ends here
;; Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk>
+;; Maintainter: Lars Hansen <larsh@math.ku.dk>
;; Keywords: convenience
;; Favourite-brand-of-beer: None, I hate beer.
;; Save window configuration.
;; Recognize more minor modes.
;; Save mark rings.
-;; Start-up with buffer-menu???
;;; Code:
;; We use functions from these modules
;; We can't (require 'mh-e) since that wants to load something.
(mapcar 'require '(info dired reporter)))
+
+(defvar desktop-file-version "206"
+ "Verion number of desktop file format.
+Written into the desktop file and used at desktop read to provide
+backward compatibility.")
+
;; ----------------------------------------------------------------------------
;; USER OPTIONS -- settings you might want to play with.
;; ----------------------------------------------------------------------------
:initialize 'custom-initialize-default
:version "20.3")
-(defcustom desktop-basefilename
+(defcustom desktop-save 'ask-if-new
+ "*When the user changes desktop or quits emacs, should the desktop be saved?
+\(in the current desktop directory)
+ t -- always save.
+ ask -- always ask.
+ ask-if-new -- ask if no desktop file exists, otherwise just save.
+ ask-if-exists -- ask if desktop file exists, otherwise don't save.
+ if-exists -- save if desktop file exists, otherwise don't save.
+ nil -- never save.
+The desktop is never saved when `desktop-enable' is nil."
+ :type '(choice
+ (const :tag "Always save" t)
+ (const :tag "Always ask" ask)
+ (const :tag "Ask if desktop file is new, else do save" ask-if-new)
+ (const :tag "Ask if desktop file exists, else don't save" ask-if-exists)
+ (const :tag "Save if desktop file exists, else don't" if-exists)
+ (const :tag "Never save" nil))
+ :group 'desktop)
+
+(defcustom desktop-base-file-name
(convert-standard-filename ".emacs.desktop")
"File for Emacs desktop, not including the directory name."
:type 'file
:group 'desktop)
+(defvaralias 'desktop-basefilename 'desktop-base-file-name)
+
+(defcustom desktop-path '("." "~")
+ "List of directories to search for the desktop file.
+The base name of the file is specified in `desktop-base-file-name'."
+ :type '(repeat directory)
+ :group 'desktop)
(defcustom desktop-missing-file-warning nil
"*If non-nil then desktop warns when a file no longer exists.
:type 'boolean
:group 'desktop)
-(defvar desktop-globals-to-save
- (list 'desktop-missing-file-warning
- ;; Feature: saving kill-ring implies saving kill-ring-yank-pointer
- ;; 'kill-ring
- 'tags-file-name
- 'tags-table-list
- 'search-ring
- 'regexp-search-ring
- 'register-alist
- ;; 'desktop-globals-to-save ; Itself!
- )
+(defcustom desktop-no-desktop-file-hook nil
+ "Normal hook run after fail of `desktop-read' due to missing desktop file.
+May e.g. be used to show a dired buffer."
+ :type 'hook
+ :group 'desktop)
+
+(defcustom desktop-after-read-hook nil
+ "Normal hook run after a sucessful `desktop-read'.
+May e.g. be used to show a buffer list."
+ :type 'hook
+ :group 'desktop)
+
+(defcustom desktop-save-hook nil
+ "Hook run before desktop saves the state of Emacs.
+This is useful for truncating history lists, for example."
+ :type 'hook
+ :group 'desktop)
+
+(defcustom desktop-globals-to-save '(
+ desktop-missing-file-warning
+ tags-file-name
+ tags-table-list
+ search-ring
+ regexp-search-ring
+ register-alist)
"List of global variables to save when killing Emacs.
An element may be variable name (a symbol)
or a cons cell of the form (VAR . MAX-SIZE),
which means to truncate VAR's value to at most MAX-SIZE elements
-\(if the value is a list) before saving the value.")
-
-(defvar desktop-locals-to-save
- (list 'desktop-locals-to-save ; Itself! Think it over.
- 'truncate-lines
- 'case-fold-search
- 'case-replace
- 'fill-column
- 'overwrite-mode
- 'change-log-default-name
- 'line-number-mode
- )
+\(if the value is a list) before saving the value.
+Feature: Saving `kill-ring' implies saving `kill-ring-yank-pointer'."
+ :type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
+ :group 'desktop)
+
+(defcustom desktop-globals-to-clear '(
+ kill-ring
+ kill-ring-yank-pointer
+ search-ring
+ search-ring-yank-pointer
+ regexp-search-ring
+ regexp-search-ring-yank-pointer)
+ "List of global variables set to clear by `desktop-clear'.
+An element may be variable name (a symbol) or a cons cell of the form
+\(VAR . FORM). Symbols are set to nil and for cons cells VAR is set
+to the value obtained by evaluateing FORM."
+ :type '(repeat (restricted-sexp :match-alternatives (symbolp consp)))
+ :group 'desktop)
+
+(defcustom desktop-clear-preserve-buffers-regexp
+ "^\\*tramp/.+\\*$"
+ "Regexp identifying buffers that `desktop-clear' should not delete."
+ :type 'regexp
+ :group 'desktop)
+
+;; Maintained for backward compatibility
+(defcustom desktop-clear-preserve-buffers
+ '("*scratch*" "*Messages*")
+ "*List of buffer names that `desktop-clear' should not delete."
+ :type '(repeat string)
+ :group 'desktop)
+
+(defvar desktop-locals-to-save '(
+ desktop-locals-to-save ; Itself! Think it over.
+ truncate-lines
+ case-fold-search
+ case-replace
+ fill-column
+ overwrite-mode
+ change-log-default-name
+ line-number-mode)
"List of local variables to save for each buffer.
The variables are saved only when they really are local.")
(make-variable-buffer-local 'desktop-locals-to-save)
;; (ftp) files because they require passwords and whatnot.
;; TAGS files to save time (tags-file-name is saved instead).
(defcustom desktop-buffers-not-to-save
- "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
- "Regexp identifying buffers that are to be excluded from saving."
- :type 'regexp
- :group 'desktop)
+ "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
+ "Regexp identifying buffers that are to be excluded from saving."
+ :type 'regexp
+ :group 'desktop)
;; Skip ange-ftp files
(defcustom desktop-files-not-to-save
:type '(repeat symbol)
:group 'desktop)
-(defcustom desktop-buffer-major-mode nil
- "When desktop creates a buffer, this holds the desired Major mode."
- :type 'symbol
- :group 'desktop)
-
-(defcustom desktop-buffer-file-name nil
- "When desktop creates a buffer, this holds the file name to visit."
- :type '(choice file (const nil))
+(defcustom desktop-file-name-format 'absolute
+ "*Format in which desktop file names should be saved.
+Possible values are:
+ absolute -- Absolute file name.
+ tilde -- Relative to ~.
+ local -- Relative to directory of desktop file."
+ :type '(choice (const absolute) (const tilde) (const local))
:group 'desktop)
-(defcustom desktop-buffer-name nil
- "When desktop creates a buffer, this holds the desired buffer name."
- :type '(choice string (const nil))
- :group 'desktop)
-
-(defvar desktop-buffer-misc nil
- "When desktop creates a buffer, this holds a list of misc info.
-It is used by the `desktop-buffer-handlers' functions.")
-
(defcustom desktop-buffer-misc-functions
'(desktop-buffer-info-misc-data
desktop-buffer-dired-misc-data)
returns non-nil, its value is saved along with the desktop buffer for
which it was called; no further functions will be called.
+File names should formatted using the call
+\"(desktop-file-name FILE-NAME dirname)\".
+
Later, when desktop.el restores the buffers it has saved, each of the
`desktop-buffer-handlers' functions will have access to a buffer local
variable, named `desktop-buffer-misc', whose value is what the
desktop-buffer-file)
"*List of functions to call in order to create a buffer.
The functions are called without explicit parameters but can use the
-variables `desktop-buffer-major-mode', `desktop-buffer-file-name',
-`desktop-buffer-name'.
+following variables:
+
+ desktop-file-version
+ desktop-buffer-file-name
+ desktop-buffer-name
+ desktop-buffer-major-mode
+ desktop-buffer-minor-modes
+ desktop-buffer-point
+ desktop-buffer-mark
+ desktop-buffer-read-only
+ desktop-buffer-misc
+ desktop-buffer-locals
+
If one function returns non-nil, no further functions are called.
-If the function returns t then the buffer is considered created."
+If the function returns a buffer, then the saved mode settings
+and variable values for that buffer are copied into it."
:type '(repeat function)
:group 'desktop)
(put 'desktop-buffer-handlers 'risky-local-variable t)
-(defvar desktop-create-buffer-form "(desktop-create-buffer 205"
- "Opening of form for creation of new buffers.")
-
-(defcustom desktop-save-hook nil
- "Hook run before desktop saves the state of Emacs.
-This is useful for truncating history lists, for example."
- :type 'hook
- :group 'desktop)
-
(defcustom desktop-minor-mode-table
'((auto-fill-function auto-fill-mode)
(vc-mode nil))
(let ((here (nthcdr (1- n) l)))
(if (consp here)
(setcdr here nil))))
-;; ----------------------------------------------------------------------------
-(defcustom desktop-clear-preserve-buffers
- '("*scratch*" "*Messages*")
- "*Buffer names that `desktop-clear' should not delete."
- :type '(repeat string)
- :group 'desktop)
+;; ----------------------------------------------------------------------------
(defun desktop-clear ()
"Empty the Desktop.
-This kills all buffers except for internal ones
-and those listed in `desktop-clear-preserve-buffers'."
+This kills all buffers except for internal ones and those listed
+in `desktop-clear-preserve-buffers'. Furthermore, it clears the
+variables listed in `desktop-globals-to-clear'."
(interactive)
- (setq kill-ring nil
- kill-ring-yank-pointer nil
- search-ring nil
- search-ring-yank-pointer nil
- regexp-search-ring nil
- regexp-search-ring-yank-pointer nil)
+ (dolist (var desktop-globals-to-clear)
+ (if (symbolp var)
+ (eval `(setq-default ,var nil))
+ (eval `(setq-default ,(car var) ,(cdr var)))))
(let ((buffers (buffer-list)))
(while buffers
- (or (member (buffer-name (car buffers)) desktop-clear-preserve-buffers)
- (null (buffer-name (car buffers)))
- ;; Don't kill buffers made for internal purposes.
- (and (not (equal (buffer-name (car buffers)) ""))
- (eq (aref (buffer-name (car buffers)) 0) ?\ ))
- (kill-buffer (car buffers)))
+ (let ((bufname (buffer-name (car buffers))))
+ (or
+ (null bufname)
+ (string-match desktop-clear-preserve-buffers-regexp bufname)
+ (member bufname desktop-clear-preserve-buffers)
+ ;; Don't kill buffers made for internal purposes.
+ (and (not (equal bufname "")) (eq (aref bufname 0) ?\ ))
+ (kill-buffer (car buffers))))
(setq buffers (cdr buffers))))
(delete-other-windows))
+
;; ----------------------------------------------------------------------------
(add-hook 'kill-emacs-hook 'desktop-kill)
(defun desktop-kill ()
- (if desktop-dirname
- (condition-case err
- (desktop-save desktop-dirname)
- (file-error
- (if (yes-or-no-p "Error while saving the desktop. Quit anyway? ")
- nil
- (signal (car err) (cdr err)))))))
+ "If `desktop-enable' is non-nil, do what `desktop-save' says to do.
+If the desktop should be saved and `desktop-dirname'
+is nil, ask the user where to save the desktop."
+ (when
+ (and
+ desktop-enable
+ (let ((exists (file-exists-p (expand-file-name desktop-base-file-name desktop-dirname))))
+ (or
+ (eq desktop-save 't)
+ (and exists (memq desktop-save '(ask-if-new if-exists)))
+ (and
+ (or
+ (memq desktop-save '(ask ask-if-new))
+ (and exists (eq desktop-save 'ask-if-exists)))
+ (y-or-n-p "Save desktop? ")))))
+ (unless desktop-dirname
+ (setq desktop-dirname
+ (file-name-as-directory
+ (expand-file-name
+ (call-interactively
+ (lambda (dir) (interactive "DDirectory for desktop file: ") dir))))))
+ (condition-case err
+ (desktop-save desktop-dirname)
+ (file-error
+ (unless (yes-or-no-p "Error while saving the desktop. Ignore? ")
+ (signal (car err) (cdr err)))))))
+
;; ----------------------------------------------------------------------------
(defun desktop-list* (&rest args)
(if (null (cdr args))
(setq args (cdr args)))
value)))
+;; ----------------------------------------------------------------------------
(defun desktop-internal-v2s (val)
"Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE.
TXT is a string that when read and evaluated yields value.
(t ; save as text
(cons 'may "\"Unprintable entity\""))))
+;; ----------------------------------------------------------------------------
(defun desktop-value-to-string (val)
"Convert VALUE to a string that when read evaluates to the same value.
Not all types of values are supported."
(if (eq quote 'must)
(concat "'" txt)
txt)))
+
;; ----------------------------------------------------------------------------
(defun desktop-outvar (varspec)
"Output a setq statement for variable VAR to the desktop file.
" "
(desktop-value-to-string (symbol-value var))
")\n")))))
+
;; ----------------------------------------------------------------------------
(defun desktop-save-buffer-p (filename bufname mode &rest dummy)
"Return t if the desktop should record a particular buffer for next startup.
default-directory))))
(and (null filename)
(memq mode desktop-buffer-modes-to-save))))))
+
+;; ----------------------------------------------------------------------------
+(defun desktop-file-name (filename dirname)
+ "Convert FILENAME to format specified in `desktop-file-name-format'.
+DIRNAME must be the directory in which the desktop file will be saved."
+ (cond
+ ((not filename) nil)
+ ((eq desktop-file-name-format 'tilde)
+ (let ((relative-name (file-relative-name (expand-file-name filename) "~")))
+ (cond
+ ((file-name-absolute-p relative-name) relative-name)
+ ((string= "./" relative-name) "~/")
+ ((string= "." relative-name) "~")
+ (t (concat "~/" relative-name)))))
+ ((eq desktop-file-name-format 'local) (file-relative-name filename dirname))
+ (t (expand-file-name filename))))
+
;; ----------------------------------------------------------------------------
(defun desktop-save (dirname)
- "Save the Desktop file. Parameter DIRNAME specifies where to save desktop."
+ "Save the Desktop file. Parameter DIRNAME specifies where to save desktop."
(interactive "DDirectory to save desktop file in: ")
(run-hooks 'desktop-save-hook)
+ (setq dirname (file-name-as-directory (expand-file-name dirname)))
(save-excursion
- (let ((filename (expand-file-name desktop-basefilename dirname))
- (info (nreverse
- (mapcar
- (function
- (lambda (b)
- (set-buffer b)
- (list
- (buffer-file-name)
- (buffer-name)
- major-mode
- ;; minor modes
- (let (ret)
- (mapcar
- #'(lambda (mim)
- (and (boundp mim)
- (symbol-value mim)
- (setq ret
- (cons (let ((special (assq mim desktop-minor-mode-table)))
- (if special
- (cadr special)
- mim))
- ret))))
- (mapcar #'car minor-mode-alist))
- ret)
- (point)
- (list (mark t) mark-active)
- buffer-read-only
- (run-hook-with-args-until-success
- 'desktop-buffer-misc-functions)
- (let ((locals desktop-locals-to-save)
- (loclist (buffer-local-variables))
- (ll))
- (while locals
- (let ((here (assq (car locals) loclist)))
- (if here
- (setq ll (cons here ll))
- (if (member (car locals) loclist)
- (setq ll (cons (car locals) ll)))))
- (setq locals (cdr locals)))
- ll)
- )))
- (buffer-list))))
- (buf (get-buffer-create "*desktop*")))
+ (let ((filename (expand-file-name desktop-base-file-name dirname))
+ (info
+ (mapcar
+ (function
+ (lambda (b)
+ (set-buffer b)
+ (list
+ (desktop-file-name (buffer-file-name) dirname)
+ (buffer-name)
+ major-mode
+ ;; minor modes
+ (let (ret)
+ (mapcar
+ #'(lambda (mim)
+ (and
+ (boundp mim)
+ (symbol-value mim)
+ (setq ret
+ (cons
+ (let ((special (assq mim desktop-minor-mode-table)))
+ (if special (cadr special) mim))
+ ret))))
+ (mapcar #'car minor-mode-alist))
+ ret)
+ (point)
+ (list (mark t) mark-active)
+ buffer-read-only
+ (run-hook-with-args-until-success 'desktop-buffer-misc-functions)
+ (let ((locals desktop-locals-to-save)
+ (loclist (buffer-local-variables))
+ (ll))
+ (while locals
+ (let ((here (assq (car locals) loclist)))
+ (if here
+ (setq ll (cons here ll))
+ (when (member (car locals) loclist)
+ (setq ll (cons (car locals) ll)))))
+ (setq locals (cdr locals)))
+ ll))))
+ (buffer-list)))
+ (buf (get-buffer-create "*desktop*")))
(set-buffer buf)
(erase-buffer)
- (insert ";; -*- coding: utf-8-emacs; -*-\n"
- desktop-header
- ";; Created " (current-time-string) "\n"
- ";; Emacs version " emacs-version "\n\n"
- ";; Global section:\n")
+ (insert
- ";; -*- coding: emacs-mule; -*-\n"
++ ";; -*- coding: utf-8-emacs; -*-\n"
+ desktop-header
+ ";; Created " (current-time-string) "\n"
+ ";; Desktop file format version " desktop-file-version "\n"
+ ";; Emacs version " emacs-version "\n\n"
+ ";; Global section:\n")
(mapcar (function desktop-outvar) desktop-globals-to-save)
(if (memq 'kill-ring desktop-globals-to-save)
- (insert "(setq kill-ring-yank-pointer (nthcdr "
- (int-to-string
- (- (length kill-ring) (length kill-ring-yank-pointer)))
- " kill-ring))\n"))
+ (insert
+ "(setq kill-ring-yank-pointer (nthcdr "
+ (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
+ " kill-ring))\n"))
- (insert "\n;; Buffer section:\n")
+ (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
(mapcar
- (function (lambda (l)
- (if (apply 'desktop-save-buffer-p l)
- (progn
- (insert desktop-create-buffer-form)
- (mapcar
- (function (lambda (e)
- (insert "\n "
- (desktop-value-to-string e))))
- l)
- (insert ")\n\n")))))
- info)
+ (function
+ (lambda (l)
+ (if (apply 'desktop-save-buffer-p l)
+ (progn
+ (insert "(desktop-create-buffer " desktop-file-version)
+ (mapcar
+ (function
+ (lambda (e)
+ (insert "\n " (desktop-value-to-string e))))
+ l)
+ (insert ")\n\n")))))
+ info)
(setq default-directory dirname)
- (if (file-exists-p filename) (delete-file filename))
+ (when (file-exists-p filename) (delete-file filename))
- (let ((coding-system-for-write 'emacs-mule))
+ (let ((coding-system-for-write 'utf-8-emacs))
- (write-region (point-min) (point-max) filename nil 'nomessage))))
+ (write-region (point-min) (point-max) filename nil 'nomessage))))
(setq desktop-dirname dirname))
+
;; ----------------------------------------------------------------------------
(defun desktop-remove ()
"Delete the Desktop file and inactivate the desktop system."
(interactive)
(if desktop-dirname
- (let ((filename (concat desktop-dirname desktop-basefilename)))
- (setq desktop-dirname nil)
- (if (file-exists-p filename)
- (delete-file filename)))))
+ (let ((filename (expand-file-name desktop-base-file-name desktop-dirname)))
+ (setq desktop-dirname nil)
+ (if (file-exists-p filename)
+ (delete-file filename)))))
;; ----------------------------------------------------------------------------
;;;###autoload
(defun desktop-read ()
"Read the Desktop file and the files it specifies.
-This is a no-op when Emacs is running in batch mode."
+This is a no-op when Emacs is running in batch mode.
+Look for the desktop file according to the variables `desktop-base-file-name'
+and `desktop-path'. If no desktop file is found, clear the desktop.
+Returns t if it has read a desktop file, nil otherwise."
(interactive)
- (if noninteractive
- nil
- (let ((dirs '("./" "~/")))
- (while (and dirs
- (not (file-exists-p (expand-file-name
- desktop-basefilename
- (car dirs)))))
- (setq dirs (cdr dirs)))
- (setq desktop-dirname (and dirs (expand-file-name (car dirs))))
+ (unless noninteractive
+ (let ((dirs desktop-path))
+ (while
+ (and
+ dirs
+ (not
+ (file-exists-p (expand-file-name desktop-base-file-name (car dirs)))))
+ (setq dirs (cdr dirs)))
+ (setq desktop-dirname (and dirs (file-name-as-directory (expand-file-name (car dirs)))))
(if desktop-dirname
- (let ((desktop-last-buffer nil))
- ;; `load-with-code-conversion' calls `eval-buffer' which
- ;; contains a `save-excursion', so we end up with the same
- ;; buffer before and after the load. This is a problem
- ;; when the desktop is read initially when Emacs starts up
- ;; because, if we still are in *scratch* after running
- ;; `after-init-hook', the splash screen will be displayed.
- (load (expand-file-name desktop-basefilename desktop-dirname)
- t t t)
- (when desktop-last-buffer
- (switch-to-buffer desktop-last-buffer))
- (run-hooks 'desktop-delay-hook)
- (setq desktop-delay-hook nil)
- (message "Desktop loaded."))
- (desktop-clear)))))
+ (let ((desktop-first-buffer nil))
+ ;; Evaluate desktop buffer.
+ (load (expand-file-name desktop-base-file-name desktop-dirname) t t t)
+ ;; `desktop-create-buffer' puts buffers at end of the buffer list.
+ ;; We want buffers existing prior to evaluating the desktop (and not reused)
+ ;; to be placed at the end of the buffer list, so we move them here.
+ (mapcar 'bury-buffer
+ (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list))))))
+ (switch-to-buffer (car (buffer-list)))
+ (run-hooks 'desktop-delay-hook)
+ (setq desktop-delay-hook nil)
+ (run-hooks 'desktop-after-read-hook)
+ (message "Desktop loaded.")
+ t)
+ (desktop-clear)
+ (run-hooks 'desktop-no-desktop-file-hook)
+ (message "No desktop file.")
+ nil))))
+
;; ----------------------------------------------------------------------------
;;;###autoload
(defun desktop-load-default ()
(progn
(load "default" t t)
(setq inhibit-default-init t))))
+
+;; ----------------------------------------------------------------------------
+;;;###autoload
+(defun desktop-change-dir (dir)
+ "Save and clear the desktop, then load the desktop from directory DIR.
+However, if `desktop-enable' was nil at call, don't save the old desktop.
+This function always sets `desktop-enable' to t."
+ (interactive "DNew directory: ")
+ (setq dir (file-name-as-directory (expand-file-name dir desktop-dirname)))
+ (desktop-kill)
+ (desktop-clear)
+ (setq desktop-enable t)
+ (let ((desktop-path (list dir))
+ (default-directory dir))
+ (desktop-read))
+ ;; Set `desktop-dirname' even in no desktop file was found
+ (setq desktop-dirname dir))
+ ;; ----------------------------------------------------------------------------
+;;;###autoload
+(defun desktop-save-in-load-dir ()
+ "Save desktop in directory from which it was loaded."
+ (interactive)
+ (if desktop-dirname
+ (desktop-save desktop-dirname)
+ (call-interactively 'desktop-save))
+ (message "Desktop saved in %s" desktop-dirname))
+
+;; ----------------------------------------------------------------------------
+;;;###autoload
+(defun desktop-revert ()
+ "Revert to the last loaded desktop."
+ (interactive)
+ (unless desktop-dirname (error "No desktop has been loaded"))
+ (setq desktop-enable nil)
+ (desktop-change-dir desktop-dirname))
+
;; ----------------------------------------------------------------------------
;; Note: the following functions use the dynamic variable binding in Lisp.
;;
+
+(eval-when-compile ; Just to silence the byte compiler
+ (defvar desktop-file-version)
+ (defvar desktop-buffer-file-name)
+ (defvar desktop-buffer-name)
+ (defvar desktop-buffer-major-mode)
+ (defvar desktop-buffer-minor-modes)
+ (defvar desktop-buffer-point)
+ (defvar desktop-buffer-mark)
+ (defvar desktop-buffer-read-only)
+ (defvar desktop-buffer-misc)
+ (defvar desktop-buffer-locals)
+)
+
(defun desktop-buffer-info-misc-data ()
(if (eq major-mode 'Info-mode)
(list Info-current-file
Info-current-node)))
+;; ----------------------------------------------------------------------------
(defun desktop-buffer-dired-misc-data ()
- (if (eq major-mode 'dired-mode)
- (cons
- (expand-file-name dired-directory)
- (cdr
- (nreverse
- (mapcar
- (function car)
- dired-subdir-alist))))))
+ (when (eq major-mode 'dired-mode)
+ (eval-when-compile (defvar dirname))
+ (cons
+ ;; Value of `dired-directory'.
+ (if (consp dired-directory)
+ ;; Directory name followed by list of files.
+ (cons (desktop-file-name (car dired-directory) dirname) (cdr dired-directory))
+ ;; Directory name, optionally with with shell wildcard.
+ (desktop-file-name dired-directory dirname))
+ ;; Subdirectories in `dired-subdir-alist'.
+ (cdr
+ (nreverse
+ (mapcar
+ (function (lambda (f) (desktop-file-name (car f) dirname)))
+ dired-subdir-alist))))))
+;; ----------------------------------------------------------------------------
(defun desktop-buffer-info () "Load an info file."
(if (eq 'Info-mode desktop-buffer-major-mode)
(progn
(second (nth 1 desktop-buffer-misc)))
(when (and first second)
(require 'info)
- (Info-find-node first second)
+ (with-no-warnings
+ (Info-find-node first second))
(current-buffer))))))
+
;; ----------------------------------------------------------------------------
+(eval-when-compile (defvar rmail-buffer)) ; Just to silence the byte compiler.
(defun desktop-buffer-rmail () "Load an RMAIL file."
(if (eq 'rmail-mode desktop-buffer-major-mode)
(condition-case error
(file-locked
(kill-buffer (current-buffer))
'ignored))))
+
;; ----------------------------------------------------------------------------
(defun desktop-buffer-mh () "Load a folder in the mh system."
(if (eq 'mh-folder-mode desktop-buffer-major-mode)
- (progn
- (require 'mh-e)
+ (with-no-warnings
(mh-find-path)
(mh-visit-folder desktop-buffer-name)
(current-buffer))))
+
;; ----------------------------------------------------------------------------
(defun desktop-buffer-dired () "Load a directory using dired."
(if (eq 'dired-mode desktop-buffer-major-mode)
- (if (file-directory-p (file-name-directory (car desktop-buffer-misc)))
- (progn
- (dired (car desktop-buffer-misc))
- (mapcar 'dired-maybe-insert-subdir (cdr desktop-buffer-misc))
- (current-buffer))
- (message "Directory %s no longer exists." (car desktop-buffer-misc))
- (sit-for 1)
- 'ignored)))
+ ;; First element of `desktop-buffer-misc' is the value of `dired-directory'.
+ ;; This value is a directory name, optionally with with shell wildcard or
+ ;; a directory name followed by list of files.
+ (let* ((dired-directory (car desktop-buffer-misc))
+ (dir (if (consp dired-directory) (car dired-directory) dired-directory)))
+ (if (file-directory-p (file-name-directory dir))
+ (progn
+ (dired dired-directory)
+ (mapcar 'dired-maybe-insert-subdir (cdr desktop-buffer-misc))
+ (current-buffer))
+ (message "Directory %s no longer exists." dir)
+ (sit-for 1)
+ 'ignored))))
+
;; ----------------------------------------------------------------------------
-(defun desktop-buffer-file () "Load a file."
+(defun desktop-buffer-file ()
+ "Load a file."
(if desktop-buffer-file-name
(if (or (file-exists-p desktop-buffer-file-name)
(and desktop-missing-file-warning
(let ((buf (find-file-noselect desktop-buffer-file-name)))
(condition-case nil
(switch-to-buffer buf)
- (error (pop-to-buffer buf))))
+ (error (pop-to-buffer buf)))
+ (and (not (eq major-mode desktop-buffer-major-mode))
+ (functionp desktop-buffer-major-mode)
+ (funcall desktop-buffer-major-mode))
+ buf)
'ignored)))
+
;; ----------------------------------------------------------------------------
;; Create a buffer, load its file, set is mode, ...; called from Desktop file
;; only.
-(defvar desktop-last-buffer nil
- "Last buffer read. Dynamically bound in `desktop-read'.")
-
-(defun desktop-create-buffer (ver desktop-buffer-file-name desktop-buffer-name
- desktop-buffer-major-mode
- mim pt mk ro desktop-buffer-misc
- &optional locals)
- (let ((hlist desktop-buffer-handlers)
- (result)
- (handler))
- (while (and (not result) hlist)
- (setq handler (car hlist))
- (setq result (funcall handler))
- (setq hlist (cdr hlist)))
- (when (bufferp result)
- (setq desktop-last-buffer result)
- (set-buffer result)
- (if (not (equal (buffer-name) desktop-buffer-name))
- (rename-buffer desktop-buffer-name))
- ;; minor modes
- (cond ((equal '(t) mim) (auto-fill-mode 1)) ; backwards compatible
- ((equal '(nil) mim) (auto-fill-mode 0))
- (t (mapcar #'(lambda (minor-mode)
- (when (functionp minor-mode)
- (funcall minor-mode 1)))
- mim)))
- (goto-char pt)
- (if (consp mk)
- (progn
- (set-mark (car mk))
- (setq mark-active (car (cdr mk))))
- (set-mark mk))
- ;; Never override file system if the file really is read-only marked.
- (if ro (setq buffer-read-only ro))
- (while locals
- (let ((this (car locals)))
- (if (consp this)
- ;; an entry of this form `(symbol . value)'
- (progn
- (make-local-variable (car this))
- (set (car this) (cdr this)))
- ;; an entry of the form `symbol'
- (make-local-variable this)
- (makunbound this)))
- (setq locals (cdr locals))))))
+(eval-when-compile ; Just to silence the byte compiler
+ (defvar desktop-first-buffer) ;; Dynamically bound in `desktop-read'
+)
+
+(defun desktop-create-buffer (
+ desktop-file-version
+ desktop-buffer-file-name
+ desktop-buffer-name
+ desktop-buffer-major-mode
+ desktop-buffer-minor-modes
+ desktop-buffer-point
+ desktop-buffer-mark
+ desktop-buffer-read-only
+ desktop-buffer-misc
+ &optional
+ desktop-buffer-locals)
+ ;; To make desktop files with relative file names possible, we cannot
+ ;; allow `default-directory' to change. Therefore we save current buffer.
+ (save-current-buffer
+ (let (
+ (buffer-list (buffer-list))
+ (hlist desktop-buffer-handlers)
+ (result)
+ (handler)
+ )
+ ;; Call desktop-buffer-handlers to create buffer.
+ (while (and (not result) hlist)
+ (setq handler (car hlist))
+ (setq result (funcall handler))
+ (setq hlist (cdr hlist)))
+ (unless (bufferp result) (setq result nil))
+ ;; Restore buffer list order with new buffer at end. Don't change
+ ;; the order for old desktop files (old desktop module behaviour).
+ (unless (< desktop-file-version 206)
+ (mapcar 'bury-buffer buffer-list)
+ (when result (bury-buffer result)))
+ (when result
+ (unless (or desktop-first-buffer (< desktop-file-version 206))
+ (setq desktop-first-buffer result))
+ (set-buffer result)
+ (unless (equal (buffer-name) desktop-buffer-name)
+ (rename-buffer desktop-buffer-name))
+ ;; minor modes
+ (cond (
+ ;; backwards compatible
+ (equal '(t) desktop-buffer-minor-modes)
+ (auto-fill-mode 1))(
+ (equal '(nil) desktop-buffer-minor-modes)
+ (auto-fill-mode 0))(
+ t
+ (mapcar
+ #'(lambda (minor-mode)
+ (when (functionp minor-mode) (funcall minor-mode 1)))
+ desktop-buffer-minor-modes)))
+ ;; Even though point and mark are non-nil when written by `desktop-save'
+ ;; they may be modified by handlers wanting to set point or mark themselves.
+ (when desktop-buffer-point (goto-char desktop-buffer-point))
+ (when desktop-buffer-mark
+ (if (consp desktop-buffer-mark)
+ (progn
+ (set-mark (car desktop-buffer-mark))
+ (setq mark-active (car (cdr desktop-buffer-mark))))
+ (set-mark desktop-buffer-mark)))
+ ;; Never override file system if the file really is read-only marked.
+ (if desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only))
+ (while desktop-buffer-locals
+ (let ((this (car desktop-buffer-locals)))
+ (if (consp this)
+ ;; an entry of this form `(symbol . value)'
+ (progn
+ (make-local-variable (car this))
+ (set (car this) (cdr this)))
+ ;; an entry of the form `symbol'
+ (make-local-variable this)
+ (makunbound this)))
+ (setq desktop-buffer-locals (cdr desktop-buffer-locals)))))))
+;; ----------------------------------------------------------------------------
;; Backward compatibility -- update parameters to 205 standards.
(defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name
desktop-buffer-major-mode
(cons 'case-fold-search cfs)
(cons 'case-replace cr)
(cons 'overwrite-mode (car mim)))))
-;; ----------------------------------------------------------------------------
-;; If the user set desktop-enable to t with Custom,
-;; do the rest of what it takes to use desktop,
-;; but do it after finishing loading the init file.
-(add-hook 'after-init-hook
- '(lambda ()
- (when desktop-enable
- (desktop-load-default)
- (desktop-read))))
+;; ----------------------------------------------------------------------------
+;; When `desktop-enable' is non-nil and "--no-desktop" is not specified on the
+;; command line, we do the rest of what it takes to use desktop, but do it
+;; after finishing loading the init file.
+;; We cannot use `command-switch-alist' to process "--no-desktop" because these
+;; functions are processed after `after-init-hook'.
+(add-hook
+ 'after-init-hook
+ '(lambda ()
+ (let ((key "--no-desktop"))
+ (if (member key command-line-args)
+ (delete key command-line-args)
+ (when desktop-enable
+ (desktop-load-default)
+ (desktop-read))))))
(provide 'desktop)
;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler
-;;; Copyright (c) 1991, 1994, 2000, 2001 Free Software Foundation, Inc.
+;;; Copyright (c) 1991, 1994, 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
;; You can, however, make a faster pig."
;;
;; Or, to put it another way, the emacs byte compiler is a VW Bug. This code
-;; makes it be a VW Bug with fuel injection and a turbocharger... You're
+;; makes it be a VW Bug with fuel injection and a turbocharger... You're
;; still not going to make it go faster than 70 mph, but it might be easier
;; to get it there.
;;
;; Simple defsubsts often produce forms like
;; (let ((v1 (f1)) (v2 (f2)) ...)
;; (FN v1 v2 ...))
-;; It would be nice if we could optimize this to
+;; It would be nice if we could optimize this to
;; (FN (f1) (f2) ...)
;; but we can't unless FN is dynamically-safe (it might be dynamically
;; referring to the bindings that the lambda arglist established.)
;; One of the uncountable lossages introduced by dynamic scope...
;;
-;; Maybe there should be a control-structure that says "turn on
+;; Maybe there should be a control-structure that says "turn on
;; fast-and-loose type-assumptive optimizations here." Then when
;; we see a form like (car foo) we can from then on assume that
;; the variable foo is of type cons, and optimize based on that.
-;; But, this won't win much because of (you guessed it) dynamic
+;; But, this won't win much because of (you guessed it) dynamic
;; scope. Anything down the stack could change the value.
;; (Another reason it doesn't work is that it is perfectly valid
;; to call car with a null argument.) A better approach might
;;
;; However, if there was even a single let-binding around the COND,
;; it could not be byte-compiled, because there would be an "unbind"
-;; byte-op between the final "call" and "return." Adding a
+;; byte-op between the final "call" and "return." Adding a
;; Bunbind_all byteop would fix this.
;;
;; (defun foo (x y z) ... (foo a b c))
;;
;; Wouldn't it be nice if Emacs Lisp had lexical scope.
;;
-;; Idea: the form (lexical-scope) in a file means that the file may be
-;; compiled lexically. This proclamation is file-local. Then, within
+;; Idea: the form (lexical-scope) in a file means that the file may be
+;; compiled lexically. This proclamation is file-local. Then, within
;; that file, "let" would establish lexical bindings, and "let-dynamic"
;; would do things the old way. (Or we could use CL "declare" forms.)
;; We'd have to notice defvars and defconsts, since those variables should
;; in the file being compiled (doing a boundp check isn't good enough.)
;; Fdefvar() would have to be modified to add something to the plist.
;;
-;; A major disadvantage of this scheme is that the interpreter and compiler
-;; would have different semantics for files compiled with (dynamic-scope).
+;; A major disadvantage of this scheme is that the interpreter and compiler
+;; would have different semantics for files compiled with (dynamic-scope).
;; Since this would be a file-local optimization, there would be no way to
-;; modify the interpreter to obey this (unless the loader was hacked
+;; modify the interpreter to obey this (unless the loader was hacked
;; in some grody way, but that's a really bad idea.)
;; Other things to consider:
;;;;; error free also they may act as true-constants.
;;;(disassemble (lambda (x) (and (point) (foo))))
-;;;;; When
+;;;;; When
;;;;; - all but one arguments to a function are constant
;;;;; - the non-constant argument is an if-expression (cond-expression?)
;;;;; then the outer function can be distributed. If the guarding
(defun byte-inline-lapcode (lap)
(setq byte-compile-output (nconc (nreverse lap) byte-compile-output)))
-
(defun byte-compile-inline-expand (form)
(let* ((name (car form))
(fn (or (cdr (assq name byte-compile-function-environment))
form))))))
;;; ((lambda ...) ...)
-;;;
+;;;
(defun byte-compile-unfold-lambda (form &optional name)
(or name (setq name "anonymous lambda"))
(let ((lambda (car form))
(byte-compile-warn
"attempt to open-code `%s' with too many arguments" name))
form)
-
+
;; The following leads to infinite recursion when loading a
;; file containing `(defsubst f () (f))', and then trying to
;; byte-compile that file.
;(setq body (mapcar 'byte-optimize-form body)))
-
- (let ((newform
+
+ (let ((newform
(if bindings
(cons 'let (cons (nreverse bindings) body))
(cons 'progn body))))
(cons (byte-optimize-form (nth 1 form) t)
(cons (byte-optimize-form (nth 2 form) for-effect)
(byte-optimize-body (cdr (cdr (cdr form))) t)))))
-
+
((memq fn '(save-excursion save-restriction save-current-buffer))
;; those subrs which have an implicit progn; it's not quite good
;; enough to treat these like normal function calls.
;; This can turn (save-excursion ...) into (save-excursion) which
;; will be optimized away in the lap-optimize pass.
(cons fn (byte-optimize-body (cdr form) for-effect)))
-
+
((eq fn 'with-output-to-temp-buffer)
;; this is just like the above, except for the first argument.
(cons fn
(cons
(byte-optimize-form (nth 1 form) nil)
(byte-optimize-body (cdr (cdr form)) for-effect))))
-
+
((eq fn 'if)
(when (< (length form) 3)
(byte-compile-warn "too few arguments for `if'"))
(cons
(byte-optimize-form (nth 2 form) for-effect)
(byte-optimize-body (nthcdr 3 form) for-effect)))))
-
+
((memq fn '(and or)) ; remember, and/or are control structures.
;; take forms off the back until we can't any more.
;; In the future it could conceivably be a problem that the
(byte-compile-log
" all subforms of %s called for effect; deleted" form))
(and backwards
- (cons fn (nreverse backwards))))
+ (cons fn (nreverse (mapcar 'byte-optimize-form backwards)))))
(cons fn (mapcar 'byte-optimize-form (cdr form)))))
((eq fn 'interactive)
(byte-compile-warn "misplaced interactive spec: `%s'"
(prin1-to-string form))
nil)
-
+
((memq fn '(defun defmacro function
condition-case save-window-excursion))
;; These forms are compiled as constants or by breaking out
(cons fn
(cons (byte-optimize-form (nth 1 form) for-effect)
(cdr (cdr form)))))
-
+
((eq fn 'catch)
;; the body of a catch is compiled (and thus optimized) as a
;; top-level form, so don't do it here. The tag is never
(cons (byte-optimize-form (nth 1 form) nil)
(cdr (cdr form)))))
+ ((eq fn 'ignore)
+ ;; Don't treat the args to `ignore' as being
+ ;; computed for effect. We want to avoid the warnings
+ ;; that might occur if they were treated that way.
+ ;; However, don't actually bother calling `ignore'.
+ `(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form))))
+
;; If optimization is on, this is the only place that macros are
;; expanded. If optimization is off, then macroexpansion happens
;; in byte-compile-form. Otherwise, the macros are already expanded
(not (eq form
(setq form (compiler-macroexpand form)))))
(byte-optimize-form form for-effect))
-
+
((not (symbolp fn))
(byte-compile-warn "`%s' is a malformed function"
(prin1-to-string fn))
((and for-effect (setq tmp (get fn 'side-effect-free))
(or byte-compile-delete-errors
(eq tmp 'error-free)
+ ;; Detect the expansion of (pop foo).
+ ;; There is no need to compile the call to `car' there.
+ (and (eq fn 'car)
+ (eq (car-safe (cadr form)) 'prog1)
+ (let ((var (cadr (cadr form)))
+ (last (nth 2 (cadr form))))
+ (and (symbolp var)
+ (null (nthcdr 3 (cadr form)))
+ (eq (car-safe last) 'setq)
+ (eq (cadr last) var)
+ (eq (car-safe (nth 2 last)) 'cdr)
+ (eq (cadr (nth 2 last)) var))))
(progn
(byte-compile-warn "`%s' called for effect"
- (prin1-to-string form))
+ (prin1-to-string (car form)))
nil)))
(byte-compile-log " %s called for effect; deleted" fn)
;; appending a nil here might not be necessary, but it can't hurt.
(byte-optimize-form
(cons 'progn (append (cdr form) '(nil))) t))
-
+
(t
;; Otherwise, no args can be considered to be for-effect,
;; even if the called function is for-effect, because we
((keywordp ,form))))
;; If the function is being called with constant numeric args,
-;; evaluate as much as possible at compile-time. This optimizer
+;; evaluate as much as possible at compile-time. This optimizer
;; assumes that the function is associative, like + or *.
(defun byte-optimize-associative-math (form)
(let ((args nil)
(cons (/ (nth 1 form) last)
(byte-compile-butlast (cdr (cdr form)))))
last nil))))
- (cond
+ (cond
;;; ((null (cdr (cdr form)))
;;; (nth 1 form))
((eq (nth 1 form) 0)
(put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate)
-;; I'm not convinced that this is necessary. Doesn't the optimizer loop
+;; I'm not convinced that this is necessary. Doesn't the optimizer loop
;; take care of this? - Jamie
;; I think this may some times be necessary to reduce ie (quote 5) to 5,
;; so arithmetic optimizers recognize the numeric constant. - Hallvard
(put 'nth 'byte-optimizer 'byte-optimize-nth)
(defun byte-optimize-nth (form)
- (if (and (= (safe-length form) 3) (memq (nth 1 form) '(0 1)))
- (list 'car (if (zerop (nth 1 form))
- (nth 2 form)
- (list 'cdr (nth 2 form))))
- (byte-optimize-predicate form)))
+ (if (= (safe-length form) 3)
+ (if (memq (nth 1 form) '(0 1))
+ (list 'car (if (zerop (nth 1 form))
+ (nth 2 form)
+ (list 'cdr (nth 2 form))))
+ (byte-optimize-predicate form))
+ form))
(put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr)
(defun byte-optimize-nthcdr (form)
- (if (and (= (safe-length form) 3) (not (memq (nth 1 form) '(0 1 2))))
- (byte-optimize-predicate form)
- (let ((count (nth 1 form)))
- (setq form (nth 2 form))
- (while (>= (setq count (1- count)) 0)
- (setq form (list 'cdr form)))
- form)))
+ (if (= (safe-length form) 3)
+ (if (memq (nth 1 form) '(0 1 2))
+ (let ((count (nth 1 form)))
+ (setq form (nth 2 form))
+ (while (>= (setq count (1- count)) 0)
+ (setq form (list 'cdr form)))
+ form)
+ (byte-optimize-predicate form))
+ form))
(put 'concat 'byte-optimizer 'byte-optimize-concat)
(defun byte-optimize-concat (form)
form)))
;; Avoid having to write forward-... with a negative arg for speed.
+;; Fixme: don't be limited to constant args.
(put 'backward-char 'byte-optimizer 'byte-optimize-backward-char)
(defun byte-optimize-backward-char (form)
(cond ((and (= 2 (safe-length form))
((= 1 (safe-length form))
'(char-after (1- (point))))
(t form)))
+
+;; Fixme: delete-char -> delete-region (byte-coded)
+;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
+;; string-make-multibyte for constant args.
+
+(put 'featurep 'byte-optimizer 'byte-optimize-featurep)
+(defun byte-optimize-featurep (form)
+ ;; Emacs-21's byte-code doesn't run under XEmacs anyway, so we can
+ ;; safely optimize away this test.
+ (if (equal '((quote xemacs)) (cdr-safe form))
+ nil
+ form))
+
+(put 'set 'byte-optimizer 'byte-optimize-set)
+(defun byte-optimize-set (form)
+ (let ((var (car-safe (cdr-safe form))))
+ (cond
+ ((and (eq (car-safe var) 'quote) (consp (cdr var)))
+ `(setq ,(cadr var) ,@(cddr form)))
+ ((and (eq (car-safe var) 'make-local-variable)
+ (eq (car-safe (setq var (car-safe (cdr var)))) 'quote)
+ (consp (cdr var)))
+ `(progn ,(cadr form) (setq ,(cadr var) ,@(cddr form))))
+ (t form))))
\f
-;;; enumerating those functions which need not be called if the returned
+;;; enumerating those functions which need not be called if the returned
;;; value is not used. That is, something like
;;; (progn (list (something-with-side-effects) (yow))
;;; (foo))
;;; (foo))
;;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo.
+;;; Some of these functions have the side effect of allocating memory
+;;; and it would be incorrect to replace two calls with one.
+;;; But we don't try to do those kinds of optimizations,
+;;; so it is safe to list such functions here.
+;;; Some of these functions return values that depend on environment
+;;; state, so that constant folding them would be wrong,
+;;; but we don't do constant folding based on this list.
+
+;;; However, at present the only optimization we normally do
+;;; is delete calls that need not occur, and we only do that
+;;; with the error-free functions.
+
;;; I wonder if I missed any :-\)
(let ((side-effect-free-fns
'(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan
assoc assq
boundp buffer-file-name buffer-local-variables buffer-modified-p
- buffer-substring
+ buffer-substring byte-code-function-p
capitalize car-less-than-car car cdr ceiling char-after char-before
- concat coordinates-in-window-p
- char-width copy-marker cos count-lines
- decode-char default-boundp default-value documentation downcase
- elt encode-char exp expt fboundp featurep
+ 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
- float floor format frame-visible-p
+ float float-time floor format format-time-string frame-visible-p
+ fround ftruncate
get gethash get-buffer get-buffer-window getenv get-file-buffer
hash-table-count
- int-to-string
+ 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
- parse-colon-path prefix-numeric-value previous-window propertize
- radians-to-degrees rassq regexp-quote reverse round
+ parse-colon-path plist-get plist-member
+ prefix-numeric-value previous-window prin1-to-string propertize
+ radians-to-degrees rassq rassoc read-from-string regexp-quote
+ region-beginning region-end reverse round
sin sqrt string string< string= string-equal string-lessp string-to-char
- string-to-int string-to-number substring symbol-function symbol-plist
- symbol-value string-make-unibyte string-make-multibyte
- string-to-multibyte string-as-multibyte string-as-unibyte
- tan unibyte-char-to-multibyte upcase user-variable-p vconcat
+ 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
+ vconcat
window-buffer window-dedicated-p window-edges window-height
window-hscroll window-minibuffer-p window-width
zerop))
(side-effect-and-error-free-fns
'(arrayp atom
- bobp bolp buffer-end buffer-list buffer-size buffer-string bufferp
+ 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
- dot dot-marker eobp eolp eq equal eventp
+ current-local-map current-minor-mode-maps current-time
+ current-time-string current-time-zone
+ eobp eolp eq equal eventp
floatp following-char framep
get-largest-window get-lru-window
hash-table-p
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
++ 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
- selected-frame selected-window sequencep stringp subrp symbolp
- standard-case-table standard-syntax-table syntax-table-p
+ safe-length selected-frame selected-window sequencep
+ standard-case-table standard-syntax-table stringp subrp symbolp
+ syntax-table syntax-table-p
this-command-keys this-command-keys-vector this-single-command-keys
this-single-command-raw-keys
- user-full-name user-login-name user-original-login-name
user-real-login-name user-real-uid user-uid
vector vectorp visible-frame-list
- window-configuration-p window-live-p windowp)))
+ wholenump window-configuration-p window-live-p windowp)))
(while side-effect-free-fns
(put (car side-effect-free-fns) 'side-effect-free t)
(setq side-effect-free-fns (cdr side-effect-free-fns)))
byte-current-buffer byte-interactive-p))
(defconst byte-compile-side-effect-free-ops
- (nconc
+ (nconc
'(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
;;; varbind pop-up-windows
;;; not
;;;
-;;; we break the program, because it will appear that pop-up-windows and
+;;; we break the program, because it will appear that pop-up-windows and
;;; old-pop-ups are not EQ when really they are. So we have to know what
;;; the BOOL variables are, and not perform this optimization on them.
;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X:
;;
;; it is wrong to do the same thing for the -else-pop variants.
- ;;
+ ;;
((and (or (eq 'byte-goto-if-nil (car lap0))
(eq 'byte-goto-if-not-nil (car lap0))) ; gotoX
(eq 'byte-goto (car lap1)) ; gotoY
str (concat str " %s")
i (1+ i))))
(if opt-p
- (let ((tagstr
+ (let ((tagstr
(if (eq 'TAG (car (car tmp)))
(format "%d:" (car (cdr (car tmp))))
(or (car tmp) ""))))
(byte-goto-if-not-nil-else-pop .
byte-goto-if-nil-else-pop))))
newtag)
-
+
(nth 1 newtag)
)
(setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp)))
;;; bytecomp.el --- compilation of Lisp code into byte code
-;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002
+;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;;; This version incorporates changes up to version 2.10 of the
;;; Zawinski-Furuseth compiler.
-(defconst byte-compile-version "$Revision: 2.94.2.2 $")
+(defconst byte-compile-version "$Revision: 2.134 $")
;; This file is part of GNU Emacs.
;; finding unused functions, as well as simple
;; performance metering.
;; byte-compile-warnings List of warnings to issue, or t. May contain
-;; 'free-vars (references to variables not in the
-;; current lexical scope)
-;; 'unresolved (calls to unknown functions)
-;; 'callargs (lambda calls with args that don't
-;; match the lambda's definition)
-;; 'redefine (function cell redefined from
-;; a macro to a lambda or vice versa,
-;; or redefined to take other args)
-;; 'obsolete (obsolete variables and functions)
-;; 'noruntime (calls to functions only defined
-;; within `eval-when-compile')
+;; `free-vars' (references to variables not in the
+;; current lexical scope)
+;; `unresolved' (calls to unknown functions)
+;; `callargs' (lambda calls with args that don't
+;; match the lambda's definition)
+;; `redefine' (function cell redefined from
+;; a macro to a lambda or vice versa,
+;; or redefined to take other args)
+;; `obsolete' (obsolete variables and functions)
+;; `noruntime' (calls to functions only defined
+;; within `eval-when-compile')
;; byte-compile-compatibility Whether the compiler should
;; generate .elc files which can be loaded into
;; generic emacs 18.
(or (fboundp 'defsubst)
;; This really ought to be loaded already!
- (load-library "byte-run"))
+ (load "byte-run"))
;; The feature of compiling in a specific target Emacs version
;; has been turned off because compile time options are a bad idea.
(const :tag "source-level" source)
(const :tag "byte-level" byte)))
-(defcustom byte-compile-delete-errors t
+(defcustom byte-compile-delete-errors nil
"*If non-nil, the optimizer may delete forms that may signal an error.
This includes variable references and calls to functions such as `car'."
:group 'bytecomp
:type 'boolean)
(defconst byte-compile-warning-types
- '(redefine callargs free-vars unresolved obsolete noruntime))
+ '(redefine callargs free-vars unresolved obsolete noruntime cl-functions)
+ "The list of warning types used when `byte-compile-warnings' is t.")
(defcustom byte-compile-warnings t
"*List of warnings that the byte-compiler should issue (t for all).
+
Elements of the list may be be:
free-vars references to variables not in the current lexical scope.
callargs lambda calls with args that don't match the definition.
redefine function cell redefined from a macro to a lambda or vice
versa, or redefined to take a different number of arguments.
- obsolete obsolete variables and functions."
+ obsolete obsolete variables and functions.
+ noruntime functions that may not be defined at runtime (typically
+ defined only under `eval-when-compile').
+ cl-functions calls to runtime functions from the CL package (as
+ distinguished from macros and aliases)."
:group 'bytecomp
- :type '(choice (const :tag "All" t)
+ :type `(choice (const :tag "All" t)
(set :menu-tag "Some"
(const free-vars) (const unresolved)
- (const callargs) (const redefined)
- (const obsolete) (const noruntime))))
+ (const callargs) (const redefine)
+ (const obsolete) (const noruntime) (const cl-functions))))
(defcustom byte-compile-generate-call-tree nil
"*Non-nil means collect call-graph information when compiling.
:type '(choice (const name) (const callers) (const calls)
(const calls+callers) (const nil)))
+(defvar byte-compile-debug nil)
+
;; (defvar byte-compile-overwrite-file t
;; "If nil, old .elc files are deleted before the new is saved, and .elc
;; files will have the same modes as the corresponding .el file. Otherwise,
(defvar byte-compile-bound-variables nil
"List of variables bound in the context of the current form.
This list lives partly on the stack.")
+(defvar byte-compile-const-variables nil
+ "List of variables declared as constants during compilation of this file.")
(defvar byte-compile-free-references)
(defvar byte-compile-free-assignments)
(byte-compile-eval (byte-compile-top-level
(cons 'progn body))))))
(eval-and-compile . (lambda (&rest body)
- (eval (cons 'progn body))
+ (byte-compile-eval-before-compile (cons 'progn body))
(cons 'progn body))))
"The default macro-environment passed to macroexpand by the compiler.
Placing a macro here will cause a macro to have different semantics when
(let ((pc 0) ; Program counter
op off ; Operation & offset
(bytes '()) ; Put the output bytes here
- (patchlist nil) ; List of tags and goto's to patch
- rest rel tmp)
+ (patchlist nil)) ; List of tags and goto's to patch
(while lap
(setq op (car (car lap))
off (cdr (car lap)))
(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
;; Go through load-history, look for newly loaded files
;; and mark all the functions defined therein.
(while (and hist-new (not (eq hist-new hist-orig)))
- (let ((xs (pop hist-new)))
+ (let ((xs (pop hist-new))
+ old-autoloads)
;; Make sure the file was not already loaded before.
(unless (assoc (car xs) hist-orig)
(dolist (s xs)
(cond
- ((symbolp s) (put s 'byte-compile-noruntime t))
+ ((symbolp s)
+ (unless (memq s old-autoloads)
+ (put s 'byte-compile-noruntime t)))
+ ((and (consp s) (eq t (car s)))
+ (push (cdr s) old-autoloads))
((and (consp s) (eq 'autoload (car s)))
(put (cdr s) 'byte-compile-noruntime t)))))))
;; Go through current-load-list for the locally defined funs.
- (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
- (let ((s (pop hist-nil-new)))
- (when (symbolp s)
- (put s 'byte-compile-noruntime t)))))))))
-
+ (let (old-autoloads)
+ (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
+ (let ((s (pop hist-nil-new)))
+ (when (and (symbolp s) (not (memq s old-autoloads)))
+ (put s 'byte-compile-noruntime t))
+ (when (and (consp s) (eq t (car s)))
+ (push (cdr s) old-autoloads))))))))))
+
+(defun byte-compile-eval-before-compile (form)
+ "Evaluate FORM for `eval-and-compile'."
+ (let ((hist-nil-orig current-load-list))
+ (prog1 (eval form)
+ ;; (eval-and-compile (require 'cl) turns off warnings for cl functions.
+ (let ((tem current-load-list))
+ (while (not (eq tem hist-nil-orig))
+ (when (equal (car tem) '(require . cl))
+ (setq byte-compile-warnings
+ (remq 'cl-functions byte-compile-warnings)))
+ (setq tem (cdr tem)))))))
\f
;;; byte compiler messages
(defvar byte-compile-current-form nil)
(defvar byte-compile-dest-file nil)
(defvar byte-compile-current-file nil)
+(defvar byte-compile-current-buffer nil)
+;; Log something that isn't a warning.
(defmacro byte-compile-log (format-string &rest args)
(list 'and
'byte-optimize
(if (symbolp x) (list 'prin1-to-string x) x))
args)))))))
+;; Log something that isn't a warning.
+(defun byte-compile-log-1 (string)
+ (save-excursion
+ (byte-goto-log-buffer)
+ (goto-char (point-max))
+ (byte-compile-warning-prefix nil nil)
+ (cond (noninteractive
+ (message " %s" string))
+ (t
+ (insert (format "%s\n" string))))))
+
+(defvar byte-compile-read-position nil
+ "Character position we began the last `read' from.")
+(defvar byte-compile-last-position nil
+ "Last known character position in the input.")
+
+;; copied from gnus-util.el
+(defsubst byte-compile-delete-first (elt list)
+ (if (eq (car list) elt)
+ (cdr list)
+ (let ((total list))
+ (while (and (cdr list)
+ (not (eq (cadr list) elt)))
+ (setq list (cdr list)))
+ (when (cdr list)
+ (setcdr list (cddr list)))
+ total)))
+
+;; The purpose of this function is to iterate through the
+;; `read-symbol-positions-list'. Each time we process, say, a
+;; function definition (`defun') we remove `defun' from
+;; `read-symbol-positions-list', and set `byte-compile-last-position'
+;; to that symbol's character position. Similarly, if we encounter a
+;; variable reference, like in (1+ foo), we remove `foo' from the
+;; list. If our current position is after the symbol's position, we
+;; assume we've already passed that point, and look for the next
+;; occurrence of the symbol.
+;; So your're probably asking yourself: Isn't this function a
+;; gross hack? And the answer, of course, would be yes.
+(defun byte-compile-set-symbol-position (sym &optional allow-previous)
+ (when byte-compile-read-position
+ (let (last entry)
+ (while (progn
+ (setq last byte-compile-last-position
+ entry (assq sym read-symbol-positions-list))
+ (when entry
+ (setq byte-compile-last-position
+ (+ byte-compile-read-position (cdr entry))
+ read-symbol-positions-list
+ (byte-compile-delete-first
+ entry read-symbol-positions-list)))
+ (or (and allow-previous (not (= last byte-compile-last-position)))
+ (> last byte-compile-last-position)))))))
+
(defvar byte-compile-last-warned-form nil)
(defvar byte-compile-last-logged-file nil)
-(defvar byte-compile-last-line nil
- "Last known line number in the input.")
-
-
-(defun byte-compile-display-log-head-p ()
- (and (not (eq byte-compile-current-form :end))
- (or (and byte-compile-current-file
- (not (equal byte-compile-current-file
- byte-compile-last-logged-file)))
- (and byte-compile-last-warned-form
- (not (eq byte-compile-current-form
- byte-compile-last-warned-form))))))
-
(defun byte-goto-log-buffer ()
(set-buffer (get-buffer-create "*Compile-Log*"))
(unless (eq major-mode 'compilation-mode)
(compilation-mode)))
-;; Log a message STRING in *Compile-Log*.
-;; Also log the current function and file if not already done.
-(defun byte-compile-log-1 (string &optional fill)
- (let* ((file (cond ((stringp byte-compile-current-file)
- (format "%s:" byte-compile-current-file))
+;; This is used as warning-prefix for the compiler.
+;; It is always called with the warnings buffer current.
+(defun byte-compile-warning-prefix (level entry)
+ (let* ((dir default-directory)
+ (file (cond ((stringp byte-compile-current-file)
+ (format "%s:" (file-relative-name byte-compile-current-file dir)))
((bufferp byte-compile-current-file)
(format "Buffer %s:"
(buffer-name byte-compile-current-file)))
(t "")))
(pos (if (and byte-compile-current-file
- (integerp byte-compile-last-line))
- (format "%d:" byte-compile-last-line)
+ (integerp byte-compile-read-position))
+ (with-current-buffer byte-compile-current-buffer
+ (format "%d:%d:" (count-lines (point-min)
+ byte-compile-last-position)
+ (save-excursion
+ (goto-char byte-compile-last-position)
+ (1+ (current-column)))))
""))
- (form (or byte-compile-current-form "toplevel form")))
- (cond (noninteractive
- (when (byte-compile-display-log-head-p)
- (message "%s In %s" file form))
- (message "%s%s %s" file pos string))
- (t
- (save-excursion
- (byte-goto-log-buffer)
- (goto-char (point-max))
- (when (byte-compile-display-log-head-p)
- (insert (format "\nIn %s" form)))
- (insert (format "\n%s%s\n%s\n" file pos string))
- (when (and fill (not (string-match "\n" string)))
- (let ((fill-prefix " ") (fill-column 78))
- (fill-paragraph nil)))))))
+ (form (if (eq byte-compile-current-form :end) "end of data"
+ (or byte-compile-current-form "toplevel form"))))
+ (when (or (and byte-compile-current-file
+ (not (equal byte-compile-current-file
+ byte-compile-last-logged-file)))
+ (and byte-compile-last-warned-form
+ (not (eq byte-compile-current-form
+ byte-compile-last-warned-form))))
+ (insert (format "\nIn %s:\n" form)))
+ (when level
+ (insert (format "%s%s" file pos))))
(setq byte-compile-last-logged-file byte-compile-current-file
- byte-compile-last-warned-form byte-compile-current-form))
+ byte-compile-last-warned-form byte-compile-current-form)
+ entry)
+
+;; This no-op function is used as the value of warning-series
+;; to tell inner calls to displaying-byte-compile-warnings
+;; not to bind warning-series.
+(defun byte-compile-warning-series (&rest ignore)
+ nil)
;; Log the start of a file in *Compile-Log*, and mark it as done.
+;; Return the position of the start of the page in the log buffer.
;; But do nothing in batch mode.
(defun byte-compile-log-file ()
- (and byte-compile-current-file
- (not (equal byte-compile-current-file byte-compile-last-logged-file))
+ (and (not (equal byte-compile-current-file byte-compile-last-logged-file))
(not noninteractive)
(save-excursion
- (byte-goto-log-buffer)
+ (set-buffer (get-buffer-create "*Compile-Log*"))
(goto-char (point-max))
- (insert "\n\^L\nCompiling "
- (if (stringp byte-compile-current-file)
- (concat "file " byte-compile-current-file)
- (concat "buffer " (buffer-name byte-compile-current-file)))
- " at " (current-time-string) "\n")
- (setq byte-compile-last-logged-file byte-compile-current-file))))
+ (let* ((dir (and byte-compile-current-file
+ (file-name-directory byte-compile-current-file)))
+ (was-same (equal default-directory dir))
+ pt)
+ (when dir
+ (unless was-same
+ (insert (format "Leaving directory `%s'\n" default-directory))))
+ (unless (bolp)
+ (insert "\n"))
+ (setq pt (point-marker))
+ (if byte-compile-current-file
+ (insert "\f\nCompiling "
+ (if (stringp byte-compile-current-file)
+ (concat "file " byte-compile-current-file)
+ (concat "buffer " (buffer-name byte-compile-current-file)))
+ " at " (current-time-string) "\n")
+ (insert "\f\nCompiling no file at " (current-time-string) "\n"))
+ (when dir
+ (setq default-directory dir)
+ (unless was-same
+ (insert (format "Entering directory `%s'\n" default-directory))))
+ (setq byte-compile-last-logged-file byte-compile-current-file)
+ ;; Do this after setting default-directory.
+ (unless (eq major-mode 'compilation-mode)
+ (compilation-mode))
+ pt))))
+
+;; Log a message STRING in *Compile-Log*.
+;; Also log the current function and file if not already done.
+(defun byte-compile-log-warning (string &optional fill level)
+ (let ((warning-prefix-function 'byte-compile-warning-prefix)
+ (warning-group-format "")
+ (warning-fill-prefix (if fill " ")))
+ (display-warning 'bytecomp string level "*Compile-Log*")))
(defun byte-compile-warn (format &rest args)
+ "Issue a byte compiler warning; use (format FORMAT ARGS...) for message."
(setq format (apply 'format format args))
(if byte-compile-error-on-warn
(error "%s" format) ; byte-compile-file catches and logs it
- (byte-compile-log-1 (concat "warning: " format) t)
- ;; It is useless to flash warnings too fast to be read.
- ;; Besides, they will all be shown at the end.
- ;; (or noninteractive ; already written on stdout.
- ;; (message "Warning: %s" format))
- ))
+ (byte-compile-log-warning format t :warning)))
-;;; This function should be used to report errors that have halted
-;;; compilation of the current file.
(defun byte-compile-report-error (error-info)
+ "Report Lisp error in compilation. ERROR-INFO is the error data."
(setq byte-compiler-error-flag t)
- (byte-compile-log-1
- (concat "error: "
- (format (if (cdr error-info) "%s (%s)" "%s")
- (downcase (get (car error-info) 'error-message))
- (prin1-to-string (cdr error-info))))))
+ (byte-compile-log-warning
+ (error-message-string error-info)
+ nil :error))
;;; Used by make-obsolete.
(defun byte-compile-obsolete (form)
(let* ((new (get (car form) 'byte-obsolete-info))
(handler (nth 1 new))
(when (nth 2 new)))
+ (byte-compile-set-symbol-position (car form))
(if (memq 'obsolete byte-compile-warnings)
(byte-compile-warn "%s is an obsolete function%s; %s" (car form)
(if when (concat " since " when) "")
(not (numberp (cdr sig))))
(setcdr sig nil))
(if sig
- (if (or (< ncall (car sig))
+ (when (or (< ncall (car sig))
(and (cdr sig) (> ncall (cdr sig))))
- (byte-compile-warn
- "%s called with %d argument%s, but %s %s"
- (car form) ncall
- (if (= 1 ncall) "" "s")
- (if (< ncall (car sig))
- "requires"
- "accepts only")
- (byte-compile-arglist-signature-string sig)))
- (or (and (fboundp (car form)) ; might be a subr or autoload.
- (not (get (car form) 'byte-compile-noruntime)))
- (eq (car form) byte-compile-current-form) ; ## this doesn't work
- ; with recursion.
- ;; It's a currently-undefined function.
- ;; Remember number of args in call.
- (let ((cons (assq (car form) byte-compile-unresolved-functions))
- (n (length (cdr form))))
- (if cons
- (or (memq n (cdr cons))
- (setcdr cons (cons n (cdr cons))))
- (setq byte-compile-unresolved-functions
- (cons (list (car form) n)
- byte-compile-unresolved-functions))))))))
+ (byte-compile-set-symbol-position (car form))
+ (byte-compile-warn
+ "%s called with %d argument%s, but %s %s"
+ (car form) ncall
+ (if (= 1 ncall) "" "s")
+ (if (< ncall (car sig))
+ "requires"
+ "accepts only")
+ (byte-compile-arglist-signature-string sig))))
+ ;; Check to see if the function will be available at runtime
+ ;; and/or remember its arity if it's unknown.
+ (or (and (or sig (fboundp (car form))) ; might be a subr or autoload.
+ (not (get (car form) 'byte-compile-noruntime)))
+ (eq (car form) byte-compile-current-form) ; ## this doesn't work
+ ; with recursion.
+ ;; It's a currently-undefined function.
+ ;; Remember number of args in call.
+ (let ((cons (assq (car form) byte-compile-unresolved-functions))
+ (n (length (cdr form))))
+ (if cons
+ (or (memq n (cdr cons))
+ (setcdr cons (cons n (cdr cons))))
+ (setq byte-compile-unresolved-functions
+ (cons (list (car form) n)
+ byte-compile-unresolved-functions)))))))
;; Warn if the function or macro is being redefined with a different
;; number of arguments.
(aref old 0)
'(&rest def)))))
(sig2 (byte-compile-arglist-signature (nth 2 form))))
- (or (byte-compile-arglist-signatures-congruent-p sig1 sig2)
- (byte-compile-warn "%s %s used to take %s %s, now takes %s"
- (if (eq (car form) 'defun) "function" "macro")
- (nth 1 form)
- (byte-compile-arglist-signature-string sig1)
- (if (equal sig1 '(1 . 1)) "argument" "arguments")
- (byte-compile-arglist-signature-string sig2))))
+ (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
+ (byte-compile-set-symbol-position (nth 1 form))
+ (byte-compile-warn
+ "%s %s used to take %s %s, now takes %s"
+ (if (eq (car form) 'defun) "function" "macro")
+ (nth 1 form)
+ (byte-compile-arglist-signature-string sig1)
+ (if (equal sig1 '(1 . 1)) "argument" "arguments")
+ (byte-compile-arglist-signature-string sig2))))
;; This is the first definition. See if previous calls are compatible.
(let ((calls (assq (nth 1 form) byte-compile-unresolved-functions))
nums sig min max)
nums (sort (copy-sequence (cdr calls)) (function <))
min (car nums)
max (car (nreverse nums)))
- (if (or (< min (car sig))
+ (when (or (< min (car sig))
(and (cdr sig) (> max (cdr sig))))
- (byte-compile-warn
- "%s being defined to take %s%s, but was previously called with %s"
- (nth 1 form)
- (byte-compile-arglist-signature-string sig)
- (if (equal sig '(1 . 1)) " arg" " args")
- (byte-compile-arglist-signature-string (cons min max))))
+ (byte-compile-set-symbol-position (nth 1 form))
+ (byte-compile-warn
+ "%s being defined to take %s%s, but was previously called with %s"
+ (nth 1 form)
+ (byte-compile-arglist-signature-string sig)
+ (if (equal sig '(1 . 1)) " arg" " args")
+ (byte-compile-arglist-signature-string (cons min max))))
(setq byte-compile-unresolved-functions
(delq calls byte-compile-unresolved-functions)))))
)))
+(defvar byte-compile-cl-functions nil
+ "List of functions defined in CL.")
+
+(defun byte-compile-find-cl-functions ()
+ (unless byte-compile-cl-functions
+ (dolist (elt load-history)
+ (when (and (stringp (car elt))
+ (string-match "^cl\\>" (car elt)))
+ (setq byte-compile-cl-functions
+ (append byte-compile-cl-functions
+ (cdr elt)))))
+ (let ((tail byte-compile-cl-functions))
+ (while tail
+ (if (and (consp (car tail))
+ (eq (car (car tail)) 'autoload))
+ (setcar tail (cdr (car tail))))
+ (setq tail (cdr tail))))))
+
+(defun byte-compile-cl-warn (form)
+ "Warn if FORM is a call of a function from the CL package."
+ (let ((func (car-safe form)))
+ (if (and byte-compile-cl-functions
+ (memq func byte-compile-cl-functions)
+ ;; Aliases which won't have been expended at this point.
+ ;; These aren't all aliases of subrs, so not trivial to
+ ;; avoid hardwiring the list.
+ (not (memq func
+ '(cl-block-wrapper cl-block-throw
+ multiple-value-call nth-value
+ copy-seq first second rest endp cl-member
+ ;; These are included in generated code
+ ;; that can't be called except at compile time
+ ;; or unless cl is loaded anyway.
+ cl-defsubst-expand cl-struct-setf-expander
+ ;; These would sometimes be warned about
+ ;; but such warnings are never useful,
+ ;; so don't warn about them.
+ macroexpand cl-macroexpand-all
+ cl-compiling-file)))
+ ;; Avoid warnings for things which are safe because they
+ ;; have suitable compiler macros, but those aren't
+ ;; expanded at this stage. There should probably be more
+ ;; here than caaar and friends.
+ (not (and (eq (get func 'byte-compile)
+ 'cl-byte-compile-compiler-macro)
+ (string-match "\\`c[ad]+r\\'" (symbol-name func)))))
+ (byte-compile-warn "Function `%s' from cl package called at runtime"
+ func)))
+ form)
+
(defun byte-compile-print-syms (str1 strn syms)
+ (when syms
+ (byte-compile-set-symbol-position (car syms) t))
(cond ((and (cdr syms) (not noninteractive))
(let* ((str strn)
(L (length str))
nil)
\f
-(defsubst byte-compile-const-symbol-p (symbol)
+(defsubst byte-compile-const-symbol-p (symbol &optional any-value)
+ "Non-nil if SYMBOL is constant.
+If ANY-VALUE is nil, only return non-nil if the value of the symbol is the
+symbol itself."
(or (memq symbol '(nil t))
- (keywordp symbol)))
+ (keywordp symbol)
+ (if any-value (memq symbol byte-compile-const-variables))))
(defmacro byte-compile-constp (form)
"Return non-nil if FORM is a constant."
(copy-alist byte-compile-initial-macro-environment))
(byte-compile-function-environment nil)
(byte-compile-bound-variables nil)
+ (byte-compile-const-variables nil)
(byte-compile-free-references nil)
(byte-compile-free-assignments nil)
;;
)
body)))
-(defvar byte-compile-warnings-point-max nil)
(defmacro displaying-byte-compile-warnings (&rest body)
- `(let ((byte-compile-warnings-point-max byte-compile-warnings-point-max))
- ;; Log the file name.
- (byte-compile-log-file)
- ;; Record how much is logged now.
- ;; We will display the log buffer if anything more is logged
- ;; before the end of BODY.
- (unless byte-compile-warnings-point-max
- (save-excursion
- (byte-goto-log-buffer)
- (setq byte-compile-warnings-point-max (point-max))))
- (unwind-protect
- (condition-case error-info
- (progn ,@body)
- (error (byte-compile-report-error error-info)))
- (with-current-buffer "*Compile-Log*"
- ;; If there were compilation warnings, display them.
- (unless (= byte-compile-warnings-point-max (point-max))
- (select-window
- (prog1 (selected-window)
- (select-window (display-buffer (current-buffer)))
- (goto-char byte-compile-warnings-point-max)
- (beginning-of-line)
- (forward-line -1)
- (recenter 0))))))))
-
+ `(let* ((--displaying-byte-compile-warnings-fn (lambda () ,@body))
+ (warning-series-started
+ (and (markerp warning-series)
+ (eq (marker-buffer warning-series)
+ (get-buffer "*Compile-Log*")))))
+ (byte-compile-find-cl-functions)
+ (if (or (eq warning-series 'byte-compile-warning-series)
+ warning-series-started)
+ ;; warning-series does come from compilation,
+ ;; so don't bind it, but maybe do set it.
+ (let (tem)
+ ;; Log the file name. Record position of that text.
+ (setq tem (byte-compile-log-file))
+ (unless warning-series-started
+ (setq warning-series (or tem 'byte-compile-warning-series)))
+ (if byte-compile-debug
+ (funcall --displaying-byte-compile-warnings-fn)
+ (condition-case error-info
+ (funcall --displaying-byte-compile-warnings-fn)
+ (error (byte-compile-report-error error-info)))))
+ ;; warning-series does not come from compilation, so bind it.
+ (let ((warning-series
+ ;; Log the file name. Record position of that text.
+ (or (byte-compile-log-file) 'byte-compile-warning-series)))
+ (if byte-compile-debug
+ (funcall --displaying-byte-compile-warnings-fn)
+ (condition-case error-info
+ (funcall --displaying-byte-compile-warnings-fn)
+ (error (byte-compile-report-error error-info))))))))
\f
;;;###autoload
(defun byte-force-recompile (directory)
nil
(save-some-buffers)
(force-mode-line-update))
- (let ((directories (list (expand-file-name directory)))
- (skip-count 0)
- (fail-count 0)
- (file-count 0)
- (dir-count 0)
- last-dir)
- (displaying-byte-compile-warnings
- (while directories
- (setq directory (car directories))
- (message "Checking %s..." directory)
- (let ((files (directory-files directory))
- source dest)
- (dolist (file files)
- (setq source (expand-file-name file directory))
- (if (and (not (member file '("." ".." "RCS" "CVS")))
- (file-directory-p source)
- (not (file-symlink-p source)))
- ;; This file is a subdirectory. Handle them differently.
- (when (or (null arg)
- (eq 0 arg)
- (y-or-n-p (concat "Check " source "? ")))
- (setq directories
- (nconc directories (list source))))
- ;; It is an ordinary file. Decide whether to compile it.
- (if (and (string-match emacs-lisp-file-regexp source)
- (file-readable-p source)
- (not (auto-save-file-name-p source))
- (setq dest (byte-compile-dest-file source))
- (if (file-exists-p dest)
- ;; File was already compiled.
- (or force (file-newer-than-file-p source dest))
- ;; No compiled file exists yet.
- (and arg
- (or (eq 0 arg)
- (y-or-n-p (concat "Compile " source "? "))))))
- (progn (if (and noninteractive (not byte-compile-verbose))
- (message "Compiling %s..." source))
- (let ((res (byte-compile-file source)))
- (cond ((eq res 'no-byte-compile)
- (setq skip-count (1+ skip-count)))
- ((eq res t)
- (setq file-count (1+ file-count)))
- ((eq res nil)
- (setq fail-count (1+ fail-count)))))
- (or noninteractive
- (message "Checking %s..." directory))
- (if (not (eq last-dir directory))
- (setq last-dir directory
- dir-count (1+ dir-count)))
- )))))
- (setq directories (cdr directories))))
- (message "Done (Total of %d file%s compiled%s%s%s)"
- file-count (if (= file-count 1) "" "s")
- (if (> fail-count 0) (format ", %d failed" fail-count) "")
- (if (> skip-count 0) (format ", %d skipped" skip-count) "")
- (if (> dir-count 1) (format " in %d directories" dir-count) ""))))
+ (save-current-buffer
+ (set-buffer (get-buffer-create "*Compile-Log*"))
+ (setq default-directory (expand-file-name directory))
+ ;; compilation-mode copies value of default-directory.
+ (unless (eq major-mode 'compilation-mode)
+ (compilation-mode))
+ (let ((directories (list (expand-file-name directory)))
+ (default-directory default-directory)
+ (skip-count 0)
+ (fail-count 0)
+ (file-count 0)
+ (dir-count 0)
+ last-dir)
+ (displaying-byte-compile-warnings
+ (while directories
+ (setq directory (car directories))
+ (message "Checking %s..." directory)
+ (let ((files (directory-files directory))
+ source dest)
+ (dolist (file files)
+ (setq source (expand-file-name file directory))
+ (if (and (not (member file '("." ".." "RCS" "CVS")))
+ (file-directory-p source)
+ (not (file-symlink-p source)))
+ ;; This file is a subdirectory. Handle them differently.
+ (when (or (null arg)
+ (eq 0 arg)
+ (y-or-n-p (concat "Check " source "? ")))
+ (setq directories
+ (nconc directories (list source))))
+ ;; It is an ordinary file. Decide whether to compile it.
+ (if (and (string-match emacs-lisp-file-regexp source)
+ (file-readable-p source)
+ (not (auto-save-file-name-p source))
+ (setq dest (byte-compile-dest-file source))
+ (if (file-exists-p dest)
+ ;; File was already compiled.
+ (or force (file-newer-than-file-p source dest))
+ ;; No compiled file exists yet.
+ (and arg
+ (or (eq 0 arg)
+ (y-or-n-p (concat "Compile " source "? "))))))
+ (progn (if (and noninteractive (not byte-compile-verbose))
+ (message "Compiling %s..." source))
+ (let ((res (byte-compile-file source)))
+ (cond ((eq res 'no-byte-compile)
+ (setq skip-count (1+ skip-count)))
+ ((eq res t)
+ (setq file-count (1+ file-count)))
+ ((eq res nil)
+ (setq fail-count (1+ fail-count)))))
+ (or noninteractive
+ (message "Checking %s..." directory))
+ (if (not (eq last-dir directory))
+ (setq last-dir directory
+ dir-count (1+ dir-count)))
+ )))))
+ (setq directories (cdr directories))))
+ (message "Done (Total of %d file%s compiled%s%s%s)"
+ file-count (if (= file-count 1) "" "s")
+ (if (> fail-count 0) (format ", %d failed" fail-count) "")
+ (if (> skip-count 0) (format ", %d skipped" skip-count) "")
+ (if (> dir-count 1) (format " in %d directories" dir-count) "")))))
(defvar no-byte-compile nil
"Non-nil to prevent byte-compiling of emacs-lisp code.
(y-or-n-p (format "Save buffer %s first? " (buffer-name b))))
(save-excursion (set-buffer b) (save-buffer)))))
+ ;; Force logging of the file name for each file compiled.
+ (setq byte-compile-last-logged-file nil)
(let ((byte-compile-current-file filename)
- (byte-compile-last-logged-file nil)
(set-auto-coding-for-load t)
target-file input-buffer output-buffer
byte-compile-dest-file)
;; unless the file itself forces unibyte with -*-coding: raw-text;-*-
(set-buffer-multibyte t)
(insert-file-contents filename)
- ;; Mimic the way after-insert-file-set-buffer-file-coding-system
- ;; can make the buffer unibyte when visiting this file.
+ ;; Mimic the way after-insert-file-set-coding can make the
+ ;; buffer unibyte when visiting this file.
(when (or (eq last-coding-system-used 'no-conversion)
(eq (coding-system-type last-coding-system-used) 5))
;; For coding systems no-conversion and raw-text...,
(condition-case nil (delete-file target-file) (error nil)))
;; We successfully didn't compile this file.
'no-byte-compile)
- (if byte-compile-verbose
- (message "Compiling %s..." filename))
+ (when byte-compile-verbose
+ (message "Compiling %s..." filename))
(setq byte-compiler-error-flag nil)
;; It is important that input-buffer not be current at this call,
;; so that the value of point set in input-buffer
;; within byte-compile-from-buffer lingers in that buffer.
- (setq output-buffer (byte-compile-from-buffer input-buffer filename))
+ (setq output-buffer
+ (save-current-buffer
+ (byte-compile-from-buffer input-buffer filename)))
(if byte-compiler-error-flag
nil
- (if byte-compile-verbose
- (message "Compiling %s...done" filename))
+ (when byte-compile-verbose
+ (message "Compiling %s...done" filename))
(kill-buffer input-buffer)
(with-current-buffer output-buffer
(goto-char (point-max))
;; the build tree, without causing problems when emacs-lisp
;; files in the build tree are recompiled).
(delete-file target-file))
- (write-region 1 (point-max) target-file))
+ (write-region (point-min) (point-max) target-file))
;; This is just to give a better error message than write-region
(signal 'file-error
(list "Opening output file"
(end-of-defun)
(beginning-of-defun)
(let* ((byte-compile-current-file nil)
+ (byte-compile-current-buffer (current-buffer))
+ (byte-compile-read-position (point))
+ (byte-compile-last-position byte-compile-read-position)
(byte-compile-last-warned-form 'nothing)
- (value (eval (displaying-byte-compile-warnings
- (byte-compile-sexp (read (current-buffer)))))))
+ (value (eval
+ (let ((read-with-symbol-positions (current-buffer))
+ (read-symbol-positions-list nil))
+ (displaying-byte-compile-warnings
+ (byte-compile-sexp (read (current-buffer))))))))
(cond (arg
(message "Compiling from buffer... done.")
(prin1 value (current-buffer))
(defun byte-compile-from-buffer (inbuffer &optional filename)
;; Filename is used for the loading-into-Emacs-18 error message.
(let (outbuffer
+ (byte-compile-current-buffer inbuffer)
+ (byte-compile-read-position nil)
+ (byte-compile-last-position nil)
;; Prevent truncation of flonums and lists as we read and print them
(float-output-format nil)
(case-fold-search nil)
(print-level nil)
;; Prevent edebug from interfering when we compile
;; and put the output into a file.
- (edebug-all-defs nil)
- (edebug-all-forms nil)
+;; (edebug-all-defs nil)
+;; (edebug-all-forms nil)
;; Simulate entry to byte-compile-top-level
(byte-compile-constants nil)
(byte-compile-variables nil)
(byte-compile-depth 0)
(byte-compile-maxdepth 0)
(byte-compile-output nil)
+ ;; This allows us to get the positions of symbols read; it's
+ ;; new in Emacs 21.4.
+ (read-with-symbol-positions inbuffer)
+ (read-symbol-positions-list nil)
;; #### This is bound in b-c-close-variables.
;; (byte-compile-warnings (if (eq byte-compile-warnings t)
;; byte-compile-warning-types
(looking-at ";"))
(forward-line 1))
(not (eobp)))
- (let ((byte-compile-last-line (count-lines (point-min) (point))))
- (byte-compile-file-form (read inbuffer))))
-
+ (setq byte-compile-read-position (point)
+ byte-compile-last-position byte-compile-read-position)
+ (let ((form (read inbuffer)))
+ (byte-compile-file-form form)))
;; Compile pending forms at end of file.
(byte-compile-flush-pending)
+ ;; Make warnings about unresolved functions
+ ;; give the end of the file as their position.
+ (setq byte-compile-last-position (point-max))
(byte-compile-warn-about-unresolved-functions)
;; Should we always do this? When calling multiple files, it
;; would be useful to delay this warning until all have
outbuffer))
(defun byte-compile-fix-header (filename inbuffer outbuffer)
- (save-excursion
- (set-buffer outbuffer)
+ (with-current-buffer outbuffer
;; See if the buffer has any multibyte characters.
(when (< (point-max) (position-bytes (point-max)))
(when (byte-compile-version-cond byte-compile-compatibility)
(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 "22")
(re-search-forward "19\\(\\.[0-9]+\\)")
- (replace-match "20")
+ (replace-match "22")
;; Now compensate for the change in size,
;; to make sure all positions in the file remain valid.
(setq delta (- (point-max) old-header-end))
(set-buffer outbuffer)
(goto-char 1)
;; 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 22) as a
++ ;; that is the file-format version number (18, 19, 20, or 22) 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"
(insert
";ELC"
- (if (byte-compile-version-cond byte-compile-compatibility) 18 20)
+ (if (byte-compile-version-cond byte-compile-compatibility) 18 22)
"\000\000\000\n"
)
(insert ";;; Compiled by "
;; 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"))
+ ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))
;; Here if we want Emacs 18 compatibility.
(when dynamic-docstrings
(error "Version-18 compatibility doesn't support dynamic doc strings"))
(prin1 form outbuffer)
nil)))
+(defvar print-gensym-alist) ;Used before print-circle existed.
+
(defun byte-compile-output-docform (preface name info form specindex quoted)
"Print a form with a doc string. INFO is (prefix doc-index postfix).
If PREFACE and NAME are non-nil, print them too,
(setq position
(byte-compile-output-as-comment
(nth (nth 1 info) form) nil))
- (setq position (position-bytes position))
+ (setq position (- (position-bytes position) (point-min) -1))
;; If the doc string starts with * (a user variable),
;; negate POSITION.
(if (and (stringp (nth (nth 1 info) form))
;; print-gensym-alist not to be cleared
;; between calls to print functions.
(print-gensym '(t))
- ;; print-gensym-alist was used before print-circle existed.
- print-gensym-alist
+ print-gensym-alist ; was used before print-circle existed.
(print-continuous-numbering t)
print-number-table
(index 0))
(while (setq form (cdr form))
(setq index (1+ index))
(insert " ")
- (cond ((and (numberp specindex) (= index specindex))
+ (cond ((and (numberp specindex) (= index specindex)
+ ;; Don't handle the definition dynamically
+ ;; if it refers (or might refer)
+ ;; to objects already output
+ ;; (for instance, gensyms in the arg list).
+ (let (non-nil)
+ (dotimes (i (length print-number-table))
+ (if (aref print-number-table i)
+ (setq non-nil t)))
+ (not non-nil)))
+ ;; Output the byte code and constants specially
+ ;; for lazy dynamic loading.
(let ((position
(byte-compile-output-as-comment
(cons (car form) (nth 1 form))
t)))
- (setq position (position-bytes position))
+ (setq position (- (position-bytes position) (point-min) -1))
(princ (format "(#$ . %d) nil" position) outbuffer)
(setq form (cdr form))
(setq index (1+ index))))
(put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst)
(defun byte-compile-file-form-defsubst (form)
- (cond ((assq (nth 1 form) byte-compile-unresolved-functions)
- (setq byte-compile-current-form (nth 1 form))
- (byte-compile-warn "defsubst %s was used before it was defined"
- (nth 1 form))))
+ (when (assq (nth 1 form) byte-compile-unresolved-functions)
+ (setq byte-compile-current-form (nth 1 form))
+ (byte-compile-warn "defsubst %s was used before it was defined"
+ (nth 1 form)))
(byte-compile-file-form
(macroexpand form byte-compile-macro-environment))
;; Return nil so the form is not output twice.
;; Since there is no doc string, we can compile this as a normal form,
;; and not do a file-boundary.
(byte-compile-keep-pending form)
- (if (memq 'free-vars byte-compile-warnings)
- (setq byte-compile-bound-variables
- (cons (nth 1 form) byte-compile-bound-variables)))
+ (when (memq 'free-vars byte-compile-warnings)
+ (push (nth 1 form) byte-compile-bound-variables)
+ (if (eq (car form) 'defconst)
+ (push (nth 1 form) byte-compile-const-variables)))
(cond ((consp (nth 2 form))
(setq form (copy-sequence form))
(setcar (cdr (cdr form))
(put 'custom-declare-variable 'byte-hunk-handler
'byte-compile-file-form-custom-declare-variable)
(defun byte-compile-file-form-custom-declare-variable (form)
- (if (memq 'free-vars byte-compile-warnings)
- (setq byte-compile-bound-variables
- (cons (nth 1 (nth 1 form)) byte-compile-bound-variables)))
+ (when (memq 'free-vars byte-compile-warnings)
+ (push (nth 1 (nth 1 form)) byte-compile-bound-variables))
+ (let ((tail (nthcdr 4 form)))
+ (while tail
+ ;; If there are any (function (lambda ...)) expressions, compile
+ ;; those functions.
+ (if (and (consp (car tail))
+ (eq (car (car tail)) 'function)
+ (consp (nth 1 (car tail))))
+ (setcar tail (byte-compile-lambda (nth 1 (car tail))))
+ ;; Likewise for a bare lambda.
+ (if (and (consp (car tail))
+ (eq (car (car tail)) 'lambda))
+ (setcar tail (byte-compile-lambda (car tail)))))
+ (setq tail (cdr tail))))
form)
(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary)
(defun byte-compile-file-form-eval-boundary (form)
- (eval form)
+ (let ((old-load-list current-load-list))
+ (eval form)
+ ;; (require 'cl) turns off warnings for cl functions.
+ (let ((tem current-load-list))
+ (while (not (eq tem old-load-list))
+ (when (equal (car tem) '(require . cl))
+ (setq byte-compile-warnings
+ (remq 'cl-functions byte-compile-warnings)))
+ (setq tem (cdr tem)))))
(byte-compile-keep-pending form 'byte-compile-normal-call))
(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
(that-one (assq name (symbol-value that-kind)))
(byte-compile-free-references nil)
(byte-compile-free-assignments nil))
-
+ (byte-compile-set-symbol-position name)
;; When a function or macro is defined, add it to the call tree so that
;; we can tell when functions are not used.
(if byte-compile-generate-call-tree
(nth 1 form)))
(setcdr that-one nil))
(this-one
- (if (and (memq 'redefine byte-compile-warnings)
+ (when (and (memq 'redefine byte-compile-warnings)
;; hack: don't warn when compiling the magic internal
;; byte-compiler macros in byte-run.el...
(not (assq (nth 1 form)
byte-compile-initial-macro-environment)))
- (byte-compile-warn "%s %s defined multiple times in this file"
- (if macrop "macro" "function")
- (nth 1 form))))
+ (byte-compile-warn "%s %s defined multiple times in this file"
+ (if macrop "macro" "function")
+ (nth 1 form))))
((and (fboundp name)
(eq (car-safe (symbol-function name))
(if macrop 'lambda 'macro)))
- (if (memq 'redefine byte-compile-warnings)
- (byte-compile-warn "%s %s being redefined as a %s"
- (if macrop "function" "macro")
- (nth 1 form)
- (if macrop "macro" "function")))
+ (when (memq 'redefine byte-compile-warnings)
+ (byte-compile-warn "%s %s being redefined as a %s"
+ (if macrop "function" "macro")
+ (nth 1 form)
+ (if macrop "macro" "function")))
;; shadow existing definition
(set this-kind
(cons (cons name nil) (symbol-value this-kind))))
)
(let ((body (nthcdr 3 form)))
- (if (and (stringp (car body))
- (symbolp (car-safe (cdr-safe body)))
- (car-safe (cdr-safe body))
- (stringp (car-safe (cdr-safe (cdr-safe body)))))
- (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
- (nth 1 form))))
+ (when (and (stringp (car body))
+ (symbolp (car-safe (cdr-safe body)))
+ (car-safe (cdr-safe body))
+ (stringp (car-safe (cdr-safe (cdr-safe body)))))
+ (byte-compile-set-symbol-position (nth 1 form))
+ (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
+ (nth 1 form))))
+
+ ;; Generate code for declarations in macro definitions.
+ ;; Remove declarations from the body of the macro definition.
+ (when macrop
+ (let ((tail (nthcdr 2 form)))
+ (when (stringp (car (cdr tail)))
+ (setq tail (cdr tail)))
+ (while (and (consp (car (cdr tail)))
+ (eq (car (car (cdr tail))) 'declare))
+ (let ((declaration (car (cdr tail))))
+ (setcdr tail (cdr (cdr tail)))
+ (princ `(if macro-declaration-function
+ (funcall macro-declaration-function
+ ',name ',declaration))
+ outbuffer)))))
+
(let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
(code (byte-compile-byte-code-maker new-one)))
(if this-one
(let (vars)
(while list
(let ((arg (car list)))
+ (when (symbolp arg)
+ (byte-compile-set-symbol-position arg))
(cond ((or (not (symbolp arg))
- (keywordp arg)
- (memq arg '(t nil)))
+ (byte-compile-const-symbol-p arg t))
(error "Invalid lambda variable %s" arg))
((eq arg '&rest)
(unless (cdr list)
(defun byte-compile-lambda (fun)
(unless (eq 'lambda (car-safe fun))
(error "Not a lambda list: %S" fun))
+ (byte-compile-set-symbol-position 'lambda)
(byte-compile-check-lambda-list (nth 1 fun))
(let* ((arglist (nth 1 fun))
(byte-compile-bound-variables
(if (cdr body)
(setq body (cdr body))))))
(int (assq 'interactive body)))
- (cond (int
- ;; Skip (interactive) if it is in front (the most usual location).
- (if (eq int (car body))
- (setq body (cdr body)))
- (cond ((consp (cdr int))
- (if (cdr (cdr int))
- (byte-compile-warn "malformed interactive spec: %s"
- (prin1-to-string int)))
- ;; If the interactive spec is a call to `list',
- ;; don't compile it, because `call-interactively'
- ;; looks at the args of `list'.
- (let ((form (nth 1 int)))
- (while (or (eq (car-safe form) 'let)
- (eq (car-safe form) 'let*)
- (eq (car-safe form) 'save-excursion))
- (while (consp (cdr form))
- (setq form (cdr form)))
- (setq form (car form)))
- (or (eq (car-safe form) 'list)
- (setq int (list 'interactive
- (byte-compile-top-level (nth 1 int)))))))
- ((cdr int)
- (byte-compile-warn "malformed interactive spec: %s"
- (prin1-to-string int))))))
+ ;; Process the interactive spec.
+ (when int
+ (byte-compile-set-symbol-position 'interactive)
+ ;; Skip (interactive) if it is in front (the most usual location).
+ (if (eq int (car body))
+ (setq body (cdr body)))
+ (cond ((consp (cdr int))
+ (if (cdr (cdr int))
+ (byte-compile-warn "malformed interactive spec: %s"
+ (prin1-to-string int)))
+ ;; If the interactive spec is a call to `list',
+ ;; don't compile it, because `call-interactively'
+ ;; looks at the args of `list'.
+ (let ((form (nth 1 int)))
+ (while (memq (car-safe form) '(let let* progn save-excursion))
+ (while (consp (cdr form))
+ (setq form (cdr form)))
+ (setq form (car form)))
+ (or (eq (car-safe form) 'list)
+ (setq int (list 'interactive
+ (byte-compile-top-level (nth 1 int)))))))
+ ((cdr int)
+ (byte-compile-warn "malformed interactive spec: %s"
+ (prin1-to-string int)))))
+ ;; Process the body.
(let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda)))
+ ;; Build the actual byte-coded function.
(if (and (eq 'byte-code (car-safe compiled))
(not (byte-compile-version-cond
byte-compile-compatibility)))
;; constant was not optimized away because we chose to return it.
(and (not (assq nil byte-compile-constants)) ; Nil is often there.
(let ((tmp (reverse byte-compile-constants)))
- (while (and tmp (not (or (symbolp (car (car tmp)))
- (numberp (car (car tmp))))))
+ (while (and tmp (not (or (symbolp (caar tmp))
+ (numberp (caar tmp)))))
(setq tmp (cdr tmp)))
- (car (car tmp)))))))
+ (caar tmp))))))
(byte-compile-out 'byte-return 0)
(setq byte-compile-output (nreverse byte-compile-output))
(if (memq byte-optimize '(t byte))
(defun byte-compile-form (form &optional for-effect)
(setq form (macroexpand form byte-compile-macro-environment))
(cond ((not (consp form))
+ (when (symbolp form)
+ (byte-compile-set-symbol-position form))
(cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
(byte-compile-constant form))
((and for-effect byte-compile-delete-errors)
((symbolp (car form))
(let* ((fn (car form))
(handler (get fn 'byte-compile)))
- (if (byte-compile-const-symbol-p fn)
- (byte-compile-warn "%s called as a function" fn))
+ (byte-compile-set-symbol-position fn)
+ (when (byte-compile-const-symbol-p fn)
+ (byte-compile-warn "%s called as a function" fn))
(if (and handler
(or (not (byte-compile-version-cond
byte-compile-compatibility))
(funcall handler form)
(if (memq 'callargs byte-compile-warnings)
(byte-compile-callargs-warn form))
- (byte-compile-normal-call form))))
+ (byte-compile-normal-call form))
+ (if (memq 'cl-functions byte-compile-warnings)
+ (byte-compile-cl-warn form))))
((and (or (byte-code-function-p (car form))
(eq (car-safe (car form)) 'lambda))
;; if the form comes out the same way it went in, that's
(byte-compile-out 'byte-call (length (cdr form))))
(defun byte-compile-variable-ref (base-op var)
- (if (or (not (symbolp var)) (byte-compile-const-symbol-p var))
- (byte-compile-warn (if (eq base-op 'byte-varbind)
- "attempt to let-bind %s %s"
- "variable reference to %s %s")
- (if (symbolp var) "constant" "nonvariable")
- (prin1-to-string var))
+ (when (symbolp var)
+ (byte-compile-set-symbol-position var))
+ (if (or (not (symbolp var))
+ (byte-compile-const-symbol-p var (not (eq base-op 'byte-varref))))
+ (byte-compile-warn
+ (cond ((eq base-op 'byte-varbind) "attempt to let-bind %s %s")
+ ((eq base-op 'byte-varset) "variable assignment to %s %s")
+ (t "variable reference to %s %s"))
+ (if (symbolp var) "constant" "nonvariable")
+ (prin1-to-string var))
(if (and (get var 'byte-obsolete-variable)
(memq 'obsolete byte-compile-warnings))
(let* ((ob (get var 'byte-obsolete-variable))
(format "use %s instead." (car ob))))))
(if (memq 'free-vars byte-compile-warnings)
(if (eq base-op 'byte-varbind)
- (setq byte-compile-bound-variables
- (cons var byte-compile-bound-variables))
+ (push var byte-compile-bound-variables)
(or (boundp var)
(memq var byte-compile-bound-variables)
(if (eq base-op 'byte-varset)
(or (memq var byte-compile-free-assignments)
(progn
(byte-compile-warn "assignment to free variable %s" var)
- (setq byte-compile-free-assignments
- (cons var byte-compile-free-assignments))))
+ (push var byte-compile-free-assignments)))
(or (memq var byte-compile-free-references)
(progn
(byte-compile-warn "reference to free variable %s" var)
- (setq byte-compile-free-references
- (cons var byte-compile-free-references)))))))))
+ (push var byte-compile-free-references))))))))
(let ((tmp (assq var byte-compile-variables)))
- (or tmp
- (setq tmp (list var)
- byte-compile-variables (cons tmp byte-compile-variables)))
+ (unless tmp
+ (setq tmp (list var))
+ (push tmp byte-compile-variables))
(byte-compile-out base-op tmp)))
(defmacro byte-compile-get-constant (const)
(defun byte-compile-constant (const)
(if for-effect
(setq for-effect nil)
+ (when (symbolp const)
+ (byte-compile-set-symbol-position const))
(byte-compile-out 'byte-constant (byte-compile-get-constant const))))
;; Use this for a constant that is not the value of its containing form.
;; If function is a symbol, then the variable "byte-SYMBOL" must name
;; the opcode to be used. If function is a list, the first element
;; is the function and the second element is the bytecode-symbol.
+ ;; The second element may be nil, meaning there is no opcode.
;; COMPILE-HANDLER is the function to use to compile this byte-op, or
;; may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.
;; If it is nil, then the handler is "byte-compile-SYMBOL."
\f
(defun byte-compile-subr-wrong-args (form n)
+ (byte-compile-set-symbol-position (car form))
(byte-compile-warn "%s called with %d arg%s, but requires %s"
(car form) (length (cdr form))
(if (= 1 (length (cdr form))) "" "s") n)
(setq args (cdr args))
(or args (setq args '(0)
opcode (get '+ 'byte-opcode)))
- (while args
- (byte-compile-form (car args))
- (byte-compile-out opcode 0)
- (setq args (cdr args))))
+ (dolist (arg args)
+ (byte-compile-form arg)
+ (byte-compile-out opcode 0)))
(byte-compile-constant (eval form))))
\f
(byte-defop-compiler-1 mapatoms byte-compile-funarg)
(byte-defop-compiler-1 mapconcat byte-compile-funarg)
(byte-defop-compiler-1 mapc byte-compile-funarg)
-(byte-defop-compiler-1 sort byte-compile-funarg-2)
+(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*)
(defun byte-compile-if (form)
(byte-compile-form (car (cdr form)))
- (if (null (nthcdr 3 form))
- ;; No else-forms
- (let ((donetag (byte-compile-make-tag)))
- (byte-compile-goto-if nil for-effect donetag)
- (byte-compile-form (nth 2 form) for-effect)
- (byte-compile-out-tag donetag))
- (let ((donetag (byte-compile-make-tag)) (elsetag (byte-compile-make-tag)))
- (byte-compile-goto 'byte-goto-if-nil elsetag)
- (byte-compile-form (nth 2 form) for-effect)
- (byte-compile-goto 'byte-goto donetag)
- (byte-compile-out-tag elsetag)
- (byte-compile-body (cdr (cdr (cdr form))) for-effect)
- (byte-compile-out-tag donetag)))
+ ;; Check whether we have `(if (fboundp ...' or `(if (boundp ...'
+ ;; and avoid warnings about the relevent symbols in the consequent.
+ (let* ((clause (nth 1 form))
+ (fbound (if (eq 'fboundp (car-safe clause))
+ (and (eq 'quote (car-safe (nth 1 clause)))
+ ;; Ignore if the symbol is already on the
+ ;; unresolved list.
+ (not (assq
+ (nth 1 (nth 1 clause)) ; the relevant symbol
+ byte-compile-unresolved-functions))
+ (nth 1 (nth 1 clause)))))
+ (bound (if (eq 'boundp (car-safe clause))
+ (and (eq 'quote (car-safe (nth 1 clause)))
+ (nth 1 (nth 1 clause)))))
+ (donetag (byte-compile-make-tag)))
+ (if (null (nthcdr 3 form))
+ ;; No else-forms
+ (progn
+ (byte-compile-goto-if nil for-effect donetag)
+ ;; Maybe add to the bound list.
+ (let ((byte-compile-bound-variables
+ (if bound
+ (cons bound byte-compile-bound-variables)
+ byte-compile-bound-variables)))
+ (byte-compile-form (nth 2 form) for-effect))
+ ;; Maybe remove the function symbol from the unresolved list.
+ (if fbound
+ (setq byte-compile-unresolved-functions
+ (delq (assq fbound byte-compile-unresolved-functions)
+ byte-compile-unresolved-functions)))
+ (byte-compile-out-tag donetag))
+ (let ((elsetag (byte-compile-make-tag)))
+ (byte-compile-goto 'byte-goto-if-nil elsetag)
+ ;; As above for the first form.
+ (let ((byte-compile-bound-variables
+ (if bound
+ (cons bound byte-compile-bound-variables)
+ byte-compile-bound-variables)))
+ (byte-compile-form (nth 2 form) for-effect))
+ (if fbound
+ (setq byte-compile-unresolved-functions
+ (delq (assq fbound byte-compile-unresolved-functions)
+ byte-compile-unresolved-functions)))
+ (byte-compile-goto 'byte-goto donetag)
+ (byte-compile-out-tag elsetag)
+ (byte-compile-body (cdr (cdr (cdr form))) for-effect)
+ (byte-compile-out-tag donetag))))
(setq for-effect nil))
(defun byte-compile-cond (clauses)
(defun byte-compile-let (form)
;; First compute the binding values in the old scope.
(let ((varlist (car (cdr form))))
- (while varlist
- (if (consp (car varlist))
- (byte-compile-form (car (cdr (car varlist))))
- (byte-compile-push-constant nil))
- (setq varlist (cdr varlist))))
+ (dolist (var varlist)
+ (if (consp var)
+ (byte-compile-form (car (cdr var)))
+ (byte-compile-push-constant nil))))
(let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
(varlist (reverse (car (cdr form)))))
- (while varlist
- (byte-compile-variable-ref 'byte-varbind (if (consp (car varlist))
- (car (car varlist))
- (car varlist)))
- (setq varlist (cdr varlist)))
+ (dolist (var varlist)
+ (byte-compile-variable-ref 'byte-varbind (if (consp var) (car var) var)))
(byte-compile-body-do-effect (cdr (cdr form)))
(byte-compile-out 'byte-unbind (length (car (cdr form))))))
(defun byte-compile-let* (form)
(let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
(varlist (copy-sequence (car (cdr form)))))
- (while varlist
- (if (atom (car varlist))
+ (dolist (var varlist)
+ (if (atom var)
(byte-compile-push-constant nil)
- (byte-compile-form (car (cdr (car varlist))))
- (setcar varlist (car (car varlist))))
- (byte-compile-variable-ref 'byte-varbind (car varlist))
- (setq varlist (cdr varlist)))
+ (byte-compile-form (car (cdr var)))
+ (setq var (car var)))
+ (byte-compile-variable-ref 'byte-varbind var))
(byte-compile-body-do-effect (cdr (cdr form)))
(byte-compile-out 'byte-unbind (length (car (cdr form))))))
;; Even when optimization is off, /= is optimized to (not (= ...)).
(defun byte-compile-negation-optimizer (form)
;; an optimizer for forms where <form1> is less efficient than (not <form2>)
+ (byte-compile-set-symbol-position (car form))
(list 'not
(cons (or (get (car form) 'byte-compile-negated-op)
(error
(defun byte-compile-track-mouse (form)
(byte-compile-form
- (list
- 'funcall
- (list 'quote
- (list 'lambda nil
- (cons 'track-mouse
- (byte-compile-top-level-body (cdr form))))))))
+ `(funcall '(lambda nil
+ (track-mouse ,@(byte-compile-top-level-body (cdr form)))))))
(defun byte-compile-condition-case (form)
(let* ((var (nth 1 form))
(byte-compile-bound-variables
(if var (cons var byte-compile-bound-variables)
byte-compile-bound-variables)))
- (or (symbolp var)
- (byte-compile-warn
- "%s is not a variable-name or nil (in condition-case)" var))
+ (byte-compile-set-symbol-position 'condition-case)
+ (unless (symbolp var)
+ (byte-compile-warn
+ "%s is not a variable-name or nil (in condition-case)" var))
(byte-compile-push-constant var)
(byte-compile-push-constant (byte-compile-top-level
(nth 2 form) for-effect))
(byte-compile-out 'byte-temp-output-buffer-setup 0)
(byte-compile-body (cdr (cdr form)))
(byte-compile-out 'byte-temp-output-buffer-show 0))
-
\f
;;; top-level forms elsewhere
(defun byte-compile-defun (form)
;; This is not used for file-level defuns with doc strings.
- (unless (symbolp (car form))
+ (if (symbolp (car form))
+ (byte-compile-set-symbol-position (car form))
+ (byte-compile-set-symbol-position 'defun)
(error "defun name must be a symbol, not %s" (car form)))
- (byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
- (list 'fset (list 'quote (nth 1 form))
- (byte-compile-byte-code-maker
- (byte-compile-lambda (cons 'lambda (cdr (cdr form)))))))
- (byte-compile-discard)
+ (if (byte-compile-version-cond byte-compile-compatibility)
+ (progn
+ (byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
+ (list 'fset
+ (list 'quote (nth 1 form))
+ (byte-compile-byte-code-maker
+ (byte-compile-lambda (cons 'lambda (cdr (cdr form)))))))
+ (byte-compile-discard))
+ ;; We prefer to generate a defalias form so it will record the function
+ ;; definition just like interpreting a defun.
+ (byte-compile-form
+ (list 'defalias
+ (list 'quote (nth 1 form))
+ (byte-compile-byte-code-maker
+ (byte-compile-lambda (cons 'lambda (cdr (cdr form))))))
+ t))
(byte-compile-constant (nth 1 form)))
(defun byte-compile-defmacro (form)
(var (nth 1 form))
(value (nth 2 form))
(string (nth 3 form)))
- (when (> (length form) 4)
- (byte-compile-warn
- "%s %s called with %d arguments, but accepts only %s"
- fun var (length (cdr form)) 3))
+ (byte-compile-set-symbol-position fun)
+ (when (or (> (length form) 4)
+ (and (eq fun 'defconst) (null (cddr form))))
+ (let ((ncall (length (cdr form))))
+ (byte-compile-warn
+ "%s called with %d argument%s, but %s %s"
+ fun ncall
+ (if (= 1 ncall) "" "s")
+ (if (< ncall 2) "requires" "accepts only")
+ "2-3")))
(when (memq 'free-vars byte-compile-warnings)
- (setq byte-compile-bound-variables
- (cons var byte-compile-bound-variables)))
+ (push var byte-compile-bound-variables)
+ (if (eq fun 'defconst)
+ (push var byte-compile-const-variables)))
(byte-compile-body-do-effect
(list
;; Put the defined variable in this library's load-history entry
(if (eq fun 'defconst)
;; `defconst' sets `var' unconditionally.
(let ((tmp (make-symbol "defconst-tmp-var")))
- `(let ((,tmp ,value))
- (eval '(defconst ,var ,tmp))))
+ `(funcall '(lambda (,tmp) (defconst ,var ,tmp))
+ ,value))
;; `defvar' sets `var' only when unbound.
- `(if (not (boundp ',var)) (setq ,var ,value))))
+ `(if (not (default-boundp ',var)) (setq-default ,var ,value)))
+ (when (eq fun 'defconst)
+ ;; This will signal an appropriate error at runtime.
+ `(eval ',form)))
`',var))))
(defun byte-compile-autoload (form)
+ (byte-compile-set-symbol-position 'autoload)
(and (byte-compile-constp (nth 1 form))
(byte-compile-constp (nth 5 form))
(eval (nth 5 form)) ; macro-p
;; Lambdas in valid places are handled as special cases by various code.
;; The ones that remain are errors.
(defun byte-compile-lambda-form (form)
+ (byte-compile-set-symbol-position 'lambda)
(error "`lambda' used as function name is invalid"))
;; Compile normally, but deal with warnings for the function being defined.
(consp (cdr (nth 2 form)))
(symbolp (nth 1 (nth 2 form))))
(progn
- (byte-compile-defalias-warn (nth 1 (nth 1 form))
- (nth 1 (nth 2 form)))
+ (byte-compile-defalias-warn (nth 1 (nth 1 form)))
(setq byte-compile-function-environment
(cons (cons (nth 1 (nth 1 form))
(nth 1 (nth 2 form)))
;; Turn off warnings about prior calls to the function being defalias'd.
;; This could be smarter and compare those calls with
;; the function it is being aliased to.
-(defun byte-compile-defalias-warn (new alias)
+(defun byte-compile-defalias-warn (new)
(let ((calls (assq new byte-compile-unresolved-functions)))
(if calls
(setq byte-compile-unresolved-functions
(delq calls byte-compile-unresolved-functions)))))
+
+(byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings)
+(defun byte-compile-no-warnings (form)
+ (let (byte-compile-warnings)
+ (byte-compile-form (cadr form))))
\f
;;; tags
(setcdr (cdr tag) byte-compile-depth)))
(defun byte-compile-goto (opcode tag)
- (setq byte-compile-output (cons (cons opcode tag) byte-compile-output))
+ (push (cons opcode tag) byte-compile-output)
(setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops)
(1- byte-compile-depth)
byte-compile-depth))
(1- byte-compile-depth))))
(defun byte-compile-out (opcode offset)
- (setq byte-compile-output (cons (cons opcode offset) byte-compile-output))
+ (push (cons opcode offset) byte-compile-output)
(cond ((eq opcode 'byte-call)
(setq byte-compile-depth (- byte-compile-depth offset)))
((eq opcode 'byte-return)
(defun batch-byte-compile-file (file)
(condition-case err
(byte-compile-file file)
+ (file-error
+ (message (if (cdr err)
+ ">>Error occurred processing %s: %s (%s)"
+ ">>Error occurred processing %s: %s")
+ file
+ (get (car err) 'error-message)
+ (prin1-to-string (cdr err)))
+ (let ((destfile (byte-compile-dest-file file)))
+ (if (file-exists-p destfile)
+ (delete-file destfile)))
+ nil)
(error
(message (if (cdr err)
">>Error occurred processing %s: %s (%s)"
;;;###autoload
(defun batch-byte-recompile-directory ()
- "Runs `byte-recompile-directory' on the dirs remaining on the command line.
+ "Run `byte-recompile-directory' on the dirs remaining on the command line.
Must be used only with `-batch', and kills Emacs on completion.
For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
;; command-line-args-left is what is left of the command line (startup.el)
(kill-emacs 0))
-(make-obsolete 'dot 'point "before 19.15")
-(make-obsolete 'dot-max 'point-max "before 19.15")
-(make-obsolete 'dot-min 'point-min "before 19.15")
-(make-obsolete 'dot-marker 'point-marker "before 19.15")
-
-(make-obsolete 'buffer-flush-undo 'buffer-disable-undo "before 19.15")
-(make-obsolete 'baud-rate "use the baud-rate variable instead" "before 19.15")
-(make-obsolete 'compiled-function-p 'byte-code-function-p "before 19.15")
-(make-obsolete 'define-function 'defalias "20.1")
(make-obsolete-variable 'auto-fill-hook 'auto-fill-function "before 19.15")
(make-obsolete-variable 'blink-paren-hook 'blink-paren-function "before 19.15")
(make-obsolete-variable 'lisp-indent-hook 'lisp-indent-function "before 19.15")
(make-obsolete-variable 'inhibit-local-variables
"use enable-local-variables (with the reversed sense)."
"before 19.15")
-(make-obsolete-variable 'unread-command-char
- "use unread-command-events instead. That variable is a list of events to reread, so it now uses nil to mean `no event', instead of -1."
- "before 19.15")
(make-obsolete-variable 'unread-command-event
"use unread-command-events; which is a list of events rather than a single event."
"before 19.15")
(make-obsolete-variable 'suspend-hooks 'suspend-hook "before 19.15")
(make-obsolete-variable 'comment-indent-hook 'comment-indent-function "before 19.15")
-(make-obsolete-variable 'meta-flag "Use the set-input-mode function instead." "before 19.34")
-(make-obsolete-variable 'executing-macro 'executing-kbd-macro "before 19.34")
+(make-obsolete-variable 'meta-flag "use the set-input-mode function instead." "before 19.34")
(make-obsolete-variable 'before-change-function
"use before-change-functions; which is a list of functions rather than a single function."
"before 19.34")
"use after-change-functions; which is a list of functions rather than a single function."
"before 19.34")
(make-obsolete-variable 'font-lock-doc-string-face 'font-lock-string-face "before 19.34")
-(make-obsolete-variable 'post-command-idle-hook
- "use timers instead, with `run-with-idle-timer'." "before 19.34")
-(make-obsolete-variable 'post-command-idle-delay
- "use timers instead, with `run-with-idle-timer'." "before 19.34")
(provide 'byte-compile)
(provide 'bytecomp)
\f
;;; report metering (see the hacks in bytecode.c)
+(defvar byte-code-meter)
(defun byte-compile-report-ops ()
- (defvar byte-code-meter)
(with-output-to-temp-buffer "*Meter*"
(set-buffer "*Meter*")
(let ((i 0) n op off)
;;; cl-macs.el --- Common Lisp macros -*-byte-compile-dynamic: t;-*-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2003 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Version: 2.02
(error "Tried to load `cl-macs' before `cl'!"))
-;;; We define these here so that this file can compile without having
-;;; loaded the cl.el file already.
-
-(defmacro cl-push (x place) (list 'setq place (list 'cons x place)))
-(defmacro cl-pop (place)
- (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))))
(defmacro cl-pop2 (place)
(list 'prog1 (list 'car (list 'cdr place))
(list 'setq place (list 'cdr (list 'cdr place)))))
-(put 'cl-push 'edebug-form-spec 'edebug-sexps)
-(put 'cl-pop 'edebug-form-spec 'edebug-sexps)
(put 'cl-pop2 'edebug-form-spec 'edebug-sexps)
(defvar cl-optimize-safety)
(run-hooks 'cl-hack-bytecomp-hook))
+;;; Some predicates for analyzing Lisp forms. These are used by various
+;;; macro expanders to optimize the results in certain common cases.
+
+(defconst cl-simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max
+ car-safe cdr-safe progn prog1 prog2))
+(defconst cl-safe-funcs '(* / % length memq list vector vectorp
+ < > <= >= = error))
+
+;;; Check if no side effects, and executes quickly.
+(defun cl-simple-expr-p (x &optional size)
+ (or size (setq size 10))
+ (if (and (consp x) (not (memq (car x) '(quote function function*))))
+ (and (symbolp (car x))
+ (or (memq (car x) cl-simple-funcs)
+ (get (car x) 'side-effect-free))
+ (progn
+ (setq size (1- size))
+ (while (and (setq x (cdr x))
+ (setq size (cl-simple-expr-p (car x) size))))
+ (and (null x) (>= size 0) size)))
+ (and (> size 0) (1- size))))
+
+(defun cl-simple-exprs-p (xs)
+ (while (and xs (cl-simple-expr-p (car xs)))
+ (setq xs (cdr xs)))
+ (not xs))
+
+;;; Check if no side effects.
+(defun cl-safe-expr-p (x)
+ (or (not (and (consp x) (not (memq (car x) '(quote function function*)))))
+ (and (symbolp (car x))
+ (or (memq (car x) cl-simple-funcs)
+ (memq (car x) cl-safe-funcs)
+ (get (car x) 'side-effect-free))
+ (progn
+ (while (and (setq x (cdr x)) (cl-safe-expr-p (car x))))
+ (null x)))))
+
+;;; Check if constant (i.e., no side effects or dependencies).
+(defun cl-const-expr-p (x)
+ (cond ((consp x)
+ (or (eq (car x) 'quote)
+ (and (memq (car x) '(function function*))
+ (or (symbolp (nth 1 x))
+ (and (eq (car-safe (nth 1 x)) 'lambda) 'func)))))
+ ((symbolp x) (and (memq x '(nil t)) t))
+ (t t)))
+
+(defun cl-const-exprs-p (xs)
+ (while (and xs (cl-const-expr-p (car xs)))
+ (setq xs (cdr xs)))
+ (not xs))
+
+(defun cl-const-expr-val (x)
+ (and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x)))
+
+(defun cl-expr-access-order (x v)
+ (if (cl-const-expr-p x) v
+ (if (consp x)
+ (progn
+ (while (setq x (cdr x)) (setq v (cl-expr-access-order (car x) v)))
+ v)
+ (if (eq x (car v)) (cdr v) '(t)))))
+
+;;; Count number of times X refers to Y. Return nil for 0 times.
+(defun cl-expr-contains (x y)
+ (cond ((equal y x) 1)
+ ((and (consp x) (not (memq (car-safe x) '(quote function function*))))
+ (let ((sum 0))
+ (while x
+ (setq sum (+ sum (or (cl-expr-contains (pop x) y) 0))))
+ (and (> sum 0) sum)))
+ (t nil)))
+
+(defun cl-expr-contains-any (x y)
+ (while (and y (not (cl-expr-contains x (car y)))) (pop y))
+ y)
+
+;;; Check whether X may depend on any of the symbols in Y.
+(defun cl-expr-depends-p (x y)
+ (and (not (cl-const-expr-p x))
+ (or (not (cl-safe-expr-p x)) (cl-expr-contains-any x y))))
+
;;; Symbols.
(defvar *gensym-counter*)
;;; Program structure.
(defmacro defun* (name args &rest body)
- "(defun* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.
+ "Define NAME as a function.
Like normal `defun', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...)."
+and BODY is implicitly surrounded by (block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)"
(let* ((res (cl-transform-lambda (cons args body) name))
(form (list* 'defun name (cdr res))))
(if (car res) (list 'progn (car res) form) form)))
(defmacro defmacro* (name args &rest body)
- "(defmacro* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro.
+ "Define NAME as a macro.
Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...)."
+and BODY is implicitly surrounded by (block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)"
(let* ((res (cl-transform-lambda (cons args body) name))
(form (list* 'defmacro name (cdr res))))
(if (car res) (list 'progn (car res) form) form)))
(defvar bind-inits) (defvar bind-lets) (defvar bind-forms)
(defun cl-transform-lambda (form bind-block)
- (let* ((args (car form)) (body (cdr form))
+ (let* ((args (car form)) (body (cdr form)) (orig-args args)
(bind-defs nil) (bind-enquote nil)
(bind-inits nil) (bind-lets nil) (bind-forms nil)
(header nil) (simple-args nil))
(while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive))
- (cl-push (cl-pop body) header))
+ (push (pop body) header))
(setq args (if (listp args) (copy-list args) (list '&rest args)))
(let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
(if (setq bind-defs (cadr (memq '&cl-defs args)))
(not (memq (car args) '(nil &rest &body &key &aux)))
(not (and (eq (car args) '&optional)
(or bind-defs (consp (cadr args))))))
- (cl-push (cl-pop args) simple-args))
+ (push (pop args) simple-args))
(or (eq bind-block 'cl-none)
(setq body (list (list* 'block bind-block body))))
(if (null args)
(list* nil (nreverse simple-args) (nconc (nreverse header) body))
- (if (memq '&optional simple-args) (cl-push '&optional args))
+ (if (memq '&optional simple-args) (push '&optional args))
(cl-do-arglist args nil (- (length simple-args)
(if (memq '&optional simple-args) 1 0)))
(setq bind-lets (nreverse bind-lets))
(list* (and bind-inits (list* 'eval-when '(compile load eval)
(nreverse bind-inits)))
(nconc (nreverse simple-args)
- (list '&rest (car (cl-pop bind-lets))))
- (nconc (nreverse header)
+ (list '&rest (car (pop bind-lets))))
+ (nconc (let ((hdr (nreverse header)))
+ (require 'help-fns)
+ (cons (help-add-fundoc-usage
+ (if (stringp (car hdr)) (pop hdr))
+ ;; orig-args can contain &cl-defs (an internal CL
+ ;; thingy that I do not understand), so remove it.
+ (let ((x (memq '&cl-defs orig-args)))
+ (if (null x) orig-args
+ (delq (car x) (remq (cadr x) orig-args)))))
+ hdr))
(list (nconc (list 'let* bind-lets)
(nreverse bind-forms) body)))))))
(if (nlistp args)
(if (or (memq args lambda-list-keywords) (not (symbolp args)))
(error "Invalid argument name: %s" args)
- (cl-push (list args expr) bind-lets))
+ (push (list args expr) bind-lets))
(setq args (copy-list args))
(let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
(let ((p (memq '&body args))) (if p (setcar p '&rest)))
(if (listp (cadr restarg))
(setq restarg (gensym "--rest--"))
(setq restarg (cadr restarg)))
- (cl-push (list restarg expr) bind-lets)
+ (push (list restarg expr) bind-lets)
(if (eq (car args) '&whole)
- (cl-push (list (cl-pop2 args) restarg) bind-lets))
+ (push (list (cl-pop2 args) restarg) bind-lets))
(let ((p args))
(setq minarg restarg)
(while (and p (not (memq (car p) lambda-list-keywords)))
(let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car)
restarg)))
(cl-do-arglist
- (cl-pop args)
+ (pop args)
(if (or laterarg (= safety 0)) poparg
(list 'if minarg poparg
(list 'signal '(quote wrong-number-of-arguments)
(list 'quote bind-block))
(list 'length restarg)))))))
(setq num (1+ num) laterarg t))
- (while (and (eq (car args) '&optional) (cl-pop args))
+ (while (and (eq (car args) '&optional) (pop args))
(while (and args (not (memq (car args) lambda-list-keywords)))
- (let ((arg (cl-pop args)))
+ (let ((arg (pop args)))
(or (consp arg) (setq arg (list arg)))
(if (cddr arg) (cl-do-arglist (nth 2 arg) (list 'and restarg t)))
(let ((def (if (cdr arg) (nth 1 arg)
(let ((arg (cl-pop2 args)))
(if (consp arg) (cl-do-arglist arg restarg)))
(or (eq (car args) '&key) (= safety 0) exactarg
- (cl-push (list 'if restarg
+ (push (list 'if restarg
(list 'signal '(quote wrong-number-of-arguments)
(list 'list
(and (not (eq bind-block 'cl-none))
(list 'quote bind-block))
(list '+ num (list 'length restarg)))))
bind-forms)))
- (while (and (eq (car args) '&key) (cl-pop args))
+ (while (and (eq (car args) '&key) (pop args))
(while (and args (not (memq (car args) lambda-list-keywords)))
- (let ((arg (cl-pop args)))
+ (let ((arg (pop args)))
(or (consp arg) (setq arg (list arg)))
(let* ((karg (if (consp (car arg)) (caar arg)
(intern (format ":%s" (car arg)))))
'quote
(list nil (cl-const-expr-val def)))
(list 'list nil def))))))))
- (cl-push karg keys)))))
+ (push karg keys)))))
(setq keys (nreverse keys))
- (or (and (eq (car args) '&allow-other-keys) (cl-pop args))
+ (or (and (eq (car args) '&allow-other-keys) (pop args))
(null keys) (= safety 0)
(let* ((var (gensym "--keys--"))
(allow '(:allow-other-keys))
(format "Keyword argument %%s not one of %s"
keys)
(list 'car var)))))))
- (cl-push (list 'let (list (list var restarg)) check) bind-forms)))
- (while (and (eq (car args) '&aux) (cl-pop args))
+ (push (list 'let (list (list var restarg)) check) bind-forms)))
+ (while (and (eq (car args) '&aux) (pop args))
(while (and args (not (memq (car args) lambda-list-keywords)))
(if (consp (car args))
(if (and bind-enquote (cadar args))
(cl-do-arglist (caar args)
- (list 'quote (cadr (cl-pop args))))
- (cl-do-arglist (caar args) (cadr (cl-pop args))))
- (cl-do-arglist (cl-pop args) nil))))
+ (list 'quote (cadr (pop args))))
+ (cl-do-arglist (caar args) (cadr (pop args))))
+ (cl-do-arglist (pop args) nil))))
(if args (error "Malformed argument list %s" save-args)))))
(defun cl-arglist-args (args)
(if (nlistp args) (list args)
(let ((res nil) (kind nil) arg)
(while (consp args)
- (setq arg (cl-pop args))
+ (setq arg (pop args))
(if (memq arg lambda-list-keywords) (setq kind arg)
- (if (eq arg '&cl-defs) (cl-pop args)
+ (if (eq arg '&cl-defs) (pop args)
(and (consp arg) kind (setq arg (car arg)))
(and (consp arg) (cdr arg) (eq kind '&key) (setq arg (cadr arg)))
(setq res (nconc res (cl-arglist-args arg))))))
(defvar cl-not-toplevel nil)
(defmacro eval-when (when &rest body)
- "(eval-when (WHEN...) BODY...): control when BODY is evaluated.
+ "Control when BODY is evaluated.
If `compile' is in WHEN, BODY is evaluated when compiled at top-level.
If `load' is in WHEN, BODY is evaluated when loaded after top-level compile.
-If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level."
+If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
+
+\(fn (WHEN...) BODY...)"
(if (and (fboundp 'cl-compiling-file) (cl-compiling-file)
(not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge
(let ((comp (or (memq 'compile when) (memq :compile-toplevel when)))
Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared
against each key in each KEYLIST; the corresponding BODY is evaluated.
If no clause succeeds, case returns nil. A single atom may be used in
-place of a KEYLIST of one atom. A KEYLIST of `t' or `otherwise' is
+place of a KEYLIST of one atom. A KEYLIST of t or `otherwise' is
allowed only in the final clause, and matches if no other keys match.
Key values are compared by `eql'."
(let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym)))
(if (memq (car c) head-list)
(error "Duplicate key in case: %s"
(car c)))
- (cl-push (car c) head-list)
+ (push (car c) head-list)
(list 'eql temp (list 'quote (car c)))))
(or (cdr c) '(nil)))))
clauses))))
"Evals EXPR, chooses from CLAUSES on that value.
Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it
satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds,
-typecase returns nil. A TYPE of `t' or `otherwise' is allowed only in the
+typecase returns nil. A TYPE of t or `otherwise' is allowed only in the
final clause, and matches if no other keys match."
(let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym)))
(type-list nil)
(list 'error "etypecase failed: %s, %s"
temp (list 'quote (reverse type-list))))
(t
- (cl-push (car c) type-list)
+ (push (car c) type-list)
(cl-make-type-test temp (car c))))
(or (cdr c) '(nil)))))
clauses))))
(defvar loop-result-var) (defvar loop-steps) (defvar loop-symbol-macs)
(defmacro loop (&rest args)
- "(loop CLAUSE...): The Common Lisp `loop' macro.
+ "The Common Lisp `loop' macro.
Valid clauses are:
for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM,
for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR,
if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...],
unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...],
do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR,
- finally return EXPR, named NAME."
+ finally return EXPR, named NAME.
+
+\(fn CLAUSE...)"
(if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list args))))))
(list 'block nil (list* 'while t args))
(let ((loop-name nil) (loop-bindings nil)
(setq args (append args '(cl-end-loop)))
(while (not (eq (car args) 'cl-end-loop)) (cl-parse-loop-clause))
(if loop-finish-flag
- (cl-push (list (list loop-finish-flag t)) loop-bindings))
+ (push (list (list loop-finish-flag t)) loop-bindings))
(if loop-first-flag
- (progn (cl-push (list (list loop-first-flag t)) loop-bindings)
- (cl-push (list 'setq loop-first-flag nil) loop-steps)))
+ (progn (push (list (list loop-first-flag t)) loop-bindings)
+ (push (list 'setq loop-first-flag nil) loop-steps)))
(let* ((epilogue (nconc (nreverse loop-finally)
(list (or loop-result-explicit loop-result))))
(ands (cl-loop-build-ands (nreverse loop-body)))
(list (list 'if loop-finish-flag
(cons 'progn epilogue) loop-result-var)))
epilogue))))
- (if loop-result-var (cl-push (list loop-result-var) loop-bindings))
+ (if loop-result-var (push (list loop-result-var) loop-bindings))
(while loop-bindings
(if (cdar loop-bindings)
- (setq body (list (cl-loop-let (cl-pop loop-bindings) body t)))
+ (setq body (list (cl-loop-let (pop loop-bindings) body t)))
(let ((lets nil))
(while (and loop-bindings
(not (cdar loop-bindings)))
- (cl-push (car (cl-pop loop-bindings)) lets))
+ (push (car (pop loop-bindings)) lets))
(setq body (list (cl-loop-let lets body nil))))))
(if loop-symbol-macs
(setq body (list (list* 'symbol-macrolet loop-symbol-macs body))))
(list* 'block loop-name body)))))
(defun cl-parse-loop-clause () ; uses args, loop-*
- (let ((word (cl-pop args))
+ (let ((word (pop args))
(hash-types '(hash-key hash-keys hash-value hash-values))
(key-types '(key-code key-codes key-seq key-seqs
key-binding key-bindings)))
(error "Malformed `loop' macro"))
((eq word 'named)
- (setq loop-name (cl-pop args)))
+ (setq loop-name (pop args)))
((eq word 'initially)
- (if (memq (car args) '(do doing)) (cl-pop args))
+ (if (memq (car args) '(do doing)) (pop args))
(or (consp (car args)) (error "Syntax error on `initially' clause"))
(while (consp (car args))
- (cl-push (cl-pop args) loop-initially)))
+ (push (pop args) loop-initially)))
((eq word 'finally)
(if (eq (car args) 'return)
(setq loop-result-explicit (or (cl-pop2 args) '(quote nil)))
- (if (memq (car args) '(do doing)) (cl-pop args))
+ (if (memq (car args) '(do doing)) (pop args))
(or (consp (car args)) (error "Syntax error on `finally' clause"))
(if (and (eq (caar args) 'return) (null loop-name))
- (setq loop-result-explicit (or (nth 1 (cl-pop args)) '(quote nil)))
+ (setq loop-result-explicit (or (nth 1 (pop args)) '(quote nil)))
(while (consp (car args))
- (cl-push (cl-pop args) loop-finally)))))
+ (push (pop args) loop-finally)))))
((memq word '(for as))
(let ((loop-for-bindings nil) (loop-for-sets nil) (loop-for-steps nil)
(ands nil))
(while
- (let ((var (or (cl-pop args) (gensym))))
- (setq word (cl-pop args))
- (if (eq word 'being) (setq word (cl-pop args)))
- (if (memq word '(the each)) (setq word (cl-pop args)))
+ (let ((var (or (pop args) (gensym))))
+ (setq word (pop args))
+ (if (eq word 'being) (setq word (pop args)))
+ (if (memq word '(the each)) (setq word (pop args)))
(if (memq word '(buffer buffers))
(setq word 'in args (cons '(buffer-list) args)))
(cond
((memq word '(from downfrom upfrom to downto upto
above below by))
- (cl-push word args)
+ (push word args)
(if (memq (car args) '(downto above))
(error "Must specify `from' value for downward loop"))
(let* ((down (or (eq (car args) 'downfrom)
(gensym))))
(and step (numberp step) (<= step 0)
(error "Loop `by' value is not positive: %s" step))
- (cl-push (list var (or start 0)) loop-for-bindings)
- (if end-var (cl-push (list end-var end) loop-for-bindings))
- (if step-var (cl-push (list step-var step)
+ (push (list var (or start 0)) loop-for-bindings)
+ (if end-var (push (list end-var end) loop-for-bindings))
+ (if step-var (push (list step-var step)
loop-for-bindings))
(if end
- (cl-push (list
+ (push (list
(if down (if excl '> '>=) (if excl '< '<=))
var (or end-var end)) loop-body))
- (cl-push (list var (list (if down '- '+) var
+ (push (list var (list (if down '- '+) var
(or step-var step 1)))
loop-for-steps)))
((memq word '(in in-ref on))
(let* ((on (eq word 'on))
(temp (if (and on (symbolp var)) var (gensym))))
- (cl-push (list temp (cl-pop args)) loop-for-bindings)
- (cl-push (list 'consp temp) loop-body)
+ (push (list temp (pop args)) loop-for-bindings)
+ (push (list 'consp temp) loop-body)
(if (eq word 'in-ref)
- (cl-push (list var (list 'car temp)) loop-symbol-macs)
+ (push (list var (list 'car temp)) loop-symbol-macs)
(or (eq temp var)
(progn
- (cl-push (list var nil) loop-for-bindings)
- (cl-push (list var (if on temp (list 'car temp)))
+ (push (list var nil) loop-for-bindings)
+ (push (list var (if on temp (list 'car temp)))
loop-for-sets))))
- (cl-push (list temp
+ (push (list temp
(if (eq (car args) 'by)
(let ((step (cl-pop2 args)))
(if (and (memq (car-safe step)
loop-for-steps)))
((eq word '=)
- (let* ((start (cl-pop args))
+ (let* ((start (pop args))
(then (if (eq (car args) 'then) (cl-pop2 args) start)))
- (cl-push (list var nil) loop-for-bindings)
+ (push (list var nil) loop-for-bindings)
(if (or ands (eq (car args) 'and))
(progn
- (cl-push (list var
+ (push (list var
(list 'if
(or loop-first-flag
(setq loop-first-flag
(gensym)))
start var))
loop-for-sets)
- (cl-push (list var then) loop-for-steps))
- (cl-push (list var
+ (push (list var then) loop-for-steps))
+ (push (list var
(if (eq start then) start
(list 'if
(or loop-first-flag
((memq word '(across across-ref))
(let ((temp-vec (gensym)) (temp-idx (gensym)))
- (cl-push (list temp-vec (cl-pop args)) loop-for-bindings)
- (cl-push (list temp-idx -1) loop-for-bindings)
- (cl-push (list '< (list 'setq temp-idx (list '1+ temp-idx))
+ (push (list temp-vec (pop args)) loop-for-bindings)
+ (push (list temp-idx -1) loop-for-bindings)
+ (push (list '< (list 'setq temp-idx (list '1+ temp-idx))
(list 'length temp-vec)) loop-body)
(if (eq word 'across-ref)
- (cl-push (list var (list 'aref temp-vec temp-idx))
+ (push (list var (list 'aref temp-vec temp-idx))
loop-symbol-macs)
- (cl-push (list var nil) loop-for-bindings)
- (cl-push (list var (list 'aref temp-vec temp-idx))
+ (push (list var nil) loop-for-bindings)
+ (push (list var (list 'aref temp-vec temp-idx))
loop-for-sets))))
((memq word '(element elements))
(cadr (cl-pop2 args))
(error "Bad `using' clause"))
(gensym))))
- (cl-push (list temp-seq seq) loop-for-bindings)
- (cl-push (list temp-idx 0) loop-for-bindings)
+ (push (list temp-seq seq) loop-for-bindings)
+ (push (list temp-idx 0) loop-for-bindings)
(if ref
(let ((temp-len (gensym)))
- (cl-push (list temp-len (list 'length temp-seq))
+ (push (list temp-len (list 'length temp-seq))
loop-for-bindings)
- (cl-push (list var (list 'elt temp-seq temp-idx))
+ (push (list var (list 'elt temp-seq temp-idx))
loop-symbol-macs)
- (cl-push (list '< temp-idx temp-len) loop-body))
- (cl-push (list var nil) loop-for-bindings)
- (cl-push (list 'and temp-seq
+ (push (list '< temp-idx temp-len) loop-body))
+ (push (list var nil) loop-for-bindings)
+ (push (list 'and temp-seq
(list 'or (list 'consp temp-seq)
(list '< temp-idx
(list 'length temp-seq))))
loop-body)
- (cl-push (list var (list 'if (list 'consp temp-seq)
+ (push (list var (list 'if (list 'consp temp-seq)
(list 'pop temp-seq)
(list 'aref temp-seq temp-idx)))
loop-for-sets))
- (cl-push (list temp-idx (list '1+ temp-idx))
+ (push (list temp-idx (list '1+ temp-idx))
loop-for-steps)))
((memq word hash-types)
(t (setq buf (cl-pop2 args)))))
(if (and (consp var) (symbolp (car var)) (symbolp (cdr var)))
(setq var1 (car var) var2 (cdr var))
- (cl-push (list var (list 'cons var1 var2)) loop-for-sets))
+ (push (list var (list 'cons var1 var2)) loop-for-sets))
(setq loop-map-form
(list 'cl-map-intervals
(list 'function (list 'lambda (list var1 var2)
(setq var (prog1 other (setq other var))))
(setq loop-map-form
(list (if (memq word '(key-seq key-seqs))
- 'cl-map-keymap-recursively 'cl-map-keymap)
+ 'cl-map-keymap-recursively 'map-keymap)
(list 'function (list* 'lambda (list var other)
'--cl-map)) map))))
((memq word '(frame frames screen screens))
(let ((temp (gensym)))
- (cl-push (list var '(selected-frame))
+ (push (list var '(selected-frame))
loop-for-bindings)
- (cl-push (list temp nil) loop-for-bindings)
- (cl-push (list 'prog1 (list 'not (list 'eq var temp))
+ (push (list temp nil) loop-for-bindings)
+ (push (list 'prog1 (list 'not (list 'eq var temp))
(list 'or temp (list 'setq temp var)))
loop-body)
- (cl-push (list var (list 'next-frame var))
+ (push (list var (list 'next-frame var))
loop-for-steps)))
((memq word '(window windows))
(let ((scr (and (memq (car args) '(in of)) (cl-pop2 args)))
(temp (gensym)))
- (cl-push (list var (if scr
+ (push (list var (if scr
(list 'frame-selected-window scr)
'(selected-window)))
loop-for-bindings)
- (cl-push (list temp nil) loop-for-bindings)
- (cl-push (list 'prog1 (list 'not (list 'eq var temp))
+ (push (list temp nil) loop-for-bindings)
+ (push (list 'prog1 (list 'not (list 'eq var temp))
(list 'or temp (list 'setq temp var)))
loop-body)
- (cl-push (list var (list 'next-window var)) loop-for-steps)))
+ (push (list var (list 'next-window var)) loop-for-steps)))
(t
(let ((handler (and (symbolp word)
(error "Expected a `for' preposition, found %s" word)))))
(eq (car args) 'and))
(setq ands t)
- (cl-pop args))
+ (pop args))
(if (and ands loop-for-bindings)
- (cl-push (nreverse loop-for-bindings) loop-bindings)
+ (push (nreverse loop-for-bindings) loop-bindings)
(setq loop-bindings (nconc (mapcar 'list loop-for-bindings)
loop-bindings)))
(if loop-for-sets
- (cl-push (list 'progn
+ (push (list 'progn
(cl-loop-let (nreverse loop-for-sets) 'setq ands)
t) loop-body))
(if loop-for-steps
- (cl-push (cons (if ands 'psetq 'setq)
+ (push (cons (if ands 'psetq 'setq)
(apply 'append (nreverse loop-for-steps)))
loop-steps))))
((eq word 'repeat)
(let ((temp (gensym)))
- (cl-push (list (list temp (cl-pop args))) loop-bindings)
- (cl-push (list '>= (list 'setq temp (list '1- temp)) 0) loop-body)))
+ (push (list (list temp (pop args))) loop-bindings)
+ (push (list '>= (list 'setq temp (list '1- temp)) 0) loop-body)))
((memq word '(collect collecting))
- (let ((what (cl-pop args))
+ (let ((what (pop args))
(var (cl-loop-handle-accum nil 'nreverse)))
(if (eq var loop-accum-var)
- (cl-push (list 'progn (list 'push what var) t) loop-body)
- (cl-push (list 'progn
+ (push (list 'progn (list 'push what var) t) loop-body)
+ (push (list 'progn
(list 'setq var (list 'nconc var (list 'list what)))
t) loop-body))))
((memq word '(nconc nconcing append appending))
- (let ((what (cl-pop args))
+ (let ((what (pop args))
(var (cl-loop-handle-accum nil 'nreverse)))
- (cl-push (list 'progn
+ (push (list 'progn
(list 'setq var
(if (eq var loop-accum-var)
(list 'nconc
var what))) t) loop-body)))
((memq word '(concat concating))
- (let ((what (cl-pop args))
+ (let ((what (pop args))
(var (cl-loop-handle-accum "")))
- (cl-push (list 'progn (list 'callf 'concat var what) t) loop-body)))
+ (push (list 'progn (list 'callf 'concat var what) t) loop-body)))
((memq word '(vconcat vconcating))
- (let ((what (cl-pop args))
+ (let ((what (pop args))
(var (cl-loop-handle-accum [])))
- (cl-push (list 'progn (list 'callf 'vconcat var what) t) loop-body)))
+ (push (list 'progn (list 'callf 'vconcat var what) t) loop-body)))
((memq word '(sum summing))
- (let ((what (cl-pop args))
+ (let ((what (pop args))
(var (cl-loop-handle-accum 0)))
- (cl-push (list 'progn (list 'incf var what) t) loop-body)))
+ (push (list 'progn (list 'incf var what) t) loop-body)))
((memq word '(count counting))
- (let ((what (cl-pop args))
+ (let ((what (pop args))
(var (cl-loop-handle-accum 0)))
- (cl-push (list 'progn (list 'if what (list 'incf var)) t) loop-body)))
+ (push (list 'progn (list 'if what (list 'incf var)) t) loop-body)))
((memq word '(minimize minimizing maximize maximizing))
- (let* ((what (cl-pop args))
+ (let* ((what (pop args))
(temp (if (cl-simple-expr-p what) what (gensym)))
(var (cl-loop-handle-accum nil))
(func (intern (substring (symbol-name word) 0 3)))
(set (list 'setq var (list 'if var (list func var temp) temp))))
- (cl-push (list 'progn (if (eq temp what) set
+ (push (list 'progn (if (eq temp what) set
(list 'let (list (list temp what)) set))
t) loop-body)))
((eq word 'with)
(let ((bindings nil))
- (while (progn (cl-push (list (cl-pop args)
+ (while (progn (push (list (pop args)
(and (eq (car args) '=) (cl-pop2 args)))
bindings)
(eq (car args) 'and))
- (cl-pop args))
- (cl-push (nreverse bindings) loop-bindings)))
+ (pop args))
+ (push (nreverse bindings) loop-bindings)))
((eq word 'while)
- (cl-push (cl-pop args) loop-body))
+ (push (pop args) loop-body))
((eq word 'until)
- (cl-push (list 'not (cl-pop args)) loop-body))
+ (push (list 'not (pop args)) loop-body))
((eq word 'always)
(or loop-finish-flag (setq loop-finish-flag (gensym)))
- (cl-push (list 'setq loop-finish-flag (cl-pop args)) loop-body)
+ (push (list 'setq loop-finish-flag (pop args)) loop-body)
(setq loop-result t))
((eq word 'never)
(or loop-finish-flag (setq loop-finish-flag (gensym)))
- (cl-push (list 'setq loop-finish-flag (list 'not (cl-pop args)))
+ (push (list 'setq loop-finish-flag (list 'not (pop args)))
loop-body)
(setq loop-result t))
((eq word 'thereis)
(or loop-finish-flag (setq loop-finish-flag (gensym)))
(or loop-result-var (setq loop-result-var (gensym)))
- (cl-push (list 'setq loop-finish-flag
- (list 'not (list 'setq loop-result-var (cl-pop args))))
+ (push (list 'setq loop-finish-flag
+ (list 'not (list 'setq loop-result-var (pop args))))
loop-body))
((memq word '(if when unless))
- (let* ((cond (cl-pop args))
+ (let* ((cond (pop args))
(then (let ((loop-body nil))
(cl-parse-loop-clause)
(cl-loop-build-ands (nreverse loop-body))))
(else (let ((loop-body nil))
(if (eq (car args) 'else)
- (progn (cl-pop args) (cl-parse-loop-clause)))
+ (progn (pop args) (cl-parse-loop-clause)))
(cl-loop-build-ands (nreverse loop-body))))
(simple (and (eq (car then) t) (eq (car else) t))))
- (if (eq (car args) 'end) (cl-pop args))
+ (if (eq (car args) 'end) (pop args))
(if (eq word 'unless) (setq then (prog1 else (setq else then))))
(let ((form (cons (if simple (cons 'progn (nth 1 then)) (nth 2 then))
(if simple (nth 1 else) (list (nth 2 else))))))
(if (cl-expr-contains form 'it)
(let ((temp (gensym)))
- (cl-push (list temp) loop-bindings)
+ (push (list temp) loop-bindings)
(setq form (list* 'if (list 'setq temp cond)
(subst temp 'it form))))
(setq form (list* 'if cond form)))
- (cl-push (if simple (list 'progn form t) form) loop-body))))
+ (push (if simple (list 'progn form t) form) loop-body))))
((memq word '(do doing))
(let ((body nil))
(or (consp (car args)) (error "Syntax error on `do' clause"))
- (while (consp (car args)) (cl-push (cl-pop args) body))
- (cl-push (cons 'progn (nreverse (cons t body))) loop-body)))
+ (while (consp (car args)) (push (pop args) body))
+ (push (cons 'progn (nreverse (cons t body))) loop-body)))
((eq word 'return)
(or loop-finish-flag (setq loop-finish-flag (gensym)))
(or loop-result-var (setq loop-result-var (gensym)))
- (cl-push (list 'setq loop-result-var (cl-pop args)
+ (push (list 'setq loop-result-var (pop args)
loop-finish-flag nil) loop-body))
(t
(or handler (error "Expected a loop keyword, found %s" word))
(funcall handler))))
(if (eq (car args) 'and)
- (progn (cl-pop args) (cl-parse-loop-clause)))))
+ (progn (pop args) (cl-parse-loop-clause)))))
(defun cl-loop-let (specs body par) ; uses loop-*
(let ((p specs) (temps nil) (new nil))
(while p
(or (cl-const-expr-p (cadar p))
(let ((temp (gensym)))
- (cl-push (list temp (cadar p)) temps)
+ (push (list temp (cadar p)) temps)
(setcar (cdar p) temp)))
(setq p (cdr p)))))
(while specs
(if (and (consp (car specs)) (listp (caar specs)))
(let* ((spec (caar specs)) (nspecs nil)
- (expr (cadr (cl-pop specs)))
+ (expr (cadr (pop specs)))
(temp (cdr (or (assq spec loop-destr-temps)
- (car (cl-push (cons spec (or (last spec 0)
+ (car (push (cons spec (or (last spec 0)
(gensym)))
loop-destr-temps))))))
- (cl-push (list temp expr) new)
+ (push (list temp expr) new)
(while (consp spec)
- (cl-push (list (cl-pop spec)
+ (push (list (pop spec)
(and expr (list (if spec 'pop 'car) temp)))
nspecs))
(setq specs (nconc (nreverse nspecs) specs)))
- (cl-push (cl-pop specs) new)))
+ (push (pop specs) new)))
(if (eq body 'setq)
(let ((set (cons (if par 'psetq 'setq) (apply 'nconc (nreverse new)))))
(if temps (list 'let* (nreverse temps) set) set))
(if (eq (car args) 'into)
(let ((var (cl-pop2 args)))
(or (memq var loop-accum-vars)
- (progn (cl-push (list (list var def)) loop-bindings)
- (cl-push var loop-accum-vars)))
+ (progn (push (list (list var def)) loop-bindings)
+ (push var loop-accum-vars)))
var)
(or loop-accum-var
(progn
- (cl-push (list (list (setq loop-accum-var (gensym)) def))
+ (push (list (list (setq loop-accum-var (gensym)) def))
loop-bindings)
(setq loop-result (if func (list func loop-accum-var)
loop-accum-var))
(cdadr clauses)
(list (cadr clauses))))
(cddr clauses)))
- (setq body (cdr (butlast (cl-pop clauses)))))
- (cl-push (cl-pop clauses) ands)))
+ (setq body (cdr (butlast (pop clauses)))))
+ (push (pop clauses) ands)))
(setq ands (or (nreverse ands) (list t)))
(list (if (cdr ands) (cons 'and ands) (car ands))
body
(or (cdr endtest) '(nil)))))
(defmacro dolist (spec &rest body)
- "(dolist (VAR LIST [RESULT]) BODY...): loop over a list.
+ "Loop over a list.
Evaluate BODY with VAR bound to each `car' from LIST, in turn.
-Then evaluate RESULT to get return value, default nil."
+Then evaluate RESULT to get return value, default nil.
+
+\(fn (VAR LIST [RESULT]) BODY...)"
(let ((temp (gensym "--dolist-temp--")))
(list 'block nil
(list* 'let (list (list temp (nth 1 spec)) (car spec))
'(nil))))))
(defmacro dotimes (spec &rest body)
- "(dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times.
+ "Loop a certain number of times.
Evaluate BODY with VAR bound to successive integers from 0, inclusive,
to COUNT, exclusive. Then evaluate RESULT to get return value, default
-nil."
+nil.
+
+\(fn (VAR COUNT [RESULT]) BODY...)"
(let ((temp (gensym "--dotimes-temp--")))
(list 'block nil
(list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0))
(or (cdr (cdr spec)) '(nil))))))
(defmacro do-symbols (spec &rest body)
- "(dosymbols (VAR [OBARRAY [RESULT]]) BODY...): loop over all symbols.
+ "Loop over all symbols.
Evaluate BODY with VAR bound to each interned symbol, or to each symbol
-from OBARRAY."
+from OBARRAY.
+
+\(fn (VAR [OBARRAY [RESULT]]) BODY...)"
;; Apparently this doesn't have an implicit block.
(list 'block nil
(list 'let (list (car spec))
;;; Assignments.
(defmacro psetq (&rest args)
- "(psetq SYM VAL SYM VAL ...): set SYMs to the values VALs in parallel.
+ "Set SYMs to the values VALs in parallel.
This is like `setq', except that all VAL forms are evaluated (in order)
-before assigning any symbols SYM to the corresponding values."
+before assigning any symbols SYM to the corresponding values.
+
+\(fn SYM VAL SYM VAL ...)"
(cons 'psetf args))
;;; This should really have some way to shadow 'byte-compile properties, etc.
(defmacro flet (bindings &rest body)
- "(flet ((FUNC ARGLIST BODY...) ...) FORM...): make temporary function defns.
+ "Make temporary function defns.
This is an analogue of `let' that operates on the function cell of FUNC
rather than its value cell. The FORMs are evaluated with the specified
function definitions in place, then the definitions are undone (the FUNCs
-go back to their previous definitions, or lack thereof)."
+go back to their previous definitions, or lack thereof).
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(list* 'letf*
(mapcar
(function
(list* 'block (car x) (cddr x))))))
(if (and (cl-compiling-file)
(boundp 'byte-compile-function-environment))
- (cl-push (cons (car x) (eval func))
+ (push (cons (car x) (eval func))
byte-compile-function-environment))
(list (list 'symbol-function (list 'quote (car x))) func))))
bindings)
body))
(defmacro labels (bindings &rest body)
- "(labels ((FUNC ARGLIST BODY...) ...) FORM...): make temporary func bindings.
+ "Make temporary func bindings.
This is like `flet', except the bindings are lexical instead of dynamic.
-Unlike `flet', this macro is fully complaint with the Common Lisp standard."
+Unlike `flet', this macro is fully compliant with the Common Lisp standard.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(let ((vars nil) (sets nil) (cl-macro-environment cl-macro-environment))
(while bindings
(let ((var (gensym)))
- (cl-push var vars)
- (cl-push (list 'function* (cons 'lambda (cdar bindings))) sets)
- (cl-push var sets)
- (cl-push (list (car (cl-pop bindings)) 'lambda '(&rest cl-labels-args)
+ (push var vars)
+ (push (list 'function* (cons 'lambda (cdar bindings))) sets)
+ (push var sets)
+ (push (list (car (pop bindings)) 'lambda '(&rest cl-labels-args)
(list 'list* '(quote funcall) (list 'quote var)
'cl-labels-args))
cl-macro-environment)))
;; The following ought to have a better definition for use with newer
;; byte compilers.
(defmacro macrolet (bindings &rest body)
- "(macrolet ((NAME ARGLIST BODY...) ...) FORM...): make temporary macro defns.
-This is like `flet', but for macros instead of functions."
+ "Make temporary macro defns.
+This is like `flet', but for macros instead of functions.
+
+\(fn ((NAME ARGLIST BODY...) ...) FORM...)"
(if (cdr bindings)
(list 'macrolet
(list (car bindings)) (list* 'macrolet (cdr bindings) body))
cl-macro-environment))))))
(defmacro symbol-macrolet (bindings &rest body)
- "(symbol-macrolet ((NAME EXPANSION) ...) FORM...): make symbol macro defns.
+ "Make symbol macro defns.
Within the body FORMs, references to the variable NAME will be replaced
-by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)."
+by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
+
+\(fn ((NAME EXPANSION) ...) FORM...)"
(if (cdr bindings)
(list 'symbol-macrolet
(list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body))
(vars (mapcar (function
(lambda (x)
(or (consp x) (setq x (list x)))
- (cl-push (gensym (format "--%s--" (car x)))
+ (push (gensym (format "--%s--" (car x)))
cl-closure-vars)
(set (car cl-closure-vars) [bad-lexical-ref])
(list (car x) (cadr x) (car cl-closure-vars))))
bindings))
- (ebody
+ (ebody
(cl-macroexpand-all
(cons 'progn body)
(nconc (mapcar (function (lambda (x)
(if (null bindings) (cons 'progn body)
(setq bindings (reverse bindings))
(while bindings
- (setq body (list (list* 'lexical-let (list (cl-pop bindings)) body))))
+ (setq body (list (list* 'lexical-let (list (pop bindings)) body))))
(car body)))
(defun cl-defun-expander (func &rest rest)
;;; Multiple values.
(defmacro multiple-value-bind (vars form &rest body)
- "(multiple-value-bind (SYM SYM...) FORM BODY): collect multiple return values.
+ "Collect multiple return values.
FORM must return a list; the BODY is then executed with the first N elements
of this list bound (`let'-style) to each of the symbols SYM in turn. This
is analogous to the Common Lisp `multiple-value-bind' macro, using lists to
simulate true multiple return values. For compatibility, (values A B C) is
-a synonym for (list A B C)."
+a synonym for (list A B C).
+
+\(fn (SYM SYM...) FORM BODY)"
(let ((temp (gensym)) (n -1))
(list* 'let* (cons (list temp form)
(mapcar (function
body)))
(defmacro multiple-value-setq (vars form)
- "(multiple-value-setq (SYM SYM...) FORM): collect multiple return values.
+ "Collect multiple return values.
FORM must return a list; the first N elements of this list are stored in
each of the symbols SYM in turn. This is analogous to the Common Lisp
`multiple-value-setq' macro, using lists to simulate true multiple return
-values. For compatibility, (values A B C) is a synonym for (list A B C)."
+values. For compatibility, (values A B C) is a synonym for (list A B C).
+
+\(fn (SYM SYM...) FORM)"
(cond ((null vars) (list 'progn form nil))
((null (cdr vars)) (list 'setq (car vars) (list 'car form)))
(t
(let* ((temp (gensym)) (n 0))
(list 'let (list (list temp form))
- (list 'prog1 (list 'setq (cl-pop vars) (list 'car temp))
+ (list 'prog1 (list 'setq (pop vars) (list 'car temp))
(cons 'setq (apply 'nconc
(mapcar (function
(lambda (v)
(defvar cl-declare-stack t) ; for future compilers
(defun cl-do-proclaim (spec hist)
- (and hist (listp cl-proclaim-history) (cl-push spec cl-proclaim-history))
+ (and hist (listp cl-proclaim-history) (push spec cl-proclaim-history))
(cond ((eq (car-safe spec) 'special)
(if (boundp 'byte-compile-bound-variables)
(setq byte-compile-bound-variables
;;; Process any proclamations made before cl-macs was loaded.
(defvar cl-proclaims-deferred)
(let ((p (reverse cl-proclaims-deferred)))
- (while p (cl-do-proclaim (cl-pop p) t))
+ (while p (cl-do-proclaim (pop p) t))
(setq cl-proclaims-deferred nil))
(defmacro declare (&rest specs)
(if (cl-compiling-file)
(while specs
- (if (listp cl-declare-stack) (cl-push (car specs) cl-declare-stack))
- (cl-do-proclaim (cl-pop specs) nil)))
+ (if (listp cl-declare-stack) (push (car specs) cl-declare-stack))
+ (cl-do-proclaim (pop specs) nil)))
nil)
;;; Generalized variables.
(defmacro define-setf-method (func args &rest body)
- "(define-setf-method NAME ARGLIST BODY...): define a `setf' method.
+ "Define a `setf' method.
This method shows how to handle `setf's to places of the form (NAME ARGS...).
The argument forms ARGS are bound according to ARGLIST, as if NAME were
going to be expanded as a macro, then the BODY forms are executed and must
return a list of five elements: a temporary-variables list, a value-forms
list, a store-variables list (of length one), a store-form, and an access-
-form. See `defsetf' for a simpler way to define most setf-methods."
+form. See `defsetf' for a simpler way to define most setf-methods.
+
+\(fn NAME ARGLIST BODY...)"
(append '(eval-when (compile load eval))
(if (stringp (car body))
(list (list 'put (list 'quote func) '(quote setf-documentation)
- (cl-pop body))))
+ (pop body))))
(list (cl-transform-function-property
func 'setf-method (cons args body)))))
(defalias 'define-setf-expander 'define-setf-method)
(list 'aset seq n store)))
(defsetf get put)
(defsetf get* (x y &optional d) (store) (list 'put x y store))
-(defsetf gethash (x h &optional d) (store) (list 'cl-puthash x store h))
+(defsetf gethash (x h &optional d) (store) (list 'puthash x store h))
(defsetf nth (n x) (store) (list 'setcar (list 'nthcdr n x) store))
(defsetf subseq (seq start &optional end) (new)
(list 'progn (list 'replace seq new :start1 start :end1 end) new))
(defsetf process-buffer set-process-buffer)
(defsetf process-filter set-process-filter)
(defsetf process-sentinel set-process-sentinel)
+(defsetf process-get process-put)
(defsetf read-mouse-position (scr) (store)
(list 'set-mouse-position scr (list 'car store) (list 'cdr store)))
(defsetf screen-height set-screen-height t)
(simple (and optimize (consp place) (cl-simple-exprs-p (cdr place)))))
(while values
(if (or simple (cl-const-expr-p (car values)))
- (cl-push (cons (cl-pop temps) (cl-pop values)) subs)
- (cl-push (list (cl-pop temps) (cl-pop values)) lets)))
+ (push (cons (pop temps) (pop values)) subs)
+ (push (list (pop temps) (pop values)) lets)))
(list (nreverse lets)
(cons (car (nth 2 method)) (sublis subs (nth 3 method)))
(sublis subs (nth 4 method)))))
;;; The standard modify macros.
(defmacro setf (&rest args)
- "(setf PLACE VAL PLACE VAL ...): set each PLACE to the value of its VAL.
+ "Set each PLACE to the value of its VAL.
This is a generalized version of `setq'; the PLACEs may be symbolic
references such as (car x) or (aref x i), as well as plain symbols.
For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y).
-The return value is the last VAL in the list."
+The return value is the last VAL in the list.
+
+\(fn PLACE VAL PLACE VAL ...)"
(if (cdr (cdr args))
(let ((sets nil))
- (while args (cl-push (list 'setf (cl-pop args) (cl-pop args)) sets))
+ (while args (push (list 'setf (pop args) (pop args)) sets))
(cons 'progn (nreverse sets)))
(if (symbolp (car args))
(and args (cons 'setq args))
(if (car method) (list 'let* (car method) store) store)))))
(defmacro psetf (&rest args)
- "(psetf PLACE VAL PLACE VAL ...): set PLACEs to the values VALs in parallel.
+ "Set PLACEs to the values VALs in parallel.
This is like `setf', except that all VAL forms are evaluated (in order)
-before assigning any PLACEs to the corresponding values."
+before assigning any PLACEs to the corresponding values.
+
+\(fn PLACE VAL PLACE VAL ...)"
(let ((p args) (simple t) (vars nil))
(while p
(if (or (not (symbolp (car p))) (cl-expr-depends-p (nth 1 p) vars))
(setq simple nil))
(if (memq (car p) vars)
(error "Destination duplicated in psetf: %s" (car p)))
- (cl-push (cl-pop p) vars)
+ (push (pop p) vars)
(or p (error "Odd number of arguments to psetf"))
- (cl-pop p))
+ (pop p))
(if simple
(list 'progn (cons 'setf args) nil)
(setq args (reverse args))
(list 'cl-do-remf tval ttag)))))
(defmacro shiftf (place &rest args)
- "(shiftf PLACE PLACE... VAL): shift left among PLACEs.
+ "Shift left among PLACEs.
Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
-Each PLACE may be a symbol, or any generalized variable allowed by `setf'."
+Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
+
+\(fn PLACE PLACE... VAL)"
(cond
((null args) place)
((symbolp place) `(prog1 ,place (setq ,place (shiftf ,@args))))
,(cl-setf-do-store (nth 1 method) `(shiftf ,@args))))))))
(defmacro rotatef (&rest args)
- "(rotatef PLACE...): rotate left among PLACEs.
+ "Rotate left among PLACEs.
Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil.
-Each PLACE may be a symbol, or any generalized variable allowed by `setf'."
+Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
+
+\(fn PLACE...)"
(if (not (memq nil (mapcar 'symbolp args)))
(and (cdr args)
(let ((sets nil)
(first (car args)))
(while (cdr args)
- (setq sets (nconc sets (list (cl-pop args) (car args)))))
+ (setq sets (nconc sets (list (pop args) (car args)))))
(nconc (list 'psetf) sets (list (car args) first))))
(let* ((places (reverse args))
(temp (gensym "--rotatef--"))
(form temp))
(while (cdr places)
- (let ((method (cl-setf-do-modify (cl-pop places) 'unsafe)))
+ (let ((method (cl-setf-do-modify (pop places) 'unsafe)))
(setq form (list 'let* (car method)
(list 'prog1 (nth 2 method)
(cl-setf-do-store (nth 1 method) form))))))
(cl-setf-do-store (nth 1 method) form) nil)))))
(defmacro letf (bindings &rest body)
- "(letf ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs.
+ "Temporarily bind to PLACEs.
This is the analogue of `let', but with generalized variables (in the
sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
VALUE, then the BODY forms are executed. On exit, either normally or
because of a `throw' or error, the PLACEs are set back to their original
values. Note that this macro is *not* available in Common Lisp.
As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
-the PLACE is not modified before executing BODY."
+the PLACE is not modified before executing BODY.
+
+\(fn ((PLACE VALUE) ...) BODY...)"
(if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings)))
(list* 'let bindings body)
(let ((lets nil) (sets nil)
(list* 'let* lets body))))
(defmacro letf* (bindings &rest body)
- "(letf* ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs.
+ "Temporarily bind to PLACEs.
This is the analogue of `let*', but with generalized variables (in the
sense of `setf') for the PLACEs. Each PLACE is set to the corresponding
VALUE, then the BODY forms are executed. On exit, either normally or
because of a `throw' or error, the PLACEs are set back to their original
values. Note that this macro is *not* available in Common Lisp.
As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
-the PLACE is not modified before executing BODY."
+the PLACE is not modified before executing BODY.
+
+\(fn ((PLACE VALUE) ...) BODY...)"
(if (null bindings)
(cons 'progn body)
(setq bindings (reverse bindings))
(while bindings
- (setq body (list (list* 'letf (list (cl-pop bindings)) body))))
+ (setq body (list (list* 'letf (list (pop bindings)) body))))
(car body)))
(defmacro callf (func place &rest args)
- "(callf FUNC PLACE ARGS...): set PLACE to (FUNC PLACE ARGS...).
+ "Set PLACE to (FUNC PLACE ARGS...).
FUNC should be an unquoted function name. PLACE may be a symbol,
-or any generalized variable allowed by `setf'."
+or any generalized variable allowed by `setf'.
+
+\(fn FUNC PLACE ARGS...)"
(let* ((method (cl-setf-do-modify place (cons 'list args)))
(rargs (cons (nth 2 method) args)))
(list 'let* (car method)
rargs))))))
(defmacro callf2 (func arg1 place &rest args)
- "(callf2 FUNC ARG1 PLACE ARGS...): set PLACE to (FUNC ARG1 PLACE ARGS...).
-Like `callf', but PLACE is the second argument of FUNC, not the first."
+ "Set PLACE to (FUNC ARG1 PLACE ARGS...).
+Like `callf', but PLACE is the second argument of FUNC, not the first.
+
+\(fn FUNC ARG1 PLACE ARGS...)"
(if (and (cl-safe-expr-p arg1) (cl-simple-expr-p place) (symbolp func))
(list 'setf place (list* func arg1 place args))
(let* ((method (cl-setf-do-modify place (cons 'list args)))
;;; Structures.
(defmacro defstruct (struct &rest descs)
- "(defstruct (NAME OPTIONS...) (SLOT SLOT-OPTS...)...): define a struct type.
+ "Define a struct type.
This macro defines a new Lisp data type called NAME, which contains data
stored in SLOTs. This defines a `make-NAME' constructor, a `copy-NAME'
-copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors."
+copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors.
+
+\(fn (NAME OPTIONS...) (SLOT SLOT-OPTS...)...)"
(let* ((name (if (consp struct) (car struct) struct))
(opts (cdr-safe struct))
(slots nil)
(forms nil)
pred-form pred-check)
(if (stringp (car descs))
- (cl-push (list 'put (list 'quote name) '(quote structure-documentation)
- (cl-pop descs)) forms))
+ (push (list 'put (list 'quote name) '(quote structure-documentation)
+ (pop descs)) forms))
(setq descs (cons '(cl-tag-slot)
(mapcar (function (lambda (x) (if (consp x) x (list x))))
descs)))
(while opts
(let ((opt (if (consp (car opts)) (caar opts) (car opts)))
- (args (cdr-safe (cl-pop opts))))
+ (args (cdr-safe (pop opts))))
(cond ((eq opt :conc-name)
(if args
(setq conc-name (if (car args)
(symbol-name (car args)) ""))))
((eq opt :constructor)
(if (cdr args)
- (cl-push args constrs)
+ (push args constrs)
(if args (setq constructor (car args)))))
((eq opt :copier)
(if args (setq copier (car args))))
(error "No slot %s in included struct %s"
(caar include-descs) include))
old-descs)
- (cl-pop include-descs)))
+ (pop include-descs)))
(setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs))
type (car inc-type)
named (assq 'cl-tag-slot descs))
(if (cadr inc-type) (setq tag name named t))
(let ((incl include))
(while incl
- (cl-push (list 'pushnew (list 'quote tag)
+ (push (list 'pushnew (list 'quote tag)
(intern (format "cl-struct-%s-tags" incl)))
forms)
(setq incl (get incl 'cl-struct-include)))))
(if named (setq tag name)))
(setq type 'vector named 'true)))
(or named (setq descs (delq (assq 'cl-tag-slot descs) descs)))
- (cl-push (list 'defvar tag-symbol) forms)
+ (push (list 'defvar tag-symbol) forms)
(setq pred-form (and named
(let ((pos (- (length descs)
(length (memq (assq 'cl-tag-slot descs)
(cons 'and (cdddr pred-form)) pred-form)))
(let ((pos 0) (descp descs))
(while descp
- (let* ((desc (cl-pop descp))
+ (let* ((desc (pop descp))
(slot (car desc)))
(if (memq slot '(cl-tag-slot cl-skip-slot))
(progn
- (cl-push nil slots)
- (cl-push (and (eq slot 'cl-tag-slot) (list 'quote tag))
+ (push nil slots)
+ (push (and (eq slot 'cl-tag-slot) (list 'quote tag))
defaults))
(if (assq slot descp)
(error "Duplicate slots named %s in %s" slot name))
(let ((accessor (intern (format "%s%s" conc-name slot))))
- (cl-push slot slots)
- (cl-push (nth 1 desc) defaults)
- (cl-push (list*
+ (push slot slots)
+ (push (nth 1 desc) defaults)
+ (push (list*
'defsubst* accessor '(cl-x)
(append
(and pred-check
(list (if (eq type 'vector) (list 'aref 'cl-x pos)
(if (= pos 0) '(car cl-x)
(list 'nth pos 'cl-x)))))) forms)
- (cl-push (cons accessor t) side-eff)
- (cl-push (list 'define-setf-method accessor '(cl-x)
+ (push (cons accessor t) side-eff)
+ (push (list 'define-setf-method accessor '(cl-x)
(if (cadr (memq :read-only (cddr desc)))
(list 'error (format "%s is a read-only slot"
accessor))
(setq slots (nreverse slots)
defaults (nreverse defaults))
(and predicate pred-form
- (progn (cl-push (list 'defsubst* predicate '(cl-x)
+ (progn (push (list 'defsubst* predicate '(cl-x)
(if (eq (car pred-form) 'and)
(append pred-form '(t))
(list 'and pred-form t))) forms)
- (cl-push (cons predicate 'error-free) side-eff)))
+ (push (cons predicate 'error-free) side-eff)))
(and copier
- (progn (cl-push (list 'defun copier '(x) '(copy-sequence x)) forms)
- (cl-push (cons copier t) side-eff)))
+ (progn (push (list 'defun copier '(x) '(copy-sequence x)) forms)
+ (push (cons copier t) side-eff)))
(if constructor
- (cl-push (list constructor
+ (push (list constructor
(cons '&key (delq nil (copy-sequence slots))))
constrs))
(while constrs
(let* ((name (caar constrs))
- (args (cadr (cl-pop constrs)))
+ (args (cadr (pop constrs)))
(anames (cl-arglist-args args))
(make (mapcar* (function (lambda (s d) (if (memq s anames) s d)))
slots defaults)))
- (cl-push (list 'defsubst* name
+ (push (list 'defsubst* name
(list* '&cl-defs (list 'quote (cons nil descs)) args)
(cons type make)) forms)
(if (cl-safe-expr-p (cons 'progn (mapcar 'second descs)))
- (cl-push (cons name t) side-eff))))
+ (push (cons name t) side-eff))))
(if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
(if print-func
- (cl-push (list 'push
+ (push (list 'push
(list 'function
(list 'lambda '(cl-x cl-s cl-n)
(list 'and pred-form print-func)))
'custom-print-functions) forms))
- (cl-push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms)
- (cl-push (list* 'eval-when '(compile load eval)
+ (push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms)
+ (push (list* 'eval-when '(compile load eval)
(list 'put (list 'quote name) '(quote cl-struct-slots)
(list 'quote descs))
(list 'put (list 'quote name) '(quote cl-struct-type)
((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"))))
`(condition-case nil (progn ,@body) (error nil)))
-;;; Some predicates for analyzing Lisp forms. These are used by various
-;;; macro expanders to optimize the results in certain common cases.
-
-(defconst cl-simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max
- car-safe cdr-safe progn prog1 prog2))
-(defconst cl-safe-funcs '(* / % length memq list vector vectorp
- < > <= >= = error))
-
-;;; Check if no side effects, and executes quickly.
-(defun cl-simple-expr-p (x &optional size)
- (or size (setq size 10))
- (if (and (consp x) (not (memq (car x) '(quote function function*))))
- (and (symbolp (car x))
- (or (memq (car x) cl-simple-funcs)
- (get (car x) 'side-effect-free))
- (progn
- (setq size (1- size))
- (while (and (setq x (cdr x))
- (setq size (cl-simple-expr-p (car x) size))))
- (and (null x) (>= size 0) size)))
- (and (> size 0) (1- size))))
-
-(defun cl-simple-exprs-p (xs)
- (while (and xs (cl-simple-expr-p (car xs)))
- (setq xs (cdr xs)))
- (not xs))
-
-;;; Check if no side effects.
-(defun cl-safe-expr-p (x)
- (or (not (and (consp x) (not (memq (car x) '(quote function function*)))))
- (and (symbolp (car x))
- (or (memq (car x) cl-simple-funcs)
- (memq (car x) cl-safe-funcs)
- (get (car x) 'side-effect-free))
- (progn
- (while (and (setq x (cdr x)) (cl-safe-expr-p (car x))))
- (null x)))))
-
-;;; Check if constant (i.e., no side effects or dependencies).
-(defun cl-const-expr-p (x)
- (cond ((consp x)
- (or (eq (car x) 'quote)
- (and (memq (car x) '(function function*))
- (or (symbolp (nth 1 x))
- (and (eq (car-safe (nth 1 x)) 'lambda) 'func)))))
- ((symbolp x) (and (memq x '(nil t)) t))
- (t t)))
-
-(defun cl-const-exprs-p (xs)
- (while (and xs (cl-const-expr-p (car xs)))
- (setq xs (cdr xs)))
- (not xs))
-
-(defun cl-const-expr-val (x)
- (and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x)))
-
-(defun cl-expr-access-order (x v)
- (if (cl-const-expr-p x) v
- (if (consp x)
- (progn
- (while (setq x (cdr x)) (setq v (cl-expr-access-order (car x) v)))
- v)
- (if (eq x (car v)) (cdr v) '(t)))))
-
-;;; Count number of times X refers to Y. Return nil for 0 times.
-(defun cl-expr-contains (x y)
- (cond ((equal y x) 1)
- ((and (consp x) (not (memq (car-safe x) '(quote function function*))))
- (let ((sum 0))
- (while x
- (setq sum (+ sum (or (cl-expr-contains (cl-pop x) y) 0))))
- (and (> sum 0) sum)))
- (t nil)))
-
-(defun cl-expr-contains-any (x y)
- (while (and y (not (cl-expr-contains x (car y)))) (cl-pop y))
- y)
-
-;;; Check whether X may depend on any of the symbols in Y.
-(defun cl-expr-depends-p (x y)
- (and (not (cl-const-expr-p x))
- (or (not (cl-safe-expr-p x)) (cl-expr-contains-any x y))))
-
-
;;; Compiler macros.
(defmacro define-compiler-macro (func args &rest body)
original function call alone by declaring an initial `&whole foo' parameter
and then returning foo."
(let ((p args) (res nil))
- (while (consp p) (cl-push (cl-pop p) res))
+ (while (consp p) (push (pop p) res))
(setq args (nconc (nreverse res) (and p (list '&rest p)))))
(list 'eval-when '(compile load eval)
(cl-transform-function-property
(byte-compile-form form)))
(defmacro defsubst* (name args &rest body)
- "(defsubst* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.
+ "Define NAME as a function.
Like `defun', except the function is automatically declared `inline',
ARGLIST allows full Common Lisp conventions, and BODY is implicitly
-surrounded by (block NAME ...)."
+surrounded by (block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)"
(let* ((argns (cl-arglist-args args)) (p argns)
(pbody (cons 'progn body))
(unsafe (not (cl-safe-expr-p pbody))))
- (while (and p (eq (cl-expr-contains args (car p)) 1)) (cl-pop p))
+ (while (and p (eq (cl-expr-contains args (car p)) 1)) (pop p))
(list 'progn
(if p nil ; give up if defaults refer to earlier args
(list 'define-compiler-macro name
- (list* '&whole 'cl-whole '&cl-quote args)
+ (if (memq '&key args)
+ (list* '&whole 'cl-whole '&cl-quote args)
+ (cons '&cl-quote args))
(list* 'cl-defsubst-expand (list 'quote argns)
(list 'quote (list* 'block name body))
(not (or unsafe (cl-expr-access-order pbody argns)))
(run-hooks 'cl-macs-load-hook)
+;;; Local variables:
+;;; byte-compile-warnings: (redefine callargs free-vars unresolved obsolete noruntime)
+;;; End:
+
;;; cl-macs.el ends here
;;; copyright.el --- update the copyright notice in current buffer
-;; Copyright (C) 1991, 92, 93, 94, 95, 98, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 92, 93, 94, 95, 1998, 2001, 2003
+;; Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Keywords: maint, tools
;;; Commentary:
;; Allows updating the copyright year and above mentioned GPL version manually
-;; or when saving a file. Do (add-hook 'write-file-hooks 'copyright-update).
+;; or when saving a file.
+;; Do (add-hook 'write-file-functions 'copyright-update).
;;; Code:
:type '(choice (integer :tag "Limit")
(const :tag "No limit")))
--;; Would it be cleaner to specify Latin-1 coding for this file,
--;; and not use both unibyte and multibyte copyright symbol characters?
--
- ;; The character classes include the unibyte (C) sign,
- ;; the Latin-1 version, and the Latin-9 version.
(defcustom copyright-regexp
- "\\([\81©\8e©]\\|@copyright{}\\|[Cc]opyright\\s *:?\\s *\\(?:(C)\\)?\
- \\|[Cc]opyright\\s *:?\\s *[\81©\8e©]\\)\
- "\\(©\\|@copyright{}\\|[Cc]opyright\\s *:?\\s *\\(?:(C)\\)?\
++ "\\(©\|@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."
(defvar copyright-current-year (substring (current-time-string) -4)
"String representing the current year.")
+(defun copyright-update-year (replace noquery)
+ (when (re-search-forward copyright-regexp (+ (point) copyright-limit) t)
+ ;; Note that `current-time-string' isn't locale-sensitive.
+ (setq copyright-current-year (substring (current-time-string) -4))
+ (unless (string= (buffer-substring (- (match-end 2) 2) (match-end 2))
+ (substring copyright-current-year -2))
+ (if (or noquery
+ (y-or-n-p (if replace
+ (concat "Replace copyright year(s) by "
+ copyright-current-year "? ")
+ (concat "Add " copyright-current-year
+ " to copyright? "))))
+ (if replace
+ (replace-match copyright-current-year t t nil 1)
+ (let ((size (save-excursion (skip-chars-backward "0-9"))))
+ (if (and (eq (% (- (string-to-number copyright-current-year)
+ (string-to-number (buffer-substring
+ (+ (point) size)
+ (point))))
+ 100)
+ 1)
+ (or (eq (char-after (+ (point) size -1)) ?-)
+ (eq (char-after (+ (point) size -2)) ?-)))
+ ;; This is a range so just replace the end part.
+ (delete-char size)
+ ;; Detect if this is using the following shorthand:
+ ;; (C) 1993, 94, 95, 1998, 2000, 01, 02, 2003
+ (if (and
+ ;; Check that the last year was 4-chars and same century.
+ (eq size -4)
+ (equal (buffer-substring (- (point) 4) (- (point) 2))
+ (substring copyright-current-year 0 2))
+ ;; Check that there are 2-char years as well.
+ (save-excursion
+ (re-search-backward "[^0-9][0-9][0-9][^0-9]"
+ (line-beginning-position) t))
+ ;; Make sure we don't remove the first century marker.
+ (save-excursion
+ (forward-char size)
+ (re-search-backward
+ (concat (buffer-substring (point) (+ (point) 2))
+ "[0-9][0-9]")
+ (line-beginning-position) t)))
+ ;; Remove the century marker of the last entry.
+ (delete-region (- (point) 4) (- (point) 2)))
+ ;; Insert a comma with the preferred number of spaces.
+ (insert
+ (save-excursion
+ (if (re-search-backward "[0-9]\\( *, *\\)[0-9]"
+ (line-beginning-position) t)
+ (match-string 1)
+ ", ")))
+ ;; If people use the '91 '92 '93 scheme, do that as well.
+ (if (eq (char-after (+ (point) size -3)) ?')
+ (insert ?')))
+ ;; Finally insert the new year.
+ (insert (substring copyright-current-year size))))))))
;;;###autoload
-(defun copyright-update (&optional arg)
+(defun copyright-update (&optional arg interactivep)
"Update copyright notice at beginning of buffer to indicate the current year.
With prefix ARG, replace the years in the notice rather than adding
the current year after them. If necessary, and
`copyright-current-gpl-version' is set, any copying permissions
-following the copyright are updated as well."
- (interactive "*P")
- (if copyright-update
+following the copyright are updated as well.
+If non-nil, INTERACTIVEP tells the function to behave as when it's called
+interactively."
+ (interactive "*P\nd")
+ (when (or copyright-update interactivep)
+ (let ((noquery (or (not copyright-query)
+ (and (eq copyright-query 'function) interactivep))))
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
- ;; Note that `current-time-string' isn't locale-sensitive.
- (setq copyright-current-year (substring (current-time-string) -4))
- (if (re-search-forward copyright-regexp copyright-limit t)
- (if (string= (buffer-substring (- (match-end 2) 2) (match-end 2))
- (substring copyright-current-year -2))
- ()
- (if (or (not copyright-query)
- (and (eq copyright-query 'function)
- (eq this-command 'copyright-update))
- (y-or-n-p (if arg
- (concat "Replace copyright year(s) by "
- copyright-current-year "? ")
- (concat "Add " copyright-current-year
- " to copyright? "))))
- (if arg
- (progn
- (delete-region (match-beginning 1) (match-end 1))
- (insert copyright-current-year))
- (setq arg (save-excursion (skip-chars-backward "0-9")))
- (if (and (eq (% (- (string-to-number
- copyright-current-year)
- (string-to-number (buffer-substring
- (+ (point) arg)
- (point))))
- 100)
- 1)
- (or (eq (char-after (+ (point) arg -1)) ?-)
- (eq (char-after (+ (point) arg -2)) ?-)))
- (delete-char arg)
- (insert ", ")
- (if (eq (char-after (+ (point) arg -3)) ?')
- (insert ?')))
- (insert (substring copyright-current-year arg))))))
+ (copyright-update-year arg noquery)
(goto-char (point-min))
(and copyright-current-gpl-version
;; match the GPL version comment in .el files, including the
(re-search-forward "\\(the Free Software Foundation;\
either \\|; a\\^u eldono \\([0-9]+\\)a, ? a\\^u (la\\^u via \\)\
version \\([0-9]+\\), or (at"
- copyright-limit t)
+ (+ (point) copyright-limit) t)
(not (string= (match-string 3) copyright-current-gpl-version))
- (or (not copyright-query)
- (and (eq copyright-query 'function)
- (eq this-command 'copyright-update))
+ (or noquery
(y-or-n-p (concat "Replace GPL version by "
copyright-current-gpl-version "? ")))
(progn
(if (match-end 2)
;; Esperanto bilingual comment in two-column.el
- (progn
- (delete-region (match-beginning 2) (match-end 2))
- (goto-char (match-beginning 2))
- (insert copyright-current-gpl-version)))
- (delete-region (match-beginning 3) (match-end 3))
- (goto-char (match-beginning 3))
- (insert copyright-current-gpl-version))))
+ (replace-match copyright-current-gpl-version t t nil 2))
+ (replace-match copyright-current-gpl-version t t nil 3))))
(set (make-local-variable 'copyright-update) nil)))
- ;; If a write-file-hook returns non-nil, the file is presumed to be written.
- nil)
+ ;; If a write-file-hook returns non-nil, the file is presumed to be written.
+ nil))
;;;###autoload
"Copyright (C) " `(substring (current-time-string) -4) " by "
(or (getenv "ORGANIZATION")
str)
- '(if (> (point) copyright-limit)
+ '(if (> (point) (+ (point-min) copyright-limit))
(message "Copyright extends beyond `copyright-limit' and won't be updated automatically."))
comment-end \n)
;; For the copyright sign:
;; Local Variables:
- ;; coding: emacs-mule
+ ;; coding: utf-8
;; End:
;;; copyright.el ends here
(re (regexp-opt-group sorted-strings open)))
(if words (concat "\\<" re "\\>") re))))
+(defconst regexp-opt-not-groupie*-re
+ (let* ((harmless-ch "[^\\\\[]")
+ (esc-pair-not-lp "\\\\[^(]")
+ (class-harmless-ch "[^][]")
+ (class-lb-harmless "[^]:]")
+ (class-lb-colon-maybe-charclass ":\\([a-z]+:]\\)?")
+ (class-lb (concat "\\[\\(" class-lb-harmless
+ "\\|" class-lb-colon-maybe-charclass "\\)"))
+ (class
+ (concat "\\[^?]?"
+ "\\(" class-harmless-ch
+ "\\|" class-lb "\\)*"
+ "\\[?]")) ; special handling for bare [ at end of re
+ (shy-lp "\\\\(\\?:"))
+ (concat "\\(" harmless-ch "\\|" esc-pair-not-lp
+ "\\|" class "\\|" shy-lp "\\)*"))
+ "Matches any part of a regular expression EXCEPT for non-shy \"\\\\(\"s")
+
;;;###autoload
(defun regexp-opt-depth (regexp)
"Return the depth of REGEXP.
(string-match regexp "")
;; Count the number of open parentheses in REGEXP.
(let ((count 0) start)
- (while (string-match "\\(\\`\\|[^\\]\\)\\\\\\(\\\\\\\\\\)*([^?]"
- regexp start)
- (setq count (1+ count)
- ;; Go back 2 chars (one for [^?] and one for [^\\]).
- start (- (match-end 0) 2)))
+ (while
+ (progn
+ (string-match regexp-opt-not-groupie*-re regexp start)
+ (setq start ( + (match-end 0) 2)) ; +2 for "\\(" after match-end.
+ (<= start (length regexp)))
+ (setq count (1+ count)))
count)))
\f
;;; Workhorse functions.
(require 'cl))
(defun regexp-opt-group (strings &optional paren lax)
- "Return a regexp to match a string in STRINGS.
-If PAREN non-nil, output regexp parentheses around returned regexp.
-If LAX non-nil, don't output parentheses if it doesn't require them.
-Merges keywords to avoid backtracking in Emacs' regexp matcher.
+ ;; Return a regexp to match a string in the sorted list STRINGS.
+ ;; If PAREN non-nil, output regexp parentheses around returned regexp.
+ ;; If LAX non-nil, don't output parentheses if it doesn't require them.
+ ;; Merges keywords to avoid backtracking in Emacs' regexp matcher.
-The basic idea is to find the shortest common prefix or suffix, remove it
-and recurse. If there is no prefix, we divide the list into two so that
-\(at least) one half will have at least a one-character common prefix.
+ ;; The basic idea is to find the shortest common prefix or suffix, remove it
+ ;; and recurse. If there is no prefix, we divide the list into two so that
+ ;; \(at least) one half will have at least a one-character common prefix.
-Also we delay the addition of grouping parenthesis as long as possible
-until we're sure we need them, and try to remove one-character sequences
-so we can use character sets rather than grouping parenthesis."
+ ;; Also we delay the addition of grouping parenthesis as long as possible
+ ;; until we're sure we need them, and try to remove one-character sequences
+ ;; so we can use character sets rather than grouping parenthesis.
(let* ((open-group (cond ((stringp paren) paren) (paren "\\(?:") (t "")))
(close-group (if paren "\\)" ""))
(open-charset (if lax "" open-group))
;;
;; We have a list of different length strings.
(t
- (let ((prefix (try-completion "" (mapcar 'list strings))))
+ (let ((prefix (try-completion "" strings)))
(if (> (length prefix) 0)
;; common prefix: take it and recurse on the suffixes.
(let* ((n (length prefix))
(let* ((sgnirts (mapcar (lambda (s)
(concat (nreverse (string-to-list s))))
strings))
- (xiffus (try-completion "" (mapcar 'list sgnirts))))
+ (xiffus (try-completion "" sgnirts)))
(if (> (length xiffus) 0)
;; common suffix: take it and recurse on the prefixes.
(let* ((n (- (length xiffus)))
(regexp-quote
(concat (nreverse (string-to-list xiffus))))
close-group))
-
+
;; Otherwise, divide the list into those that start with a
;; particular letter and those that do not, and recurse on them.
(let* ((char (char-to-string (string-to-char (car strings))))
- (half1 (all-completions char (mapcar 'list strings)))
+ (half1 (all-completions char strings))
(half2 (nthcdr (length half1) strings)))
(concat open-group
(regexp-opt-group half1)
(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))
(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 (>= (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)))))
(when eshell-status-in-modeline
(make-local-variable 'eshell-command-running-string)
- (let ((fmt (eshell-copy-list mode-line-format)))
+ (let ((fmt (copy-sequence mode-line-format)))
(make-local-variable 'mode-line-format)
(setq mode-line-format fmt))
(let ((modeline (memq 'mode-line-modified mode-line-format)))
(set (make-local-variable 'eshell-last-output-end) (point-marker))
(set (make-local-variable 'eshell-last-output-block-begin) (point))
- (let ((modules-list (eshell-copy-list eshell-modules-list)))
+ (let ((modules-list (copy-sequence eshell-modules-list)))
(make-local-variable 'eshell-modules-list)
(setq eshell-modules-list modules-list))
;; Free Software Foundation, Inc.
;; Maintainer: FSF
+;; Keywords: internal
;; This file is part of GNU Emacs.
;; Warning suppression -- can't require x-win in batch:
(autoload 'xw-defined-colors "x-win"))
-(require 'cus-face)
-
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Font selection.
example, if `:slant' appears before `:height', font selection first
tries to find a font with a suitable slant, even if this results in
a font height that isn't optimal."
- :tag "Font selection order."
+ :tag "Font selection order"
:type '(list symbol symbol symbol symbol)
:group 'font-selection
:set #'(lambda (symbol value)
Each element has the form (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...).
If fonts of family FAMILY can't be loaded, try ALTERNATIVE1, then
ALTERNATIVE2 etc."
- :tag "Alternative font families to try."
+ :tag "Alternative font families to try"
:type '(repeat (repeat string))
:group 'font-selection
:set #'(lambda (symbol value)
If fonts of registry REGISTRY can be loaded, font selection
tries to find a best matching font among all fonts of registry
REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc."
- :tag "Alternative font registries to try."
+ :tag "Alternative font registries to try"
:type '(repeat (repeat string))
:version "21.1"
:group 'font-selection
If NEW-FACE already exists as a face, it is modified to be like
OLD-FACE. If it doesn't already exist, it is created.
-If the optional argument FRAME is given as a frame, NEW-FACE is
+If the optional argument FRAME is given as a frame, NEW-FACE is
changed on FRAME only.
If FRAME is t, the frame-independent default specification for OLD-FACE
is copied to NEW-FACE.
If the optional argument FRAME is given, this gets the face NAME for
that frame; otherwise, it uses the selected frame.
If FRAME is the symbol t, then the global, non-frame face is returned.
-If NAME is already a face, it is simply returned.
-
-This function is defined for compatibility with Emacs 20.2. It
-should not be used anymore."
+If NAME is already a face, it is simply returned."
(or (facep name)
(check-face name)))
-(make-obsolete 'internal-get-face "See `facep' and `check-face'." "21.1")
+(make-obsolete 'internal-get-face "see `facep' and `check-face'." "21.1")
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; support faces in display table entries.
(defun face-id (face &optional frame)
- "Return the interNal ID of face with name FACE.
+ "Return the internal ID of face with name FACE.
If optional argument FRAME is nil or omitted, use the selected frame."
(check-face face)
(get face 'face))
(when (and inherit
(not (eq inherit t))
(face-attribute-relative-p attribute value))
- ;; We should merge with INHERIT as well
+ ;; We should merge with INHERIT as well
(setq value (face-attribute-merged-with attribute value inherit frame)))
value))
like an underlying face would be, with higher priority than underlying faces."
(let ((where (if (null frame) 0 frame)))
(setq args (purecopy args))
+ ;; If we set the new-frame defaults, this face is modified outside Custom.
+ (if (memq where '(0 t))
+ (put face 'face-modified t))
(while args
(internal-set-lisp-face-attribute face (car args)
(purecopy (cadr args))
;;; Interactively modifying faces.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun read-face-name (prompt)
- "Read and return a face symbol, prompting with PROMPT.
-PROMPT should not end with a blank, since this function appends one.
-Value is a symbol naming a known face."
- (let ((face-list (mapcar #'(lambda (x) (cons (symbol-name x) x))
- (face-list)))
- (def (thing-at-point 'symbol))
- face)
- (cond ((assoc def face-list)
- (setq prompt (concat prompt " (default " def "): ")))
- (t (setq def nil)
- (setq prompt (concat prompt ": "))))
- (while (equal "" (setq face (completing-read
- prompt face-list nil t nil nil def))))
- (intern face)))
+(defun read-face-name (prompt &optional string-describing-default multiple)
+ "Read a face, defaulting to the face or faces on the char after point.
+If it has a `read-face-name' property, that overrides the `face' property.
+PROMPT describes what you will do with the face (don't end in a space).
+STRING-DESCRIBING-DEFAULT describes what default you will use
+if this function returns nil.
+If MULTIPLE is non-nil, return a list of faces (possibly only one).
+Otherwise, return a single face."
+ (let ((faceprop (or (get-char-property (point) 'read-face-name)
+ (get-char-property (point) 'face)))
+ faces)
+ ;; Make a list of the named faces that the `face' property uses.
+ (if (listp faceprop)
+ (dolist (f faceprop)
+ (if (symbolp f)
+ (push f faces)))
+ (if (symbolp faceprop)
+ (setq faces (list faceprop))))
+ ;; If there are none, try to get a face name from the buffer.
+ (if (and (null faces)
+ (memq (intern-soft (thing-at-point 'symbol)) (face-list)))
+ (setq faces (list (intern-soft (thing-at-point 'symbol)))))
+
+ ;; If we only want one, and the default is more than one,
+ ;; discard the unwanted ones now.
+ (unless multiple
+ (if faces
+ (setq faces (list (car faces)))))
+ (let* ((input
+ ;; Read the input.
+ (completing-read
+ (if (or faces string-describing-default)
+ (format "%s (default %s): " prompt
+ (if faces (mapconcat 'symbol-name faces ", ")
+ string-describing-default))
+ (format "%s: " prompt))
+ obarray 'custom-facep t))
+ ;; Canonicalize the output.
+ (output
+ (if (equal input "")
+ faces
+ (if (stringp input)
+ (list (intern input))
+ input))))
+ ;; Return either a list of faces or just one face.
+ (if multiple
+ output
+ (car output)))))
(defun face-valid-attribute-values (attribute &optional frame)
;; The name list-faces would be more consistent, but let's avoid a
;; conflict with Lucid, which uses that name differently.
+(defvar help-xref-stack)
(defun list-faces-display ()
"List all faces, using the same sample text in each.
The sample text is a string that comes from the variable
(save-excursion
(save-match-data
(search-backward face-name)
- (help-xref-button 0 'help-customize-face face-name)))
- (let ((beg (point)))
+ (help-xref-button 0 'help-customize-face face)))
+ (let ((beg (point))
+ (line-beg (line-beginning-position)))
(insert list-faces-sample-text)
;; Hyperlink to a help buffer for the face.
(save-excursion
(help-xref-button 0 'help-face face)))
(insert "\n")
(put-text-property beg (1- (point)) 'face face)
+ ;; Make all face commands default to the proper face
+ ;; anywhere in the line.
+ (put-text-property line-beg (1- (point)) 'read-face-name face)
;; If the sample text has multiple lines, line up all of them.
(goto-char beg)
(forward-line 1)
(copy-face (car faces) (car faces) frame disp-frame)
(setq faces (cdr faces)))))))
-
(defun describe-face (face &optional frame)
"Display the properties of face FACE on FRAME.
+Interactively, FACE defaults to the faces of the character after point
+and FRAME defaults to the selected frame.
+
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).
If FRAME is omitted or nil, use the selected frame."
- (interactive (list (read-face-name "Describe face")))
+ (interactive (list (read-face-name "Describe face" "= `default' face" t)))
(let* ((attrs '((:family . "Family")
(:width . "Width")
(:height . "Height")
(: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))))
(help-setup-xref (list #'describe-face face) (interactive-p))
+ (unless face
+ (setq face 'default))
+ (if (not (listp face))
+ (setq face (list face)))
(with-output-to-temp-buffer (help-buffer)
(save-excursion
(set-buffer standard-output)
- (dolist (a attrs)
- (let ((attr (face-attribute face (car a) frame)))
- (insert (make-string (- max-width (length (cdr a))) ?\ )
- (cdr a) ": " (format "%s" attr) "\n")))
- (insert "\nDocumentation:\n\n"
- (or (face-documentation face)
- "not documented as a face."))
- (let ((customize-label "customize"))
- (terpri)
- (terpri)
- (princ (concat "You can " customize-label " this face."))
- (with-current-buffer standard-output
- (save-excursion
- (re-search-backward
- (concat "\\(" customize-label "\\)") nil t)
- (help-xref-button 1 'help-customize-face face)))))
+ (dolist (f face)
+ (insert "Face: " (symbol-name f))
+ (if (not (facep f))
+ (insert " undefined face.\n")
+ (let ((customize-label "customize this face"))
+ (princ (concat " (" customize-label ")\n"))
+ (insert "Documentation: "
+ (or (face-documentation f)
+ "Not documented as a face.")
+ "\n\n")
+ (with-current-buffer standard-output
+ (save-excursion
+ (re-search-backward
+ (concat "\\(" customize-label "\\)") nil t)
+ (help-xref-button 1 'help-customize-face f)))
+ (dolist (a attrs)
+ (let ((attr (face-attribute f (car a) frame)))
+ (insert (make-string (- max-width (length (cdr a))) ?\ )
+ (cdr a) ": " (format "%s" attr) "\n")))))
+ (terpri)))
(print-help-return-message))))
\f
((eq req 'background)
(memq (frame-parameter frame 'background-mode)
options))
+ ((eq req 'supports)
+ (display-supports-face-attributes-p options frame))
(t (error "Unknown req `%S' with options `%S'"
req options)))))
match))
(unless frame
(setq frame (selected-frame)))
(let ((tail spec)
- result)
+ result all)
(while tail
(let* ((entry (pop tail))
(display (car entry))
(attrs (cdr entry)))
(when (face-spec-set-match-display display frame)
- (setq result (if (listp (car attrs))
+ (setq result (if (null (cdr attrs)) ;; was (listp (car attrs))
;; Old-style entry, the attribute list is the
;; first element.
(car attrs)
- attrs)
- tail nil))))
- result))
+ attrs))
+ (if (eq display t)
+ (setq all result result nil)
+ (setq tail nil)))))
+ (if all (append result all) result)))
(defun face-spec-reset-face (face &optional frame)
(setq attribute nil))))
(when attribute
(set-face-attribute face frame attribute value)))
- (setq attrs (cdr (cdr attrs))))))
+ (setq attrs (cdr (cdr attrs)))))
+ ;; When we reset the face based on its spec, then it is unmodified
+ ;; as far as Custom is concerned.
+ (if (null frame)
+ (put face 'face-modified nil)))
(defun face-attr-match-p (face attrs &optional frame)
(t
(> (tty-color-gray-shades display) 2)))))
+(defun display-supports-face-attributes-p (attributes &optional display)
+ "Return non-nil if all the face attributes in ATTRIBUTES are supported.
+The optional argument DISPLAY can be a display name, a frame, or
+nil (meaning the selected frame's display)
+
+The definition of `supported' is somewhat heuristic, but basically means
+that a face containing all the attributes in ATTRIBUTES, when merged
+with the default face for display, can be represented in a way that's
+
+ (1) different in appearance than the default face, and
+ (2) `close in spirit' to what the attributes specify, if not exact.
+
+Point (2) implies that a `:weight black' attribute will be satisfied by
+any display that can display bold, and a `:foreground \"yellow\"' as long
+as it can display a yellowish color, but `:slant italic' will _not_ be
+satisfied by the tty display code's automatic substitution of a `dim'
+face for italic."
+ (let ((frame
+ (if (framep display)
+ display
+ (car (frames-on-display-list display)))))
+ ;; For now, we assume that non-tty displays can support everything.
+ ;; Later, we should add the ability to query about specific fonts,
+ ;; colors, etc.
+ (or (memq (framep frame) '(x w32 mac))
+ (tty-supports-face-attributes-p attributes frame))))
+
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Background mode.
according to the `background-mode' and `display-type' frame parameters."
(let* ((bg-resource
(and window-system
- (x-get-resource ".backgroundMode" "BackgroundMode")))
+ (x-get-resource "backgroundMode" "BackgroundMode")))
(bg-color (frame-parameter frame 'background-color))
(bg-mode
(cond (frame-background-mode)
(defun face-set-after-frame-default (frame)
"Set frame-local faces of FRAME from face specs and resources.
Initialize colors of certain faces from frame parameters."
+ (if (face-attribute 'default :font t)
+ (set-face-attribute 'default frame :font
+ (face-attribute 'default :font t))
+ (set-face-attribute 'default frame :family
+ (face-attribute 'default :family t))
+ (set-face-attribute 'default frame :height
+ (face-attribute 'default :height t))
+ (set-face-attribute 'default frame :slant
+ (face-attribute 'default :slant t))
+ (set-face-attribute 'default frame :weight
+ (face-attribute 'default :weight t))
+ (set-face-attribute 'default frame :width
+ (face-attribute 'default :width t)))
(dolist (face (face-list))
- (when (not (equal face 'default))
- (face-spec-set face (face-user-default-spec face) frame)
- (internal-merge-in-global-face face frame)
- (when (and (memq window-system '(x w32 mac))
- (or (not (boundp 'inhibit-default-face-x-resources))
- (not (eq face 'default))))
- (make-face-x-resource-internal face frame))))
-
+ ;; Don't let frame creation fail because of an invalid face spec.
+ (condition-case ()
+ (when (not (equal face 'default))
+ (face-spec-set face (face-user-default-spec face) frame)
+ (internal-merge-in-global-face face frame)
+ (when (and (memq window-system '(x w32 mac))
+ (or (not (boundp 'inhibit-default-face-x-resources))
+ (not (eq face 'default))))
+ (make-face-x-resource-internal face frame)))
+ (error nil)))
;; Initialize attributes from frame parameters.
(let ((params '((foreground-color default :foreground)
(background-color default :background)
;; Update a frame's faces when we change its default font.
(defalias 'frame-update-faces 'ignore)
-(make-obsolete 'frame-update-faces "No longer necessary" "21.1")
+(make-obsolete 'frame-update-faces "no longer necessary." "21.1")
;; Update the colors of FACE, after FRAME's own colors have been
;; changed.
(defface mode-line
'((((type x w32 mac) (class color))
- (:box (:line-width -1 :style released-button)
- :background "grey75" :foreground "black"))
+ :box (:line-width -1 :style released-button)
+ :background "grey75" :foreground "black")
(t
- (:inverse-video t)))
+ :inverse-video t))
"Basic mode line face for selected window."
:version "21.1"
:group 'modeline
:group 'basic-faces)
(defface mode-line-inactive
- '((((type x w32 mac) (background light) (class color))
- :inherit mode-line
+ '((t
+ :inherit mode-line)
+ (((type x w32 mac) (background light) (class color))
:weight light
:box (:line-width -1 :color "grey75" :style nil)
:foreground "grey20" :background "grey90")
(((type x w32 mac) (background dark) (class color))
- :inherit mode-line
:weight light
:box (:line-width -1 :color "grey40" :style nil)
- :foreground "grey80" :background "grey30")
- (t
- :inherit mode-line
- :inverse-video t))
+ :foreground "grey80" :background "grey30"))
"Basic mode line face for non-selected windows."
- :version "21.2"
+ :version "21.4"
:group 'modeline
:group 'basic-faces)
;; highlighting; this may be too confusing in general, although it
;; happens to look good with the only current use of header-lines,
;; the info browser. XXX
- :inherit mode-line
:underline t)
(((class color grayscale) (background light))
- :inherit mode-line
:background "grey90" :foreground "grey20"
- :box nil)
+ :box nil
+ :inherit mode-line)
(((class color grayscale) (background dark))
- :inherit mode-line
:background "grey20" :foreground "grey90"
- :box nil)
+ :box nil
+ :inherit mode-line)
(((class mono) (background light))
- :inherit mode-line
:background "white" :foreground "black"
:inverse-video nil
:box nil
- :underline t)
+ :underline t
+ :inherit mode-line)
(((class mono) (background dark))
- :inherit mode-line
:background "black" :foreground "white"
:inverse-video nil
:box nil
- :underline t)
- (t
- :inverse-video t))
+ :underline t
+ :inherit mode-line))
"Basic header-line face."
:version "21.1"
:group 'basic-faces)
(defface tool-bar
'((((type x w32 mac) (class color))
- (:box (:line-width 1 :style released-button)
- :background "grey75" :foreground "black"))
+ :box (:line-width 1 :style released-button)
+ :background "grey75" :foreground "black")
(((type x) (class mono))
- (:box (:line-width 1 :style released-button)
- :background "grey" :foreground "black"))
+ :box (:line-width 1 :style released-button)
+ :background "grey" :foreground "black")
(t
()))
"Basic tool-bar face."
:group 'basic-faces)
-(defface minibuffer-prompt '((((background dark)) (:foreground "cyan"))
- (((type pc)) (:foreground "magenta"))
- (t (:foreground "dark blue")))
+(defface minibuffer-prompt '((((background dark)) :foreground "cyan")
+ (((type pc)) :foreground "magenta")
+ (t :foreground "dark blue"))
"Face for minibuffer prompts."
- :version "21.3"
+ :version "21.4"
:group 'basic-faces)
(setq minibuffer-prompt-properties
(defface region
'((((type tty) (class color))
- (:background "blue" :foreground "white"))
+ :background "blue" :foreground "white")
(((type tty) (class mono))
- (:inverse-video t))
+ :inverse-video t)
(((class color) (background dark))
- (:background "blue3"))
+ :background "blue3")
(((class color) (background light))
- (:background "lightgoldenrod2"))
- (t (:background "gray")))
+ :background "lightgoldenrod2")
+ (t :background "gray"))
"Basic face for highlighting the region."
:version "21.1"
:group 'basic-faces)
(defface fringe
'((((class color) (background light))
- (:background "grey95"))
- (((class color) (background dark))
- (:background "grey10"))
- (t
- (:background "gray")))
+ :background "grey95")
+ (((class color) (background dark))
+ :background "grey10")
+ (t
+ :background "gray"))
"Basic face for the fringes to the left and right of windows under X."
:version "21.1"
:group 'frames
:group 'basic-faces)
-(defface bold '((t (:weight bold)))
+(defface bold '((t :weight bold))
"Basic bold face."
:group 'basic-faces)
-(defface italic '((t (:slant italic)))
+(defface italic
+ '((((supports :slant italic))
+ :slant italic)
+ (((supports :underline t))
+ :underline t)
+ (t
+ ;; default to italic, even it doesn't appear to be supported,
+ ;; because in some cases the display engine will do it's own
+ ;; workaround (to `dim' on ttys)
+ :slant italic))
"Basic italic font."
:group 'basic-faces)
-(defface bold-italic '((t (:weight bold :slant italic)))
+(defface bold-italic '((t :weight bold :slant italic))
"Basic bold-italic face."
:group 'basic-faces)
-(defface underline '((t (:underline t)))
+(defface underline '((t :underline t))
"Basic underlined face."
:group 'basic-faces)
(defface highlight
'((((type tty) (class color))
- (:background "green"))
+ :background "green" :foreground "black")
(((class color) (background light))
- (:background "darkseagreen2"))
+ :background "darkseagreen2")
(((class color) (background dark))
- (:background "darkolivegreen"))
- (t (:inverse-video t)))
+ :background "darkolivegreen")
+ (t :inverse-video t))
"Basic face for highlighting."
:group 'basic-faces)
(defface secondary-selection
'((((type tty) (class color))
- (:background "cyan" :foreground "black"))
+ :background "cyan" :foreground "black")
(((class color) (background light))
- (:background "yellow"))
+ :background "yellow")
(((class color) (background dark))
- (:background "SkyBlue4"))
- (t (:inverse-video t)))
+ :background "SkyBlue4")
+ (t :inverse-video t))
"Basic face for displaying the secondary selection."
:group 'basic-faces)
-(defface fixed-pitch '((t (:family "courier")))
+(defface fixed-pitch '((t :family "courier"))
"The basic fixed-pitch face."
:group 'basic-faces)
-(defface variable-pitch '((t (:family "helv")))
+(defface variable-pitch '((t :family "helv"))
"The basic variable-pitch face."
:group 'basic-faces)
(defface trailing-whitespace
'((((class color) (background light))
- (:background "red"))
+ :background "red")
(((class color) (background dark))
- (:background "red"))
- (t (:inverse-video t)))
+ :background "red")
+ (t :inverse-video t))
"Basic face for highlighting trailing whitespace."
:version "21.1"
:group 'font-lock ; like `show-trailing-whitespace'
;;; files.el --- file input and output commands for Emacs
-;; Copyright (C) 1985, 86, 87, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001
+;; Copyright (C) 1985,86,87,92,93,94,95,96,97,98,99,2000,01,02,2003
;;; Free Software Foundation, Inc.
;; Maintainer: FSF
by programs that create small temporary files. This is for systems that
have fast storage with limited space, such as a RAM disk."
:group 'files
- :type 'directory)
+ :type '(choice (const nil) directory))
;; The system null device. (Should reference NULL_DEVICE from C.)
(defvar null-device "/dev/null" "The system null device.")
"[\000-\031]\\|" ; control characters
"\\(/\\.\\.?[^/]\\)\\|" ; leading dots
"\\(/[^/.]+\\.[^/.]*\\.\\)")) ; more than a single dot
- ((memq system-type '(ms-dos windows-nt))
+ ((memq system-type '(ms-dos windows-nt cygwin))
(concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
"[|<>\"?*\000-\031]")) ; invalid characters
(t "[\000]"))
(defcustom auto-save-file-name-transforms
`(("\\`/[^/]*:\\(.+/\\)*\\(.*\\)"
- ,(expand-file-name "\\2" temporary-file-directory)))
+ ;; Don't put "\\2" inside expand-file-name, since it will be
+ ;; transformed to "/2" on DOS/Windows.
+ ,(concat temporary-file-directory "\\2") t))
"*Transforms to apply to buffer file name before making auto-save file name.
-Each transform is a list (REGEXP REPLACEMENT):
+Each transform is a list (REGEXP REPLACEMENT UNIQUIFY):
REGEXP is a regular expression to match against the file name.
If it matches, `replace-match' is used to replace the
matching part with REPLACEMENT.
+If the optional element UNIQUIFY is non-nil, the auto-save file name is
+constructed by taking the directory part of the replaced file-name,
+concatenated with the buffer file name with all directory separators
+changed to `!' to prevent clashes. This will not work
+correctly if your filesystem truncates the resulting name.
+
All the transforms in the list are tried, in the order they are listed.
When one transform applies, its result is final;
no further transforms are tried.
The default value is set up to put the auto-save file into the
temporary directory (see the variable `temporary-file-directory') for
-editing a remote file."
+editing a remote file.
+
+On MS-DOS filesystems without long names this variable is always
+ignored."
:group 'auto-save
- :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")))
+ :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")
+ (boolean :tag "Uniquify")))
:version "21.1")
(defcustom save-abbrevs t
;;;It is not useful to make this a local variable.
;;;(put 'find-file-not-found-hooks 'permanent-local t)
-(defvar find-file-not-found-hooks nil
+(defvar find-file-not-found-functions nil
"List of functions to be called for `find-file' on nonexistent file.
These functions are called as soon as the error is detected.
Variable `buffer-file-name' is already set up.
The functions are called in the order given until one of them returns non-nil.")
+(defvaralias 'find-file-not-found-hooks 'find-file-not-found-functions)
+(make-obsolete-variable
+ 'find-file-not-found-hooks 'find-file-not-found-functions "21.4")
;;;It is not useful to make this a local variable.
;;;(put 'find-file-hooks 'permanent-local t)
-(defvar find-file-hooks nil
+(defvar find-file-hook nil
"List of functions to be called after a buffer is loaded from a file.
The buffer's local variables (if any) will have been processed before the
functions are called.")
+(defvaralias 'find-file-hooks 'find-file-hook)
+(make-obsolete-variable 'find-file-hooks 'find-file-hook "21.4")
-(defvar write-file-hooks nil
+(defvar write-file-functions nil
"List of functions to be called before writing out a buffer to a file.
If one of them returns non-nil, the file is considered already written
and the rest are not called.
These hooks are considered to pertain to the visited file.
-So any buffer-local binding of `write-file-hooks' is
-discarded if you change the visited file name with \\[set-visited-file-name].
-
-Don't make this variable buffer-local; instead, use `local-write-file-hooks'.
-See also `write-contents-hooks'.")
-;;; However, in case someone does make it local...
-(put 'write-file-hooks 'permanent-local t)
-
-(defvar local-write-file-hooks nil
- "Just like `write-file-hooks', except intended for per-buffer use.
-The functions in this list are called before the ones in
-`write-file-hooks'.
-
-This variable is meant to be used for hooks that have to do with a
-particular visited file. Therefore, it is a permanent local, so that
-changing the major mode does not clear it. However, calling
-`set-visited-file-name' does clear it.")
+So any buffer-local binding of this variable is discarded if you change
+the visited file name with \\[set-visited-file-name], but not when you
+change the major mode.
+
+See also `write-contents-functions'.")
+(put 'write-file-functions 'permanent-local t)
+(defvaralias 'write-file-hooks 'write-file-functions)
+(make-obsolete-variable 'write-file-hooks 'write-file-functions "21.4")
+
+(defvar local-write-file-hooks nil)
(make-variable-buffer-local 'local-write-file-hooks)
(put 'local-write-file-hooks 'permanent-local t)
+(make-obsolete-variable 'local-write-file-hooks 'write-file-functions "21.4")
-(defvar write-contents-hooks nil
+(defvar write-contents-functions nil
"List of functions to be called before writing out a buffer to a file.
If one of them returns non-nil, the file is considered already written
and the rest are not called.
`set-visited-file-name' does not clear this variable; but changing the
major mode does clear it.
-This variable automatically becomes buffer-local whenever it is set.
-If you use `add-hook' to add elements to the list, use nil for the
-LOCAL argument.
-
-See also `write-file-hooks'.")
-(make-variable-buffer-local 'write-contents-hooks)
+See also `write-file-functions'.")
+(make-variable-buffer-local 'write-contents-functions)
+(defvaralias 'write-contents-hooks 'write-contents-functions)
+(make-obsolete-variable 'write-contents-hooks 'write-contents-functions "21.4")
(defcustom enable-local-variables t
"*Control use of local variables in files you visit.
(or (fboundp 'file-locked-p)
(defalias 'file-locked-p 'ignore))
-(defvar view-read-only nil
- "*Non-nil means buffers visiting files read-only, do it in view mode.")
+(defcustom view-read-only nil
+ "*Non-nil means buffers visiting files read-only do so in view mode.
+In fact, this means that all read-only buffers normally have
+View mode enabled, including buffers that are read-only because
+you visit a file you cannot alter, and buffers you make read-only
+using \\[toggle-read-only]."
+ :type 'boolean
+ :group 'view)
+(put 'ange-ftp-completion-hook-function 'safe-magic t)
(defun ange-ftp-completion-hook-function (op &rest args)
"Provides support for ange-ftp host name completion.
Runs the usual ange-ftp hook, but only for completion operations."
that really does change some file names to canonicalize certain
patterns and to guarantee valid names."
filename)
+
+(defun read-directory-name (prompt &optional dir default-dirname mustmatch initial)
+ "Read directory name, prompting with PROMPT and completing in directory DIR.
+Value is not expanded---you must call `expand-file-name' yourself.
+Default name to DEFAULT-DIRNAME if user enters a null string.
+ (If DEFAULT-DIRNAME is omitted, the current buffer's directory is used,
+ except that if INITIAL is specified, that combined with DIR is used.)
+Fourth arg MUSTMATCH non-nil means require existing directory's name.
+ Non-nil and non-t means also require confirmation after completion.
+Fifth arg INITIAL specifies text to start with.
+DIR defaults to current buffer's directory default."
+ (unless dir
+ (setq dir default-directory))
+ (unless default-dirname
+ (setq default-dirname
+ (if initial (concat dir initial) default-directory)))
+ (read-file-name prompt dir default-dirname mustmatch initial
+ 'file-directory-p))
+
\f
(defun pwd ()
"Show the current default directory."
\(For values of `colon' equal to `path-separator'.)"
;; We could use split-string here.
(and cd-path
- (let (cd-prefix cd-list (cd-start 0) cd-colon)
+ (let (cd-list (cd-start 0) cd-colon)
(setq cd-path (concat cd-path path-separator))
(while (setq cd-colon (string-match path-separator cd-path cd-start))
(setq cd-list
If your environment includes a `CDPATH' variable, try each one of that
colon-separated list of directories when resolving a relative directory name."
(interactive
- (list (read-file-name "Change default directory: "
+ (list (read-directory-name "Change default directory: "
default-directory default-directory
(and (member cd-path '(nil ("./")))
(null (getenv "CDPATH"))))))
(read-file-name "Load file: "))))
(load (expand-file-name file) nil nil t))
+(defun locate-file (filename path &optional suffixes predicate)
+ "Search for FILENAME through PATH.
+If SUFFIXES is non-nil, it should be a list of suffixes to append to
+file name when searching. If SUFFIXES is nil, it is equivalent to '(\"\").
+If non-nil, PREDICATE is used instead of `file-readable-p'.
+PREDICATE can also be an integer to pass to the `access' system call,
+in which case file-name handlers are ignored. This usage is deprecated.
+
+For compatibility, PREDICATE can also be one of the symbols
+`executable', `readable', `writable', or `exists', or a list of
+one or more of those symbols."
+ (if (and predicate (symbolp predicate) (not (functionp predicate)))
+ (setq predicate (list predicate)))
+ (when (and (consp predicate) (not (functionp predicate)))
+ (setq predicate
+ (logior (if (memq 'executable predicate) 1 0)
+ (if (memq 'writable predicate) 2 0)
+ (if (memq 'readable predicate) 4 0))))
+ (locate-file-internal filename path suffixes predicate))
+
+(defun locate-file-completion (string path-and-suffixes action)
+ "Do completion for file names passed to `locate-file'.
+PATH-AND-SUFFIXES is a pair of lists (DIRECTORIES . SUFFIXES)."
+ (if (file-name-absolute-p string)
+ (read-file-name-internal string nil action)
+ (let ((names nil)
+ (suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'"))
+ (string-dir (file-name-directory string)))
+ (dolist (dir (car path-and-suffixes))
+ (if string-dir (setq dir (expand-file-name string-dir dir)))
+ (when (file-directory-p dir)
+ (dolist (file (file-name-all-completions
+ (file-name-nondirectory string) dir))
+ (push (if string-dir (concat string-dir file) file) names)
+ (when (string-match suffix file)
+ (setq file (substring file 0 (match-beginning 0)))
+ (push (if string-dir (concat string-dir file) file) names)))))
+ (cond
+ ((eq action t) (all-completions string names))
+ ((null action) (try-completion string names))
+ (t (test-completion string names))))))
+
(defun load-library (library)
"Load the library named LIBRARY.
This is an interface to the function `load'."
- (interactive "sLoad library: ")
+ (interactive
+ (list (completing-read "Load library: "
+ 'locate-file-completion
+ (cons load-path load-suffixes))))
(load library))
+(defun file-remote-p (file)
+ "Test whether FILE specifies a location on a remote system."
+ (let ((handler (find-file-name-handler file 'file-local-copy)))
+ (if handler
+ (get handler 'file-remote-p))))
+
(defun file-local-copy (file)
"Copy the file FILE into a temporary file on this machine.
Returns the name of the local copy, or nil, if FILE is directly
;; it is stored on disk (expanding short name aliases with the full
;; name in the process).
(if (eq system-type 'windows-nt)
- (let ((handler (find-file-name-handler filename 'file-truename))
- newname)
+ (let ((handler (find-file-name-handler filename 'file-truename)))
;; For file name that has a special handler, call handler.
;; This is so that ange-ftp can save time by doing a no-op.
(if handler
(setq filename (funcall handler 'file-truename filename))
;; If filename contains a wildcard, newname will be the old name.
- (if (string-match "[[*?]" filename)
- (setq newname filename)
- ;; If filename doesn't exist, newname will be nil.
- (setq newname (w32-long-file-name filename)))
- (setq filename (or newname filename)))
+ (unless (string-match "[[*?]" filename)
+ ;; If filename exists, use the long name
+ (setq filename (or (w32-long-file-name filename) filename))))
(setq done t)))
;; If this file directly leads to a link, process that iteratively
(setq done t))))))))
filename))
-(defun file-chase-links (filename)
+(defun file-chase-links (filename &optional limit)
"Chase links in FILENAME until a name that is not a link.
-Does not examine containing directories for links,
-unlike `file-truename'."
- (let (tem (count 100) (newname filename))
- (while (setq tem (file-symlink-p newname))
+Unlike `file-truename', this does not check whether a parent
+directory name is a symbolic link.
+If the optional argument LIMIT is a number,
+it means chase no more than that many links and then stop."
+ (let (tem (newname filename)
+ (count 0))
+ (while (and (or (null limit) (< count limit))
+ (setq tem (file-symlink-p newname)))
(save-match-data
- (if (= count 0)
+ (if (and (null limit) (= count 100))
(error "Apparent cycle of symbolic links for %s" filename))
;; In the context of a link, `//' doesn't mean what Emacs thinks.
(while (string-match "//+" tem)
;; Now find the parent of that dir.
(setq newname (file-name-directory newname)))
(setq newname (expand-file-name tem (file-name-directory newname)))
- (setq count (1- count))))
+ (setq count (1+ count))))
+ newname))
+
+(defun recode-file-name (file coding new-coding &optional ok-if-already-exists)
+ "Change the encoding of FILE's name from CODING to NEW-CODING.
+The value is a new name of FILE.
+Signals a `file-already-exists' error if a file of the new name
+already exists unless optional third argument OK-IF-ALREADY-EXISTS
+is non-nil. A number as third arg means request confirmation if
+the new name already exists. This is what happens in interactive
+use with M-x."
+ (interactive
+ (let ((default-coding (or file-name-coding-system
+ default-file-name-coding-system))
+ (filename (read-file-name "Recode filename: " nil nil t))
+ from-coding to-coding)
+ (if (and default-coding
+ ;; We provide the default coding only when it seems that
+ ;; the filename is correctly decoded by the default
+ ;; coding.
+ (let ((charsets (find-charset-string filename)))
+ (and (not (memq 'eight-bit-control charsets))
+ (not (memq 'eight-bit-graphic charsets)))))
+ (setq from-coding (read-coding-system
+ (format "Recode filename %s from (default %s): "
+ filename default-coding)
+ default-coding))
+ (setq from-coding (read-coding-system
+ (format "Recode filename %s from: " filename))))
+
+ ;; We provide the default coding only when a user is going to
+ ;; change the encoding not from the default coding.
+ (if (eq from-coding default-coding)
+ (setq to-coding (read-coding-system
+ (format "Recode filename %s from %s to: "
+ filename from-coding)))
+ (setq to-coding (read-coding-system
+ (format "Recode filename %s from %s to (default %s): "
+ filename from-coding default-coding)
+ default-coding)))
+ (list filename from-coding to-coding)))
+
+ (let* ((default-coding (or file-name-coding-system
+ default-file-name-coding-system))
+ ;; FILE should have been decoded by DEFAULT-CODING.
+ (encoded (encode-coding-string file default-coding))
+ (newname (decode-coding-string encoded coding))
+ (new-encoded (encode-coding-string newname new-coding))
+ ;; Suppress further encoding.
+ (file-name-coding-system nil)
+ (default-file-name-coding-system nil)
+ (locale-coding-system nil))
+ (rename-file encoded new-encoded ok-if-already-exists)
newname))
\f
(defun switch-to-buffer-other-window (buffer &optional norecord)
(pop-to-buffer buffer t norecord)
(raise-frame (window-frame (selected-window)))))
+(defvar find-file-default nil
+ "Used within `find-file-read-args'.")
+
+(defun find-file-read-args (prompt mustmatch)
+ (list (let ((find-file-default
+ (and buffer-file-name
+ (abbreviate-file-name buffer-file-name)))
+ (munge-default-fun
+ (lambda ()
+ (setq minibuffer-default find-file-default)
+ ;; Clear out this hook so it does not interfere
+ ;; with any recursive minibuffer usage.
+ (pop minibuffer-setup-hook)))
+ (minibuffer-setup-hook
+ minibuffer-setup-hook))
+ (add-hook 'minibuffer-setup-hook munge-default-fun)
+ (read-file-name prompt nil default-directory mustmatch))
+ t))
+
(defun find-file (filename &optional wildcards)
"Edit file FILENAME.
Switch to a buffer visiting file FILENAME,
creating one if none already exists.
+Interactively, the default if you just type RET is the current directory,
+but the visited file name is available through the minibuffer history:
+type M-n to pull it into the minibuffer.
+
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files. Wildcard expansion
can be suppressed by setting `find-file-wildcards'."
- (interactive "FFind file: \np")
+ (interactive
+ (find-file-read-args "Find file: " nil))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(mapcar 'switch-to-buffer (nreverse value))
"Edit file FILENAME, in another window.
May create a new window, or reuse an existing one.
See the function `display-buffer'.
+
+Interactively, the default if you just type RET is the current directory,
+but the visited file name is available through the minibuffer history:
+type M-n to pull it into the minibuffer.
+
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
- (interactive "FFind file in other window: \np")
+ (interactive (find-file-read-args "Find file in other window: " nil))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
"Edit file FILENAME, in another frame.
May create a new frame, or reuse an existing one.
See the function `display-buffer'.
+
+Interactively, the default if you just type RET is the current directory,
+but the visited file name is available through the minibuffer history:
+type M-n to pull it into the minibuffer.
+
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
- (interactive "FFind file in other frame: \np")
+ (interactive (find-file-read-args "Find file in other frame: " nil))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
(defun find-file-read-only (filename &optional wildcards)
"Edit file FILENAME but don't allow changes.
-Like `find-file' but marks buffer as read-only.
+Like \\[find-file] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
- (interactive "fFind file read-only: \np")
+ (interactive (find-file-read-args "Find file read-only: " t))
+ (unless (file-exists-p filename) (error "%s does not exist" filename))
(find-file filename wildcards)
(toggle-read-only 1)
(current-buffer))
"Edit file FILENAME in another window but don't allow changes.
Like \\[find-file-other-window] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
- (interactive "fFind file read-only other window: \np")
+ (interactive (find-file-read-args "Find file read-only other window: " t))
+ (unless (file-exists-p filename) (error "%s does not exist" filename))
(find-file-other-window filename wildcards)
(toggle-read-only 1)
(current-buffer))
"Edit file FILENAME in another frame but don't allow changes.
Like \\[find-file-other-frame] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
- (interactive "fFind file read-only other frame: \np")
+ (interactive (find-file-read-args "Find file read-only other frame: " t))
+ (unless (file-exists-p filename) (error "%s does not exist" filename))
(find-file-other-frame filename wildcards)
(toggle-read-only 1)
(current-buffer))
file-dir (file-name-directory file)))
(list (read-file-name
"Find alternate file: " file-dir nil nil file-name))))
- (and (buffer-modified-p) (buffer-file-name)
- ;; (not buffer-read-only)
- (not (yes-or-no-p (format "Buffer %s is modified; kill anyway? "
- (buffer-name))))
- (error "Aborted"))
+ (unless (run-hook-with-args-until-failure 'kill-buffer-query-functions)
+ (error "Aborted"))
+ (when (and (buffer-modified-p) (buffer-file-name))
+ (if (yes-or-no-p (format "Buffer %s is modified; save it first? "
+ (buffer-name)))
+ (save-buffer)
+ (unless (yes-or-no-p "Kill and replace the buffer without saving it? ")
+ (error "Aborted"))))
(let ((obuf (current-buffer))
(ofile buffer-file-name)
(onum buffer-file-number)
+ (odir dired-directory)
(otrue buffer-file-truename)
(oname (buffer-name)))
(if (get-buffer " **lose**")
(unwind-protect
(progn
(unlock-buffer)
+ ;; This prevents us from finding the same buffer
+ ;; if we specified the same file again.
(setq buffer-file-name nil)
(setq buffer-file-number nil)
(setq buffer-file-truename nil)
+ ;; Likewise for dired buffers.
+ (setq dired-directory nil)
(find-file filename))
- (cond ((eq obuf (current-buffer))
- (setq buffer-file-name ofile)
- (setq buffer-file-number onum)
- (setq buffer-file-truename otrue)
- (lock-buffer)
- (rename-buffer oname))))
- (or (eq (current-buffer) obuf)
- (kill-buffer obuf))))
+ (when (eq obuf (current-buffer))
+ ;; This executes if find-file gets an error
+ ;; and does not really find anything.
+ ;; We put things back as they were.
+ ;; If find-file actually finds something, we kill obuf below.
+ (setq buffer-file-name ofile)
+ (setq buffer-file-number onum)
+ (setq buffer-file-truename otrue)
+ (setq dired-directory odir)
+ (lock-buffer)
+ (rename-buffer oname)))
+ (unless (eq (current-buffer) obuf)
+ (with-current-buffer obuf
+ ;; We already asked; don't ask again.
+ (let ((kill-buffer-query-functions))
+ (kill-buffer obuf))))))
\f
(defun create-file-buffer (filename)
"Create a suitably named buffer for visiting FILENAME, and return it.
(defun abbreviate-file-name (filename)
"Return a version of FILENAME shortened using `directory-abbrev-alist'.
-This also substitutes \"~\" for the user's home directory.
-Type \\[describe-variable] directory-abbrev-alist RET for more information."
+This also substitutes \"~\" for the user's home directory and
+removes automounter prefixes (see the variable `automount-dir-prefix')."
;; Get rid of the prefixes added by the automounter.
(if (and automount-dir-prefix
(string-match automount-dir-prefix filename)
;; MS-DOS root directories can come with a drive letter;
;; Novell Netware allows drive letters beyond `Z:'.
(not (and (or (eq system-type 'ms-dos)
+ (eq system-type 'cygwin)
(eq system-type 'windows-nt))
(save-match-data
(string-match "^[a-zA-`]:/$" filename)))))
:type '(repeat (string :tag "Name"))
:group 'find-file)
-(defun find-buffer-visiting (filename)
+(defun find-buffer-visiting (filename &optional predicate)
"Return the buffer visiting file FILENAME (a string).
This is like `get-file-buffer', except that it checks for any buffer
visiting the same file, possibly under a different name.
+If PREDICATE is non-nil, only a buffer satisfying it can be returned.
If there is no such live buffer, return nil."
- (let ((buf (get-file-buffer filename))
- (truename (abbreviate-file-name (file-truename filename))))
- (or buf
- (let ((list (buffer-list)) found)
- (while (and (not found) list)
- (save-excursion
- (set-buffer (car list))
- (if (and buffer-file-name
- (string= buffer-file-truename truename))
- (setq found (car list))))
- (setq list (cdr list)))
- found)
- (let* ((attributes (file-attributes truename))
- (number (nthcdr 10 attributes))
- (list (buffer-list)) found)
- (and buffer-file-numbers-unique
- number
- (while (and (not found) list)
- (with-current-buffer (car list)
- (if (and buffer-file-name
- (equal buffer-file-number number)
- ;; Verify this buffer's file number
- ;; still belongs to its file.
- (file-exists-p buffer-file-name)
- (equal (file-attributes buffer-file-name)
- attributes))
- (setq found (car list))))
- (setq list (cdr list))))
- found))))
+ (let ((predicate (or predicate #'identity))
+ (truename (abbreviate-file-name (file-truename filename))))
+ (or (let ((buf (get-file-buffer filename)))
+ (when (and buf (funcall predicate buf)) buf))
+ (let ((list (buffer-list)) found)
+ (while (and (not found) list)
+ (save-excursion
+ (set-buffer (car list))
+ (if (and buffer-file-name
+ (string= buffer-file-truename truename)
+ (funcall predicate (current-buffer)))
+ (setq found (car list))))
+ (setq list (cdr list)))
+ found)
+ (let* ((attributes (file-attributes truename))
+ (number (nthcdr 10 attributes))
+ (list (buffer-list)) found)
+ (and buffer-file-numbers-unique
+ number
+ (while (and (not found) list)
+ (with-current-buffer (car list)
+ (if (and buffer-file-name
+ (equal buffer-file-number number)
+ ;; Verify this buffer's file number
+ ;; still belongs to its file.
+ (file-exists-p buffer-file-name)
+ (equal (file-attributes buffer-file-truename)
+ attributes)
+ (funcall predicate (current-buffer)))
+ (setq found (car list))))
+ (setq list (cdr list))))
+ found))))
\f
(defcustom find-file-wildcards t
"*Non-nil means file-visiting commands should handle wildcards.
:version "21.1"
:type 'boolean)
+(defcustom large-file-warning-threshold 10000000
+ "Maximum size of file above which a confirmation is requested.
+When nil, never request confirmation."
+ :group 'files
+ :group 'find-file
+ :type '(choice integer (const :tag "Never request confirmation" nil)))
+
(defun find-file-noselect (filename &optional nowarn rawfile wildcards)
"Read file FILENAME into a buffer and return the buffer.
If a buffer exists visiting FILENAME, return that one, but
(mapcar #'find-file-noselect files)))
(let* ((buf (get-file-buffer filename))
(truename (abbreviate-file-name (file-truename filename)))
- (number (nthcdr 10 (file-attributes truename)))
+ (attributes (file-attributes truename))
+ (number (nthcdr 10 attributes))
;; Find any buffer for a file which has same truename.
(other (and (not buf) (find-buffer-visiting filename))))
;; Let user know if there is a buffer with the same truename.
;; Optionally also find that buffer.
(if (or find-file-existing-other-name find-file-visit-truename)
(setq buf other))))
+ ;; Check to see if the file looks uncommonly large.
+ (when (and large-file-warning-threshold (nth 7 attributes)
+ ;; Don't ask again if we already have the file or
+ ;; if we're asked to be quiet.
+ (not (or buf nowarn))
+ (> (nth 7 attributes) large-file-warning-threshold)
+ (not (y-or-n-p
+ (format "File %s is large (%sMB), really open? "
+ (file-name-nondirectory filename)
+ (/ (nth 7 attributes) 1048576)))))
+ (error "Aborted"))
(if buf
;; We are using an existing buffer.
(progn
(unless (or (eq read-only buffer-file-read-only)
(eq read-only buffer-read-only))
(when (or nowarn
- (let ((question
+ (let ((question
(format "File %s is %s on disk. Change buffer mode? "
buffer-file-name
(if read-only "read-only" "writable"))))
;; Needed in case we are re-visiting the file with a different
;; text representation.
(kill-local-variable 'buffer-file-coding-system)
+ (kill-local-variable 'cursor-type)
(erase-buffer)
(and (default-value 'enable-multibyte-characters)
(not rawfile)
(signal 'file-error (list "File is not readable"
filename)))
;; Run find-file-not-found-hooks until one returns non-nil.
- (or (run-hook-with-args-until-success 'find-file-not-found-hooks)
+ (or (run-hook-with-args-until-success 'find-file-not-found-functions)
;; If they fail too, set error.
(setq error t)))))
;; Record the file's truename, and maybe use that as visited name.
"Like `insert-file-contents', but only reads in the file literally.
A buffer may be modified in several ways after reading into the buffer,
to Emacs features such as format decoding, character code
-conversion, `find-file-hooks', automatic uncompression, etc.
+conversion, `find-file-hook', automatic uncompression, etc.
This function ensures that none of these modifications will take place."
(let ((format-alist nil)
(coding-system-for-read 'no-conversion)
(coding-system-for-write 'no-conversion)
(find-buffer-file-type-function
- (if (fboundp 'find-buffer-file-type)
- (symbol-function 'find-buffer-file-type)
- nil))
- (inhibit-file-name-handlers '(jka-compr-handler image-file-handler))
- (inhibit-file-name-operation 'insert-file-contents))
+ (if (fboundp 'find-buffer-file-type)
+ (symbol-function 'find-buffer-file-type)
+ nil))
+ (inhibit-file-name-handlers
+ (append '(jka-compr-handler image-file-handler)
+ inhibit-file-name-handlers))
+ (inhibit-file-name-operation 'insert-file-contents))
(unwind-protect
- (progn
- (fset 'find-buffer-file-type (lambda (filename) t))
- (insert-file-contents filename visit beg end replace))
+ (progn
+ (fset 'find-buffer-file-type (lambda (filename) t))
+ (insert-file-contents filename visit beg end replace))
(if find-buffer-file-type-function
(fset 'find-buffer-file-type find-buffer-file-type-function)
(fmakunbound 'find-buffer-file-type)))))
+(defun insert-file-1 (filename insert-func)
+ (if (file-directory-p filename)
+ (signal 'file-error (list "Opening input file" "file is a directory"
+ filename)))
+ (let* ((buffer (find-buffer-visiting (abbreviate-file-name (file-truename filename))
+ #'buffer-modified-p))
+ (tem (funcall insert-func filename)))
+ (push-mark (+ (point) (car (cdr tem))))
+ (when buffer
+ (message "File %s already visited and modified in buffer %s"
+ filename (buffer-name buffer)))))
+
(defun insert-file-literally (filename)
"Insert contents of file FILENAME into buffer after point with no conversion.
Don't call it from programs! Use `insert-file-contents-literally' instead.
\(Its calling sequence is different; see its documentation)."
(interactive "*fInsert file literally: ")
- (if (file-directory-p filename)
- (signal 'file-error (list "Opening input file" "file is a directory"
- filename)))
- (let ((tem (insert-file-contents-literally filename)))
- (push-mark (+ (point) (car (cdr tem))))))
+ (insert-file-1 filename #'insert-file-contents-literally))
(defvar find-file-literally nil
"Non-nil if this buffer was made by `find-file-literally' or equivalent.
Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil
means this call was from `revert-buffer'.
Fifth arg NOMODES non-nil means don't alter the file's modes.
-Finishes by calling the functions in `find-file-hooks'
+Finishes by calling the functions in `find-file-hook'
unless NOMODES is non-nil."
(setq buffer-read-only (not (file-writable-p buffer-file-name)))
(if noninteractive
(file-newer-than-file-p (or buffer-auto-save-file-name
(make-auto-save-file-name))
buffer-file-name))
- (format "%s has auto save data; consider M-x recover-file"
+ (format "%s has auto save data; consider M-x recover-this-file"
(file-name-nondirectory buffer-file-name))
(setq not-serious t)
(if error "(New file)" nil)))
(setq buffer-read-only nil))
(t
(setq buffer-read-only nil)
- (if (file-exists-p (file-name-directory (directory-file-name (file-name-directory buffer-file-name))))
- "Use M-x make-directory RET RET to create the directory"
- "Use C-u M-x make-directory RET RET to create directory and its parents")))))
+ "Use M-x make-directory RET RET to create the directory and its parents"))))
(when msg
- (message msg)
- (or not-serious (sit-for 1 nil t))))
+ (message "%s" msg)
+ (or not-serious (sit-for 1 t))))
(when (and auto-save-default (not noauto))
(auto-save-mode t)))
;; Make people do a little extra work (C-x C-q)
;; before altering a backup file.
(when (backup-file-name-p buffer-file-name)
(setq buffer-read-only t))
+ ;; When a file is marked read-only,
+ ;; make the buffer read-only even if root is looking at it.
+ (when (and (file-modes (buffer-file-name))
+ (zerop (logand (file-modes (buffer-file-name)) #o222)))
+ (setq buffer-read-only t))
(unless nomodes
(when (and view-read-only view-mode)
(view-mode-disable))
view-read-only
(not (eq (get major-mode 'mode-class) 'special)))
(view-mode-enter))
- (run-hooks 'find-file-hooks)))
+ (run-hooks 'find-file-hook)))
+
+(defmacro report-errors (format &rest body)
+ "Eval BODY and turn any error into a FORMAT message.
+FORMAT can have a %s escape which will be replaced with the actual error.
+If `debug-on-error' is set, errors are not caught, so that you can
+debug them.
+Avoid using a large BODY since it is duplicated."
+ (declare (debug t) (indent 1))
+ `(if debug-on-error
+ (progn . ,body)
+ (condition-case err
+ (progn . ,body)
+ (error (message ,format (prin1-to-string err))))))
(defun normal-mode (&optional find-file)
"Choose the major mode for this buffer automatically.
in that case, this function acts as if `enable-local-variables' were t."
(interactive)
(or find-file (funcall (or default-major-mode 'fundamental-mode)))
- (condition-case err
- (set-auto-mode)
- (error (message "File mode specification error: %s"
- (prin1-to-string err))))
- (condition-case err
- (let ((enable-local-variables (or (not find-file)
- enable-local-variables)))
- (hack-local-variables))
- (error (message "File local-variables error: %s"
- (prin1-to-string err)))))
+ (report-errors "File mode specification error: %s"
+ (set-auto-mode))
+ (report-errors "File local-variables error: %s"
+ (let ((enable-local-variables (or (not find-file) enable-local-variables)))
+ (hack-local-variables)))
+ (if (fboundp 'ucs-set-table-for-input) ; don't lose when building
+ (ucs-set-table-for-input)))
(defvar auto-mode-alist
+ ;; Note: The entries for the modes defined in cc-mode.el (c-mode,
+ ;; c++-mode, java-mode and more) are added through autoload
+ ;; directives in that file. That way is discouraged since it
+ ;; spreads out the definition of the initial value.
(mapc
(lambda (elt)
(cons (purecopy (car elt)) (cdr elt)))
'(("\\.te?xt\\'" . text-mode)
- ("\\.c\\'" . c-mode)
- ("\\.h\\'" . c-mode)
("\\.tex\\'" . tex-mode)
+ ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages.
("\\.ltx\\'" . latex-mode)
+ ("\\.dtx\\'" . doctex-mode)
("\\.el\\'" . emacs-lisp-mode)
("\\.scm\\'" . scheme-mode)
("\\.l\\'" . lisp-mode)
("\\.p\\'" . pascal-mode)
("\\.pas\\'" . pascal-mode)
("\\.ad[abs]\\'" . ada-mode)
+ ("\\.ad[bs].dg\\'" . ada-mode)
("\\.\\([pP]\\([Llm]\\|erl\\)\\|al\\)\\'" . perl-mode)
("\\.s?html?\\'" . html-mode)
- ("\\.cc\\'" . c++-mode)
- ("\\.hh\\'" . c++-mode)
- ("\\.hpp\\'" . c++-mode)
- ("\\.C\\'" . c++-mode)
- ("\\.H\\'" . c++-mode)
- ("\\.cpp\\'" . c++-mode)
- ("\\.cxx\\'" . c++-mode)
- ("\\.hxx\\'" . c++-mode)
- ("\\.c\\+\\+\\'" . c++-mode)
- ("\\.h\\+\\+\\'" . c++-mode)
- ("\\.m\\'" . objc-mode)
- ("\\.java\\'" . java-mode)
("\\.mk\\'" . makefile-mode)
- ("\\(M\\|m\\|GNUm\\)akefile\\(\\.in\\)?\\'" . makefile-mode)
+ ("\\(M\\|m\\|GNUm\\)akefile\\'" . makefile-mode)
("\\.am\\'" . makefile-mode) ;For Automake.
;; Less common extensions come here
;; so more common ones above are found faster.
("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
("\\.scm\\.[0-9]*\\'" . scheme-mode)
("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
+ ("\\.bash\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\(bash_logout\\|shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
("\\.me\\'" . nroff-mode)
("\\.ms\\'" . nroff-mode)
("\\.man\\'" . nroff-mode)
- ("\\.\\(u?lpc\\|pike\\|pmod\\)\\'" . pike-mode)
("\\.TeX\\'" . tex-mode)
("\\.sty\\'" . latex-mode)
("\\.cls\\'" . latex-mode) ;LaTeX 2e class
("\\.sim\\'" . simula-mode)
("\\.mss\\'" . scribe-mode)
("\\.f90\\'" . f90-mode)
+ ("\\.f95\\'" . f90-mode)
("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode
("\\.pro\\'" . idlwave-mode)
("\\.lsp\\'" . lisp-mode)
- ("\\.awk\\'" . awk-mode)
("\\.prolog\\'" . prolog-mode)
("\\.tar\\'" . tar-mode)
- ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\)\\'" . archive-mode)
- ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|JAR\\)\\'" . archive-mode)
+ ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|ear\\|jar\\|war\\)\\'" . archive-mode)
+ ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|EAR\\|JAR\\|WAR\\)\\'" . archive-mode)
+ ("\\.sx[dmicw]\\'" . archive-mode) ; OpenOffice.org
;; Mailer puts message to be edited in
;; /tmp/Re.... or Message
("\\`/tmp/Re" . text-mode)
("\\.zone\\'" . zone-mode)
;; some news reader is reported to use this
("\\`/tmp/fol/" . text-mode)
- ("\\.y\\'" . c-mode)
- ("\\.lex\\'" . c-mode)
("\\.oak\\'" . scheme-mode)
("\\.sgml?\\'" . sgml-mode)
("\\.xml\\'" . sgml-mode)
+ ("\\.xsl\\'" . sgml-mode)
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
- ("\\.idl\\'" . idl-mode)
- ;; .emacs following a directory delimiter
- ;; in Unix, MSDOG or VMS syntax.
- ("[]>:/\\]\\..*emacs\\'" . emacs-lisp-mode)
+ ;; .emacs or .gnus or .viper following a directory delimiter in
+ ;; Unix, MSDOG or VMS syntax.
+ ("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
("\\`\\..*emacs\\'" . emacs-lisp-mode)
;; _emacs following a directory delimiter
;; in MsDos syntax
;; for the sake of ChangeLog.1, etc.
;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too.
("\\.[1-9]\\'" . nroff-mode)
- ("\\.g\\'" . antlr-mode)))
+ ("\\.g\\'" . antlr-mode)
+ ("\\.ses\\'" . ses-mode)
+ ("\\.in\\'" nil t)))
"Alist of filename patterns vs corresponding major mode functions.
Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
\(NON-NIL stands for anything that is not nil; the value does not matter.)
(defvar interpreter-mode-alist
+ ;; Note: The entries for the modes defined in cc-mode.el (awk-mode
+ ;; and pike-mode) are added through autoload directives in that
+ ;; file. That way is discouraged since it spreads out the
+ ;; definition of the initial value.
(mapc
(lambda (l)
(cons (purecopy (car l)) (cdr l)))
("wishx" . tcl-mode)
("tcl" . tcl-mode)
("tclsh" . tcl-mode)
- ("awk" . awk-mode)
- ("mawk" . awk-mode)
- ("nawk" . awk-mode)
- ("gawk" . awk-mode)
("scm" . scheme-mode)
("ash" . sh-mode)
("bash" . sh-mode)
(mode nil))
;; Find first matching alist entry.
(let ((case-fold-search
- (memq system-type '(vax-vms windows-nt))))
+ (memq system-type '(vax-vms windows-nt cygwin))))
(while (and (not mode) alist)
(if (string-match (car (car alist)) name)
(if (and (consp (cdr (car alist)))
(goto-char beg)
end))))
-(defun hack-local-variables-prop-line ()
+(defun hack-local-variables-prop-line (&optional mode-only)
"Set local variables specified in the -*- line.
Ignore any specification for `mode:' and `coding:';
`set-auto-mode' should already have handled `mode:',
-`set-auto-coding' should already have handled `coding:'."
+`set-auto-coding' should already have handled `coding:'.
+If MODE-ONLY is non-nil, all we do is check whether the major mode
+is specified, returning t if it is specified."
(save-excursion
(goto-char (point-min))
(let ((result nil)
(end (set-auto-mode-1))
+ mode-specified
(enable-local-variables
(and local-enable-local-variables enable-local-variables)))
- ;; Parse the -*- line into the `result' alist.
+ ;; Parse the -*- line into the RESULT alist.
+ ;; Also set MODE-SPECIFIED if we see a spec or `mode'.
(cond ((not end)
nil)
((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
;; Simple form: "-*- MODENAME -*-". Already handled.
+ (setq mode-specified t)
nil)
(t
;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
(or (equal (downcase (symbol-name key)) "mode")
(equal (downcase (symbol-name key)) "coding")
(setq result (cons (cons key val) result)))
+ (if (equal (downcase (symbol-name key)) "mode")
+ (setq mode-specified t))
(skip-chars-forward " \t;")))
(setq result (nreverse result))))
- (if (and result
- (or (eq enable-local-variables t)
- (and enable-local-variables
- (save-window-excursion
- (condition-case nil
- (switch-to-buffer (current-buffer))
- (error
- ;; If we fail to switch in the selected window,
- ;; it is probably a minibuffer.
- ;; So try another window.
- (condition-case nil
- (switch-to-buffer-other-window (current-buffer))
- (error
- (switch-to-buffer-other-frame (current-buffer))))))
- (y-or-n-p (format "Set local variables as specified in -*- line of %s? "
- (file-name-nondirectory buffer-file-name)))))))
- (let ((enable-local-eval enable-local-eval))
- (while result
- (hack-one-local-variable (car (car result)) (cdr (car result)))
- (setq result (cdr result))))))))
+ (if mode-only mode-specified
+ (if (and result
+ (or mode-only
+ (eq enable-local-variables t)
+ (and enable-local-variables
+ (save-window-excursion
+ (condition-case nil
+ (switch-to-buffer (current-buffer))
+ (error
+ ;; If we fail to switch in the selected window,
+ ;; it is probably a minibuffer.
+ ;; So try another window.
+ (condition-case nil
+ (switch-to-buffer-other-window (current-buffer))
+ (error
+ (switch-to-buffer-other-frame (current-buffer))))))
+ (y-or-n-p (format "Set local variables as specified in -*- line of %s? "
+ (file-name-nondirectory buffer-file-name)))))))
+ (let ((enable-local-eval enable-local-eval))
+ (while result
+ (hack-one-local-variable (car (car result)) (cdr (car result)))
+ (setq result (cdr result)))))
+ nil))))
(defvar hack-local-variables-hook nil
"Normal hook run after processing a file's local variables specs.
"Parse and put into effect this buffer's local variables spec.
If MODE-ONLY is non-nil, all we do is check whether the major mode
is specified, returning t if it is specified."
- (unless mode-only
- (hack-local-variables-prop-line))
- ;; Look for "Local variables:" line in last page.
- (let (mode-specified
+ (let ((mode-specified
+ ;; If MODE-ONLY is t, we check here for specifying the mode
+ ;; in the -*- line. If MODE-ONLY is nil, we process
+ ;; the -*- line here.
+ (hack-local-variables-prop-line mode-only))
(enable-local-variables
(and local-enable-local-variables enable-local-variables)))
+ ;; Look for "Local variables:" line in last page.
(save-excursion
(goto-char (point-max))
(search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
(put 'ignored-local-variables 'risky-local-variable t)
(put 'eval 'risky-local-variable t)
(put 'file-name-handler-alist 'risky-local-variable t)
+(put 'inhibit-quit 'risky-local-variable t)
+(put 'minor-mode-alist 'risky-local-variable t)
(put 'minor-mode-map-alist 'risky-local-variable t)
+(put 'minor-mode-overriding-map-alist 'risky-local-variable t)
+(put 'overriding-local-map 'risky-local-variable t)
+(put 'overriding-terminal-local-map 'risky-local-variable t)
+(put 'auto-mode-alist 'risky-local-variable t)
(put 'after-load-alist 'risky-local-variable t)
(put 'buffer-file-name 'risky-local-variable t)
+(put 'buffer-undo-list 'risky-local-variable t)
(put 'buffer-auto-save-file-name 'risky-local-variable t)
(put 'buffer-file-truename 'risky-local-variable t)
+(put 'default-text-properties 'risky-local-variable t)
(put 'exec-path 'risky-local-variable t)
(put 'load-path 'risky-local-variable t)
(put 'exec-directory 'risky-local-variable t)
(put 'outline-level 'risky-local-variable t)
(put 'rmail-output-file-alist 'risky-local-variable t)
(put 'font-lock-defaults 'risky-local-variable t)
-
-;; This one is safe because the user gets to check it before it is used.
-(put 'compile-command 'safe-local-variable t)
+(put 'special-display-buffer-names 'risky-local-variable t)
+(put 'frame-title-format 'risky-local-variable t)
+(put 'global-mode-string 'risky-local-variable t)
+(put 'header-line-format 'risky-local-variable t)
+(put 'icon-title-format 'risky-local-variable t)
+(put 'input-method-alist 'risky-local-variable t)
+(put 'format-alist 'risky-local-variable t)
+(put 'vc-mode 'risky-local-variable t)
+(put 'imenu-generic-expression 'risky-local-variable t)
+(put 'imenu-index-alist 'risky-local-variable t)
+(put 'standard-input 'risky-local-variable t)
+(put 'standard-output 'risky-local-variable t)
+(put 'unread-command-events 'risky-local-variable t)
+(put 'max-lisp-eval-depth 'risky-local-variable t)
+(put 'max-specpdl-size 'risky-local-variable t)
+(put 'mode-line-format 'risky-local-variable t)
+(put 'mode-line-modified 'risky-local-variable t)
+(put 'mode-line-mule-info 'risky-local-variable t)
+(put 'mode-line-buffer-identification 'risky-local-variable t)
+(put 'mode-line-modes 'risky-local-variable t)
+(put 'mode-line-position 'risky-local-variable t)
+(put 'mode-line-process 'risky-local-variable t)
+(put 'mode-name 'risky-local-variable t)
+(put 'display-time-string 'risky-local-variable t)
+(put 'parse-time-rules 'risky-local-variable t)
+
+;; This case is safe because the user gets to check it before it is used.
+(put 'compile-command 'safe-local-variable 'stringp)
+
+(defun risky-local-variable-p (sym val)
+ "Non-nil if SYM could be dangerous as a file-local variable with value VAL.
+If VAL is nil, the question is whether any value might be dangerous."
+ (let ((safep (get sym 'safe-local-variable)))
+ (or (memq sym ignored-local-variables)
+ (get sym 'risky-local-variable)
+ (and (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|-map$\\|-map-alist$"
+ (symbol-name sym))
+ (not safep))
+ ;; If the safe-local-variable property isn't t or nil,
+ ;; then it must return non-nil on the proposed value to be safe.
+ (and (not (memq safep '(t nil)))
+ (or (null val)
+ (not (funcall safep val)))))))
+
+(defcustom safe-local-eval-forms nil
+ "*Expressions that are considered \"safe\" in an `eval:' local variable.
+Add expressions to this list if you want Emacs to evaluate them, when
+they appear in an `eval' local variable specification, without first
+asking you for confirmation."
+ :group 'find-file
+ :version "21.4"
+ :type '(repeat sexp))
+
+(put 'c-set-style 'safe-local-eval-function t)
(defun hack-one-local-variable-quotep (exp)
(and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
+(defun hack-one-local-variable-constantp (exp)
+ (or (and (not (symbolp exp)) (not (consp exp)))
+ (memq exp '(t nil))
+ (keywordp exp)
+ (hack-one-local-variable-quotep exp)))
+
+(defun hack-one-local-variable-eval-safep (exp)
+ "Return t if it is safe to eval EXP when it is found in a file."
+ (or (not (consp exp))
+ ;; Detect certain `put' expressions.
+ (and (eq (car exp) 'put)
+ (hack-one-local-variable-quotep (nth 1 exp))
+ (hack-one-local-variable-quotep (nth 2 exp))
+ (memq (nth 1 (nth 2 exp))
+ '(lisp-indent-hook))
+ ;; Only allow safe values of lisp-indent-hook;
+ ;; not functions.
+ (or (numberp (nth 3 exp))
+ (equal (nth 3 exp) ''defun)))
+ ;; Allow expressions that the user requested.
+ (member exp safe-local-eval-forms)
+ ;; Certain functions can be allowed with safe arguments
+ ;; or can specify verification functions to try.
+ (and (symbolp (car exp))
+ (let ((prop (get (car exp) 'safe-local-eval-function)))
+ (cond ((eq prop t)
+ (let ((ok t))
+ (dolist (arg (cdr exp))
+ (unless (hack-one-local-variable-constantp arg)
+ (setq ok nil)))
+ ok))
+ ((functionp prop)
+ (funcall prop exp))
+ ((listp prop)
+ (let ((ok nil))
+ (dolist (function prop)
+ (if (funcall function exp)
+ (setq ok t)))
+ ok)))))))
+
(defun hack-one-local-variable (var val)
"\"Set\" one variable in a local variables spec.
-A few variable names are treated specially."
+A few patterns are specified so that any name which matches one
+is considered risky."
(cond ((eq var 'mode)
(funcall (intern (concat (downcase (symbol-name val))
"-mode"))))
((eq var 'coding)
;; We have already handled coding: tag in set-auto-coding.
nil)
- ((memq var ignored-local-variables)
- nil)
;; "Setting" eval means either eval it or do nothing.
;; Likewise for setting hook variables.
- ((or (get var 'risky-local-variable)
- (and
- (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$"
- (symbol-name var))
- (not (get var 'safe-local-variable))))
+ ((risky-local-variable-p var val)
;; Permit evalling a put of a harmless property.
;; if the args do nothing tricky.
(if (or (and (eq var 'eval)
- (consp val)
- (eq (car val) 'put)
- (hack-one-local-variable-quotep (nth 1 val))
- (hack-one-local-variable-quotep (nth 2 val))
- ;; Only allow safe values of lisp-indent-hook;
- ;; not functions.
- (or (numberp (nth 3 val))
- (equal (nth 3 val) ''defun))
- (memq (nth 1 (nth 2 val))
- '(lisp-indent-hook)))
+ (hack-one-local-variable-eval-safep val))
;; Permit eval if not root and user says ok.
(and (not (zerop (user-uid)))
(or (eq enable-local-eval t)
(save-excursion (eval val))
(make-local-variable var)
(set var val))
- (message "Ignoring `eval:' in the local variables list")))
+ (message "Ignoring risky spec in the local variables list")))
;; Ordinary variable, really set it.
(t (make-local-variable var)
+ ;; Make sure the string has no text properties.
+ ;; Some text properties can get evaluated in various ways,
+ ;; so it is risky to put them on with a local variable list.
+ (if (stringp val)
+ (set-text-properties 0 (length val) nil val))
(set var val))))
\f
(if (eq system-type 'vax-vms)
(setq new-name (downcase new-name)))
(setq default-directory (file-name-directory buffer-file-name))
+ ;; If new-name == old-name, renaming would add a spurious <2>
+ ;; and it's considered as a feature in rename-buffer.
(or (string= new-name (buffer-name))
(rename-buffer new-name t))))
(setq buffer-backed-up nil)
(progn
(setq buffer-file-truename (abbreviate-file-name truename))
(if find-file-visit-truename
- (setq buffer-file-name buffer-file-truename))))
+ (setq buffer-file-name truename))))
(setq buffer-file-number
(if filename
(nthcdr 10 (file-attributes buffer-file-name))
nil)))
- ;; write-file-hooks is normally used for things like ftp-find-file
+ ;; write-file-functions is normally used for things like ftp-find-file
;; that visit things that are not local files as if they were files.
;; Changing to visit an ordinary local file instead should flush the hook.
- (kill-local-variable 'write-file-hooks)
+ (kill-local-variable 'write-file-functions)
(kill-local-variable 'local-write-file-hooks)
(kill-local-variable 'revert-buffer-function)
(kill-local-variable 'backup-inhibited)
(defun backup-buffer ()
"Make a backup of the disk file visited by the current buffer, if appropriate.
This is normally done before saving the buffer the first time.
-If the value is non-nil, it is the result of `file-modes' on the original
-file; this means that the caller, after saving the buffer, should change
-the modes of the new file to agree with the old modes.
A backup may be done by renaming or by copying; see documentation of
variable `make-backup-files'. If it's done by renaming, then the file is
-no longer accessible under its old name."
+no longer accessible under its old name.
+
+The value is non-nil after a backup was made by renaming.
+It has the form (MODES . BACKUPNAME).
+MODES is the result of `file-modes' on the original
+file; this means that the caller, after saving the buffer, should change
+the modes of the new file to agree with the old modes.
+BACKUPNAME is the backup file name, which is the old file renamed."
(if (and make-backup-files (not backup-inhibited)
(not buffer-backed-up)
(file-exists-p buffer-file-name)
(or (eq delete-old-versions t) (eq delete-old-versions nil))
(or delete-old-versions
(y-or-n-p (format "Delete excess backup versions of %s? "
- real-file-name))))))
+ real-file-name)))))
+ (modes (file-modes buffer-file-name)))
;; Actually write the back up file.
(condition-case ()
(if (or file-precious-flag
; (file-symlink-p buffer-file-name)
backup-by-copying
+ ;; Don't rename a suid or sgid file.
+ (and modes (< 0 (logand modes #o6000)))
(and backup-by-copying-when-linked
(> (file-nlinks real-file-name) 1))
(and (or backup-by-copying-when-mismatch
(<= (nth 2 attr) backup-by-copying-when-privileged-mismatch)))
(or (nth 9 attr)
(not (file-ownership-preserved-p real-file-name)))))))
- (condition-case ()
- (copy-file real-file-name backupname t t)
- (file-error
- ;; If copying fails because file BACKUPNAME
- ;; is not writable, delete that file and try again.
- (if (and (file-exists-p backupname)
- (not (file-writable-p backupname)))
- (delete-file backupname))
- (copy-file real-file-name backupname t t)))
+ (backup-buffer-copy real-file-name backupname modes)
;; rename-file should delete old backup.
(rename-file real-file-name backupname t)
- (setq setmodes (file-modes backupname)))
+ (setq setmodes (cons modes backupname)))
(file-error
;; If trouble writing the backup, write it in ~.
(setq backupname (expand-file-name
(message "Cannot write backup file; backing up in %s"
(file-name-nondirectory backupname))
(sleep-for 1)
- (condition-case ()
- (copy-file real-file-name backupname t t)
- (file-error
- ;; If copying fails because file BACKUPNAME
- ;; is not writable, delete that file and try again.
- (if (and (file-exists-p backupname)
- (not (file-writable-p backupname)))
- (delete-file backupname))
- (copy-file real-file-name backupname t t)))))
+ (backup-buffer-copy real-file-name backupname modes)))
(setq buffer-backed-up t)
;; Now delete the old versions, if desired.
(if delete-old-versions
setmodes)
(file-error nil))))))
+(defun backup-buffer-copy (from-name to-name modes)
+ (condition-case ()
+ (copy-file from-name to-name t t)
+ (file-error
+ ;; If copying fails because file TO-NAME
+ ;; is not writable, delete that file and try again.
+ (if (and (file-exists-p to-name)
+ (not (file-writable-p to-name)))
+ (delete-file to-name))
+ (copy-file from-name to-name t t)))
+ (set-file-modes to-name (logand modes #o1777)))
+
(defun file-name-sans-versions (name &optional keep-backup-version)
"Return file NAME sans backup versions or strings.
This is a separate procedure so your site-init or startup file can
(if (and (string-match "\\.[^.]*\\'" file)
(not (eq 0 (match-beginning 0))))
(if (setq directory (file-name-directory filename))
- (expand-file-name (substring file 0 (match-beginning 0))
- directory)
+ ;; Don't use expand-file-name here; if DIRECTORY is relative,
+ ;; we don't want to expand it.
+ (concat directory (substring file 0 (match-beginning 0)))
(substring file 0 (match-beginning 0)))
filename))))
(defun make-backup-file-name-1 (file)
"Subroutine of `make-backup-file-name' and `find-backup-file-name'."
(let ((alist backup-directory-alist)
- elt backup-directory dir-sep-string)
+ elt backup-directory)
(while alist
(setq elt (pop alist))
(if (string-match (car elt) file)
(setq backup-directory (cdr elt)
alist nil)))
- (if (null backup-directory)
- file
- (unless (file-exists-p backup-directory)
+ (if (and backup-directory (not (file-exists-p backup-directory)))
(condition-case nil
(make-directory backup-directory 'parents)
- (file-error file)))
+ (file-error (setq backup-directory nil))))
+ (if (null backup-directory)
+ file
(if (file-name-absolute-p backup-directory)
(progn
- (when (memq system-type '(windows-nt ms-dos))
- ;; Normalize DOSish file names: convert all slashes to
- ;; directory-sep-char, downcase the drive letter, if any,
- ;; and replace the leading "x:" with "/drive_x".
+ (when (memq system-type '(windows-nt ms-dos cygwin))
+ ;; Normalize DOSish file names: downcase the drive
+ ;; letter, if any, and replace the leading "x:" with
+ ;; "/drive_x".
(or (file-name-absolute-p file)
(setq file (expand-file-name file))) ; make defaults explicit
;; Replace any invalid file-name characters (for the
;; case of backing up remote files).
(setq file (expand-file-name (convert-standard-filename file)))
- (setq dir-sep-string (char-to-string directory-sep-char))
(if (eq (aref file 1) ?:)
- (setq file (concat dir-sep-string
+ (setq file (concat "/"
"drive_"
(char-to-string (downcase (aref file 0)))
- (if (eq (aref file 2) directory-sep-char)
+ (if (eq (aref file 2) ?/)
""
- dir-sep-string)
+ "/")
(substring file 2)))))
;; Make the name unique by substituting directory
;; separators. It may not really be worth bothering about
;; doubling `!'s in the original name...
(expand-file-name
(subst-char-in-string
- directory-sep-char ?!
+ ?/ ?!
(replace-regexp-in-string "!" "!!" file))
backup-directory))
(expand-file-name (file-name-nondirectory file)
"Return number of names file FILENAME has."
(car (cdr (file-attributes filename))))
+;; (defun file-relative-name (filename &optional directory)
+;; "Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
+;; This function returns a relative file name which is equivalent to FILENAME
+;; when used with that default directory as the default.
+;; If this is impossible (which can happen on MSDOS and Windows
+;; when the file name and directory use different drive names)
+;; then it returns FILENAME."
+;; (save-match-data
+;; (let ((fname (expand-file-name filename)))
+;; (setq directory (file-name-as-directory
+;; (expand-file-name (or directory default-directory))))
+;; ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
+;; ;; drive names, they can't be relative, so return the absolute name.
+;; (if (and (or (eq system-type 'ms-dos)
+;; (eq system-type 'cygwin)
+;; (eq system-type 'windows-nt))
+;; (not (string-equal (substring fname 0 2)
+;; (substring directory 0 2))))
+;; filename
+;; (let ((ancestor ".")
+;; (fname-dir (file-name-as-directory fname)))
+;; (while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir))
+;; (not (string-match (concat "^" (regexp-quote directory)) fname)))
+;; (setq directory (file-name-directory (substring directory 0 -1))
+;; ancestor (if (equal ancestor ".")
+;; ".."
+;; (concat "../" ancestor))))
+;; ;; Now ancestor is empty, or .., or ../.., etc.
+;; (if (string-match (concat "^" (regexp-quote directory)) fname)
+;; ;; We matched within FNAME's directory part.
+;; ;; Add the rest of FNAME onto ANCESTOR.
+;; (let ((rest (substring fname (match-end 0))))
+;; (if (and (equal ancestor ".")
+;; (not (equal rest "")))
+;; ;; But don't bother with ANCESTOR if it would give us `./'.
+;; rest
+;; (concat (file-name-as-directory ancestor) rest)))
+;; ;; We matched FNAME's directory equivalent.
+;; ancestor))))))
+
(defun file-relative-name (filename &optional directory)
"Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
This function returns a relative file name which is equivalent to FILENAME
when used with that default directory as the default.
-If this is impossible (which can happen on MSDOS and Windows
-when the file name and directory use different drive names)
-then it returns FILENAME."
+If FILENAME and DIRECTORY lie on different machines or on different drives
+on a DOS/Windows machine, it returns FILENAME on expanded form."
(save-match-data
- (let ((fname (expand-file-name filename)))
- (setq directory (file-name-as-directory
- (expand-file-name (or directory default-directory))))
- ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
- ;; drive names, they can't be relative, so return the absolute name.
- (if (and (or (eq system-type 'ms-dos)
- (eq system-type 'windows-nt))
- (not (string-equal (substring fname 0 2)
- (substring directory 0 2))))
+ (setq directory
+ (file-name-as-directory (expand-file-name (or directory
+ default-directory))))
+ (setq filename (expand-file-name filename))
+ (let ((hf (find-file-name-handler filename 'file-local-copy))
+ (hd (find-file-name-handler directory 'file-local-copy)))
+ (when (and hf (not (get hf 'file-remote-p))) (setq hf nil))
+ (when (and hd (not (get hd 'file-remote-p))) (setq hd nil))
+ (if ;; Conditions for separate trees
+ (or
+ ;; Test for different drives on DOS/Windows
+ (and
+ (memq system-type '(ms-dos cygwin windows-nt))
+ (not (string-equal (substring filename 0 2)
+ (substring directory 0 2))))
+ ;; Test for different remote file handlers
+ (not (eq hf hd))
+ ;; Test for different remote file system identification
+ (and
+ hf
+ (let ((re (car (rassq hf file-name-handler-alist))))
+ (not
+ (equal
+ (and
+ (string-match re filename)
+ (substring filename 0 (match-end 0)))
+ (and
+ (string-match re directory)
+ (substring directory 0 (match-end 0))))))))
filename
- (let ((ancestor ".")
- (fname-dir (file-name-as-directory fname)))
- (while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir))
- (not (string-match (concat "^" (regexp-quote directory)) fname)))
- (setq directory (file-name-directory (substring directory 0 -1))
+ (let ((ancestor ".")
+ (filename-dir (file-name-as-directory filename)))
+ (while
+ (and
+ (not (string-match (concat "\\`" (regexp-quote directory))
+ filename-dir))
+ (not (string-match (concat "\\`" (regexp-quote directory))
+ filename)))
+ (setq directory (file-name-directory (substring directory 0 -1))
ancestor (if (equal ancestor ".")
".."
(concat "../" ancestor))))
- ;; Now ancestor is empty, or .., or ../.., etc.
- (if (string-match (concat "^" (regexp-quote directory)) fname)
- ;; We matched within FNAME's directory part.
- ;; Add the rest of FNAME onto ANCESTOR.
- (let ((rest (substring fname (match-end 0))))
- (if (and (equal ancestor ".")
- (not (equal rest "")))
+ ;; Now ancestor is empty, or .., or ../.., etc.
+ (if (string-match (concat "^" (regexp-quote directory)) filename)
+ ;; We matched within FILENAME's directory part.
+ ;; Add the rest of FILENAME onto ANCESTOR.
+ (let ((rest (substring filename (match-end 0))))
+ (if (and (equal ancestor ".") (not (equal rest "")))
;; But don't bother with ANCESTOR if it would give us `./'.
rest
(concat (file-name-as-directory ancestor) rest)))
- ;; We matched FNAME's directory equivalent.
- ancestor))))))
+ ;; We matched FILENAME's directory equivalent.
+ ancestor))))))
\f
(defun save-buffer (&optional args)
"Save current buffer in visited file if modified. Versions described below.
(defun basic-save-buffer ()
"Save the current buffer in its visited file, if it has been modified.
-The hooks `write-contents-hooks', `local-write-file-hooks' and
-`write-file-hooks' get a chance to do the job of saving; if they do not,
-then the buffer is saved in the visited file file in the usual way.
+The hooks `write-contents-functions' and `write-file-functions' get a chance
+to do the job of saving; if they do not, then the buffer is saved in
+the visited file file in the usual way.
After saving the buffer, this function runs `after-save-hook'."
(interactive)
(save-current-buffer
(set-buffer (buffer-base-buffer)))
(if (buffer-modified-p)
(let ((recent-save (recent-auto-save-p))
- setmodes tempsetmodes)
+ setmodes)
;; On VMS, rename file and buffer to get rid of version number.
(if (and (eq system-type 'vax-vms)
(not (string= buffer-file-name
(save-restriction
(widen)
(save-excursion
- (and (> (point-max) 1)
+ (and (> (point-max) (point-min))
(not find-file-literally)
(/= (char-after (1- (point-max))) ?\n)
(not (and (eq selective-display t)
(insert ?\n))))
;; Support VC version backups.
(vc-before-save)
- (or (run-hook-with-args-until-success 'write-contents-hooks)
+ (or (run-hook-with-args-until-success 'write-contents-functions)
(run-hook-with-args-until-success 'local-write-file-hooks)
- (run-hook-with-args-until-success 'write-file-hooks)
+ (run-hook-with-args-until-success 'write-file-functions)
;; If a hook returned t, file is already "written".
;; Otherwise, write it the usual way now.
(setq setmodes (basic-save-buffer-1)))
(nthcdr 10 (file-attributes buffer-file-name)))
(if setmodes
(condition-case ()
- (set-file-modes buffer-file-name setmodes)
+ (set-file-modes buffer-file-name (car setmodes))
(error nil))))
;; If the auto-save file was recent before this command,
;; delete it now.
;; This does the "real job" of writing a buffer into its visited file
;; and making a backup file. This is what is normally done
-;; but inhibited if one of write-file-hooks returns non-nil.
-;; It returns a value to store in setmodes.
+;; but inhibited if one of write-file-functions returns non-nil.
+;; It returns a value (MODES . BACKUPNAME), like backup-buffer.
(defun basic-save-buffer-1 ()
(if save-buffer-coding-system
(let ((coding-system-for-write save-buffer-coding-system))
(basic-save-buffer-2))
(basic-save-buffer-2)))
+;; This returns a value (MODES . BACKUPNAME), like backup-buffer.
(defun basic-save-buffer-2 ()
(let (tempsetmodes setmodes)
(if (not (file-writable-p buffer-file-name))
;; This requires write access to the containing dir,
;; which is why we don't try it if we don't have that access.
(let ((realname buffer-file-name)
- tempname temp nogood i succeed
+ tempname nogood i succeed
(old-modtime (visited-file-modtime)))
(setq i 0)
(setq nogood t)
;; Since we have created an entirely new file
;; and renamed it, make sure it gets the
;; right permission bits set.
- (setq setmodes (file-modes buffer-file-name))
+ (setq setmodes (or setmodes (cons (file-modes buffer-file-name)
+ buffer-file-name)))
;; We succeeded in writing the temp file,
;; so rename it.
(rename-file tempname buffer-file-name t))
;; (setmodes is set) because that says we're superseding.
(cond ((and tempsetmodes (not setmodes))
;; Change the mode back, after writing.
- (setq setmodes (file-modes buffer-file-name))
- (set-file-modes buffer-file-name (logior setmodes 128))))
- (write-region (point-min) (point-max)
- buffer-file-name nil t buffer-file-truename)))
+ (setq setmodes (cons (file-modes buffer-file-name) buffer-file-name))
+ (set-file-modes buffer-file-name (logior (car setmodes) 128))))
+ (let (success)
+ (unwind-protect
+ (progn
+ (write-region (point-min) (point-max)
+ buffer-file-name nil t buffer-file-truename)
+ (setq success t))
+ ;; If we get an error writing the new file, and we made
+ ;; the backup by renaming, undo the backing-up.
+ (and setmodes (not success)
+ (rename-file (cdr setmodes) buffer-file-name))))))
setmodes))
+(defun diff-buffer-with-file (&optional buffer)
+ "View the differences between BUFFER and its associated file.
+This requires the external program `diff' to be in your `exec-path'."
+ (interactive "bBuffer: ")
+ (with-current-buffer (get-buffer (or buffer (current-buffer)))
+ (if (and buffer-file-name
+ (file-exists-p buffer-file-name))
+ (let ((tempfile (make-temp-file "buffer-content-")))
+ (unwind-protect
+ (save-restriction
+ (widen)
+ (write-region (point-min) (point-max) tempfile nil 'nomessage)
+ (diff buffer-file-name tempfile nil t)
+ (sit-for 0))
+ (when (file-exists-p tempfile)
+ (delete-file tempfile))))
+ (message "Buffer %s has no associated file on disc" (buffer-name))
+ ;; Display that message for 1 second so that user can read it
+ ;; in the minibuffer.
+ (sit-for 1)))
+ ;; return always nil, so that save-buffers-kill-emacs will not move
+ ;; over to the next unsaved buffer when calling `d'.
+ nil)
+
+(defvar save-some-buffers-action-alist
+ '((?\C-r
+ (lambda (buf)
+ (view-buffer buf
+ (lambda (ignore)
+ (exit-recursive-edit)))
+ (recursive-edit)
+ ;; Return nil to ask about BUF again.
+ nil)
+ "display the current buffer")
+ (?d diff-buffer-with-file
+ "show difference to last saved version"))
+ "ACTION-ALIST argument used in call to `map-y-or-n-p'.")
+(put 'save-some-buffers-action-alist 'risky-local-variable t)
+
(defun save-some-buffers (&optional arg pred)
"Save some modified file-visiting buffers. Asks user about each one.
+You can answer `y' to save, `n' not to save, `C-r' to look at the
+buffer in question with `view-buffer' before deciding or `d' to
+view the differences using `diff-buffer-to-file'.
+
Optional argument (the prefix) non-nil means save all with no questions.
Optional second argument PRED determines which buffers are considered:
If PRED is nil, all the file-visiting buffers are considered.
If PRED is t, then certain non-file buffers will also be considered.
If PRED is a zero-argument function, it indicates for each buffer whether
-to consider it or not when called with that buffer current."
+to consider it or not when called with that buffer current.
+
+See `save-some-buffers-action-alist' if you want to
+change the additional actions you can take on files."
(interactive "P")
(save-window-excursion
(let* ((queried nil)
(save-buffer)))
(buffer-list)
'("buffer" "buffers" "save")
- (list (list ?\C-r (lambda (buf)
- (view-buffer buf
- (function
- (lambda (ignore)
- (exit-recursive-edit))))
- (recursive-edit)
- ;; Return nil to ask about BUF again.
- nil)
- "display the current buffer"))))
+ save-some-buffers-action-alist))
(abbrevs-done
(and save-abbrevs abbrevs-changed
(progn
With arg, set read-only iff arg is positive.
If visiting file read-only and `view-read-only' is non-nil, enter view mode."
(interactive "P")
- (cond
- ((and arg (if (> (prefix-numeric-value arg) 0) buffer-read-only
- (not buffer-read-only))) ; If buffer-read-only is set correctly,
- nil) ; do nothing.
- ;; Toggle.
- ((and buffer-read-only view-mode)
- (View-exit-and-edit)
- (make-local-variable 'view-read-only)
- (setq view-read-only t)) ; Must leave view mode.
- ((and (not buffer-read-only) view-read-only
- (not (eq (get major-mode 'mode-class) 'special)))
- (view-mode-enter))
- (t (setq buffer-read-only (not buffer-read-only))
- (force-mode-line-update))))
+ (if (and arg
+ (if (> (prefix-numeric-value arg) 0) buffer-read-only
+ (not buffer-read-only))) ; If buffer-read-only is set correctly,
+ nil ; do nothing.
+ ;; Toggle.
+ (cond
+ ((and buffer-read-only view-mode)
+ (View-exit-and-edit)
+ (make-local-variable 'view-read-only)
+ (setq view-read-only t)) ; Must leave view mode.
+ ((and (not buffer-read-only) view-read-only
+ ;; If view-mode is already active, `view-mode-enter' is a nop.
+ (not view-mode)
+ (not (eq (get major-mode 'mode-class) 'special)))
+ (view-mode-enter))
+ (t (setq buffer-read-only (not buffer-read-only))
+ (force-mode-line-update)))
+ (if (vc-backend buffer-file-name)
+ (message (substitute-command-keys
+ (concat "File is under version-control; "
+ "use \\[vc-next-action] to check in/out"))))))
(defun insert-file (filename)
"Insert contents of file FILENAME into buffer after point.
Don't call it from programs! Use `insert-file-contents' instead.
\(Its calling sequence is different; see its documentation)."
(interactive "*fInsert file: ")
- (if (file-directory-p filename)
- (signal 'file-error (list "Opening input file" "file is a directory"
- filename)))
- (let ((tem (insert-file-contents filename)))
- (push-mark (+ (point) (car (cdr tem))))))
+ (insert-file-1 filename #'insert-file-contents))
(defun append-to-file (start end filename)
"Append the contents of the region to the end of file FILENAME.
;; `make-backup-file-name' will get us the right directory for
;; ordinary or numeric backups. It might create a directory for
;; backups as a side-effect, according to `backup-directory-alist'.
- (let* ((filename (make-backup-file-name filename))
+ (let* ((filename (file-name-sans-versions
+ (make-backup-file-name filename)))
(file (file-name-nondirectory filename))
(dir (file-name-directory filename))
(comp (file-name-all-completions file dir))
That is useful when you have visited a file in a nonexistent directory.
Noninteractively, the second (optional) argument PARENTS says whether
-to create parent directories if they don't exist."
+to create parent directories if they don't exist. Interactively,
+this happens by default."
(interactive
(list (read-file-name "Make directory: " default-directory default-directory
nil nil)
t))
+ ;; If default-directory is a remote directory,
+ ;; make sure we find its make-directory handler.
+ (setq dir (expand-file-name dir))
(let ((handler (find-file-name-handler dir 'make-directory)))
(if handler
(funcall handler 'make-directory dir parents)
This command also works for special buffers that contain text which
doesn't come from a file, but reflects some other data base instead:
-for example, Dired buffers and buffer-list buffers. In these cases,
+for example, Dired buffers and `buffer-list' buffers. In these cases,
it reconstructs the buffer contents from the appropriate data base.
When called from Lisp, the first argument is IGNORE-AUTO; only offer
(funcall revert-buffer-insert-file-contents-function
file-name auto-save-p)
(if (not (file-exists-p file-name))
- (error "File %s no longer exists!" file-name))
+ (error (if buffer-file-number
+ "File %s no longer exists!"
+ "Cannot revert nonexistent file %s")
+ file-name))
;; Bind buffer-file-name to nil
;; so that we don't try to lock the file.
(let ((buffer-file-name nil))
(let ((coding-system-for-read
;; Auto-saved file shoule be read without
;; any code conversion.
- (if auto-save-p 'emacs-mule-unix
- (if auto-save-p 'utf-8-emacs-unix
- coding-system-for-read)))
++ (if auto-save-p 'utf-8-emacs
+ (or coding-system-for-read
+ buffer-file-coding-system))))
+ ;; This force after-insert-file-set-coding
+ ;; (called from insert-file-contents) to set
+ ;; buffer-file-coding-system to a proper value.
+ (kill-local-variable 'buffer-file-coding-system)
+
;; Note that this preserves point in an intelligent way.
- (insert-file-contents file-name (not auto-save-p)
- nil nil t))))
+ (if preserve-modes
+ (let ((buffer-file-format buffer-file-format))
+ (insert-file-contents file-name (not auto-save-p)
+ nil nil t))
+ (insert-file-contents file-name (not auto-save-p)
+ nil nil t)))))
;; Recompute the truename in case changes in symlinks
;; have changed the truename.
(setq buffer-file-truename
;; Run after-revert-hook as it was before we reverted.
(setq-default revert-buffer-internal-hook global-hook)
(if local-hook-p
- (progn
- (make-local-variable 'revert-buffer-internal-hook)
- (setq revert-buffer-internal-hook local-hook))
+ (set (make-local-variable 'revert-buffer-internal-hook)
+ local-hook)
(kill-local-variable 'revert-buffer-internal-hook))
(run-hooks 'revert-buffer-internal-hook))
t)))))
+(defun recover-this-file ()
+ "Recover the visited file--get contents from its last auto-save file."
+ (interactive)
+ (recover-file buffer-file-name))
+
(defun recover-file (file)
"Visit file FILE, but get contents from its last auto-save file."
;; Actually putting the file name in the minibuffer should be used
(interactive "FRecover file: ")
(setq file (expand-file-name file))
(if (auto-save-file-name-p (file-name-nondirectory file))
- (error "%s is an auto-save file" file))
+ (error "%s is an auto-save file" (abbreviate-file-name file)))
(let ((file-name (let ((buffer-file-name file))
(make-auto-save-file-name))))
(cond ((if (file-exists-p file)
(not (file-newer-than-file-p file-name file))
(not (file-exists-p file-name)))
- (error "Auto-save file %s not current" file-name))
+ (error "Auto-save file %s not current"
+ (abbreviate-file-name file-name)))
((save-window-excursion
(with-output-to-temp-buffer "*Directory*"
(buffer-disable-undo standard-output)
(let ((buffer-read-only nil)
;; Keep the current buffer-file-coding-system.
(coding-system buffer-file-coding-system)
- ;; Auto-saved file shoule be read without any code conversion.
- (coding-system-for-read 'utf-8-emacs-unix))
+ ;; Auto-saved file shoule be read with special coding.
+ (coding-system-for-read 'auto-save-coding))
(erase-buffer)
(insert-file-contents file-name nil)
(set-buffer-file-coding-system coding-system))
(error "You set `auto-save-list-file-prefix' to disable making session files"))
(let ((dir (file-name-directory auto-save-list-file-prefix)))
(unless (file-directory-p dir)
- (make-directory dir t)))
+ (make-directory dir t))
+ (unless (directory-files dir nil
+ (concat "\\`" (regexp-quote
+ (file-name-nondirectory
+ auto-save-list-file-prefix)))
+ t)
+ (error "No previous sessions to recover")))
(let ((ls-lisp-support-shell-wildcards t))
(dired (concat auto-save-list-file-prefix "*")
(concat dired-listing-switches "t")))
;; a "visited file name" from that.
(progn
(forward-line 1)
- (setq autofile
- (buffer-substring-no-properties
- (point)
- (save-excursion
- (end-of-line)
- (point))))
- (setq thisfile
- (expand-file-name
- (substring
- (file-name-nondirectory autofile)
- 1 -1)
- (file-name-directory autofile)))
+ ;; If there is no auto-save file name, the
+ ;; auto-save-list file is probably corrupted.
+ (unless (eolp)
+ (setq autofile
+ (buffer-substring-no-properties
+ (point)
+ (save-excursion
+ (end-of-line)
+ (point))))
+ (setq thisfile
+ (expand-file-name
+ (substring
+ (file-name-nondirectory autofile)
+ 1 -1)
+ (file-name-directory autofile))))
(forward-line 1))
;; This pair of lines is a file-visiting
;; buffer. Use the visited file name.
(point) (progn (end-of-line) (point))))
(forward-line 1)))
;; Ignore a file if its auto-save file does not exist now.
- (if (file-exists-p autofile)
+ (if (and autofile (file-exists-p autofile))
(setq files (cons thisfile files)))))
(setq files (nreverse files))
;; The file contains a pair of line for each auto-saved buffer.
(if buffer-file-name
(let ((list auto-save-file-name-transforms)
(filename buffer-file-name)
- result)
+ result uniq)
;; Apply user-specified translations
;; to the file name.
(while (and list (not result))
(if (string-match (car (car list)) filename)
(setq result (replace-match (cadr (car list)) t nil
- filename)))
+ filename)
+ uniq (car (cddr (car list)))))
(setq list (cdr list)))
- (if result (setq filename result))
-
- (if (and (eq system-type 'ms-dos)
- (not (msdos-long-file-names)))
- ;; We truncate the file name to DOS 8+3 limits before
- ;; doing anything else, because the regexp passed to
- ;; string-match below cannot handle extensions longer than
- ;; 3 characters, multiple dots, and other atrocities.
- (let ((fn (dos-8+3-filename
- (file-name-nondirectory buffer-file-name))))
- (string-match "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" fn)
- (concat (file-name-directory buffer-file-name)
- "#" (match-string 1 fn)
- "." (match-string 3 fn) "#"))
- (concat (file-name-directory filename)
- "#"
- (file-name-nondirectory filename)
- "#")))
+ (if result
+ (if uniq
+ (setq filename (concat
+ (file-name-directory result)
+ (subst-char-in-string
+ ?/ ?!
+ (replace-regexp-in-string "!" "!!"
+ filename))))
+ (setq filename result)))
+ (setq result
+ (if (and (eq system-type 'ms-dos)
+ (not (msdos-long-file-names)))
+ ;; We truncate the file name to DOS 8+3 limits
+ ;; before doing anything else, because the regexp
+ ;; passed to string-match below cannot handle
+ ;; extensions longer than 3 characters, multiple
+ ;; dots, and other atrocities.
+ (let ((fn (dos-8+3-filename
+ (file-name-nondirectory buffer-file-name))))
+ (string-match
+ "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
+ fn)
+ (concat (file-name-directory buffer-file-name)
+ "#" (match-string 1 fn)
+ "." (match-string 3 fn) "#"))
+ (concat (file-name-directory filename)
+ "#"
+ (file-name-nondirectory filename)
+ "#")))
+ ;; Make sure auto-save file names don't contain characters
+ ;; invalid for the underlying filesystem.
+ (if (and (memq system-type '(ms-dos windows-nt))
+ ;; Don't modify remote (ange-ftp) filenames
+ (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result)))
+ (convert-standard-filename result)
+ result))
;; Deal with buffers that don't have any associated files. (Mail
;; mode tends to create a good number of these.)
(let ((buffer-name (buffer-name))
- (limit 0))
+ (limit 0)
+ file-name)
;; Eliminate all slashes and backslashes by
;; replacing them with sequences that start with %.
;; Quote % also, to keep distinct names distinct.
(setq buffer-name (replace-match replacement t t buffer-name))
(setq limit (1+ (match-end 0)))))
;; Generate the file name.
- (expand-file-name
- (format "#%s#%s#" buffer-name (make-temp-name ""))
- ;; Try a few alternative directories, to get one we can write it.
- (cond
- ((file-writable-p default-directory) default-directory)
- ((file-writable-p "/var/tmp/") "/var/tmp/")
- ("~/"))))))
+ (setq file-name
+ (make-temp-file
+ (let ((fname
+ (expand-file-name
+ (format "#%s#" buffer-name)
+ ;; Try a few alternative directories, to get one we can
+ ;; write it.
+ (cond
+ ((file-writable-p default-directory) default-directory)
+ ((file-writable-p "/var/tmp/") "/var/tmp/")
+ ("~/")))))
+ (if (and (memq system-type '(ms-dos windows-nt))
+ ;; Don't modify remote (ange-ftp) filenames
+ (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" fname)))
+ ;; The call to convert-standard-filename is in case
+ ;; buffer-name includes characters not allowed by the
+ ;; DOS/Windows filesystems. make-temp-file writes to the
+ ;; file it creates, so we must fix the file name _before_
+ ;; make-temp-file is called.
+ (convert-standard-filename fname)
+ fname))
+ nil "#"))
+ ;; make-temp-file creates the file,
+ ;; but we don't want it to exist until we do an auto-save.
+ (condition-case ()
+ (delete-file file-name)
+ (file-error nil))
+ file-name)))
(defun auto-save-file-name-p (filename)
"Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
relative to the current default directory, `default-directory'.
The file names returned are normally also relative to the current
default directory. However, if FULL is non-nil, they are absolute."
- (let* ((nondir (file-name-nondirectory pattern))
- (dirpart (file-name-directory pattern))
- ;; A list of all dirs that DIRPART specifies.
- ;; This can be more than one dir
- ;; if DIRPART contains wildcards.
- (dirs (if (and dirpart (string-match "[[*?]" dirpart))
- (mapcar 'file-name-as-directory
- (file-expand-wildcards (directory-file-name dirpart)))
- (list dirpart)))
- contents)
- (while dirs
- (when (or (null (car dirs)) ; Possible if DIRPART is not wild.
- (file-directory-p (directory-file-name (car dirs))))
- (let ((this-dir-contents
- ;; Filter out "." and ".."
- (delq nil
- (mapcar #'(lambda (name)
- (unless (string-match "\\`\\.\\.?\\'"
- (file-name-nondirectory name))
- name))
- (directory-files (or (car dirs) ".") full
- (wildcard-to-regexp nondir))))))
- (setq contents
- (nconc
- (if (and (car dirs) (not full))
- (mapcar (function (lambda (name) (concat (car dirs) name)))
- this-dir-contents)
- this-dir-contents)
- contents))))
- (setq dirs (cdr dirs)))
- contents))
+ (save-match-data
+ (let* ((nondir (file-name-nondirectory pattern))
+ (dirpart (file-name-directory pattern))
+ ;; A list of all dirs that DIRPART specifies.
+ ;; This can be more than one dir
+ ;; if DIRPART contains wildcards.
+ (dirs (if (and dirpart (string-match "[[*?]" dirpart))
+ (mapcar 'file-name-as-directory
+ (file-expand-wildcards (directory-file-name dirpart)))
+ (list dirpart)))
+ contents)
+ (while dirs
+ (when (or (null (car dirs)) ; Possible if DIRPART is not wild.
+ (file-directory-p (directory-file-name (car dirs))))
+ (let ((this-dir-contents
+ ;; Filter out "." and ".."
+ (delq nil
+ (mapcar #'(lambda (name)
+ (unless (string-match "\\`\\.\\.?\\'"
+ (file-name-nondirectory name))
+ name))
+ (directory-files (or (car dirs) ".") full
+ (wildcard-to-regexp nondir))))))
+ (setq contents
+ (nconc
+ (if (and (car dirs) (not full))
+ (mapcar (function (lambda (name) (concat (car dirs) name)))
+ this-dir-contents)
+ this-dir-contents)
+ contents))))
+ (setq dirs (cdr dirs)))
+ contents)))
(defun list-directory (dirname &optional verbose)
"Display a list of files in or matching DIRNAME, a la `ls'.
nil default-directory nil)
pfx)))
(let ((switches (if verbose list-directory-verbose-switches
- list-directory-brief-switches)))
+ list-directory-brief-switches))
+ buffer)
(or dirname (setq dirname default-directory))
(setq dirname (expand-file-name dirname))
(with-output-to-temp-buffer "*Directory*"
+ (setq buffer standard-output)
(buffer-disable-undo standard-output)
(princ "Directory ")
(princ dirname)
(terpri)
(save-excursion
(set-buffer "*Directory*")
- (setq default-directory
- (if (file-directory-p dirname)
- (file-name-as-directory dirname)
- (file-name-directory dirname)))
(let ((wildcard (not (file-directory-p dirname))))
- (insert-directory dirname switches wildcard (not wildcard)))))))
+ (insert-directory dirname switches wildcard (not wildcard)))))
+ ;; Finishing with-output-to-temp-buffer seems to clobber default-directory.
+ (with-current-buffer buffer
+ (setq default-directory
+ (if (file-directory-p dirname)
+ (file-name-as-directory dirname)
+ (file-name-directory dirname))))))
(defun shell-quote-wildcard-pattern (pattern)
"Quote characters special to the shell in PATTERN, leave wildcards alone.
PATTERN that already quotes some of the special characters."
(save-match-data
(cond
- ((memq system-type '(ms-dos windows-nt))
+ ((memq system-type '(ms-dos windows-nt cygwin))
;; DOS/Windows don't allow `"' in file names. So if the
;; argument has quotes, we can safely assume it is already
;; quoted by the caller.
:type '(choice (string :tag "Program") (const :tag "None" nil))
:group 'dired)
-(defcustom directory-free-space-args "-Pk"
+(defcustom directory-free-space-args
+ (if (eq system-type 'darwin) "-k" "-Pk")
"*Options to use when running `directory-free-space-program'."
:type 'string
:group 'dired)
;; dired-insert-headerline
;; dired-after-subdir-garbage (defines what a "total" line is)
;; - variable dired-subdir-regexp
+;; - may be passed "--dired" as the first argument in SWITCHES.
+;; Filename handlers might have to remove this switch if their
+;; "ls" command does not support it.
(defun insert-directory (file switches &optional wildcard full-directory-p)
"Insert directory listing for FILE, formatted according to SWITCHES.
Leaves point after the inserted text.
wildcard full-directory-p)
(if (eq system-type 'vax-vms)
(vms-read-directory file switches (current-buffer))
- (let (result available)
+ (let (result (beg (point)))
;; Read the actual directory using `insert-directory-program'.
;; RESULT gets the status code.
- (let ((coding-system-for-read
- (and enable-multibyte-characters
- (or file-name-coding-system
- default-file-name-coding-system)))
- ;; This is to control encoding the arguments in call-process.
- (coding-system-for-write coding-system-for-read))
+ (let* (;; We at first read by no-conversion, then after
+ ;; putting text property `dired-filename, decode one
+ ;; bunch by one to preserve that property.
+ (coding-system-for-read 'no-conversion)
+ ;; This is to control encoding the arguments in call-process.
+ (coding-system-for-write
+ (and enable-multibyte-characters
+ (or file-name-coding-system
+ default-file-name-coding-system))))
(setq result
(if wildcard
;; Run ls in the directory part of the file pattern
(access-file file "Reading directory")
(error "Listing directory failed but `access-file' worked")))
- ;; Try to insert the amount of free space.
- (save-excursion
- (goto-char (point-min))
- ;; First find the line to put it on.
- (when (re-search-forward "^total" nil t)
- (let ((available (get-free-disk-space ".")))
- (when available
- ;; Replace "total" with "used", to avoid confusion.
- (replace-match "total used in directory")
- (end-of-line)
- (insert " available " available))))))))))
+ (when (string-match "--dired\\>" switches)
+ (forward-line -2)
+ (when (looking-at "//SUBDIRED//")
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (forward-line -1))
+ (let ((end (line-end-position)))
+ (forward-word 1)
+ (forward-char 3)
+ (while (< (point) end)
+ (let ((start (+ beg (read (current-buffer))))
+ (end (+ beg (read (current-buffer)))))
+ (if (= (char-after end) ?\n)
+ (put-text-property start end 'dired-filename t)
+ ;; It seems that we can't trust ls's output as to
+ ;; byte positions of filenames.
+ (put-text-property beg (point) 'dired-filename nil)
+ (end-of-line))))
+ (goto-char end)
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 2) (point)))))
+
+ ;; Now decode what read if necessary.
+ (let ((coding (or coding-system-for-read
+ file-name-coding-system
+ default-file-name-coding-system
+ 'undecided))
+ coding-no-eol
+ val pos)
+ (when (and enable-multibyte-characters
+ (not (memq (coding-system-base coding)
+ '(raw-text no-conversion))))
+ ;; If no coding system is specified or detection is
+ ;; requested, detect the coding.
+ (if (eq (coding-system-base coding) 'undecided)
+ (setq coding (detect-coding-region beg (point) t)))
+ (if (not (eq (coding-system-base coding) 'undecided))
+ (save-restriction
+ (setq coding-no-eol
+ (coding-system-change-eol-conversion coding 'unix))
+ (narrow-to-region beg (point))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq pos (point)
+ val (get-text-property (point) 'dired-filename))
+ (goto-char (next-single-property-change
+ (point) 'dired-filename nil (point-max)))
+ ;; Force no eol conversion on a file name, so
+ ;; that CR is preserved.
+ (decode-coding-region pos (point)
+ (if val coding-no-eol coding))
+ (if val
+ (put-text-property pos (point)
+ 'dired-filename t)))))))
+
+ (if full-directory-p
+ ;; Try to insert the amount of free space.
+ (save-excursion
+ (goto-char beg)
+ ;; First find the line to put it on.
+ (when (re-search-forward "^ *\\(total\\)" nil t)
+ (let ((available (get-free-disk-space ".")))
+ (when available
+ ;; Replace "total" with "used", to avoid confusion.
+ (replace-match "total used in directory" nil nil nil 1)
+ (end-of-line)
+ (insert " available " available)))))))))))
(defun insert-directory-safely (file switches
&optional wildcard full-directory-p)
(let ((processes (process-list))
active)
(while processes
- (and (memq (process-status (car processes)) '(run stop open))
- (let ((val (process-kill-without-query (car processes))))
- (process-kill-without-query (car processes) val)
- val)
+ (and (memq (process-status (car processes)) '(run stop open listen))
+ (process-query-on-exit-flag (car processes))
(setq active t))
(setq processes (cdr processes)))
(or (not active)
- (list-processes)
+ (list-processes t)
(yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
;; Query the user for other things, perhaps.
(run-hook-with-args-until-failure 'kill-emacs-query-functions)
;; `identity' means just return the first arg
;; as stripped of its quoting.
(substitute-in-file-name . identity)
- (file-name-completion 0 1)
- (file-name-all-completions 0 1)
+ (file-name-completion 1)
+ (file-name-all-completions 1)
(rename-file 0 1)
(copy-file 0 1)
(make-symbolic-link 0 1)
(setq file-arg-indices (cdr file-arg-indices))))
(if (eq file-arg-indices 'identity)
(car arguments)
- (let ((value (apply operation arguments)))
- (cond ((memq operation '(file-name-completion))
- (and value (concat "/:" value)))
- ((memq operation '(file-name-all-completions))
- (mapcar (lambda (name) (concat "/:" name)) value))
- (t value))))))
+ (apply operation arguments))))
\f
(define-key ctl-x-map "\C-f" 'find-file)
(define-key ctl-x-map "\C-r" 'find-file-read-only)
(define-key esc-map "~" 'not-modified)
(define-key ctl-x-map "\C-d" 'list-directory)
(define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs)
+(define-key ctl-x-map "\C-q" 'toggle-read-only)
(define-key ctl-x-4-map "f" 'find-file-other-window)
(define-key ctl-x-4-map "r" 'find-file-read-only-other-window)
;;; font-lock.el --- Electric font lock mode
-;; Copyright (C) 1992, 93, 94, 95, 96, 97, 98, 1999, 2000, 2001
+;; Copyright (C) 1992, 93, 94, 95, 96, 97, 98, 1999, 2000, 2001, 02, 2003
;; Free Software Foundation, Inc.
;; Author: jwz, then rms, then sm
;; "Default expressions to highlight in Foo mode.")
;;
;; (add-hook 'foo-mode-hook
-;; (function (lambda ()
-;; (make-local-variable 'font-lock-defaults)
-;; (setq font-lock-defaults '(foo-font-lock-keywords t)))))
+;; (lambda ()
+;; (make-local-variable 'font-lock-defaults)
+;; (setq font-lock-defaults '(foo-font-lock-keywords t))))
;;; Adding Font Lock support for modes:
(defvar font-lock-warning-face 'font-lock-warning-face
"Face name to use for things that should stand out.")
-(defvar font-lock-reference-face 'font-lock-constant-face
- "This variable is obsolete. Use `font-lock-constant-face'.")
+(defvar font-lock-preprocessor-face 'font-lock-preprocessor-face
+ "Face name to use for preprocessor directives.")
+
+(defvar font-lock-reference-face 'font-lock-constant-face)
+(make-obsolete-variable 'font-lock-reference-face 'font-lock-constant-face)
;; Fontification variables:
Be careful when composing regexps for this list; a poorly written pattern can
dramatically slow things down!")
-;; This variable is used by mode packages that support Font Lock mode by
-;; defining their own keywords to use for `font-lock-keywords'. (The mode
-;; command should make it buffer-local and set it to provide the set up.)
-(defvar font-lock-defaults nil
- "Defaults for Font Lock mode specified by the major mode.
-Defaults should be of the form:
-
- (KEYWORDS KEYWORDS-ONLY CASE-FOLD SYNTAX-ALIST SYNTAX-BEGIN ...)
-
-KEYWORDS may be a symbol (a variable or function whose value is the keywords to
-use for fontification) or a list of symbols. If KEYWORDS-ONLY is non-nil,
-syntactic fontification (strings and comments) is not performed.
-If CASE-FOLD is non-nil, the case of the keywords is ignored when fontifying.
-If SYNTAX-ALIST is non-nil, it should be a list of cons pairs of the form
-\(CHAR-OR-STRING . STRING) used to set the local Font Lock syntax table, for
-keyword and syntactic fontification (see `modify-syntax-entry').
-
-If SYNTAX-BEGIN is non-nil, it should be a function with no args used to move
-backwards outside any enclosing syntactic block, for syntactic fontification.
-Typical values are `beginning-of-line' (i.e., the start of the line is known to
-be outside a syntactic block), or `beginning-of-defun' for programming modes or
-`backward-paragraph' for textual modes (i.e., the mode-dependent function is
-known to move outside a syntactic block). If nil, the beginning of the buffer
-is used as a position outside of a syntactic block, in the worst case.
-
-These item elements are used by Font Lock mode to set the variables
-`font-lock-keywords', `font-lock-keywords-only',
-`font-lock-keywords-case-fold-search', `font-lock-syntax-table' and
-`font-lock-beginning-of-syntax-function', respectively.
-
-Further item elements are alists of the form (VARIABLE . VALUE) and are in no
-particular order. Each VARIABLE is made buffer-local before set to VALUE.
-
-Currently, appropriate variables include `font-lock-mark-block-function'.
-If this is non-nil, it should be a function with no args used to mark any
-enclosing block of text, for fontification via \\[font-lock-fontify-block].
-Typical values are `mark-defun' for programming modes or `mark-paragraph' for
-textual modes (i.e., the mode-dependent function is known to put point and mark
-around a text block relevant to that mode).
-
-Other variables include that for syntactic keyword fontification,
-`font-lock-syntactic-keywords'
-and those for buffer-specialised fontification functions,
-`font-lock-fontify-buffer-function', `font-lock-unfontify-buffer-function',
-`font-lock-fontify-region-function', `font-lock-unfontify-region-function',
-`font-lock-inhibit-thing-lock' and `font-lock-maximum-size'.")
-;;;###autoload
-(make-variable-buffer-local 'font-lock-defaults)
-
-;; This variable is used where font-lock.el itself supplies the keywords.
-(defvar font-lock-defaults-alist
- (let (;; We use `beginning-of-defun', rather than nil, for SYNTAX-BEGIN.
- ;; Thus the calculation of the cache is usually faster but not
- ;; infallible, so we risk mis-fontification. sm.
- (c-mode-defaults
- '((c-font-lock-keywords c-font-lock-keywords-1
- c-font-lock-keywords-2 c-font-lock-keywords-3)
- nil nil ((?_ . "w")) beginning-of-defun
- (font-lock-syntactic-face-function
- . c-font-lock-syntactic-face-function)
- (font-lock-mark-block-function . mark-defun)))
- (c++-mode-defaults
- '((c++-font-lock-keywords c++-font-lock-keywords-1
- c++-font-lock-keywords-2 c++-font-lock-keywords-3)
- nil nil ((?_ . "w")) beginning-of-defun
- (font-lock-syntactic-face-function
- . c-font-lock-syntactic-face-function)
- (font-lock-mark-block-function . mark-defun)))
- (objc-mode-defaults
- '((objc-font-lock-keywords objc-font-lock-keywords-1
- objc-font-lock-keywords-2 objc-font-lock-keywords-3)
- nil nil ((?_ . "w") (?$ . "w")) nil
- (font-lock-syntactic-face-function
- . c-font-lock-syntactic-face-function)
- (font-lock-mark-block-function . mark-defun)))
- (java-mode-defaults
- '((java-font-lock-keywords java-font-lock-keywords-1
- java-font-lock-keywords-2 java-font-lock-keywords-3)
- nil nil ((?_ . "w") (?$ . "w")) nil
- (font-lock-syntactic-face-function
- . java-font-lock-syntactic-face-function)
- (font-lock-mark-block-function . mark-defun))))
- (list
- (cons 'c-mode c-mode-defaults)
- (cons 'c++-mode c++-mode-defaults)
- (cons 'objc-mode objc-mode-defaults)
- (cons 'java-mode java-mode-defaults)))
- "Alist of fall-back Font Lock defaults for major modes.
-
-This variable should not be used any more.
-Set the buffer-local `font-lock-keywords' in the major mode instead.
-
-Each item should be a list of the form:
-
- (MAJOR-MODE . FONT-LOCK-DEFAULTS)
-
-where MAJOR-MODE is a symbol and FONT-LOCK-DEFAULTS is a list of default
-settings. See the variable `font-lock-defaults', which takes precedence.")
-(make-obsolete-variable 'font-lock-defaults-alist 'font-lock-defaults)
-
(defvar font-lock-keywords-alist nil
"*Alist of `font-lock-keywords' local to a `major-mode'.
This is normally set via `font-lock-add-keywords' and
This is normally set via `font-lock-defaults'.")
(defvar font-lock-beginning-of-syntax-function nil
- "*Non-nil means use this function to move back outside of a syntactic block.
-When called with no args it should leave point at the beginning of any
-enclosing syntactic block.
-If this is nil, the beginning of the buffer is used (in the worst case).
+ "*Non-nil means use this function to move back outside all constructs.
+When called with no args it should move point backward to a place which
+is not in a string or comment and not within any bracket-pairs (or else,
+a place such that any bracket-pairs outside it can be ignored for Emacs
+syntax analysis and fontification).
+
+If this is nil, the beginning of the buffer is used, which is
+always correct but tends to be slow.
This is normally set via `font-lock-defaults'.
-It is preferable to set `syntax-begin-function' instead.")
+This variable is semi-obsolete; we recommend setting
+`syntax-begin-function' instead.")
(defvar font-lock-mark-block-function nil
"*Non-nil means use this function to mark a block of text.
;; 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))))
+ (let ((modified (make-symbol "modified")))
+ `(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))
+ (progn
+ ,@body)
+ (unless ,modified
+ (restore-buffer-modified-p nil)))))
(put 'save-buffer-state 'lisp-indent-function 1)
(def-edebug-spec save-buffer-state let)
;;
(defvar font-lock-face-attributes)) ; Obsolete but respected if set.
;;;###autoload
-(define-minor-mode font-lock-mode
- "Toggle Font Lock mode.
-With arg, turn Font Lock mode off if and only if arg is a non-positive
-number; if arg is nil, toggle Font Lock mode; anything else turns Font
-Lock on.
-\(Font Lock is also known as \"syntax highlighting\".)
-
-When Font Lock mode is enabled, text is fontified as you type it:
-
- - Comments are displayed in `font-lock-comment-face';
- - Strings are displayed in `font-lock-string-face';
- - Certain other expressions are displayed in other faces according to the
- value of the variable `font-lock-keywords'.
-
-To customize the faces (colors, fonts, etc.) used by Font Lock for
-fontifying different parts of buffer text, use \\[customize-face].
-
-You can enable Font Lock mode in any major mode automatically by turning on in
-the major mode's hook. For example, put in your ~/.emacs:
-
- (add-hook 'c-mode-hook 'turn-on-font-lock)
-
-Alternatively, you can use Global Font Lock mode to automagically turn on Font
-Lock mode in buffers whose major mode supports it and whose major mode is one
-of `font-lock-global-modes'. For example, put in your ~/.emacs:
-
- (global-font-lock-mode t)
-
-There are a number of support modes that may be used to speed up Font Lock mode
-in various ways, specified via the variable `font-lock-support-mode'. Where
-major modes support different levels of fontification, you can use the variable
-`font-lock-maximum-decoration' to specify which level you generally prefer.
-When you turn Font Lock mode on/off the buffer is fontified/defontified, though
-fontification occurs only if the buffer is less than `font-lock-maximum-size'.
-
-For example, to specify that Font Lock mode use use Lazy Lock mode as a support
-mode and use maximum levels of fontification, put in your ~/.emacs:
-
- (setq font-lock-support-mode 'lazy-lock-mode)
- (setq font-lock-maximum-decoration t)
-
-To add your own highlighting for some major mode, and modify the highlighting
-selected automatically via the variable `font-lock-maximum-decoration', you can
-use `font-lock-add-keywords'.
-
-To fontify a buffer, without turning on Font Lock mode and regardless of buffer
-size, you can use \\[font-lock-fontify-buffer].
-
-To fontify a block (the function or paragraph containing point, or a number of
-lines around point), perhaps because modification on the current line caused
-syntactic change on other lines, you can use \\[font-lock-fontify-block].
-
-See the variable `font-lock-defaults-alist' for the Font Lock mode default
-settings. You can set your own default settings for some mode, by setting a
-buffer local value for `font-lock-defaults', via its mode hook."
- nil nil nil
- ;; Don't turn on Font Lock mode if we don't have a display (we're running a
- ;; batch job) or if the buffer is invisible (the name starts with a space).
- (when (or noninteractive (eq (aref (buffer-name) 0) ?\ ))
- (setq font-lock-mode nil))
-
+(defun font-lock-mode-internal (arg)
;; Turn on Font Lock mode.
- (when font-lock-mode
+ (when arg
(add-hook 'after-change-functions 'font-lock-after-change-function t t)
(font-lock-set-defaults)
(font-lock-turn-on-thing-lock)
(font-lock-unfontify-buffer)
(font-lock-turn-off-thing-lock)))
-;;;###autoload
-(defun turn-on-font-lock ()
- "Turn on Font Lock mode (only if the terminal can display it)."
- (unless font-lock-mode
- (font-lock-mode)))
-
;;;###autoload
(defun font-lock-add-keywords (mode keywords &optional append)
"Add highlighting KEYWORDS for MODE.
to use nil for MODE (and place the call in a loop or on a hook) to avoid
subtle problems due to details of the implementation.
-Note that some modes have specialised support for additional patterns, e.g.,
+Note that some modes have specialized support for additional patterns, e.g.,
see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types',
`objc-font-lock-extra-types' and `java-font-lock-extra-types'."
(cond (mode
(delete (font-lock-compile-keyword keyword)
font-lock-keywords)))))))
\f
-;;; Global Font Lock mode.
-
-;; A few people have hassled in the past for a way to make it easier to turn on
-;; Font Lock mode, without the user needing to know for which modes s/he has to
-;; turn it on, perhaps the same way hilit19.el/hl319.el does. I've always
-;; balked at that way, as I see it as just re-moulding the same problem in
-;; another form. That is; some person would still have to keep track of which
-;; modes (which may not even be distributed with Emacs) support Font Lock mode.
-;; The list would always be out of date. And that person might have to be me.
-
-;; Implementation.
-;;
-;; In a previous discussion the following hack came to mind. It is a gross
-;; hack, but it generally works. We use the convention that major modes start
-;; by calling the function `kill-all-local-variables', which in turn runs
-;; functions on the hook variable `change-major-mode-hook'. We attach our
-;; function `font-lock-change-major-mode' to that hook. Of course, when this
-;; hook is run, the major mode is in the process of being changed and we do not
-;; know what the final major mode will be. So, `font-lock-change-major-mode'
-;; only (a) notes the name of the current buffer, and (b) adds our function
-;; `turn-on-font-lock-if-enabled' to the hook variables `find-file-hooks' and
-;; `post-command-hook' (for buffers that are not visiting files). By the time
-;; the functions on the first of these hooks to be run are run, the new major
-;; mode is assumed to be in place. This way we get a Font Lock function run
-;; when a major mode is turned on, without knowing major modes or their hooks.
-;;
-;; Naturally this requires that (a) major modes run `kill-all-local-variables',
-;; as they are supposed to do, and (b) the major mode is in place after the
-;; file is visited or the command that ran `kill-all-local-variables' has
-;; finished, whichever the sooner. Arguably, any major mode that does not
-;; follow the convension (a) is broken, and I can't think of any reason why (b)
-;; would not be met (except `gnudoit' on non-files). However, it is not clean.
-;;
-;; Probably the cleanest solution is to have each major mode function run some
-;; hook, e.g., `major-mode-hook', but maybe implementing that change is
-;; impractical. I am personally against making `setq' a macro or be advised,
-;; or have a special function such as `set-major-mode', but maybe someone can
-;; come up with another solution?
-
-;; User interface.
-;;
-;; Although Global Font Lock mode is a pseudo-mode, I think that the user
-;; interface should conform to the usual Emacs convention for modes, i.e., a
-;; command to toggle the feature (`global-font-lock-mode') with a variable for
-;; finer control of the mode's behaviour (`font-lock-global-modes').
-;;
-;; The feature should not be enabled by loading font-lock.el, since other
-;; mechanisms for turning on Font Lock mode, such as M-x font-lock-mode RET or
-;; (add-hook 'c-mode-hook 'turn-on-font-lock), would cause Font Lock mode to be
-;; turned on everywhere. That would not be intuitive or informative because
-;; loading a file tells you nothing about the feature or how to control it. It
-;; would also be contrary to the Principle of Least Surprise. sm.
-
-(defcustom font-lock-global-modes t
- "*Modes for which Font Lock mode is automagically turned on.
-Global Font Lock mode is controlled by the command `global-font-lock-mode'.
-If nil, means no modes have Font Lock mode automatically turned on.
-If t, all modes that support Font Lock mode have it automatically turned on.
-If a list, it should be a list of `major-mode' symbol names for which Font Lock
-mode should be automatically turned on. The sense of the list is negated if it
-begins with `not'. For example:
- (c-mode c++-mode)
-means that Font Lock mode is turned on for buffers in C and C++ modes only."
- :type '(choice (const :tag "none" nil)
- (const :tag "all" t)
- (set :menu-tag "mode specific" :tag "modes"
- :value (not)
- (const :tag "Except" not)
- (repeat :inline t (symbol :tag "mode"))))
- :group 'font-lock)
-
-(defun turn-on-font-lock-if-enabled ()
- (when (and (or font-lock-defaults
- (assq major-mode font-lock-defaults-alist))
- (or (eq font-lock-global-modes t)
- (if (eq (car-safe font-lock-global-modes) 'not)
- (not (memq major-mode (cdr font-lock-global-modes)))
- (memq major-mode font-lock-global-modes))))
- (let (inhibit-quit)
- (turn-on-font-lock))))
-
-;;;###autoload
-(easy-mmode-define-global-mode
- global-font-lock-mode font-lock-mode turn-on-font-lock-if-enabled
- :extra-args (dummy))
-
-;;; End of Global Font Lock mode.
-\f
;;; Font Lock Support mode.
;; This is the code used to interface font-lock.el with any of its add-on
:version "21.1"
:group 'font-lock)
-(defvar fast-lock-mode nil)
-(defvar lazy-lock-mode nil)
-(defvar jit-lock-mode nil)
+(defvar fast-lock-mode)
+(defvar lazy-lock-mode)
+(defvar jit-lock-mode)
(defun font-lock-turn-on-thing-lock ()
(let ((thing-mode (font-lock-value-in-major-mode font-lock-support-mode)))
(not font-lock-keywords-only))))))
(defun font-lock-turn-off-thing-lock ()
- (cond (fast-lock-mode
+ (cond ((and (boundp 'fast-lock-mode) fast-lock-mode)
(fast-lock-mode -1))
- (jit-lock-mode
+ ((and (boundp 'jit-lock-mode) jit-lock-mode)
(jit-lock-unregister 'font-lock-fontify-region)
;; Reset local vars to the non-jit-lock case.
(kill-local-variable 'font-lock-fontify-buffer-function))
- (lazy-lock-mode
+ ((and (boundp 'lazy-lock-mode) lazy-lock-mode)
(lazy-lock-mode -1))))
(defun font-lock-after-fontify-buffer ()
- (cond (fast-lock-mode
+ (cond ((and (boundp 'fast-lock-mode) fast-lock-mode)
(fast-lock-after-fontify-buffer))
;; Useless now that jit-lock intercepts font-lock-fontify-buffer. -sm
;; (jit-lock-mode
;; (jit-lock-after-fontify-buffer))
- (lazy-lock-mode
+ ((and (boundp 'lazy-lock-mode) lazy-lock-mode)
(lazy-lock-after-fontify-buffer))))
(defun font-lock-after-unfontify-buffer ()
- (cond (fast-lock-mode
+ (cond ((and (boundp 'fast-lock-mode) fast-lock-mode)
(fast-lock-after-unfontify-buffer))
;; Useless as well. It's only called when:
;; - turning off font-lock: it does not matter if we leave spurious
;;
;; (jit-lock-mode
;; (jit-lock-after-unfontify-buffer))
- (lazy-lock-mode
+ ((and (boundp 'lazy-lock-mode) lazy-lock-mode)
(lazy-lock-after-unfontify-buffer))))
;;; End of Font Lock Support mode.
(font-lock-after-unfontify-buffer)
(setq font-lock-fontified nil)))
+(defvar font-lock-dont-widen nil
+ "If non-nil, font-lock will work on the non-widened buffer.
+Useful for things like RMAIL and Info where the whole buffer is not
+a very meaningful entity to highlight.")
+
(defun font-lock-default-fontify-region (beg end loudly)
(save-buffer-state
((parse-sexp-lookup-properties font-lock-syntactic-keywords)
(old-syntax-table (syntax-table)))
(unwind-protect
(save-restriction
- (widen)
+ (unless font-lock-dont-widen (widen))
;; Use the fontification syntax table, if any.
(when font-lock-syntax-table
(set-syntax-table font-lock-syntax-table))
(defun font-lock-default-unfontify-region (beg end)
(save-buffer-state nil
- (remove-text-properties
+ (remove-list-of-text-properties
beg end (append
font-lock-extra-managed-props
(if font-lock-syntactic-keywords
- '(face nil syntax-table nil font-lock-multiline nil)
- '(face nil font-lock-multiline nil))))))
+ '(syntax-table face font-lock-multiline)
+ '(face font-lock-multiline))))))
;; Called when any modification is made to buffer text.
(defun font-lock-after-change-function (beg end old-len)
(font-lock-fontify-region (point) (mark)))
((error quit) (message "Fontifying block...%s" error-data)))))))
-(define-key facemenu-keymap "\M-g" 'font-lock-fontify-block)
+(if (boundp 'facemenu-keymap)
+ (define-key facemenu-keymap "\M-g" 'font-lock-fontify-block))
;;; End of Fontification functions.
\f
(defun font-lock-fontify-keywords-region (start end &optional loudly)
"Fontify according to `font-lock-keywords' between START and END.
-START should be at the beginning of a line."
+START should be at the beginning of a line.
+LOUDLY, if non-nil, allows progress-meter bar."
(unless (eq (car font-lock-keywords) t)
(setq font-lock-keywords
(font-lock-compile-keywords font-lock-keywords t)))
`font-lock-defaults-alist') and `font-lock-maximum-decoration'."
;; Set fontification defaults iff not previously set.
(unless font-lock-set-defaults
- (set (make-local-variable 'font-lock-set-defaults) t)
+ (set (make-local-variable 'font-lock-set-defaults) t)
(make-local-variable 'font-lock-fontified)
(make-local-variable 'font-lock-multiline)
(let* ((defaults (or font-lock-defaults
(cdr (assq major-mode font-lock-defaults-alist))))
(keywords
(font-lock-choose-keywords (nth 0 defaults)
- (font-lock-value-in-major-mode font-lock-maximum-decoration)))
+ (font-lock-value-in-major-mode font-lock-maximum-decoration)))
(local (cdr (assq major-mode font-lock-keywords-alist)))
(removed-keywords
(cdr-safe (assq major-mode font-lock-removed-keywords-alist))))
+ (set (make-local-variable 'font-lock-defaults) defaults)
;; Syntactic fontification?
(when (nth 1 defaults)
(set (make-local-variable 'font-lock-keywords-only) t))
"Font Lock mode face used to highlight warnings."
:group 'font-lock-highlighting-faces)
+(defface font-lock-preprocessor-face
+ '((t :inherit 'font-lock-builtin-face))
+ "Font Lock mode face used to highlight preprocessor directives."
+ :group 'font-lock-highlighting-faces)
+
;;; End of Colour etc. support.
\f
;;; Menu support.
;;; Various regexp information shared by several modes.
;;; Information specific to a single mode should go in its load library.
-;; Font Lock support for C, C++, Objective-C and Java modes will one day be in
-;; some cc-font.el (and required by cc-mode.el). However, the below function
+;; Font Lock support for C, C++, Objective-C and Java modes is now in
+;; cc-fonts.el (and required by cc-mode.el). However, the below function
;; should stay in font-lock.el, since it is used by other libraries. sm.
(defun font-lock-match-c-style-declaration-item-and-skip-to-next (limit)
The expected syntax of a declaration/definition item is `word' (preceded by
optional whitespace and `*' characters and proceeded by optional whitespace)
optionally followed by a `('. Everything following the item (but belonging to
-it) is expected to by skip-able by `scan-sexps', and items are expected to be
+it) is expected to be skip-able by `scan-sexps', and items are expected to be
separated with a `,' and to be terminated with a `;'.
Thus the regexp matches after point: word (
(let ((pos (point)))
(skip-chars-backward " \t\n")
(skip-syntax-backward "w")
- (unless (looking-at "\\(\\sw+\\)[ \t\n]*\\sw*_\\sw*[ \t\n]*\\((\\)?")
+ (unless (looking-at "\\(\\sw+\\)[ \t\n]*\\sw+[ \t\n]*\\(((?\\)?")
;; Looks like it was something else, so go back to where we
;; were and reset the match data by rematching.
(goto-char pos)
;; 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)))))
\f
;; Lisp.
;; Variable declarations.
"\\(const\\(ant\\)?\\|custom\\|face\\|parameter\\|var\\)\\|"
;; Structure declarations.
- "\\(class\\|group\\|package\\|struct\\|type\\)"
+ "\\(class\\|group\\|theme\\|package\\|struct\\|type\\)"
"\\)\\)\\>"
;; Any whitespace and defined object.
"[ \t'\(]*"
'("`\\(\\sw\\sw+\\)'" 1 font-lock-constant-face prepend)
;;
;; Constant values.
- '("\\<:\\sw\\sw+\\>" 0 font-lock-builtin-face)
+ '("\\<:\\sw+\\>" 0 font-lock-builtin-face)
;;
;; ELisp and CLisp `&' keywords as types.
'("\\&\\sw+\\>" . font-lock-type-face)
(defvar lisp-font-lock-keywords lisp-font-lock-keywords-1
"Default expressions to highlight in Lisp modes.")
\f
-;;; User choices.
-
-;; These provide a means to fontify types not defined by the language. Those
-;; types might be the user's own or they might be generally accepted and used.
-;; Generally accepted types are used to provide default variable values.
-
-(define-widget 'font-lock-extra-types-widget 'radio
- "Widget `:type' for members of the custom group `font-lock-extra-types'.
-Members should `:load' the package `font-lock' to use this widget."
- :args '((const :tag "none" nil)
- (repeat :tag "types" regexp)))
-
-(defcustom c-font-lock-extra-types '("FILE" "\\sw+_t" "Lisp_Object")
- "*List of extra types to fontify in C mode.
-Each list item should be a regexp not containing word-delimiters.
-For example, a value of (\"FILE\" \"\\\\sw+_t\") means the word FILE and words
-ending in _t are treated as type names.
-
-The value of this variable is used when Font Lock mode is turned on."
- :type 'font-lock-extra-types-widget
- :group 'font-lock-extra-types)
-
-(defcustom c++-font-lock-extra-types
- '("\\sw+_t"
- "\\([iof]\\|str\\)+stream\\(buf\\)?" "ios"
- "string" "rope"
- "list" "slist"
- "deque" "vector" "bit_vector"
- "set" "multiset"
- "map" "multimap"
- "hash\\(_\\(m\\(ap\\|ulti\\(map\\|set\\)\\)\\|set\\)\\)?"
- "stack" "queue" "priority_queue"
- "type_info"
- "iterator" "const_iterator" "reverse_iterator" "const_reverse_iterator"
- "reference" "const_reference")
- "*List of extra types to fontify in C++ mode.
-Each list item should be a regexp not containing word-delimiters.
-For example, a value of (\"string\") means the word string is treated as a type
-name.
-
-The value of this variable is used when Font Lock mode is turned on."
- :type 'font-lock-extra-types-widget
- :group 'font-lock-extra-types)
-
-(defcustom objc-font-lock-extra-types '("Class" "BOOL" "IMP" "SEL")
- "*List of extra types to fontify in Objective-C mode.
-Each list item should be a regexp not containing word-delimiters.
-For example, a value of (\"Class\" \"BOOL\" \"IMP\" \"SEL\") means the words
-Class, BOOL, IMP and SEL are treated as type names.
-
-The value of this variable is used when Font Lock mode is turned on."
- :type 'font-lock-extra-types-widget
- :group 'font-lock-extra-types)
-
-(defcustom java-font-lock-extra-types
- '("[A-Z\300-\326\330-\337]\\sw*[a-z]\\sw*")
- "*List of extra types to fontify in Java mode.
-Each list item should be a regexp not containing word-delimiters.
-For example, a value of (\"[A-Z\300-\326\330-\337]\\\\sw*[a-z]\\\\sw*\") means capitalised
-words (and words conforming to the Java id spec) are treated as type names.
-
-The value of this variable is used when Font Lock mode is turned on."
- :type 'font-lock-extra-types-widget
- :group 'font-lock-extra-types)
-\f
-;;; C.
-
-;; [Murmur murmur murmur] Maestro, drum-roll please... [Murmur murmur murmur.]
-;; Ahem. [Murmur murmur murmur] Lay-dees an Gennel-men. [Murmur murmur shhh!]
-;; I am most proud and humbly honoured today [murmur murmur cough] to present
-;; to you good people, the winner of the Second Millennium Award for The Most
-;; Hairy Language Syntax. [Ahhh!] All rise please. [Shuffle shuffle
-;; shuffle.] And a round of applause please. For... The C Language! [Roar.]
-;;
-;; Thank you... You are too kind... It is with a feeling of great privilege
-;; and indeed emotion [sob] that I accept this award. It has been a long hard
-;; road. But we know our destiny. And our future. For we must not rest.
-;; There are more tokens to overload, more shoehorn, more methodologies. But
-;; more is a plus! [Ha ha ha.] And more means plus! [Ho ho ho.] The future
-;; is C++! [Ohhh!] The Third Millennium Award... Will be ours! [Roar.]
-
-(let* ((c-keywords
- (eval-when-compile
- (regexp-opt '("break" "continue" "do" "else" "for" "if" "return"
- "switch" "while" "sizeof"
- ;; Type related, but we don't do anything special.
- "typedef" "extern" "auto" "register" "static"
- "volatile" "const"
- ;; Dan Nicolaescu <done@gnu.org> says this is new.
- "restrict"
- ;; Henrik Enberg <henrik@enberg.org> says this is new.
- "inline"))))
- (c-type-specs
- (eval-when-compile
- (regexp-opt '("enum" "struct" "union"))))
- (c-type-specs-depth
- (regexp-opt-depth c-type-specs))
- (c-type-names
- `(mapconcat 'identity
- (cons
- ,(eval-when-compile
- (regexp-opt
- '("char" "short" "int" "long" "signed" "unsigned"
- "float" "double" "void" "complex"
- ;; Henrik Enberg <henrik@enberg.org> says these are new.
- "_Complex" "_Imaginary" "_Bool")))
- c-font-lock-extra-types)
- "\\|"))
- (c-type-names-depth
- `(regexp-opt-depth ,c-type-names))
- (c-preprocessor-directives
- (eval-when-compile
- (regexp-opt
- '("define" "elif" "else" "endif" "error" "file" "if" "ifdef"
- "ifndef" "include" "line" "pragma" "undef"))))
- (c-preprocessor-directives-depth
- (regexp-opt-depth c-preprocessor-directives)))
- (defconst c-font-lock-keywords-1
- (list
- ;;
- ;; These are all anchored at the beginning of line for speed.
- ;; Note that `c++-font-lock-keywords-1' depends on `c-font-lock-keywords-1'.
- ;;
- ;; Fontify function name definitions (GNU style; without type on line).
- '("^\\(\\sw+\\)[ \t]*(" 1 font-lock-function-name-face)
- ;;
- ;; Fontify error directives.
- '("^#[ \t]*error[ \t]+\\(.+\\)" 1 font-lock-warning-face prepend)
- ;;
- ;; Fontify filenames in #include <...> preprocessor directives as strings.
- '("^#[ \t]*\\(import\\|include\\)[ \t]*\\(<[^>\"\n]*>?\\)"
- 2 font-lock-string-face)
- ;;
- ;; Fontify function macro names.
- '("^#[ \t]*define[ \t]+\\(\\sw+\\)(" 1 font-lock-function-name-face)
- ;;
- ;; Fontify symbol names in #elif or #if ... defined preprocessor directives.
- '("^#[ \t]*\\(elif\\|if\\)\\>"
- ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil
- (1 font-lock-builtin-face) (2 font-lock-variable-name-face nil t)))
- ;;
- ;; Fontify otherwise as symbol names, and the preprocessor directive names.
- (list
- (concat "^#[ \t]*\\(" c-preprocessor-directives
- "\\)\\>[ \t!]*\\(\\sw+\\)?")
- '(1 font-lock-builtin-face)
- (list (+ 2 c-preprocessor-directives-depth)
- 'font-lock-variable-name-face nil t)))
- "Subdued level highlighting for C mode.")
-
- (defconst c-font-lock-keywords-2
- (append c-font-lock-keywords-1
- (list
- ;;
- ;; Simple regexps for speed.
- ;;
- ;; Fontify all type names.
- `(eval .
- (cons (concat "\\<\\(" ,c-type-names "\\)\\>") 'font-lock-type-face))
- ;;
- ;; Fontify all builtin keywords (except case, default and goto; see below).
- (concat "\\<\\(" c-keywords "\\|" c-type-specs "\\)\\>")
- ;;
- ;; Fontify case/goto keywords and targets, and case default/goto tags.
- '("\\<\\(case\\|goto\\)\\>"
- (1 font-lock-keyword-face)
- ("\\(-[0-9]+\\|\\sw+\\)"
- ;; Return limit of search.
- (save-excursion (skip-chars-forward "^:\n") (point))
- nil
- (1 font-lock-constant-face nil t)))
- ;; Anders Lindgren <andersl@andersl.com> points out that it is quicker
- ;; to use MATCH-ANCHORED to effectively anchor the regexp on the left.
- ;; This must come after the one for keywords and targets.
- ;; Note: the lack of `:' in the first char-range prevents `bar' from being
- ;; highlighted in "foo: bar:". But adding `:' would break cases like
- ;; "test1 ? test2 ? foo : bar : baz".
- '(":" ("\\(?:^\\|[{};]\\)[ \t]*\\(\\sw+\\)[ \t]*:"
- (beginning-of-line) (end-of-line)
- (1 font-lock-constant-face)))
- ))
- "Medium level highlighting for C mode. See also `c-font-lock-extra-types'.")
-
- (defconst c-font-lock-keywords-3
- (append c-font-lock-keywords-2
- ;;
- ;; More complicated regexps for more complete highlighting for types.
- ;; We still have to fontify type specifiers individually, as C is so hairy.
- (list
- ;;
- ;; Fontify all storage types, plus their items.
- `(eval .
- (list (concat "\\<\\(" ,c-type-names "\\)\\>"
- "\\([ \t*&]+\\sw+\\>\\)*")
- ;; Fontify each declaration item.
- `(font-lock-match-c-style-declaration-item-and-skip-to-next
- ;; Start with point after all type specifiers.
- (prog1 (progn (skip-chars-forward "^;{}") (point))
- (goto-char (or (match-beginning
- ,(+ ,c-type-names-depth 2))
- (match-end 1))))
- ;; Finish with point after first type specifier.
- (goto-char (match-end 1))
- ;; Fontify as a variable or function name.
- (1 (if (match-beginning 2)
- font-lock-function-name-face
- font-lock-variable-name-face)))))
- ;;
- ;; Fontify all storage specs and types, plus their items.
- `(,(concat "\\<\\(" c-type-specs "\\)\\>" "[ \t]*\\(\\sw+\\)?")
- (1 font-lock-keyword-face)
- (,(+ c-type-specs-depth 2) font-lock-type-face nil t)
- (font-lock-match-c-style-declaration-item-and-skip-to-next
- (save-excursion (skip-chars-forward "^;{}") (point))
- ;; Finish with point after the variable name if
- ;; there is one.
- (if (match-end 2)
- (goto-char (match-end 2)))
- ;; Fontify as a variable or function name.
- (1 (if (match-beginning 2)
- font-lock-function-name-face
- font-lock-variable-name-face) nil t)))
- ;;
- ;; Fontify structures, or typedef names, plus their items.
- '("\\(}\\)[ \t*]*\\sw"
- (font-lock-match-c-style-declaration-item-and-skip-to-next
- (prog1 (progn (skip-chars-forward "^;{}") (point))
- (goto-char (match-end 1))) nil
- (1 font-lock-type-face)))
- ;;
- ;; Fontify anything at beginning of line as a declaration or definition.
- '("^\\(\\sw+\\)\\>\\([ \t*]+\\sw+\\>\\)*"
- (1 font-lock-type-face)
- (font-lock-match-c-style-declaration-item-and-skip-to-next
- (prog1 (progn (skip-chars-forward "^;{}") (point))
- (goto-char (or (match-beginning 2) (match-end 1)))) nil
- (1 (if (match-beginning 2)
- font-lock-function-name-face
- font-lock-variable-name-face))))
- ))
- "Gaudy level highlighting for C mode.
-See also `c-font-lock-extra-types'."))
-
-(defun c-font-lock-syntactic-face-function (state)
- (save-excursion
- (if (nth 3 state)
- ;; Check whether the string is properly terminated.
- (let ((nstate (parse-partial-sexp (point) (line-end-position)
- nil nil state 'syntax-table)))
- (if (and (eolp) (not (nth 5 nstate)) (nth 3 nstate))
- ;; We're inside a string, at EOL and there was no \.
- font-lock-warning-face
- font-lock-string-face))
- (goto-char (nth 8 state))
- ;; `doxygen' uses /*! while others use /**.
- (if (looking-at "/\\*[*!]\n")
- font-lock-doc-face font-lock-comment-face))))
-
-(defvar c-font-lock-keywords c-font-lock-keywords-1
- "Default expressions to highlight in C mode.
-See also `c-font-lock-extra-types'.")
-\f
-;;; C++.
-
-(defun font-lock-match-c++-style-declaration-item-and-skip-to-next (limit)
- ;; Regexp matches after point: word<word>::word (
- ;; ^^^^ ^^^^ ^^^^ ^
- ;; Where the match subexpressions are: 1 3 5 6
- ;;
- ;; Item is delimited by (match-beginning 1) and (match-end 1).
- ;; If (match-beginning 3) is non-nil, that part of the item incloses a `<>'.
- ;; If (match-beginning 5) is non-nil, that part of the item follows a `::'.
- ;; If (match-beginning 6) is non-nil, the item is followed by a `('.
- (when (looking-at (eval-when-compile
- (concat
- ;; Skip any leading whitespace.
- "[ \t\n*&]*"
- ;; This is `c++-type-spec' from below. (Hint hint!)
- "\\(\\sw+\\)" ; The instance?
- "\\([ \t\n]*<\\(\\(?:[^<>]\\|<[^>]+>\\)+\\)[ \t\n*&]*>\\)?" ; Or template?
- "\\([ \t\n]*::[ \t\n*~]*\\(\\sw+\\)\\)*" ; Or member?
- ;; Match any trailing parenthesis.
- "[ \t\n]*\\((\\)?")))
- (save-match-data
- (condition-case nil
- (save-restriction
- ;; Restrict to the end of line, currently guaranteed to be LIMIT.
- (narrow-to-region (point-min) limit)
- (goto-char (match-end 1))
- ;; 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)))
- (error t)))))
-
-(defun font-lock-match-c++-structor-declaration (limit)
- ;; Match C++ constructors and destructors inside class declarations.
- (let ((res nil)
- (regexp (concat "^\\s-+\\(\\(virtual\\|explicit\\)\\s-+\\)*~?\\(\\<"
- (mapconcat 'identity
- c++-font-lock-extra-types "\\|")
- "\\>\\)\\s-*("
- ;; Don't match function pointer declarations, e.g.:
- ;; Foo (*fptr)();
- "\\s-*[^*( \t]")))
- (while (progn (setq res (re-search-forward regexp limit t))
- (and res
- (save-excursion
- (beginning-of-line)
- (save-match-data
- (not (vectorp (c-at-toplevel-p))))))))
- res))
-
-(let* ((c++-keywords
- (eval-when-compile
- (regexp-opt
- '("break" "continue" "do" "else" "for" "if" "return" "switch"
- "while" "asm" "catch" "delete" "new" "sizeof" "this" "throw" "try"
- "typeid"
- ;; Branko Cibej <branko.cibej@hermes.si> says this is new.
- "export"
- ;; Mark Mitchell <mmitchell@usa.net> says these are new.
- "mutable" "explicit"
- ;; Alain Picard <ap@abelard.apana.org.au> suggests treating these
- ;; as keywords not types.
- "typedef" "template"
- "extern" "auto" "register" "const" "volatile" "static"
- "inline" "friend" "virtual"
- ;; Standard C++ operator names.
- "and" "and_eq" "bitand" "bitor" "compl" "not" "not_eq"
- "or" "or_eq" "xor" "xor_eq"))))
- (c++-operators
- (eval-when-compile
- (regexp-opt
- ;; Taken from Stroustrup, minus keywords otherwise fontified.
- '("+" "-" "*" "/" "%" "^" "&" "|" "~" "!" "=" "<" ">" "+=" "-="
- "*=" "/=" "%=" "^=" "&=" "|=" "<<" ">>" ">>=" "<<=" "==" "!="
- "<=" ">=" "&&" "||" "++" "--" "->*" "," "->" "[]" "()"))))
- (c++-type-specs
- (eval-when-compile
- (regexp-opt
- '("class" "public" "private" "protected" "typename"
- "struct" "union" "enum" "namespace" "using"
- ;; Eric Hopper <hopper@omnifarious.mn.org> says these are new.
- "static_cast" "dynamic_cast" "const_cast" "reinterpret_cast") t)))
- (c++-type-specs-depth
- (regexp-opt-depth c++-type-specs))
- (c++-type-names
- `(mapconcat 'identity
- (cons
- ,(eval-when-compile
- (regexp-opt
- '("signed" "unsigned" "short" "long"
- "int" "char" "float" "double" "void"
- "bool" "complex")))
- c++-font-lock-extra-types)
- "\\|"))
- (c++-type-names-depth `(regexp-opt-depth ,c++-type-names))
- ;;
- ;; A brave attempt to match templates following a type and/or match
- ;; class membership. See and sync the above function
- ;; `font-lock-match-c++-style-declaration-item-and-skip-to-next'.
- (c++-type-suffix (concat "\\([ \t]*<\\(\\(?:[^<>\n]\\|<[^>\n]+>\\)+\\)[ \t*&]*>\\)?"
- "\\([ \t]*::[ \t*~]*\\(\\sw+\\)\\)*"))
- (c++-type-suffix-depth (regexp-opt-depth c++-type-suffix))
- ;; If the string is a type, it may be followed by the cruft above.
- (c++-type-spec (concat "\\(\\sw+\\)\\>" c++-type-suffix))
- (c++-type-spec-depth (regexp-opt-depth c++-type-spec))
- ;;
- ;; Parenthesis depth of user-defined types not forgetting their cruft.
- (c++-type-depth `(regexp-opt-depth
- (concat ,c++-type-names ,c++-type-suffix)))
- )
- (defconst c++-font-lock-keywords-1
- (append
- ;;
- ;; The list `c-font-lock-keywords-1' less that for function names.
- (cdr c-font-lock-keywords-1)
- (list
- ;;
- ;; Fontify function name definitions, possibly incorporating class names.
- (list (concat "^" c++-type-spec "[ \t]*(")
- '(1 (if (or (match-beginning 2) (match-beginning 4))
- font-lock-type-face
- font-lock-function-name-face))
- '(3 font-lock-type-face nil t)
- '(5 font-lock-function-name-face nil t))
- ))
- "Subdued level highlighting for C++ mode.")
-
- (defconst c++-font-lock-keywords-2
- (append c++-font-lock-keywords-1
- (list
- ;;
- ;; The list `c-font-lock-keywords-2' for C++ plus operator overloading.
- `(eval .
- (cons (concat "\\<\\(" ,c++-type-names "\\)\\>")
- 'font-lock-type-face))
- ;;
- ;; Fontify operator overloading.
- (list (concat "\\<\\(operator\\)\\>[ \t]*\\(" c++-operators "\\)?")
- '(1 font-lock-keyword-face)
- '(2 font-lock-builtin-face nil t))
- ;;
- ;; Fontify case/goto keywords and targets, and case default/goto tags.
- '("\\<\\(case\\|goto\\)\\>"
- (1 font-lock-keyword-face)
- ("\\(-[0-9]+\\|\\sw+\\)[ \t]*\\(::\\)?"
- ;; Return limit of search.
- (save-excursion
- (while (progn
- (skip-chars-forward "^:\n")
- (looking-at "::"))
- (forward-char 2))
- (point))
- nil
- (1 (if (match-beginning 2)
- font-lock-type-face
- font-lock-constant-face) nil t)))
- ;; This must come after the one for keywords and targets.
- '(":" ("^[ \t]*\\(\\sw+\\)[ \t]*:\\($\\|[^:]\\)"
- (beginning-of-line) (end-of-line)
- (1 font-lock-constant-face)))
- ;;
- ;; Fontify other builtin keywords.
- (concat "\\<\\(" c++-keywords "\\|" c++-type-specs "\\)\\>")
- ;;
- ;; Eric Hopper <hopper@omnifarious.mn.org> says `true' and `false' are new.
- '("\\<\\(false\\|true\\)\\>" . font-lock-constant-face)
- ))
- "Medium level highlighting for C++ mode.
-See also `c++-font-lock-extra-types'.")
-
- (defconst c++-font-lock-keywords-3
- (append c++-font-lock-keywords-2
- ;;
- ;; More complicated regexps for more complete highlighting for types.
- (list
- ;;
- ;; Fontify all storage classes and type specifiers, plus their items.
- `(eval .
- (list (concat "\\<\\(" ,c++-type-names "\\)\\>" ,c++-type-suffix
- "\\([ \t*&]+" ,c++-type-spec "\\)*")
- ;; The name of any template type.
- `(,(+ ,c++-type-names-depth 3) font-lock-type-face nil t)
- ;; Fontify each declaration item.
- `(font-lock-match-c++-style-declaration-item-and-skip-to-next
- ;; Start with point after all type specifiers.
- (prog1 (progn (skip-chars-forward "^;{}") (point))
- (goto-char (or (match-beginning
- ,(+ ,c++-type-depth 2))
- (match-end 1))))
- ;; Finish with point after first type specifier.
- (goto-char (match-end 1))
- ;; Fontify as a variable or function name.
- (1 (cond ((or (match-beginning 2) (match-beginning 4))
- font-lock-type-face)
- ((and (match-beginning 6) (c-at-toplevel-p))
- font-lock-function-name-face)
- (t
- font-lock-variable-name-face)))
- (3 font-lock-type-face nil t)
- (5 (if (match-beginning 6)
- font-lock-function-name-face
- font-lock-variable-name-face) nil t))))
- ;;
- ;; Fontify all storage specs and types, plus their items.
- `(,(concat "\\<" c++-type-specs "\\>" c++-type-suffix
- "[ \t]*\\(" c++-type-spec "\\)?")
- ;; The name of any template type.
- (,(+ c++-type-specs-depth 2) 'font-lock-type-face nil t)
- ;; The name of any type.
- (,(+ c++-type-specs-depth c++-type-suffix-depth 2)
- font-lock-type-face nil t)
- ;; Fontify each declaration item.
- (font-lock-match-c++-style-declaration-item-and-skip-to-next
- ;; Start with point after all type specifiers.
- (save-excursion (skip-chars-forward "^;{}") (point))
- ;; Finish with point after first type specifier.
- nil
- ;; Fontify as a variable or function name.
- (1 (cond ((or (match-beginning 2) (match-beginning 4))
- font-lock-type-face)
- ((and (match-beginning 6) (c-at-toplevel-p))
- font-lock-function-name-face)
- (t
- font-lock-variable-name-face)))
- (3 font-lock-type-face nil t)
- (5 (if (match-beginning 6)
- font-lock-function-name-face
- font-lock-variable-name-face) nil t)))
- ;;
- ;; Fontify structures, or typedef names, plus their items.
- '("\\(}\\)[ \t*]*\\sw"
- (font-lock-match-c++-style-declaration-item-and-skip-to-next
- (prog1 (progn (skip-chars-forward "^;{}") (point))
- (goto-char (match-end 1))) nil
- (1 font-lock-type-face)))
- ;;
- ;; Fontify anything at beginning of line as a declaration or definition.
- `(,(concat "^\\(" c++-type-spec "[ \t*&]*\\)+")
- (font-lock-match-c++-style-declaration-item-and-skip-to-next
- (prog1 (progn (skip-chars-forward "^;{}") (point))
- (goto-char (match-beginning 1)))
- (goto-char (match-end 1))
- (1 (cond ((or (match-beginning 2) (match-beginning 4))
- font-lock-type-face)
- ((match-beginning 6) font-lock-function-name-face)
- (t font-lock-variable-name-face)))
- (3 font-lock-type-face nil t)
- (5 (if (match-beginning 6)
- font-lock-function-name-face
- font-lock-variable-name-face) nil t)))
- ;;
- ;; Fontify constructors and destructors inside class declarations.
- '(font-lock-match-c++-structor-declaration
- (3 font-lock-function-name-face t))
- ))
- "Gaudy level highlighting for C++ mode.
-See also `c++-font-lock-extra-types'.")
- )
-
-(defvar c++-font-lock-keywords c++-font-lock-keywords-1
- "Default expressions to highlight in C++ mode.
-See also `c++-font-lock-extra-types'.")
-\f
-;;; Objective-C.
-
-;; Regexps written with help from Stephen Peters <speters@us.oracle.com> and
-;; Jacques Duthen Prestataire <duthen@cegelec-red.fr>.
-(let* ((objc-keywords
- (eval-when-compile
- (regexp-opt '("break" "continue" "do" "else" "for" "if" "return"
- "switch" "while" "sizeof" "self" "super"
- "typedef" "auto" "extern" "static"
- "volatile" "const"))))
- (objc-type-specs
- (eval-when-compile
- (regexp-opt
- '("register" "struct" "union" "enum"
- "oneway" "in" "out" "inout" "bycopy" "byref") t)))
- (objc-type-specs-depth
- (regexp-opt-depth objc-type-specs))
- (objc-type-names
- `(mapconcat 'identity
- (cons
- ,(eval-when-compile
- (regexp-opt
- '("signed" "unsigned" "short" "long"
- "int" "char" "float" "double" "void"
- "id")))
- objc-font-lock-extra-types)
- "\\|"))
- (objc-type-names-depth
- `(regexp-opt-depth ,objc-type-names))
- )
- (defconst objc-font-lock-keywords-1
- (append
- ;;
- ;; The list `c-font-lock-keywords-1' less that for function names.
- (cdr c-font-lock-keywords-1)
- (list
- ;;
- ;; Fontify compiler directives.
- '("@\\(\\sw+\\)\\>"
- (1 font-lock-keyword-face)
- ("\\=[ \t:<,]*\\(\\sw+\\)" nil nil
- (1 font-lock-type-face)))
- ;;
- ;; Fontify method names and arguments. Oh Lordy!
- ;; First, on the same line as the function declaration.
- '("^[+-][ \t]*\\(PRIVATE\\>\\)?[ \t]*\\(([^)\n]+)\\)?[ \t]*\\(\\sw+\\)"
- (1 font-lock-keyword-face nil t)
- (3 font-lock-function-name-face)
- ("\\=[ \t]*\\(\\sw+\\)?:[ \t]*\\(([^)\n]+)\\)?[ \t]*\\(\\sw+\\)"
- nil nil
- (1 font-lock-function-name-face nil t)
- (3 font-lock-variable-name-face)))
- ;; Second, on lines following the function declaration.
- '(":" ("^[ \t]*\\(\\sw+\\)?:[ \t]*\\(([^)\n]+)\\)?[ \t]*\\(\\sw+\\)"
- (beginning-of-line) (end-of-line)
- (1 font-lock-function-name-face nil t)
- (3 font-lock-variable-name-face)))
- ))
- "Subdued level highlighting for Objective-C mode.")
-
- (defconst objc-font-lock-keywords-2
- (append objc-font-lock-keywords-1
- (list
- ;;
- ;; Simple regexps for speed.
- ;;
- ;; Fontify all type specifiers.
- `(eval .
- (cons (concat "\\<\\(" ,objc-type-names "\\)\\>")
- 'font-lock-type-face))
- ;;
- ;; Fontify all builtin keywords (except case, default and goto; see below).
- (concat "\\<\\(" objc-keywords "\\|" objc-type-specs "\\)\\>")
- ;;
- ;; Fontify case/goto keywords and targets, and case default/goto tags.
- '("\\<\\(case\\|goto\\)\\>[ \t]*\\(-?\\sw+\\)?"
- (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
- ;; Fontify tags iff sole statement on line, otherwise we detect selectors.
- ;; This must come after the one for keywords and targets.
- '(":" ("^[ \t]*\\(\\sw+\\)[ \t]*:[ \t]*$"
- (beginning-of-line) (end-of-line)
- (1 font-lock-constant-face)))
- ;;
- ;; Fontify null object pointers.
- '("\\<[Nn]il\\>" . font-lock-constant-face)
- ))
- "Medium level highlighting for Objective-C mode.
-See also `objc-font-lock-extra-types'.")
-
- (defconst objc-font-lock-keywords-3
- (append objc-font-lock-keywords-2
- ;;
- ;; More complicated regexps for more complete highlighting for types.
- ;; We still have to fontify type specifiers individually, as C is so hairy.
- (list
- ;;
- ;; Fontify all storage classes and type specifiers, plus their items.
- `(eval .
- (list (concat "\\<\\(" ,objc-type-names "\\)\\>"
- "\\([ \t*&]+\\sw+\\>\\)*")
- ;; Fontify each declaration item.
- `(font-lock-match-c-style-declaration-item-and-skip-to-next
- ;; Start with point after all type specifiers.
- (prog1 (progn (skip-chars-forward "^;{}") (point))
- (goto-char (or (match-beginning
- ,(+ ,objc-type-names-depth 2))
- (match-end 1))))
- ;; Finish with point after first type specifier.
- (goto-char (match-end 1))
- ;; Fontify as a variable or function name.
- (1 (if (match-beginning 2)
- font-lock-function-name-face
- font-lock-variable-name-face)))))
- ;;
- ;; Fontify all storage specs and types, plus their items.
- `(,(concat "\\<\\(" objc-type-specs "[ \t]*\\)+\\>" "[ \t]*\\(\\sw+\\)?")
- ;; The name of any type.
- (,(+ objc-type-specs-depth 2) font-lock-type-face nil t)
- ;; Fontify each declaration item.
- (font-lock-match-c++-style-declaration-item-and-skip-to-next
- (save-excursion (skip-chars-forward "^;{}") (point)) nil
- ;; Fontify as a variable or function name.
- (1 (if (match-beginning 2)
- font-lock-function-name-face
- font-lock-variable-name-face))))
- ;;
- ;; Fontify structures, or typedef names, plus their items.
- '("\\(}\\)[ \t*]*\\sw"
- (font-lock-match-c-style-declaration-item-and-skip-to-next
- (prog1 (progn (skip-chars-forward "^;{}") (point))
- (goto-char (match-end 1))) nil
- (1 font-lock-type-face)))
- ;;
- ;; Fontify anything at beginning of line as a declaration or definition.
- '("^\\(\\sw+\\)\\>\\([ \t*]+\\sw+\\>\\)*"
- (1 font-lock-type-face)
- (font-lock-match-c-style-declaration-item-and-skip-to-next
- (prog1 (progn (skip-chars-forward "^;{}") (point))
- (goto-char (or (match-beginning 2) (match-end 1)))) nil
- (1 (if (match-beginning 2)
- font-lock-function-name-face
- font-lock-variable-name-face))))
- ))
- "Gaudy level highlighting for Objective-C mode.
-See also `objc-font-lock-extra-types'.")
- )
-
-(defvar objc-font-lock-keywords objc-font-lock-keywords-1
- "Default expressions to highlight in Objective-C mode.
-See also `objc-font-lock-extra-types'.")
-\f
-;;; Java.
-
-;; Regexps written with help from Fred White <fwhite@bbn.com>,
-;; Anders Lindgren <andersl@andersl.com> and Carl Manning <caroma@ai.mit.edu>.
-(let* ((java-keywords
- (eval-when-compile
- (regexp-opt
- '("catch" "do" "else" "super" "this" "finally" "for" "if"
- ;; Anders Lindgren <andersl@andersl.com> says these have gone.
- ;; "cast" "byvalue" "future" "generic" "operator" "var"
- ;; "inner" "outer" "rest"
- "implements" "extends" "throws" "instanceof" "new"
- "interface" "return" "switch" "throw" "try" "while"))))
- ;;
- ;; Classes immediately followed by an object name.
- (java-type-names
- `(mapconcat 'identity
- (cons
- ,(eval-when-compile
- (regexp-opt '("boolean" "char" "byte" "short" "int" "long"
- "float" "double" "void")))
- java-font-lock-extra-types)
- "\\|"))
- (java-type-names-depth `(regexp-opt-depth ,java-type-names))
- ;;
- ;; These are eventually followed by an object name.
- (java-type-specs
- (eval-when-compile
- (regexp-opt
- '("abstract" "const" "final" "synchronized" "transient" "static"
- ;; Anders Lindgren <andersl@andersl.com> says this has gone.
- ;; "threadsafe"
- "volatile" "public" "private" "protected" "native"
- ;; Carl Manning <caroma@ai.mit.edu> says this is new.
- "strictfp"))))
- )
- (defconst java-font-lock-keywords-1
- (list
- ;;
- ;; Fontify class names.
- '("\\<\\(class\\)\\>[ \t]*\\(\\sw+\\)?"
- (1 font-lock-keyword-face) (2 font-lock-type-face nil t))
- ;;
- ;; Fontify package names in import directives.
- '("\\<\\(import\\|package\\)\\>[ \t]*\\(\\sw+\\)?"
- (1 font-lock-keyword-face)
- (2 font-lock-constant-face nil t)
- ("\\=\\.\\(\\*\\|\\sw+\\)" nil nil
- (1 font-lock-constant-face nil t)))
- )
- "Subdued level highlighting for Java mode.")
-
- (defconst java-font-lock-keywords-2
- (append java-font-lock-keywords-1
- (list
- ;;
- ;; Fontify class names.
- `(eval .
- (cons (concat "\\<\\(" ,java-type-names "\\)\\>[^.]")
- '(1 font-lock-type-face)))
- ;;
- ;; Fontify all builtin keywords (except below).
- (concat "\\<\\(" java-keywords "\\|" java-type-specs "\\)\\>")
- ;;
- ;; Fontify keywords and targets, and case default/goto tags.
- (list "\\<\\(break\\|case\\|continue\\|goto\\)\\>[ \t]*\\(-?\\sw+\\)?"
- '(1 font-lock-keyword-face) '(2 font-lock-constant-face nil t))
- ;; This must come after the one for keywords and targets.
- '(":" ("^[ \t]*\\(\\sw+\\)[ \t]*:[ \t]*$"
- (beginning-of-line) (end-of-line)
- (1 font-lock-constant-face)))
- ;;
- ;; Fontify all constants.
- '("\\<\\(false\\|null\\|true\\)\\>" . font-lock-constant-face)
- ;;
- ;; Javadoc tags within comments.
- (list
- (concat "@\\("
- "author\\|deprecated\\|exception"
- "\\|link\\|return\\|see\\|serial\\|serialData\\|serialField"
- "\\|since\\|throws"
- "\\|version"
- "\\)\\>")
- '(1 font-lock-constant-face prepend))
- '("@\\(param\\)\\>[ \t]*\\(\\sw+\\)?"
- (1 font-lock-constant-face prepend)
- (2 font-lock-variable-name-face prepend t))
- '("@\\(exception\\|throws\\)\\>[ \t]*\\(\\S-+\\)?"
- (1 font-lock-constant-face prepend)
- (2 font-lock-type-face prepend t))
- ))
- "Medium level highlighting for Java mode.
-See also `java-font-lock-extra-types'.")
-
- (defconst java-font-lock-keywords-3
- (append java-font-lock-keywords-2
- ;;
- ;; More complicated regexps for more complete highlighting for types.
- ;; We still have to fontify type specifiers individually, as Java is hairy.
- (list
- ;;
- ;; Fontify random types immediately followed by an item or items.
- `(eval .
- (list (concat "\\<\\(" ,java-type-names "\\)\\>"
- "\\([ \t]*\\[[ \t]*\\]\\)*"
- "\\([ \t]*\\sw\\)")
- ;; Fontify each declaration item.
- `(font-lock-match-c-style-declaration-item-and-skip-to-next
- ;; Start and finish with point after the type specifier.
- (prog1 (progn (skip-chars-forward "^;{}") (point))
- (goto-char (match-beginning ,(+ ,java-type-names-depth 3))))
- (goto-char (match-beginning ,(+ ,java-type-names-depth 3)))
- ;; Fontify as a variable or function name.
- (1 (if (match-beginning 2)
- font-lock-function-name-face
- font-lock-variable-name-face)))))
- ;;
- ;; Fontify those that are eventually followed by an item or items.
- `(,(concat "\\<\\(" java-type-specs "\\)\\>"
- "\\([ \t]+\\sw+\\>"
- "\\([ \t]*\\[[ \t]*\\]\\)*"
- "\\)*")
- ;; Fontify each declaration item.
- (font-lock-match-c-style-declaration-item-and-skip-to-next
- ;; Start with point after all type specifiers.
- (prog1 (progn (skip-chars-forward "^;{}") (point))
- (goto-char (or (match-beginning 5) (match-end 1))))
- ;; Finish with point after first type specifier.
- (goto-char (match-end 1))
- ;; Fontify as a variable or function name.
- (1 (if (match-beginning 2)
- font-lock-function-name-face
- font-lock-variable-name-face))))
- ))
- "Gaudy level highlighting for Java mode.
-See also `java-font-lock-extra-types'.")
- )
-
-(defvar java-font-lock-keywords java-font-lock-keywords-1
- "Default expressions to highlight in Java mode.
-See also `java-font-lock-extra-types'.")
-\f
-;; Provide ourselves:
-
-(defun java-font-lock-syntactic-face-function (state)
- (save-excursion
- (if (nth 3 state)
- ;; Check whether the string is properly terminated.
- (let ((nstate (parse-partial-sexp (point) (line-end-position)
- nil nil state 'syntax-table)))
- (if (and (eolp) (nth 3 nstate))
- ;; We're inside a string, at EOL. The JLS says that:
- ;; It is a compile-time error for a line terminator to
- ;; appear after the opening " and before the closing
- ;; matching ".
- font-lock-warning-face
- font-lock-string-face))
- (goto-char (nth 8 state))
- (if (looking-at "/\\*\\*")
- font-lock-doc-face
- font-lock-comment-face))))
-
(provide 'font-lock)
(when (eq font-lock-support-mode 'jit-lock-mode)
;; 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)
MODE-FN, if specified, is called when visiting a file with that format.
It is called with a single positive argument, on the assumption
- that it turns on some Emacs mode.")
+ that it turns on some Emacs mode.
+
+PRESERVE, if non-nil, means that `format-write-file' should not remove
+ this format from `buffer-file-formats'.")
;;; Basic Functions (called from Lisp)
(if modify
;; To-function wants to modify region. Copy to safe place.
(let ((copy-buf (get-buffer-create (format " *Format Temp %d*"
- format-count))))
+ format-count)))
+ (sel-disp selective-display)
+ (multibyte enable-multibyte-characters)
+ (coding-system buffer-file-coding-system))
+ (with-current-buffer copy-buf
+ (setq selective-display sel-disp)
+ (set-buffer-multibyte multibyte)
+ (setq buffer-file-coding-system coding-system))
(copy-to-buffer copy-buf from to)
(set-buffer copy-buf)
(format-insert-annotations write-region-annotations-so-far from)
Second arg LENGTH is the number of characters following point to operate on.
If optional third arg VISIT-FLAG is true, set `buffer-file-format'
-to the list of formats used, and call any mode functions defined for those
-formats.
+to the reverted list of formats used, and call any mode functions defined
+for those formats.
Returns the new length of the decoded region.
(unwind-protect
(progn
;; Don't record undo information for the decoding.
-
+
(if (null format)
;; Figure out which format it is in, remember list in `format'.
(let ((try format-alist))
(if (and regexp (looking-at regexp)
(< (match-end 0) (+ begin length)))
(progn
- (setq format (cons (car f) format))
+ (push (car f) format)
;; Decode it
(if (nth 3 f)
(setq end (format-decode-run-method (nth 3 f) begin end)))
(setq end (format-decode-run-method (nth 3 f) begin end)))
;; Call visit function if required
(if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1))
- (setq do (cdr do)))))
+ (setq do (cdr do))))
+ ;; Encode in the opposite order.
+ (setq format (reverse format)))
(if visit-flag
(setq buffer-file-format format)))
-
+
(set-buffer-modified-p mod))
;; Return new length of region
(fmt (format-read (format "Write file `%s' in format: "
(file-name-nondirectory file)))))
(list file fmt)))
- (setq buffer-file-format format)
+ (let ((old-formats buffer-file-format)
+ preserve-formats)
+ (dolist (fmt old-formats)
+ (let ((aelt (assq fmt format-alist)))
+ (if (nth 7 aelt)
+ (push fmt preserve-formats))))
+ (setq buffer-file-format format)
+ (dolist (fmt preserve-formats)
+ (unless (memq fmt buffer-file-format)
+ (setq buffer-file-format (append buffer-file-format (list fmt))))))
(write-file filename))
(defun format-find-file (filename format)
;; Now (cdr p) is the cons to delete
(setcdr p (cdr cons))
list)))
-
+
(defun format-make-relatively-unique (a b)
"Delete common elements of lists A and B, return as pair.
Compares using `equal'."
Annotations listed under the pseudo-property PARAMETER are considered to be
arguments of the immediately surrounding annotation; the text between the
opening and closing parameter annotations is deleted from the buffer but saved
-as a string. The surrounding annotation should be listed under the
-pseudo-property FUNCTION. Instead of inserting a text-property for this
-annotation, the function listed in the VALUE slot is called to make whatever
-changes are appropriate. The function's first two arguments are the START and
-END locations, and the rest of the arguments are any PARAMETERs found in that
-region.
+as a string.
+
+The surrounding annotation should be listed under the pseudo-property
+FUNCTION. Instead of inserting a text-property for this annotation,
+the function listed in the VALUE slot is called to make whatever
+changes are appropriate. It can also return a list of the form
+\(START LOC PROP VALUE) which specifies a property to put on. The
+function's first two arguments are the START and END locations, and
+the rest of the arguments are any PARAMETERs found in that region.
Any annotations that are found by NEXT-FN but not defined by TRANSLATIONS
are saved as values of the `unknown' text-property \(which is list-valued).
(delete-region loc end)
(cond
;; Positive annotations are stacked, remembering location
- (positive (setq open-ans (cons `(,name ((,loc . nil))) open-ans)))
+ (positive (push `(,name ((,loc . nil))) open-ans))
;; It is a negative annotation:
;; Close the top annotation & add its text property.
;; If the file's nesting is messed up, the close might not match
;; Not a property, but a function.
(let ((rtn
(apply value start loc params)))
- (if rtn (setq todo (cons rtn todo)))))
+ (if rtn (push rtn todo))))
(t
;; Normal property/value pair
(setq todo
(cond
;; The minuend starts after the subtrahend ends; keep it.
((> (car m) (cdr s))
- (setq results (cons m results)
- minuend (cdr minuend)
+ (push m results)
+ (setq minuend (cdr minuend)
m (car minuend)))
;; The minuend extends beyond the end of the subtrahend. Chop it off.
((or (null (cdr m)) (> (cdr m) (cdr s)))
- (setq results (cons (cons (1+ (cdr s)) (cdr m)) results))
+ (push (cons (1+ (cdr s)) (cdr m)) results)
(setcdr m (cdr s)))
;; The subtrahend starts after the minuend ends; throw it away.
((< (cdr m) (car s))
(while (not (equal (car neg-ans) (car open-ans)))
;; To close anno. N, need to first close ans 1 to N-1,
;; remembering to re-open them later.
- (setq pos-ans (cons (car open-ans) pos-ans))
+ (push (car open-ans) pos-ans)
(setq all-ans
(cons (cons loc (funcall format-fn (car open-ans) nil))
all-ans))
;; Now remove the one we're really interested in from open list.
(setq open-ans (cdr open-ans))
;; And put the closing annotation here.
- (setq all-ans
- (cons (cons loc (funcall format-fn (car neg-ans) nil))
- all-ans)))
+ (push (cons loc (funcall format-fn (car neg-ans) nil))
+ all-ans))
(setq neg-ans (cdr neg-ans)))
;; Now deal with positive (opening) annotations
(let ((p pos-ans))
(while pos-ans
- (setq open-ans (cons (car pos-ans) open-ans))
- (setq all-ans
- (cons (cons loc (funcall format-fn (car pos-ans) t))
- all-ans))
+ (push (car pos-ans) open-ans)
+ (push (cons loc (funcall format-fn (car pos-ans) t))
+ all-ans)
(setq pos-ans (cdr pos-ans))))))
;; Close any annotations still open
(setq p before-plist)
(while p
(if (not (memq (car p) props))
- (setq props (cons (car p) props)))
+ (push (car p) props))
(setq p (cdr (cdr p))))
(setq p after-plist)
(while p
(if (not (memq (car p) props))
- (setq props (cons (car p) props)))
+ (push (car p) props))
(setq p (cdr (cdr p))))
(while props
- (setq prop (car props)
- props (cdr props))
+ (setq prop (pop props))
(if (memq prop ignore)
nil ; If it's been ignored before, ignore it now.
(let ((before (if all nil (car (cdr (memq prop before-plist)))))
(let ((result (format-annotate-single-property-change
prop before after translations)))
(if (not result)
- (setq not-found (cons prop not-found))
+ (push prop not-found)
(setq negatives (nconc negatives (car result))
positives (nconc positives (cdr result)))))))))
(vector negatives positives not-found)))
--- /dev/null
--- /dev/null
++2002-10-16 Dave Love <fx@gnu.org>
++
++ * mm-bodies.el (mm-encode-body): Doc fix.
++
++ * qp.el (quoted-printable-encode-region): Fix non-Emacs 22 case.
++
++2002-10-09 Dave Love <fx@gnu.org>
++
++ * qp.el (quoted-printable-encode-region): Fix non-multibyte search
++ for Emacs 22.
++
++2002-10-07 Dave Love <fx@gnu.org>
++
++ * qp.el (quoted-printable-encode-region): Go to start of range
++ before searching.
++ (quoted-printable-encode-region): Use multibyte-char-to-unibyte.
++
++2002-09-05 Dave Love <fx@gnu.org>
++
++ * qp.el (quoted-printable-decode-region): Use mm-insert-byte.
++
++ * mm-util.el (mm-hack-charsets, mm-iso-8859-15-compatible)
++ (mm-iso-8859-x-to-15-table, mm-iso-8859-x-to-15-region): Deleted.
++ (mm-find-mime-charset-region): Remove hack-charsets stuff.
++ (mm-insert-byte): New.
++
++ * rfc2047.el (message-posting-charset): defvar when compiling.
++ (rfc2047-header-encoding-alist): Add `address-mime' part.
++ (rfc2047-charset-encoding-alist): Use B for iso-8859-7. Doc fix.
++ (rfc2047-q-encoding-alist): Augment header list.
++ (rfc2047-encodable-p): Use mm-find-mime-charset-region.
++ (rfc2047-special-chars, rfc2047-non-special-chars): New.
++ (rfc2047-dissect-region, rfc2047-encode-region, rfc2047-encode):
++ Rewritten to avoid charset stuff and to take account of rfc2822
++ tokens.
++ (rfc2047-encode-message-header): Don't include header name field
++ in encoding. Add `address-mime' case and bind
++ rfc2047-special-chars for `mime' case.
++
++2002-08-21 Kenichi Handa <handa@etl.go.jp>
++
++ * qp.el (quoted-printable-decode-region): Insert bytes by
++ `insert-byte'.
++
++2002-08-18 Dave Love <fx@gnu.org>
++
++ * rfc2047.el (rfc2047-encode): Fix last change.
++
++2002-07-30 Dave Love <fx@gnu.org>
++
++ * rfc2047.el (rfc2047-charset-encoding-alist): Use B for Hebrew.
++ Doc fix.
++
++ * gnus-start.el (gnus-read-newsrc-el-file): Don't bind
++ coding-system-for-read.
++ (gnus-gnus-to-quick-newsrc-format): Insert coding cookie.
++
++2002-07-09 Dave Love <fx@gnu.org>
++
++ * mm-util.el (mm-find-mime-charset-region): Fix :mime-charset
++ part.
++
++2002-06-26 Dave Love <fx@gnu.org>
++
++ * rfc2047.el (rfc2047-encodable-p): Avoid mm-find-charset-region.
++ (rfc2047-dissect-region): Don't record charsets.
++ (rfc2047-encode): Remove arg CHARSET.
++ (rfc2047-encode-region): Change rfc2047-encode call.
++
++2002-06-24 Dave Love <fx@gnu.org>
++
++ * mm-util.el (mm-mule4-p, mm-enable-multibyte-mule4)
++ (mm-disable-multibyte-mule4)
++ (mm-with-unibyte-current-buffer-mule4): Deleted.
++
++ * gnus-sum.el (gnus-summary-mode, gnus-summary-display-article)
++ (gnus-summary-select-article, gnus-summary-edit-article): Use
++ mm-{en,dis}able-multibyte, not mm-{en,dis}able-multibyte-mule4.
++
++ * message.el (message-forward-make-body): Use
++ mm-{en,dis}able-multibyte, not mm-{en,dis}able-multibyte-mule4.
++
++ * qp.el (quoted-printable-encode-region): Avoid
++ find-charset-region.
++
++ * mm-bodies.el (mm-body-7-or-8): Don't special-case Mule.
++ (mm-encode-body): Just call mm-encode-coding-region in encoding
++ case.
++
++2002-05-27 Dave Love <fx@gnu.org>
++
++ * mm-util.el (mm-auto-save-coding-system): Prefer utf-8-emacs
++ coding system to emacs-mule.
++
++2002-05-14 Dave Love <fx@gnu.org>
++
++ * mm-util.el (mm-mime-mule-charset-alist)
++ (mm-mule-charset-to-mime-charset, mm-charset-to-coding-system)
++ (mm-mime-charset, mm-find-mime-charset-region): Look for
++ `:mime-charset' property of coding systems before `mime-charset'.
++
++;; Local Variables:
++;; coding: iso-2022-7bit
++;; End:
++
++ Copyright (C) 2002 Free Software Foundation, Inc.
++ Copying and distribution of this file, with or without modification,
++ are permitted provided the copyright notice and this notice are preserved.
;;; 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.")
(gnus-message 5 "Reading %s..." ding-file)
(let (gnus-newsrc-assoc)
(condition-case nil
- (let ((coding-system-for-read gnus-ding-file-coding-system))
- (load ding-file t t t))
+ (load ding-file t t t)
(error
(ding)
(unless (gnus-yes-or-no-p
reads nil)
(if (eolp)
;; If the line ends here, this is clearly a buggy line, so
- ;; we put point a the beginning of line and let the cond
+ ;; we put point at the beginning of line and let the cond
;; below do the error handling.
(beginning-of-line)
;; We skip to the beginning of the ranges.
(let ((print-quoted t)
(print-escape-newlines t))
- (insert ";; -*- emacs-lisp -*-\n")
+ (insert ";; -*- emacs-lisp; coding: "
+ (format "%s" gnus-ding-file-coding-system) ";-*-\n")
(insert ";; Gnus startup file.\n")
(insert "\
;; Never delete this file -- if you want to force Gnus to read the
(save-excursion
(set-buffer gnus-dribble-buffer)
(let ((slave-name
- (make-temp-name (concat gnus-current-startup-file "-slave-")))
+ (mm-make-temp-file (concat gnus-current-startup-file "-slave-")))
(modes (ignore-errors
(file-modes (concat gnus-current-startup-file ".eld")))))
(let ((coding-system-for-write gnus-ding-file-coding-system))
;;; gnus-sum.el --- summary mode commands for Gnus
- ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
++;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
the end of an article.
If nil, the marking commands do NOT go to the next unread article
-(they go to the next article instead). If `never', commands that
+\(they go to the next article instead). If `never', commands that
usually go to the next unread article, will go to the next article,
whether it is read or not."
:group 'gnus-summary-marks
. gnus-summary-normal-read-face))
"*Controls the highlighting of summary buffer lines.
-A list of (FORM . FACE) pairs. When deciding how a a particular
-summary line should be displayed, each form is evaluated. The content
-of the face field after the first true form is used. You can change
-how those summary lines are displayed, by editing the face field.
+A list of (FORM . FACE) pairs. When deciding how a particular summary
+line should be displayed, each form is evaluated. The content of the
+face field after the first true form is used. You can change how those
+summary lines are displayed, by editing the face field.
You can use the following variables in the FORM field.
(defcustom gnus-alter-header-function nil
"Function called to allow alteration of article header structures.
The function is called with one parameter, the article header vector,
-which it may alter in any way.")
+which it may alter in any way."
+ :type '(choice (const :tag "None" nil)
+ function)
+ :group 'gnus-summary)
(defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string
"Variable that says which function should be used to decode a string with encoded words.")
gnus-article-commands-menu gnus-article-mode-map ""
(cons "Commands" innards))
;; in Emacs, don't share menu.
- (setq gnus-article-commands-menu
+ (setq gnus-article-commands-menu
(copy-keymap gnus-summary-article-menu))
(define-key gnus-article-mode-map [menu-bar commands]
(cons "Commands" gnus-article-commands-menu))))
(defvar gnus-summary-tool-bar-map nil)
;; Emacs 21 tool bar. Should be no-op otherwise.
+;; NB: A new function tool-bar-local-item-from-menu is added in Emacs
+;; 21.2.50+. Considering many users use Emacs 21, use
+;; tool-bar-add-item-from-menu here.
(defun gnus-summary-make-tool-bar ()
- (if (and (fboundp 'tool-bar-add-item-from-menu)
- (default-value 'tool-bar-mode)
- (not gnus-summary-tool-bar-map))
+ (if (and
+ (condition-case nil (require 'tool-bar) (error nil))
+ (fboundp 'tool-bar-add-item-from-menu)
+ (default-value 'tool-bar-mode)
+ (not gnus-summary-tool-bar-map))
(setq gnus-summary-tool-bar-map
(let ((tool-bar-map (make-sparse-keymap)))
(tool-bar-add-item-from-menu
(defmacro gnus-summary-article-number ()
"The article number of the article on the current line.
-If there isn's an article number here, then we return the current
+If there isn't an article number here, then we return the current
article number."
'(progn
(gnus-summary-skip-intangible)
[0 "" "" "" "" "" 0 0 "" nil] 0 nil 128 t nil "" nil 1)
(goto-char (point-min))
(setq pos (list (cons 'unread (and (search-forward "\200" nil t)
- (- (point) 2)))))
+ (- (point) (point-min) 1)))))
(goto-char (point-min))
(push (cons 'replied (and (search-forward "\201" nil t)
- (- (point) 2)))
+ (- (point) (point-min) 1)))
pos)
(goto-char (point-min))
- (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2)))
+ (push (cons 'score (and (search-forward "\202" nil t)
+ (- (point) (point-min) 1)))
pos)
(goto-char (point-min))
(push (cons 'download
- (and (search-forward "\203" nil t) (- (point) 2)))
+ (and (search-forward "\203" nil t)
+ (- (point) (point-min) 1)))
pos)))
(setq gnus-summary-mark-positions pos))))
(let ((gnus-newsgroup-dormant nil))
(gnus-summary-initial-limit show-all))
(gnus-summary-initial-limit show-all))
- ;; When untreaded, all articles are always shown.
+ ;; When unthreaded, all articles are always shown.
(setq gnus-newsgroup-limit
(mapcar
(lambda (header) (mail-header-number header))
threads
(gnus-message 8 "Sorting threads...")
(prog1
- (gnus-sort-threads-1
- threads
+ (gnus-sort-threads-1
+ threads
(gnus-make-sort-function gnus-thread-sort-functions))
(gnus-message 8 "Sorting threads...done"))))
gnus-list-identifiers
(mapconcat 'identity gnus-list-identifiers " *\\|"))))
(dolist (header gnus-newsgroup-headers)
- (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
+ (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
" *\\)\\)+\\(Re: +\\)?\\)")
(mail-header-subject header))
(mail-header-set-subject
(gnus-sorted-complement gnus-newsgroup-unreads articles)))
(when gnus-alter-articles-to-read-function
(setq gnus-newsgroup-unreads
- (sort
+ (sort
(funcall gnus-alter-articles-to-read-function
gnus-newsgroup-name gnus-newsgroup-unreads)
'<)))
(unless (memq (cdr type) uncompressed)
(setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
-
+
(when (gnus-check-backend-function
'request-set-mark gnus-newsgroup-name)
;; propagate flags to server, with the following exceptions:
(push (list add 'add (list (cdr type))) delta-marks))
(when del
(push (list del 'del (list (cdr type))) delta-marks)))))
-
+
(when list
(push (cons (cdr type) list) newmarked)))
(unless (gnus-check-group gnus-newsgroup-name)
(error "Can't open server for %s" gnus-newsgroup-name))
(gnus-request-set-mark gnus-newsgroup-name delta-marks))
-
+
;; Enter these new marks into the info of the group.
(if (nthcdr 3 info)
(setcar (nthcdr 3 info) newmarked)
(let* ((mformat (symbol-value
(intern
(format "gnus-%s-mode-line-format-spec" where))))
- (gnus-tmp-group-name (gnus-group-name-decode
+ (gnus-tmp-group-name (gnus-group-name-decode
gnus-newsgroup-name
- (gnus-group-name-charset
+ (gnus-group-name-charset
nil
gnus-newsgroup-name)))
(gnus-tmp-article-number (or gnus-current-article 0))
(defun gnus-summary-toggle-truncation (&optional arg)
"Toggle truncation of summary lines.
-With arg, turn line truncation on iff arg is positive."
+With arg, turn line truncation on if arg is positive."
(interactive "P")
(setq truncate-lines
(if (null arg) (not truncate-lines)
(list
(when current-prefix-arg
(completing-read
- "Faq dir: " (and (listp gnus-group-faq-directory)
+ "FAQ dir: " (and (listp gnus-group-faq-directory)
(mapcar (lambda (file) (list file))
gnus-group-faq-directory))))))
(let (gnus-faq-buffer)
(defun gnus-summary-limit-to-subject (subject &optional header not-matching)
"Limit the summary buffer to articles that have subjects that match a regexp.
If NOT-MATCHING, excluding articles that have subjects that match a regexp."
- (interactive
+ (interactive
(list (read-string (if current-prefix-arg
"Exclude subject (regexp): "
- "Limit to subject (regexp): "))
+ "Limit to subject (regexp): "))
nil current-prefix-arg))
(unless header
(setq header "subject"))
(when (not (equal "" subject))
(prog1
(let ((articles (gnus-summary-find-matching
- (or header "subject") subject 'all nil nil
+ (or header "subject") subject 'all nil nil
not-matching)))
(unless articles
(error "Found no matches for \"%s\"" subject))
(defun gnus-summary-limit-to-author (from &optional not-matching)
"Limit the summary buffer to articles that have authors that match a regexp.
If NOT-MATCHING, excluding articles that have authors that match a regexp."
- (interactive
+ (interactive
(list (read-string (if current-prefix-arg
"Exclude author (regexp): "
- "Limit to author (regexp): "))
+ "Limit to author (regexp): "))
current-prefix-arg))
(gnus-summary-limit-to-subject from "from" not-matching))
nil
t))))
(list header
- (read-string (format "%s header %s (regexp): "
+ (read-string (format "%s header %s (regexp): "
(if current-prefix-arg "Exclude" "Limit to")
header))
current-prefix-arg)))
(when (not (equal "" regexp))
(prog1
(let ((articles (gnus-summary-find-matching
- (cons 'extra header) regexp 'all nil nil
+ (cons 'extra header) regexp 'all nil nil
not-matching)))
(unless articles
(error "Found no matches for \"%s\"" regexp))
(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
(make-obsolete 'gnus-summary-delete-marked-with
- 'gnus-summary-limit-exlude-marks)
+ 'gnus-summary-limit-exclude-marks)
(defun gnus-summary-limit-exclude-marks (marks &optional reverse)
"Exclude articles that are marked with MARKS (e.g. \"DK\").
(gnus-message 3 "Couldn't fetch article %s" message-id)))))))
(defun gnus-refer-article-methods ()
- "Return a list of referrable methods."
+ "Return a list of referable methods."
(cond
;; No method, so we default to current and native.
((null gnus-refer-article-method)
;; the parent article.
(when (setq to-address (or (message-fetch-field "reply-to")
(message-fetch-field "from")))
- (setq params (append
- (list (cons 'to-address
+ (setq params (append
+ (list (cons 'to-address
(funcall gnus-decode-encoded-word-function
to-address))))))
(setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
BACKWARD is non-nil. If BACKWARD is `all', do all articles.
If UNREAD is non-nil, only unread articles will
be taken into consideration. If NOT-CASE-FOLD, case won't be folded
-in the comparisons. If NOT-MATCHING, return a list of all articles that
+in the comparisons. If NOT-MATCHING, return a list of all articles that
not match REGEXP on HEADER."
(let ((case-fold-search (not not-case-fold))
articles d func)
(gnus-data-unread-p d)) ; Or just unreads.
(vectorp (gnus-data-header d)) ; It's not a pseudo.
(if not-matching
- (not (string-match
+ (not (string-match
regexp
(funcall func (gnus-data-header d))))
(string-match regexp
(save-restriction
(let* ((buffer-read-only nil)
(inhibit-point-motion-hooks t)
- hidden e)
+ hidden s e)
(setq hidden
(if (numberp arg)
(>= arg 0)
(when (search-forward "\n\n" nil t)
(delete-region (point-min) (1- (point))))
(goto-char (point-min))
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (goto-char (point-min))
+ (with-current-buffer gnus-original-article-buffer
+ (goto-char (setq s (point-min)))
(setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
- (insert-buffer-substring gnus-original-article-buffer 1 e)
+ (insert-buffer-substring gnus-original-article-buffer s e)
(save-restriction
(narrow-to-region (point-min) (point))
(article-decode-encoded-words)
"Edit the current article.
This will have permanent effect only in mail groups.
If ARG is nil, edit the decoded articles.
-If ARG is 1, edit the raw articles.
+If ARG is 1, edit the raw articles.
If ARG is 2, edit the raw articles even in read-only groups.
Otherwise, allow editing of articles even in read-only
groups."
(interactive "P")
(let (force raw)
- (cond
+ (cond
((null arg))
((eq arg 1) (setq raw t))
((eq arg 2) (setq raw t
(if (equal gnus-newsgroup-name "nndraft:drafts")
(setq raw t))
(gnus-article-edit-article
- (if raw 'ignore
- #'(lambda ()
+ (if raw 'ignore
+ #'(lambda ()
(let ((mbl mml-buffer-list))
(setq mml-buffer-list nil)
(mime-to-mml)
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
`(lambda (no-highlight)
(let ((mail-parse-charset ',gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
+ (mail-parse-ignored-charsets
',gnus-newsgroup-ignored-charsets))
- ,(if (not raw) '(progn
+ ,(if (not raw) '(progn
(mml-to-mime)
(mml-destroy-buffers)
- (remove-hook 'kill-buffer-hook
+ (remove-hook 'kill-buffer-hook
'mml-destroy-buffers t)
(kill-local-variable 'mml-buffer-list)))
(gnus-summary-edit-article-done
,(or (mail-header-references gnus-current-headers) "")
- ,(gnus-group-read-only-p)
+ ,(gnus-group-read-only-p)
,gnus-summary-buffer no-highlight))))))))
(defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
If N is negative, mark backwards instead. Mark with MARK, ?r by default.
The difference between N and the actual number of articles marked is
returned.
-Iff NO-EXPIRE, auto-expiry will be inhibited."
+If NO-EXPIRE, auto-expiry will be inhibited."
(interactive "p")
(gnus-summary-show-thread)
(let ((backward (< n 0))
If MARK is nil, then the default character `?r' is used.
If ARTICLE is nil, then the article on the current line will be
marked.
-Iff NO-EXPIRE, auto-expiry will be inhibited."
+If NO-EXPIRE, auto-expiry will be inhibited."
;; The mark might be a string.
(when (stringp mark)
(setq mark (aref mark 0)))
"Save parts matching TYPE to DIR.
If REVERSE, save parts that do not match TYPE."
(interactive
- (list (read-string "Save parts of type: "
+ (list (read-string "Save parts of type: "
(or (car gnus-summary-save-parts-type-history)
gnus-summary-save-parts-default-mime)
'gnus-summary-save-parts-type-history)
(setq gnus-summary-save-parts-last-directory
- (read-file-name "Save to directory: "
+ (read-file-name "Save to directory: "
gnus-summary-save-parts-last-directory
nil t))
current-prefix-arg))
`(progn
(gnus-info-set-marks ',info ',(gnus-info-marks info) t)
(gnus-info-set-read ',info ',(gnus-info-read info))
- (gnus-get-unread-articles-in-group ',info
+ (gnus-get-unread-articles-in-group ',info
(gnus-active ,group))
(gnus-group-update-group ,group t)
,setmarkundo))))
mark (car lway) lway name)))
(setq func (eval func))
(define-key map (nth 4 lway) func)))))
-
+
(defun gnus-summary-make-marking-command-1 (mark way lway name)
`(defun ,(intern
(format "gnus-summary-put-mark-as-%s%s"
name (cadr lway))
(interactive "p")
(gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway))))
-
+
(defun gnus-summary-generic-mark (n mark move unread)
"Mark N articles with MARK."
(unless (eq major-mode 'gnus-summary-mode)
(string-as-unibyte . identity)
(string-as-multibyte . identity)
(multibyte-string-p . ignore)
- (insert-byte . insert))))
+ (point-at-bol . line-beginning-position)
+ (point-at-eol . line-end-position)
+ (insert-byte . insert-char)
+ (multibyte-char-to-unibyte . identity))))
(eval-and-compile
(defalias 'mm-char-or-char-int-p
,@(unless (mm-coding-system-p 'gb2312)
'((gb2312 . cn-gb-2312)))
;; ISO-8859-15 is very similar to ISO-8859-1.
+ ;; But this is just wrong. --fx
,@(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it.
'((iso-8859-15 . iso-8859-1)))
;; Windows-1252 is actually a superset of Latin-1. See also
;; `gnus-article-dumbquotes-map'.
- ,@(unless (mm-coding-system-p 'windows-1252)
+ ,@(unless (mm-coding-system-p 'windows-1252)
(if (mm-coding-system-p 'cp1252)
'((windows-1252 . cp1252))
'((windows-1252 . iso-8859-1))))
;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
;; Outlook users in Czech republic. Use this to allow reading of their
;; e-mails. cp1250 should be defined by M-x codepage-setup.
+
+ ;; This is not TRT, the MIME name, windows-1250, should be an
+ ;; alias, and cp1250 should have a mime-charset property, per
+ ;; code-page.el. -- fx
,@(if (and (not (mm-coding-system-p 'windows-1250))
(mm-coding-system-p 'cp1250))
'((windows-1250 . cp1250)))
(coding-system-get cs 'safe-charsets))))))
(sort-coding-systems (coding-system-list 'base-only))))))
- (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.")
-
(defvar mm-coding-system-priorities nil
"Preferred coding systems for encoding outgoing mails.
'(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8))
")
+;; Why on earth was this broken out? -- fx
(defvar mm-use-find-coding-systems-region
(fboundp 'find-coding-systems-region)
"Use `find-coding-systems-region' to find proper coding systems.")
enable-multibyte-characters
(featurep 'mule)))
- (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 (prog1 (+ c (car (cdr item))) (delete-char 1))))
- (skip-chars-forward "\0-\177"))))
- (not inconvertible))))
-
(defun mm-sort-coding-systems-predicate (a b)
(> (length (memq a mm-coding-system-priorities))
(length (memq b mm-coding-system-priorities))))
- (defun mm-find-mime-charset-region (b e &optional hack-charsets)
+ (defun mm-find-mime-charset-region (b e)
"Return the MIME charsets needed to encode the region between B and E.
nil means ASCII, a single-element list represents an appropriate MIME
charset, and a longer list means no appropriate charset."
;; system that has one.
(let ((systems (find-coding-systems-region b e)))
(when mm-coding-system-priorities
- (setq systems
+ (setq systems
(sort systems 'mm-sort-coding-systems-predicate)))
;; Fixme: The `mime-charset' (`x-ctext') of `compound-text'
;; is not in the IANA list.
(setq systems nil
charsets (list cs))))))
charsets))
+ ;; Fixme: won't work for unibyte Emacs 22:
+
;; Otherwise we're not multibyte, XEmacs or a single coding
;; system won't cover it.
- (setq charsets
+ (setq charsets
(mm-delete-duplicates
(mapcar 'mm-mime-charset
(delq 'ascii
(mm-find-charset-region b e))))))
- (if (and (memq 'iso-8859-15 charsets)
- (memq 'iso-8859-15 hack-charsets)
- (save-excursion (mm-iso-8859-x-to-15-region b e)))
- (mapcar (lambda (x) (setq charsets (delq (car x) charsets)))
- mm-iso-8859-15-compatible))
- (if (and (memq 'iso-2022-jp-2 charsets)
- (memq 'iso-2022-jp-2 hack-charsets))
- (setq charsets (delq 'iso-2022-jp charsets)))
charsets))
(defmacro mm-with-unibyte-buffer (&rest forms)
Equivalent to `progn' in XEmacs"
(let ((multibyte (make-symbol "multibyte"))
(buffer (make-symbol "buffer")))
- `(if mm-emacs-mule
+ `(if mm-emacs-mule
(let ((,multibyte enable-multibyte-characters)
(,buffer (current-buffer)))
(unwind-protect
(push dir result))
(push path result))))
+;; It is not a MIME function, but some MIME functions use it.
+(defalias 'mm-make-temp-file
+ (if (fboundp 'make-temp-file)
+ 'make-temp-file
+ (lambda (prefix &optional dir-flag)
+ (let ((file (expand-file-name
+ (make-temp-name prefix)
+ (if (fboundp 'temp-directory)
+ (temp-directory)
+ temporary-file-directory))))
+ (if dir-flag
+ (make-directory file))
+ file))))
+
(provide 'mm-util)
;;; mm-util.el ends here
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
+;; Copyright (C) 2002 Free Software Foundation, Inc.
;; Keywords: CCL, mule, multilingual, character set, coding-system
;;; Commentary:
;; CCL (Code Conversion Language) is a simple programming language to
-;; be used for various kind of code conversion. CCL program is
-;; compiled to CCL code (vector of integers) and executed by CCL
-;; interpreter of Emacs.
+;; be used for various kind of code conversion. A CCL program is
+;; compiled to CCL code (vector of integers) and executed by the CCL
+;; interpreter in Emacs.
;;
;; CCL is used for code conversion at process I/O and file I/O for
-;; non-standard coding-system. In addition, it is used for
-;; calculating a code point of X's font from a character code.
+;; non-standard coding-systems. In addition, it is used for
+;; calculating code points of X fonts from character codes.
;; However, since CCL is designed as a powerful programming language,
;; it can be used for more generic calculation. For instance,
;; combination of three or more arithmetic operations can be
-;; calculated faster than Emacs Lisp.
+;; calculated faster than in Emacs Lisp.
;;
-;; Syntax and semantics of CCL program is described in the
+;; The syntax and semantics of CCL programs are described in the
;; documentation of `define-ccl-program'.
;;; Code:
read read-if read-branch write call end
read-multibyte-character write-multibyte-character
translate-character
- iterate-multiple-map map-multiple map-single]
+ iterate-multiple-map map-multiple map-single lookup-integer
+ lookup-character]
"Vector of CCL commands (symbols).")
;; Put a property to each symbol of CCL commands for the compiler.
iterate-multiple-map
map-multiple
map-single
+ lookup-int-const-tbl
+ lookup-char-const-tbl
]
"Vector of CCL extended compiled codes (symbols).")
;; Embed pair of SYMBOL and PROP where (get SYMBOL PROP) should give
;; proper index number for SYMBOL. PROP should be
-;; `translation-table-id', `code-conversion-map-id', or
-;; `ccl-program-idx'.
+;; `translation-table-id', `translation-hash-table-id'
+;; `code-conversion-map-id', or `ccl-program-idx'.
(defun ccl-embed-symbol (symbol prop)
(ccl-embed-data (cons symbol prop)))
;; If REG is a CCL register symbol (e.g. r0, r1...), the register
;; number is embedded. If OP is one of unconditional jumps, DATA is
-;; changed to an relative jump address.
+;; changed to a relative jump address.
(defun ccl-embed-code (op reg data &optional reg2)
(if (and (> data 0) (get op 'jump-flag))
(ccl-embed-data op)
(ccl-embed-data arg))
(ccl-check-register arg cmd)
- (ccl-embed-code (if read-flag 'read-jump-cond-expr-register
+ (ccl-embed-code (if read-flag 'read-jump-cond-expr-register
'jump-cond-expr-register)
rrr 0)
(ccl-embed-data op)
(error "CCL: Invalid argument %s: %s" arg cmd)))
(ccl-embed-code 'read-jump rrr ccl-loop-head))
t)
-
+
;; Compile READ statement.
(defun ccl-compile-read (cmd)
(if (< (length cmd) 2)
(ccl-embed-extended-command 'translate-character rrr RRR Rrr))))
nil)
+;; Compile lookup-integer
+(defun ccl-compile-lookup-integer (cmd)
+ (if (/= (length cmd) 4)
+ (error "CCL: Invalid number of arguments: %s" cmd))
+ (let ((Rrr (nth 1 cmd))
+ (RRR (nth 2 cmd))
+ (rrr (nth 3 cmd)))
+ (ccl-check-register RRR cmd)
+ (ccl-check-register rrr cmd)
+ (cond ((and (symbolp Rrr) (not (get Rrr 'ccl-register-number)))
+ (ccl-embed-extended-command 'lookup-int-const-tbl
+ rrr RRR 0)
+ (ccl-embed-symbol Rrr 'translation-hash-table-id))
+ (t
+ (error "CCL: non-constant table: %s" cmd)
+ ;; not implemented:
+ (ccl-check-register Rrr cmd)
+ (ccl-embed-extended-command 'lookup-int rrr RRR 0))))
+ nil)
+
+;; Compile lookup-character
+(defun ccl-compile-lookup-character (cmd)
+ (if (/= (length cmd) 4)
+ (error "CCL: Invalid number of arguments: %s" cmd))
+ (let ((Rrr (nth 1 cmd))
+ (RRR (nth 2 cmd))
+ (rrr (nth 3 cmd)))
+ (ccl-check-register RRR cmd)
+ (ccl-check-register rrr cmd)
+ (cond ((and (symbolp Rrr) (not (get Rrr 'ccl-register-number)))
+ (ccl-embed-extended-command 'lookup-char-const-tbl
+ rrr RRR 0)
+ (ccl-embed-symbol Rrr 'translation-hash-table-id))
+ (t
+ (error "CCL: non-constant table: %s" cmd)
+ ;; not implemented:
+ (ccl-check-register Rrr cmd)
+ (ccl-embed-extended-command 'lookup-char rrr RRR 0))))
+ nil)
+
(defun ccl-compile-iterate-multiple-map (cmd)
(ccl-compile-multiple-map-function 'iterate-multiple-map cmd)
nil)
add 1))
(setq arg (cdr arg)
len (+ len add)))
- (if mp
+ (if mp
(cons (- len) result)
result))))
(setq arg (append (list (nth 0 cmd) (nth 1 cmd) (nth 2 cmd))
(setq args (cdr args)))))
\f
-;;; CCL dump staffs
+;;; CCL dump stuff
;; To avoid byte-compiler warning.
(defvar ccl-code)
(rrr (ash (logand code 255) -5))
(cc (ash code -8)))
(insert (format "%5d:[%s] " (1- ccl-current-ic) cmd))
- (funcall (get cmd 'ccl-dump-function) rrr cc)))
+ (funcall (get cmd 'ccl-dump-function) rrr cc)))
(defun ccl-dump-set-register (rrr cc)
(insert (format "r%d = r%d\n" rrr cc)))
(let ((tbl (ccl-get-next-code)))
(insert (format "translation table(%S) r%d r%d\n" tbl RRR rrr))))
+(defun ccl-dump-lookup-int-const-tbl (rrr RRR Rrr)
+ (let ((tbl (ccl-get-next-code)))
+ (insert (format "hash table(%S) r%d r%d\n" tbl RRR rrr))))
+
+(defun ccl-dump-lookup-char-const-tbl (rrr RRR Rrr)
+ (let ((tbl (ccl-get-next-code)))
+ (insert (format "hash table(%S) r%d r%d\n" tbl RRR rrr))))
+
(defun ccl-dump-iterate-multiple-map (rrr RRR Rrr)
(let ((notbl (ccl-get-next-code))
(i 0) id)
(insert (format "map-single r%d r%d map(%S)\n" RRR rrr id))))
\f
-;; CCL emulation staffs
+;; CCL emulation staffs
;; Not yet implemented.
\f
STATEMENT :=
SET | IF | BRANCH | LOOP | REPEAT | BREAK | READ | WRITE | CALL
- | TRANSLATE | END
+ | TRANSLATE | MAP | LOOKUP | END
SET := (REG = EXPRESSION)
| (REG ASSIGNMENT_OPERATOR EXPRESSION)
;; (REG <8= ARG) is the same as:
;; ((REG <<= 8)
;; (REG |= ARG))
- | <8=
+ | <8=
;; (REG >8= ARG) is the same as:
;; ((r7 = (REG & 255))
(translate-character REG(table) REG(charset) REG(codepoint))
| (translate-character SYMBOL REG(charset) REG(codepoint))
;; SYMBOL must refer to a table defined by `define-translation-table'.
+LOOKUP :=
+ (lookup-character SYMBOL REG(charset) REG(codepoint))
+ | (lookup-integer SYMBOL REG(integer))
+ ;; SYMBOL refers to a table defined by `define-translation-hash-table'.
MAP :=
(iterate-multiple-map REG REG MAP-IDs)
| (map-multiple REG REG (MAP-SET))
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) 1995, 1997 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
-;; Copyright (C) 2001, 2002
++;; 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:
;;; Predefined categories.
(define-category ?| "While filling, we can break a line at this character.")
;; For indentation calculation.
-(define-category ?
+(define-category ?\s
"This character counts as a space for indentation purposes.")
;; Keep the following for `kinsoku' processing. See comments in
;; 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 characters (Unicode)
+ (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) ?|)
;; 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")
- ;; Unicode equivalents of above
- (modify-syntax-entry ?\\e$,2=T\e(B "(\e$,2=U\e(B")
- (modify-syntax-entry ?\\e$,2=H\e(B "(\e$,2=I\e(B")
- (modify-syntax-entry ?\\e$,2=J\e(B "(\e$,2=K\e(B")
- (modify-syntax-entry ?\\e$,2=L\e(B "(\e$,2=M\e(B")
- (modify-syntax-entry ?\\e$,2=N\e(B "(\e$,2=O\e(B")
- (modify-syntax-entry ?\\e$,2=V\e(B "(\e$,2=W\e(B")
- (modify-syntax-entry ?\\e$,2=P\e(B "(\e$,2=Q\e(B")
- (modify-syntax-entry ?\\e$,2=U\e(B ")\e$,2=T\e(B")
- (modify-syntax-entry ?\\e$,2=I\e(B ")\e$,2=H\e(B")
- (modify-syntax-entry ?\\e$,2=K\e(B ")\e$,2=J\e(B")
- (modify-syntax-entry ?\\e$,2=M\e(B ")\e$,2=L\e(B")
- (modify-syntax-entry ?\\e$,2=O\e(B ")\e$,2=N\e(B")
- (modify-syntax-entry ?\\e$,2=W\e(B ")\e$,2=V\e(B")
- (modify-syntax-entry ?\\e$,2=Q\e(B ")\e$,2=P\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))))
+ (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)
+
+ (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?c)
+ (map-charset-chars #'modify-category-entry 'chinese-gb2312 ?|)
+ (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)
;; 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))))
-
- (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)
-
- (modify-category-entry generic-big5-1-char ?C)
- (modify-category-entry generic-big5-2-char ?C)
-
- (modify-category-entry generic-big5-1-char ?\|)
- (modify-category-entry generic-big5-2-char ?\|))
+ (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)
+ (map-charset-chars #'modify-category-entry 'big5 ?|)
;; 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))))
-
- ;; Cyrillic character set (ISO-8859-5)
-
- (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))))
-
- ;; Ethiopic character set
-
- (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-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-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))
+ (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))
+ (map-charset-chars #'modify-category-entry c ?|))
- ;; Hebrew character set (ISO-8859-8)
-;; Japanese character set (JISX0201-kana, JISX0201-roman, JISX0208, JISX0212)
++;; Japanese character set (JISX0201, JISX0208, JISX0212, JISX0213)
- (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
+ (map-charset-chars #'modify-category-entry 'katakana-jisx0201 ?k)
- ;; Indian character set (IS 13194 and other Emacs original Indian charsets)
+ (map-charset-chars #'modify-category-entry 'latin-jisx0201 ?r)
- (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))
++(dolist (l '(katakana-jisx0201 japanese-jisx0208 japanese-jisx0212
++ japanese-jisx0213-1 japanese-jisx0213-2))
+ (map-charset-chars #'modify-category-entry l ?j)
- (map-charset-chars #'modify-category-entry l ?\|))
++ (if (eq l 'japanese-jisx0213-1)
++ (map-charset-chars #'modify-category-entry l ?\| #x2E21 #x7E7F)
++ (map-charset-chars #'modify-category-entry l ?\|)))
;; 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 . #x309f)))
++(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))))
- (modify-syntax-entry ?\\e$B!J\e(B "(\e$B!K\e(B")
- (modify-syntax-entry ?\\e$B!N\e(B "(\e$B!O\e(B")
- (modify-syntax-entry ?\\e$B!P\e(B "(\e$B!Q\e(B")
- (modify-syntax-entry ?\\e$B!V\e(B "(\e$B!W\e(B")
- (modify-syntax-entry ?\\e$B!X\e(B "(\e$B!Y\e(B")
- (modify-syntax-entry ?\\e$B!K\e(B ")\e$B!J\e(B")
- (modify-syntax-entry ?\\e$B!O\e(B ")\e$B!N\e(B")
- (modify-syntax-entry ?\\e$B!Q\e(B ")\e$B!P\e(B")
- (modify-syntax-entry ?\\e$B!W\e(B ")\e$B!V\e(B")
- (modify-syntax-entry ?\\e$B!Y\e(B ")\e$B!X\e(B")
-
- (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))))
;; 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)
-
- ;; 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) ?\ )
+ (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.
-(modify-syntax-entry ?\（ "(）")
-(modify-syntax-entry ?\ï¼» "(ï¼½")
-(modify-syntax-entry ?\ï½› "(ï½")
-(modify-syntax-entry ?\「 "(ã€")
-(modify-syntax-entry ?\『 "(ã€")
-(modify-syntax-entry ?\） ")（")
-(modify-syntax-entry ?\ï¼½ ")ï¼»")
-(modify-syntax-entry ?\ï½ ")ï½›")
-(modify-syntax-entry ?\〠")「")
-(modify-syntax-entry ?\〠")『")
-
-(modify-syntax-entry ?\〔 "(〕")
-(modify-syntax-entry ?\〈 "(〉")
-(modify-syntax-entry ?\《 "(》")
-(modify-syntax-entry ?\〖 "(〗")
-(modify-syntax-entry ?\〠"(】")
-(modify-syntax-entry ?\〕 ")〔")
-(modify-syntax-entry ?\〉 ")〈")
-(modify-syntax-entry ?\》 ")《")
-(modify-syntax-entry ?\〗 ")〖")
-(modify-syntax-entry ?\】 ")ã€")
-(modify-syntax-entry ?\〚 "(〛")
-(modify-syntax-entry ?\〛 ")〚")
++(let ((parens (concat "〈〉《》「ã€ã€Žã€ã€ã€‘〔〕〖〗〘〙〚〛"
++ "︵︶︷︸︹︺︻︼︽︾︿﹀ï¹ï¹‚﹃﹄"
++ "（）［］｛ï½"))
++ 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))))
- ;; Lao character set
+ ;; Arabic character set
- (modify-category-entry (make-char 'lao) ?o)
- (dotimes (i (1+ (- #xeff #xe80)))
- (modify-category-entry (decode-char 'ucs (+ i #xe80)) ?o))
+ (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)
- (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
+ ;; Cyrillic character set (ISO-8859-5)
+
+ (modify-syntax-entry ?â„– ".")
+
+ ;; Ethiopic character set
+
+ (modify-category-entry '(#x1200 . #x137b) ?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" ?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" ?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)
+
+ ;; Latin
+
+ (modify-category-entry '(#x80 . #x024F) ?l)
(let ((tbl (standard-case-table)) c)
;; In some languages, U+0049 LATIN CAPITAL LETTER I and U+0131 LATIN
;; SMALL LETTER DOTLESS I make a case pair, and so do U+0130 LATIN
;; CAPITAL LETTER I WITH DOT ABOVE and U+0069 LATIN SMALL LETTER I.
- ;; Thus we have to check language-environment to handle casing
- ;; correctly. Currently only I<->i is available.
+ ;; See the Turkish language environment.
+
+ ;; 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.
+ (set-case-syntax ? " " tbl) ; dubious
+ (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 #x0233)
- (modify-category-entry (decode-char 'ucs c) ?l)
(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))
+ (set-case-syntax-pair c (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))
+ (set-case-syntax-pair (1- c) c tbl))
(setq c (1+ c)))
- (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) ; these two have different length!
- (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 ?IJ ?ij 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)
;; 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-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)
+ (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 ?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)
+ (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)
;; 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)
+ (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)
+ (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)
;; 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))
++ (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)
- (setq c (decode-char 'ucs (1+ c))))
- (setq c #x2010)
+ (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:
(while (<= c #x2027)
- (set-case-syntax (decode-char 'ucs c) "_" tbl)
- (setq c (decode-char 'ucs (1+ c))))
+ (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
)
\f
- ;;; Setting word boundary.
-
- (setq word-combining-categories
- '((?l . ?l)))
-
- (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)
(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)
japanese-jisx0208 japanese-jisx0212
chinese-gb2312 chinese-big5-1 chinese-big5-2)))
(while l
- (aset auto-fill-chars (make-char (car l)) t)
+ ;;(aset auto-fill-chars (make-char (car l)) t)
(put-charset-property (car l) 'nospace-between-words t)
(setq l (cdr l))))
-
+
+ \f
+ ;; CJK double width characters.
+ (let ((l '((#x1100 . #x11FF)
+ (#x2E80 . #x9FAF)
+ (#xAC00 . #xD7AF)
+ (#xF900 . #xFAFF)
+ (#xFE30 . #xFE4F)
+ (#xFF00 . #xFF5F)
- (#xFFE0 . #xFFEF))))
++ (#xFFE0 . #xFFEF)
++ (#x20000 . #x2AFFF)
++ (#x2F800 . #x2FFFF))))
+ (dolist (elt l)
+ (set-char-table-range char-width-table
+ (cons (car elt) (cdr elt))
+ 2)))
+ ;; Fixme: Doing this affects non-CJK characters through unification,
+ ;; but presumably CJK users expect those characters to be
+ ;; double-width when using these charsets.
+ ;; (map-charset-chars
+ ;; #'(lambda (range ignore) (set-char-table-range char-width-table range 2))
+ ;; 'japanese-jisx0208)
+ ;; (map-charset-chars
+ ;; #'(lambda (range ignore) (set-char-table-range char-width-table range 2))
+ ;; 'japanese-jisx0212)
+ ;; (map-charset-chars
+ ;; #'(lambda (range ignore) (set-char-table-range char-width-table range 2))
+ ;; 'japanese-jisx0213-1)
+ ;; (map-charset-chars
+ ;; #'(lambda (range ignore) (set-char-table-range char-width-table range 2))
+ ;; 'japanese-jisx0213-2)
+ ;; (map-charset-chars
+ ;; (lambda (range ignore) (set-char-table-range char-width-table range 2))
+ ;; 'korean-ksc5601)
+
+ ;; 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 char-width-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)
+ (#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 #x137F 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)
+ (#x20A0 #x20AF currency)
+ (#x2800 #x28FF braille)
+ (#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)
+ (#xAC00 #xD7AF hangul)
+ (#xF900 #xFA5F han)
+ (#xFB1D #xFB4F hebrew)
+ (#xFB50 #xFDFF arabic)
+ (#xFE70 #xFEFC arabic)
+ (#xFF00 #xFF5F cjk-misc)
+ (#xFF61 #xFF9F kana)
+ (#xFFE0 #xFFE6 cjk-misc)
+ (#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
++(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)))
+ (point))
+ (let ((category-set (char-category-set (char-after pos)))
+ category)
+ (if (aref category-set ?K)
+ (while (and (> pos limit)
+ (aref (char-category-set (char-after (1- pos))) ?K))
+ (setq pos (1- pos)))
+ (while (and (> pos limit)
- (aref (setq category-set
++ (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 next-word-boundary-function-table
++ (set-char-table-range find-word-boundary-function-table
+ char #'next-word-boundary-han))
+ ((eq script 'kana)
- (set-char-table-range next-word-boundary-function-table
++ (set-char-table-range find-word-boundary-function-table
+ char #'next-word-boundary-kana))))
+ char-script-table)
+
+ (setq word-combining-categories
+ '((?l . ?l)))
+
+ (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-emacs
;;; End:
;;; characters.el ends here
;;; encoded-kb.el --- handler to input multibyte characters encoded somehow
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
+ ;; Copyright (C) 2002 Free Software Foundation, Inc.
++;; Copyright (C) 2003
++;; National Institute of Advanced Industrial Science and Technology (AIST)
++;; Registration Number H13PRO009
;; This file is part of GNU Emacs.
(aset encoded-kbd-iso2022-invocations 2 3))
((>= last-command-char ?\240)
- (encoded-kbd-self-insert-iso2022-8bit))
+ (encoded-kbd-self-insert-iso2022-8bit 1))
(t
(error "Can't handle the character code %d"
(aset encoded-kbd-iso2022-invocations 2 nil)
(setq unread-command-events (cons char unread-command-events))))
- (defun encoded-kbd-self-insert-iso2022-8bit ()
- (interactive)
+ (defun encoded-kbd-self-insert-iso2022-8bit (arg)
+ (interactive "p")
(cond
((= last-command-char ?\216) ; SS2 (Single Shift 2)
(aset encoded-kbd-iso2022-invocations 2 2))
(make-char charset last-command-char
(read-char-exclusive)))))
(aset encoded-kbd-iso2022-invocations 2 nil)
- (setq unread-command-events (cons char unread-command-events))))))
+ ;; As simply setting unread-command-events may result in
+ ;; infinite-loop for characters 160..255, this is a temporary
+ ;; workaround until we found a better solution.
+ (let ((last-command-char char))
+ (self-insert-command arg))))))
(defun encoded-kbd-self-insert-sjis ()
(interactive)
(defun encoded-kbd-self-insert-ccl ()
(interactive)
(let ((str (char-to-string last-command-char))
- (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 unread-command-events
(append result unread-command-events))))
+ (defun encoded-kbd-self-insert-charset (arg)
+ (interactive "p")
+ (let* ((charset-list
+ (coding-system-get (keyboard-coding-system) :charset-list))
+ (charset (car charset-list))
+ ;; For the moment, we can assume that the length of CHARSET-LIST
+ ;; is 1, and the dimension of CHARSET is 1.
+ (c (decode-char charset last-command-char)))
+ (unless c
+ (error "Can't decode the code point %d by %s"
+ last-command-char charset))
+ ;; As simply setting unread-command-events may result in
+ ;; infinite-loop for characters 160..255, this is a temporary
+ ;; workaround until we found a better solution.
+ (let ((last-command-char c))
+ (self-insert-command arg))))
+
(defun encoded-kbd-setup-keymap (coding)
;; At first, reset the keymap.
(setcdr encoded-kbd-mode-map nil)
;; Then setup the keymap according to the keyboard coding system.
(cond
+ ((eq encoded-kbd-coding 'charset)
+ (let* ((charset (car (coding-system-get coding :charset-list)))
+ (code-space (get-charset-property charset :code-space))
+ (from (max (aref code-space 0) 128))
+ (to (aref code-space 1)))
+ (while (<= from to)
+ (define-key encoded-kbd-mode-map
+ (vector from) 'encoded-kbd-self-insert-charset)
+ (setq from (1+ from)))))
+
((eq encoded-kbd-coding 'sjis)
(let ((i 128))
(while (< i 256)
((eq encoded-kbd-coding 'iso2022-7)
(define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix))
-
+
((eq encoded-kbd-coding 'iso2022-8)
(define-key encoded-kbd-mode-map
(vector ?\216) 'encoded-kbd-self-insert-iso2022-8bit)
(setq i (1+ i)))))
((eq encoded-kbd-coding 'ccl)
- (let ((valid-codes (or (coding-system-get coding 'valid-codes)
+ (let ((valid-codes (or (coding-system-get coding :valid)
'((128 . 255))))
elt from to)
(while valid-codes
(setq encoded-kbd-mode nil)
(error "No coding system for keyboard input is set"))
- ((= (coding-system-type coding) 1) ; SJIS
+ ((eq (coding-system-type coding) 'shift-jis)
(set-input-mode
(nth 0 saved-input-mode) (nth 1 saved-input-mode)
'use-8th-bit (nth 3 saved-input-mode))
(setq encoded-kbd-coding 'sjis))
- ((= (coding-system-type coding) 2) ; ISO2022
- (if (aref (coding-system-flags coding) 7) ; 7-bit only
+ ((eq (coding-system-type coding) 'iso-2022)
+ (if (memq '7-bit (coding-system-get coding :flags))
(setq encoded-kbd-coding 'iso2022-7)
(set-input-mode
(nth 0 saved-input-mode) (nth 1 saved-input-mode)
'use-8th-bit (nth 3 saved-input-mode))
(setq encoded-kbd-coding 'iso2022-8))
- (setq encoded-kbd-iso2022-designations (make-vector 4 nil))
- (let ((flags (coding-system-flags coding))
- (i 0))
- (while (< i 4)
- (if (charsetp (aref flags i))
- (aset encoded-kbd-iso2022-designations i
- (aref flags i))
- (if (charsetp (car-safe (aref flags i)))
- (aset encoded-kbd-iso2022-designations i
- (car (aref flags i)))))
- (setq i (1+ i))))
+ (setq encoded-kbd-iso2022-designations
+ (coding-system-get coding :designation))
(setq encoded-kbd-iso2022-invocations (make-vector 3 nil))
(aset encoded-kbd-iso2022-invocations 0 0)
(aset encoded-kbd-iso2022-invocations 1 1))
- ((= (coding-system-type coding) 3) ; BIG5
+ ((eq (coding-system-type coding) 'big5)
(set-input-mode
(nth 0 saved-input-mode) (nth 1 saved-input-mode)
'use-8th-bit (nth 3 saved-input-mode))
(setq encoded-kbd-coding 'big5))
- ((= (coding-system-type coding) 4) ; CCL based coding
+ ((eq (coding-system-type coding) 'ccl)
(set-input-mode
(nth 0 saved-input-mode) (nth 1 saved-input-mode)
'use-8th-bit (nth 3 saved-input-mode))
(setq encoded-kbd-coding 'ccl))
+ ((and (eq (coding-system-type coding) 'charset)
+ (let* ((charset-list (coding-system-get coding
+ :charset-list))
+ (charset (car charset-list)))
+ (and (= (length charset-list) 1)
+ (= (charset-dimension charset) 1))))
+ (set-input-mode
+ (nth 0 saved-input-mode) (nth 1 saved-input-mode)
+ 'use-8th-bit (nth 3 saved-input-mode))
+ (setq encoded-kbd-coding 'charset))
+
(t
(setq encoded-kbd-mode nil)
(error "Coding-system `%s' is not supported in Encoded-kbd mode"
(keyboard-coding-system))))
(encoded-kbd-setup-keymap coding))))
+(provide 'encoded-kb)
+
;;; encoded-kb.el ends here
;;; fontset.el --- commands for handling fontset
;; Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
;; Copyright (C) 2001 Free Software Foundation, Inc.
++;; Copyright (C) 2003
++;; 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:
- ("devanagari-cdac" . devanagari-glyph)
-;; These would be necessary for supporting the complete set of Indian
-;; scripts. See also mule-conf.el.
-;; ("sanskrit-cdac" . sanskrit-glyph)
-;; ("bengali-cdac" . bengali-glyph)
-;; ("assamese-cdac" . assamese-glyph)
-;; ("punjabi-cdac" . punjabi-glyph)
-;; ("gujarati-cdac" . gujarati-glyph)
-;; ("oriya-cdac" . oriya-glyph)
-;; ("tamil-cdac" . tamil-glyph)
-;; ("telugu-cdac" . telugu-glyph)
-;; ("kannada-cdac" . kannada-glyph)
-;; ("malayalam-cdac" . malayalam-glyph)
+ ;; 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)
+ ("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)
+ ("big5" . big5)
+ ("sisheng_cwnn" . chinese-sisheng)
+ ("viscii" . viscii)
+ ("tis620" . tis620-2533)
+ ("mulearabic-0" . arabic-digit)
+ ("mulearabic-1" . arabic-1-column)
+ ("mulearabic-2" . arabic-2-column)
+ ("muleipa" . ipa)
+ ("ethiopic-unicode" . 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)
+ ("jisx0213.2000-1" . japanese-jisx0213-1)
+ ("jisx0213.2000-2" . japanese-jisx0213-2)
+ ("abobe-symbol" . symbol)
+ ("iso10646-1" . (unicode . nil))
+ ("iso10646.indian-1" . (unicode . nil))))
+
+
;; 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
+ ;; fontset to find an appropriate font for each script/charset. The
+ ;; specification has the form ((SCRIPT FONT-SPEC ...) ...), where
+ ;; FONT-SPEC is:
+ ;; a vector [ FAMILY WEIGHT SLANT ADSTYLE REGISTRY ],
+ ;; or a cons (FAMILY . REGISTRY),
+ ;; or a string FONT-NAME.
-;;
++;;
+ ;; FAMILY, WEIGHT, SLANT, and ADSTYLE 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. The
- ;; REGISTRY for ASCII characters are predefined as "ISO8859-1".
+ ;; 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.
-(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 (nil . "TIS620*")
- (nil . "ISO8859-11"))
-
- (devanagari (nil . "iso10646.indian-1"))
-
- (lao (nil . "MuleLao-1"))
-
- ;; both for script and charset.
- (tibetan (nil . "muletibetan-2"))
-
- ;; both for script and charset.
- (ethiopic (nil . "ethiopic-unicode"))
-
- (greek (nil . "ISO8859-7"))
-
- (cyrillic (nil . "ISO8859-5"))
-
- (arabic (nil . "MuleArabic-0")
- (nil . "MuleArabic-1")
- (nil . "MuleArabic-2")
- (nil . "ISO8859-6"))
-
- (hebrew (nil . "ISO8859-8"))
-
- (kana (nil . "JISX0208*")
- (nil . "GB2312.1980-0")
- (nil . "KSC5601.1987*")
- (nil . "JISX0201*"))
-
- (bopomofo (nil . "sisheng_cwnn-0"))
-
- (han (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 . "JISX0213.2000-1")
- (nil . "JISX0213.2000-2"))
-
- (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 . "JISX0213.2000-1")
- (nil . "JISX0213.2000-2"))
-
- (hangul (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"))
- (devanagari-glyph ("altsys-dv_ttsurekh" . "devanagari-cdac"))
-;; These would be necessary for supporting the complete set of Indian
-;; scripts.
- ;; fixme: family name
-;; (sanskrit-glyph ("*" . "sanskrit-cdac"))
-;; (bengali-glyph ("*" . "bengali-cdac"))
-;; (assamese-glyph ("*" . "assamese-cdac"))
-;; (punjabi-glyph ("*" . "punjabi-cdac"))
-;; (gujarati-glyph ("*" . "gujarati-cdac"))
-;; (oriya-glyph ("*" . "oriya-cdac"))
-;; (tamil-glyph ("*" . "tamil-cdac"))
-;; (telugu-glyph ("*" . "telugu-cdac"))
-;; (kannada-glyph ("*" . "kannada-cdac"))
- (malayalam-glyph ("altsys-ml_ttkarthika" . "malayalam-cdac"))
- (ipa (nil . "MuleIPA-1"))
- ))
-
-;; Append Unicode fonts.
-;; This may find fonts with more variants (bold, italic) but which don't cover
-;; many characters.
-(set-fontset-font "fontset-default" '(0 . #xFFFF)
- '(nil . "iso10646-1") nil 'append)
-;; These may find fonts that cover many characters but with fewer variants.
-(set-fontset-font "fontset-default" '(0 . #xFFFF)
- '("gnu-unifont" . "iso10646-1") nil 'append)
-(set-fontset-font "fontset-default" '(0 . #xFFFF)
- '("mutt-clearlyu" . "iso10646-1") nil 'append)
+(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"))
- (thai-tis620 . ("*" . "TIS620"))
- (greek-iso8859-7 . ("*" . "ISO8859-7"))
- (arabic-iso8859-6 . ("*" . "ISO8859-6"))
- (hebrew-iso8859-8 . ("*" . "ISO8859-8"))
- (katakana-jisx0201 . ("*" . "JISX0201"))
- (latin-jisx0201 . (nil . "JISX0201"))
- (cyrillic-iso8859-5 . ("*" . "ISO8859-5"))
- (latin-iso8859-9 . (nil . "ISO8859-9"))
- (japanese-jisx0208-1978 . ("*" . "JISX0208.1978"))
- (chinese-gb2312 . ("*" . "GB2312.1980"))
- (japanese-jisx0208 . ("*" . "JISX0208.1990"))
- (korean-ksc5601 . ("*" . "KSC5601.1989"))
- (japanese-jisx0212 . ("*" . "JISX0212"))
- (chinese-cns11643-1 . ("*" . "CNS11643.1992-1"))
- (chinese-cns11643-2 . ("*" . "CNS11643.1992-2"))
- (chinese-cns11643-3 . ("*" . "CNS11643.1992-3"))
- (chinese-cns11643-4 . ("*" . "CNS11643.1992-4"))
- (chinese-cns11643-5 . ("*" . "CNS11643.1992-5"))
- (chinese-cns11643-6 . ("*" . "CNS11643.1992-6"))
- (chinese-cns11643-7 . ("*" . "CNS11643.1992-7"))
- (chinese-big5-1 . ("*" . "Big5"))
- (chinese-big5-2 . ("*" . "Big5"))
- (chinese-sisheng . (nil . "sisheng_cwnn"))
- (vietnamese-viscii-lower . (nil . "VISCII1.1"))
- (vietnamese-viscii-upper . (nil . "VISCII1.1"))
- (arabic-digit . ("*" . "MuleArabic-0"))
- (arabic-1-column . ("*" . "MuleArabic-1"))
- (arabic-2-column . ("*" . "MuleArabic-2"))
- (ipa . (nil . "MuleIPA"))
- (ethiopic . ("*" . "Ethiopic-Unicode"))
- (ascii-right-to-left . (nil . "ISO8859-1"))
- (indian-is13194 . ("*" . "IS13194-Devanagari"))
- (indian-2-column . ("*" . "MuleIndian-2"))
- (lao . ("*" . "MuleLao-1"))
- (tibetan . ("proportional" . "MuleTibetan-2"))
- (tibetan-1-column . ("*" . "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 . ("*" . "JISX0213.2000-1"))
- (japanese-jisx0213-2 . ("*" . "JISX0213.2000-2"))
- ;; unicode
- ((,(decode-char 'ucs #x0900) . ,(decode-char 'ucs #x097F))
- . ("*" . "ISO10646.indian-1"))
- ;; Indian CDAC
- (,(indian-font-char-range 'cdac:dv-ttsurekh)
- . ("*" . "Devanagari-CDAC"))
- (,(indian-font-char-range 'cdac:sd-ttsurekh)
- . ("*" . "Sanskrit-CDAC"))
- (,(indian-font-char-range 'cdac:bn-ttdurga)
- . ("*" . "Bengali-CDAC"))
- (,(indian-font-char-range 'cdac:as-ttdurga)
- . ("*" . "Assamese-CDAC"))
- (,(indian-font-char-range 'cdac:pn-ttamar)
- . ("*" . "Punjabi-CDAC"))
- (,(indian-font-char-range 'cdac:gj-ttavantika)
- . ("*" . "Gujarati-CDAC"))
- (,(indian-font-char-range 'cdac:or-ttsarala)
- . ("*" . "Oriya-CDAC"))
- (,(indian-font-char-range 'cdac:tm-ttvalluvar)
- . ("*" . "Tamil-CDAC"))
- (,(indian-font-char-range 'cdac:tl-tthemalatha)
- . ("*" . "Telugu-CDAC"))
- (,(indian-font-char-range 'cdac:kn-ttuma)
- . ("*" . "Kannada-CDAC"))
- (,(indian-font-char-range 'cdac:ml-ttkarthika)
- . ("*" . "Malayalam-CDAC"))
- ;; Indian AKRUTI
- (,(indian-font-char-range 'akruti:dev)
- . ("*" . "Devanagari-Akruti"))
- (,(indian-font-char-range 'akruti:bng)
- . ("*" . "Bengali-Akruti"))
- (,(indian-font-char-range 'akruti:pnj)
- . ("*" . "Punjabi-Akruti"))
- (,(indian-font-char-range 'akruti:guj)
- . ("*" . "Gujarati-Akruti"))
- (,(indian-font-char-range 'akruti:ori)
- . ("*" . "Oriay-Akruti"))
- (,(indian-font-char-range 'akruti:tml)
- . ("*" . "Tamil-Akruti"))
- (,(indian-font-char-range 'akruti:tlg)
- . ("*" . "Telugu-Akruti"))
- (,(indian-font-char-range 'akruti:knd)
- . ("*" . "Kannada-Akruti"))
- (,(indian-font-char-range 'akruti:mal)
- . ("*" . "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 (nil . "TIS620*")
++ (nil . "ISO8859-11"))
++
++ (devanagari (nil . "iso10646.indian-1"))
++
++ (lao (nil . "MuleLao-1"))
++
++ ;; both for script and charset.
++ (tibetan (nil . "muletibetan-2"))
++
++ ;; both for script and charset.
++ (ethiopic (nil . "ethiopic-unicode"))
++
++ (greek (nil . "ISO8859-7"))
++
++ (cyrillic (nil . "ISO8859-5"))
++
++ (arabic (nil . "MuleArabic-0")
++ (nil . "MuleArabic-1")
++ (nil . "MuleArabic-2")
++ (nil . "ISO8859-6"))
++
++ (hebrew (nil . "ISO8859-8"))
++
++ (kana (nil . "JISX0208*")
++ (nil . "GB2312.1980-0")
++ (nil . "KSC5601.1987*")
++ (nil . "JISX0201*"))
++
++ (bopomofo (nil . "sisheng_cwnn-0"))
++
++ (han (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 . "JISX0213.2000-1")
++ (nil . "JISX0213.2000-2"))
++
++ (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 . "JISX0213.2000-1")
++ (nil . "JISX0213.2000-2"))
++
++ (hangul (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"))
++ ))
++
++ ;; Append Unicode fonts.
++ ;; This may find fonts with more variants (bold, italic) but which
++ ;; don't cover many characters.
++ (set-fontset-font "fontset-default" '(0 . #xFFFF)
++ '(nil . "iso10646-1") nil 'append)
++ ;; These may find fonts that cover many characters but with fewer
++ ;; variants.
++ (set-fontset-font "fontset-default" '(0 . #xFFFF)
++ '("gnu-unifont" . "iso10646-1") nil 'append)
++ (set-fontset-font "fontset-default" '(0 . #xFFFF)
++ '("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 ucs-mule-cjk-to-unicode 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 '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
(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, the length 14.
+ "Compose X fontname from FIELDS.
+ FIELDS is a vector of XLFD fields, the length 12.
If a field is nil, wild-card letter `*' is embedded.
Optional argument REDUCE is always ignored. It exists just for
backward compatibility."
(concat "-" (mapconcat (lambda (x) (or x "*")) fields "-")))
-
(defun x-must-resolve-font-name (xlfd-fields)
"Like `x-resolve-font-name', but always return a font name.
XLFD-FIELDS is a vector of XLFD (X Logical Font Description) fields.
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))
(aset xlfd-fields index "*")
(setq index (1+ index))))))
(unless ascii-font
- (error "No fonts founds"))
+ (error "No fonts found"))
ascii-font))
(defun x-complement-fontset-spec (xlfd-fields fontlist)
- "Complement FONTLIST for charsets based on XLFD-FIELDS and return it.
+ "Complement elements of FONTLIST based on XLFD-FIELDS.
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))))))))
+ FONTLIST is an alist of script names vs the corresponding font names.
+
+ The font names are complemented as below.
+
+ If a font name matches `xlfd-style-regexp', each field of wild card is
+ replaced by the corresponding fields in XLFD-FIELDS."
+ (let ((default-spec (vector (aref xlfd-fields xlfd-regexp-family-subnum)
+ (aref xlfd-fields xlfd-regexp-weight-subnum)
+ (aref xlfd-fields xlfd-regexp-slant-subnum)
+ (aref xlfd-fields xlfd-regexp-swidth-subnum)
+ (aref xlfd-fields xlfd-regexp-adstyle-subnum)
+ (aref xlfd-fields xlfd-regexp-registry-subnum))))
+ (dolist (elt fontlist)
+ (let ((name (cadr elt))
+ font-spec)
+ (when (or (string-match xlfd-style-regexp name)
+ (and (setq name (car (x-list-fonts name nil nil 1)))
+ (string-match xlfd-style-regexp name)))
+ (setq font-spec (make-vector 6 nil))
+ (dotimes (i 6)
+ (aset font-spec i (match-string (1+ i) name)))
+ (dotimes (i 6)
+ (if (string-match "^[*-]+$" (aref font-spec i))
+ (aset font-spec i (aref default-spec i))))
+ (setcar (cdr elt) font-spec))))
fontlist))
(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-int 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-int 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-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.")
-;;;###autoload
(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,CHARSET-NAME0:FONT-NAME0,CHARSET-NAME1:FONT-NAME1, ...
+ FONTSET-NAME,SCRIPT-NAME0:FONT-NAME0,SCRIPT-NAME1:FONT-NAME1, ...
Any number of SPACE, TAB, and NEWLINE can be put before and after commas.
- Optional 2nd argument is ignored. It exists just for backward
- compatibility.
+ 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, error is
- signaled unless the optional 3rd argument NOERROR is non-nil.
+ Optional 2nd and 3rd arguments are ignored. They exist just for
+ backward compatibility.
- 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]*\\([^:]+\\):\\([^,]+\\)" 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))
+ xlfd-fields script fontlist)
+ (setq xlfd-fields (x-decompose-font-name name))
+ (or xlfd-fields
+ (error "Fontset name \"%s\" not conforming to XLFD" name))
+
+ ;; At first, extract pairs of charset and fontname from FONTSET-SPEC.
+ (while (string-match "[, \t\n]*\\([^:]+\\):\\([^,]+\\)" fontset-spec idx)
+ (setq idx (match-end 0))
+ (setq script (intern (match-string 1 fontset-spec)))
+ (if (or (eq script 'ascii)
+ (memq script (char-table-extra-slot char-script-table 0))
+ (setq script (cdr (assq script charset-script-alist))))
+ (setq fontlist (cons (list script (match-string 2 fontset-spec))
+ fontlist))))
+
+ ;; Complement FONTLIST.
+ (setq fontlist (x-complement-fontset-spec xlfd-fields fontlist))
+
+ ;; Create a fontset.
+ (new-fontset name fontlist)))
(defun create-fontset-from-ascii-font (font &optional resolved-font
fontset-name)
Optional 1st arg RESOLVED-FONT is a resolved name of FONT. If
omitted, `x-resolve-font-name' is called to get the resolved name. At
- this time, if FONT is not available, error is signaled.
+ this time, if FONT is not available, an error is signaled.
Optional 2nd arg FONTSET-NAME is a string to be used in
`<CHARSET_ENCODING>' fields of a new fontset name. If it is omitted,
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
(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 ...")
(save-excursion
(set-buffer buf)
(insert ")\n\n")))
-
+
(defconst skkdic-prefix-list '(skkdic-prefix-list))
(defun skkdic-convert-prefix (skkbuf buf)
(save-excursion
(set-buffer buf)
(insert ")\n\n")))
-
+
;; FROM and TO point the head and tail of "/J../J../.../".
(defun skkdic-get-candidate-list (from to)
(let (candidates)
(setq candidates (cdr candidates)))
(nreverse l)))
-(defconst skkdic-okuri-nasi-entries (list nil))
-(defconst skkdic-okuri-nasi-entries-count 0)
+(defvar skkdic-okuri-nasi-entries (list nil))
+(defvar skkdic-okuri-nasi-entries-count 0)
(defun skkdic-collect-okuri-nasi ()
(message "Collecting OKURI-NASI entries ...")
(goto-char to)
(skkdic-convert-prefix skkbuf buf)
- ;;
+ ;;
(skkdic-collect-okuri-nasi)
;; Convert okuri-nasi general 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))
;;; mule-cmds.el --- commands for mulitilingual environment
-
-;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
-;; Copyright (C) 2001, 2002
+;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN.
- ;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
+;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
++;; 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.
;;; Code:
- (eval-when-compile (defvar dos-codepage))
-(eval-when-compile
++(eval-when-compile
+ (defvar dos-codepage)
+ (require 'wid-edit))
;;; MULE related key bindings and menus.
(define-key ctl-x-map "\C-m" mule-keymap)
(define-key mule-keymap "f" 'set-buffer-file-coding-system)
+(define-key mule-keymap "r" 'revert-buffer-with-coding-system)
+(define-key mule-keymap "F" 'set-file-name-coding-system)
(define-key mule-keymap "t" 'set-terminal-coding-system)
(define-key mule-keymap "k" 'set-keyboard-coding-system)
(define-key mule-keymap "p" 'set-buffer-process-coding-system)
(define-key-after mule-menu-keymap [set-language-environment]
(list 'menu-item "Set Language Environment" setup-language-environment-map
:help "Multilingual environment suitable for a specific language"))
-(define-key-after mule-menu-keymap [mouse-set-font]
- '(menu-item "Set Font/Fontset" mouse-set-font
- :visible (fboundp 'generate-fontset-menu)
- :help "Select a font from list of known fonts/fontsets"))
(define-key-after mule-menu-keymap [separator-mule]
'("--")
t)
t)
(define-key-after mule-menu-keymap [set-various-coding-system]
(list 'menu-item "Set Coding Systems" set-coding-system-map
- :enable 'enable-multibyte-characters))
+ :enable 'default-enable-multibyte-characters))
(define-key-after mule-menu-keymap [view-hello-file]
'(menu-item "Show Multi-lingual Text" view-hello-file
:enable (file-readable-p
:help "Display multilingual environment settings")
t)
-(define-key-after set-coding-system-map [set-buffer-file-coding-system]
- '(menu-item "For Saving this Buffer" set-buffer-file-coding-system
- :help "How to encode this buffer on disk")
- t)
(define-key-after set-coding-system-map [universal-coding-system-argument]
'(menu-item "For Next Command" universal-coding-system-argument
:help "Coding system to be used by next command")
t)
-(define-key-after set-coding-system-map [set-terminal-coding-system]
- '(menu-item "For Terminal" set-terminal-coding-system
- :enable (null (memq window-system '(x w32 mac)))
- :help "How to encode terminal output")
+(define-key-after set-coding-system-map [separator-1]
+ '("--")
+ t)
+(define-key-after set-coding-system-map [set-buffer-file-coding-system]
+ '(menu-item "For Saving This Buffer" set-buffer-file-coding-system
+ :help "How to encode this buffer when saved")
+ t)
+(define-key-after set-coding-system-map [revert-buffer-with-coding-system]
+ '(menu-item "For Reverting This File Now" revert-buffer-with-coding-system
+ :enable buffer-file-name
+ :help "Revisit this file immediately using specified coding system")
+ t)
+(define-key-after set-coding-system-map [set-file-name-coding-system]
+ '(menu-item "For File Name" set-file-name-coding-system
+ :help "How to decode/encode file names")
+ t)
+(define-key-after set-coding-system-map [separator-2]
+ '("--")
t)
+
(define-key-after set-coding-system-map [set-keyboard-coding-system]
'(menu-item "For Keyboard" set-keyboard-coding-system
:help "How to decode keyboard input")
t)
-(define-key-after set-coding-system-map [set-buffer-process-coding-system]
- '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system
- :visible (fboundp 'start-process)
- :enable (get-buffer-process (current-buffer))
- :help "How to en/decode I/O from/to subprocess connected to this buffer")
+(define-key-after set-coding-system-map [set-terminal-coding-system]
+ '(menu-item "For Terminal" set-terminal-coding-system
+ :enable (null (memq window-system '(x w32 mac)))
+ :help "How to encode terminal output")
+ t)
+(define-key-after set-coding-system-map [separator-3]
+ '("--")
t)
(define-key-after set-coding-system-map [set-selection-coding-system]
'(menu-item "For X Selections/Clipboard" set-selection-coding-system
:visible (display-selections-p)
:help "How to en/decode next selection/clipboard operation")
t)
+(define-key-after set-coding-system-map [set-buffer-process-coding-system]
+ '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system
+ :visible (fboundp 'start-process)
+ :enable (get-buffer-process (current-buffer))
+ :help "How to en/decode I/O from/to subprocess connected to this buffer")
+ t)
+
+
(define-key setup-language-environment-map
[Default] '(menu-item "Default" setup-specified-language-environment))
but end-of-line as the same way as CODING-SYSTEM.
If CODING is nil, the returned coding system detects
how text is formatted automatically while decoding."
- (if (not coding)
- (coding-system-base coding-system)
- (let ((eol-type (coding-system-eol-type coding-system)))
- (coding-system-change-eol-conversion
- coding
- (if (numberp eol-type) (aref [unix dos mac] eol-type))))))
+ (let ((eol-type (coding-system-eol-type coding-system)))
+ (coding-system-change-eol-conversion
+ (if coding coding 'undecided)
+ (if (numberp eol-type) (aref [unix dos mac] eol-type)))))
(defun toggle-enable-multibyte-characters (&optional arg)
"Change whether this buffer uses multibyte characters.
;; We have to decode the file in any environment.
(let ((default-enable-multibyte-characters t)
(coding-system-for-read 'iso-2022-7bit))
- (find-file-read-only (expand-file-name "HELLO" data-directory))))
+ (view-file (expand-file-name "HELLO" data-directory))))
-(defun universal-coding-system-argument ()
+(defun universal-coding-system-argument (coding-system)
"Execute an I/O command using the specified coding system."
- (interactive)
- (let* ((default (and buffer-file-coding-system
+ (interactive
+ (let ((default (and buffer-file-coding-system
(not (eq (coding-system-type buffer-file-coding-system)
- t))
+ 'undecided))
- buffer-file-coding-system))
- (coding-system (read-coding-system
- (if default
- (format "Coding system for following command (default, %s): " default)
- "Coding system for following command: ")
- default))
- (keyseq (read-key-sequence
+ buffer-file-coding-system)))
+ (list (read-coding-system
+ (if default
+ (format "Coding system for following command (default, %s): " default)
+ "Coding system for following command: ")
+ default))))
+ (let* ((keyseq (read-key-sequence
(format "Command to execute with %s:" coding-system)))
(cmd (key-binding keyseq))
prefix)
(when (eq cmd 'universal-argument)
(call-interactively cmd)
-
+
;; Process keys bound in `universal-argument-map'.
(while (progn
(setq keyseq (read-key-sequence nil t)
(not (eq cmd 'universal-argument-other-key)))
(let ((current-prefix-arg prefix-arg)
;; Have to bind `last-command-char' here so that
- ;; `digit-argument', for instance, can compute the
+ ;; `digit-argument', for isntance, can compute the
;; prefix arg.
(last-command-char (aref keyseq 0)))
(call-interactively cmd)))
- ;; This is the final call to `univeral-argument-other-key', which
+ ;; This is the final call to `universal-argument-other-key', which
;; set's the final `prefix-arg.
(let ((current-prefix-arg prefix-arg))
(call-interactively cmd))
-
+
;; Read the command to execute with the given prefix arg.
(setq prefix prefix-arg
keyseq (read-key-sequence nil t)
(let ((coding-system-for-read coding-system)
(coding-system-for-write coding-system)
+ (coding-system-require-warning t)
(current-prefix-arg prefix))
(message "")
(call-interactively cmd))))
(unless (and (eq window-system 'pc) coding-system)
(setq default-terminal-coding-system coding-system))
(setq default-keyboard-coding-system coding-system)
- (setq default-process-coding-system (cons 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
+ ;; users shell appropriately, so should not be altered by changing
+ ;; language environment.
+ (let ((output-coding
+ (coding-system-change-text-conversion
+ (car default-process-coding-system) coding-system))
+ (input-coding
+ (coding-system-change-text-conversion
+ (cdr default-process-coding-system) coding-system)))
+ (setq default-process-coding-system
+ (cons output-coding input-coding))))
(defalias 'update-iso-coding-systems 'update-coding-systems-internal)
(make-obsolete 'update-iso-coding-systems 'update-coding-systems-internal "20.3")
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.."
+++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))
- (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 in the different way than above."
(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* ((most-preferred (coding-system-priority-list t))
++ (let* ((from-priority (coding-system-priority-list))
++ (most-preferred (car from-priority))
(lang-preferred (get-language-info current-language-environment
'coding-system))
(func (function
(lambda (x)
(let ((base (coding-system-base x)))
- (+ (if (eq base most-preferred) 64 0)
- (let ((mime (coding-system-get base :mime-charset)))
+ ;; We calculate the priority number 0..255 by
+ ;; using the 8 bits PMMLCEII as this:
+ ;; P: 1 iff most preferred.
+ ;; MM: greater than 0 iff mime-charset.
+ ;; L: 1 iff one of the current lang. env.'s codings.
+ ;; C: 1 iff one of codings listed in the category list.
+ ;; E: 1 iff not XXX-with-esc
+ ;; II: if iso-2022 based, 0..3, else 1.
+ (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
- (if (string-match "^x-" (symbol-name mime))
- 16 32)
+ ;; Lower utf-16 priority so that we
+ ;; normally prefer utf-8 to it, and put
+ ;; x-ctext below that.
+ (cond ((string-match "utf-16"
+ (symbol-name mime))
+ 2)
+ ((string-match "^x-" (symbol-name mime))
+ 1)
+ (t 3))
0))
- (if (memq base lang-preferred) 8 0)
- (if (string-match "-with-esc$" (symbol-name base))
- 0 4)
- (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.
+ 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.
where
CHARSET is a character set,
COUNT is a number of characters,
- CHARs are found characters of the character set.
+ 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 EXCLUDE is a list of character sets to be ignored.
-
- For invalid characters, CHARs are actually strings."
+ Optional 4th arg EXCLUDE 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.
+If such a character is found, set point after that character.
+Otherwise, don't move point.
+
+When called from a program, the value is a position of the found character,
+or nil if all characters are encodable."
+ (interactive
+ (list (let ((default (or buffer-file-coding-system 'us-ascii)))
+ (read-coding-system
+ (format "Coding-system (default, %s): " default)
+ default))))
+ (let ((pos (unencodable-char-position (point) (point-max) coding-system)))
+ (if pos
+ (goto-char (1+ pos))
+ (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
overrides that argument.")
(defun select-safe-coding-system (from to &optional default-coding-system
- accept-default-p)
+ accept-default-p file)
"Ask a user to select a safe coding system from candidates.
The candidates of coding systems which can safely encode a text
between FROM and TO are shown in a popup window. Among them, the most
proper one is suggested as the default.
-The list of `buffer-file-coding-system' of the current buffer and the
+The list of `buffer-file-coding-system' of the current buffer,
+the `default-buffer-file-coding-system', and the
most preferred coding system (if it corresponds to a MIME charset) is
treated as the default coding system list. Among them, the first one
-that safely encodes the text is silently selected and returned without
-any user interaction. See also the command `prefer-coding-system'.
+that safely encodes the text is normally selected silently and
+returned without any user interaction. See also the command
+`prefer-coding-system'.
+
+However, the user is queried if the chosen coding system is
+inconsistent with what would be selected by `set-auto-coding' from
+coding cookies &c. if the contents of the region were read from a
+file. (That could lead to data corruption in a file subsequently
+re-visited and edited.)
Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a
list of coding systems to be prepended to the default coding system
-list.
+list. However, if DEFAULT-CODING-SYSTEM is a list and the first
+element is t, the cdr part is used as the defualt coding system list,
+i.e. `buffer-file-coding-system', `default-buffer-file-coding-system',
+and the most preferred coding system are not used.
Optional 4th arg ACCEPT-DEFAULT-P, if non-nil, is a function to
determine the acceptability of the silently selected coding system.
It is called with that coding system, and should return nil if it
should not be silently selected and thus user interaction is required.
+Optional 5th arg FILE is the file name to use for this purpose.
+That is different from `buffer-file-name' when handling `write-region'
+\(for example).
+
The variable `select-safe-coding-system-accept-default-p', if
non-nil, overrides ACCEPT-DEFAULT-P.
(not (listp default-coding-system)))
(setq default-coding-system (list default-coding-system)))
- ;; Change elements of the list to (coding . base-coding).
- (setq default-coding-system
- (mapcar (function (lambda (x) (cons x (coding-system-base x))))
- default-coding-system))
-
- ;; If buffer-file-coding-system is not nil nor undecided, append it
- ;; to the defaults.
- (if buffer-file-coding-system
- (let ((base (coding-system-base buffer-file-coding-system)))
- (or (eq base 'undecided)
- (assq buffer-file-coding-system default-coding-system)
- (rassq base default-coding-system)
- (setq default-coding-system
- (append default-coding-system
- (list (cons buffer-file-coding-system base)))))))
-
- ;; If the most preferred coding system has the property mime-charset,
- ;; append it to the defaults.
- (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)
- (not (assq preferred default-coding-system))
- (not (rassq base default-coding-system))
- (setq default-coding-system
- (append default-coding-system (list (cons preferred base))))))
+ (let ((no-other-defaults nil))
+ (if (eq (car default-coding-system) t)
+ (setq no-other-defaults t
+ default-coding-system (cdr default-coding-system)))
+
+ ;; Change elements of the list to (coding . base-coding).
+ (setq default-coding-system
+ (mapcar (function (lambda (x) (cons x (coding-system-base x))))
+ default-coding-system))
+
+ ;; From now on, the list of defaults is reversed.
+ (setq default-coding-system (nreverse default-coding-system))
+
+ (unless no-other-defaults
+ ;; If buffer-file-coding-system is not nil nor undecided, append it
+ ;; to the defaults.
+ (if buffer-file-coding-system
+ (let ((base (coding-system-base buffer-file-coding-system)))
+ (or (eq base 'undecided)
+ (rassq base default-coding-system)
+ (push (cons buffer-file-coding-system base)
+ default-coding-system))))
+
+ ;; If default-buffer-file-coding-system is not nil nor undecided,
+ ;; append it to the defaults.
+ (if default-buffer-file-coding-system
+ (let ((base (coding-system-base default-buffer-file-coding-system)))
+ (or (eq base 'undecided)
+ (rassq base default-coding-system)
+ (push (cons default-buffer-file-coding-system base)
+ default-coding-system))))
+
+ ;; 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))
+ (push (cons preferred base)
+ default-coding-system)))))
(if select-safe-coding-system-accept-default-p
(setq accept-default-p select-safe-coding-system-accept-default-p))
(let ((codings (find-coding-systems-region from to))
(coding-system nil)
(bufname (buffer-name))
- (l default-coding-system))
+ safe rejected unsafe)
(if (eq (car codings) 'undecided)
;; Any coding system is ok.
(setq coding-system t)
- ;; Try the defaults.
- (while (and l (not coding-system))
- (if (memq (cdr (car l)) codings)
- (setq coding-system (car (car l)))
- (setq l (cdr l))))
- (if (and coding-system accept-default-p)
- (or (funcall accept-default-p coding-system)
- (setq coding-system (list coding-system)))))
+ ;; Classify the defaults into safe, rejected, and unsafe.
+ (dolist (elt default-coding-system)
+ (if (memq (cdr elt) codings)
+ (if (and (functionp accept-default-p)
+ (not (funcall accept-default-p (cdr elt))))
+ (push (car elt) rejected)
+ (push (car elt) safe))
+ (push (car elt) unsafe)))
+ (if safe
+ (setq coding-system (car safe))))
;; If all the defaults failed, ask a user.
- (when (or (not coding-system) (consp coding-system))
- ;; At first, change each coding system to the corresponding
+ (when (not coding-system)
+ ;; At first, if some defaults are unsafe, record at most 11
+ ;; problematic characters and their positions for them by turning
+ ;; (CODING ...)
+ ;; into
+ ;; ((CODING (POS . CHAR) (POS . CHAR) ...) ...)
+ (if unsafe
+ (if (stringp from)
+ (setq unsafe
+ (mapcar #'(lambda (coding)
+ (cons coding
+ (mapcar #'(lambda (pos)
+ (cons pos (aref from pos)))
+ (unencodable-char-position
+ 0 (length from) coding
+ 11 from))))
+ unsafe))
+ (setq unsafe
+ (mapcar #'(lambda (coding)
+ (cons coding
+ (mapcar #'(lambda (pos)
+ (cons pos (char-after pos)))
+ (unencodable-char-position
+ from to coding 11))))
+ unsafe))))
+
+ ;; Change each safe coding system to the corresponding
;; mime-charset name if it is also a coding system. Such a name
;; is more friendly to users.
(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))))
- ;; Make sure the offending buffer is displayed.
- (or (stringp from)
- (pop-to-buffer bufname))
- ;; Then ask users to select one form CODINGS.
- (unwind-protect
- (save-window-excursion
- (with-output-to-temp-buffer "*Warning*"
- (save-excursion
- (set-buffer standard-output)
- (if (not default-coding-system)
- (insert "No default coding systems to try for "
- (if (stringp from)
- (format "string \"%s\"." from)
- (format "buffer `%s'." bufname)))
- (insert
- "These default coding systems were tried to encode"
- (if (stringp from)
- (concat " \"" (if (> (length from) 10)
- (concat (substring from 0 10) "...\"")
- (concat from "\"")))
- (format " text\nin the buffer `%s'" bufname))
- ":\n")
- (let ((pos (point))
- (fill-prefix " "))
- (mapcar (function (lambda (x)
- (princ " ") (princ (car x))))
- default-coding-system)
- (insert "\n")
- (fill-region-as-paragraph pos (point)))
- (insert
- (if (consp coding-system)
- (concat (format "%s safely encodes the target text,\n"
- (car coding-system))
- "but it is not recommended for encoding text in this context,\n"
- "e.g., for sending an email message.\n")
- "However, none of them safely encodes the target text.\n")))
- (insert (if (consp coding-system)
- "\nSelect the above, or "
- "\nSelect ")
- "one of the following safe coding systems:\n")
+ ;; Don't offer variations with locking shift, which you
+ ;; basically never want.
+ (let (l)
+ (dolist (elt codings (setq codings (nreverse l)))
+ (unless (or (eq 'coding-category-iso-7-else
+ (coding-system-category elt))
+ (eq 'coding-category-iso-8-else
+ (coding-system-category elt)))
+ (push elt l))))
+
+ ;; Remove raw-text, emacs-mule and no-conversion unless nothing
+ ;; else is available.
+ (setq codings
+ (or (delq 'raw-text
+ (delq 'emacs-mule
+ (delq 'no-conversion codings)))
+ '(raw-text emacs-mule no-conversion)))
+
+ (let ((window-configuration (current-window-configuration)))
+ (save-excursion
+ ;; If some defaults are unsafe, make sure the offending
+ ;; buffer is displayed.
+ (when (and unsafe (not (stringp from)))
+ (pop-to-buffer bufname)
+ (goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x)))
+ unsafe))))
+ ;; Then ask users to select one from CODINGS while showing
+ ;; the reason why none of the defaults are not used.
+ (with-output-to-temp-buffer "*Warning*"
+ (save-excursion
+ (set-buffer standard-output)
+ (if (not default-coding-system)
+ (insert "No default coding systems to try for "
+ (if (stringp from)
+ (format "string \"%s\"." from)
+ (format "buffer `%s'." bufname)))
+ (insert
+ "These default coding systems were tried to encode"
+ (if (stringp from)
+ (concat " \"" (if (> (length from) 10)
+ (concat (substring from 0 10) "...\"")
+ (concat from "\"")))
+ (format " text\nin the buffer `%s'" bufname))
+ ":\n")
(let ((pos (point))
(fill-prefix " "))
- (mapcar (function (lambda (x) (princ " ") (princ x)))
- codings)
+ (mapc #'(lambda (x) (princ " ") (princ (car x)))
+ default-coding-system)
(insert "\n")
- (fill-region-as-paragraph pos (point)))))
-
- ;; Read a coding system.
- (if (consp coding-system)
- (setq codings (cons (car coding-system) codings)))
- (let* ((safe-names (mapcar (lambda (x) (list (symbol-name x)))
- codings))
- (name (completing-read
- (format "Select coding system (default %s): "
- (car codings))
- safe-names nil t nil nil
- (car (car safe-names)))))
- (setq last-coding-system-specified (intern name)
- coding-system last-coding-system-specified)))
- (kill-buffer "*Warning*")))
+ (fill-region-as-paragraph pos (point)))
+ (when rejected
+ (insert "These safely encodes the target text,
+but it is not recommended for encoding text in this context,
+e.g., for sending an email message.\n ")
+ (mapc #'(lambda (x) (princ " ") (princ x)) rejected)
+ (insert "\n"))
+ (when unsafe
+ (insert (if rejected "And the others"
+ "However, each of them")
+ " encountered these problematic characters:\n")
+ (mapc
+ #'(lambda (coding)
+ (insert (format " %s:" (car coding)))
+ (let ((i 0)
+ (func1
+ #'(lambda (bufname pos)
+ (when (buffer-live-p (get-buffer bufname))
+ (pop-to-buffer bufname)
+ (goto-char pos))))
+ (func2
+ #'(lambda (bufname pos coding)
+ (when (buffer-live-p (get-buffer bufname))
+ (pop-to-buffer bufname)
+ (if (< (point) pos)
+ (goto-char pos)
+ (forward-char 1)
+ (search-unencodable-char coding)
+ (forward-char -1))))))
+ (dolist (elt (cdr coding))
+ (insert " ")
+ (if (stringp from)
+ (insert (if (< i 10) (cdr elt) "..."))
+ (if (< i 10)
+ (insert-text-button
+ (cdr elt)
+ :type 'help-xref
+ 'help-echo
+ "mouse-2, RET: jump to this character"
+ 'help-function func1
+ 'help-args (list bufname (car elt)))
+ (insert-text-button
+ "..."
+ :type 'help-xref
+ 'help-echo
+ "mouse-2, RET: next unencodable character"
+ 'help-function func2
+ 'help-args (list bufname (car elt)
+ (car coding)))))
+ (setq i (1+ i))))
+ (insert "\n"))
+ unsafe)
+ (insert "\
+The first problematic character is at point in the displayed buffer,\n"
+ (substitute-command-keys "\
+and \\[universal-argument] \\[what-cursor-position] will give information about it.\n"))))
+ (insert (if safe
+ "\nSelect the above, or "
+ "\nSelect ")
+ "\
+one of the following safe coding systems, or edit the buffer:\n")
+ (let ((pos (point))
+ (fill-prefix " "))
+ (mapcar (function (lambda (x) (princ " ") (princ x)))
+ codings)
+ (insert "\n")
+ (fill-region-as-paragraph pos (point)))
+ (insert "Or specify any other coding system
+on your risk of losing the problematic characters.\n")))
+
+ ;; Read a coding system.
+ (setq default-coding-system (or (car safe) (car codings)))
+ (setq coding-system
+ (read-coding-system
+ (format "Select coding system (default %s): "
+ default-coding-system)
+ default-coding-system))
+ (setq last-coding-system-specified coding-system))
+
+ (kill-buffer "*Warning*")
+ (set-window-configuration window-configuration)))
(if (vectorp (coding-system-eol-type coding-system))
(let ((eol (coding-system-eol-type buffer-file-coding-system)))
(if (eq coding-system t)
(setq coding-system buffer-file-coding-system))
+ ;; Check we're not inconsistent with what `coding:' spec &c would
+ ;; give when file is re-read.
+ ;; But don't do this if we explicitly ignored the cookie
+ ;; by using `find-file-literally'.
+ (unless (or (stringp from) find-file-literally)
+ (let ((auto-cs (save-excursion
+ (save-restriction
+ (widen)
+ (narrow-to-region from to)
+ (goto-char (point-min))
+ (set-auto-coding (or file buffer-file-name "")
+ (buffer-size))))))
+ (if (and auto-cs coding-system
+ ;; Don't barf if writing a compressed file, say.
+ ;; This check perhaps isn't ideal, but is probably
+ ;; the best thing to do.
+ (not (auto-coding-alist-lookup (or file buffer-file-name "")))
+ (not (coding-system-equal (coding-system-base coding-system)
+ (coding-system-base auto-cs))))
+ (unless (yes-or-no-p
+ (format "Selected encoding %s disagrees with \
+%s specified by file contents. Really save (else edit coding cookies \
+and try again)? " coding-system auto-cs))
+ (error "Save aborted")))))
coding-system))
(setq select-safe-coding-system-function 'select-safe-coding-system)
(if (fboundp select-safe-coding-system-function)
(funcall select-safe-coding-system-function
(point-min) (point-max) coding
- (function (lambda (x) (coding-system-get x 'mime-charset))))
+ (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,
(progn
(setq key-slot (list key))
(setcdr lang-slot (cons key-slot (cdr lang-slot)))))
- (setcdr key-slot (purecopy info))))
+ (setcdr key-slot (purecopy info))
+ ;; Update the custom-type of `current-language-environment'.
+ (put 'current-language-environment 'custom-type
+ (cons 'choice (mapcar
+ (lambda (lang)
+ (list 'const lang))
+ (sort (mapcar 'car language-info-alist) 'string<))))))
(defun set-language-info-alist (lang-env alist &optional parents)
"Store ALIST as the definition of language environment LANG-ENV.
(name (completing-read prompt
language-info-alist
(and key
- (function (lambda (elm) (assq key elm))))
+ (function (lambda (elm) (and (listp elm) (assq key elm)))))
t nil nil default)))
(if (and (> (length name) 0)
(or (not key)
"*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")
:group 'mule
- :type '(choice (const nil) string)
+ :type '(choice (const nil) (string
+ :completion-ignore-case t
+ :complete-function widget-string-complete
+ :completion-alist input-method-alist
+ :prompt-history input-method-history))
:set-after '(current-language-environment))
(put 'input-method-function 'permanent-local t)
(when (interactive-p)
(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
: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 inserts some chunk of text."
++ "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, it 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 behaviour 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)
current-language-environment)
language-info-alist))
"English"))
- :type (cons 'choice (mapcar (lambda (lang)
- (list 'const (car lang)))
- language-info-alist))
+ ;; custom type will be updated with `set-language-info'.
+ :type (if language-info-alist
+ (cons 'choice (mapcar
+ (lambda (lang)
+ (list 'const lang))
+ (sort (mapcar 'car language-info-alist) 'string<)))
+ 'string)
:initialize 'custom-initialize-default
- :group 'mule
- :type 'string)
+ :group 'mule)
(defun reset-language-environment ()
"Reset multilingual environment of Emacs to the default status.
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))
-
- (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)
- (setq default-process-coding-system '(undecided . iso-latin-1))
+ (setq default-file-name-coding-system 'iso-latin-1)
+ ;; 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
+ ;; users shell appropriately, so should not be altered by changing
+ ;; language environment.
+ (let ((output-coding
+ ;; When bootstrapping, coding-systems are not defined yet, so
+ ;; we need to catch the error from check-coding-system.
+ (condition-case nil
+ (coding-system-change-text-conversion
+ (car default-process-coding-system) 'undecided)
+ (coding-system-error 'undecided)))
+ (input-coding
+ (condition-case nil
+ (coding-system-change-text-conversion
+ (cdr default-process-coding-system) 'iso-latin-1)
+ (coding-system-error 'iso-latin-1))))
+ (setq default-process-coding-system
+ (cons output-coding input-coding)))
;; Don't alter the terminal and keyboard coding systems here.
;; The terminal still supports the same coding system
;; that it supported a minute ago.
-;;; (set-terminal-coding-system-internal nil)
-;;; (set-keyboard-coding-system-internal nil)
+ ;; (set-terminal-coding-system-internal nil)
+ ;; (set-keyboard-coding-system-internal nil)
- (setq nonascii-translation-table nil
- nonascii-insert-offset 0))
+ (set-unibyte-charset 'iso-8859-1))
(reset-language-environment)
(let ((coding (get-language-info language-name 'unibyte-display)))
(if coding
(standard-display-european-internal)
- (standard-display-default (if (eq window-system 'pc) 128 160) 255)
- (aset standard-display-table 146 nil))
+ ;; The following 2 lines undo the 8-bit display that we set up
+ ;; in standard-display-european-internal, which see. This is in
+ ;; case the user has used standard-display-european earlier in
+ ;; this session. (The MS-DOS port doesn't use that setup, so it
+ ;; doesn't need to undo it.)
+ (when standard-display-table
+ (dotimes (i 128)
+ (aset standard-display-table (+ i 128) nil))))
(or (eq window-system 'pc)
- (set-terminal-coding-system coding))))
+ (set-terminal-coding-system coding))))
(defun set-language-environment (language-name)
"Set up multi-lingual environment for using LANGUAGE-NAME.
(if (symbolp language-name)
(setq language-name (symbol-name language-name)))
(setq language-name "English"))
- (or (assoc-ignore-case language-name language-info-alist)
+ (let ((slot (assoc-ignore-case language-name language-info-alist)))
+ (unless slot
(error "Language environment not defined: %S" language-name))
+ (setq language-name (car slot)))
(if current-language-environment
(let ((func (get-language-info current-language-environment
'exit-function)))
(setq input-method-history
(cons input-method
(delete input-method input-method-history))))))
- (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)))))
+
+ ;; Put higher priorities to such charsets that are supported by the
+ ;; coding systems of higher priorities in this environment.
+ (let ((charsets nil))
+ (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)))
+
+ ;; 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)
+ (= (charset-dimension nonascii) 1))
+ (setq nonascii 'iso-8859-1))
+ (set-unibyte-charset nonascii))
;; Unibyte setups if necessary.
- (unless default-enable-multibyte-characters
- ;; 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))
- (case-table (standard-case-table))
- (ch (if (eq window-system 'pc) 128 160)))
- (while (< ch 256)
- (modify-syntax-entry ch " " syntax-table)
- (aset case-table ch ch)
- (setq ch (1+ ch)))
- (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 (standard-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))
+ (or default-enable-multibyte-characters
+ (set-display-table-and-terminal-coding-system language-name))
(let ((required-features (get-language-info language-name 'features)))
(while required-features
(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 "22.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)
of `buffer-file-coding-system' set by this function."
(let* ((priority (get-language-info language-name 'coding-priority))
(default-coding (car priority)))
- (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)))
- (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))))
(defsubst princ-list (&rest args)
"Print all arguments with `princ', then print \"\n\"."
(error "No documentation for the specified language"))
(if (symbolp language-name)
(setq language-name (symbol-name language-name)))
+ (dolist (feature (get-language-info language-name 'features))
+ (require feature))
(let ((doc (get-language-info language-name 'documentation))
pos)
(help-setup-xref (list #'describe-language-environment language-name)
(setq l (cons input-method (delete input-method l))))
(insert ":\n")
(while l
- (when (string= language-name (nth 1 (car l)))
+ (when (eq t (compare-strings language-name nil nil
+ (nth 1 (car l)) nil nil t))
(insert " " (car (car l)))
(search-backward (car (car l)))
(help-xref-button 0 'help-input-method (car (car 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
("ca" . "Latin-1") ; Catalan
; co Corsican
("cs" . "Czech")
- ("cy" . "Welsh") ; Welsh
+ ("cy" . "Welsh") ; Welsh [glibc uses Latin-8. Did this change?]
("da" . "Latin-1") ; Danish
("de" . "German")
; dz Bhutani
("el" . "Greek")
;; Users who specify "en" explicitly typically want Latin-1, not ASCII.
+ ;; That's actually what the GNU locales define, modulo things like
+ ;; en_IN -- fx.
("en" . "Latin-1") ; English
("eo" . "Latin-3") ; Esperanto
("es" . "Spanish")
; ha Hausa
("he" . "Hebrew")
("hi" . "Devanagari") ; Hindi glibc uses utf-8
- ("hr" . "Latin-2") ; Croatian
+ ("hr" . "Croatian") ; Croatian
("hu" . "Latin-2") ; Hungarian
; hy Armenian
; ia Interlingua
; ie Interlingue
; ik Inupiak
("is" . "Latin-1") ; Icelandic
- ("it" . "Latin-1") ; Italian
+ ("it" . "Italian") ; Italian
; iu Inuktitut
("ja" . "Japanese")
; jw Javanese
("rm" . "Latin-1") ; Rhaeto-Romanic
; rn Kirundi
("ro" . "Romanian")
- ("ru.*[_.]koi8" . "Russian")
+ ("ru.*[_.]koi8\\(?:-r\\)?\\'" . "Cyrillic-KOI8") ; Russian
("ru" . "Cyrillic-ISO") ; Russian
; rw Kinyarwanda
("sa" . "Devanagari") ; Sanskrit
; so Somali
("sq" . "Latin-1") ; Albanian
("sr" . "Latin-2") ; Serbian (Latin alphabet)
- ("sr_YU@cyrillic" . "Cyrillic-ISO") ; per glibc
+ ("sr.*@cyrillic" . "Cyrillic-ISO") ; per glibc
; ss Siswati
; st Sesotho
; su Sundanese
- ("sv" . "Latin-1") ; Swedish
+ ("sv" . "Swedish") ; Swedish
("sw" . "Latin-1") ; Swahili
; ta Tamil glibc uses utf-8
; te Telugu glibc uses utf-8
("tl" . "Latin-1") ; Tagalog
; tn Setswana
; to Tonga
- ("tr" . "Latin-5") ; Turkish
+ ("tr" . "Turkish")
; ts Tsonga
; tt Tatar
; tw Twi
; za Zhuang
; glibc:
- ; zh_CN.GB18030/GB18030 \
- ; zh_CN.GBK/GBK \
; zh_HK/BIG5-HKSCS \
("zh.*[._]big5" . "Chinese-BIG5")
- ("zh.*[._]gbk" . nil) ; Solaris 2.7; has gbk-0 as well as GB 2312.1980-0
+ ("zh.*[._].gb18030" . "Chinese-GB18030") ; zh_CN.GB18030/GB18030 in glibc
+ ("zh.*[._].gbk" . "Chinese-GBK")
+ ;; glibc has zh_TW.EUC-TW, with zh_TW defaulting to Big5
- ("zh_tw" . "Chinese-CNS")
+ ("zh_tw" . "Chinese-CNS") ; glibc uses big5
+ ("zh_tw[._]euc-tw" . "Chinese-EUC-TW")
("zh" . "Chinese-GB")
; zu Zulu
(".*8859[-_]?14\\>" . "Latin-8")
(".*8859[-_]?15\\>" . "Latin-9")
(".*utf\\(-?8\\)\\>" . "UTF-8")
- ;; utf-8@euro exists, so put this last. (@euro really specifies
- ;; the currency, rather than the charset.)
+ ;; @euro actually indicates the monetary component, but it
+ ;; probably implies a Latin-9 codeset component.
+ ;; utf-8@euro exists, so put this last.
(".*@euro\\>" . "Latin-9")))
"List of pairs of locale regexps and charset language names.
The first element whose locale regexp matches the start of a downcased locale
("ja.*[._]jis7" . iso-2022-jp)
("ja.*[._]pck" . japanese-shift-jis)
("ja.*[._]sjis" . japanese-shift-jis)
+ ("jpn" . japanese-shift-jis) ; MS-Windows uses this.
(".*[._]utf" . utf-8)))
"List of pairs of locale regexps and preferred coding systems.
The first element whose locale regexp matches the start of a downcased locale
(setq alist (cdr alist)))
(cdr element)))
+ (defun locale-charset-match-p (charset1 charset2)
+ "Whether charset names (strings) CHARSET1 and CHARSET2 are equivalent.
+ Matching is done ignoring case and any hyphens and underscores in the
+ names. E.g. `ISO_8859-1' and `iso88591' both match `iso-8859-1'."
+ (setq charset1 (replace-regexp-in-string "[-_]" "" charset1))
+ (setq charset2 (replace-regexp-in-string "[-_]" "" charset2))
+ (eq t (compare-strings charset1 nil nil charset2 nil nil t)))
+
(defun set-locale-environment (&optional locale-name)
"Set up multi-lingual environment for using LOCALE-NAME.
This sets the language environment, the coding system priority,
the default input method and sometimes other things.
- LOCALE-NAME should be a string
- which is the name of a locale supported by the system;
- often it is of the form xx_XX.CODE, where xx is a language,
- XX is a country, and CODE specifies a character set and coding system.
- For example, the locale name \"ja_JP.EUC\" might name a locale
- for Japanese in Japan using the `japanese-iso-8bit' coding-system.
+ LOCALE-NAME should be a string which is the name of a locale supported
+ by the system; often it is of the form xx_XX.CODE, where xx is a
+ language, XX is a country, and CODE specifies a character set and
+ coding system. For example, the locale name \"ja_JP.EUC\" might name
+ a locale for Japanese in Japan using the `japanese-iso-8bit'
+ coding-system. The name may also have a modifier suffix, e.g. `@euro'
+ or `@cyrillic'.
If LOCALE-NAME is nil, its value is taken from the environment
variables LC_ALL, LC_CTYPE and LANG (the first one that is set).
See also `locale-charset-language-names', `locale-language-names',
`locale-preferred-coding-systems' and `locale-coding-system'."
(interactive "sSet environment for locale: ")
-
+
;; Do this at runtime for the sake of binaries possibly transported
;; to a system without X.
(setq locale-translation-file-name
;; Use the first of these three environment variables
;; that has a nonempty value.
(let ((vars '("LC_ALL" "LC_CTYPE" "LANG")))
- (while (and vars (not (setq locale (getenv (car vars)))))
- (setq vars (cdr vars)))))
+ (while (and vars
+ (= 0 (length locale))) ; nil or empty string
+ (setq locale (getenv (pop vars))))))
(when locale
(when coding-system
(prefer-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 (langinfo '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))
- (langinfo 'codeset))))
- (unless result
++ (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))))))))))
++system codeset `%s' for this locale." coding-system codeset))))))))
+
+ ;; Default to A4 paper if we're not in a C, POSIX or US locale.
+ ;; (See comments in Flocale_info.)
+ (let ((locale locale)
+ (paper (locale-info 'paper)))
+ (if paper
+ ;; This will always be null at the time of writing.
+ (cond
+ ((equal paper '(216 279))
+ (setq ps-paper-type 'letter))
+ ((equal paper '(210 297))
+ (setq ps-paper-type 'a4)))
+ (let ((vars '("LC_ALL" "LC_PAPER" "LANG")))
+ (while (and vars (= 0 (length locale)))
+ (setq locale (getenv (pop vars)))))
+ (when locale
+ ;; As of glibc 2.2.5, these are the only US Letter locales,
+ ;; and the rest are A4.
+ (setq ps-paper-type
+ (or (locale-name-match locale '(("c$" . letter)
+ ("posix$" . letter)
+ (".._us" . letter)
+ (".._pr" . letter)
+ (".._ca" . letter)))
+ '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 code property
(put 'char-code-property-table 'char-table-extra-slots 0)
"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 "%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 charaset) at the tail if type of CODING is ISO 2022.
+ ;; ASCII charset) at the tail if type of CODING is ISO 2022.
;; To exclude such tailing bytes, we at first encode one-char
;; string and two-char string, then check how many bytes at the
;; tail of both encoded strings are the same.
;; 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.")
+
;;; mule-cmds.el ends here
- ;;; mule-conf.el --- configure multilingual environment -*- no-byte-compile: t -*-
+ ;;; mule-conf.el --- configure multilingual environment
;; Copyright (C) 1997 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2001, 2002
++;; Licensed to the Free Software Foundation.
++;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
++;; Copyright (C) 2003
+ ;; National Institute of Advanced Industrial Science and Technology (AIST)
+ ;; Registration Number H13PRO009
-;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
- ;; 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"
+ :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"
+ :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
+ :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 [33 254]
- :map "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
+ :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
+ :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-1980")
++ :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")
++ :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 "cns11643-1")
++ :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 "cns11643-2")
++ :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)
++ :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)
++ :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)
++ :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)
++ :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)
++ :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")
++ :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
+ :code-space [#x21 #x7E #x21 #x7E]
+ :code-offset #x135000
- :unify-map "big5-1")
++ :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
+ :code-space [#x21 #x7E #x21 #x7E]
+ :code-offset #x137800
- :unify-map "big5-2")
++ :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-1990")
++ :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 (Japanese): ISO-IR-42"
++ :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 "jisx0208-1978")
++ :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-1990")
++ :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 Plane 1 (Japanese)"
+ :short-name "JISX0213-1"
+ :iso-final-char ?O
+ :emacs-mule-id 151
- :unify-map "jisx0213-1"
++ :unify-map "JISX2131"
+ :code-space [33 126 33 126]
+ :code-offset #x14C000)
+
+ (define-charset 'japanese-jisx0213-2
+ "JISX0213 Plane 2 (Japanese)"
+ :short-name "JISX0213-2"
+ :iso-final-char ?P
+ :emacs-mule-id 254
- :unify-map "jisx0213-2"
++ :unify-map "JISX2132"
+ :code-space [33 126 33 126]
+ :code-offset #x150000)
+
+ (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-1987")
++ :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")
++ :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 "sisheng"
++ :unify-map "MULE-sisheng"
+ :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 "ipa"
++ :unify-map "MULE-ipa"
+ :code-space [32 127]
+ :code-offset #x200080)
+
+ (define-charset 'viscii
+ "VISCII1.1"
+ :short-name "VISCII"
+ :long-name "VISCII 1.1"
+ :code-space [0 255]
- :map "viscii")
++ :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
- :unify-map "viscii-lower")
++ :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
- :unify-map "viscii-upper")
++ :unify-map "MULE-uviscii")
+
+ (define-charset 'vscii
- "VSCII1.1"
++ "VSCII1.1 (TCVN-5712 VN1)"
+ :short-name "VSCII"
+ :code-space [0 255]
- :map "vscii")
++ :map "VSCII")
++
++(define-charset-alias 'tcvn-5712 'vscii)
+
+ ;; Fixme: see note in tcvn.map about combining characters
-(define-charset 'tcvn-5712
- "TCVN-5712"
++(define-charset 'vscii-2
++ "VSCII-2 (TCVN-5712 VN2)"
+ :code-space [0 255]
- :map "tcvn")
++ :map "VSCII-2")
+
+ (define-charset 'koi8-r
+ "KOI8-R"
+ :short-name "KOI8-R"
+ :ascii-compatible-p t
+ :code-space [0 255]
- :map "koi8-r")
++ :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")
++ :map "ALTERNATIVNYJ")
+
+ (define-charset 'cp866
+ "CP866"
+ :short-name "cp866"
+ :ascii-compatible-p t
+ :code-space [0 255]
- :map "ibm866")
++ :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")
++ :map "KOI8-U")
+
+ (define-charset 'koi8-t
+ "KOI8-T"
+ :short-name "KOI8-T"
+ :ascii-compatible-p t
+ :code-space [0 255]
- :map "koi8-t")
++ :map "KOI8-T")
+
+ (define-charset 'georgian-ps
+ "GEORGIAN-PS"
+ :short-name "GEORGIAN-PS"
+ :ascii-compatible-p t
+ :code-space [0 255]
- :map "georgian-ps")
++ :map "KA-PS")
+
+ (define-charset 'georgian-academy
+ "GEORGIAN-ACADEMY"
+ :short-name "GEORGIAN-ACADEMY"
+ :ascii-compatible-p t
+ :code-space [0 255]
- :map "georgian-academy")
++ :map "KA-ACADEMY")
+
+ (define-charset 'windows-1250
+ "WINDOWS-1250 (Central Europe)"
+ :short-name "WINDOWS-1250"
+ :ascii-compatible-p t
+ :code-space [0 255]
- :map "windows-1250")
++ :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 "windows-1251")
++ :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 "windows-1252")
++ :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 "windows-1253")
++ :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 "windows-1254")
++ :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 "windows-1255")
++ :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 "windows-1256")
++ :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 "windows-1257")
++ :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 "windows-1258")
++ :map "CP1258")
+ (define-charset-alias 'cp1258 'windows-1258)
+
+ (define-charset 'next
+ "NEXT"
+ :short-name "NEXT"
+ :ascii-compatible-p t
+ :code-space [0 255]
- :map "next")
++ :map "NEXTSTEP")
+
+ (define-charset 'cp1125
+ "CP1125"
+ :short-name "CP1125"
+ :code-space [0 255]
- :map "cp1125")
++ :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 "cp437")
++ :map "IBM437")
+
+ (define-charset 'cp720
+ "CP720 (Arabic)"
+ :short-name "CP720"
+ :code-space [0 255]
+ :ascii-compatible-p t
- :map "cp720")
++ :map "CP720")
+
+ (define-charset 'cp737
+ "CP737 (PC Greek)"
+ :short-name "CP737"
+ :code-space [0 255]
+ :ascii-compatible-p t
- :map "cp737")
++ :map "CP737")
+
+ (define-charset 'cp775
+ "CP775 (PC Baltic)"
+ :short-name "CP775"
+ :code-space [0 255]
+ :ascii-compatible-p t
- :map "cp775")
++ :map "CP775")
+
+ (define-charset 'cp851
+ "CP851 (Greek)"
+ :short-name "CP851"
+ :code-space [0 255]
+ :ascii-compatible-p t
- :map "cp851")
++ :map "IBM851")
+
+ (define-charset 'cp852
+ "CP852 (MS-DOS Latin-2)"
+ :short-name "CP852"
+ :code-space [0 255]
+ :ascii-compatible-p t
- :map "cp852")
++ :map "IBM852")
+
+ (define-charset 'cp855
+ "CP855 (IBM Cyrillic)"
+ :short-name "CP855"
+ :code-space [0 255]
+ :ascii-compatible-p t
- :map "cp855")
++ :map "IBM855")
+
+ (define-charset 'cp857
+ "CP857 (IBM Turkish)"
+ :short-name "CP857"
+ :code-space [0 255]
+ :ascii-compatible-p t
- :map "cp857")
++ :map "IBM857")
+
+ (define-charset 'cp858
+ "CP858 (Multilingual Latin I + Euro)"
+ :short-name "CP858"
+ :code-space [0 255]
+ :ascii-compatible-p t
- :map "cp858")
++ :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 "cp860")
++ :map "IBM860")
+
+ (define-charset 'cp861
+ "CP861 (MS-DOS Icelandic)"
+ :short-name "CP861"
+ :code-space [0 255]
+ :ascii-compatible-p t
- :map "cp861")
++ :map "IBM861")
+
+ (define-charset 'cp862
+ "CP862 (PC Hebrew)"
+ :short-name "CP862"
+ :code-space [0 255]
+ :ascii-compatible-p t
- :map "cp862")
++ :map "IBM862")
+
+ (define-charset 'cp863
+ "CP863 (MS-DOS Canadian French)"
+ :short-name "CP863"
+ :code-space [0 255]
+ :ascii-compatible-p t
- :map "cp863")
++ :map "IBM863")
+
+ (define-charset 'cp864
+ "CP864 (PC Arabic)"
+ :short-name "CP864"
+ :code-space [0 255]
+ :ascii-compatible-p t
- :map "cp864")
++ :map "IBM864")
+
+ (define-charset 'cp865
+ "CP865 (MS-DOS Nordic)"
+ :short-name "CP865"
+ :code-space [0 255]
+ :ascii-compatible-p t
- :map "cp865")
++ :map "IBM865")
+
+ (define-charset 'cp869
+ "CP869 (IBM Modern Greek)"
+ :short-name "CP869"
+ :code-space [0 255]
+ :ascii-compatible-p t
- :map "cp869")
++ :map "IBM869")
+
+ (define-charset 'cp874
+ "CP874 (IBM Thai)"
+ :short-name "CP874"
+ :code-space [0 255]
+ :ascii-compatible-p t
- :map "cp874")
++ :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
+ :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
+ :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
+ :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.
+ ;; 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
+ :code-space [33 126]
+ :code-offset #x0E81)
+
+ (define-charset 'mule-lao
+ "Lao characters (ISO10646 0E81..0EDF)"
+ :short-name "Lao"
+ :code-space [0 255]
+ :superset '(ascii eight-bit-control (lao . 128)))
- ;; 1-byte 2-column charsets. Valid range of CHARSET-ID is 224..239.
-
- (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
+ :code-space [33 126]
+ :code-offset #x180000)
+
-(define-charset 'devanagari-glyph
- "Glyphs for Devanagari script. Subset of `indian-glyph'."
- :short-name "Devanagari glyph"
- :code-space [0 255]
- :code-offset #x180100)
-
-(define-charset 'malayalam-glyph
- "Glyphs for Malayalam script. Subset of `indian-glyph'."
- :short-name "Malayalam glyph"
- :code-space [0 255]
- :code-offset #x180200)
-
-;; These would be necessary for supporting the complete set of Indian
-;; scripts. See also fontset.el.
-
-;; (let ((i 0))
-;; (dolist (script '(sanskrit bengali tamil telugu assamese
-;; oriya kannada malayalam gujarati punjabi))
-;; (define-charset (intern (concat (symbol-name script) "-glyph"))
-;; (concat "Glyphs for " (capitalize (symbol-name script))
-;; " script. Subset of `indian-glyph'.")
-;; :short-name (concat (capitalize (symbol-name script)) " glyph")
-;; :code-space [0 255]
-;; :code-offset (+ #x180100 (* 256 i)))
-;; (setq i (1+ i))))
++(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)))
++ :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)))
++ :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
+ :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 240
+ :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)
-
- ;; 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)."])
+ (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
+ :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 "tibetan"
++ :unify-map "MULE-tibetan"
+ :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
+ :code-space [33 126 33 37]
+ :code-offset #x190000)
- ;; 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
+ :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
+ :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
+ :code-space [#x20 #x7F #x20 #x7F]
+ :code-offset #x100)
+
+ (define-charset 'unicode-bmp
+ "Unicode Basic Multilingual Plane"
+ :short-name "Unicode BMP"
+ :code-space [0 255 0 255]
+ :code-offset 0)
+
+ (define-charset 'ethiopic
+ "Ethiopic characters for Amharic and Tigrigna."
+ :short-name "Ethiopic"
+ :long-name "Ethiopic characters"
+ :iso-final-char ?3
+ :emacs-mule-id 245
- :unify-map "ethiopic"
++ :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 "mac-roman")
++ :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 "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 "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")
++ :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")
++ :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")
++ :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")
++ :map "MIK")
+
-(define-charset 'pt154
++(define-charset 'ptcp154
+ "`Paratype' codepage (Asian Cyrillic)"
+ :short-name "PT154"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :mime-charset 'pt154
- :map "pt154")
-(define-charset-alias 'ptcp154 'pt154)
-(define-charset-alias 'cp154 '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 "gb18030-2")
++ :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 "gb18030-4")
++ :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))
+
+ (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 'big5-hkscs)
+ (unify-charset 'chinese-sisheng)
-(unify-charset 'korean-ksc5601)
+ (unify-charset 'ipa)
+ (unify-charset 'tibetan)
+ (unify-charset 'ethiopic)
-;; (unify-charset 'japanese-jisx0208-1978)
++(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)
+ ;; Fixme: should this be retained? I guess it could be useful for
+ ;; non-unified charsets.
(defvar translation-table-for-input nil
"If non-nil, a char table used to translate characters from input methods.
\(Currently only used by Quail.)")
\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' is already defined in coding.c as
+ ;; below:
+ ;;
+ ;; (define-coding-system 'no-conversion
+ ;; "Do no conversion."
+ ;; :coding-type 'raw-text
+ ;; :mnemonic ?=)
(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.
++ "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
- :mnemonic ?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 'undecided
+ "No conversion on encoding, automatic conversion on decoding."
+ :coding-type 'undecided
+ :mnemonic ?-
+ :charset-list '(ascii))
- (define-coding-system-alias 'iso-2022-int-1 'iso-2022-7bit-lock)
+ (define-coding-system-alias 'unix 'undecided-unix)
+ (define-coding-system-alias 'dos 'undecided-dos)
+ (define-coding-system-alias 'mac 'undecided-mac)
- (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)))
+ (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-cjk 'iso-2022-7bit-lock-ss2)
+ (define-coding-system-alias 'iso-8859-1 'iso-latin-1)
+ (define-coding-system-alias 'latin-1 'iso-latin-1)
- (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)))
+ ;; Coding systems not specific to each language environment.
- (make-coding-system
- 'compound-text 2 ?x
- "Compound text based generic encoding for decoding unknown messages.
+ (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))
- 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-alias 'iso-2022-int-1 'iso-2022-7bit-lock)
+
+ (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))
+
+ (define-coding-system-alias 'iso-2022-cjk 'iso-2022-7bit-lock-ss2)
+
+ (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 ICCCM Extended Segments."
++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
+ 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 2 ?x
"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 5 ?x
- "Compound text encoding with extended segments.
+ (define-coding-system 'compound-text-with-extensions
+ "Compound text encoding with ICCCM Extended Segment extensions.
This coding system should be used only for X selections. It is inappropriate
for decoding and encoding files, process I/O, etc."
- nil
- '((post-read-conversion . ctext-post-read-conversion)
- (pre-write-conversion . ctext-pre-write-conversion)))
+ :coding-type 'raw-text
+ :mnemonic ?x
+ :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
- "Convert all characters but ASCII to `?'."
++ "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)
+
+ ;; 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
;; the beginning of a doc string, work.
("\\(\\`\\|/\\)loaddefs.el\\'" . (raw-text . raw-text-unix))
("\\.tar\\'" . (no-conversion . no-conversion))
- ( "\\.po[tx]?\\'\\|\\.po\\." . po-find-file-coding-system)
++ ( "\\.po[tx]?\\'\\|\\.po\\." . po-find-file-coding-system)
("" . (undecided . nil))))
\f
;; 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 ?\224 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:
;;; mule-conf.el ends here
;;; mule-diag.el --- show diagnosis of multilingual environment (Mule)
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
-;; Copyright (C) 2001, 2002
++;; 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
but still shows the full information."
(interactive "P")
(help-setup-xref (list #'list-character-sets arg) (interactive-p))
- (with-output-to-temp-buffer (help-buffer)
+ (with-output-to-temp-buffer "*Character Set List*"
(with-current-buffer standard-output
(if arg
(list-character-sets-2)
;; Insert header.
+ (insert "Indirectly supported 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
(goto-char (point-min))
(re-search-forward "[0-9][0-9][0-9]")
(beginning-of-line)
- (delete-region (point) (point-max))
- (list-character-sets-1 sort-key)))))
+ (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'.
-
(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 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)))
+ (push (list charset
+ (charset-dimension charset)
+ (charset-chars charset)
+ (charset-iso-final-char charset))
+ 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))
;; 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))
+ (dolist (elt charset-info-list)
+ (insert-text-button (symbol-name (car elt))
:type 'list-charset-chars
- 'help-args (list (nth 1 elt)))
+ 'help-args (list (car 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
- ;; (indent-to 40)
- ;; (insert (nth 2 elt)) ; MULTIBYTE-FORM
+ (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)
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:%d:%s\n"
charset
(charset-dimension charset)
(charset-chars charset)
- (charset-bytes charset)
- (charset-width charset)
- (charset-direction charset)
+ (aref char-width-table (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" "22.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))))
-
-
- ;; Add DOS codepages to `non-iso-charset-alist'.
-
- (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)))))
-
+ coding system cpCODEPAGE. This function is obsolete."
+ (decode-char (intern (format "cp%d" codepage)) code))
+ (make-obsolete 'decode-codepage-char 'decode-char "22.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))))
++;; Vector of 16 space-only strings. Nth string has display property
++;; '(space :align-to COL) when COL is the column number to align the
++;; Nth character in a row. Used by `list-block-of-chars'.
++
++(defconst stretches-for-character-list
++ (let ((stretches (make-vector 16 nil)))
++ (dotimes (i 16)
++ (aset stretches i
++ (propertize " " 'display `(space :align-to ,(+ 6 (* i 4))))))
++ stretches)
++ "For internal use only.")
;; 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 ?- (+ 5 (* 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)))
- (or (decode-char charset (+ (* row 256) i))
- 32)) ; gap in mapping
-- ((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%4Xx" (/ (+ (* row 256) i) 16))))
++ (setq ch (if (< i min)
++ 32
++ (or (decode-char charset (+ (* row 256) i))
++ 32))) ; gap in mapping
++ ;; Don't insert a control code.
++ (if (or (< ch 32) (= ch 127))
++ (setq ch (single-key-description ch))
++ (if (and (>= ch 128) (< ch 160))
++ (setq ch (format "%02Xh" ch))))
++ (insert (aref stretches-for-character-list (% i 16)) 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: ")))
- (with-output-to-temp-buffer "*Help*"
+ (with-output-to-temp-buffer "*Character List*"
(with-current-buffer standard-output
+ (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)
(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))))))
+ (unless (charsetp charset)
+ (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))
+ (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)))))))))
;;;###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 ?×))
+ (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)))))))
-
-;;;###autoload
-(defun describe-char-after (&optional pos)
- "Display information about the character at POS in the current buffer.
-POS defaults to point.
-The information includes character code, charset and code points in it,
-syntax, category, how the character is encoded in a file,
-which font is being used for displaying the character."
- (interactive)
- (or pos
- (setq pos (point)))
- (if (>= pos (point-max))
- (error "No character at point"))
- (let* ((char (char-after pos))
- (charset (char-charset char))
- (props (text-properties-at pos))
- (composition (find-composition (point) nil nil t))
- (composed (if composition (buffer-substring (car composition)
- (nth 1 composition))))
- (multibyte-p enable-multibyte-characters)
- item-list max-width)
- (if (not (characterp char))
- (setq item-list
- `(("character"
- ,(format "%s (0%o, %d, 0x%x) -- invalid character code"
- (char-to-string char) char char char))))
- (setq item-list
- `(("character"
- ,(format "%s (0%o, %d, 0x%x%s)"
- (if (< char 256)
- (single-key-description char)
- (char-to-string char))
- char char char
- (if (encode-char char 'ucs)
- (format ", U+%04X" (encode-char char 'ucs))
- "")))
- ("preferred charset"
- ,(symbol-name charset)
- ,(format "(%s)" (charset-description charset)))
- ("code point"
- ,(let ((split (split-char char)))
- (mapconcat #'number-to-string (cdr split) " ")))
- ("syntax"
- ,(let* ((old-table (syntax-table))
- (table (get-char-property (point) 'syntax-table)))
- (if (consp table)
- (nth 1 (assq (car table)
- (mapcar #'cdr syntax-code-table)))
- (unwind-protect
- (progn
- (if (syntax-table-p table)
- (set-syntax-table table))
- (nth 2 (assq (char-syntax char) syntax-code-table)))
- (set-syntax-table old-table)))))
- ("category"
- ,@(let ((category-set (char-category-set char)))
- (if (not category-set)
- '("-- none --")
- (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)))))
- ("buffer code"
- ,(encoded-string-description
- (string-as-unibyte (char-to-string char)) nil))
- ("file code"
- ,@(let* ((coding buffer-file-coding-system)
- (encoded (encode-coding-char char coding)))
- (if encoded
- (list (encoded-string-description encoded coding)
- (format "(encoded by coding system %S)" coding))
- (list "not encodable by coding system"
- (symbol-name coding)))))
- ,(if (display-graphic-p (selected-frame))
- (list "font" (or (internal-char-font (point))
- "-- none --"))
- (list "terminal code"
- (let* ((coding (terminal-coding-system))
- (encoded (encode-coding-char char coding)))
- (if encoded
- (encoded-string-description encoded coding)
- "not encodable"))))
- ,@(let ((unicodedata (if (encode-char char 'ucs)
- (unicode-data char))))
- (if unicodedata
- (cons (list "Unicode data" " ") unicodedata))))))
- (setq max-width (apply #'max (mapcar #'(lambda (x)
- (if (cadr x)
- (length (car x))
- 0))
- item-list)))
- (with-output-to-temp-buffer "*Help*"
- (save-excursion
- (set-buffer standard-output)
- (set-buffer-multibyte multibyte-p)
- (let ((formatter (format "%%%ds:" max-width)))
- (dolist (elt item-list)
- (when (cadr elt)
- (insert (format formatter (car elt)))
- (dolist (clm (cdr elt))
- (when (>= (+ (current-column)
- (or (string-match "\n" clm)
- (string-width clm)) 1)
- (frame-width))
- (insert "\n")
- (indent-to (1+ max-width)))
- (insert " " clm))
- (insert "\n"))))
- (when composition
- (insert "\nComposed with the following character(s) "
- (mapconcat (lambda (x) (format "`%c'" x))
- (substring composed 1)
- ", ")
- " to form `" composed "'")
- (if (nth 3 composition)
- (insert ".\n")
- (insert "\nby the rule ("
- (mapconcat (lambda (x)
- (format (if (consp x) "%S" "?%c") x))
- (nth 2 composition)
- " ")
- ").\n"
- "See the variable `reference-point-alist' for "
- "the meaning of the rule.\n")))
- (if props
- (insert "\nText properties\n"))
- (while props
- (insert (format " %s: %s" (car props) (cadr props)))
- (setq props (cddr props)))
- ))))
-
\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 (charset-description charset)))
((listp charset)
(if (charsetp (car charset))
- (format "%s:%s, and also used by the followings:"
+ (format "%s:%s, and also used by the following:"
(car charset)
(charset-description (car charset)))
"no initial designation, and used by the followings:"))
(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 behaviour of this coding system.\n")
- (dolist (v vars)
- (princ " `")
- (princ v)
- (princ "'\n"))
- (princ "\n")))
-
- (princ "Type: ")
- (let* ((type (coding-system-type coding-system))
- ;; Fixme: use this
- (extra-spec (coding-system-plist coding-system)))
+ (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'."
++ "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)))
- (if (eq coding-system (car aliases))
- (if (cdr aliases)
- (princ (format " %S" (cons 'alias: (cdr aliases)))))
- (if (memq coding-system aliases)
- (princ (format " (alias of %s)" (car aliases))))))
- (princ "\n\n")
- (if (and doc-string
- (setq doc-string (coding-system-doc-string coding-system)))
- (princ (format "%s\n" doc-string)))))
+ (cond ((eq coding-system (car aliases))
+ (if (cdr aliases)
+ (princ (format " %S" (cons 'alias: (cdr aliases))))))
+ ((memq coding-system aliases)
+ (princ (format " (alias of %s)" (car aliases))))
+ (t
+ (let ((eol-type (coding-system-eol-type coding-system))
+ (base-eol-type (coding-system-eol-type (car aliases))))
+ (if (and (integerp eol-type)
+ (vectorp base-eol-type)
+ (not (eq coding-system (aref base-eol-type eol-type))))
+ (princ (format " (alias of %s)"
+ (aref base-eol-type eol-type))))))))
+ (princ "\n")
+ (or (eq doc-string 'tightly)
+ (princ "\n"))
+ (if doc-string
+ (let ((doc (or (coding-system-doc-string coding-system) "")))
+ (when (eq doc-string 'tightly)
+ (if (string-match "\n" doc)
+ (setq doc (substring doc 0 (match-beginning 0))))
+ (setq doc (concat " " doc)))
+ (princ (format "%s\n" doc))))))
;;;###autoload
(defun describe-current-coding-system ()
(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
(setq coding-system (symbol-value (car categories)))
(mapcar
- (function
- (lambda (x)
- (if (and (not (eq x coding-system))
+ (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)))))
+ (setq codings (cons x codings))))
(get (car categories) 'coding-systems))
(if codings
(let ((max-col (frame-width))
(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)))
###############################################
# List of coding systems in the following format:
# MNEMONIC-LETTER -- CODING-SYSTEM-NAME
-# DOC-STRING
+# DOC-STRING
")
(princ "\
#########################
## POST-READ-CONVERSION, PRE-WRITE-CONVERSION = function name to be called
##
"))
- (let ((bases (coding-system-list 'base-only))
- coding-system)
- (while bases
- (setq coding-system (car bases))
- (if (null arg)
- (print-coding-system-briefly coding-system 'doc-string)
- (print-coding-system coding-system))
- (setq bases (cdr bases)))))
+ (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))))
+ ;; 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 (aref requested 0))
+ (registry (aref requested 5)))
+ (if (not family)
+ (setq family "*-*")
+ (or (string-match "-" family)
+ (setq family (concat "*-" family))))
+ (or (string-match "-" registry)
+ (= (aref registry (1- (length registry))) ?*)
+ (setq registry (concat registry "*")))
+ (insert "\n -" family
+ ?- (or (aref requested 1) ?*) ; weight
+ ?- (or (aref requested 2) ?*) ; slant
+ "-*-" (or (aref requested 3) ?*) ; width
+ "-*-" (or (aref requested 4) ?*) ; 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 optional arg PRINT-FONTS is non-nil, also print names of all opened
+If FONTSET is nil, print information about the default fontset.
+ 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."
- (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)
- )))
+ (or fontset
+ (setq fontset (query-fontset "fontset-default")))
+ (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)
(if (not (and window-system (fboundp 'fontset-list)))
(error "No fontsets being used")
(let ((fontset-list (nconc
- (mapcar 'list (fontset-list))
- (mapcar (lambda (x) (list (cdr x)))
- fontset-alias-alist)))
+ (fontset-list)
+ (mapcar 'cdr fontset-alias-alist)))
(completion-ignore-case t))
(list (completing-read
"Fontset (default, used by the current frame): "
fontset-list nil t)))))
(if (= (length fontset) 0)
- (setq fontset (cdr (assq 'font (frame-parameters)))))
- (if (not (setq fontset (query-fontset fontset)))
- (error "Current frame is using font, not fontset"))
+ (setq fontset (frame-parameter nil 'font)))
+ (setq fontset (query-fontset fontset))
(help-setup-xref (list #'describe-fontset fontset) (interactive-p))
(with-output-to-temp-buffer (help-buffer)
(with-current-buffer standard-output
;; This code is duplicated near the end of mule-diag.
(let ((fontsets
(sort (fontset-list)
- (function (lambda (x y)
- (string< (fontset-plain-name x)
- (fontset-plain-name y)))))))
+ (lambda (x y)
+ (string< (fontset-plain-name x)
+ (fontset-plain-name y))))))
(while fontsets
(if arg
(print-fontset (car fontsets) nil)
(defun list-input-methods ()
"Display information about all input methods."
(interactive)
- (with-output-to-temp-buffer "*Help*"
+ (help-setup-xref '(list-input-methods) (interactive-p))
+ (with-output-to-temp-buffer (help-buffer)
(list-input-methods-1)
(with-current-buffer standard-output
(save-excursion
"^ \\([^ ]+\\) (`.*' in mode line)$" nil t)
(help-xref-button 1 #'help-input-method
(match-string 1)
- "mouse-2: describe this method")))
- (help-setup-xref '(list-input-methods) (interactive-p)))))
+ "mouse-2: describe this method"))))))
(defun list-input-methods-1 ()
(if (not input-method-alist)
(progn
(princ "
-No input method is available, perhaps because you have not yet
-installed LEIM (Libraries of Emacs Input Methods).
-
-LEIM is available from the same ftp directory as Emacs. For instance,
-if there exists an archive file `emacs-M.N.tar.gz', there should also
-be a file `leim-M.N.tar.gz'. When you extract this file, LEIM files
-are put under the subdirectory `emacs-M.N/leim'. When you install
-Emacs again, you should be able to use various input methods."))
+No input method is available, perhaps because you have not
+installed LEIM (Libraries of Emacs Input Methods)."))
(princ "LANGUAGE\n NAME (`TITLE' in mode line)\n")
(princ " SHORT-DESCRIPTION\n------------------------------\n")
(setq input-method-alist
(sort input-method-alist
- (function (lambda (x y) (string< (nth 1 x) (nth 1 y))))))
+ (lambda (x y) (string< (nth 1 x) (nth 1 y)))))
(let ((l input-method-alist)
language elt)
(while l
(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 nil 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)
+
+ ;; Local Variables:
+ ;; coding: utf-8
+ ;; End:
;;; mule-diag.el ends here
;;; mule-util.el --- utility functions for mulitilingual environment (mule)
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
+ ;; Copyright (C) 2002 Free Software Foundation, Inc.
++;; Copyright (C) 2003
++;; National Institute of Advanced Industrial Science and Technology (AIST)
++;; Registration Number H13PRO009
++
;; Keywords: mule, multilingual
(error "Invalid type: %s" type)))
;;; val)
)
+
+;;;###autoload
(make-obsolete 'string-to-sequence
- "Use `string-to-list' or `string-to-vector'"
- "21.3")
+ "use `string-to-list' or `string-to-vector'."
+ "21.4")
;;;###autoload
(defsubst string-to-list (string)
string)
;;;###autoload
-(defun truncate-string-to-width (str end-column &optional start-column padding)
+(defun truncate-string-to-width (str end-column
+ &optional start-column padding ellipsis)
"Truncate string STR to end at column END-COLUMN.
-The optional 3rd arg START-COLUMN, if non-nil, specifies
-the starting column; that means to return the characters occupying
-columns START-COLUMN ... END-COLUMN of STR.
-
-The optional 4th arg PADDING, if non-nil, specifies a padding character
-to add at the end of the result if STR doesn't reach column END-COLUMN,
-or if END-COLUMN comes in the middle of a character in STR.
-PADDING is also added at the beginning of the result
-if column START-COLUMN appears in the middle of a character in STR.
+The optional 3rd arg START-COLUMN, if non-nil, specifies the starting
+column; that means to return the characters occupying columns
+START-COLUMN ... END-COLUMN of STR. Both END-COLUMN and START-COLUMN
+are specified in terms of character display width in the current
+buffer; see also `char-width'.
+
+The optional 4th arg PADDING, if non-nil, specifies a padding
+character (which should have a display width of 1) to add at the end
+of the result if STR doesn't reach column END-COLUMN, or if END-COLUMN
+comes in the middle of a character in STR. PADDING is also added at
+the beginning of the result if column START-COLUMN appears in the
+middle of a character in STR.
If PADDING is nil, no padding is added in these cases, so
-the resulting string may be narrower than END-COLUMN."
+the resulting string may be narrower than END-COLUMN.
+
+If ELLIPSIS is non-nil, it should be a string which will replace the
+end of STR (including any padding) if it extends beyond END-COLUMN,
+unless the display width of STR is equal to or less than the display
+width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS
+defaults to \"...\"."
(or start-column
(setq start-column 0))
- (let ((len (length str))
+ (when (and ellipsis (not (stringp ellipsis)))
+ (setq ellipsis "..."))
+ (let ((str-len (length str))
+ (str-width (string-width str))
+ (ellipsis-len (if ellipsis (length ellipsis) 0))
+ (ellipsis-width (if ellipsis (string-width ellipsis) 0))
(idx 0)
(column 0)
(head-padding "") (tail-padding "")
(setq ch (aref str idx)
column (+ column (char-width ch))
idx (1+ idx)))
- (args-out-of-range (setq idx len)))
+ (args-out-of-range (setq idx str-len)))
(if (< column start-column)
(if padding (make-string end-column padding) "")
- (if (and padding (> column start-column))
- (setq head-padding (make-string (- column start-column) padding)))
+ (when (and padding (> column start-column))
+ (setq head-padding (make-string (- column start-column) padding)))
(setq from-idx idx)
- (if (< end-column column)
- (setq idx from-idx)
+ (when (>= end-column column)
+ (if (and (< end-column str-width)
+ (> str-width ellipsis-width))
+ (setq end-column (- end-column ellipsis-width))
+ (setq ellipsis ""))
(condition-case nil
(while (< column end-column)
(setq last-column column
ch (aref str idx)
column (+ column (char-width ch))
idx (1+ idx)))
- (args-out-of-range (setq idx len)))
- (if (> column end-column)
- (setq column last-column idx last-idx))
- (if (and padding (< column end-column))
- (setq tail-padding (make-string (- end-column column) padding))))
- (setq str (substring str from-idx idx))
- (if padding
- (concat head-padding str tail-padding)
- str))))
+ (args-out-of-range (setq idx str-len)))
+ (when (> column end-column)
+ (setq column last-column
+ idx last-idx))
+ (when (and padding (< column end-column))
+ (setq tail-padding (make-string (- end-column column) padding))))
+ (concat head-padding (substring str from-idx idx)
+ tail-padding ellipsis))))
+
+;;; Test suite for truncate-string-to-width
+;; (dolist (test '((("" 0) . "")
+;; (("x" 1) . "x")
+;; (("xy" 1) . "x")
+;; (("xy" 2 1) . "y")
+;; (("xy" 0) . "")
+;; (("xy" 3) . "xy")
+;; (("\e$AVP\e(B" 0) . "")
+;; (("\e$AVP\e(B" 1) . "")
+;; (("\e$AVP\e(B" 2) . "\e$AVP\e(B")
+;; (("\e$AVP\e(B" 1 nil ? ) . " ")
+;; (("\e$AVPND\e(B" 3 1 ? ) . " ")
+;; (("x\e$AVP\e(Bx" 2) . "x")
+;; (("x\e$AVP\e(Bx" 3) . "x\e$AVP\e(B")
+;; (("x\e$AVP\e(Bx" 3) . "x\e$AVP\e(B")
+;; (("x\e$AVP\e(Bx" 4 1) . "\e$AVP\e(Bx")
+;; (("kor\e$(CGQ\e(Be\e$(C1[\e(Ban" 8 1 ? ) . "or\e$(CGQ\e(Be\e$(C1[\e(B")
+;; (("kor\e$(CGQ\e(Be\e$(C1[\e(Ban" 7 2 ? ) . "r\e$(CGQ\e(Be ")
+;; (("" 0 nil nil "...") . "")
+;; (("x" 3 nil nil "...") . "x")
+;; (("\e$AVP\e(B" 3 nil nil "...") . "\e$AVP\e(B")
+;; (("foo" 3 nil nil "...") . "foo")
+;; (("foo" 2 nil nil "...") . "fo") ;; XEmacs failure?
+;; (("foobar" 6 0 nil "...") . "foobar")
+;; (("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")
+;; ))
+;; (let (ret)
+;; (condition-case e
+;; (setq ret (apply #'truncate-string-to-width (car test)))
+;; (error (setq ret e)))
+;; (unless (equal ret (cdr test))
+;; (error "%s: expected %s, got %s"
+;; (prin1-to-string (cons 'truncate-string-to-width (car test)))
+;; (prin1-to-string (cdr test))
+;; (if (consp ret)
+;; (format "error: %s: %s" (car ret)
+;; (prin1-to-string (cdr ret)))
+;; (prin1-to-string ret))))))
;;; For backward compatibility ...
;;;###autoload
(defalias 'truncate-string 'truncate-string-to-width)
+
+;;;###autoload
(make-obsolete 'truncate-string 'truncate-string-to-width "20.1")
\f
;;; Nested alist handler. Nested alist is alist whose elements are
Nested alist is a list of the form (ENTRY . BRANCHES), where ENTRY is
any Lisp object, and BRANCHES is a list of cons cells of the form
-(KEY-ELEMENT . NESTED-ALIST).
+\(KEY-ELEMENT . NESTED-ALIST).
You can use a nested alist to store any Lisp object (ENTRY) for a key
sequence KEYSEQ, where KEYSEQ is a sequence of KEY-ELEMENT. KEYSEQ
\f
;; Coding system related functions.
-;;;###autoload
-(defun coding-system-eol-type-mnemonic (coding-system)
- "Return the string indicating end-of-line format of CODING-SYSTEM."
- (let* ((eol-type (coding-system-eol-type coding-system))
- (val (cond ((vectorp eol-type) eol-mnemonic-undecided)
- ((eq eol-type 0) eol-mnemonic-unix)
- ((eq eol-type 1) eol-mnemonic-dos)
- ((eq eol-type 2) eol-mnemonic-mac)
- (t "-"))))
- (if (stringp val)
- val
- (char-to-string val))))
-
;;;###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
(defun coding-system-equal (coding-system-1 coding-system-2)
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)
(and (vectorp eol-type-1) (vectorp eol-type-2)))))))
++;;;###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))
- (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" "22.1")
;;;###autoload
(defun detect-coding-with-language-environment (from to lang-env)
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
-(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)
\f
(provide 'mule-util)
+;; Local Variables:
+;; coding: iso-2022-7bit
+;; End:
+
;;; mule-util.el ends here
- ;;; mule.el --- basic commands for mulitilingual environment
+ ;;; mule.el --- basic commands for multilingual environment
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
-;; Copyright (C) 2001, 2002
++;; 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 "7.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 "2002.2.28" "\
++(defconst mule-version-date "2003.9.1" "\
Distribution date of this version of MULE (multilingual environment).")
+
+ \f
+ ;;; CHARACTER
+ (defalias 'char-valid-p 'characterp)
+ (make-obsolete 'char-valid-p 'characterp "22.1")
+
+ \f
+ ;;; CHARSET
+
+ (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, 128..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 of some other
+ charset.
+
+ `: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."
+ (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
+ (progn
+ (setq dimension (/ (length (plist-get props :code-space)) 2))
+ (setq props (plist-put props :dimension dimension)))))
+
+ (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.
(message "Loading %s (source)..." file)
(message "Loading %s..." file)))
(when purify-flag
- (setq preloaded-file-list (cons file preloaded-file-list)))
+ (push file preloaded-file-list))
(unwind-protect
(let ((load-file-name fullname)
(set-auto-coding-for-load t)
;; 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)))
- (eq (coding-system-type last-coding-system-used)
- 'raw-text))
++ (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)
- "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.
+
-;;; Charset property
+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
- (function
- (lambda (form)
- (let ((charset (nth 1 form)))
- (if (charset-quoted-standard-p charset)
- (byte-compile-normal-call
- (cons 'make-char-internal
- (cons (charset-id (nth 1 charset)) (nthcdr 2 form))))
- (byte-compile-normal-call
- (cons 'make-char-internal
- (cons (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'" "22.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 the translation-hash-table named
- `utf-subst-table-for-decode'.
-
- 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 (gethash code-point
- (get 'utf-subst-table-for-decode 'translation-hash-table))
- (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 the translation-hash-table named
- `utf-subst-table-for-encode'.
-
- 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 (gethash char (get 'utf-subst-table-for-encode
- 'translation-hash-table))
- (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)
- 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))))))))
-
+ (defun generic-char-p (char)
- "Always return nil. This exists only for backward compatibility."
++ "Always return nil. This is provided for backward compatibility."
+ nil)
+ (make-obsolete 'generic-char-p "Generic characters no longer exist" "22.1")
\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
++ :prefer-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))
+ (plist-get (coding-system-plist coding-system) :docstring))
+
+ (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-plist (coding-system)
- "Return the property list of CODING-SYSTEM."
- (aref (coding-system-spec coding-system) coding-spec-plist-idx))
+ (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-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-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 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."
- (plist-get (coding-system-plist 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))
+ (plist-get (coding-system-plist coding-system)
+ (intern (concat ":" (symbol-name prop)))))))
(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-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'.
- Any alias nor subsidiary coding systems are not base coding system."
- (car (coding-system-get coding-system 'alias-coding-systems)))
+ (plist-put (coding-system-plist coding-system) prop val))
(defalias 'coding-system-parent 'coding-system-base)
(make-obsolete 'coding-system-parent 'coding-system-base "20.3")
- ;; 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))
-
+(defun coding-system-eol-type-mnemonic (coding-system)
+ "Return the string indicating end-of-line format of CODING-SYSTEM."
+ (let* ((eol-type (coding-system-eol-type coding-system))
+ (val (cond ((eq eol-type 0) eol-mnemonic-unix)
+ ((eq eol-type 1) eol-mnemonic-dos)
+ ((eq eol-type 2) eol-mnemonic-mac)
+ (t eol-mnemonic-undecided))))
+ (if (stringp val)
+ val
+ (char-to-string val))))
+
(defun coding-system-lessp (x y)
(cond ((eq x 'no-conversion) t)
((eq y 'no-conversion) nil)
(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))
;; coding systems (if necessary).
(while (cdr tail)
(let* ((coding (car (cdr tail)))
- (aliases (coding-system-get coding 'alias-coding-systems)))
+ (aliases (coding-system-aliases coding)))
(if (or
;; CODING is an eol variant if not in ALIASES.
(not (memq coding aliases))
(setq tail (cdr tail)))))
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)))))))
-
- (defun register-char-codings (coding-system safe-chars)
- "This is an obsolete function.
- It exists just for backward compatibility, and it does nothing.")
- (make-obsolete 'register-char-codings
- "Unnecessary function. Calling it has no effect."
- "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))))
- (i 0)
- temp)
- (while (< i 3)
- (put (aref subsidiaries i) 'coding-system coding-spec)
- (put (aref subsidiaries i) 'eol-type i)
- (add-to-coding-system-list (aref subsidiaries i))
- (setq coding-system-alist
- (cons (list (symbol-name (aref subsidiaries i)))
- coding-system-alist))
- (setq i (1+ i)))
- 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.
+Value is a list of transformed arguments."
+ (let ((mnemonic (string-to-char (or (plist-get props 'mnemonic) "?")))
+ (eol-type (plist-get props 'eol-type))
+ properties tmp)
+ (cond
+ ((eq eol-type 'lf) (setq eol-type 'unix))
+ ((eq eol-type 'crlf) (setq eol-type 'dos))
+ ((eq eol-type 'cr) (setq eol-type 'mac)))
+ (if (setq tmp (plist-get props 'post-read-conversion))
+ (setq properties (plist-put properties 'post-read-conversion tmp)))
+ (if (setq tmp (plist-get props 'pre-write-conversion))
+ (setq properties (plist-put properties 'pre-write-conversion tmp)))
+ (cond
+ ((eq type 'shift-jis)
+ `(,name 1 ,mnemonic ,doc-string () ,properties ,eol-type))
+ ((eq type 'iso2022) ; This is not perfect.
+ (if (plist-get props 'escape-quoted)
+ (error "escape-quoted is not supported: %S"
+ `(,name ,type ,doc-string ,props)))
+ (let ((g0 (plist-get props 'charset-g0))
+ (g1 (plist-get props 'charset-g1))
+ (g2 (plist-get props 'charset-g2))
+ (g3 (plist-get props 'charset-g3))
+ (use-roman
+ (and
+ (eq (cadr (assoc 'latin-jisx0201
+ (plist-get props 'input-charset-conversion)))
+ 'ascii)
+ (eq (cadr (assoc 'ascii
+ (plist-get props 'output-charset-conversion)))
+ 'latin-jisx0201)))
+ (use-oldjis
+ (and
+ (eq (cadr (assoc 'japanese-jisx0208-1978
+ (plist-get props 'input-charset-conversion)))
+ 'japanese-jisx0208)
+ (eq (cadr (assoc 'japanese-jisx0208
+ (plist-get props 'output-charset-conversion)))
+ 'japanese-jisx0208-1978))))
+ (if (charsetp g0)
+ (if (plist-get props 'force-g0-on-output)
+ (setq g0 `(nil ,g0))
+ (setq g0 `(,g0 t))))
+ (if (charsetp g1)
+ (if (plist-get props 'force-g1-on-output)
+ (setq g1 `(nil ,g1))
+ (setq g1 `(,g1 t))))
+ (if (charsetp g2)
+ (if (plist-get props 'force-g2-on-output)
+ (setq g2 `(nil ,g2))
+ (setq g2 `(,g2 t))))
+ (if (charsetp g3)
+ (if (plist-get props 'force-g3-on-output)
+ (setq g3 `(nil ,g3))
+ (setq g3 `(,g3 t))))
+ `(,name 2 ,mnemonic ,doc-string
+ (,g0 ,g1 ,g2 ,g3
+ ,(plist-get props 'short)
+ ,(not (plist-get props 'no-ascii-eol))
+ ,(not (plist-get props 'no-ascii-cntl))
+ ,(plist-get props 'seven)
+ t
+ ,(not (plist-get props 'lock-shift))
+ ,use-roman
+ ,use-oldjis
+ ,(plist-get props 'no-iso6429)
+ nil nil nil nil)
+ ,properties ,eol-type)))
+ ((eq type 'big5)
+ `(,name 3 ,mnemonic ,doc-string () ,properties ,eol-type))
+ ((eq type 'ccl)
+ `(,name 4 ,mnemonic ,doc-string
+ (,(plist-get props 'decode) . ,(plist-get props 'encode))
+ ,properties ,eol-type))
+ (t
+ (error "unsupported XEmacs style make-coding-style arguments: %S"
+ `(,name ,type ,doc-string ,props))))))
+
+(defun make-coding-system (coding-system type mnemonic doc-string
+ &optional
+ flags
+ 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 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.
-
- 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
+ ;; Emacs style.
+ (if (symbolp type)
+ (let ((args (transform-make-coding-system-args coding-system type
+ mnemonic doc-string)))
+ (setq coding-system (car args)
+ type (nth 1 args)
+ mnemonic (nth 2 args)
+ doc-string (nth 3 args)
+ flags (nth 4 args)
+ 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-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)
- (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))
- (add-to-coding-system-list alias)
- (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))
++ (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.
+Return the resulting coding system."
+ (let ((base (coding-system-base second))
+ (eol (coding-system-eol-type second)))
+ ;; If FIRST doesn't specify text conversion, merge with that of SECOND.
+ (if (eq (coding-system-base first) 'undecided)
+ (setq first (coding-system-change-text-conversion first base)))
+ ;; If FIRST doesn't specify eol conversion, merge with that of SECOND.
+ (if (and (vectorp (coding-system-eol-type first))
+ (numberp eol) (>= eol 0) (<= eol 2))
+ (setq first (coding-system-change-eol-conversion
+ first eol)))
+ first))
+
(defun set-buffer-file-coding-system (coding-system &optional force)
"Set the file coding-system of the current buffer to CODING-SYSTEM.
This means that when you save the buffer, it will be converted
according to CODING-SYSTEM. For a list of possible values of CODING-SYSTEM,
use \\[list-coding-systems].
-If the buffer's previous file coding-system value specifies end-of-line
-conversion, and CODING-SYSTEM does not specify one, CODING-SYSTEM is
-merged with the already-specified end-of-line conversion.
-
-If the buffer's previous file coding-system value specifies text
-conversion, and CODING-SYSTEM does not specify one, CODING-SYSTEM is
-merged with the already-specified text conversion.
-
-However, if the optional prefix argument FORCE is non-nil, then
-CODING-SYSTEM is used exactly as specified.
+If CODING-SYSTEM leaves the text conversion unspecified, or if it
+leaves the end-of-line conversion unspecified, FORCE controls what to
+do. If FORCE is nil, get the unspecified aspect (or aspects) from the
+buffer's previous `buffer-file-coding-system' value (if it is
+specified there). Otherwise, levae it unspecified.
This marks the buffer modified so that the succeeding \\[save-buffer]
surely saves the buffer with CODING-SYSTEM. From a program, if you
don't want to mark the buffer modified, just set the variable
`buffer-file-coding-system' directly."
- (interactive "zCoding system for visited file (default, nil): \nP")
+ (interactive "zCoding system for saving file (default, nil): \nP")
(check-coding-system coding-system)
(if (and coding-system buffer-file-coding-system (null force))
- (let ((base (coding-system-base buffer-file-coding-system))
- (eol (coding-system-eol-type buffer-file-coding-system)))
- ;; If CODING-SYSTEM doesn't specify text conversion, merge
- ;; with that of buffer-file-coding-system.
- (if (eq (coding-system-base coding-system) 'undecided)
- (setq coding-system (coding-system-change-text-conversion
- coding-system base)))
- ;; If CODING-SYSTEM doesn't specify eol conversion, merge with
- ;; that of buffer-file-coding-system.
- (if (and (vectorp (coding-system-eol-type coding-system))
- (numberp eol) (>= eol 0) (<= eol 2))
- (setq coding-system (coding-system-change-eol-conversion
- coding-system eol)))))
+ (setq coding-system
+ (merge-coding-systems coding-system buffer-file-coding-system)))
(setq buffer-file-coding-system coding-system)
+ ;; This is in case of an explicit call. Normally, `normal-mode' and
+ ;; `set-buffer-major-mode-hook' take care of setting the table.
+ (if (fboundp 'ucs-set-table-for-input) ; don't lose when building
+ (ucs-set-table-for-input))
(set-buffer-modified-p t)
(force-mode-line-update))
+(defun revert-buffer-with-coding-system (coding-system &optional force)
+ "Visit the current buffer's file again using coding system CODING-SYSTEM.
+For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems].
+
+If CODING-SYSTEM leaves the text conversion unspecified, or if it
+leaves the end-of-line conversion unspecified, FORCE controls what to
+do. If FORCE is nil, get the unspecified aspect (or aspects) from the
+buffer's previous `buffer-file-coding-system' value (if it is
+specified there). Otherwise, determine it from the file contents as
+usual for visiting a file."
+ (interactive "zCoding system for visited file (default, nil): \nP")
+ (check-coding-system coding-system)
+ (if (and coding-system buffer-file-coding-system (null force))
+ (setq coding-system
+ (merge-coding-systems coding-system buffer-file-coding-system)))
+ (let ((coding-system-for-read coding-system))
+ (revert-buffer)))
+
+(defun set-file-name-coding-system (coding-system)
+ "Set coding system for decoding and encoding file names to CODING-SYSTEM.
+It actually just set the variable `file-name-coding-system' (which
+see) to CODING-SYSTEM."
+ (interactive "zCoding system for file names (default, nil): ")
+ (check-coding-system coding-system)
+ (setq file-name-coding-system coding-system))
+
(defvar default-terminal-coding-system nil
"Default value for the terminal coding system.
This is normally set according to the selected language environment.
8-bit characters, you will have to use ESC to type Meta characters.
See Info node `Specify Coding' and Info node `Single-Byte Character Support'.
+On non-windowing terminals, this is set from the locale by default.
+
Setting this variable directly does not take effect;
use either M-x customize or \\[set-keyboard-coding-system]."
:type '(coding-system :tag "Coding system")
(if (or value (boundp 'encoded-kbd-mode))
(set-keyboard-coding-system value)
(set-default 'keyboard-coding-system nil))) ; must initialize
- :version "21.1"
+ :version "21.4"
:group 'keyboard
:group 'mule)
(defalias 'set-clipboard-coding-system 'set-selection-coding-system)
(defun set-selection-coding-system (coding-system)
- "Make CODING-SYSTEM used for communicating with other X clients .
+ "Make CODING-SYSTEM used for communicating with other X clients.
When sending or receiving text via cut_buffer, selection, and clipboard,
the text is encoded or decoded by CODING-SYSTEM."
(interactive "zCoding system for X selection: ")
(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 "22.1")
;;; X selections
(defvar ctext-non-standard-encodings-alist
- '(("ISO8859-10" . iso-8859-10)
- ("ISO8859-13" . iso-8859-13)
- ("ISO8859-14" . iso-8859-14)
- ("ISO8859-15" . iso-8859-15)
- ("ISO8859-16" . iso-8859-16)
+ '(("ISO8859-15" . latin-iso8859-15)
+ ("ISO8859-14" . latin-iso8859-14)
("KOI8-R" . koi8-r)
("BIG5-0" . big5))
"Alist of non-standard encoding names vs Emacs coding systems.
This alist is used to decode an extened segment of a compound text.")
-;; Functions to support "Non-Standard Character Set Encodings" defined
-;; by the COMPOUND TEXT spec.
-
(defvar ctext-non-standard-encodings-regexp
(string-to-multibyte
(concat
;; For UTF-8 encoding.
"\\(\e%G[^\e]*\e%@\\)")))
+;; Functions to support "Non-Standard Character Set Encodings" defined
+;; by the COMPOUND-TEXT spec.
+;; We support that by decoding the whole data by `ctext' which just
+;; pertains byte sequences belonging to ``extended segment'', then
+;; decoding those byte sequences one by one in Lisp.
+;; This function also supports "The UTF-8 encoding" described in the
+;; section 7 of the documentation fo COMPOUND-TEXT distributed with
+;; XFree86.
+
(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)))
(decode-coding-region (point-min) (point-max) 'ctext)
- (if in-workbuf
- (set-buffer-multibyte t))
(while (re-search-forward ctext-non-standard-encodings-regexp
nil 'move)
(setq pos (match-beginning 0))
ctext-non-standard-encodings-alist))
(coding-system-p
(intern (downcase encoding))))))
+ (if enable-multibyte-characters
+ (setq M (multibyte-char-to-unibyte M)
+ L (multibyte-char-to-unibyte L)))
(setq bytes (- (+ (* (- M 128) 128) (- L 128))
(- (point) (+ pos 6))))
(when coding
(goto-char (point-min))
(- (point-max) (point)))))
+;; If you add charsets here, be sure to modify the regexp used by
+;; ctext-pre-write-conversion to look up non-standard charsets.
(defvar ctext-non-standard-designations-alist
'(("$(0" . (big5 "big5-0" 2))
("$(1" . (big5 "big5-0" 2))
;; The following are actually standard; generating extended
;; segments for them is wrong and screws e.g. Latin-9 users.
- ;; ("-V" . (t "iso8859-10" 1))
- ;; ("-Y" . (t "iso8859-13" 1))
- ;; ("-_" . (t "iso8859-14" 1))
- ;; ("-b" . (t "iso8859-15" 1))
- ;; ("-f" . (t "iso8859-16" 1))
+ ;; 8859-{10,13,16} aren't Emacs charsets anyhow. -- fx
+;; ("-V" . (t "iso8859-10" 1))
+;; ("-Y" . (t "iso8859-13" 1))
+;; ("-_" . (t "iso8859-14" 1))
+;; ("-b" . (t "iso8859-15" 1))
+;; ("-f" . (t "iso8859-16" 1))
)
"Alist of ctext control sequences that introduce character sets which
are not in the list of approved encodings, and the corresponding
"Encode characters between FROM and TO as Compound Text w/Extended Segments.
If FROM is a string, or if the current buffer is not the one set up for us
-by run_pre_post_conversion_on_str, generate a new temp buffer, insert the
+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
;; Setup a working buffer if necessary.
- (cond ((stringp from)
- (let ((buf (current-buffer)))
- (set-buffer (generate-new-buffer " *temp"))
- (set-buffer-multibyte (multibyte-string-p from))
- (insert from)))
- ((not (string= (buffer-name) " *code-converting-work*"))
- (let ((buf (current-buffer))
- (multibyte enable-multibyte-characters))
- (set-buffer (generate-new-buffer " *temp"))
- (set-buffer-multibyte multibyte)
- (insert-buffer-substring buf from to))))
+ (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 ((case-fold-search nil)
noctets (car (cddr encode-info)))
(skip-chars-forward "^\e")
(cond
- ((eq encoding t) ; only the leading sequence needs to be changed
+ ((eq encoding t) ; only the leading sequence needs to be changed
(setq textlen (+ (- (point) posend) (length chset) 1))
;; Generate the control sequence for an extended segment.
- (replace-match (format "\e%%/%d%c%c%s\ 2"
- noctets
- (+ (/ textlen 128) 128)
- (+ (% textlen 128) 128)
- chset)
+ (replace-match (string-to-multibyte (format "\e%%/%d%c%c%s\ 2"
+ noctets
+ (+ (/ textlen 128) 128)
+ (+ (% textlen 128) 128)
+ chset))
t t))
((coding-system-p encoding) ; need to recode the entire segment...
(decode-coding-region pos (point) 'ctext-no-compositions)
(setq textlen (+ (- (point) pos) (length chset) 1))
(save-excursion
(goto-char pos)
- (insert (format "\e%%/%d%c%c%s\ 2"
- noctets
- (+ (/ textlen 128) 128)
- (+ (% textlen 128) 128)
- chset))))))
+ (insert (string-to-multibyte (format "\e%%/%d%c%c%s\ 2"
+ noctets
+ (+ (/ textlen 128) 128)
+ (+ (% textlen 128) 128)
+ chset)))))))
(goto-char (point-min))))
;; Must return nil, as build_annotations_2 expects that.
nil)
-(make-obsolete 'set-coding-priority 'set-coding-system-priority "22.1")
-
;;; FILE I/O
(defcustom auto-coding-alist
- '(("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\|sx[dmicw]\\|tar\\|tgz\\)\\'" . no-conversion)
- '(("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\|tar\\|tgz\\)\\'" . no-conversion)
- ("\\.\\(gz\\|Z\\|bz\\|bz2\\|gpg\\)\\'" . no-conversion))
++ '(("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\|sx[dmicw]\\|tar\\)\\'" . no-conversion-multibyte)
++ ("\\.tgz\\'" . no-conversion)
+ ("\\.\\(gz\\|Z\\|bz\\|bz2\\|gpg\\)\\'" . no-conversion)
+ ("/#[^/]+#\\'" . emacs-mule))
"Alist of filename patterns vs corresponding coding systems.
Each element looks like (REGEXP . CODING-SYSTEM).
A file whose name matches REGEXP is decoded by CODING-SYSTEM on reading.
(symbol :tag "Coding system"))))
(defcustom auto-coding-regexp-alist
- '(("^BABYL OPTIONS:[ \t]*-\\*-[ \t]*rmail[ \t]*-\\*-" . no-conversion))
+ '(("^BABYL OPTIONS:[ \t]*-\\*-[ \t]*rmail[ \t]*-\\*-" . no-conversion)
+ ("\\`;ELC\14
"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.
:type '(repeat (cons (regexp :tag "Regexp")
(symbol :tag "Coding system"))))
+;; See the bottom of this file for built-in auto coding functions.
+(defcustom auto-coding-functions '(sgml-xml-auto-coding-function
+ sgml-html-meta-auto-coding-function)
+ "A list of functions which attempt to determine a coding system.
+
+Each function in this list should be written to operate on the
+current buffer, but should not modify it in any way. The buffer
+will contain undecoded text of parts of the file. Each function
+should take one argument, SIZE, which says how many
+characters (starting from point) it should look at.
+
+If one of these functions succeeds in determining a coding
+system, it should return that coding system. Otherwise, it
+should return nil.
+
+If a file has a `coding:' tag, that takes precedence over these
+functions, so they won't be called at all."
+ :group 'files
+ :group 'mule
+ :type '(repeat function))
+
(defvar set-auto-coding-for-load nil
"Non-nil means look for `load-coding' property instead of `coding'.
This is used for loading and byte-compiling Emacs Lisp files.")
(defun auto-coding-alist-lookup (filename)
"Return the coding system specified by `auto-coding-alist' for FILENAME."
(let ((alist auto-coding-alist)
- (case-fold-search (memq system-type '(vax-vms windows-nt ms-dos)))
+ (case-fold-search (memq system-type '(vax-vms windows-nt ms-dos cygwin)))
coding-system)
(while (and alist (not coding-system))
(if (string-match (car (car alist)) filename)
(setq alist (cdr alist))))
coding-system))
-
-(defun auto-coding-from-file-contents (size)
- "Determine a coding system from the contents of the current buffer.
-The current buffer contains SIZE bytes starting at point.
-Value is either a coding system or nil."
- (save-excursion
- (let ((alist auto-coding-regexp-alist)
- coding-system)
- (while (and alist (not coding-system))
- (let ((regexp (car (car alist))))
- (when (re-search-forward regexp (+ (point) size) t)
- (setq coding-system (cdr (car alist)))))
- (setq alist (cdr alist)))
- coding-system)))
-
-
(defun set-auto-coding (filename size)
"Return coding system for a file FILENAME of which SIZE bytes follow point.
These bytes should include at least the first 1k of the file
and the last 3k of the file, but the middle may be omitted.
-It checks FILENAME against the variable `auto-coding-alist'. If
-FILENAME doesn't match any entries in the variable, it checks the
+The function checks FILENAME against the variable `auto-coding-alist'.
+If FILENAME doesn't match any entries in the variable, it checks the
contents of the current buffer following point against
`auto-coding-regexp-alist'. If no match is found, it checks for a
`coding:' tag in the first one or two lines following point. If no
-`coding:' tag is found, it checks for local variables list in the last
-3K bytes out of the SIZE bytes.
+`coding:' tag is found, it checks any local variables list in the last
+3K bytes out of the SIZE bytes. Finally, if none of these methods
+succeed, it checks to see if any function in `auto-coding-functions'
+gives a match.
-The return value is the specified coding system,
-or nil if nothing specified.
+The return value is the specified coding system, or nil if nothing is
+specified.
The variable `set-auto-coding-function' (which see) is set to this
function by default."
(or (auto-coding-alist-lookup filename)
- (auto-coding-from-file-contents size)
+ ;; Try using `auto-coding-regexp-alist'.
+ (save-excursion
+ (let ((alist auto-coding-regexp-alist)
+ coding-system)
+ (while (and alist (not coding-system))
+ (let ((regexp (car (car alist))))
+ (when (re-search-forward regexp (+ (point) size) t)
+ (setq coding-system (cdr (car alist)))))
+ (setq alist (cdr alist)))
+ coding-system))
(let* ((case-fold-search t)
(head-start (point))
(head-end (+ head-start (min size 1024)))
(setq coding-system (intern (match-string 1)))
(or (coding-system-p coding-system)
(setq coding-system nil))))))
+ coding-system)
+ ;; Finally, try all the `auto-coding-functions'.
+ (let ((funcs auto-coding-functions)
+ (coding-system nil))
+ (while (and funcs (not coding-system))
+ (setq coding-system (condition-case e
+ (save-excursion
+ (goto-char (point-min))
+ (funcall (pop funcs) size))
+ (error nil))))
coding-system)))
(setq set-auto-coding-function 'set-auto-coding)
-(defun after-insert-file-set-buffer-file-coding-system (inserted)
- "Set `buffer-file-coding-system' of current buffer after text is inserted."
+(defun after-insert-file-set-coding (inserted)
+ "Set `buffer-file-coding-system' of current buffer after text is inserted.
+INSERTED is the number of characters that were inserted, as figured
+in the situation before this function. Return the number of characters
+inserted, as figured in the situation after. The two numbers can be
+different if the buffer has become unibyte."
(if last-coding-system-used
(let ((coding-system
(find-new-buffer-file-coding-system last-coding-system-used))
(modified-p (buffer-modified-p)))
(when coding-system
(set-buffer-file-coding-system coding-system t)
-- (if (and enable-multibyte-characters
- (or (eq coding-system 'no-conversion)
- (eq (coding-system-type coding-system) 5))
- (or (eq (coding-system-type coding-system) 'raw-text))
-- ;; 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))))
- (let ((pos-byte (position-bytes (+ (point) inserted))))
-- (set-buffer-multibyte nil)
- (setq inserted (- pos-marker (point)))))
- (setq inserted (- pos-byte (position-bytes (point))))))
(set-buffer-modified-p modified-p))))
inserted)
-(add-hook 'after-insert-file-functions
- 'after-insert-file-set-buffer-file-coding-system)
-
;; The coding-spec and eol-type of coding-system returned is decided
;; independently in the following order.
;; 1. That of buffer-file-coding-system locally bound.
;; 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.
(cons (cons regexp coding-system)
network-coding-system-alist)))))))
+(defun decode-coding-inserted-region (from to filename
+ &optional visit beg end replace)
+ "Decode the region between FROM and TO as if it is read from file FILENAME.
+Optional arguments VISIT, BEG, END, and REPLACE are the same as those
+of the function `insert-file-contents'."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region from to)
+ (goto-char (point-min))
+ (let ((coding coding-system-for-read))
+ (or coding
+ (setq coding (funcall set-auto-coding-function
+ filename (- (point-max) (point-min)))))
+ (or coding
+ (setq coding (find-operation-coding-system
+ 'insert-file-contents
+ filename visit beg end replace)))
+ (if (coding-system-p coding)
+ (or enable-multibyte-characters
+ (setq coding
+ (coding-system-change-text-conversion coding 'raw-text)))
+ (setq coding nil))
+ (if coding
+ (decode-coding-region (point-min) (point-max) coding))
+ (setq last-coding-system-used coding)))))
+
(defun make-translation-table (&rest args)
"Make a translation table from arguments.
A translation table is a char table intended for character
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.
table))
(put 'with-category-table 'lisp-indent-function 1)
-(defmacro with-category-table (category-table &rest body)
- "Execute BODY like `progn' with CATEGORY-TABLE the current category table."
- (let ((current-category-table (make-symbol "current-category-table")))
- `(let ((,current-category-table (category-table)))
- (set-category-table ,category-table)
+(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."
+ (let ((old-table (make-symbol "old-table"))
+ (old-buffer (make-symbol "old-buffer")))
+ `(let ((,old-table (category-table))
+ (,old-buffer (current-buffer)))
(unwind-protect
- (progn ,@body)
- (set-category-table ,current-category-table)))))
+ (progn
+ (set-category-table ,table)
+ ,@body)
+ (save-current-buffer
+ (set-buffer ,old-buffer)
+ (set-category-table ,old-table))))))
+
+(defun define-translation-hash-table (symbol table)
+ "Define SYMBOL as the name of the hash translation TABLE for use in CCL.
+
+Analogous to `define-translation-table', but updates
+`translation-hash-table-vector' and the table is for use in the CCL
+`lookup-integer' and `lookup-character' functions."
+ (unless (and (symbolp symbol)
+ (hash-table-p table))
+ (error "Bad args to define-translation-hash-table"))
+ (let ((len (length translation-hash-table-vector))
+ (id 0)
+ done)
+ (put symbol 'translation-hash-table table)
+ (while (not done)
+ (if (>= id len)
+ (setq translation-hash-table-vector
+ (vconcat translation-hash-table-vector [nil])))
+ (let ((slot (aref translation-hash-table-vector id)))
+ (if (or (not slot)
+ (eq (car slot) symbol))
+ (progn
+ (aset translation-hash-table-vector id (cons symbol table))
+ (setq done t))
+ (setq id (1+ id)))))
+ (put symbol 'translation-hash-table-id id)
+ id))
;;; Initialize some variables.
(setq ignore-relative-composition
(make-char-table 'ignore-relative-composition))
+ (make-obsolete 'set-char-table-default
+ "Generic characters no longer exist" "22.1")
+
+;;; Built-in auto-coding-functions:
+
+(defun sgml-xml-auto-coding-function (size)
+ "Determine whether the buffer is XML, and if so, its encoding.
+This function is intended to be added to `auto-coding-functions'."
+ (setq size (+ (point) size))
+ (when (re-search-forward "\\`[[:space:]\n]*<\\?xml" size t)
+ (let ((end (save-excursion
+ ;; This is a hack.
+ (re-search-forward "\"\\s-*\\?>" size t))))
+ (when end
+ (if (re-search-forward "encoding=\"\\(.+?\\)\"" end t)
+ (let* ((match (match-string 1))
+ (sym (intern (downcase match))))
+ (if (coding-system-p sym)
+ sym
+ (message "Warning: unknown coding system \"%s\"" match)
+ nil))
+ 'utf-8)))))
+
+(defun sgml-html-meta-auto-coding-function (size)
+ "If the buffer has an HTML meta tag, use it to determine encoding.
+This function is intended to be added to `auto-coding-functions'."
+ (setq size (min (+ (point) size)
+ ;; Only search forward 10 lines
+ (save-excursion
+ (forward-line 10)
+ (point))))
+ (when (and (search-forward "<html>" size t)
+ (re-search-forward "<meta\\s-+http-equiv=\"content-type\"\\s-+content=\"text/\\sw+;\\s-*charset=\\(.+?\\)\"" size t))
+ (let* ((match (match-string 1))
+ (sym (intern (downcase match))))
+ (if (coding-system-p sym)
+ sym
+ (message "Warning: unknown coding system \"%s\"" match)
+ nil))))
+
;;;
(provide 'mule)
;; Copyright (C) 1995, 2000 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
;; Author: Kenichi HANDA <handa@etl.go.jp>
;; Naoto TAKAHASHI <ntakahas@etl.go.jp>
(make-variable-buffer-local 'quail-current-package)
(put 'quail-current-package 'permanent-local t)
-;; Quail uses the following two buffers to assist users.
-;; A buffer to show available key sequence or translation list.
-(defvar quail-guidance-buf nil)
+;; Quail uses the following variables to assist users.
+;; A string containing available key sequences or translation list.
+(defvar quail-guidance-str nil)
;; A buffer to show completion list of the current key sequence.
(defvar quail-completion-buf nil)
+;; We may display the guidance string in a buffer on a one-line frame.
+(defvar quail-guidance-buf nil)
+(defvar quail-guidance-frame nil)
;; Each buffer in which Quail is activated should use different
-;; guidance buffers.
-(make-variable-buffer-local 'quail-guidance-buf)
-(put 'quail-guidance-buf 'permanent-local t)
-
-;; A main window showing Quail guidance buffer.
-(defvar quail-guidance-win nil)
-(make-variable-buffer-local 'quail-guidance-win)
+;; guidance string.
+(make-variable-buffer-local 'quail-guidance-str)
+(put 'quail-guidance-str 'permanent-local t)
(defvar quail-overlay nil
"Overlay which covers the current translation region of Quail.")
title
(condition-case nil
(mapconcat
- (lambda (x)
+ (lambda (x)
(cond ((stringp x) x)
((and (listp x) (symbolp (car x)) (= (length x) 3))
(if (symbol-value (car x))
(let ((pos (point)))
(if (overlayp quail-overlay)
(move-overlay quail-overlay pos pos)
- (setq quail-overlay (make-overlay pos pos nil nil t))
+ (setq quail-overlay (make-overlay pos pos))
(if input-method-highlight-flag
(overlay-put quail-overlay 'face 'underline))
(let ((l (quail-overlay-plist)))
(if (overlayp quail-conv-overlay)
(if (not (overlay-start quail-conv-overlay))
(move-overlay quail-conv-overlay pos pos))
- (setq quail-conv-overlay (make-overlay pos pos nil nil t))
+ (setq quail-conv-overlay (make-overlay pos pos))
(if input-method-highlight-flag
(overlay-put quail-conv-overlay 'face 'underline))))))
(if (and (overlayp quail-conv-overlay) (overlay-start quail-conv-overlay))
(delete-overlay quail-conv-overlay)))
-;; Kill Quail guidance buffer. Set in kill-buffer-hook.
-(defun quail-kill-guidance-buf ()
- (if (buffer-live-p quail-guidance-buf)
- (kill-buffer quail-guidance-buf)))
-
(defun quail-inactivate ()
"Inactivate Quail input method.
;; Let's inactivate Quail input method.
(unwind-protect
(progn
- (quail-hide-guidance-buf)
(quail-delete-overlays)
(setq describe-current-input-method-function nil)
+ (quail-hide-guidance)
+ (remove-hook 'post-command-hook 'quail-show-guidance t)
(run-hooks 'quail-inactivate-hook))
(kill-local-variable 'input-method-function))
;; Let's activate Quail input method.
(setq inactivate-current-input-method-function 'quail-inactivate)
(setq describe-current-input-method-function 'quail-help)
(quail-delete-overlays)
- (quail-show-guidance-buf)
+ (setq quail-guidance-str "")
+ (quail-show-guidance)
;; If we are in minibuffer, turn off the current input method
;; before exiting.
- (if (eq (selected-window) (minibuffer-window))
- (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
- (add-hook 'kill-buffer-hook 'quail-kill-guidance-buf nil t)
+ (when (eq (selected-window) (minibuffer-window))
+ (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer)
+ (add-hook 'post-command-hook 'quail-show-guidance nil t))
(run-hooks 'quail-activate-hook)
(make-local-variable 'input-method-function)
(setq input-method-function 'quail-input-method)))
but the location of key \\ (backslash) is just right of key ' (single-quote),
not right of RETURN key.")
-(defvar quail-keyboard-layout quail-keyboard-layout-standard
- "A string which represents physical key layout of a particular keyboard.
-We assume there are six rows and each row has 15 keys (columns),
- the first row is above the `1' - `0' row,
- the first column of the second row is left of key `1',
- the first column of the third row is left of key `q',
- the first column of the fourth row is left of key `a',
- the first column of the fifth row is left of key `z',
- the sixth row is below the `z' - `/' row.
-Nth (N is even) and (N+1)th characters in the string are non-shifted
-and shifted characters respectively at the same location.
-The location of Nth character is row (N / 30) and column ((N mod 30) / 2).
-The command `quail-set-keyboard-layout' usually sets this variable.")
-
(defconst quail-keyboard-layout-len 180)
;; Here we provide several examples of famous keyboard layouts.
")
'("pc105-uk" . "\
\
-`\2541!2\3\243$5%6^7&8*9(0)-_=+ \
+`\2541!2\"3\2434$5%6^7&8*9(0)-_=+ \
qQwWeErRtTyYuUiIoOpP[{]} \
aAsSdDfFgGhHjJkKlL;:'@#~ \
\\|zZxXcCvVbBnNmM,<.>/? \
See the documentation of `quail-keyboard-layout' for the format of
the layout string.")
+(defcustom quail-keyboard-layout quail-keyboard-layout-standard
+ "A string which represents physical key layout of a particular keyboard.
+We assume there are six rows and each row has 15 keys (columns),
+ the first row is above the `1' - `0' row,
+ the first column of the second row is left of key `1',
+ the first column of the third row is left of key `q',
+ the first column of the fourth row is left of key `a',
+ the first column of the fifth row is left of key `z',
+ the sixth row is below the `z' - `/' row.
+Nth (N is even) and (N+1)th characters in the string are non-shifted
+and shifted characters respectively at the same location.
+The location of Nth character is row (N / 30) and column ((N mod 30) / 2).
+The command `quail-set-keyboard-layout' usually sets this variable."
+ :group 'quail
+ :type `(choice
+ ,@(mapcar (lambda (pair)
+ (list 'const :tag (car pair) (cdr pair)))
+ quail-keyboard-layout-alist)
+ (string :tag "Other")))
+
;; A non-standard keyboard layout may miss some key locations of the
;; standard layout while having additional key locations not in the
;; standard layout. This alist maps those additional key locations to
The variable `quail-keyboard-layout-type' holds the currently selected
keyboard type."
(interactive
- (list (completing-read "Keyboard type (default, current choise): "
+ (list (completing-read "Keyboard type (default, current choice): "
quail-keyboard-layout-alist
nil t)))
(or (and keyboard-type (> (length keyboard-type) 0))
(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
(quail-setup-overlays (quail-conversion-keymap))
(let ((modified-p (buffer-modified-p))
(buffer-undo-list t))
- (or (and quail-guidance-win
- (window-live-p quail-guidance-win)
- (eq (window-buffer quail-guidance-win) quail-guidance-buf)
- (not input-method-use-echo-area))
- (quail-show-guidance-buf))
(unwind-protect
(let ((input-string (if (quail-conversion-keymap)
(quail-start-conversion key)
(quail-start-translation key))))
+ (setq quail-guidance-str "")
(when (and (stringp input-string)
(> (length input-string) 0))
(if input-method-exit-on-first-char
(list (aref input-string 0))
(quail-input-string-to-events input-string))))
(quail-delete-overlays)
- (if (buffer-live-p quail-guidance-buf)
- (with-current-buffer quail-guidance-buf
- (erase-buffer)))
- (quail-hide-guidance-buf)
(set-buffer-modified-p modified-p)
;; Run this hook only when the current input method doesn't require
;; conversion. When conversion is required, the conversion function
(setq unread-command-events (cons key unread-command-events)))
(while quail-translating
(set-buffer-modified-p modified-p)
+ (quail-show-guidance)
(let* ((keyseq (read-key-sequence
(and input-method-use-echo-area
(concat input-method-previous-message
quail-current-str ""
quail-translating t)
(quail-setup-overlays nil)))
- ;; Hide '... loaded' message.
- (message nil)
+ (quail-show-guidance)
(let* ((keyseq (read-key-sequence
(and input-method-use-echo-area
(concat input-method-previous-message
(defun quail-terminate-translation ()
"Terminate the translation of the current key."
(setq quail-translating nil)
- (if (buffer-live-p quail-guidance-buf)
- (with-current-buffer quail-guidance-buf
- (erase-buffer))))
+ (setq quail-guidance-str " "))
(defun quail-select-current ()
"Accept the currently selected translation."
(quail-simple))
(setq control-flag t)))))))
(or input-method-use-echo-area
- (progn
+ (let (pos)
(quail-delete-region)
- (insert quail-current-str)))
+ (setq pos (point))
+ (insert quail-current-str)
+ (move-overlay quail-overlay pos (point))
+ (if (overlayp quail-conv-overlay)
+ (if (not (overlay-start quail-conv-overlay))
+ (move-overlay quail-conv-overlay pos (point))
+ (if (< (overlay-end quail-conv-overlay) (point))
+ (move-overlay quail-conv-overlay
+ (overlay-start quail-conv-overlay)
+ (point)))))))
(let (quail-current-str)
(quail-update-guidance))
(or (stringp quail-current-str)
(< cur start) ; We moved to the previous block.
(>= cur end)) ; We moved to the next block.
(let ((len (length (cdr quail-current-translations)))
- (maxcol (- (window-width quail-guidance-win)
+ (maxcol (- (window-width)
quail-guidance-translations-starting-column))
(block (nth 3 indices))
col idx width trans num-items blocks)
(t
;; No way to handle the last character in this context.
+ (setq def (quail-map-definition
+ (quail-lookup-key quail-current-key (1- len))))
+ (if def (setq quail-current-str
+ (quail-get-current-str (1- len) def)))
(1- len))))))
(defun quail-next-translation ()
;; Guidance, Completion, and Help buffer handlers.
-(defun quail-make-guidance-frame (buf)
- "Make a new one-line frame for Quail guidance buffer."
+(defun quail-make-guidance-frame ()
+ "Make a new one-line frame for Quail guidance."
(let* ((fparam (frame-parameters))
(top (cdr (assq 'top fparam)))
(border (cdr (assq 'border-width fparam)))
(newtop (- top
(frame-char-height) (* internal-border 2) (* border 2))))
(if (< newtop 0)
- (setq newtop (+ top (frame-pixel-height))))
- (let* ((frame (make-frame (append '((user-position . t) (height . 1)
- (minibuffer) (menu-bar-lines . 0))
- (cons (cons 'top newtop) fparam))))
- (win (frame-first-window frame)))
- (set-window-buffer win buf)
- ;;(set-window-dedicated-p win t)
- )))
+ (setq newtop (+ top (frame-pixel-height) internal-border border)))
+ (make-frame (append '((user-position . t) (height . 1)
+ (minibuffer)
+ (menu-bar-lines . 0) (tool-bar-lines . 0))
+ (cons (cons 'top newtop) fparam)))))
(defun quail-setup-completion-buf ()
"Setup Quail completion buffer."
(not (quail-simple))
t))))
-(defun quail-show-guidance-buf ()
- "Display a guidance buffer for Quail input method in some window.
-Create the buffer if it does not exist yet.
-The buffer is normally displayed at the echo area,
-but if the current buffer is a minibuffer, it is shown in
-the bottom-most ordinary window of the same frame,
-or in a newly created frame (if the selected frame has no other windows)."
- (when (quail-require-guidance-buf)
- ;; At first, setup a guidance buffer.
- (let ((default-enable-multibyte-characters enable-multibyte-characters))
- (or (buffer-live-p quail-guidance-buf)
- (setq quail-guidance-buf (generate-new-buffer " *Quail-guidance*"))))
- (let ((name (quail-name))
- (title (quail-title)))
- (with-current-buffer quail-guidance-buf
- ;; To show the title of Quail package.
- (setq current-input-method name
- current-input-method-title title)
- (erase-buffer)
- (or (overlayp quail-overlay)
- (progn
- (setq quail-overlay (make-overlay 1 1))
- (overlay-put quail-overlay 'face 'highlight)))
- (delete-overlay quail-overlay)
- (set-buffer-modified-p nil)))
- (bury-buffer quail-guidance-buf)
-
- ;; Assign the buffer " *Minibuf-N*" to all windows which are now
- ;; displaying quail-guidance-buf.
- (let ((win-list (get-buffer-window-list quail-guidance-buf t t)))
- (while win-list
- (set-window-buffer (car win-list)
- (format " *Minibuf-%d*" (minibuffer-depth)))
- (setq win-list (cdr win-list))))
-
- ;; Then, display it in an appropriate window.
- (let ((win (minibuffer-window)))
- (if (or (eq (selected-window) win)
- input-method-use-echo-area)
- ;; Since we are in minibuffer, we can't use it for guidance.
- (if (eq win (frame-root-window))
- ;; Create a frame. It is sure that we are using some
- ;; window system.
- (quail-make-guidance-frame quail-guidance-buf)
- ;; Find the bottom window and split it if necessary.
- (setq win (window-at
- 0 (1- (- (frame-height) (window-height win)))))
- (let ((height (window-height win))
- (window-min-height 2))
- ;; If WIN is tall enough, split it vertically and use
- ;; the lower one.
- (when (>= height 4)
- ;; Here, `split-window' returns a lower window
- ;; which is what we wanted.
- (setq win (split-window win (- height 2))))
- (set-window-buffer win quail-guidance-buf)
- (with-current-buffer quail-guidance-buf
- (fit-window-to-buffer win nil (window-height win)))))
- (set-window-buffer win quail-guidance-buf)
- (set-minibuffer-window win))
- (setq quail-guidance-win win)))
-
- ;; And, create a buffer for completion.
+
+;; Quail specific version of minibuffer-message. It displays STRING
+;; with timeout 1000000 seconds instead of two seconds.
+
+(defun quail-minibuffer-message (string)
+ (message nil)
+ (let ((point-max (point-max))
+ (inhibit-quit t))
+ (save-excursion
+ (goto-char point-max)
+ (insert string))
+ (sit-for 1000000)
+ (delete-region point-max (point-max))
+ (when quit-flag
+ (setq quit-flag nil
+ unread-command-events '(7)))))
+
+(defun quail-show-guidance ()
+ "Display a guidance for Quail input method in some window.
+The guidance is normally displayed at the echo area,
+or in a newly created frame (if the current buffer is a
+minibuffer and the selected frame has no other windows)."
+ ;; At first, setup a buffer for completion.
(quail-setup-completion-buf)
- (bury-buffer quail-completion-buf))
-
-(defun quail-hide-guidance-buf ()
- "Hide the Quail guidance buffer."
- (if (buffer-live-p quail-guidance-buf)
- (let ((win-list (get-buffer-window-list quail-guidance-buf t t))
- win)
- (while win-list
- (setq win (car win-list) win-list (cdr win-list))
- (if (window-minibuffer-p win)
- ;; We are using echo area for the guidance buffer.
- ;; Vacate it to the deepest minibuffer.
- (set-window-buffer win
- (format " *Minibuf-%d*" (minibuffer-depth)))
- (if (eq win (frame-root-window (window-frame win)))
- (progn
- ;; We are using a separate frame for guidance buffer.
- ;;(set-window-dedicated-p win nil)
- (delete-frame (window-frame win)))
- ;;(set-window-dedicated-p win nil)
- (delete-window win))))
- (setq quail-guidance-win nil))))
+ (bury-buffer quail-completion-buf)
+
+ ;; Then, show the guidance.
+ (when (and (quail-require-guidance-buf)
+ (null unread-command-events)
+ (null unread-post-input-method-events))
+ (if (or (eq (selected-window) (minibuffer-window))
+ input-method-use-echo-area)
+ (if (eq (minibuffer-window) (frame-root-window))
+ ;; Use another frame. It is sure that we are using some
+ ;; window system.
+ (let ((guidance quail-guidance-str))
+ (or (frame-live-p quail-guidance-frame)
+ (setq quail-guidance-frame
+ (quail-make-guidance-frame)))
+ (or (buffer-live-p quail-guidance-buf)
+ (setq quail-guidance-buf
+ (get-buffer-create " *Quail-guidance*")))
+ (save-excursion
+ (set-buffer quail-guidance-buf)
+ (erase-buffer)
+ (setq cursor-type nil)
+ (insert guidance))
+ (set-window-buffer (frame-root-window quail-guidance-frame)
+ quail-guidance-buf)
+ (quail-minibuffer-message
+ (format " [%s]" current-input-method-title)))
+ ;; Show the guidance in the next line of the currrent
+ ;; minibuffer.
+ (quail-minibuffer-message
+ (format " [%s]\n%s"
+ current-input-method-title quail-guidance-str)))
+ ;; Show the guidance in echo area without logging.
+ (let ((message-log-max nil))
+ (message "%s" quail-guidance-str)))))
+
+(defun quail-hide-guidance ()
+ "Hide the Quail guidance."
+ (when (and (quail-require-guidance-buf)
+ (or (eq (selected-window) (minibuffer-window))
+ input-method-use-echo-area)
+ (eq (minibuffer-window) (frame-root-window)))
+ ;; We are using another frame for the guidance.
+ (if (frame-live-p quail-guidance-frame)
+ (delete-frame quail-guidance-frame))
+ (if (buffer-live-p quail-guidance-buf)
+ (kill-buffer quail-guidance-buf))))
(defun quail-update-guidance ()
"Update the Quail guidance buffer and completion buffer (if displayed now)."
- ;; Update guidance buffer.
- (if (quail-require-guidance-buf)
- (let ((guidance (quail-guidance)))
- (unless (and (eq (selected-frame) (window-frame (minibuffer-window)))
- (eq (selected-frame) (window-frame quail-guidance-win)))
- ;; The guidance window is not shown in this frame, show it.
- (quail-show-guidance-buf))
- (cond ((or (eq guidance t)
- (consp guidance))
- ;; Show the current possible translations.
- (quail-show-translations))
- ((null guidance)
- ;; Show the current input keys.
- (let ((key quail-current-key))
- (if (quail-kbd-translate)
- (setq key (quail-keyseq-translate key)))
- (with-current-buffer quail-guidance-buf
- (erase-buffer)
- (insert key)))))
- ;; Make sure the height of the guidance window is OK --
- ;; sometimes, if the minibuffer window expands due to user
- ;; input (for instance if the newly inserted character is in a
- ;; different font), it will cause the guidance window to be
- ;; only partially visible. We force a redisplay first because
- ;; this automatic expansion doesn't happen until then, and we
- ;; want to see the window sizes after the expansion.
- (sit-for 0)
- (fit-window-to-buffer quail-guidance-win nil
- (window-height quail-guidance-win))))
+ ;; Update the guidance string.
+ (when (quail-require-guidance-buf)
+ (let ((guidance (quail-guidance)))
+ (cond ((or (eq guidance t)
+ (consp guidance))
+ ;; Show the current possible translations.
+ (setq quail-guidance-str
+ (quail-get-translations)))
+ ((null guidance)
+ ;; Show the current input keys.
+ (let ((key quail-current-key))
+ (if (quail-kbd-translate)
+ (setq key (quail-keyseq-translate key)))
+ (setq quail-guidance-str (if (stringp key) key (string key)))))
+ (t
+ (setq quail-guidance-str " ")))))
;; Update completion buffer if displayed now. We highlight the
;; selected candidate string in *Completion* buffer if any.
(delete-overlay quail-overlay)
(setq pos (point))
(if (and str (search-forward (concat "." str) nil t))
- (move-overlay quail-overlay (1+ (match-beginning 0)) (point))
- (move-overlay quail-overlay (match-beginning 0) (point)))
+ (move-overlay quail-overlay (1+ (match-beginning 0)) (point))
+ (move-overlay quail-overlay (match-beginning 0) (point)))
;; Now POS points end of KEY and (point) points end of STR.
(if (pos-visible-in-window-p (point) win)
;; STR is already visible.
(set-window-start win pos))
))))))
-(defun quail-show-translations ()
- "Show the current possible translations."
- (let* ((key quail-current-key)
- (map (quail-lookup-key quail-current-key))
- (current-translations quail-current-translations))
+(defun quail-get-translations ()
+ "Return a string containing the current possible translations."
+ (let ((map (quail-lookup-key quail-current-key))
+ (str (copy-sequence quail-current-key)))
(if quail-current-translations
(quail-update-current-translations))
- (with-current-buffer quail-guidance-buf
- (erase-buffer)
-
- ;; Show the current key.
- (let ((guidance (quail-guidance)))
- (if (listp guidance)
- ;; We must show the specified PROMPTKEY instead of the
- ;; actual typed keys.
- (let ((i 0)
- (len (length key))
- prompt-key)
- (while (< i len)
- (setq prompt-key (cdr (assoc (aref key i) guidance)))
- (insert (or prompt-key (aref key i)))
- (setq i (1+ i))))
- (insert key)))
- ;; Show followable keys.
- (if (and (> (length key) 0) (cdr map))
- (let ((keys (mapcar (function (lambda (x) (car x)))
- (cdr map))))
- (setq keys (sort keys '<))
- (insert "[")
- (while keys
- (insert (car keys))
- (setq keys (cdr keys)))
- (insert "]")))
+ ;; Show the current key.
+ (let ((guidance (quail-guidance)))
+ (if (listp guidance)
+ ;; We must replace thetyped key with the specified PROMPTKEY.
+ (dotimes (i (length str))
+ (let ((prompt-key (cdr (assoc (aref str i) guidance))))
+ (if prompt-key
+ (aset str i (aref prompt-key 0)))))))
+ ;; Show followable keys.
+ (if (and (> (length quail-current-key) 0) (cdr map))
+ (setq str
+ (format "%s[%s]"
+ str
+ (concat (sort (mapcar (function (lambda (x) (car x)))
+ (cdr map))
+ '<)))))
;; Show list of translations.
- (if (and current-translations
+ (if (and quail-current-translations
(not (quail-deterministic)))
- (let* ((indices (car current-translations))
+ (let* ((indices (car quail-current-translations))
(cur (car indices))
(start (nth 1 indices))
(end (nth 2 indices))
(idx start))
- (indent-to (- quail-guidance-translations-starting-column 7))
- (insert (format "(%02d/"(nth 3 indices))
- (if (nth 4 indices)
- (format "%02d)" (nth 4 indices))
- "??)"))
+ (if (< (string-width str)
+ (- quail-guidance-translations-starting-column 7))
+ (setq str
+ (concat str
+ (make-string
+ (- quail-guidance-translations-starting-column
+ 7 (string-width str))
+ 32))))
+ (setq str (format "%s(%02d/%s)"
+ str (nth 3 indices)
+ (if (nth 4 indices)
+ (format "%02d" (nth 4 indices))
+ "??")))
(while (< idx end)
- (insert (format " %d." (if (= (- idx start) 9) 0
- (1+ (- idx start)))))
- (let ((pos (point)))
- (insert (aref (cdr current-translations) idx))
+ (let ((len (length str))
+ (trans (aref (cdr quail-current-translations) idx)))
+ (or (stringp trans)
+ (setq trans (string trans)))
+ (setq str (format "%s %d.%s"
+ str
+ (if (= (- idx start) 9) 0
+ (1+ (- idx start)))
+ trans))
(if (= idx cur)
- (move-overlay quail-overlay pos (point))))
- (setq idx (1+ idx)))))
- )))
+ (put-text-property (+ len 3) (length str)
+ 'face 'highlight str))
+ (setq idx (1+ idx))))))
+
+ str))
(defvar quail-completion-max-depth 5
"The maximum depth of Quail completion list.")
;; shown. We just scroll it appropriately.
(if (pos-visible-in-window-p (point-max) win)
(set-window-start win (point-min))
- (let ((other-window-scroll-buffer quail-completion-buf))
+ (let ((other-window-scroll-buffer quail-completion-buf)
+ ;; This nil binding is necessary to surely scroll
+ ;; quail-completion-buf.
+ (minibuffer-scroll-window nil))
(scroll-other-window)))
(setq quail-current-key key)
(erase-buffer)
(define-button-type 'quail-keyboard-layout-button
:supertype 'help-xref
- 'help-function '(lambda (layout)
+ 'help-function '(lambda (layout)
(help-setup-xref `(quail-keyboard-layout-button ,layout) nil)
(quail-show-keyboard-layout layout))
'help-echo (purecopy "mouse-2, RET: show keyboard layout"))
(when (> num 0)
(insert "
KEY SEQUENCE
- -----------
+ ------------
")
(if (quail-show-layout)
(insert "You can also input more characters")
(setq quail-current-package nil)
;; Resize the help window again, now that it has all its contents.
(save-selected-window
- (select-window (get-buffer-window (current-buffer)))
+ (select-window (get-buffer-window (current-buffer) t))
(run-hooks 'temp-buffer-show-hook)))))
(defun quail-help-insert-keymap-description (keymap &optional header)
;; 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
;;; Commentary:
-;;; Code:
-
+ ;; 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 swedish-re
"[ \t\n]\\(och\\|att\\|en\\|{r\\|\\[R\\|p}\\|P\\]\\|som\\|det\\|av\\|den\\|f|r\\|F\\\\R\\)[ \t\n.,?!:;'\")}]"
"Regular expression for common Swedish words.")
;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding:iso-2022-7bit; -*-
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
++;; Copyright (C) 2003
++;; National Institute of Advanced Industrial Science and Technology (AIST)
++;; Registration Number H13PRO009
;; Keywords: Quail, TIT, cxterm
first radical:
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
- \e$APD\e(B \e$AZ"\e(B \e$AJ,\e(B \e$AX<\e(B \e$A;p\e(B \e$A?Z\e(B \e$A^P\e(B \e$Ac_\e(B \e$AZ%\e(B \e$A\3\e(B \e$AXi\e(B \e$AD>\e(B \e$Alj\e(B \e$Ab;\e(B \e$ATB\e(B \e$Afy\e(B \e$AJ/\e(B \e$AMu\e(B \e$A0K\e(B \e$AX/\e(B \e$AHU\e(B \e$AeA\e(B \e$Aak\e(B \e$AVq\e(B \e$AR;\e(B \e$AHK\e(B
+ \e$APD\e(B \e$AZ"\e(B \e$AJ,\e(B \e$AX<\e(B \e$A;p\e(B \e$A?Z\e(B \e$A^P\e(B \e$Ac_\e(B \e$AZ%\e(B \e$A\3\e(B \e$AXi\e(B \e$AD>\e(B \e$Alj\e(B \e$Ab;\e(B \e$ATB\e(B \e$Afy\e(B \e$AJ/\e(B \e$AMu\e(B \e$A0K\e(B \e$AX/\e(B \e$AHU\e(B \e$AeA\e(B \e$Aak\e(B \e$AVq\e(B \e$AR;\e(B \e$AHK\e(B
last radical:
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
- \e$ASV\e(B \e$AI=\e(B \e$AMA\e(B \e$A56\e(B \e$AZb\e(B \e$A?Z\e(B \e$ARB\e(B \e$Aqb\e(B \e$A4s\e(B \e$A6!\e(B \e$A[L\e(B \e$Ala\e(B \e$AJ.\e(B \e$A4u\e(B \e$AXg\e(B \e$ACE\e(B \e$A=q\e(B \e$AX-\e(B \e$AE.\e(B \e$ARR\e(B \e$A`m\e(B \e$AP!\e(B \e$A3'\e(B \e$A3f\e(B \e$A_.\e(B \e$A27\e(B
+ \e$ASV\e(B \e$AI=\e(B \e$AMA\e(B \e$A56\e(B \e$AZb\e(B \e$A?Z\e(B \e$ARB\e(B \e$Aqb\e(B \e$A4s\e(B \e$A6!\e(B \e$A[L\e(B \e$Ala\e(B \e$AJ.\e(B \e$A4u\e(B \e$AXg\e(B \e$ACE\e(B \e$A=q\e(B \e$AX-\e(B \e$AE.\e(B \e$ARR\e(B \e$A`m\e(B \e$AP!\e(B \e$A3'\e(B \e$A3f\e(B \e$A_.\e(B \e$A27\e(B
\\<quail-translation-docstring>")
("chinese-tonepy" "\e$A5wF4\e(B"
"Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
-Pinyin is the standared roman transliteration method for Chinese.
+Pinyin is the standard roman transliteration method for Chinese.
For the details of Pinyin system, see the documentation of the input
method `chinese-py'.
dirname))
;; This value is nil if we are processing phrase dictionary.
-(defconst tit-dictionary t)
+(defvar tit-dictionary t)
(defvar tit-encode nil)
(defvar tit-default-encode "GB")
(princ (buffer-substring pos (point)))
(princ "\n")
(forward-line 1)))
-
+
(princ "\n;;; End of the header of original TIT dictionary.\n\n")
(princ ";;; Code:\n\n(require 'quail)\n\n")
(set-buffer-multibyte nil)
(let ((coding-system-for-read 'no-conversion))
(insert-file-contents (expand-file-name filename)))
-
+
;; Decode the buffer contents from the encoding specified by a
;; value of the key "ENCODE:".
(if (not (search-forward "\nBEGIN" nil t))
(goto-char (point-min))
(decode-coding-region (point-min) (point-max) coding-system))
+ (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.
++ ;; Process the body part
(tit-process-body))))))
;;;###autoload
;; Alist of input method names and the corresponding information.
;; Each element has this form:
;; (INPUT-METHOD-NAME ;; Name of the input method.
-;; INPUT-METHOD-TITLE ;; Title string of the input method
+;; INPUT-METHOD-TITLE ;; Title string of the input method
;; DICFILE ;; Name of the source dictionary file.
;; CODING ;; Coding system of the dictionary file.
;; QUAILFILE ;; Name of the Quail package file.
(defvar quail-misc-package-ext-info
'(("chinese-b5-tsangchi" "\e$(06A\e(BB"
- "cangjie-table.b5" big5 "tsang-b5.el"
+ "cangjie-table.b5" big5 "tsang-b5.el"
tsang-b5-converter
"\
;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw>
;; # this notice is preserved.")
("chinese-b5-quick" "\e$(0X|\e(BB"
- "cangjie-table.b5" big5 "quick-b5.el"
+ "cangjie-table.b5" big5 "quick-b5.el"
quick-b5-converter
"\
;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw>
;;
;;
;; Copyright (C) 1999, Rui He, herui@cs.duke.edu
-;;
-;;
+;;
+;;
;; CCE(Console Chinese Environment) 0.32
-;;
-;; CCE is free software; you can redistribute it and/or modify it under the
-;; terms of the GNU General Public License as published by the Free Software
-;; Foundation; either version 1, or (at your option) any later version.
-;;
-;; CCE is distributed in the hope that it will be useful, but WITHOUT ANY
-;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
-;; details.
-;;
+;;
+;; CCE is free software; you can redistribute it and/or modify it under the
+;; terms of the GNU General Public License as published by the Free Software
+;; Foundation; either version 1, or (at your option) any later version.
+;;
+;; CCE is distributed in the hope that it will be useful, but WITHOUT ANY
+;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+;; details.
+;;
;; You should have received a copy of the GNU General Public License along with
-;; CCE; see the file COPYING. If not, write to the Free Software Foundation,
+;; CCE; see the file COPYING. If not, write to the Free Software Foundation,
;; 675 Mass Ave, Cambridge, MA 02139, USA.")
("chinese-ziranma" "\e$AWTH;\e(B"
;;
;;
;; Copyright (C) 1999, Rui He, herui@cs.duke.edu
-;;
-;;
+;;
+;;
;; CCE(Console Chinese Environment) 0.32
-;;
-;; CCE is free software; you can redistribute it and/or modify it under the
-;; terms of the GNU General Public License as published by the Free Software
-;; Foundation; either version 1, or (at your option) any later version.
-;;
-;; CCE is distributed in the hope that it will be useful, but WITHOUT ANY
-;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
-;; details.
-;;
+;;
+;; CCE is free software; you can redistribute it and/or modify it under the
+;; terms of the GNU General Public License as published by the Free Software
+;; Foundation; either version 1, or (at your option) any later version.
+;;
+;; CCE is distributed in the hope that it will be useful, but WITHOUT ANY
+;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+;; details.
+;;
;; You should have received a copy of the GNU General Public License along with
-;; CCE; see the file COPYING. If not, write to the Free Software Foundation,
+;; CCE; see the file COPYING. If not, write to the Free Software Foundation,
;; 675 Mass Ave, Cambridge, MA 02139, USA.")
- ("chinese-b5-quick" "\e$(0X|\e(BB"
- "cangjie-table.b5" big5 "quick-b5.el"
- quick-b5-converter
- "\
-;; # Copyright 2001 Christian Wittern <wittern@iis.sinica.edu.tw>
-;; #
-;; # Permission to copy and distribute both modified and
-;; # unmodified versions is granted without royalty provided
-;; # this notice is preserved.")
-
("chinese-ctlau" "\e$AAuTA\e(B"
"CTLau.html" cn-gb-2312 "CTLau.el"
ctlau-gb-converter
;; It contains the following copyright notice:
;;
;; # Copyright (C) 1988-2001 Fung Fung Lee (lee@umunhum.stanford.edu)
-;; #
+;; #
;; # This program is free software; you can redistribute it and/or
;; # modify it under the terms of the GNU General Public License
;; # as published by the Free Software Foundation; either version 2
;; # of the License, or any later version.
-;; #
+;; #
;; # This program is distributed in the hope that it will be useful,
;; # but WITHOUT ANY WARRANTY; without even the implied warranty of
;; # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; # GNU General Public License for more details.
-;; #
+;; #
;; # You should have received a copy of the GNU General Public License
;; # along with this program; if not, write to the Free Software Foundation,
;; # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.")
;; It contains the following copyright notice:
;;
;; # Copyright (C) 1988-2001 Fung Fung Lee (lee@umunhum.stanford.edu)
-;; #
+;; #
;; # This program is free software; you can redistribute it and/or
;; # modify it under the terms of the GNU General Public License
;; # as published by the Free Software Foundation; either version 2
;; # of the License, or any later version.
-;; #
+;; #
;; # This program is distributed in the hope that it will be useful,
;; # but WITHOUT ANY WARRANTY; without even the implied warranty of
;; # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; # GNU General Public License for more details.
-;; #
+;; #
;; # You should have received a copy of the GNU General Public License
;; # along with this program; if not, write to the Free Software Foundation,
;; # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.")
[Q \e$(0'D\e(B] [W \e$(0(q\e(B] [E \e$(0'V\e(B] [R \e$(0&H\e(B] [T \e$(0'>\e(B] [Y \e$(0&4\e(B] [U \e$(0&U\e(B] [I \e$(0'B\e(B] [O \e$(0&*\e(B] [P \e$(0'A\e(B]
[A \e$(0'K\e(B] [S \e$(0&T\e(B] [D \e$(0'N\e(B] [F \e$(0'W\e(B] [G \e$(0&I\e(B] [H \e$(0*M\e(B] [J \e$(0&3\e(B] [L \e$(0&d\e(B]
-
+
[Z ] [X \e$(0[E\e(B] [C \e$(01[\e(B] [V \e$(0&M\e(B] [B \e$(0'M\e(B] [N \e$(0&_\e(B] [M \e$(0&"\e(B]
\\\\<quail-translation-docstring>\"\n"
[Q \e$(GEC\e(B] [W \e$(GFp\e(B] [E \e$(GEU\e(B] [R \e$(GDG\e(B] [T \e$(GE=\e(B] [Y \e$(GD3\e(B] [U \e$(GDT\e(B] [I \e$(GEA\e(B] [O \e$(GD)\e(B] [P \e$(GE@\e(B]
[A \e$(GEJ\e(B] [S \e$(GDS\e(B] [D \e$(GEM\e(B] [F \e$(GEV\e(B] [G \e$(GDH\e(B] [H \e$(GHL\e(B] [J \e$(GD2\e(B] [L \e$(GDc\e(B]
-
- [Z ] [X \e$(GyE\e(B] [C \e$(GOZ\e(B] [V \e$(GDL\e(B] [B \e$(GEL\e(B] [N \e$(GD^\e(B] [M \e$(GD!\e(B]
+
+ [Z ] [X \e$(GyE\e(B] [C \e$(GOZ\e(B] [V \e$(GDL\e(B] [B \e$(GEL\e(B] [N \e$(GD^\e(B] [M \e$(GD!\e(B]
\\\\<quail-translation-docstring>\"\n"
fulltitle fulltitle)))
Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
-Pinyin is the standared roman transliteration method for Chinese.
+Pinyin is the standard roman transliteration method for Chinese.
Pinyin uses a sequence of Latin alphabetic characters for each Chinese
character. The sequence is made by the combination of the initials
\(the beginning sounds) and finals (the ending sounds).
the Cantonese romanization of the respective radical (\e$(0?f5}\e(B)."))
(defun miscdic-convert (filename &optional dirname)
- "Convert a dictionary file FILENAME into a Quail package.
+ "Convert a dictionary file FILENAME into a Quail package.
Optional argument DIRNAME if specified is the directory name under which
the generated Quail package is saved."
(interactive "FInput method dictionary file: ")
(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 'iso-2022-7bit)
slot
name title dicfile coding quailfile converter copyright
dicbuf)
(if (string= (car command-line-args-left) "-dir")
(progn
(setq command-line-args-left (cdr command-line-args-left))
- (setq dir (car command-line-args-left))))
+ (setq dir (car command-line-args-left))
+ (setq command-line-args-left (cdr command-line-args-left))))
(setq filename (car command-line-args-left)
command-line-args-left (cdr command-line-args-left))
(if (file-directory-p filename)
;;; isearch.el --- incremental search minor mode
-;; Copyright (C) 1992, 93, 94, 95, 96, 97, 1999, 2000, 2001
+;; Copyright (C) 1992, 93, 94, 95, 96, 97, 1999, 2000, 01, 2003
;; Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
;; Added word search option to isearch-edit-string.
;; Renamed isearch-quit to isearch-abort.
;; Numerous changes to comments and doc strings.
-;;
+;;
;; Revision 1.3 92/06/29 13:10:08 liberte
;; Moved modal isearch-mode handling into isearch-mode.
;; Got rid of buffer-local isearch variables.
;;; Code:
\f
-;;; Some additional options and constants.
+;; Some additional options and constants.
(defgroup isearch nil
"Incremental search minor mode."
:type 'boolean
:group 'isearch)
-(defcustom search-whitespace-regexp "\\s-+"
+(defcustom search-whitespace-regexp "\\(?:\\s-+\\)"
"*If non-nil, regular expression to match a sequence of whitespace chars.
This applies to regular expression incremental search.
You might want to use something like \"[ \\t\\r\\n]+\" instead.
If the value is `open', if the text matched is made invisible by
an overlay having an `invisible' property and that overlay has a property
`isearch-open-invisible', then incremental search will show the contents.
-\(This applies when using `outline.el' and `hideshow.el'.)"
+\(This applies when using `outline.el' and `hideshow.el'.)
+See also `reveal-mode' if you want overlays to automatically be opened
+whenever point is in one of them."
:type '(choice (const :tag "Match hidden text" t)
(const :tag "Open overlays" open)
(const :tag "Don't match hidden text" nil))
This variable makes a difference when `search-invisible' is set to `open'.
It means that after search makes some invisible text visible
to show the match, it makes the text invisible again when the match moves.
-Ordinarily the text becomes invisible again at the end of the search."
- :type 'boolean
+Ordinarily the text becomes invisible again at the end of the search."
+ :type 'boolean
:group 'isearch)
(defcustom isearch-resume-enabled t
(defvar isearch-mode-end-hook nil
"Function(s) to call after terminating an incremental search.")
-;;; Search ring.
+;; Search ring.
(defvar search-ring nil
"List of search string sequences.")
:type 'boolean
:group 'isearch)
-;;; Define isearch-mode keymap.
+;; Define isearch-mode keymap.
(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))))
+ ;; Fixme: is this range right?
- (set-char-table-range (nth 1 map) (cons #x100 #x2FFFFF)
++ (set-char-table-range (nth 1 map) (cons #x100 #x3FFFFF)
+ 'isearch-printing-char)
;; Make function keys, etc, exit the search.
(define-key map [t] 'isearch-other-control-char)
;; Control chars, by default, end isearch mode transparently.
- ;; We need these explicit definitions because, in a dense keymap,
+ ;; We need these explicit definitions because, in a dense keymap,
;; the binding for t does not affect characters.
;; We use a dense keymap to save space.
(while (< i ?\ )
(error "Inconsistency in isearch.el"))
(define-key map "\e\e\e" 'isearch-cancel)
(define-key map [escape escape escape] 'isearch-cancel)
-
+
(define-key map "\C-q" 'isearch-quote-char)
(define-key map "\r" 'isearch-exit)
(define-key map "\t" 'isearch-printing-char)
(define-key map " " 'isearch-whitespace-chars)
(define-key map [?\S-\ ] 'isearch-whitespace-chars)
-
+
(define-key map "\C-w" 'isearch-yank-word-or-char)
(define-key map "\C-y" 'isearch-yank-line)
(define-key map "?" 'isearch-*-char)
(define-key map "|" 'isearch-|-char)
-;;; Turned off because I find I expect to get the global definition--rms.
-;;; ;; Instead bind C-h to special help command for isearch-mode.
-;;; (define-key map "\C-h" 'isearch-mode-help)
+ ;; Turned off because I find I expect to get the global definition--rms.
+ ;; ;; Instead bind C-h to special help command for isearch-mode.
+ ;; (define-key map "\C-h" 'isearch-mode-help)
(define-key map "\M-n" 'isearch-ring-advance)
(define-key map "\M-p" 'isearch-ring-retreat)
(defvar isearch-forward nil) ; Searching in the forward direction.
(defvar isearch-regexp nil) ; Searching for a regexp.
(defvar isearch-word nil) ; Searching for words.
+(defvar isearch-hidden nil) ; Non-nil if the string exists but is invisible.
+
+(defvar isearch-cmds nil
+ "Stack of search status sets.
+Each set is a list of the form:
+ (STRING MESSAGE POINT SUCCESS FORWARD OTHER-END WORD
+ INVALID-REGEXP WRAPPED BARRIER WITHIN-BRACKETS CASE-FOLD-SEARCH)")
-(defvar isearch-cmds nil) ; Stack of search status sets.
(defvar isearch-string "") ; The current search string.
(defvar isearch-message "") ; text-char-description version of isearch-string
(defvar isearch-adjusted nil)
(defvar isearch-slow-terminal-mode nil)
-;;; If t, using a small window.
+;; If t, using a small window.
(defvar isearch-small-window nil)
(defvar isearch-opoint 0)
-;;; The window configuration active at the beginning of the search.
+;; The window configuration active at the beginning of the search.
(defvar isearch-window-configuration nil)
;; Flag to indicate a yank occurred, so don't move the cursor.
(defvar isearch-yank-flag nil)
-;;; A function to be called after each input character is processed.
-;;; (It is not called after characters that exit the search.)
-;;; It is only set from an optional argument to `isearch-mode'.
+;; A function to be called after each input character is processed.
+;; (It is not called after characters that exit the search.)
+;; It is only set from an optional argument to `isearch-mode'.
(defvar isearch-op-fun nil)
-;;; Is isearch-mode in a recursive edit for modal searching.
+;; Is isearch-mode in a recursive edit for modal searching.
(defvar isearch-recursive-edit nil)
-;;; Should isearch be terminated after doing one search?
+;; Should isearch be terminated after doing one search?
(defvar isearch-nonincremental nil)
;; New value of isearch-forward after isearch-edit-string.
(define-key global-map "\C-r" 'isearch-backward)
(define-key esc-map "\C-r" 'isearch-backward-regexp)
-;;; Entry points to isearch-mode.
+;; Entry points to isearch-mode.
(defun isearch-forward (&optional regexp-p no-recursive-edit)
"\
With a prefix argument, do an incremental regular expression search instead.
\\<isearch-mode-map>
As you type characters, they add to the search string and are found.
-The following non-printing keys are bound in `isearch-mode-map'.
+The following non-printing keys are bound in `isearch-mode-map'.
Type \\[isearch-delete-char] to cancel characters from end of search string.
Type \\[isearch-exit] to exit, leaving point at location found.
Type \\[isearch-complete] to complete the search string using the search ring.
If an input method is turned on in the current buffer, that input
-method is also active while you are typing a characters to search. To
+method is also active while you are typing characters to search. To
toggle the input method, type \\[isearch-toggle-input-method]. It
also toggles the input method in the current buffer.
\\[isearch-toggle-specified-input-method], and specify an input method
you want to use.
-The above keys, bound in `isearch-mode-map', are often controlled by
+The above keys, bound in `isearch-mode-map', are often controlled by
options; do M-x apropos on search-.* to find them.
Other control and meta characters terminate the search
and are then executed normally (depending on `search-exit-option').
;;(defvar isearch-commands '(isearch-forward isearch-backward
;; isearch-forward-regexp isearch-backward-regexp)
;; "List of commands for which isearch-mode does not recursive-edit.")
-
+
(defun isearch-mode (forward &optional regexp op-fun recursive-edit word-p)
"Start isearch minor mode. Called by `isearch-forward', etc.
;; Maybe make minibuffer frame visible and/or raise it.
(let ((frame (window-frame (minibuffer-window))))
- (if (not (memq (frame-live-p frame) '(nil t)))
- (progn
- (make-frame-visible frame)
- (if minibuffer-auto-raise
- (raise-frame frame)))))
+ (unless (memq (frame-live-p frame) '(nil t))
+ (unless (frame-visible-p frame)
+ (make-frame-visible frame))
+ (if minibuffer-auto-raise
+ (raise-frame frame))))
(setq isearch-mode " Isearch") ;; forward? regexp?
(force-mode-line-update)
(add-hook 'mouse-leave-buffer-hook 'isearch-done)
(add-hook 'kbd-macro-termination-hook 'isearch-done)
- ;; isearch-mode can be made modal (in the sense of not returning to
- ;; the calling function until searching is completed) by entering
+ ;; isearch-mode can be made modal (in the sense of not returning to
+ ;; the calling function until searching is completed) by entering
;; a recursive-edit and exiting it when done isearching.
(if recursive-edit
(let ((isearch-recursive-edit t))
;; Some high level utilities. Others below.
(defun isearch-update ()
- ;; Called after each command to update the display.
+ ;; Called after each command to update the display.
(if (and (null unread-command-events)
(null executing-kbd-macro))
(progn
(if (not (input-pending-p))
(isearch-message))
(if (and isearch-slow-terminal-mode
- (not (or isearch-small-window
+ (not (or isearch-small-window
(pos-visible-in-window-p))))
(let ((found-point (point)))
(setq isearch-small-window t)
(defun isearch-update-ring (string &optional regexp)
"Add STRING to the beginning of the search ring.
REGEXP says which ring to use."
- (if regexp
+ (if regexp
(if (or (null regexp-search-ring)
(not (string= string (car regexp-search-ring))))
(progn
- (setq regexp-search-ring
- (cons string regexp-search-ring))
+ (push string regexp-search-ring)
(if (> (length regexp-search-ring) regexp-search-ring-max)
(setcdr (nthcdr (1- search-ring-max) regexp-search-ring)
nil))))
(if (or (null search-ring)
(not (string= string (car search-ring))))
(progn
- (setq search-ring (cons string search-ring))
+ (push string search-ring)
(if (> (length search-ring) search-ring-max)
(setcdr (nthcdr (1- search-ring-max) search-ring) nil))))))
-;;; Switching buffers should first terminate isearch-mode.
-;;; ;; For Emacs 19, the frame switch event is handled.
-;;; (defun isearch-switch-frame-handler ()
-;;; (interactive) ;; Is this necessary?
-;;; ;; First terminate isearch-mode.
-;;; (isearch-done)
-;;; (isearch-clean-overlays)
-;;; (handle-switch-frame (car (cdr last-command-char))))
+;; Switching buffers should first terminate isearch-mode.
+;; ;; For Emacs 19, the frame switch event is handled.
+;; (defun isearch-switch-frame-handler ()
+;; (interactive) ;; Is this necessary?
+;; ;; First terminate isearch-mode.
+;; (isearch-done)
+;; (isearch-clean-overlays)
+;; (handle-switch-frame (car (cdr last-command-char))))
\f
;; Commands active while inside of the isearch minor mode.
search and `search-nonincremental-instead' is non-nil, do a
nonincremental search instead via `isearch-edit-string'."
(interactive)
- (if (and search-nonincremental-instead
+ (if (and search-nonincremental-instead
(= 0 (length isearch-string)))
(let ((isearch-nonincremental t))
(isearch-edit-string)))
)
;; Actually terminate isearching until editing is done.
- ;; This is so that the user can do anything without failure,
+ ;; This is so that the user can do anything without failure,
;; like switch buffers and start another isearch, and return.
(condition-case err
(isearch-done t t)
(isearch-message) ;; for read-char
(unwind-protect
- (let* (;; Why does following read-char echo?
+ (let* (;; Why does following read-char echo?
;;(echo-keystrokes 0) ;; not needed with above message
(e (let ((cursor-in-echo-area t))
(read-event)))
(mapconcat 'isearch-text-char-description
isearch-new-string "")))
;; Always resume isearching by restarting it.
- (isearch-mode isearch-forward
- isearch-regexp
- isearch-op-fun
+ (isearch-mode isearch-forward
+ isearch-regexp
+ isearch-op-fun
nil
isearch-word)
;; Reinvoke the pending search.
(isearch-search)
(isearch-update)
- (if isearch-nonincremental
+ (if isearch-nonincremental
(progn
;; (sit-for 1) ;; needed if isearch-done does: (message "")
(isearch-done))))
(or (if isearch-regexp
(car regexp-search-ring)
(car search-ring))
- "")
+ (error "No previous search string"))
isearch-message
(mapconcat 'isearch-text-char-description
isearch-string "")
(isearch-yank-string (x-get-selection)))
-(defun isearch-mouse-2 (click arg)
+(defun isearch-mouse-2 (click)
"Handle mouse-2 in Isearch mode.
For a click in the echo area, invoke `isearch-yank-x-selection'.
Otherwise invoke whatever mouse-2 is bound to outside of Isearch."
- (interactive "e\nP")
+ (interactive "e")
(let* ((w (posn-window (event-start click)))
(overriding-terminal-local-map nil)
(key (vector (event-basic-type click)))
- (binding (key-binding key)))
+ ;; FIXME: `key-binding' should accept an event as argument
+ ;; and do all the overlay/text-properties lookup etc...
+ (binding (with-current-buffer
+ (if (window-live-p w) (window-buffer w) (current-buffer))
+ (key-binding key))))
(if (and (window-minibuffer-p w)
(not (minibuffer-window-active-p w))) ; in echo area
(isearch-yank-x-selection)
- (when binding
- ;; Kluge to allow passing ARG to functions that support it,
- ;; like mouse-yank-at-click.
- (if (equal (cadr (interactive-form binding)) "e\nP")
- (funcall binding click arg)
- (funcall binding click))))))
+ (when (functionp binding)
+ (call-interactively binding)))))
(defun isearch-yank-internal (jumpform)
"Pull next character or word from buffer into search string."
(interactive)
(isearch-yank-internal
- (lambda ()
+ (lambda ()
(if (or (= (char-syntax (or (char-after) 0)) ?w)
(= (char-syntax (or (char-after (1+ (point))) 0)) ?w))
(forward-word 1)
(defun isearch-yank-line ()
"Pull rest of line from buffer into search string."
(interactive)
- (isearch-yank-internal (lambda () (line-end-position))))
+ (isearch-yank-internal 'line-end-position))
(defun isearch-search-and-update ()
;; Do the search and update the display.
- (if (and (not isearch-success)
- ;; unsuccessful regexp search may become
- ;; successful by addition of characters which
- ;; make isearch-string valid
- (not isearch-regexp))
- nil
+ (when (or isearch-success
+ ;; unsuccessful regexp search may become
+ ;; successful by addition of characters which
+ ;; make isearch-string valid
+ isearch-regexp
+ ;; If the string was found but was completely invisible,
+ ;; it might now be partly visible, so try again.
+ (prog1 isearch-hidden (setq isearch-hidden nil)))
;; In reverse search, adding stuff at
;; the end may cause zero or many more chars to be
;; matched, in the string following point.
(regexp-quote isearch-string))))
(error nil))
(or isearch-yank-flag
- (<= (match-end 0)
+ (<= (match-end 0)
(min isearch-opoint isearch-barrier))))
(progn
- (setq isearch-success t
+ (setq isearch-success t
isearch-invalid-regexp nil
isearch-within-brackets nil
isearch-other-end (match-end 0))
;; Not regexp, not reverse, or no match at point.
(if (and isearch-other-end (not isearch-adjusted))
(goto-char (if isearch-forward isearch-other-end
- (min isearch-opoint
- isearch-barrier
+ (min isearch-opoint
+ isearch-barrier
(1+ isearch-other-end)))))
(isearch-search)
))
(defun isearch-*-char ()
"Handle * and ? specially in regexps."
(interactive)
- (if isearch-regexp
+ (if isearch-regexp
(let ((idx (length isearch-string)))
(while (and (> idx 0)
(eq (aref isearch-string (1- idx)) ?\\))
(max cs isearch-barrier)
(min cs isearch-barrier)))))))
(isearch-process-search-char last-command-char))
-
+
(defun isearch-|-char ()
"If in regexp search, jump to the barrier."
(when (and (> (length key) 1)
(symbolp (aref key 0))
(listp (aref key 1))
- (not (numberp (posn-point
+ (not (numberp (posn-point
(event-start (aref key 1))))))
(pop unread-command-events)
(setq main-event (car unread-command-events)))
;; obviously wrong for the case that a down-mouse event
;; on another window invokes this function. The event
;; will contain the window clicked on and that window's
- ;; buffer is certainaly not always in Isearch mode.
+ ;; buffer is certainly not always in Isearch mode.
;;
;; Leave the code in, but check for current buffer not
;; being in Isearch mode for now, until someone tells
"Match all whitespace chars, if in regexp mode.
If you want to search for just a space, type \\<isearch-mode-map>\\[isearch-quote-char] SPC."
(interactive)
- (if isearch-regexp
+ (if isearch-regexp
(if (and search-whitespace-regexp (not isearch-within-brackets)
(not isearch-invalid-regexp))
(isearch-process-search-string search-whitespace-regexp " ")
(defun isearch-process-search-char (char)
;; Append the char to the search string, update the message and re-search.
- (isearch-process-search-string
- (char-to-string char)
+ (isearch-process-search-string
+ (char-to-string char)
(if (>= char ?\200)
(char-to-string char)
(isearch-text-char-description char))))
;; Helper for isearch-complete and isearch-complete-edit
;; Return t if completion OK, nil if no completion exists.
(let* ((ring (if isearch-regexp regexp-search-ring search-ring))
- (alist (mapcar (function (lambda (string) (list string))) ring))
(completion-ignore-case case-fold-search)
- (completion (try-completion isearch-string alist)))
+ (completion (try-completion isearch-string ring)))
(cond
((eq completion t)
;; isearch-string stays the same
(progn
(if completion-auto-help
(with-output-to-temp-buffer "*Isearch completions*"
- (display-completion-list
- (all-completions isearch-string alist))))
+ (display-completion-list
+ (all-completions isearch-string ring))))
t)
(and completion
(setq isearch-string completion))))
If there is no completion possible, say so and continue searching."
(interactive)
(if (isearch-complete1)
- (isearch-edit-string)
+ (progn (setq isearch-message
+ (mapconcat 'isearch-text-char-description
+ isearch-string ""))
+ (isearch-edit-string))
;; else
(sit-for 1)
(isearch-update)))
(defun isearch-complete-edit ()
"Same as `isearch-complete' except in the minibuffer."
(interactive)
- (setq isearch-string (buffer-string))
+ (setq isearch-string (field-string))
(if (isearch-complete1)
(progn
(delete-field)
(isearch-top-state))
(defun isearch-push-state ()
- (setq isearch-cmds
+ (setq isearch-cmds
(cons (list isearch-string isearch-message (point)
- isearch-success isearch-forward isearch-other-end
+ isearch-success isearch-forward isearch-other-end
isearch-word
isearch-invalid-regexp isearch-wrapped isearch-barrier
isearch-within-brackets isearch-case-fold-search)
(concat " [" current-input-method-title "]: ")
": ")
)))
- (concat (upcase (substring m 0 1)) (substring m 1))))
-
+ (propertize (concat (upcase (substring m 0 1)) (substring m 1))
+ 'face 'minibuffer-prompt)))
(defun isearch-message-suffix (&optional c-q-hack ellipsis)
(concat (if c-q-hack "^Q" "")
"")))
\f
-;;; Searching
+;; Searching
+
+(defvar isearch-search-fun-function nil "Override `isearch-function-fun'.")
+
+(defun isearch-search-fun ()
+ "Return the function to use for the search.
+Can be changed via `isearch-search-fun-function' for special needs."
+ (if isearch-search-fun-function
+ (funcall isearch-search-fun-function)
+ (cond
+ (isearch-word
+ (if isearch-forward 'word-search-forward 'word-search-backward))
+ (isearch-regexp
+ (if isearch-forward 're-search-forward 're-search-backward))
+ (t
+ (if isearch-forward 'search-forward 'search-backward)))))
(defun isearch-search ()
;; Do the search with the current search string.
(while retry
(setq isearch-success
(funcall
- (cond (isearch-word
- (if isearch-forward
- 'word-search-forward 'word-search-backward))
- (isearch-regexp
- (if isearch-forward
- 're-search-forward 're-search-backward))
- (t
- (if isearch-forward 'search-forward 'search-backward)))
+ (isearch-search-fun)
isearch-string nil t))
;; Clear RETRY unless we matched some invisible text
;; and we aren't supposed to do that.
(quit (isearch-unread ?\C-g)
(setq isearch-success nil))
- (invalid-regexp
+ (invalid-regexp
(setq isearch-invalid-regexp (car (cdr lossage)))
(setq isearch-within-brackets (string-match "\\`Unmatched \\["
isearch-invalid-regexp))
(goto-char (nth 2 (car isearch-cmds)))))
-;;; Called when opening an overlay, and we are still in isearch.
+;; Called when opening an overlay, and we are still in isearch.
(defun isearch-open-overlay-temporary (ov)
- (if (not (null (overlay-get ov 'isearch-open-invisible-temporary)))
+ (if (not (null (overlay-get ov 'isearch-open-invisible-temporary)))
;; Some modes would want to open the overlays temporary during
;; isearch in their own way, they should set the
;; `isearch-open-invisible-temporary' to a function doing this.
(overlay-put ov 'intangible nil)))
-;;; This is called at the end of isearch. It will open the overlays
-;;; that contain the latest match. Obviously in case of a C-g the
-;;; point returns to the original location which surely is not contain
-;;; in any of these overlays, se we are safe in this case too.
+;; This is called at the end of isearch. It will open the overlays
+;; that contain the latest match. Obviously in case of a C-g the
+;; point returns to the original location which surely is not contain
+;; in any of these overlays, se we are safe in this case too.
(defun isearch-open-necessary-overlays (ov)
- (let ((inside-overlay (and (> (point) (overlay-start ov))
+ (let ((inside-overlay (and (> (point) (overlay-start ov))
(< (point) (overlay-end ov))))
;; If this exists it means that the overlay was opened using
;; this function, not by us tweaking the overlay properties.
(if fct-temp
(funcall fct-temp ov t)))))
-;;; This is called when exiting isearch. It closes the temporary
-;;; opened overlays, except the ones that contain the latest match.
+;; This is called when exiting isearch. It closes the temporary
+;; opened overlays, except the ones that contain the latest match.
(defun isearch-clean-overlays ()
(when isearch-opened-overlays
(mapc 'isearch-open-necessary-overlays isearch-opened-overlays)
(and (> end1 start0) (<= end1 end0))))
-;;; Verify if the current match is outside of each element of
-;;; `isearch-opened-overlays', if so close that overlay.
+;; Verify if the current match is outside of each element of
+;; `isearch-opened-overlays', if so close that overlay.
(defun isearch-close-unnecessary-overlays (begin end)
(let ((overlays isearch-opened-overlays))
(defun isearch-range-invisible (beg end)
"Return t if all the text from BEG to END is invisible."
- (and (/= beg end)
- ;; Check that invisibility runs up to END.
- (save-excursion
- (goto-char beg)
- (let (
- ;; can-be-opened keeps track if we can open some overlays.
- (can-be-opened (eq search-invisible 'open))
- ;; the list of overlays that could be opened
- (crt-overlays nil))
- (when (and can-be-opened isearch-hide-immediately)
- (isearch-close-unnecessary-overlays beg end))
- ;; If the following character is currently invisible,
- ;; skip all characters with that same `invisible' property value.
- ;; Do that over and over.
- (while (and (< (point) end)
- (let ((prop
- (get-char-property (point) 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec)))))
- (if (get-text-property (point) 'invisible)
- (progn
- (goto-char (next-single-property-change (point) 'invisible
- nil end))
- ;; if text is hidden by an `invisible' text property
- ;; we cannot open it at all.
- (setq can-be-opened nil))
- (unless (null can-be-opened)
- (let ((overlays (overlays-at (point)))
- ov-list
- o
- invis-prop)
- (while overlays
- (setq o (car overlays)
- invis-prop (overlay-get o 'invisible))
- (if (if (eq buffer-invisibility-spec t)
- invis-prop
- (or (memq invis-prop buffer-invisibility-spec)
- (assq invis-prop buffer-invisibility-spec)))
- (if (overlay-get o 'isearch-open-invisible)
- (setq ov-list (cons o ov-list))
- ;; We found one overlay that cannot be
- ;; opened, that means the whole chunk
- ;; cannot be opened.
- (setq can-be-opened nil)))
- (setq overlays (cdr overlays)))
- (if can-be-opened
- ;; It makes sense to append to the open
- ;; overlays list only if we know that this is
- ;; t.
- (setq crt-overlays (append ov-list crt-overlays)))))
- (goto-char (next-overlay-change (point)))))
- ;; See if invisibility reaches up thru END.
- (if (>= (point) end)
- (if (and (not (null can-be-opened)) (consp crt-overlays))
- (progn
- (setq isearch-opened-overlays
- (append isearch-opened-overlays crt-overlays))
- (mapc 'isearch-open-overlay-temporary crt-overlays)
- nil)
- t))))))
+ (when (/= beg end)
+ ;; Check that invisibility runs up to END.
+ (save-excursion
+ (goto-char beg)
+ (let (;; can-be-opened keeps track if we can open some overlays.
+ (can-be-opened (eq search-invisible 'open))
+ ;; the list of overlays that could be opened
+ (crt-overlays nil))
+ (when (and can-be-opened isearch-hide-immediately)
+ (isearch-close-unnecessary-overlays beg end))
+ ;; If the following character is currently invisible,
+ ;; skip all characters with that same `invisible' property value.
+ ;; Do that over and over.
+ (while (and (< (point) end)
+ (let ((prop
+ (get-char-property (point) 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))))
+ (if (get-text-property (point) 'invisible)
+ (progn
+ (goto-char (next-single-property-change (point) 'invisible
+ nil end))
+ ;; if text is hidden by an `invisible' text property
+ ;; we cannot open it at all.
+ (setq can-be-opened nil))
+ (when can-be-opened
+ (let ((overlays (overlays-at (point)))
+ ov-list
+ o
+ invis-prop)
+ (while overlays
+ (setq o (car overlays)
+ invis-prop (overlay-get o 'invisible))
+ (if (if (eq buffer-invisibility-spec t)
+ invis-prop
+ (or (memq invis-prop buffer-invisibility-spec)
+ (assq invis-prop buffer-invisibility-spec)))
+ (if (overlay-get o 'isearch-open-invisible)
+ (setq ov-list (cons o ov-list))
+ ;; We found one overlay that cannot be
+ ;; opened, that means the whole chunk
+ ;; cannot be opened.
+ (setq can-be-opened nil)))
+ (setq overlays (cdr overlays)))
+ (if can-be-opened
+ ;; It makes sense to append to the open
+ ;; overlays list only if we know that this is
+ ;; t.
+ (setq crt-overlays (append ov-list crt-overlays)))))
+ (goto-char (next-overlay-change (point)))))
+ ;; See if invisibility reaches up thru END.
+ (if (>= (point) end)
+ (if (and can-be-opened (consp crt-overlays))
+ (progn
+ (setq isearch-opened-overlays
+ (append isearch-opened-overlays crt-overlays))
+ (mapc 'isearch-open-overlay-temporary crt-overlays)
+ nil)
+ (setq isearch-hidden t)))))))
\f
-;;; Highlighting
+;; Highlighting
(defvar isearch-overlay nil)
(delete-overlay isearch-overlay)))
-;;; General utilities
+;; General utilities
(defun isearch-no-upper-case-p (string regexp-flag)
"Return t if there are no upper case chars in STRING.
If REGEXP-FLAG is non-nil, disregard letters preceded by `\\' (but not `\\\\')
since they have special meaning in a regexp."
- (let (quote-flag (i 0) (len (length string)) found)
+ (let (quote-flag (i 0) (len (length string)) found)
(while (and (not found) (< i len))
(let ((char (aref string i)))
(if (and regexp-flag (eq char ?\\))
(setq quote-flag (not quote-flag))
(if (and (not quote-flag) (not (eq char (downcase char))))
- (setq found t))))
+ (setq found t))
+ (setq quote-flag nil)))
(setq i (1+ i)))
(not found)))
(append char-or-events unread-command-events)))
\f
-;;; isearch-lazy-highlight feature
-;;; by Bob Glickstein <http://www.zanshin.com/~bobg/>
-
-;;; When active, *every* match for the current search string is
-;;; highlighted: the current one using the normal isearch match color
-;;; and all the others using `isearch-lazy-highlight-face'. The extra
-;;; highlighting makes it easier to anticipate where the cursor will
-;;; land each time you press C-s or C-r to repeat a pending search.
-;;; Highlighting of these additional matches happens in a deferred
-;;; fashion using "idle timers," so the cycles needed do not rob
-;;; isearch of its usual snappy response.
-
-;;; IMPLEMENTATION NOTE: This depends on some isearch internals.
-;;; Specifically:
-;;; - `isearch-update' is expected to be called (at least) every time
-;;; the search string or window-start changes;
-;;; - `isearch-string' is expected to contain the current search
-;;; string as entered by the user;
-;;; - the type of the current search is expected to be given by
-;;; `isearch-word' and `isearch-regexp';
-;;; - the direction of the current search is expected to be given by
-;;; `isearch-forward';
-;;; - the variable `isearch-invalid-regexp' is expected to be true
-;;; iff `isearch-string' is an invalid regexp.
-
-(require 'timer)
+;; isearch-lazy-highlight feature
+;; by Bob Glickstein <http://www.zanshin.com/~bobg/>
+
+;; When active, *every* match for the current search string is
+;; highlighted: the current one using the normal isearch match color
+;; and all the others using `isearch-lazy-highlight-face'. The extra
+;; highlighting makes it easier to anticipate where the cursor will
+;; land each time you press C-s or C-r to repeat a pending search.
+;; Highlighting of these additional matches happens in a deferred
+;; fashion using "idle timers," so the cycles needed do not rob
+;; isearch of its usual snappy response.
+
+;; IMPLEMENTATION NOTE: This depends on some isearch internals.
+;; Specifically:
+;; - `isearch-update' is expected to be called (at least) every time
+;; the search string or window-start changes;
+;; - `isearch-string' is expected to contain the current search
+;; string as entered by the user;
+;; - the type of the current search is expected to be given by
+;; `isearch-word' and `isearch-regexp';
+;; - the direction of the current search is expected to be given by
+;; `isearch-forward';
+;; - the variable `isearch-invalid-regexp' is expected to be true
+;; iff `isearch-string' is an invalid regexp.
(defgroup isearch-lazy-highlight nil
"Lazy highlighting feature for incremental search."
(defun isearch-lazy-highlight-search ()
"Search ahead for the next or previous match, for lazy highlighting.
Attempt to do the search exactly the way the pending isearch would."
- (let ((case-fold-search isearch-case-fold-search)
- (choices (cond (isearch-word
- '(word-search-forward . word-search-backward))
- (isearch-regexp
- '(re-search-forward . re-search-backward))
- (t
- '(search-forward . search-backward)))))
- (funcall (if isearch-forward
- (car choices)
- (cdr choices))
+ (let ((case-fold-search isearch-case-fold-search))
+ (funcall (isearch-search-fun)
isearch-string
(if isearch-forward
(if isearch-lazy-highlight-wrapped
isearch-message message
isearch-case-fold-search case-fold)
(isearch-search))
-
+
;;; isearch.el ends here
;;; china-util.el --- utilities for Chinese -*- coding: iso-2022-7bit -*-
-;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN.
- ;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
;; Copyright (C) 1995, 2001 Free Software Foundation, Inc.
++;; Copyright (C) 2003
++;; National Institute of Advanced Industrial Science and Technology (AIST)
++;; Registration Number H13PRO009
;; Keywords: mule, multilingual, Chinese
"Flag to tell if we should care line continuation convention of Hz.")
(defconst hz-set-msb-table
- (let ((str (make-string 127 0))
- (i 0))
- (while (< i 33)
- (aset str i i)
- (setq i (1+ i)))
- (while (< i 127)
- (aset str i (+ i 128))
- (setq i (1+ i)))
- str))
+ (eval-when-compile
+ (let ((chars nil)
+ (i 0))
+ (while (< i 33)
+ (push i chars)
+ (setq i (1+ i)))
+ (while (< i 127)
+ (push (+ i 128) chars)
+ (setq i (1+ i)))
+ (apply 'string (nreverse chars)))))
;;;###autoload
(defun decode-hz-region (beg end)
(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) 1995 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
++;; 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)
++ "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)
(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)
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Chinese GB2312 (simplified)
+;;; 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:CN-GB)."
+ :coding-type 'iso-2022
+ :mnemonic ?c
+ :charset-list '(ascii chinese-gb2312)
+ :designation [ascii chinese-gb2312 nil nil]
+ :mime-charset 'cn-gb)
(define-coding-system-alias 'cn-gb-2312 'chinese-iso-8bit)
(define-coding-system-alias 'euc-china 'chinese-iso-8bit)
(define-coding-system-alias 'cn-gb 'chinese-iso-8bit)
(define-coding-system-alias 'gb2312 '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)
++ "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)
- ;; 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")
(features china-util)
- (sample-text . "Cantonese (\e$(Gemk#\e(B,\e$(Gl]N)fc\e(B) \e$ATg3?\e(B, \e$ADc:C\e(B")
+ (sample-text . "Cantonese (\e$(0GnM$\e(B,\e$(0N]0*Hd\e(B) \e$(0*/=(\e(B, \e$(0+$)p\e(B")
(documentation . "Support for Chinese Big5 character set."))
'("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 EUC-TW coding system
+Support for Chinese CNS character sets. Note that the EUC-TW coding system
accepts Big5 for input also (which is then converted to CNS)."))
'("Chinese"))
- :mime-charset 'gb18030
- )
+(set-language-info-alist
+ "Chinese-EUC-TW" '((charset chinese-cns11643-1 chinese-cns11643-2
+ chinese-cns11643-3 chinese-cns11643-4
+ chinese-cns11643-5 chinese-cns11643-6
+ chinese-cns11643-7 chinese-big5-1 chinese-big5-2)
+ (coding-system euc-tw iso-2022-cn)
+ (coding-priority euc-tw chinese-big5 iso-2022-cn
+ chinese-iso-8bit)
+ (features china-util)
+ (input-method . "chinese-cns-quick")
+ (documentation . "\
+Support for Chinese, prefering the EUC-TW character set. Note that
+the EUC-TW coding system accepts Big5 for input also (which is then
+converted to CNS)."))
+ '("Chinese"))
+
++
+ ;;; Chinese GBK
+
+ (define-coding-system 'chinese-gbk
+ "GBK encoding for Chinese (MIME:GBK)."
+ :coding-type 'charset
+ :mnemonic ?c
+ :charset-list '(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?
+ (input-method . "chinese-py-punct") ; fixme?
+ (features china-util)
+ (documentation . "Support for Chinese GBK character set."))
+ '("Chinese"))
+
+ ;;; Chinese GB18030
+
+ (define-coding-system 'chinese-gb18030
+ "GB18030 encoding for Chinese (MIME:GB18030)."
+ :coding-type 'charset
+ :mnemonic ?c
+ :charset-list '(gb18030)
++ :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?
+ (features china-util)
+ (documentation
+ . "Support for Chinese GB18030 character set."))
+ '("Chinese"))
+
+ ;; Fixme: add HKSCS
+
(provide 'chinese)
;;; chinese.el ends here
;;;###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,LS\e(B [?g])
(aset standard-display-table ?\e,LT\e(B [?d])
(aset standard-display-table ?\e,LU\e(B [?e])
- (aset standard-display-table ?\e,Lq\e(B [?y?o])
- (aset standard-display-table ?\e,LV\e(B [?z?h])
+ (aset standard-display-table ?\e,Lq\e(B [?y ?o])
+ (aset standard-display-table ?\e,LV\e(B [?z ?h])
(aset standard-display-table ?\e,LW\e(B [?z])
(aset standard-display-table ?\e,LX\e(B [?i])
(aset standard-display-table ?\e,LY\e(B [?j])
(aset standard-display-table ?\e,Lb\e(B [?t])
(aset standard-display-table ?\e,Lc\e(B [?u])
(aset standard-display-table ?\e,Ld\e(B [?f])
- (aset standard-display-table ?\e,Le\e(B [?k?h])
- (aset standard-display-table ?\e,Lf\e(B [?t?s])
- (aset standard-display-table ?\e,Lg\e(B [?c?h])
- (aset standard-display-table ?\e,Lh\e(B [?s?h])
- (aset standard-display-table ?\e,Li\e(B [?s?c?h])
+ (aset standard-display-table ?\e,Le\e(B [?k ?h])
+ (aset standard-display-table ?\e,Lf\e(B [?t ?s])
+ (aset standard-display-table ?\e,Lg\e(B [?c ?h])
+ (aset standard-display-table ?\e,Lh\e(B [?s ?h])
+ (aset standard-display-table ?\e,Li\e(B [?s ?c ?h])
(aset standard-display-table ?\e,Lj\e(B [?~])
(aset standard-display-table ?\e,Lk\e(B [?y])
(aset standard-display-table ?\e,Ll\e(B [?'])
- (aset standard-display-table ?\e,Lm\e(B [?e?'])
- (aset standard-display-table ?\e,Ln\e(B [?y?u])
- (aset standard-display-table ?\e,Lo\e(B [?y?a])
-
+ (aset standard-display-table ?\e,Lm\e(B [?e ?'])
+ (aset standard-display-table ?\e,Ln\e(B [?y ?u])
+ (aset standard-display-table ?\e,Lo\e(B [?y ?a])
+
(aset standard-display-table ?\e,L0\e(B [?A])
(aset standard-display-table ?\e,L1\e(B [?B])
(aset standard-display-table ?\e,L2\e(B [?V])
(aset standard-display-table ?\e,L3\e(B [?G])
(aset standard-display-table ?\e,L4\e(B [?D])
(aset standard-display-table ?\e,L5\e(B [?E])
- (aset standard-display-table ?\e,L!\e(B [?Y?o])
- (aset standard-display-table ?\e,L6\e(B [?Z?h])
+ (aset standard-display-table ?\e,L!\e(B [?Y ?o])
+ (aset standard-display-table ?\e,L6\e(B [?Z ?h])
(aset standard-display-table ?\e,L7\e(B [?Z])
(aset standard-display-table ?\e,L8\e(B [?I])
(aset standard-display-table ?\e,L9\e(B [?J])
(aset standard-display-table ?\e,LB\e(B [?T])
(aset standard-display-table ?\e,LC\e(B [?U])
(aset standard-display-table ?\e,LD\e(B [?F])
- (aset standard-display-table ?\e,LE\e(B [?K?h])
- (aset standard-display-table ?\e,LF\e(B [?T?s])
- (aset standard-display-table ?\e,LG\e(B [?C?h])
- (aset standard-display-table ?\e,LH\e(B [?S?h])
- (aset standard-display-table ?\e,LI\e(B [?S?c?h])
+ (aset standard-display-table ?\e,LE\e(B [?K ?h])
+ (aset standard-display-table ?\e,LF\e(B [?T ?s])
+ (aset standard-display-table ?\e,LG\e(B [?C ?h])
+ (aset standard-display-table ?\e,LH\e(B [?S ?h])
+ (aset standard-display-table ?\e,LI\e(B [?S ?c ?h])
(aset standard-display-table ?\e,LJ\e(B [?~])
(aset standard-display-table ?\e,LK\e(B [?Y])
(aset standard-display-table ?\e,LL\e(B [?'])
- (aset standard-display-table ?\e,LM\e(B [?E?'])
- (aset standard-display-table ?\e,LN\e(B [?Y?u])
- (aset standard-display-table ?\e,LO\e(B [?Y?a])
+ (aset standard-display-table ?\e,LM\e(B [?E ?'])
+ (aset standard-display-table ?\e,LN\e(B [?Y ?u])
+ (aset standard-display-table ?\e,LO\e(B [?Y ?a])
- (aset standard-display-table ?\e,Lt\e(B [?i?e])
+ (aset standard-display-table ?\e,Lt\e(B [?i ?e])
(aset standard-display-table ?\e,Lw\e(B [?i])
(aset standard-display-table ?\e,L~\e(B [?u])
- (aset standard-display-table ?\e,Lr\e(B [?d?j])
- (aset standard-display-table ?\e,L{\e(B [?c?h?j])
- (aset standard-display-table ?\e,Ls\e(B [?g?j])
+ (aset standard-display-table ?\e,Lr\e(B [?d ?j])
+ (aset standard-display-table ?\e,L{\e(B [?c ?h ?j])
+ (aset standard-display-table ?\e,Ls\e(B [?g ?j])
(aset standard-display-table ?\e,Lu\e(B [?s])
(aset standard-display-table ?\e,L|\e(B [?k])
(aset standard-display-table ?\e,Lv\e(B [?i])
(aset standard-display-table ?\e,Lx\e(B [?j])
- (aset standard-display-table ?\e,Ly\e(B [?l?j])
- (aset standard-display-table ?\e,Lz\e(B [?n?j])
- (aset standard-display-table ?\e,L\7f\e(B [?d?z])
+ (aset standard-display-table ?\e,Ly\e(B [?l ?j])
+ (aset standard-display-table ?\e,Lz\e(B [?n ?j])
+ (aset standard-display-table ?\e,L\7f\e(B [?d ?z])
- (aset standard-display-table ?\e,L$\e(B [?Y?e])
- (aset standard-display-table ?\e,L'\e(B [?Y?i])
+ (aset standard-display-table ?\e,L$\e(B [?Y ?e])
+ (aset standard-display-table ?\e,L'\e(B [?Y ?i])
(aset standard-display-table ?\e,L.\e(B [?U])
- (aset standard-display-table ?\e,L"\e(B [?D?j])
- (aset standard-display-table ?\e,L+\e(B [?C?h?j])
- (aset standard-display-table ?\e,L#\e(B [?G?j])
+ (aset standard-display-table ?\e,L"\e(B [?D ?j])
+ (aset standard-display-table ?\e,L+\e(B [?C ?h ?j])
+ (aset standard-display-table ?\e,L#\e(B [?G ?j])
(aset standard-display-table ?\e,L%\e(B [?S])
(aset standard-display-table ?\e,L,\e(B [?K])
(aset standard-display-table ?\e,L&\e(B [?I])
(aset standard-display-table ?\e,L(\e(B [?J])
- (aset standard-display-table ?\e,L)\e(B [?L?j])
- (aset standard-display-table ?\e,L*\e(B [?N?j])
- (aset standard-display-table ?\e,L/\e(B [?D?j])
+ (aset standard-display-table ?\e,L)\e(B [?L ?j])
+ (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]))
+ (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,L8\e(B [?Y])
(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]))))
+ (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) 1995 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2002 Free Software Foundation, Inc.
++;; Licensed to the Free Software Foundation.
+;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc.
++;; Copyright (C) 2003
++;; National Institute of Advanced Industrial Science and Technology (AIST)
++;; Registration Number H13PRO009
-;; Keywords: multilingual, Cyrillic
+;; Author: Kenichi Handa <handa@etl.go.jp>
+;; Keywords: multilingual, Cyrillic, i18n
;; This file is part of GNU Emacs.
;;; Commentary:
-;; The character set ISO8859-5 is supported. See
-;; http://www.ecma.ch/ecma1/STAND/ECMA-113.HTM. KOI-8 and
-;; ALTERNATIVNYJ are converted to ISO8859-5 internally.
+;; The character set ISO8859-5 is supported. KOI-8 and ALTERNATIVNYJ
+;; are converted to Unicode internally. See
+;; <URL:http://www.ecma.ch/ecma1/STAND/ECMA-113.HTM>. For more info
+;; on Cyrillic charsets, see
+;; <URL:http://czyborra.com/charsets/cyrillic.html>. The KOI and
+;; Alternativnyj coding systems should live in code-pages.el, but
+;; they've always been preloaded and the coding system autoload
+;; mechanism didn't get accepted, so they have to stay here and
+;; duplicate code-pages stuff.
+
+;; Note that 8859-5 maps directly onto the Unicode Cyrillic block,
+;; apart from codepoints 160 (NBSP, c.f. U+0400), 173 (soft hyphen,
+;; c.f. U+04OD) and 253 (section sign, c.f U+045D). The KOI-8 and
+;; Alternativnyj coding systems encode both 8859-5 and Unicode.
+;; ucs-tables.el provides unification for cyrillic-iso-8bit.
+
+;; Customizing `utf-fragment-on-decoding' allows decoding characters
+;; from KOI and Alternativnyj into 8859-5 where that's possible.
+;; cyrillic-iso8859-5 characters take half as much space in the buffer
+;; as the mule-unicode-0100-24ff equivalents, though that's probably
+;; not normally a big deal.
;;; Code:
;; 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)
- (nonascii-translation . cyrillic-iso8859-5)
+ (input-method . "cyrillic-yawerty") ; fixme
- (input-method . "cyrillic-yawerty")
+ (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!")
(documentation . "Support for Cyrillic ISO-8859-5."))
'("Cyrillic"))
-;; KOI-8 stuff
+;; 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)
- ;; 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
- (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)
+ (coding-priority cyrillic-koi8 cyrillic-iso-8bit)
+ (nonascii-translation . koi8)
- (input-method . "cyrillic-jcuken")
+ (input-method . "russian-typewriter")
(features cyril-util)
(unibyte-display . cyrillic-koi8)
(sample-text . "Russian (\e,L@caaZXY\e(B) \e,L7T`PRabRcYbU\e(B!")
(documentation . "Support for Cyrillic KOI8-R."))
'("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))
-
- (set-language-info-alist
- "Ukrainian" `((coding-system koi8-u)
- (coding-priority koi8-u)
- (nonascii-translation
- . ,(get 'cyrillic-koi8-u-nonascii-translation-table
- 'translation-table))
- (input-method . "ukrainian-computer")
- (features code-pages)
- (documentation
- . "Support for Ukrainian with KOI8-U character set."))
- '("Cyrillic"))
-
+(set-language-info-alist
+ "Russian" `((charset cyrillic-iso8859-5)
+ (nonascii-translation
+ . ,(get 'cyrillic-koi8-r-nonascii-translation-table
+ 'translation-table))
+ (coding-system cyrillic-koi8)
+ (coding-priority cyrillic-koi8 cyrillic-iso-8bit)
+ (input-method . "russian-computer")
+ (features cyril-util)
+ (unibyte-display . cyrillic-koi8)
+ (sample-text . "Russian (\e,L@caaZXY\e(B) \e,L7T`PRabRcYbU\e(B!")
+ (documentation . "\
+Support for Russian using koi8-r and the russian-computer input method.")
+ (tutorial . "TUTORIAL.ru"))
+ '("Cyrillic"))
+
;;; 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)
- (input-method . "cyrillic-jcuken")
+ (nonascii-translation . alternativnyj)
+ (input-method . "russian-typewriter")
(features cyril-util)
(unibyte-display . cyrillic-alternativnyj)
(sample-text . "Russian (\e,L@caaZXY\e(B) \e,L7T`PRabRcYbU\e(B!")
(documentation . "Support for Cyrillic ALTERNATIVNYJ."))
'("Cyrillic"))
- (set-language-info-alist
- "Windows-1251" `((coding-system windows-1251)
- (coding-priority windows-1251)
- (nonascii-translation
- . ,(get 'decode-windows-1252 'translation-table))
- (input-method . "russian-typewriter") ; fixme?
- (features code-pages)
- (documentation . "Support for windows-1251 character set."))
- '("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."))
(set-language-info-alist
"Bulgarian" `((coding-system windows-1251)
- (coding-priority windows-1251)
- (nonascii-translation
- . ,(get 'decode-windows-1251 'translation-table))
+ (coding-priority windows-1251)
+ (nonascii-translation . windows-1251)
+ (charset windows-1251)
(input-method . "bulgarian-bds")
- (features code-pages)
+ (features code-pages)
(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
- . ,(get 'decode-windows-1251 'translation-table))
+ (nonascii-translation . windows-1251)
+ (charset windows-1251)
(input-method . "belarusian")
(features code-pages)
(documentation
\(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)
;;; cyrillic.el ends here
-;;; czech.el --- support for Czech -*- coding: iso-2022-7bit; -*-
+;;; czech.el --- support for Czech -*- coding: iso-2022-7bit; no-byte-compile: t -*-
;; Copyright (C) 1998, 2001 Free Software Foundation.
(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!")
(documentation . "\
This language environment is almost the same as Latin-2,
-but sets the default input method is set to \"czech\",
+but sets the default input method to \"czech\",
and selects the Czech tutorial."))
'("European"))
- ;;; devan-util.el --- Support for composing Devanagari characters
+ ;;; devan-util.el --- Support for composing Devanagari characters -*-coding: iso-2022-7bit;-*-
;; Copyright (C) 2001 Free Software Foundation, Inc.
-;; Maintainer: KAWABATA, Taichi <batta@beige.ocn.ne.jp>
+;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
;; Keywords: multilingual, Devanagari
;; This file is part of GNU Emacs.
;;; 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$,15C\e(B"
+ "\\([\e$,15E\e(B-\e$,15T6@6A\e(B][\e$,15A5B\e(B]?\\)\\|[\e$,15C6D\e(B]"
"\\|\\("
"\\(?:\\(?:[\e$,15U\e(B-\e$,15y68\e(B-\e$,16?\e(B]\e$,16-\e(B\\)?\\(?:[\e$,15U\e(B-\e$,15y68\e(B-\e$,16?\e(B]\e$,16-\e(B\\)?\\(?:[\e$,15U\e(B-\e$,15y68\e(B-\e$,16?\e(B]\e$,16-\e(B\\)?[\e$,15U\e(B-\e$,15y68\e(B-\e$,16?\e(B]\e$,16-\e(B\\)?"
"[\e$,15U\e(B-\e$,15y68\e(B-\e$,16?\e(B]\\(?:\e$,16-\e(B\\|[\e$,15~\e(B-\e$,16-6B6C\e(B]?[\e$,15B5A\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")
(save-excursion
(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
+ ;; Not yet implemented.
+ nil
+ (goto-char pos)
+ (if (looking-at devanagari-composable-pattern)
+ (prog1 (match-end 0)
+ (devanagari-compose-syllable-region pos (match-end 0))))))
;; Notes on conversion steps.
("\e$,16-\e(B" . "\e$,4""\e(B")
("\e$,16-5p\e(B" . "\e$,4"%\e(B") ;; following "r"
;; ("\e$,160\e(B" . "\e$,4 D\e(B")
- ;; ("\e$,16D\e(B" . "\e$,4 J\e(B")
+ ("\e$,16D\e(B" . "\e$,4 J\e(B")
;; ("\e$,16F\e(B" . "")
;; ("\e$,16G\e(B" . "")
;; ("\e$,16H\e(B" . "")
preferred rule from the sanskrit fonts." )
(defvar dev-char-glyph-hash
- (let* ((hash (makehash 'equal)))
+ (let* ((hash (make-hash-table :test 'equal)))
(mapc (function (lambda (x) (puthash (car x) (cdr x) hash)))
dev-char-glyph)
hash))
("\\e$,4"L\e(B\\e$,4"'\e(B\\e$,4"&\e(B" . "\\e$,4"O\e(B")
))
(defvar dev-glyph-glyph-hash
- (let* ((hash (makehash 'equal)))
+ (let* ((hash (make-hash-table :test 'equal)))
(mapc (function (lambda (x) (puthash (car x) (cdr x) hash)))
dev-glyph-glyph)
hash))
("\e$,4",\e(B" . "\e$,4"0\e(B")
("\e$,4"-\e(B" . "\e$,4"1\e(B")))
(defvar dev-glyph-glyph-2-hash
- (let* ((hash (makehash 'equal)))
+ (let* ((hash (make-hash-table :test 'equal)))
(mapc (function (lambda (x) (puthash (car x) (cdr x) hash)))
dev-glyph-glyph-2)
hash))
(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)))
- (devanagari-range (make-char 'devanagari-glyph from)
- (make-char 'devanagari-glyph to)))
++ (number-sequence (decode-char 'devanagari-cdac from)
++ (decode-char 'devanagari-cdac to)))
(defvar dev-glyph-cvn
(append
(,dev-glyph-left-matra . 3) ;; processed by reference point.
(,dev-glyph-top-matra . 4)
(,(dev-charseq #xc7 #xc8) . 5)
+ (,(dev-charseq #xc4) . 6)
(,(dev-charseq #xc6) . 6)
(,(dev-charseq #xc5) . 7)
(,dev-glyph-bottom-modifier . 8)))
(defun devanagari-compose-syllable-region (from to)
"Compose devanagari syllable in region FROM to TO."
(let ((glyph-str nil) (cons-num 0) glyph-str-list
- (last-halant nil) (preceding-r nil) (last-modifier nil)
- (last-char (char-before to)) match-str
- glyph-block split-pos)
+ (last-halant nil) (preceding-r nil) (last-modifier nil)
+ (last-char (char-before to)) match-str
+ glyph-block split-pos)
(save-excursion
(save-restriction
- ;;; *** char-to-glyph conversion ***
- ;; Special rule 1. -- Last halant must be preserved.
- (if (eq last-char ?\e$,16-\e(B)
- (progn
- (setq last-halant t)
- (narrow-to-region from (1- to)))
- (narrow-to-region from to)
- ;; note if the last char is modifier.
- (if (or (eq last-char ?\e$,15A\e(B) (eq last-char ?\e$,15B\e(B))
- (setq last-modifier t)))
- (goto-char (point-min))
- ;; Special rule 2. -- preceding "r halant" must be modifier.
- (when (looking-at "\e$,15p6-\e(B.")
- (setq preceding-r t)
- (goto-char (+ 2 (point))))
- ;; translate the rest characters into glyphs
- (while (re-search-forward dev-char-glyph-regexp nil t)
- (setq match-str (match-string 0))
- (setq glyph-str
- (concat glyph-str
- (gethash match-str dev-char-glyph-hash)))
- ;; count the number of consonant-glyhs.
- (if (string-match devanagari-consonant match-str)
- (setq cons-num (1+ cons-num))))
- ;; preceding-r must be attached before the anuswar if exists.
- (if preceding-r
- (if last-modifier
- (setq glyph-str (concat (substring glyph-str 0 -1)
- "\e$,4"'\e(B" (substring glyph-str -1)))
- (setq glyph-str (concat glyph-str "\e$,4"'\e(B"))))
- (if last-halant (setq glyph-str (concat glyph-str "\e$,4""\e(B")))
- ;;; *** glyph-to-glyph conversion ***
- (when (string-match dev-glyph-glyph-regexp glyph-str)
- (setq glyph-str
- (replace-match (gethash (match-string 0 glyph-str)
- dev-glyph-glyph-hash)
- nil t glyph-str))
- (if (and (> cons-num 1)
- (string-match dev-glyph-glyph-2-regexp glyph-str))
- (setq glyph-str
- (replace-match (gethash (match-string 0 glyph-str)
- dev-glyph-glyph-2-hash)
- nil t glyph-str))))
- ;;; *** glyph reordering ***
- (while (setq split-pos (string-match "\e$,4""\e(B\\|.$" glyph-str))
- (setq glyph-block (substring glyph-str 0 (1+ split-pos)))
- (setq glyph-str (substring glyph-str (1+ split-pos)))
- (setq
- glyph-block
- (if (string-match dev-glyph-right-modifier-regexp glyph-block)
- (sort (string-to-list glyph-block)
- (function (lambda (x y)
- (< (get-char-code-property x 'composition-order)
- (get-char-code-property y 'composition-order)))))
- (sort (string-to-list glyph-block)
- (function (lambda (x y)
- (let ((xo (get-char-code-property x 'composition-order))
- (yo (get-char-code-property y 'composition-order)))
- (if (= xo 2) nil (if (= yo 2) t (< xo yo)))))))))
- (setq glyph-str-list (nconc glyph-str-list glyph-block)))
- ;; concatenate and attach reference-points.
- (setq glyph-str
- (cdr
- (apply
- 'nconc
- (mapcar
- (function (lambda (x)
- (list
- (or (get-char-code-property x 'reference-point)
- '(5 . 3) ;; default reference point.
- )
- x)))
- glyph-str-list))))))
+ ;;; *** char-to-glyph conversion ***
+ ;; Special rule 1. -- Last halant must be preserved.
+ (if (eq last-char ?\e$,16-\e(B)
+ (progn
+ (setq last-halant t)
+ (narrow-to-region from (1- to)))
+ (narrow-to-region from to)
+ ;; note if the last char is modifier.
+ (if (or (eq last-char ?\e$,15A\e(B) (eq last-char ?\e$,15B\e(B))
+ (setq last-modifier t)))
+ (goto-char (point-min))
+ ;; Special rule 2. -- preceding "r halant" must be modifier.
+ (when (looking-at "\e$,15p6-\e(B.")
+ (setq preceding-r t)
+ (goto-char (+ 2 (point))))
+ ;; translate the rest characters into glyphs
- (while (re-search-forward dev-char-glyph-regexp nil t)
- (setq match-str (match-string 0))
- (setq glyph-str
- (concat glyph-str
- (gethash match-str dev-char-glyph-hash)))
- ;; count the number of consonant-glyhs.
- (if (string-match devanagari-consonant match-str)
- (setq cons-num (1+ cons-num))))
++ (while (not (eobp))
++ (if (looking-at dev-char-glyph-regexp)
++ (let ((end (match-end 0)))
++ (setq match-str (match-string 0)
++ glyph-str
++ (concat glyph-str
++ (gethash match-str dev-char-glyph-hash)))
++ ;; count the number of consonant-glyhs.
++ (if (string-match devanagari-consonant match-str)
++ (setq cons-num (1+ cons-num)))
++ (goto-char end))
++ (setq glyph-str (concat glyph-str (string (following-char))))
++ (forward-char 1)))
+ ;; preceding-r must be attached before the anuswar if exists.
+ (if preceding-r
+ (if last-modifier
+ (setq glyph-str (concat (substring glyph-str 0 -1)
+ "\e$,4"'\e(B" (substring glyph-str -1)))
+ (setq glyph-str (concat glyph-str "\e$,4"'\e(B"))))
+ (if last-halant (setq glyph-str (concat glyph-str "\e$,4""\e(B")))
+ ;;; *** glyph-to-glyph conversion ***
+ (when (string-match dev-glyph-glyph-regexp glyph-str)
+ (setq glyph-str
+ (replace-match (gethash (match-string 0 glyph-str)
+ dev-glyph-glyph-hash)
+ nil t glyph-str))
+ (if (and (> cons-num 1)
+ (string-match dev-glyph-glyph-2-regexp glyph-str))
+ (setq glyph-str
+ (replace-match (gethash (match-string 0 glyph-str)
+ dev-glyph-glyph-2-hash)
+ nil t glyph-str))))
+ ;;; *** glyph reordering ***
+ (while (setq split-pos (string-match "\e$,4""\e(B\\|.$" glyph-str))
+ (setq glyph-block (substring glyph-str 0 (1+ split-pos)))
+ (setq glyph-str (substring glyph-str (1+ split-pos)))
+ (setq
+ glyph-block
+ (if (string-match dev-glyph-right-modifier-regexp glyph-block)
+ (sort (string-to-list glyph-block)
+ (function (lambda (x y)
+ (< (get-char-code-property x 'composition-order)
+ (get-char-code-property y 'composition-order)))))
+ (sort (string-to-list glyph-block)
+ (function (lambda (x y)
+ (let ((xo (get-char-code-property x 'composition-order))
+ (yo (get-char-code-property y 'composition-order)))
+ (if (= xo 2) nil (if (= yo 2) t (< xo yo)))))))))
+ (setq glyph-str-list (nconc glyph-str-list glyph-block)))
+ ;; concatenate and attach reference-points.
+ (setq glyph-str
+ (cdr
+ (apply
+ 'nconc
+ (mapcar
+ (function (lambda (x)
+ (list
+ (or (get-char-code-property x 'reference-point)
+ '(5 . 3) ;; default reference point.
+ )
+ x)))
+ glyph-str-list))))))
(compose-region from to glyph-str)))
(provide 'devan-util)
-;;; devanagari.el --- Support for Devanagari -*- coding: iso-2022-7bit; -*-
+;;; devanagari.el --- Support for Devanagari -*- coding: iso-2022-7bit; no-byte-compile: t -*-
;; Copyright (C) 1996, 2001 Free Software Foundation, Inc.
-;; Maintainer: KAWABATA, Taichi <batta@beige.ocn.ne.jp>
+;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
;; Keywords: multilingual, Indian, Devanagari
;; This file is part of GNU Emacs.
"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
+ 'devanagari-composition-function))
+
(provide 'devanagari)
;;; devanagari.el ends here
-;;; english.el --- support for English
+;;; english.el --- support for English -*- no-byte-compile: t -*-
;; Copyright (C) 1997 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2002 Free Software Foundation, Inc.
++;; Licensed to the Free Software Foundation.
++;; 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)))
;;; european.el --- support for European languages -*- coding: iso-2022-7bit; -*-
;; Copyright (C) 1995, 1997, 2001 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
++;; Licensed to the Free Software Foundation.
+;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc.
++;; Copyright (C) 2003
++;; National Institute of Advanced Industrial Science and Technology (AIST)
++;; Registration Number H13PRO009
;; Keywords: multilingual, European
;;; Commentary:
- ;; For European scripts, character sets ISO8859-1,2,3,4,9,14,15 are
- ;; supported.
+ ;; For European scripts, character sets ISO8859-1,2,3,4,9,10,13,14,15,
+ ;; windows-1250,2,4,7, mac-roman, adobe-standard-encoding, cp850 and
+ ;; next are supported.
;;; Code:
;; Latin-1 (ISO-8859-1)
(set-language-info-alist
- "Latin-1" '((charset ascii latin-iso8859-1)
- (coding-system iso-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 . latin-iso8859-1)
- (unibyte-syntax . "latin-1")
+ (nonascii-translation . iso-8859-1)
(unibyte-display . iso-latin-1)
(input-method . "latin-1-prefix")
(sample-text
We also have specific language environments for the following languages:
For Dutch, \"Dutch\".
For German, \"German\".
- For Spanish, \"Spanish\".
For French, \"French\".
+ For Italian, \"Italian\".
+ For Slovenian, \"Slovenian\".
+ For Spanish, \"Spanish\".
Latin-1 also covers several written languages outside Europe, including
Indonesian/Malay, Tagalog (Philippines), Swahili and Afrikaans."))
\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 . "\
and Swedish.
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
\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)9.>\e,b<=\e,_/\e(B \e,b$\e(B")
+ . "AVE. \e,b&(48<=>\e(B \e,b$\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
Latin-9 is sometimes nicknamed `Latin-0'."))
'("European"))
\f
-(define-coding-system 'iso-latin-7
- "ISO 2022 based 8-bit encoding for Latin-7 (MIME:ISO-8859-13)."
- :coding-type 'charset
- ;; `0' for `Latin-0'
- :mnemonic ?*
- :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)
-\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")
+ (documentation . "\
+This language environment is almost the same as Latin-1,
+but it selects the Dutch tutorial and input method."))
+ '("European"))
+
(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)
+ (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
(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")
(documentation . "\
This language environment is almost the same as Latin-1,
-but it selects the French tutorial."))
+but it selects the French tutorial and input method."))
+ '("European"))
+
+(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!")
+ (documentation . "\
+This language environment is almost the same as Latin-1,
+but sets the default input method to \"italian-postfix\".
+Additionally, it selects the Italian tutorial."))
'("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 . "latin-2-postfix")
+ (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!")
- (documentation . t))
+ (documentation . "\
+This language environment is almost the same as Latin-2,
+but it selects the Slovenian tutorial and input method."))
'("European"))
(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)
- (nonascii-translation . iso-8859-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!")
(documentation . "\
and it selects the Spanish tutorial."))
'("European"))
-(set-language-info-alist
- "Dutch" '((tutorial . "TUTORIAL.nl")
- (charset iso-8859-1)
- (coding-system iso-latin-1 iso-latin-9)
- (coding-priority iso-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")
- (documentation . "\
-This language environment is almost the same as Latin-1,
-but it selects the Dutch tutorial and input method."))
- '("European"))
-
;; For Turkish, the character set ISO-8859-9 (Latin-5) is used. But,
;; before the introduction of ISO-8859-9 in 1988, ISO-8859-3 (Latin-3)
;; was used for Turkish. Those who use Latin-3 for Turkish should use
;; "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,A|\e(Brk\e,Ag\e(Be) Merhaba")
+ (sample-text . "Turkish (T\e,M|\e(Brk\e,Mg\e(Be) Merhaba")
- (documentation . t)))
+ (setup-function
+ . (lambda ()
+ (set-case-syntax-pair ?I ?\e,C9\e(B (standard-case-table))
+ (set-case-syntax-pair ?\e,C)\e(B ?i (standard-case-table))))
+ (exit-function
+ . (lambda ()
+ (set-case-syntax-pair ?I ?i (standard-case-table))
+ (set-case-syntax ?\e,C9\e(B "w" (standard-case-table))
+ (set-case-syntax ?\e,C)\e(B "w" (standard-case-table))))
+ (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,C9\e(B, \e,C)\e(B.")))
;; 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))
- "Polish" '((charset . (iso-8859-2))
- (coding-system . (iso-8859-2 windows-1250))
-- (coding-priority . (iso-8859-2))
- (nonascii-translation . 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,As\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,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")
(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-6" `((coding-system latin-6)
+ (coding-priority latin-6)
+ (nonascii-translation . ,(get 'decode-iso-latin-6 'translation-table))
+ (input-method . "latin-prefix")
+ (features code-pages)
+ (documentation . "Support for Latin-6."))
+ '("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)
- ;; Fixme: input-method
+ (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"))
- (charset ascii latin-iso8859-1)
+(set-language-info-alist
+ "Swedish" '((tutorial . "TUTORIAL.sv")
- (nonascii-translation . latin-iso8859-1)
- (unibyte-syntax . "latin-1")
++ (charset iso-8859-1)
+ (coding-system iso-latin-1)
+ (coding-priority iso-latin-1)
- "Croatian" '((charset . (ascii latin-iso8859-2))
- (coding-system . (iso-8859-2))
- (coding-priority . (iso-8859-2))
++ (nonascii-translation . iso-8859-1)
+ (unibyte-display . iso-latin-1)
+ (sample-text . "Goddag Hej")
+ (documentation . "Support for Swedish"))
+ '("European"))
+
+(set-language-info-alist
- (nonascii-translation . latin-iso8859-2)
- (unibyte-syntax . "latin-2")
++ "Croatian" '((charset iso-8859-2)
++ (coding-system iso-8859-2)
++ (coding-priority iso-8859-2)
+ (input-method . "croatian")
++ (nonascii-translation . iso-8859-2)
+ (unibyte-display . iso-8859-2)
+ (documentation . "Support for Croatian with Latin-2 encoding."))
+ '("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^+")
(compose-string string idx (match-end 0))
(setq idx (match-end 0))))
string)
-
+
(defun diacritic-compose-buffer ()
"Compose diacritic characters in the current buffer."
(interactive)
(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 &optional 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
+ (let ((ch (aref string pos))
+ start end components ch composition)
+ (when (and (>= pos 0)
+ ;; Previous character is latin.
+ (aref (char-category-set ch) ?l)
+ (/= ch 32))
+ (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))
+ (let ((ch (char-after pos))
+ start end components composition)
+ (when (and (>= pos (point-min))
+ (aref (char-category-set ch) ?l)
+ (/= ch 32))
+ (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
+;;; georgian.el --- language support for Georgian -*- no-byte-compile: t -*-
- ;; Copyright (C) 2001 Free Software Foundation, Inc.
+ ;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
;; This file is part of GNU Emacs.
-;; This file is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
-;; This file is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; 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
+;;; greek.el --- support for Greek -*- no-byte-compile: t -*-
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
+ ;; Copyright (C) 2002 Free Software Foundation, Inc.
++;; Copyright (C) 2003
++;; National Institute of Advanced Industrial Science and Technology (AIST)
++;; Registration Number H13PRO009
;; Keywords: multilingual, Greek
;;; 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-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; -*-
+;;; hebrew.el --- support for Hebrew -*- coding: iso-2022-7bit; no-byte-compile: t -*-
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
- ;; Copyright (C) 2001 Free Software Foundation, Inc.
++;; Licensed to the Free Software Foundation.
+ ;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
++;; Copyright (C) 2003
++;; National Institute of Advanced Industrial Science and Technology (AIST)
++;; Registration Number H13PRO009
;; Keywords: multilingual, Hebrew
;;; 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)
++ "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)
;;; hebrew.el ends here
;;; ind-util.el --- Transliteration and Misc. Tools for Indian Languages -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
-;; Maintainer: KAWABATA, Taichi <batta@beige.ocn.ne.jp>
+;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
;; Keywords: multilingual, Indian, Devanagari
;; This file is part of GNU Emacs.
(defun indian-regexp-of-hashtbl-keys (hashtbl)
"Returns the regular expression of hashtable keys."
- (let ((max-specpdl-size 1000))
- (regexp-opt
- (sort
- (let (dummy)
- (maphash (function (lambda (key val) (setq dummy (cons key dummy))))
- hashtbl)
- dummy)
- (function (lambda (x y) (> (length x) (length y))))))))
+ (let (keys)
+ (maphash (lambda (key val) (push key keys)) hashtbl)
+ (regexp-opt keys)))
(defvar indian-dev-base-table
'(
(;; VOWELS (18)
(?\e$,15E\e(B nil) (?\e$,15F\e(B ?\e$,15~\e(B) (?\e$,15G\e(B ?\e$,15\7f\e(B) (?\e$,15H\e(B ?\e$,16 \e(B) (?\e$,15I\e(B ?\e$,16!\e(B) (?\e$,15J\e(B ?\e$,16"\e(B)
- (?\e$,15K\e(B ?\e$,16#\e(B) (?\e$,15L\e(B ?\e$,16$\e(B) (?\e$,15M\e(B ?\e$,16%\e(B) (?\e$,15N\e(B ?\e$,16&\e(B) (?\e$,15O\e(B ?\e$,16'\e(B) (?\e$,15P\e(B ?\e$,16(\e(B)
- (?\e$,15Q\e(B ?\e$,16)\e(B) (?\e$,15R\e(B ?\e$,16*\e(B) (?\e$,15S\e(B ?\e$,16+\e(B) (?\e$,15T\e(B ?\e$,16,\e(B) (?\e$,16@\e(B ?\e$,16B\e(B) (?\e$,16A\e(B ?\e$,16C\e(B))
+ (?\e$,15K\e(B ?\e$,16#\e(B) (?\e$,15L\e(B ?\e$,16B\e(B) (?\e$,15M\e(B ?\e$,16%\e(B) (?\e$,15N\e(B ?\e$,16&\e(B) (?\e$,15O\e(B ?\e$,16'\e(B) (?\e$,15P\e(B ?\e$,16(\e(B)
+ (?\e$,15Q\e(B ?\e$,16)\e(B) (?\e$,15R\e(B ?\e$,16*\e(B) (?\e$,15S\e(B ?\e$,16+\e(B) (?\e$,15T\e(B ?\e$,16,\e(B) (?\e$,16@\e(B ?\e$,16$\e(B) (?\e$,16A\e(B ?\e$,16C\e(B))
(;; CONSONANTS (currently 42, including special cases)
?\e$,15U\e(B ?\e$,15V\e(B ?\e$,15W\e(B ?\e$,15X\e(B ?\e$,15Y\e(B ;; GUTTRULS
?\e$,15Z\e(B ?\e$,15[\e(B ?\e$,15\\e(B ?\e$,15]\e(B ?\e$,15^\e(B ;; PALATALS
(;; Inscript-extra (4) (#, $, ^, *, ])
"\e$,16-5p\e(B" "\e$,15p6-\e(B" "\e$,15d6-5p\e(B" "\e$,15v6-5p\e(B" "\e$,15|\e(B")))
-(defvar indian-pnj-base-table nil)
-(defvar indian-ori-base-table nil)
-(defvar indian-bng-base-table nil)
-(defvar indian-asm-base-table nil)
-(defvar indian-tlg-base-table nil)
-(defvar indian-knd-base-table nil)
-(defvar indian-mlm-base-table nil)
-(defvar indian-tml-base-table nil)
+;; Punjabi is also known as Gurmukhi.
+(defvar indian-pnj-base-table
+ '(
+ (;; VOWELS
+ (?\e$,18%\e(B nil) (?\e$,18&\e(B ?\e$,18^\e(B) (?\e$,18'\e(B ?\e$,18_\e(B) (?\e$,18(\e(B ?\e$,18`\e(B) (?\e$,18)\e(B ?\e$,18a\e(B) (?\e$,18*\e(B ?\e$,18b\e(B)
+ nil nil nil nil (?\e$,18/\e(B ?\e$,18g\e(B) (?\e$,180\e(B ?\e$,18h\e(B)
+ nil nil (?\e$,183\e(B ?\e$,18k\e(B) (?\e$,184\e(B ?\e$,18l\e(B) nil nil)
+ (;; CONSONANTS
+ ?\e$,185\e(B ?\e$,186\e(B ?\e$,187\e(B ?\e$,188\e(B ?\e$,189\e(B ;; GUTTRULS
+ ?\e$,18:\e(B ?\e$,18;\e(B ?\e$,18<\e(B ?\e$,18=\e(B ?\e$,18>\e(B ;; PALATALS
+ ?\e$,18?\e(B ?\e$,18@\e(B ?\e$,18A\e(B ?\e$,18B\e(B ?\e$,18C\e(B ;; CEREBRALS
+ ?\e$,18D\e(B ?\e$,18E\e(B ?\e$,18F\e(B ?\e$,18G\e(B ?\e$,18H\e(B nil ;; DENTALS
+ ?\e$,18J\e(B ?\e$,18K\e(B ?\e$,18L\e(B ?\e$,18M\e(B ?\e$,18N\e(B ;; LABIALS
+ ?\e$,18O\e(B ?\e$,18P\e(B nil ?\e$,18R\e(B ?\e$,18S\e(B nil ?\e$,18U\e(B ;; SEMIVOWELS
+ ?\e$,18V\e(B nil ?\e$,18X\e(B ?\e$,18Y\e(B ;; SIBILANTS
+ nil ?\e$,18y\e(B ?\e$,18z\e(B ?\e$,18{\e(B ?\e$,18|\e(B nil ?\e$,18~\e(B nil ;; NUKTAS
+ "\e$,18<8m8>\e(B" nil)
+ (;; Misc Symbols (7)
+ nil ?\e$,18"\e(B nil nil ?\e$,18m\e(B nil nil) ;; ek onkar, etc.
+ (;; Digits
+ ?\e$,19&\e(B ?\e$,19'\e(B ?\e$,19(\e(B ?\e$,19)\e(B ?\e$,19*\e(B ?\e$,19+\e(B ?\e$,19,\e(B ?\e$,19-\e(B ?\e$,19.\e(B ?\e$,19/\e(B)
+ (;; Inscript-extra (4) (#, $, ^, *, ])
+ "\e$,18m8P\e(B" "\e$,18P8m\e(B" "\e$,18D8m8P\e(B" "\e$,18V8m8P\e(B" "\e$,18\\e(B")))
+
+(defvar indian-gjr-base-table
+ '(
+ (;; VOWELS
+ (?\e$,19E\e(B nil) (?\e$,19F\e(B ?\e$,19~\e(B) (?\e$,19G\e(B ?\e$,19\7f\e(B) (?\e$,19H\e(B ?\e$,1: \e(B) (?\e$,19I\e(B ?\e$,1:!\e(B) (?\e$,19J\e(B ?\e$,1:"\e(B)
+ (?\e$,19K\e(B ?\e$,1:#\e(B) nil (?\e$,19M\e(B ?\e$,1:%\e(B) nil (?\e$,19O\e(B ?\e$,1:'\e(B) (?\e$,19P\e(B ?\e$,1:(\e(B)
+ (?\e$,19Q\e(B ?\e$,1:)\e(B) nil (?\e$,19S\e(B ?\e$,1:+\e(B) (?\e$,19T\e(B ?\e$,1:,\e(B) (?\e$,1:@\e(B ?\e$,1:$\e(B) nil)
+ (;; CONSONANTS
+ ?\e$,19U\e(B ?\e$,19V\e(B ?\e$,19W\e(B ?\e$,19X\e(B ?\e$,19Y\e(B ;; GUTTRULS
+ ?\e$,19Z\e(B ?\e$,19[\e(B ?\e$,19\\e(B ?\e$,19]\e(B ?\e$,19^\e(B ;; PALATALS
+ ?\e$,19_\e(B ?\e$,19`\e(B ?\e$,19a\e(B ?\e$,19b\e(B ?\e$,19c\e(B ;; CEREBRALS
+ ?\e$,19d\e(B ?\e$,19e\e(B ?\e$,19f\e(B ?\e$,19g\e(B ?\e$,19h\e(B nil ;; DENTALS
+ ?\e$,19j\e(B ?\e$,19k\e(B ?\e$,19l\e(B ?\e$,19m\e(B ?\e$,19n\e(B ;; LABIALS
+ ?\e$,19o\e(B ?\e$,19p\e(B nil ?\e$,19r\e(B ?\e$,19s\e(B nil ?\e$,19u\e(B ;; SEMIVOWELS
+ ?\e$,19v\e(B ?\e$,19w\e(B ?\e$,19x\e(B ?\e$,19y\e(B ;; SIBILANTS
+ nil nil nil nil nil nil nil nil ;; NUKTAS
+ "\e$,19\:-9^\e(B" "\e$,19U:-9w\e(B")
+ (;; Misc Symbols (7)
+ ?\e$,19A\e(B ?\e$,19B\e(B ?\e$,19C\e(B ?\e$,19}\e(B ?\e$,1:-\e(B ?\e$,1:0\e(B nil)
+ (;; Digits
+ ?\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)
+ (;; Inscript-extra (4) (#, $, ^, *, ])
+ "\e$,1:-9p\e(B" "\e$,19p:-\e(B" "\e$,19d:-9p\e(B" "\e$,19v:-9p\e(B" "\e$,19|\e(B")))
+
+(defvar indian-ori-base-table
+ '(
+ (;; VOWELS
+ (?\e$,1:e\e(B nil) (?\e$,1:f\e(B ?\e$,1;>\e(B) (?\e$,1:g\e(B ?\e$,1;?\e(B) (?\e$,1:h\e(B ?\e$,1;@\e(B) (?\e$,1:i\e(B ?\e$,1;A\e(B) (?\e$,1:j\e(B ?\e$,1;B\e(B)
+ (?\e$,1:k\e(B ?\e$,1;C\e(B) (?\e$,1:l\e(B nil) nil nil (?\e$,1:o\e(B ?\e$,1;G\e(B) (?\e$,1:p\e(B ?\e$,1;H\e(B)
+ nil nil (?\e$,1:s\e(B ?\e$,1;K\e(B) (?\e$,1:t\e(B ?\e$,1;L\e(B) (?\e$,1;`\e(B nil) (?\e$,1;a\e(B nil))
+ (;; CONSONANTS
+ ?\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 ;; GUTTRULS
+ ?\e$,1:z\e(B ?\e$,1:{\e(B ?\e$,1:|\e(B ?\e$,1:}\e(B ?\e$,1:~\e(B ;; PALATALS
+ ?\e$,1:\7f\e(B ?\e$,1; \e(B ?\e$,1;!\e(B ?\e$,1;"\e(B ?\e$,1;#\e(B ;; CEREBRALS
+ ?\e$,1;$\e(B ?\e$,1;%\e(B ?\e$,1;&\e(B ?\e$,1;'\e(B ?\e$,1;(\e(B nil ;; DENTALS
+ ?\e$,1;*\e(B ?\e$,1;+\e(B ?\e$,1;,\e(B ?\e$,1;-\e(B ?\e$,1;.\e(B ;; LABIALS
+ ?\e$,1;/\e(B ?\e$,1;0\e(B nil ?\e$,1;2\e(B ?\e$,1;3\e(B nil nil ;; SEMIVOWELS
+ ?\e$,1;6\e(B ?\e$,1;7\e(B ?\e$,1;8\e(B ?\e$,1;9\e(B ;; SIBILANTS
+ nil nil nil nil ?\e$,1;\\e(B ?\e$,1;]\e(B nil ?\e$,1;_\e(B ;; NUKTAS
+ "\e$,1:|;M:~\e(B" "\e$,1:u;M;7\e(B")
+ (;; Misc Symbols
+ ?\e$,1:a\e(B ?\e$,1:b\e(B ?\e$,1:c\e(B ?\e$,1;=\e(B ?\e$,1;M\e(B nil nil)
+ (;; Digits
+ ?\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)
+ (;; Inscript-extra (4) (#, $, ^, *, ])
+ "\e$,1;M;0\e(B" "\e$,1;0;M\e(B" "\e$,1;$;M;0\e(B" "\e$,1;6;M;0\e(B" "\e$,1;<\e(B")))
+
+(defvar indian-bng-base-table
+ '(
+ (;; VOWELS
+ (?\e$,16e\e(B nil) (?\e$,16f\e(B ?\e$,17>\e(B) (?\e$,16g\e(B ?\e$,17?\e(B) (?\e$,16h\e(B ?\e$,17@\e(B) (?\e$,16i\e(B ?\e$,17A\e(B) (?\e$,16j\e(B ?\e$,17B\e(B)
+ (?\e$,16k\e(B ?\e$,17C\e(B) (?\e$,16l\e(B ?\e$,17b\e(B) nil nil (?\e$,16o\e(B ?\e$,17G\e(B) (?\e$,16p\e(B ?\e$,17H\e(B)
+ nil nil (?\e$,16s\e(B ?\e$,17K\e(B) (?\e$,16t\e(B ?\e$,17L\e(B) (?\e$,17`\e(B ?\e$,17D\e(B) (?\e$,17a\e(B ?\e$,17c\e(B))
+ (;; CONSONANTS
+ ?\e$,16u\e(B ?\e$,16v\e(B ?\e$,16w\e(B ?\e$,16x\e(B ?\e$,16y\e(B ;; GUTTRULS
+ ?\e$,16z\e(B ?\e$,16{\e(B ?\e$,16|\e(B ?\e$,16}\e(B ?\e$,16~\e(B ;; PALATALS
+ ?\e$,16\7f\e(B ?\e$,17 \e(B ?\e$,17!\e(B ?\e$,17"\e(B ?\e$,17#\e(B ;; CEREBRALS
+ ?\e$,17$\e(B ?\e$,17%\e(B ?\e$,17&\e(B ?\e$,17'\e(B ?\e$,17(\e(B nil ;; DENTALS
+ ?\e$,17*\e(B ?\e$,17+\e(B ?\e$,17,\e(B ?\e$,17-\e(B ?\e$,17.\e(B ;; LABIALS
+ ?\e$,17/\e(B ?\e$,170\e(B nil ?\e$,172\e(B nil nil nil ;; SEMIVOWELS
+ ?\e$,176\e(B ?\e$,177\e(B ?\e$,178\e(B ?\e$,179\e(B ;; SIBILANTS
+ nil nil nil nil ?\e$,17\\e(B ?\e$,17]\e(B nil ?\e$,17_\e(B ;; NUKTAS
+ "\e$,16|7M6~\e(B" "\e$,16u7M77\e(B")
+ (;; Misc Symbols
+ ?\e$,16a\e(B ?\e$,16b\e(B ?\e$,16c\e(B nil ?\e$,17M\e(B nil nil)
+ (;; Digits
+ ?\e$,17f\e(B ?\e$,17g\e(B ?\e$,17h\e(B ?\e$,17i\e(B ?\e$,17j\e(B ?\e$,17k\e(B ?\e$,17l\e(B ?\e$,17m\e(B ?\e$,17n\e(B ?\e$,17o\e(B)
+ (;; Inscript-extra (4) (#, $, ^, *, ])
+ "\e$,17M70\e(B" "\e$,1707M\e(B" "\e$,17$7M70\e(B" "\e$,1767M70\e(B" "\e$,17<\e(B")))
+
+(defvar indian-asm-base-table
+ '(
+ (;; VOWELS
+ (?\e$,16e\e(B nil) (?\e$,16f\e(B ?\e$,17>\e(B) (?\e$,16g\e(B ?\e$,17?\e(B) (?\e$,16h\e(B ?\e$,17@\e(B) (?\e$,16i\e(B ?\e$,17A\e(B) (?\e$,16j\e(B ?\e$,17B\e(B)
+ (?\e$,16k\e(B ?\e$,17C\e(B) (?\e$,16l\e(B ?\e$,17b\e(B) nil nil (?\e$,16o\e(B ?\e$,17G\e(B) (?\e$,16p\e(B ?\e$,17H\e(B)
+ nil nil (?\e$,16s\e(B ?\e$,17K\e(B) (?\e$,16t\e(B ?\e$,17L\e(B) (?\e$,17`\e(B ?\e$,17D\e(B) (?\e$,17a\e(B ?\e$,17c\e(B))
+ (;; CONSONANTS
+ ?\e$,16u\e(B ?\e$,16v\e(B ?\e$,16w\e(B ?\e$,16x\e(B ?\e$,16y\e(B ;; GUTTRULS
+ ?\e$,16z\e(B ?\e$,16{\e(B ?\e$,16|\e(B ?\e$,16}\e(B ?\e$,16~\e(B ;; PALATALS
+ ?\e$,16\7f\e(B ?\e$,17 \e(B ?\e$,17!\e(B ?\e$,17"\e(B ?\e$,17#\e(B ;; CEREBRALS
+ ?\e$,17$\e(B ?\e$,17%\e(B ?\e$,17&\e(B ?\e$,17'\e(B ?\e$,17(\e(B nil ;; DENTALS
+ ?\e$,17*\e(B ?\e$,17+\e(B ?\e$,17,\e(B ?\e$,17-\e(B ?\e$,17.\e(B ;; LABIALS
+ ?\e$,17/\e(B ?\e$,17p\e(B nil ?\e$,172\e(B nil nil ?\e$,17q\e(B ;; SEMIVOWELS
+ ?\e$,176\e(B ?\e$,177\e(B ?\e$,178\e(B ?\e$,179\e(B ;; SIBILANTS
+ nil nil nil nil ?\e$,17\\e(B ?\e$,17]\e(B nil ?\e$,17_\e(B ;; NUKTAS
+ "\e$,16|7M6~\e(B" "\e$,16u7M77\e(B")
+ (;; Misc Symbols
+ ?\e$,16a\e(B ?\e$,16b\e(B ?\e$,16c\e(B nil ?\e$,17M\e(B nil nil)
+ (;; Digits
+ ?\e$,17f\e(B ?\e$,17g\e(B ?\e$,17h\e(B ?\e$,17i\e(B ?\e$,17j\e(B ?\e$,17k\e(B ?\e$,17l\e(B ?\e$,17m\e(B ?\e$,17n\e(B ?\e$,17o\e(B)
+ (;; Inscript-extra (4) (#, $, ^, *, ])
+ "\e$,17M7p\e(B" "\e$,17p7M\e(B" "\e$,17$7M7p\e(B" "\e$,1767M7p\e(B" "\e$,17<\e(B")))
+
+(defvar indian-tlg-base-table
+ '(
+ (;; VOWELS
+ (?\e$,1=E\e(B nil) (?\e$,1=F\e(B ?\e$,1=~\e(B) (?\e$,1=G\e(B ?\e$,1=\7f\e(B) (?\e$,1=H\e(B ?\e$,1> \e(B) (?\e$,1=I\e(B ?\e$,1>!\e(B) (?\e$,1=J\e(B ?\e$,1>"\e(B)
+ (?\e$,1=K\e(B ?\e$,1>#\e(B) (?\e$,1=L\e(B nil) nil (?\e$,1=O\e(B ?\e$,1>'\e(B) (?\e$,1=N\e(B ?\e$,1>&\e(B) (?\e$,1=P\e(B ?\e$,1>(\e(B)
+ nil (?\e$,1=S\e(B ?\e$,1>+\e(B) (?\e$,1=R\e(B ?\e$,1>*\e(B) (?\e$,1=T\e(B ?\e$,1>,\e(B) (?\e$,1>@\e(B ?\e$,1>$\e(B) (?\e$,1>A\e(B nil))
+ (;; CONSONANTS
+ ?\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 ;; GUTTRULS
+ ?\e$,1=Z\e(B ?\e$,1=[\e(B ?\e$,1=\\e(B ?\e$,1=]\e(B ?\e$,1=^\e(B ;; PALATALS
+ ?\e$,1=_\e(B ?\e$,1=`\e(B ?\e$,1=a\e(B ?\e$,1=b\e(B ?\e$,1=c\e(B ;; CEREBRALS
+ ?\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 nil ;; DENTALS
+ ?\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 ;; LABIALS
+ ?\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 nil ?\e$,1=u\e(B ;; SEMIVOWELS
+ ?\e$,1=v\e(B ?\e$,1=w\e(B ?\e$,1=x\e(B ?\e$,1=y\e(B ;; SIBILANTS
+ nil nil nil nil nil nil nil nil ;; NUKTAS
+ "\e$,1=\>-=^\e(B" "\e$,1=U>-=w\e(B")
+ (;; Misc Symbols
+ ?\e$,1=A\e(B ?\e$,1=B\e(B ?\e$,1=C\e(B nil ?\e$,1>-\e(B nil nil)
+ (;; Digits
+ ?\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)
+ (;; Inscript-extra (4) (#, $, ^, *, ])
+ "\e$,1>-=p\e(B" "\e$,1=p>-\e(B" "\e$,1=d>-=p\e(B" "\e$,1=v>-=p\e(B" nil)))
+
+(defvar indian-knd-base-table
+ '(
+ (;; VOWELS
+ (?\e$,1>e\e(B nil) (?\e$,1>f\e(B ?\e$,1?>\e(B) (?\e$,1>g\e(B ?\e$,1??\e(B) (?\e$,1>h\e(B ?\e$,1?@\e(B) (?\e$,1>i\e(B ?\e$,1?A\e(B) (?\e$,1>j\e(B ?\e$,1?B\e(B)
+ (?\e$,1>k\e(B ?\e$,1?C\e(B) (?\e$,1>l\e(B nil) nil (?\e$,1>o\e(B ?\e$,1?G\e(B) (?\e$,1>n\e(B ?\e$,1?F\e(B) (?\e$,1>p\e(B ?\e$,1?H\e(B)
+ nil (?\e$,1>s\e(B ?\e$,1?K\e(B) (?\e$,1>r\e(B ?\e$,1?J\e(B) (?\e$,1>t\e(B ?\e$,1?L\e(B) (?\e$,1?`\e(B ?\e$,1?D\e(B) (?\e$,1?a\e(B nil))
+ (;; CONSONANTS
+ ?\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 ;; GUTTRULS
+ ?\e$,1>z\e(B ?\e$,1>{\e(B ?\e$,1>|\e(B ?\e$,1>}\e(B ?\e$,1>~\e(B ;; PALATALS
+ ?\e$,1>\7f\e(B ?\e$,1? \e(B ?\e$,1?!\e(B ?\e$,1?"\e(B ?\e$,1?#\e(B ;; CEREBRALS
+ ?\e$,1?$\e(B ?\e$,1?%\e(B ?\e$,1?&\e(B ?\e$,1?'\e(B ?\e$,1?(\e(B nil ;; DENTALS
+ ?\e$,1?*\e(B ?\e$,1?+\e(B ?\e$,1?,\e(B ?\e$,1?-\e(B ?\e$,1?.\e(B ;; LABIALS
+ ?\e$,1?/\e(B ?\e$,1?0\e(B ?\e$,1?1\e(B ?\e$,1?2\e(B ?\e$,1?3\e(B nil ?\e$,1?5\e(B ;; SEMIVOWELS
+ ?\e$,1?6\e(B ?\e$,1?7\e(B ?\e$,1?8\e(B ?\e$,1?9\e(B ;; SIBILANTS
+ nil nil nil nil nil nil ?\e$,1?^\e(B nil ;; NUKTAS
+ "\e$,1>|?M>~\e(B" "\e$,1>u?M?7\e(B")
+ (;; Misc Symbols
+ nil ?\e$,1>b\e(B ?\e$,1>c\e(B nil ?\e$,1?M\e(B nil nil)
+ (;; Digits
+ ?\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)
+ (;; Inscript-extra (4) (#, $, ^, *, ])
+ "\e$,1?M?0\e(B" "\e$,1?0?M\e(B" "\e$,1?$?M?0\e(B" "\e$,1?6?M?0\e(B" nil)))
+
+(defvar indian-mlm-base-table
+ '(
+ (;; VOWELS
+ (?\e$,1@%\e(B nil) (?\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@*\e(B ?\e$,1@b\e(B)
+ (?\e$,1@+\e(B ?\e$,1@c\e(B) (?\e$,1@,\e(B nil) nil (?\e$,1@/\e(B ?\e$,1@g\e(B) (?\e$,1@.\e(B ?\e$,1@f\e(B) (?\e$,1@0\e(B ?\e$,1@h\e(B)
+ nil (?\e$,1@3\e(B ?\e$,1@k\e(B) (?\e$,1@2\e(B ?\e$,1@j\e(B) (?\e$,1@4\e(B ?\e$,1@l\e(B) nil nil)
+ (;; CONSONANTS
+ ?\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 ;; GUTTRULS
+ ?\e$,1@:\e(B ?\e$,1@;\e(B ?\e$,1@<\e(B ?\e$,1@=\e(B ?\e$,1@>\e(B ;; PALATALS
+ ?\e$,1@?\e(B ?\e$,1@@\e(B ?\e$,1@A\e(B ?\e$,1@B\e(B ?\e$,1@C\e(B ;; CEREBRALS
+ ?\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 nil ;; DENTALS
+ ?\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 ;; LABIALS
+ ?\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 ;; SEMIVOWELS
+ ?\e$,1@V\e(B ?\e$,1@W\e(B ?\e$,1@X\e(B ?\e$,1@Y\e(B ;; SIBILANTS
+ nil nil nil nil nil nil nil nil ;; NUKTAS
+ "\e$,1@<@m@>\e(B" "\e$,1@5@m@W\e(B")
+ (;; Misc Symbols
+ nil ?\e$,1@"\e(B ?\e$,1@#\e(B nil ?\e$,1@m\e(B nil nil)
+ (;; Digits
+ ?\e$,1A&\e(B ?\e$,1A'\e(B ?\e$,1A(\e(B ?\e$,1A)\e(B ?\e$,1A*\e(B ?\e$,1A+\e(B ?\e$,1A,\e(B ?\e$,1A-\e(B ?\e$,1A.\e(B ?\e$,1A/\e(B)
+ (;; Inscript-extra (4) (#, $, ^, *, ])
+ "\e$,1@m@P\e(B" "\e$,1@P@m\e(B" "\e$,1@D@m@P\e(B" "\e$,1@V@m@P\e(B" nil)))
+
+(defvar indian-tml-base-table
+ '(
+ (;; VOWELS
+ (?
\e$,1<%
\e(B nil) (?
\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<*
\e(B ?
\e$,1<b
\e(B)
+ nil nil nil (?\e$,1</\e(B ?\e$,1<g\e(B) (?\e$,1<.\e(B ?\e$,1<f\e(B) (?\e$,1<0\e(B ?\e$,1<h\e(B)
+ nil (?\e$,1<3\e(B ?\e$,1<k\e(B) (?\e$,1<2\e(B ?\e$,1<j\e(B) (?\e$,1<4\e(B ?\e$,1<l\e(B) nil nil)
+ (;; CONSONANTS
+ ?\e$,1<5\e(B nil nil nil ?\e$,1<9\e(B ;; GUTTRULS
+ ?\e$,1<:\e(B nil ?\e$,1<<\e(B nil ?\e$,1<>\e(B ;; PALATALS
+ ?\e$,1<?\e(B nil nil nil ?\e$,1<C\e(B ;; CEREBRALS
+ ?\e$,1<D\e(B nil nil nil ?\e$,1<H\e(B ?\e$,1<I\e(B ;; DENTALS
+ ?\e$,1<J\e(B nil nil nil ?\e$,1<N\e(B ;; LABIALS
+ ?
\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 ;; SEMIVOWELS
+ nil ?\e$,1<W\e(B ?\e$,1<X\e(B ?\e$,1<Y\e(B ;; SIBILANTS
+ nil nil nil nil nil nil nil nil ;; NUKTAS
+ "\e$,1<<<m<>\e(B" "\e$,1<5<m<W\e(B")
+ (;; Misc Symbols
+ nil ?\e$,1<"\e(B ?\e$,1<#\e(B nil ?\e$,1<m\e(B nil nil)
+ (;; Digits
+ nil ?\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)
+ (;; Inscript-extra (4) (#, $, ^, *, ])
+ "
\e$,1<m<P
\e(B" "
\e$,1<P<m
\e(B" "
\e$,1<D<m<P
\e(B" nil nil)))
(defvar indian-base-table-to-language-alist
'((indian-dev-base-table . "Devanagari")
'(;; for encode/decode
(;; vowels -- 18
"a" ("aa" "A") "i" ("ii" "I") "u" ("uu" "U")
- ("RRi" "R^i") ("LLi" "L^i") (".c" "e.c") nil "e" "ai"
- "o.c" nil "o" "au" ("RRI" "R^I") ("LLI" "L^I"))
+ ("RRi" "R^i") ("LLi" "L^i") (".c" "e.c") "E" "e" "ai"
+ "o.c" "O" "o" "au" ("RRI" "R^I") ("LLI" "L^I"))
(;; consonants -- 40
"k" "kh" "g" "gh" ("~N" "N^")
"ch" ("Ch" "chh") "j" "jh" ("~n" "JN")
(if seqrest
(mapcar
(lambda (x)
- (apply
- 'mapthread
- `(lambda (&rest y) (apply ',function x y))
- seqrest))
+ (apply
+ 'mapthread
+ `(lambda (&rest y) (apply ',function x y))
+ seqrest))
seq1)
(mapcar function seq1)))
;; 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)
- (mapc
- (lambda (trans)
- (puthash trans char decode-hash))
- trans-char))))
+ (dolist (trans trans-char)
+ (puthash trans char decode-hash)))))
(defun indian--map (f l1 l2)
(while l1
(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
(defun indian-make-hash (table trans-table)
"Indian Transliteration Hash for decode/encode"
- (let* ((encode-hash (makehash 'equal))
- (decode-hash (makehash 'equal))
+ (let* ((encode-hash (make-hash-table :test 'equal))
+ (decode-hash (make-hash-table :test 'equal))
(hashtbls (cons encode-hash decode-hash))
(vowels (elt table 0))
(consonants (elt table 1))
(indian-make-hash indian-dev-base-table
indian-aiba-table))
+(defvar indian-pnj-itrans-v5-hash
+ (indian-make-hash indian-pnj-base-table
+ indian-itrans-v5-table))
+
+(defvar indian-gjr-itrans-v5-hash
+ (indian-make-hash indian-gjr-base-table
+ indian-itrans-v5-table))
+
+(defvar indian-ori-itrans-v5-hash
+ (indian-make-hash indian-ori-base-table
+ indian-itrans-v5-table))
+
+(defvar indian-bng-itrans-v5-hash
+ (indian-make-hash indian-bng-base-table
+ indian-itrans-v5-table))
+
+(defvar indian-asm-itrans-v5-hash
+ (indian-make-hash indian-asm-base-table
+ indian-itrans-v5-table))
+
+(defvar indian-tlg-itrans-v5-hash
+ (indian-make-hash indian-tlg-base-table
+ indian-itrans-v5-table))
+
+(defvar indian-knd-itrans-v5-hash
+ (indian-make-hash indian-knd-base-table
+ indian-itrans-v5-table))
+
+(defvar indian-mlm-itrans-v5-hash
+ (indian-make-hash indian-mlm-base-table
+ indian-itrans-v5-table))
+
+(defvar indian-tml-itrans-v5-hash
+ (indian-make-hash indian-tml-base-table
+ indian-itrans-v5-table))
)
(defmacro indian-translate-region (from to hashtable encode-p)
;;; IS 13194 utilities
-;; The following provide conversion between IS 13194 (ISCII) and UCS.
-
-(defvar is13194-default-repertory 'devanagari)
-
-(defvar is13194-repertory-to-ucs-script
- `((DEF ?\x40 ,is13194-default-repertory)
- (RMN ?\x41 ,is13194-default-repertory)
- (DEV ?\x42 devanagari)
- (BNG ?\x43 bengali)
- (TML ?\x44 tamil)
- (TLG ?\x45 telugu)
- (ASM ?\x46 bengali)
- (ORI ?\x47 oriya)
- (KND ?\x48 kannada)
- (MLM ?\x49 malayalam)
- (GJR ?\x4a gujarati)
- (PNJ ?\x4b gurmukhi)))
-
-;; for guiding find-variable function.
-(defvar is13194-to-ucs-devanagari-hashtbl nil)
-(defvar is13194-to-ucs-devanagari-regexp nil)
-(defvar is13194-to-ucs-bengali-hashtbl nil)
-(defvar is13194-to-ucs-bengali-regexp nil)
-(defvar is13194-to-ucs-assamese-hashtbl nil)
-(defvar is13194-to-ucs-assamese-regexp nil)
-(defvar is13194-to-ucs-gurmukhi-hashtbl nil)
-(defvar is13194-to-ucs-gurmukhi-regexp nil)
-(defvar is13194-to-ucs-gujarati-hashtbl nil)
-(defvar is13194-to-ucs-gujarati-regexp nil)
-(defvar is13194-to-ucs-oriya-hashtbl nil)
-(defvar is13194-to-ucs-oriya-regexp nil)
-(defvar is13194-to-ucs-tamil-hashtbl nil)
-(defvar is13194-to-ucs-tamil-regexp nil)
-(defvar is13194-to-ucs-telugu-hashtbl nil)
-(defvar is13194-to-ucs-telugu-regexp nil)
-(defvar is13194-to-ucs-malayalam-hashtbl nil)
-(defvar is13194-to-ucs-malayalam-regexp nil)
+;; 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 is13194-default-repartory 'devanagari)
+ (let
- ;;Unicode vs IS13194. Only Devanagari is supported currently.
++ ;;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))
+ (dolist (script '(devanagari bengali assamese gurmukhi gujarati
+ oriya tamil telugu malayalam))
+ (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))))))
++ (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)
+ (TLG ?\x45 telugu)
+ (ASM ?\x46 bengali)
+ (ORI ?\x47 oriya)
+ (KND ?\x48 kannada)
+ (MLM ?\x49 malayalam)
+ (GJR ?\x4a gujarati)
+ (PNJ ?\x4b gurmukhi)))
+
+;; for guiding find-variable function.
+(defvar is13194-to-ucs-devanagari-hashtbl nil)
+(defvar is13194-to-ucs-devanagari-regexp nil)
+(defvar is13194-to-ucs-bengali-hashtbl nil)
+(defvar is13194-to-ucs-bengali-regexp nil)
+(defvar is13194-to-ucs-assamese-hashtbl nil)
+(defvar is13194-to-ucs-assamese-regexp nil)
+(defvar is13194-to-ucs-gurmukhi-hashtbl nil)
+(defvar is13194-to-ucs-gurmukhi-regexp nil)
+(defvar is13194-to-ucs-gujarati-hashtbl nil)
+(defvar is13194-to-ucs-gujarati-regexp nil)
+(defvar is13194-to-ucs-oriya-hashtbl nil)
+(defvar is13194-to-ucs-oriya-regexp nil)
+(defvar is13194-to-ucs-tamil-hashtbl nil)
+(defvar is13194-to-ucs-tamil-regexp nil)
+(defvar is13194-to-ucs-telugu-hashtbl nil)
+(defvar is13194-to-ucs-telugu-regexp nil)
+(defvar is13194-to-ucs-malayalam-hashtbl nil)
+(defvar is13194-to-ucs-malayalam-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))
-
(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) "]")
++ "-" (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
(defun indian-compose-region (from to)
- "Compose the region according to `composition-function-table'. "
+ "Compose the region according to `composition-function-table'."
(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 (assoc (match-string 0) alist)))
++ (setq subst (cdr (assoc (match-string 0) alist))))
+ (replace-match (if subst subst "?"))))
+ (indian-compose-region (point-min) (point-max))))))
(provide 'ind-util)
;; Copyright (C) 1999, 2001 Free Software Foundation, Inc.
-;; Maintainer: KAWABATA, Taichi <batta@beige.ocn.ne.jp>
+;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
;; Keywords: multilingual, i18n, Indian
;; This file is part of GNU Emacs.
;;; 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.
+Currently supported foundries are `cdac' and `akruti'.")
+
+(defvar indian-script-language-alist
+ "Alist of Indian scripts vs the corresponding language list and font foundry.
+Each element has this form:
+
+ (SCRIPT LANGUAGE-LIST FONT-FOUNDRY)
+
+SCRIPT is one of Indian script names.
+
+LANGUAGE-LIST is a list of Indian langauge names SCRIPT is used for.
+The list is in the priority order.
+
+FONT-FOUNDRY is a font foundry representing a group of Indian
+fonts. If the value is nil, the value of `indian-font-foundry'
+is used."
+ '((devanagari (hindi sanskrit) nil)
+ (bengali (bengali assamese) nil)
+ (gurmukhi (punjabi) nil)
+ (gujarati (gujarati) nil)
+ (oriya (oriya) nil)
+ (tamil (tamil) nil)
+ (telugu (telugu) nil)
+ (kannada (kannada) nil)
+ (malayalam (malayalam) nil)))
+
+(defconst indian-font-char-index-table
+ '( ; for which language(s)
+ ;; CDAC fonts
+ (#x0000 . cdac:dv-ttsurekh) ; hindi, etc
+ (#x0100 . cdac:sd-ttsurekh) ; sanskrit
+ (#x0200 . cdac:bn-ttdurga) ; bengali
+ (#x0300 . cdac:tm-ttvalluvar) ; tamil
+ (#x0400 . cdac:tl-tthemalatha) ; telugu
+ (#x0500 . cdac:as-ttdurga) ; assamese
+ (#x0600 . cdac:or-ttsarala) ; oriya
+ (#x0700 . cdac:kn-ttuma) ; kannada
+ (#x0800 . cdac:ml-ttkarthika) ; malayalam
+ (#x0900 . cdac:gj-ttavantika) ; gujarati
+ (#x0A00 . cdac:pn-ttamar) ; punjabi
+
+ ;; AKRUTI fonts
+ (#x0B00 . akruti:dev) ; hindi, etc
+ (#x0C00 . akruti:bng) ; bengali
+ (#x0D00 . akruti:pnj) ; punjabi
+ (#x0E00 . akruti:guj) ; gujarati
+ (#x0F00 . akruti:ori) ; oriya
+ (#x1000 . akruti:tml) ; tamil
+ (#x1100 . akruti:tlg) ; telugu
+ (#x1200 . akruti:knd) ; kannada
+ (#x1300 . akruti:mal) ; malayalam
+ )
+ "Aliat of indices of `indian-glyph' character vs Indian font identifiers.
+Each element has this form: (INDEX . FONT-IDENTIFIER)
+
+INDEX is an index number of the first character in the charset
+`indian-glyph' assigned for glyphs in the font specified by
+FONT-IDENTIFIER. Currently FONT-IDENTIFIERs are defined for CDAC
+and AKRUTI font groups.")
+
+(defun indian-font-char (index font-identifier)
+ "Return character of charset `indian-glyph' made from glyph index INDEX.
+FONT-IDENTIFIER is an identifier of an Indian font listed in the
+variable `indian-font-char-index-table'. It specifies which
+font INDEX is for."
+ (if (or (< index 0) (> index 255))
+ (error "Invalid glyph index: %d" index))
+ (let ((start (car (rassq font-identifier indian-font-char-index-table))))
+ (if (not start)
+ (error "Unknown font identifier: %s" font-identifier))
+ (setq index (+ start index))
+ (make-char 'indian-glyph (+ (/ index 96) 32) (+ (% index 96) 32))))
+
+;; Return a range of characters (cons of min and max character) of the
+;; charset `indian-glyph' for displaying SCRIPT in LANGUAGE by a font
+;; of FOUNDRY.
+
+(defun indian-font-char-range (font-identifier)
+ (cons (indian-font-char 0 font-identifier)
+ (indian-font-char 255 font-identifier)))
+
+(defvar indian-script-table
+ '[
+ devanagari
+ sanskrit
+ bengali
+ tamil
+ telugu
+ assamese
+ oriya
+ kannada
+ malayalam
+ gujarati
+ punjabi
+ ]
+ "Vector of Indian script names.")
+
+(let ((len (length indian-script-table))
+ (i 0))
+ (while (< i len)
+ (put (aref indian-script-table i) 'indian-glyph-code-offset (* 256 i))
+ (setq i (1+ i))))
+
(defvar indian-default-script 'devanagari
"Default script for Indian languages.
Each Indian language environment sets this value
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.")
(provide 'indian)
-;;; japanese.el --- support for Japanese -*- coding: iso-2022-7bit; -*-
+;;; japanese.el --- support for Japanese -*- coding: iso-2022-7bit; no-byte-compile: t -*-
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
++;; 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)))
+ (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 japanese-jisx0212)
+ nil nil nil]
+ :flags '(short ascii-at-eol ascii-at-cntl 7-bit designation)
+ :charset-list '(ascii japanese-jisx0208-1978 japanese-jisx0208
+ latin-jisx0201 japanese-jisx0212)
+ :mime-charset 'iso-2022-jp)
(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-1978 japanese-jisx0208
+ latin-jisx0201 japanese-jisx0212
+ chinese-gb2312 korean-ksc5601
+ latin-iso8859-1 greek-iso8859-7)
+ :mime-charset 'iso-2022-jp-2)
+
+ (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)
- (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))
+
+ ;; Fixme: AKA Shift-JIS according to
+ ;; <URL:http://www.microsoft.com/globaldev/reference/WinCP.asp>. Is
+ ;; that correct?
+
+ (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
+ japanese-jisx0208-1978
+ katakana-jisx0201 japanese-jisx0212)
+ :mime-charset 'euc-jp)
(define-coding-system-alias 'euc-japan-1990 'japanese-iso-8bit)
(define-coding-system-alias 'euc-japan 'japanese-iso-8bit)
(set-language-info-alist
"Japanese" '((setup-function . setup-japanese-environment-internal)
- (exit-function . exit-japanese-environment)
(tutorial . "TUTORIAL.ja")
(charset japanese-jisx0208 japanese-jisx0208-1978
japanese-jisx0212 latin-jisx0201 katakana-jisx0201
-;;; korean.el --- support for Korean -*- coding: iso-2022-7bit; -*-
+;;; korean.el --- support for Korean -*- coding: iso-2022-7bit; no-byte-compile: t -*-
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
++;; 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)
- (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)
(define-coding-system-alias 'korean-iso-7bit-lock 'iso-2022-kr)
;;; lao-util.el --- utilities for Lao -*- coding: iso-2022-7bit; -*-
;; Copyright (C) 1997 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
;; Copyright (C) 2001 Free Software Foundation, Inc.
++;; 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.
(define-category ?v "Lao upper/lower vowel" lao-category-table)
(define-category ?t "Lao tone" lao-category-table)
-;; Fixme: Should `invalid' entries below be preserved? (See also
-;; thai-util.el.)
(let ((l '((?\e(1!\e(B consonant "LETTER KOR KAI'" "CHICKEN")
(?\e(1"\e(B consonant "LETTER KHOR KHAI'" "EGG")
(?\e(1#\e(B invalid nil)
(?\e(1Q\e(B vowel-upper "VOWEL SIGN MAI KAN")
(?\e(1R\e(B vowel-base "VOWEL SIGN SARA AR")
(?\e(1S\e(B vowel-base "VOWEL SIGN SARA AM")
- (?\e(1T\e(B vowel-upper "VOWEL SIGN SARA I")
+ (?\e(1T\e(B vowel-upper "VOWEL SIGN SARA I")
(?\e(1U\e(B vowel-upper "VOWEL SIGN SARA II")
(?\e(1V\e(B vowel-upper "VOWEL SIGN SARA EU")
(?\e(1W\e(B vowel-upper "VOWEL SIGN SARA UR")
(?\e(1c\e(B vowel-base "VOWEL SIGN SARA EI MAI MUAN\"")
(?\e(1d\e(B vowel-base "VOWEL SIGN SARA AI MAI MAY")
(?\e(1e\e(B invalid nil)
- (?\e(1f\e(B special "KO LA (REPETITION)")
+ (?\e(1f\e(B special "KO LA (REPETITION)")
(?\e(1g\e(B invalid nil)
(?\e(1h\e(B tone "TONE MAI EK")
(?\e(1i\e(B tone "TONE MAI THO")
(?\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(1b\e(B" (?\e(1b\e(B 0))
("\e(1`RP\e(B" (?\e(1`\e(B 0 ?\e(1R\e(B ?\e(1P\e(B) (0 ?\e(1Q\e(B ?\e(1M\e(B))
("\e(1m\e(B" (0 ?\e(1m\e(B) (0 ?\e(1M\e(B))
- ("\e(1`T\e(B" (?\e(1`\e(B 0 ?\e(1T\e(B))
- ("\e(1`U\e(B" (?\e(1`\e(B 0 ?\e(1U\e(B))
- ("\e(1[GP\e(B" (0 ?\e(1[\e(B ?\e(1G\e(B ?\e(1P\e(B) (0 ?\e(1Q\e(B ?\e(1G\e(B))
- ("\e(1[G\e(B" (0 ?\e(1[\e(B ?\e(1G\e(B) (0 ?\e(1G\e(B))
- ("\e(1`Q]P\e(B" (?\e(1`\e(B 0 ?\e(1Q\e(B ?\e(1]\e(B ?\e(1P\e(B) (0 ?\e(1Q\e(B ?\e(1]\e(B))
- ("\e(1`Q]\e(B" (?\e(1`\e(B 0 ?\e(1Q\e(B ?\e(1]\e(B) (0 ?\e(1]\e(B))
- ("\e(1`VM\e(B" (?\e(1`\e(B 0 ?\e(1V\e(B ?\e(1M\e(B))
- ("\e(1`WM\e(B" (?\e(1`\e(B 0 ?\e(1W\e(B ?\e(1M\e(B))
- ("\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(1P\e(B" (0 ?\e(1P\e(B) (0 ?\e(1Q\e(B))
- ("\e(1R\e(B" (0 ?\e(1R\e(B))
- ("\e(1T\e(B" (0 ?\e(1U\e(B))
- ("\e(1U\e(B" (0 ?\e(1U\e(B))
- ("\e(1V\e(B" (0 ?\e(1V\e(B))
- ("\e(1W\e(B" (0 ?\e(1W\e(B))
- ("\e(1X\e(B" (0 ?\e(1X\e(B))
- ("\e(1Y\e(B" (0 ?\e(1Y\e(B))
- ("\e(1`P\e(B" (?\e(1`\e(B 0 ?\e(1P\e(B) (?\e(1`\e(B 0 ?\e(1Q\e(B))
- ("\e(1`\e(B" (?\e(1`\e(B 0))
- ("\e(1aP\e(B" (?\e(1a\e(B 0 ?\e(1P\e(B) (?\e(1a\e(B 0 ?\e(1Q\e(B))
- ("\e(1a\e(B" (?\e(1a\e(B 0))
- ("\e(1bP\e(B" (?\e(1b\e(B 0 ?\e(1P\e(B) (0 ?\e(1[\e(B) (?\e(1-\e(B ?\e(1b\e(B 0 ?\e(1Q\e(B) (?\e(1G\e(B ?\e(1b\e(B 0 ?\e(1Q\e(B))
- ("\e(1b\e(B" (?\e(1b\e(B 0))
- ("\e(1`RP\e(B" (?\e(1`\e(B 0 ?\e(1R\e(B ?\e(1P\e(B) (0 ?\e(1Q\e(B ?\e(1M\e(B))
- ("\e(1m\e(B" (0 ?\e(1m\e(B) (0 ?\e(1M\e(B))
("\e(1`T\e(B" (?\e(1`\e(B 0 ?\e(1T\e(B))
("\e(1`U\e(B" (?\e(1`\e(B 0 ?\e(1U\e(B))
("\e(1[GP\e(B" (0 ?\e(1[\e(B ?\e(1G\e(B ?\e(1P\e(B) (0 ?\e(1Q\e(B ?\e(1G\e(B))
("\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; -*-
+;;; lao.el --- support for Lao -*- coding: iso-2022-7bit; no-byte-compile: t -*-
;; Copyright (C) 1997 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
;; Copyright (C) 2001 Free Software Foundation, Inc.
++;; 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)))
(provide 'lao)
--- /dev/null
+;;; malayalam.el --- Support for Malayalam -*- coding: iso-2022-7bit; no-byte-compile: t -*-
+
+;; Copyright (C) 2003 Free Software Foundation, Inc.
+
+;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
+;; Keywords: multilingual, Indian, Malayalam
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file defines language-info of Malayalam script.
+
+;;; Code:
+
+(set-language-info-alist
+ "Malayalam" '((charset mule-unicode-0100-24ff indian-glyph )
+ ;; indian-2-column
+ ;; comment out later
+ ;; )
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "malayalam-itrans")
+ (features mlm-util)
+ (documentation . "\
+South Indian language Malayalam is supported in this language environment."))
+ '("Indian"))
+
++;; For automatic composition.
++(set-char-table-range composition-function-table '(#x0d00 . #x0d7f)
++ 'malayalam-composition-function)
++
++
+(provide 'malayalam)
+
+;;; malayalam.el ends here
--- /dev/null
- (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)))
+;;; mlm-util.el --- support for composing malayalam characters -*-coding: iso-2022-7bit;-*-
+
+;; Copyright (C) 2003 Free Software Foundation, Inc.
+
+;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
+;; Keywords: multilingual, Malayalam
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;; Created: Feb. 11. 2003
+
+;;; Commentary:
+
+;; This file provides character(Unicode) to glyph(CDAC) conversion and
+;; composition of Malayalam script characters.
+
+;;; Code:
+
+;; Malayalam Composable Pattern
+;; C .. Consonants
+;; V .. Vowel
+;; H .. Halant
+;; M .. Matra
+;; V .. Vowel
+;; A .. Anuswar
+;; D .. Chandrabindu
+;; (N .. Zerowidth Non Joiner)
+;; (J .. Zerowidth Joiner. )
+;; 1. vowel
+;; V(A|visargam)?
+;; 2. syllable : maximum of 5 consecutive consonants. (e.g. kartsnya)
+;; ((CH)?(CH)?(CH)?CH)?C(H|M?(A|D)?)?
+
+(defconst malayalam-consonant
+ "[\e$,1@5\e(B-\e$,1@Y\e(B]")
+
+(defconst malayalam-composable-pattern
+ (concat
+ "\\([\e$,1@%\e(B-\e$,1@4\e(B][\e$,1@"\e(B]?\\)\\|\e$,1@#\e(B"
+ "\\|\\("
+ "\\(?:\\(?:[\e$,1@5\e(B-\e$,1@Y\e(B]\e$,1@m\e(B\\)?\\(?:[\e$,1@5\e(B-\e$,1@Y\e(B]\e$,1@m\e(B\\)?\\(?:[\e$,1@5\e(B-\e$,1@Y\e(B]\e$,1@m\e(B\\)?[\e$,1@5\e(B-\e$,1@Y\e(B]\e$,1@m\e(B\\)?"
+ "[\e$,1@5\e(B-\e$,1@Y\e(B]\\(?:\e$,1@m\e(B\\|[\e$,1@^\e(B-\e$,1@c@f@g@h@j@j@k@l\e(B]?[\e$,1@"@m\e(B]?\\)?"
+ "\\)")
+ "Regexp matching a composable sequence of Malayalam characters.")
+
+;;;###autoload
+(defun malayalam-compose-region (from to)
+ (interactive "r")
+ (save-excursion
+ (save-restriction
+ (narrow-to-region from to)
+ (goto-char (point-min))
+ (while (re-search-forward malayalam-composable-pattern nil t)
+ (malayalam-compose-syllable-region (match-beginning 0)
+ (match-end 0))))))
+(defun malayalam-compose-string (string)
+ (with-temp-buffer
+ (insert (decompose-string string))
+ (malayalam-compose-region (point-min) (point-max))
+ (buffer-string)))
+
+(defun malayalam-post-read-conversion (len)
+ (save-excursion
+ (save-restriction
+ (let ((buffer-modified-p (buffer-modified-p)))
+ (narrow-to-region (point) (+ (point) len))
+ (malayalam-compose-region (point-min) (point-max))
+ (set-buffer-modified-p buffer-modified-p)
+ (- (point-max) (point-min))))))
+
+(defun malayalam-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 malayalam-regexp-of-hashtbl-keys (hashtbl)
+ "Return a regular expression that matches all keys in hashtable HASHTBL."
+ (let ((max-specpdl-size 1000))
+ (regexp-opt
+ (sort
+ (let (dummy)
+ (maphash (function (lambda (key val) (setq dummy (cons key dummy)))) hashtbl)
+ dummy)
+ (function (lambda (x y) (> (length x) (length y))))))))
+
+
+;;;###autoload
- (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))))
++(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
++ ;; Not yet implemented.
++ nil
++ (goto-char pos)
++ (if (looking-at malayalam-composable-pattern)
++ (prog1 (match-end 0)
++ (malayalam-compose-syllable-region pos (match-end 0))))))
+
+;; Notes on conversion steps.
+
+;; 1. chars to glyphs
+;;
+;; Simple replacement of characters to glyphs is done.
+
+;; 2. glyphs reordering.
+;;
+;; Two special reordering rule takes place.
+;; a. following "\e$,46[\e(B" goes to the front.
+;; b. following "\e$,46S6S\e(B", "\e$,46S\e(B" or "\e$,46T\e(B" goes to the front.
+;; This reordering occurs only to the last cluster of consonants.
+;; Preceding consonants with halant characters are not affected.
+
+;; 3. Composition.
+;;
+;; left modifiers will be attached at the left.
+;; others will be attached right.
+
+(defvar mlm-char-glyph
+ '(;; various signs
+ ("\e$,1@"\e(B" . "\e$,46W\e(B")
+ ("\e$,1@#\e(B" . "\e$,46X\e(B")
+ ;; Independent Vowels
+ ("\e$,1@%\e(B" . "\e$,46!\e(B")
+ ("\e$,1@&\e(B" . "\e$,46"\e(B")
+ ("\e$,1@'\e(B" . "\e$,46#\e(B")
+ ("\e$,1@(\e(B" . "\e$,46#6U\e(B")
+ ("\e$,1@)\e(B" . "\e$,46$\e(B")
+ ("\e$,1@*\e(B" . "\e$,46$6U\e(B")
+ ("\e$,1@+\e(B" . "\e$,46%\e(B")
+ ("\e$,1@,\e(B" . "nil") ;; not in present use, not supported.
+ ("\e$,1@.\e(B" . "\e$,46&\e(B")
+ ("\e$,1@/\e(B" . "\e$,46'\e(B")
+ ("\e$,1@0\e(B" . "\e$,46S6&\e(B")
+ ("\e$,1@2\e(B" . "\e$,46(\e(B")
+ ("\e$,1@3\e(B" . "\e$,46(6M\e(B")
+ ("\e$,1@4\e(B" . "\e$,46(6U\e(B")
+ ;; Consonants
+ ("\e$,1@5\e(B" . "\e$,46)\e(B")
+ ("\e$,1@5@m@5\e(B" . "\e$,47!\e(B")
+ ("\e$,1@5@m@S\e(B" . "\e$,47"\e(B")
+ ("\e$,1@5@m@W\e(B" . "\e$,47#\e(B")
+ ("\e$,1@5@m@?\e(B" . "\e$,47N\e(B")
+ ("\e$,1@5@m@D\e(B" . "\e$,47`\e(B")
+ ("\e$,1@5@a\e(B" . "\e$,47f\e(B")
+ ("\e$,1@5@m@5@a\e(B" . "\e$,47g\e(B")
+ ("\e$,1@5@a\e(B" . "\e$,47f\e(B")
+ ("\e$,1@5@m@5@a\e(B" . "\e$,47g\e(B")
+
+ ("\e$,1@6\e(B" . "\e$,46*\e(B")
+
+ ("\e$,1@7\e(B" . "\e$,46+\e(B")
+ ("\e$,1@7@m@7\e(B" . "\e$,47$\e(B")
+ ("\e$,1@7@m@R\e(B" . "\e$,47%\e(B")
+ ("\e$,1@7@m@N\e(B" . "\e$,47\\e(B")
+ ("\e$,1@7@m@H\e(B" . "\e$,47a\e(B")
+
+ ("\e$,1@8\e(B" . "\e$,46,\e(B")
+
+ ("\e$,1@9\e(B" . "\e$,46-\e(B")
+ ("\e$,1@9@m@5\e(B" . "\e$,47&\e(B")
+ ("\e$,1@9@m@9\e(B" . "\e$,47'\e(B")
+ ("\e$,1@9@m@5@a\e(B" . "\e$,47h\e(B")
+
+ ("\e$,1@:\e(B" . "\e$,46.\e(B")
+ ("\e$,1@:@m@:\e(B" . "\e$,47(\e(B") ;; duplicate
+ ("\e$,1@:@m@;\e(B" . "\e$,47Q\e(B")
+
+ ("\e$,1@;\e(B" . "\e$,46/\e(B")
+
+ ("\e$,1@<\e(B" . "\e$,460\e(B")
+ ("\e$,1@<@m@<\e(B" . "\e$,47V\e(B")
+ ("\e$,1@<@m@>\e(B" . "\e$,47Z\e(B")
+
+ ("\e$,1@=\e(B" . "\e$,461\e(B")
+
+ ("\e$,1@>\e(B" . "\e$,462\e(B")
+ ("\e$,1@>@m@:\e(B" . "\e$,47)\e(B")
+ ("\e$,1@>@m@>\e(B" . "\e$,47*\e(B")
+
+ ("\e$,1@?\e(B" . "\e$,463\e(B")
+ ("\e$,1@?@m@?\e(B" . "\e$,47+\e(B")
+
+ ("\e$,1@@\e(B" . "\e$,464\e(B")
+ ("\e$,1@A\e(B" . "\e$,465\e(B")
+ ("\e$,1@A@m@A\e(B" . "\e$,47M\e(B")
+ ("\e$,1@B\e(B" . "\e$,466\e(B")
+
+ ("\e$,1@C\e(B" . "\e$,467\e(B")
+ ("\e$,1@C@a@m\e(B" . "\e$,47,\e(B") ;; half consonant
+ ("\e$,1@C@m@?\e(B" . "\e$,47-\e(B")
+ ("\e$,1@C@m@C\e(B" . "\e$,47.\e(B")
+ ("\e$,1@C@m@N\e(B" . "\e$,47W\e(B")
+ ("\e$,1@C@m@A\e(B" . "\e$,47^\e(B")
+ ("\e$,1@C@a\e(B" . "\e$,47i\e(B")
+
+ ("\e$,1@D\e(B" . "\e$,468\e(B")
+ ("\e$,1@D@m@D\e(B" . "\e$,47/\e(B")
+ ("\e$,1@D@m@E\e(B" . "\e$,470\e(B")
+ ("\e$,1@D@m@X\e(B" . "\e$,47U\e(B")
+ ("\e$,1@D@m@M\e(B" . "\e$,47[\e(B")
+ ("\e$,1@D@m@N\e(B" . "\e$,47_\e(B")
+
+ ("\e$,1@E\e(B" . "\e$,469\e(B")
+
+ ("\e$,1@F\e(B" . "\e$,46:\e(B")
+ ("\e$,1@F@m@F\e(B" . "\e$,471\e(B")
+ ("\e$,1@F@m@G\e(B" . "\e$,472\e(B")
+
+ ("\e$,1@G\e(B" . "\e$,46;\e(B")
+
+ ("\e$,1@H\e(B" . "\e$,46<\e(B")
+ ("\e$,1@H@a@m\e(B" . "\e$,473\e(B") ;; half consonant
+ ("\e$,1@H@m@D\e(B" . "\e$,474\e(B")
+ ("\e$,1@H@m@F\e(B" . "\e$,475\e(B")
+ ("\e$,1@H@m@H\e(B" . "\e$,476\e(B")
+ ("\e$,1@H@m@N\e(B" . "\e$,477\e(B")
+ ("\e$,1@H@m@G\e(B" . "\e$,47T\e(B")
+ ("\e$,1@H@m@E\e(B" . "\e$,47Y\e(B")
+ ("\e$,1@H@m@Q\e(B" . "\e$,47b\e(B")
+ ("\e$,1@H@a\e(B" . "\e$,47k\e(B")
+ ("\e$,1@H@m@H@a\e(B" . "\e$,47l\e(B")
+
+ ("\e$,1@J\e(B" . "\e$,46=\e(B")
+ ("\e$,1@J@m@J\e(B" . "\e$,478\e(B") ;; duplicate
+ ("\e$,1@J@m@R\e(B" . "\e$,479\e(B") ;; lakar
+
+ ("\e$,1@K\e(B" . "\e$,46>\e(B")
+
+ ("\e$,1@L\e(B" . "\e$,46?\e(B")
+ ("\e$,1@L@m@L\e(B" . "\e$,47:\e(B") ;; duplicate
+ ("\e$,1@L@m@R\e(B" . "\e$,47;\e(B") ;; lakar
+ ("\e$,1@L@m@G\e(B" . "\e$,47O\e(B")
+ ("\e$,1@L@m@F\e(B" . "\e$,47P\e(B")
+
+ ("\e$,1@M\e(B" . "\e$,46@\e(B")
+
+ ("\e$,1@N\e(B" . "\e$,46A\e(B")
+ ("\e$,1@N@m@J\e(B" . "\e$,47<\e(B")
+ ("\e$,1@N@m@N\e(B" . "\e$,47=\e(B")
+ ("\e$,1@N@m@R\e(B" . "\e$,47>\e(B") ;; lakar
+
+ ("\e$,1@O\e(B" . "\e$,46B\e(B")
+ ("\e$,1@O@m@O\e(B" . "\e$,47?\e(B") ;; duplicate
+ ("\e$,1@O@m@5@m@5\e(B" . "\e$,47m\e(B")
+
+ ("\e$,1@P\e(B" . "\e$,46C\e(B")
+ ("\e$,1@P@a@m\e(B" . "\e$,47@\e(B")
+ ("\e$,1@P@a\e(B" . "\e$,47j\e(B")
+
+ ("\e$,1@Q\e(B" . "\e$,46D\e(B")
+ ("\e$,1@Q@m\e(B" . "\e$,47@\e(B") ;; same glyph as "\e$,1@P@m\e(B"
+ ("\e$,1@Q@a@m\e(B" . "\e$,47@\e(B") ;; same glyph as "\e$,1@P@m\e(B"
+ ;;("\e$,1@Q@m@Q\e(B" . "\e$,47A\e(B")
+ ("\e$,1@Q@m@Q\e(B" . "\e$,47d\e(B")
+
+ ("\e$,1@R\e(B" . "\e$,46E\e(B")
+ ("\e$,1@R@a@m\e(B" . "\e$,47B\e(B")
+ ("\e$,1@R@m@R\e(B" . "\e$,47C\e(B") ;; lakar
+ ("\e$,1@R@m@J\e(B" . "\e$,47e\e(B")
+
+ ("\e$,1@S\e(B" . "\e$,46F\e(B")
+ ("\e$,1@S@a@m\e(B" . "\e$,47D\e(B")
+ ("\e$,1@S@m@S\e(B" . "\e$,47E\e(B")
+
+ ("\e$,1@T\e(B" . "\e$,46G\e(B")
+
+ ("\e$,1@U\e(B" . "\e$,46H\e(B")
+ ("\e$,1@U@m@U\e(B" . "\e$,47F\e(B")
+
+ ("\e$,1@V\e(B" . "\e$,46I\e(B")
+ ("\e$,1@V@m@R\e(B" . "\e$,47G\e(B")
+ ("\e$,1@V@m@V\e(B" . "\e$,47H\e(B")
+ ("\e$,1@V@m@:\e(B" . "\e$,47]\e(B")
+
+ ("\e$,1@W\e(B" . "\e$,46J\e(B")
+ ("\e$,1@W@m@?\e(B" . "\e$,47c\e(B")
+
+ ("\e$,1@X\e(B" . "\e$,46K\e(B")
+ ("\e$,1@X@m@R\e(B" . "\e$,47I\e(B")
+ ("\e$,1@X@m@X\e(B" . "\e$,47J\e(B")
+ ("\e$,1@X@m@Q@m@Q\e(B" . "\e$,47L\e(B")
+ ("\e$,1@X@m@E\e(B" . "\e$,47X\e(B")
+
+ ("\e$,1@Y\e(B" . "\e$,46L\e(B")
+ ("\e$,1@Y@m@R\e(B" . "\e$,47K\e(B")
+ ("\e$,1@Y@m@N\e(B" . "\e$,47R\e(B")
+ ("\e$,1@Y@m@H\e(B" . "\e$,47S\e(B")
+
+ ;; Dependent vowel signs
+ ("\e$,1@^\e(B" . "\e$,46M\e(B")
+ ("\e$,1@_\e(B" . "\e$,46N\e(B")
+ ("\e$,1@`\e(B" . "\e$,46O\e(B")
+ ("\e$,1@a\e(B" . "\e$,46P\e(B")
+ ("\e$,1@b\e(B" . "\e$,46Q\e(B")
+ ("\e$,1@c\e(B" . "\e$,46R\e(B")
+ ("\e$,1@f\e(B" . "\e$,46S\e(B")
+ ("\e$,1@g\e(B" . "\e$,46T\e(B")
+ ("\e$,1@h\e(B" . "\e$,46S6S\e(B")
+ ("\e$,1@j\e(B" . "\e$,46S6M\e(B")
+ ("\e$,1@k\e(B" . "\e$,46T6M\e(B")
+ ("\e$,1@l\e(B" . "\e$,46U\e(B")
+ ;; Various signs
+ ("\e$,1@m\e(B" . "\e$,46V\e(B")
+ ("\e$,1@m@O\e(B" . "\e$,46Y\e(B") ;; yakar
+ ("\e$,1@m@O@a\e(B" . "\e$,46\\e(B") ;; yakar + u
+ ("\e$,1@m@O@b\e(B" . "\e$,46]\e(B") ;; yakar + uu
+ ("\e$,1@m@U\e(B" . "\e$,46Z\e(B") ;; vakar modifier
+ ("\e$,1@m@P\e(B" . "\e$,46[\e(B") ;; rakar modifier is the same to rra modifier.
+ ("\e$,1@m@P@m\e(B" . "\e$,46R\e(B") ;; halant + rakar + halant
+ ("\e$,1@m@Q\e(B" . "\e$,46[\e(B") ;; rrakar modifier
+ ("\e$,1@m@Q@m\e(B" . "\e$,46R\e(B") ;; halant + rrakar + halant
+ ("\e$,1@m@m\e(B" . "\e$,46V\e(B") ;; double omission sign to stop forming half consonant.
+ ("\e$,1@w\e(B" . "\e$,46U\e(B") ;; not in present use, already at 0D4C.
+ ))
+
+(defvar mlm-char-glyph-hash
+ (let* ((hash (make-hash-table :test 'equal)))
+ (mapc (function (lambda (x) (puthash (car x) (cdr x) hash)))
+ mlm-char-glyph)
+ hash))
+
+(defvar mlm-char-glyph-regexp
+ (malayalam-regexp-of-hashtbl-keys mlm-char-glyph-hash))
+
+;; Malayalam languages needed to be reordered in a complex mannar.
+
+(defvar mlm-consonants
+ (concat
+ "\e$,46)6*6+6,6-6.6/606162636465666768696:6;6<6=6>6?6@6A6B6C6D6E6F6G6H6I6J6K6L\e(B"
+ "\e$,47!7"7#7$7%7&7'7(7)7*7+7,7-7.7/707172737475767778797:7;7<7=7>7?7@7A7B7C7D7E7F7G7H7I7J7K7L7M7N7O7P7Q7R7S7T7U7V7W7X7Y7Z7[7\7]7^7_7`7a7b7c7d7e\e(B"
+ ))
+
+(defvar mlm-consonants-regexp
+ (concat "\\(\e$,46[\e(B?[" mlm-consonants "][\e$,46Y6Z\e(B]?\\)"))
+
+(defvar mlm-glyph-reorder-key-glyphs "[\e$,46[6S6T\e(B]")
+
+(defvar mlm-glyph-reordering-regexp-list
+ `((,(concat "\\([" mlm-consonants "][\e$,46Y6Z\e(B]?\\)\e$,46[\e(B") . "\e$,46[\e(B\\1")
+ (,(concat mlm-consonants-regexp "\e$,46S6S\e(B") . "\e$,46S6S\e(B\\1")
+ (,(concat mlm-consonants-regexp "\e$,46S\e(B") . "\e$,46S\e(B\\1")
+ (,(concat mlm-consonants-regexp "\e$,46T\e(B") . "\e$,46T\e(B\\1")))
+
+(defun malayalam-compose-syllable-string (string)
+ (with-temp-buffer
+ (insert (decompose-string string))
+ (malayalam-compose-syllable-region (point-min) (point-max))
+ (buffer-string)))
+
+(defun malayalam-compose-syllable-region (from to)
+ "Compose malayalam syllable in region FROM to TO."
+ (let (glyph-str
+ match-str
+ glyph-reorder-regexps
+ glyph-reorder-replace
+ glyph-reorder-regexp)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region from to)
+ (goto-char (point-min))
+ ;; char-glyph-conversion
++ (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)
+ (while glyph-reorder-regexps
+ (setq glyph-reorder-regexp (caar glyph-reorder-regexps))
+ (setq glyph-reorder-replace (cdar glyph-reorder-regexps))
+ (setq glyph-reorder-regexps (cdr glyph-reorder-regexps))
+ (if (string-match glyph-reorder-regexp glyph-str)
+ (setq glyph-str
+ (replace-match glyph-reorder-replace nil nil
+ glyph-str)))))
+ ;; concatenate and attach reference-points.
+ (setq glyph-str
+ (cdr
+ (apply
+ 'nconc
+ (mapcar
+ (function
+ (lambda (x) (list '(5 . 3) x))) ;; default ref. point.
+ glyph-str))))
+ (compose-region from to glyph-str)))))
+
+(provide 'mlm-util)
+
+;;; devan-util.el ends here
-;;; romanian.el --- support for Romanian -*- coding: iso-latin-2; -*-
+;;; romanian.el --- support for Romanian -*- coding: iso-latin-2; no-byte-compile: t -*-
- ;; Copyright (C) 1998 Free Software Foundation.
+ ;; Copyright (C) 1998, 2002 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-system . (iso-8859-2 iso-latin-10))
-- (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)
;;; romanian.el ends here
-;;; slovak.el --- support for Slovak -*- coding: iso-2022-7bit; -*-
+;;; slovak.el --- support for Slovak -*- coding: iso-2022-7bit; no-byte-compile: t -*-
;; Copyright (C) 1998, 2001 Free Software Foundation.
"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!")
(documentation . "\
This language environment is almost the same as Latin-2,
-but sets the default input to \"slovak\",
+but sets the default input method to \"slovak\",
and selects the Slovak tutorial."))
'("European"))
--- /dev/null
+;;; tamil.el --- Support for Tamil -*- coding: iso-2022-7bit; no-byte-compile: t -*-
+
+;; Copyright (C) 2003 Free Software Foundation, Inc.
+
+;; Maintainer: KAWABATA, Taichi <batta@beige.ocn.ne.jp>
+;; Keywords: multilingual, Indian, Tamil
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file defines language-info of Tamil script.
+
+;;; Code:
+
+(set-language-info-alist
+ "Tamil" '((charset mule-unicode-0100-24ff indian-glyph )
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "tamil-itrans")
+ (features tml-util)
+ (documentation . "\
+South Indian Language Tamil supported in this language environment."))
+ '("Indian"))
+
++;; For automatic composition.
++(set-char-table-range composition-function-table '(#x0b80 . #x0bff)
++ 'tamil-composition-function)
+(provide 'tamil)
+
+;;; tamil.el ends here
;;; thai-util.el --- utilities for Thai -*- coding: iso-2022-7bit; -*-
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2001 Free Software Foundation, Inc.
++;; Licensed to the Free Software Foundation.
++;; Copyright (C) 2003
++;; National Institute of Advanced Industrial Science and Technology (AIST)
++;; Registration Number H13PRO009
- ;; Keywords: mule, multilingual, thai
+ ;; Keywords: mule, multilingual, Thai, i18n
;; This file is part of GNU Emacs.
(?\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 vowel-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 tone "THANTHAKHAT N/S-T (cancellation mark)")
- (?\e$,1CM\e(B tone "NIKKHAHIT N/S-T (final nasal)")
- (?\e$,1CN\e(B vowel-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
(compose-string string idx (match-end 0))
(setq idx (match-end 0)))))
string)
-
+
;;;###autoload
(defun thai-compose-buffer ()
"Compose Thai characters in the current buffer."
(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."
- (if (< (1+ from) to)
- (progn
- (if string
- (compose-string string from to)
- (compose-region from to))
- (- to from))))
+ (defun thai-composition-function (pos &optional string)
+ (setq pos (1- pos))
+ (let ((pattern "[\e,T!\e(B-\e,TCEG\e(B-\e,TN!\e(B-\e,TCEG\e(B-\e,TN\e(B][\e,TQT\e(B-\e,TWgnX\e(B-\e,TZQT\e(B-\e,TWgnX\e(B-\e,TZ\e(B]?[\e,Th\e(B-\e,Tmh\e(B-\e,Tm\e(B]?"))
+ (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)))))))))
;;
(provide 'thai-util)
-;;; thai.el --- support for Thai -*- coding: iso-2022-7bit; -*-
+;;; thai.el --- support for Thai -*- coding: iso-2022-7bit; no-byte-compile: t -*-
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
+ ;; Copyright (C) 2002 Free Software Foundation, Inc.
++;; Copyright (C) 2003
++;; National Institute of Advanced Industrial Science and Technology (AIST)
++;; Registration Number H13PRO009
- ;; 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)
- (sample-text
+ (sample-text
. (thai-compose-string
- (copy-sequence "Thai (\e,T@RIRd7B\e(B) \e,TJGQJ4U$CQ:\e(B, \e,TJGQJ4U$hP\e(B")))
+ (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")))
(documentation . t)))
--
- ;; Register a function to compose Thai characters.
- (let ((patterns '(("\\c0\\c4\\|\\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)
;;; Code:
- `(("\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")
+(defconst tibetan-obsolete-glyphs
++ `(("\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
+ "\e$(7#R#S#S#S\e(B" 0 4
+ [?\e$(7#R\e(B (Br . Bl) ?\e$(7#S\e(B (Br . Bl) ?\e$(7#S\e(B (Br . Bl) ?\e$(7#S\e(B]))
+ ("\e$(7!4!5\e(B" . ,(compose-string "\e$(7#R#S#S\e(B" 0 3 [?\e$(7#R\e(B (Br . Bl) ?\e$(7#S\e(B (Br . Bl) ?\e$(7#S\e(B]))
+ ("\e$(7!6\e(B" . ,(compose-string "\e$(7#R#S!I\e(B" 0 3 [?\e$(7#R\e(B (Br . Bl) ?\e$(7#S\e(B (br . tr) ?\e$(7!I\e(B]))
+ ("\e$(7!4\e(B" . ,(compose-string "\e$(7#R#S\e(B" 0 2 [?\e$(7#R\e(B (Br . Bl) ?\e$(7#S\e(B]))))
+
;;;###autoload
(defun tibetan-char-p (ch)
"Check if char CH is Tibetan character.
;;;
;;; 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
++ ;; 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)
+ (setq pos (1- pos))
(if string
- (tibetan-compose-string string)
- (tibetan-compose-region from to))
- (- to from))
+ ;; Not yet implemented.
+ nil
+ (if (>= pos (point-min))
+ (save-excursion
+ (goto-char 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.
;; Should return nil as annotations.
nil))
+\f
+;;;
+;;; Unicode-related definitions.
+;;;
+
+(defvar tibetan-canonicalize-for-unicode-alist
+ '(("\e$(7"Q\e(B" . "") ;; remove vowel a
+ ("\e$(7"T\e(B" . "\e$(7"R"S\e(B") ;; decompose vowels whose use is ``discouraged'' in Unicode 3.0
+ ("\e$(7"V\e(B" . "\e$(7"R"U\e(B")
+ ("\e$(7"W\e(B" . "\e$(7#C"a\e(B")
+ ("\e$(7"X\e(B" . "\e$(7#C"R"a\e(B")
+ ("\e$(7"Y\e(B" . "\e$(7#D"a\e(B")
+ ("\e$(7"Z\e(B" . "\e$(7#D"R"a\e(B")
+ ("\e$(7"b\e(B" . "\e$(7"R"a\e(B"))
+ "Rules for canonicalizing Tibetan vowels for Unicode.")
+
+(defvar tibetan-canonicalize-for-unicode-regexp
+ "[\e$(7"Q"T"V"W"X"Y"Z"b\e(B]"
+ "Regexp for Tibetan vowels to be canonicalized in Unicode.")
+
+(defun tibetan-canonicalize-for-unicode-region (from to)
+ (save-restriction
+ (narrow-to-region from to)
+ (goto-char from)
+ (while (re-search-forward tibetan-canonicalize-for-unicode-regexp nil t)
+ (let (
+ ;;(from (match-beginning 0))
+ ;;(to (match-end 0))
+ (canonical-form
+ (cdr (assoc (match-string 0)
+ tibetan-canonicalize-for-unicode-alist))))
+ ;;(goto-char from)
+ ;;(delete-region from to)
+ ;;(insert canonical-form)
+ (replace-match canonical-form)
+ ))))
+
+(defvar tibetan-strict-unicode t
+ "*Flag to control Tibetan canonicalizing for Unicode.
+
+If non-nil, the vowel a is removed and composite vowels are decomposed
+before writing buffer in Unicode. See also
+`tibetan-canonicalize-for-unicode-regexp' and
+`tibetan-canonicalize-for-unicode-alist'.")
+
+;;;###autoload
+(defun tibetan-pre-write-canonicalize-for-unicode (from to)
+ (let ((old-buf (current-buffer))
+ (strict-unicode tibetan-strict-unicode))
+ (set-buffer (generate-new-buffer " *temp*"))
+ (if (stringp from)
+ (insert from)
+ (insert-buffer-substring old-buf from to))
+ (if strict-unicode
+ (tibetan-canonicalize-for-unicode-region (point-min) (point-max)))
+ ;; Should return nil as annotations.
+ nil))
+
(provide 'tibet-util)
;;; tibet-util.el ends here
;;; tibetan.el --- support for Tibetan language -*- coding: iso-2022-7bit; -*-
;; Copyright (C) 1997 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
++;; 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.
;; Created: Feb. 17. 1997
;; History:
-;; 1997.03.13 Modification for special signs and punctuations.
+;; 1997.03.13 Modification for special signs and punctuations.
;;; Commentary:
;;;2260 \e$(7"`\e(B \e$(7"a\e(B \e$(7"b\e(B \e$(7"c\e(B \e$(7"d\e(B \e$(7"e\e(B \e$(7"f\e(B \e$(7"g\e(B \e$(7"h\e(B \e$(7"i\e(B \e$(7"j\e(B \e$(7"k\e(B \e$(7"l\e(B \e$(7"m\e(B \e$(7"n\e(B \e$(7"o\e(B ; Long vowels and
;;;2270 \e$(7"p\e(B \e$(7"q\e(B \e$(7"r\e(B \e$(7"s\e(B \e$(7"t\e(B \e$(7"u\e(B \e$(7"v\e(B \e$(7"w\e(B \e$(7"x\e(B \e$(7"y\e(B \e$(7"z\e(B \e$(7"{\e(B \e$(7"|\e(B \e$(7"}\e(B \e$(7"~\e(B // ; vocalic r, l ARE
;;; ; atomically
-;;; ; encoded.
+;;; ; encoded.
;;; 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F
;;;2320 // \e$(7#!\e(B \e$(7#"\e(B \e$(7##\e(B \e$(7#$\e(B \e$(7#%\e(B \e$(7#&\e(B \e$(7#'\e(B \e$(7#(\e(B \e$(7#)\e(B \e$(7#*\e(B \e$(7#+\e(B \e$(7#,\e(B \e$(7#-\e(B \e$(7#.\e(B \e$(7#/\e(B ; Subjoined consonants
;;;2330 \e$(7#0\e(B \e$(7#1\e(B \e$(7#2\e(B \e$(7#3\e(B \e$(7#4\e(B \e$(7#5\e(B \e$(7#6\e(B \e$(7#7\e(B \e$(7#8\e(B \e$(7#9\e(B \e$(7#:\e(B \e$(7#;\e(B \e$(7#<\e(B \e$(7#=\e(B \e$(7#>\e(B \e$(7#?\e(B ;
;;;2430 \e$(7$0\e(B \e$(7$1\e(B \e$(7$2\e(B \e$(7$3\e(B \e$(7$4\e(B \e$(7$5\e(B \e$(7$6\e(B \e$(7$7\e(B \e$(7$8\e(B \e$(7$9\e(B \e$(7$:\e(B \e$(7$;\e(B \e$(7$<\e(B \e$(7$=\e(B \e$(7$>\e(B \e$(7$?\e(B ; consonants for
;;;2440 \e$(7$@\e(B \e$(7$A\e(B \e$(7$B\e(B \e$(7$C\e(B \e$(7$D\e(B \e$(7$E\e(B \e$(7$F\e(B \e$(7$G\e(B \e$(7$H\e(B \e$(7$I\e(B \e$(7$J\e(B \e$(7$K\e(B \e$(7$L\e(B \e$(7$M\e(B \e$(7$N\e(B \e$(7$O\e(B ; ordinary Tibetan.
;;;2450 \e$(7$P\e(B \e$(7$Q\e(B \e$(7$R\e(B \e$(7$S\e(B \e$(7$T\e(B \e$(7$U\e(B \e$(7$V\e(B \e$(7$W\e(B \e$(7$X\e(B \e$(7$Y\e(B \e$(7$Z\e(B \e$(7$[\e(B \e$(7$\\e(B \e$(7$]\e(B \e$(7$^\e(B \e$(7$_\e(B ; They are decomposed
-;;;2460 \e$(7$`\e(B \e$(7$a\e(B \e$(7$b\e(B \e$(7$c\e(B \e$(7$d\e(B \e$(7$e\e(B \e$(7$f\e(B \e$(7$g\e(B \e$(7$h\e(B \e$(7$i\e(B \e$(7$j\e(B \e$(7$k\e(B \e$(7$l\e(B \e$(7$m\e(B \e$(7$n\e(B \e$(7$o\e(B ; into base and
+;;;2460 \e$(7$`\e(B \e$(7$a\e(B \e$(7$b\e(B \e$(7$c\e(B \e$(7$d\e(B \e$(7$e\e(B \e$(7$f\e(B \e$(7$g\e(B \e$(7$h\e(B \e$(7$i\e(B \e$(7$j\e(B \e$(7$k\e(B \e$(7$l\e(B \e$(7$m\e(B \e$(7$n\e(B \e$(7$o\e(B ; into base and
;;;2470 \e$(7$p\e(B \e$(7$q\e(B \e$(7$r\e(B \e$(7$s\e(B \e$(7$t\e(B \e$(7$u\e(B \e$(7$v\e(B \e$(7$w\e(B \e$(7$x\e(B \e$(7$y\e(B \e$(7$z\e(B \e$(7${\e(B \e$(7$|\e(B \e$(7$}\e(B \e$(7$~\e(B // ; subjoined consonants
;;; ; when written on a
;;; 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F ; file in Tibetan
;;;
- (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
- (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")))))
-"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")))))
--
++ (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.
;;;
("\e$(7"G#7\e(B" . "\e$(7%X\e(B")
("\e$(7"G#9\e(B" . "\e$(7%Y\e(B")))
-(defconst tibetan-obsolete-glyphs
- `(("\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
- "\e$(7#R#S#S#S\e(B" 0 4
- [?\e$(7#R\e(B (Br . Bl) ?\e$(7#S\e(B (Br . Bl) ?\e$(7#S\e(B (Br . Bl) ?\e$(7#S\e(B]))
- ("\e$(7!4!5\e(B" . ,(compose-string "\e$(7#R#S#S\e(B" 0 3 [?\e$(7#R\e(B (Br . Bl) ?\e$(7#S\e(B (Br . Bl) ?\e$(7#S\e(B]))
- ("\e$(7!6\e(B" . ,(compose-string "\e$(7#R#S!I\e(B" 0 3 [?\e$(7#R\e(B (Br . Bl) ?\e$(7#S\e(B (br . tr) ?\e$(7!I\e(B]))
- ("\e$(7!4\e(B" . ,(compose-string "\e$(7#R#S\e(B" 0 2 [?\e$(7#R\e(B (Br . Bl) ?\e$(7#S\e(B]))))
-
(defconst tibetan-regexp
(let ((l (list tibetan-precomposed-transcription-alist
tibetan-consonant-transcription-alist
(defvar tibetan-decomposed nil)
(defvar tibetan-decomposed-temp nil)
++
+ ;; For automatic composition.
+ (dolist (range '((?\e$(7#!\e(B . ?\e$(7#J\e(B) "\e$(7#K#L#M"Q"R\e(B" (?\e$(7"S\e(B . ?\e$(7"^\e(B) "\e$(7"a"b"e"_"c"d\e(B" (?\e$(7"g\e(B . ?\e$(7"l\e(B) "\e$(7!I!e!g\e(B"))
+ (if (stringp range)
+ (dotimes (i (length range))
+ (aset composition-function-table (aref range i)
+ 'tibetan-composition-function))
+ (set-char-table-range composition-function-table range
+ 'tibetan-composition-function)))
+
(provide 'tibetan)
;;; tibetan.el ends here
--- /dev/null
- ;;;###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)))
-
+;;; tml-util.el --- support for composing tamil characters -*-coding: iso-2022-7bit;-*-
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
+;; Keywords: multilingual, Indian, Tamil
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;; Created: Nov. 08. 2002
+
+;;; Commentary:
+
+;; This file provides character(Unicode) to glyph(CDAC) conversion and
+;; composition of Tamil script characters.
+
+;;; Code:
+
+;; Tamil Composable Pattern
+;; C .. Consonants
+;; V .. Vowel
+;; H .. Pulli
+;; M .. Matra
+;; V .. Vowel
+;; A .. Anuswar
+;; D .. Chandrabindu
+;; 1. vowel
+;; V
+;; 2. syllable : only ligature-formed pattern forms composition.
+;; (CkHCs|C)(H|M)?
+;; 3. sri special
+;; (CsHCrVi)
+
+;; oririnal
+;; ((CH)?(CH)?(CH)?CH)?C(H|M?(A|D)?)?
+
+(defconst tamil-consonant
+ "[\e$,1<5\e(B-\e$,1<Y\e(B]")
+
+(defconst tamil-composable-pattern
+ (concat
+ "\\([\e$,1<%\e(B-\e$,1<4\e(B]\\)\\|"
+ "[\e$,1<"<#\e(B]\\|" ;; vowel modifier considered independent
+ "\\(\\(?:\\(?:\e$,1<5<m<W\e(B\\)\\|[\e$,1<5\e(B-\e$,1<Y\e(B]\\)[\e$,1<m<^\e(B-\e$,1<l\e(B]?\\)\\|"
+ "\\(
\e$,1<W<m<P<`
\e(B\\)")
+ "Regexp matching a composable sequence of Tamil characters.")
+
+;;;###autoload
+(defun tamil-compose-region (from to)
+ (interactive "r")
+ (save-excursion
+ (save-restriction
+ (narrow-to-region from to)
+ (goto-char (point-min))
+ (while (re-search-forward tamil-composable-pattern nil t)
+ (tamil-compose-syllable-region (match-beginning 0)
+ (match-end 0))))))
+(defun tamil-compose-string (string)
+ (with-temp-buffer
+ (insert (decompose-string string))
+ (tamil-compose-region (point-min) (point-max))
+ (buffer-string)))
+
+(defun tamil-post-read-conversion (len)
+ (save-excursion
+ (save-restriction
+ (let ((buffer-modified-p (buffer-modified-p)))
+ (narrow-to-region (point) (+ (point) len))
+ (tamil-compose-region (point-min) (point-max))
+ (set-buffer-modified-p buffer-modified-p)
+ (- (point-max) (point-min))))))
+
+(defun tamil-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 tamil-regexp-of-hashtbl-keys (hashtbl)
+ "Return a regular expression that matches all keys in hashtable HASHTBL."
+ (let ((max-specpdl-size 1000))
+ (regexp-opt
+ (sort
+ (let (dummy)
+ (maphash (function (lambda (key val) (setq dummy (cons key dummy)))) hashtbl)
+ dummy)
+ (function (lambda (x y) (> (length x) (length y))))))))
+
+
- ;;("\e$,1<"\e(B" . "")
+;; Notes on conversion steps.
+
+;; 1. chars to glyphs
+;; Simple replacement of characters to glyphs is done.
+
+;; 2. glyphs reordering.
+;; following "\e$,4)j\e(B", "\e$,4)k\e(B", "\e$,4)l\e(B" goes to the front.
+
+;; 3. glyphs to glyphs
+;; reordered vowels are ligatured to consonants.
+
+;; 4. Composition.
+;; left modifiers will be attached at the left.
+;; others will be attached right.
+
+(defvar tml-char-glyph
+ '(;; various signs
- (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))))
++ ("\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")
+ ("\e$,1<&\e(B" . "\e$,4*=\e(B")
+ ("\e$,1<'\e(B" . "\e$,4*>\e(B")
+ ("\e$,1<(\e(B" . "\e$,4*?\e(B")
+ ("\e$,1<)\e(B" . "\e$,4*@\e(B")
+ ("\e$,1<*\e(B" . "\e$,4*A\e(B")
+ ("\e$,1<.\e(B" . "\e$,4*B\e(B")
+ ("\e$,1</\e(B" . "\e$,4*C\e(B")
+ ("\e$,1<0\e(B" . "\e$,4*D\e(B")
+ ("\e$,1<2\e(B" . "\e$,4*E\e(B")
+ ("\e$,1<3\e(B" . "\e$,4*F\e(B")
+ ("\e$,1<4\e(B" . "\e$,4*E*W\e(B")
+ ;; Consonants
+ ("\e$,1<5<m<W<m\e(B" . "\e$,4):\e(B") ; ks.
+ ("\e$,1<5<m<W\e(B" . "\e$,4*^\e(B") ; ks
+ ("\e$,1<5\e(B" . "\e$,4*H\e(B")
+
+ ("\e$,1<9\e(B" . "\e$,4*I\e(B")
+ ("\e$,1<:\e(B" . "\e$,4*J\e(B")
+ ("\e$,1<<\e(B" . "\e$,4*\\e(B")
+ ("\e$,1<<<m\e(B" . "\e$,4)8\e(B")
+ ("\e$,1<>\e(B" . "\e$,4*K\e(B")
+ ("\e$,1<?\e(B" . "\e$,4*L\e(B")
+ ("\e$,1<C\e(B" . "\e$,4*M\e(B")
+ ("\e$,1<D\e(B" . "\e$,4*N\e(B")
+ ("\e$,1<H\e(B" . "\e$,4*O\e(B")
+ ("\e$,1<I\e(B" . "\e$,4*Y\e(B")
+ ("\e$,1<I<m\e(B" . "\e$,4)a\e(B")
+ ("\e$,1<J\e(B" . "\e$,4*P\e(B")
+ ("\e$,1<N\e(B" . "\e$,4*Q\e(B")
+ ("\e$,1<O\e(B" . "\e$,4*R\e(B")
+ ("
\e$,1<P
\e(B" . "
\e$,4*S
\e(B")
+ ("\e$,1<Q\e(B" . "\e$,4*X\e(B")
+ ("\e$,1<R\e(B" . "\e$,4*T\e(B")
+ ("\e$,1<S\e(B" . "\e$,4*W\e(B")
+ ("\e$,1<T\e(B" . "\e$,4*V\e(B")
+ ("\e$,1<U\e(B" . "\e$,4*U\e(B")
+ ("\e$,1<W\e(B" . "\e$,4*[\e(B")
+ ("\e$,1<W<m\e(B" . "\e$,4)7\e(B")
+ ("
\e$,1<W<m<P<`
\e(B" . "
\e$,4*_
\e(B")
+ ("\e$,1<X\e(B" . "\e$,4*Z\e(B")
+ ("\e$,1<X<m\e(B" . "\e$,4)6\e(B")
+ ("\e$,1<Y\e(B" . "\e$,4*]\e(B")
+ ("\e$,1<Y<m\e(B" . "\e$,4)9\e(B")
+
+ ;; Dependent vowel signs
+ ("\e$,1<^\e(B" . "\e$,4)c\e(B")
+ ("\e$,1<_\e(B" . "\e$,4)d\e(B")
+ ("\e$,1<`\e(B" . "\e$,4)f\e(B")
+ ("
\e$,1<a
\e(B" . "
\e$,4)g
\e(B")
+ ("\e$,1<b\e(B" . "\e$,4)h\e(B")
+ ("\e$,1<f\e(B" . "\e$,4)j\e(B")
+ ("\e$,1<g\e(B" . "\e$,4)k\e(B")
+ ("\e$,1<h\e(B" . "\e$,4)l\e(B")
+ ("\e$,1<j\e(B" . "\e$,4)j)c\e(B")
+ ("\e$,1<k\e(B" . "\e$,4)k)c\e(B")
+ ("\e$,1<l\e(B" . "\e$,4)j*W\e(B")
+
+ ;; Various signs
+ ("\e$,1<m\e(B" . "\e$,4)b\e(B")
+ ("\e$,1<w\e(B" . "nil") ;; not supported?
+ ))
+
+(defvar tml-char-glyph-hash
+ (let* ((hash (make-hash-table :test 'equal)))
+ (mapc (function (lambda (x) (puthash (car x) (cdr x) hash)))
+ tml-char-glyph)
+ hash))
+
+(defvar tml-char-glyph-regexp
+ (tamil-regexp-of-hashtbl-keys tml-char-glyph-hash))
+
+;; Tamil languages needed to be reordered.
+
+(defvar tml-consonants-regexp
+ "[\e$,4*H*^*I*J*\*K*L*M*N*O*Y*P*Q*R*S*X*T*W*V*U*[*Z*]\e(B]")
+
+(defvar tml-glyph-reorder-key-glyphs "[\e$,4)j)k)l\e(B]")
+
+(defvar tml-glyph-reordering-regexp-list
+ (cons
+ (concat "\\(" tml-consonants-regexp "\\)\\([\e$,4)j)k)l\e(B]\\)") "\\2\\1"))
+
+;; Tamil vowel modifiers to be ligatured.
+(defvar tml-glyph-glyph
+ '(
+ ("\e$,4*H)d\e(B" . "\e$,4(a\e(B") ; ki
+ ("\e$,4*^)d\e(B" . "\e$,4(v\e(B") ; ksi
+ ("\e$,4*^)f\e(B" . "\e$,4)2\e(B") ; ksi~
+ ("\e$,4*I)d\e(B" . "\e$,4(b\e(B") ; n^i
+ ("\e$,4*J)d\e(B" . "\e$,4(c\e(B") ; ci
+ ("\e$,4*K)d\e(B" . "\e$,4(d\e(B") ; n~i
+ ("\e$,4*L)d\e(B" . "\e$,4)n\e(B") ; t.i
+ ("\e$,4*M)d\e(B" . "\e$,4(e\e(B") ; n.i
+ ("\e$,4*N)d\e(B" . "\e$,4(f\e(B") ; ti
+ ("\e$,4*O)d\e(B" . "\e$,4(g\e(B") ; ni
+ ("\e$,4*P)d\e(B" . "\e$,4(h\e(B") ; pi
+ ("\e$,4*Q)d\e(B" . "\e$,4(i\e(B") ; mi
+ ("\e$,4*R)d\e(B" . "\e$,4(j\e(B") ; yi
+ ("\e$,4*S)d\e(B" . "\e$,4(k\e(B") ; ri
+ ("\e$,4*T)d\e(B" . "\e$,4(l\e(B") ; li
+ ("\e$,4*U)d\e(B" . "\e$,4(m\e(B") ; vi
+ ("\e$,4*V)d\e(B" . "\e$,4(n\e(B") ; l_i
+ ("\e$,4*W)d\e(B" . "\e$,4(o\e(B") ; l.i
+ ("\e$,4*X)d\e(B" . "\e$,4(p\e(B") ; r_i
+ ("\e$,4*Y)d\e(B" . "\e$,4(q\e(B") ; n_i
+ ("\e$,4*Z)d\e(B" . "\e$,4(r\e(B") ; si
+ ("\e$,4*[)d\e(B" . "\e$,4(s\e(B") ; s'i
+ ("\e$,4*\)d\e(B" . "\e$,4(t\e(B") ; ji
+ ("\e$,4*])d\e(B" . "\e$,4(u\e(B") ; hi
+
+ ("\e$,4*H)f\e(B" . "\e$,4(w\e(B") ; ki~
+ ("\e$,4*I)f\e(B" . "\e$,4(x\e(B") ; n^i~
+ ("\e$,4*J)f\e(B" . "\e$,4(y\e(B") ; ci~
+ ("\e$,4*K)f\e(B" . "\e$,4(z\e(B") ; n~i~
+ ("\e$,4*L)f\e(B" . "\e$,4)o\e(B") ; t.i~
+ ("\e$,4*M)f\e(B" . "\e$,4)!\e(B") ; n.i~
+ ("\e$,4*N)f\e(B" . "\e$,4)"\e(B") ; ti~
+ ("\e$,4*O)f\e(B" . "\e$,4)#\e(B") ; ni~
+ ("\e$,4*P)f\e(B" . "\e$,4)$\e(B") ; pi~
+ ("\e$,4*Q)f\e(B" . "\e$,4)%\e(B") ; mi~
+ ("\e$,4*R)f\e(B" . "\e$,4)&\e(B") ; yi~
+ ("\e$,4*S)f\e(B" . "\e$,4)'\e(B") ; ri~
+ ("\e$,4*T)f\e(B" . "\e$,4)(\e(B") ; li~
+ ("\e$,4*U)f\e(B" . "\e$,4))\e(B") ; vi~
+ ("\e$,4*V)f\e(B" . "\e$,4)*\e(B") ; l_i~
+ ("\e$,4*W)f\e(B" . "\e$,4)+\e(B") ; l.i~
+ ("\e$,4*X)f\e(B" . "\e$,4),\e(B") ; r_i~
+ ("\e$,4*Y)f\e(B" . "\e$,4)-\e(B") ; n_i~
+ ("\e$,4*Z)f\e(B" . "\e$,4).\e(B") ; si~
+ ("\e$,4*[)f\e(B" . "\e$,4)/\e(B") ; s'i~
+ ("\e$,4*\)f\e(B" . "\e$,4)0\e(B") ; ji~
+ ("\e$,4*])f\e(B" . "\e$,4)1\e(B") ; hi~
+
+ ("\e$,4*H)g\e(B" . "\e$,4)p\e(B") ; ku
+ ("\e$,4*I)g\e(B" . "\e$,4)q\e(B") ; n^u
+ ("\e$,4*J)g\e(B" . "\e$,4)r\e(B") ; cu
+ ("\e$,4*K)g\e(B" . "\e$,4)s\e(B") ; n~u
+ ("\e$,4*L)g\e(B" . "\e$,4)t\e(B") ; t.u
+ ("\e$,4*M)g\e(B" . "\e$,4)u\e(B") ; n.u
+ ("\e$,4*N)g\e(B" . "\e$,4)v\e(B") ; tu
+ ("\e$,4*O)g\e(B" . "\e$,4)x\e(B") ; nu
+ ("\e$,4*P)g\e(B" . "\e$,4)y\e(B") ; pu
+ ("\e$,4*Q)g\e(B" . "\e$,4)z\e(B") ; mu
+ ("\e$,4*R)g\e(B" . "\e$,4){\e(B") ; yu
+ ("\e$,4*S)g\e(B" . "\e$,4)|\e(B") ; ru
+ ("\e$,4*T)g\e(B" . "\e$,4)}\e(B") ; lu
+ ("\e$,4*U)g\e(B" . "\e$,4)~\e(B") ; vu
+ ("\e$,4*V)g\e(B" . "\e$,4)\7f\e(B") ; l_u
+ ("\e$,4*W)g\e(B" . "\e$,4* \e(B") ; l.u
+ ("\e$,4*X)g\e(B" . "\e$,4*!\e(B") ; r_u
+ ("\e$,4*Y)g\e(B" . "\e$,4*"\e(B") ; n_u
+
+ ("\e$,4*H)h\e(B" . "\e$,4*#\e(B") ; ku~
+ ("\e$,4*I)h\e(B" . "\e$,4*$\e(B") ; n^u~
+ ("\e$,4*J)h\e(B" . "\e$,4*%\e(B") ; cu~
+ ("\e$,4*K)h\e(B" . "\e$,4*&\e(B") ; n~u~
+ ("\e$,4*L)h\e(B" . "\e$,4*'\e(B") ; t.u~
+ ("\e$,4*M)h\e(B" . "\e$,4*(\e(B") ; n.u~
+ ("\e$,4*N)h\e(B" . "\e$,4*)\e(B") ; tu~
+ ("\e$,4*O)h\e(B" . "\e$,4*+\e(B") ; nu~
+ ("\e$,4*P)h\e(B" . "\e$,4*,\e(B") ; pu~
+ ("\e$,4*Q)h\e(B" . "\e$,4*-\e(B") ; mu~
+ ("\e$,4*R)h\e(B" . "\e$,4*.\e(B") ; yu~
+ ("\e$,4*S)h\e(B" . "\e$,4*/\e(B") ; ru~
+ ("\e$,4*T)h\e(B" . "\e$,4*6\e(B") ; lu~
+ ("\e$,4*U)h\e(B" . "\e$,4*7\e(B") ; vu~
+ ("\e$,4*V)h\e(B" . "\e$,4*8\e(B") ; l_u~
+ ("\e$,4*W)h\e(B" . "\e$,4*9\e(B") ; l.u~
+ ("\e$,4*X)h\e(B" . "\e$,4*:\e(B") ; r_u~
+ ("\e$,4*Y)h\e(B" . "\e$,4*;\e(B") ; n_u~
+ ))
+
+(defvar tml-glyph-glyph-hash
+ (let* ((hash (make-hash-table :test 'equal)))
+ (mapc (function (lambda (x) (puthash (car x) (cdr x) hash)))
+ tml-glyph-glyph)
+ hash))
+
+(defvar tml-glyph-glyph-regexp
+ (tamil-regexp-of-hashtbl-keys tml-glyph-glyph-hash))
+
+(defun tamil-compose-syllable-string (string)
+ (with-temp-buffer
+ (insert (decompose-string string))
+ (tamil-compose-syllable-region (point-min) (point-max))
+ (buffer-string)))
+
+(defun tamil-compose-syllable-region (from to)
+ "Compose tamil syllable in region FROM to TO."
+ (let (glyph-str match-str glyph-reorder-regexps)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region from to)
+ (goto-char (point-min))
+ ;; char-glyph-conversion
++ (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)
+ (setq glyph-str
+ (replace-match (cdr tml-glyph-reordering-regexp-list)
+ nil nil glyph-str))))
+ ;; glyph-glyph-conversion
+ (when (string-match tml-glyph-glyph-regexp glyph-str)
+ (setq match-str (match-string 0 glyph-str))
+ (setq glyph-str
+ (replace-match (gethash match-str tml-glyph-glyph-hash)
+ nil nil glyph-str)))
+ ;; concatenate and attach reference-points.
+ (setq glyph-str
+ (cdr
+ (apply
+ 'nconc
+ (mapcar
+ (function
+ (lambda (x) (list '(5 . 3) x))) ;; default ref. point.
+ 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
++ ;; Not yet implemented.
++ nil
++ (goto-char pos)
++ (if (looking-at tamil-composable-pattern)
++ (prog1 (match-end 0)
++ (tamil-compose-syllable-region pos (match-end 0))))))
++
+(provide 'tml-util)
+
+;;; tml-util.el ends here
-;;; utf-8-lang.el --- generic UTF-8 language environment
+;;; utf-8-lang.el --- generic UTF-8 language environment -*- no-byte-compile: t -*-
;; Copyright (C) 2001 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
-;; This file is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
-;; This file is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; 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) 1995 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
++;; Copyright (C) 2003
++;; National Institute of Advanced Industrial Science and Technology (AIST)
++;; Registration Number H13PRO009
;; Keywords: mule, multilingual, Vietnamese
;; Vietnamese uses ASCII characters and additional 134 unique
;; characters (these are Latin alphabets with various diacritical and
-;; tone marks). As far as I know, Vietnamese now has 4 different ways
-;; for representing these characters: VISCII, VSCII, VIQR, and
-;; Unicode. VISCII and VSCII are simple 1-byte code which assigns 134
-;; unique characters in control-code area (0x00..0x1F) and right half
-;; area (0x80..0xFF). VIQR is a menmonic encoding specification
-;; representing diacritical marks by following ASCII characters.
+;; tone marks). As far as I know, Vietnamese now has 5 different ways
+;; for representing these characters: VISCII, TCVN-5712, VPS, VIQR,
+;; and Unicode. VISCII, TCVN-5712 and VPS are simple 1-byte code
+;; which assigns 134 unique characters in control-code area
+;; (0x00..0x1F) and right half area (0x80..0xFF). VIQR is a menmonic
+;; encoding specification representing diacritical marks by following
+;; ASCII characters.
;;; Code:
;;;###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:
;;;###autoload
(defun viet-decode-viqr-region (from to)
- "Convert `VIQR' mnemonics of the current region to Vietnamese characaters.
+ "Convert `VIQR' mnemonics of the current region to Vietnamese characters.
When called from a program, expects two arguments,
positions (integers or markers) specifying the stretch of the region."
(interactive "r")
;;;###autoload
(defun viet-decode-viqr-buffer ()
- "Convert `VIQR' mnemonics of the current buffer to Vietnamese characaters."
+ "Convert `VIQR' mnemonics of the current buffer to Vietnamese characters."
(interactive)
(viet-decode-viqr-region (point-min) (point-max)))
;;;###autoload
(defun viet-encode-viqr-region (from to)
- "Convert Vietnamese characaters of the current region to `VIQR' mnemonics.
+ "Convert Vietnamese characters of the current region to `VIQR' mnemonics.
When called from a program, expects two arguments,
positions (integers or markers) specifying the stretch of the region."
(interactive "r")
;;;###autoload
(defun viet-encode-viqr-buffer ()
- "Convert Vietnamese characaters of the current buffer to `VIQR' mnemonics."
+ "Convert Vietnamese characters of the current buffer to `VIQR' mnemonics."
(interactive)
(viet-encode-viqr-region (point-min) (point-max)))
;;; vietnamese.el --- support for Vietnamese -*- coding: iso-2022-7bit; -*-
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
--;; Licensed to the Free Software Foundation.
++;; Licensed to the Free Software Foundation.
+ ;; Copyright (C) 2002 Free Software Foundation, Inc.
++;; 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.
;;; Commentary:
-;; For Vietnames, the character sets VISCII and VSCII are supported.
+;; For Vietnames, the character sets VISCII, VSCII and TCVN-5712 are
+;; supported.
;;; 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)
(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))
(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)
-
+;; (make-coding-system
+;; 'vietnamese-vps 4 ?p
+;; "8-bit encoding for Vietnamese VPS"
+;; '(ccl-decode-vps . ccl-encode-vps)
+;; '((safe-charsets ascii vietnamese-viscii-lower vietnamese-viscii-upper)
+;; (valid-codes (0 . 255))))
+;;
+;; (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)
- (coding-priority vietnamese-viscii)
++ vietnamese-tcvn vietnamese-viqr windows-1258)
+ (nonascii-translation . viscii)
+ (coding-priority vietnamese-viscii)
(input-method . "vietnamese-viqr")
(unibyte-display . vietnamese-viscii)
(features viet-util)
(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 can use encodings VISCII, VSCII, TCVN-5712, VIQR
+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
++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.")))
++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))
+ (define-coding-system-alias 'tcvn 'vietnamese-tcvn)
(provide 'vietnamese)
;;; loaddefs.el --- automatically extracted autoloads
;;
;;; Code:
-
\f
;;;### (autoloads (5x5-crack 5x5-crack-xor-mutate 5x5-crack-mutating-best
;;;;;; 5x5-crack-mutating-current 5x5-crack-randomly 5x5) "5x5"
-;;;;;; "play/5x5.el" (15391 60707))
+;;;;;; "play/5x5.el" (15941 42963))
;;; Generated autoloads from play/5x5.el
(autoload (quote 5x5) "5x5" "\
5x5 keyboard bindings are:
\\<5x5-mode-map>
-Flip \\[5x5-flip-current]
-Move up \\[5x5-up]
-Move down \\[5x5-down]
-Move left \\[5x5-left]
-Move right \\[5x5-right]
+Flip \\[5x5-flip-current]
+Move up \\[5x5-up]
+Move down \\[5x5-down]
+Move left \\[5x5-left]
+Move right \\[5x5-right]
Start new game \\[5x5-new-game]
New game with random grid \\[5x5-randomize]
Random cracker \\[5x5-crack-randomly]
Mutate current cracker \\[5x5-crack-mutating-current]
Mutate best cracker \\[5x5-crack-mutating-best]
Mutate xor cracker \\[5x5-crack-xor-mutate]
-Quit current game \\[5x5-quit-game]" t nil)
+Quit current game \\[5x5-quit-game]
+
+\(fn &optional SIZE)" t nil)
(autoload (quote 5x5-crack-randomly) "5x5" "\
-Attempt to crack 5x5 using random solutions." t nil)
+Attempt to crack 5x5 using random solutions.
+
+\(fn)" t nil)
(autoload (quote 5x5-crack-mutating-current) "5x5" "\
-Attempt to crack 5x5 by mutating the current solution." t nil)
+Attempt to crack 5x5 by mutating the current solution.
+
+\(fn)" t nil)
(autoload (quote 5x5-crack-mutating-best) "5x5" "\
-Attempt to crack 5x5 by mutating the best solution." t nil)
+Attempt to crack 5x5 by mutating the best solution.
+
+\(fn)" t nil)
(autoload (quote 5x5-crack-xor-mutate) "5x5" "\
Attempt to crack 5x5 by xor the current and best solution.
-Mutate the result." t nil)
+Mutate the result.
+
+\(fn)" t nil)
(autoload (quote 5x5-crack) "5x5" "\
Attempt to find a solution for 5x5.
5x5-crack takes the argument BREEDER which should be a function that takes
two parameters, the first will be a grid vector array that is the current
solution and the second will be the best solution so far. The function
-should return a grid vector array that is the new solution." t nil)
+should return a grid vector array that is the new solution.
+
+\(fn BREEDER)" t nil)
;;;***
\f
;;;### (autoloads (ada-mode ada-add-extensions) "ada-mode" "progmodes/ada-mode.el"
-;;;;;; (15425 28364))
+;;;;;; (16070 35808))
;;; Generated autoloads from progmodes/ada-mode.el
(autoload (quote ada-add-extensions) "ada-mode" "\
Going from body to spec with `ff-find-other-file' used these
extensions.
SPEC and BODY are two regular expressions that must match against the file
-name" nil nil)
+name
+
+\(fn SPEC BODY)" nil nil)
(autoload (quote ada-mode) "ada-mode" "\
Ada mode is the major mode for editing Ada code.
+This version was built on $Date: 2003/05/13 20:48:15 $.
Bindings are as follows: (Note: 'LFD' is control-j.)
+\\{ada-mode-map}
Indent line '\\[ada-tab]'
Indent line, insert newline and indent the new line. '\\[newline-and-indent]'
If you use ada-xref.el:
Goto declaration: '\\[ada-point-and-xref]' on the identifier
or '\\[ada-goto-declaration]' with point on the identifier
- Complete identifier: '\\[ada-complete-identifier]'." t nil)
+ Complete identifier: '\\[ada-complete-identifier]'.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (ada-header) "ada-stmt" "progmodes/ada-stmt.el"
-;;;;;; (15371 46425))
+;;;;;; (16055 8591))
;;; Generated autoloads from progmodes/ada-stmt.el
(autoload (quote ada-header) "ada-stmt" "\
-Insert a descriptive header at the top of the file." t nil)
+Insert a descriptive header at the top of the file.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (ada-find-file) "ada-xref" "progmodes/ada-xref.el"
+;;;;;; (16070 35808))
+;;; Generated autoloads from progmodes/ada-xref.el
+
+(autoload (quote ada-find-file) "ada-xref" "\
+Open a file anywhere in the source path.
+Completion is available.
+
+\(fn FILENAME)" t nil)
;;;***
\f
;;;### (autoloads (change-log-redate change-log-merge add-log-current-defun
;;;;;; change-log-mode add-change-log-entry-other-window add-change-log-entry
;;;;;; find-change-log prompt-for-change-log-name add-log-mailing-address
-;;;;;; add-log-full-name) "add-log" "add-log.el" (15371 46415))
+;;;;;; add-log-full-name add-log-current-defun-function) "add-log"
+;;;;;; "add-log.el" (16111 41824))
;;; Generated autoloads from add-log.el
+(defvar add-log-current-defun-function nil "\
+*If non-nil, function to guess name of surrounding function.
+It is used by `add-log-current-defun' in preference to built-in rules.
+Returns function's name as a string, or nil if outside a function.")
+
+(custom-autoload (quote add-log-current-defun-function) "add-log")
+
(defvar add-log-full-name nil "\
*Full name of user, for inclusion in ChangeLog daily headers.
This defaults to the value returned by the function `user-full-name'.")
+(custom-autoload (quote add-log-full-name) "add-log")
+
(defvar add-log-mailing-address nil "\
-*Electronic mail address of user, for inclusion in ChangeLog daily headers.
-This defaults to the value of `user-mail-address'.")
+*Electronic mail addresses of user, for inclusion in ChangeLog headers.
+This defaults to the value of `user-mail-address'. In addition to
+being a simple string, this value can also be a list. All elements
+will be recognized as referring to the same user; when creating a new
+ChangeLog entry, one element will be chosen at random.")
+
+(custom-autoload (quote add-log-mailing-address) "add-log")
(autoload (quote prompt-for-change-log-name) "add-log" "\
-Prompt for a change log name." nil nil)
+Prompt for a change log name.
+
+\(fn)" nil nil)
(autoload (quote find-change-log) "add-log" "\
Find a change log file for \\[add-change-log-entry] and return the name.
Once a file is found, `change-log-default-name' is set locally in the
current buffer to the complete file name.
-Optional arg BUFFER-FILE overrides `buffer-file-name'." nil nil)
+Optional arg BUFFER-FILE overrides `buffer-file-name'.
+
+\(fn &optional FILE-NAME BUFFER-FILE)" nil nil)
(autoload (quote add-change-log-entry) "add-log" "\
Find change log file, and add an entry for today and an item for this file.
notices.
Today's date is calculated according to `change-log-time-zone-rule' if
-non-nil, otherwise in local time." t nil)
+non-nil, otherwise in local time.
+
+\(fn &optional WHOAMI FILE-NAME OTHER-WINDOW NEW-ENTRY)" t nil)
(autoload (quote add-change-log-entry-other-window) "add-log" "\
Find change log file in other window and add entry and item.
This is just like `add-change-log-entry' except that it displays
-the change log file in another window." t nil)
+the change log file in another window.
+
+\(fn &optional WHOAMI FILE-NAME)" t nil)
(define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
(autoload (quote change-log-mode) "add-log" "\
Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
Each entry behaves as a paragraph, and the entries for one day as a page.
-Runs `change-log-mode-hook'." t nil)
+Runs `change-log-mode-hook'.
+\\{change-log-mode-map}
+
+\(fn)" t nil)
(defvar add-log-lisp-like-modes (quote (emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode)) "\
*Modes that look like Lisp to `add-log-current-defun'.")
point for uppercase headings starting in the first column or
identifiers followed by `:' or `='. See variables
`add-log-current-defun-header-regexp' and
-`add-log-current-defun-function'
+`add-log-current-defun-function'.
-Has a preference of looking backwards." nil nil)
+Has a preference of looking backwards.
+
+\(fn)" nil nil)
(autoload (quote change-log-merge) "add-log" "\
Merge the contents of ChangeLog file OTHER-LOG with this buffer.
Both must be found in Change Log mode (since the merging depends on
-the appropriate motion commands).
+the appropriate motion commands). OTHER-LOG can be either a file name
+or a buffer.
Entries are inserted in chronological order. Both the current and
-old-style time formats for entries are supported." t nil)
+old-style time formats for entries are supported.
+
+\(fn OTHER-LOG)" t nil)
(autoload (quote change-log-redate) "add-log" "\
-Fix any old-style date entries in the current log file to default format." t nil)
+Fix any old-style date entries in the current log file to default format.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (defadvice ad-add-advice ad-default-compilation-action
-;;;;;; ad-redefinition-action) "advice" "emacs-lisp/advice.el" (15391
-;;;;;; 60524))
+;;;;;; ad-redefinition-action) "advice" "emacs-lisp/advice.el" (16066
+;;;;;; 53440))
;;; Generated autoloads from emacs-lisp/advice.el
(defvar ad-redefinition-action (quote warn) "\
it additionally prints a warning message. All other values will be
interpreted as `error'.")
+(custom-autoload (quote ad-redefinition-action) "advice")
+
(defvar ad-default-compilation-action (quote maybe) "\
*Defines whether to compile advised definitions during activation.
A value of `always' will result in unconditional compilation, `never' will
be interpreted as `maybe'. This variable will only be considered if the
COMPILE argument of `ad-activate' was supplied as nil.")
+(custom-autoload (quote ad-default-compilation-action) "advice")
+
(autoload (quote ad-add-advice) "advice" "\
Add a piece of ADVICE to FUNCTION's list of advices in CLASS.
If FUNCTION already has one or more pieces of advice of the specified
will be overwritten with the new one.
If the FUNCTION was not advised already, then its advice info will be
initialized. Redefining a piece of advice whose name is part of the cache-id
-will clear the cache." nil nil)
+will clear the cache.
+
+\(fn FUNCTION ADVICE CLASS POSITION)" nil nil)
(autoload (quote defadvice) "advice" "\
Define a piece of advice for FUNCTION (a symbol).
documentation of the advised function can be dumped onto the `DOC' file
during preloading.
-See Info node `(elisp)Advising Functions' for comprehensive documentation." nil (quote macro))
+See Info node `(elisp)Advising Functions' for comprehensive documentation.
+
+\(fn FUNCTION ARGS &rest BODY)" nil (quote macro))
;;;***
\f
;;;### (autoloads (align-newline-and-indent align-unhighlight-rule
;;;;;; align-highlight-rule align-current align-entire align-regexp
-;;;;;; align) "align" "align.el" (15464 26322))
+;;;;;; align) "align" "align.el" (16111 41824))
;;; Generated autoloads from align.el
(autoload (quote align) "align" "\
RULES and EXCLUDE-RULES, if either is non-nil, will replace the
default rule lists defined in `align-rules-list' and
`align-exclude-rules-list'. See `align-rules-list' for more details
-on the format of these lists." t nil)
+on the format of these lists.
+
+\(fn BEG END &optional SEPARATE RULES EXCLUDE-RULES)" t nil)
(autoload (quote align-regexp) "align" "\
Align the current region using an ad-hoc rule read from the minibuffer.
There is no predefined rule to handle this, but you could easily do it
using a REGEXP like \"(\". All you would have to do is to mark the
-region, call `align-regexp' and type in that regular expression." t nil)
+region, call `align-regexp' and type in that regular expression.
+
+\(fn BEG END REGEXP &optional GROUP SPACING REPEAT)" t nil)
(autoload (quote align-entire) "align" "\
Align the selected region as if it were one alignment section.
BEG and END mark the extent of the region. If RULES or EXCLUDE-RULES
is set to a list of rules (see `align-rules-list'), it can be used to
override the default alignment rules that would have been used to
-align that section." t nil)
+align that section.
+
+\(fn BEG END &optional RULES EXCLUDE-RULES)" t nil)
(autoload (quote align-current) "align" "\
Call `align' on the current alignment section.
so saves you from having to specify the region. If RULES or
EXCLUDE-RULES is set to a list of rules (see `align-rules-list'), it
can be used to override the default alignment rules that would have
-been used to align that section." t nil)
+been used to align that section.
+
+\(fn &optional RULES EXCLUDE-RULES)" t nil)
(autoload (quote align-highlight-rule) "align" "\
Highlight the whitespace which a given rule would have modified.
that should be highlighted. If RULES or EXCLUDE-RULES is set to a
list of rules (see `align-rules-list'), it can be used to override the
default alignment rules that would have been used to identify the text
-to be colored." t nil)
+to be colored.
+
+\(fn BEG END TITLE &optional RULES EXCLUDE-RULES)" t nil)
(autoload (quote align-unhighlight-rule) "align" "\
-Remove any highlighting that was added by `align-highlight-rule'." t nil)
+Remove any highlighting that was added by `align-highlight-rule'.
+
+\(fn)" t nil)
(autoload (quote align-newline-and-indent) "align" "\
-A replacement function for `newline-and-indent', aligning as it goes." t nil)
+A replacement function for `newline-and-indent', aligning as it goes.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (allout-init) "allout" "allout.el" (16066 53439))
+;;; Generated autoloads from allout.el
+
+(autoload (quote allout-init) "allout" "\
+Prime `allout-mode' to enable/disable auto-activation, wrt `allout-layout'.
+
+MODE is one of the following symbols:
+
+ - nil (or no argument) deactivate auto-activation/layout;
+ - `activate', enable auto-activation only;
+ - `ask', enable auto-activation, and enable auto-layout but with
+ confirmation for layout operation solicited from user each time;
+ - `report', just report and return the current auto-activation state;
+ - anything else (eg, t) for auto-activation and auto-layout, without
+ any confirmation check.
+
+Use this function to setup your emacs session for automatic activation
+of allout outline mode, contingent to the buffer-specific setting of
+the `allout-layout' variable. (See `allout-layout' and
+`allout-expose-topic' docstrings for more details on auto layout).
+
+`allout-init' works by setting up (or removing)
+`allout-find-file-hook' in `find-file-hooks', and giving
+`allout-auto-activation' a suitable setting.
+
+To prime your emacs session for full auto-outline operation, include
+the following two lines in your emacs init file:
+
+\(require 'allout)
+\(allout-init t)
+
+\(fn &optional MODE)" t nil)
;;;***
\f
;;;### (autoloads (ange-ftp-hook-function ange-ftp-reread-dir) "ange-ftp"
-;;;;;; "net/ange-ftp.el" (15464 26331))
+;;;;;; "net/ange-ftp.el" (16139 21086))
;;; Generated autoloads from net/ange-ftp.el
- (defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir)
+
+(defalias (quote ange-ftp-re-read-dir) (quote ange-ftp-reread-dir))
(autoload (quote ange-ftp-reread-dir) "ange-ftp" "\
Reread remote directory DIR to update the directory cache.
The implementation of remote ftp file names caches directory contents
for speed. Therefore, when new remote files are created, Emacs
may not know they exist. You can use this command to reread a specific
-directory, so that Emacs will know its current contents." t nil)
+directory, so that Emacs will know its current contents.
-(autoload (quote ange-ftp-hook-function) "ange-ftp" nil nil nil)
+\(fn &optional DIR)" t nil)
-(or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist) (setq file-name-handler-alist (cons (quote ("^/[^/:]*[^/:.]:" . ange-ftp-hook-function)) file-name-handler-alist)))
+(autoload (quote ange-ftp-hook-function) "ange-ftp" "\
+Not documented
-(or (assoc "^/[^/:]*\\'" file-name-handler-alist) (setq file-name-handler-alist (cons (quote ("^/[^/:]*\\'" . ange-ftp-completion-hook-function)) file-name-handler-alist)))
+\(fn OPERATION &rest ARGS)" nil nil)
+
+(put (quote ange-ftp-hook-function) (quote file-remote-p) t)
;;;***
\f
;;;### (autoloads (animate-birthday-present animate-sequence animate-string)
-;;;;;; "animate" "play/animate.el" (15371 46425))
+;;;;;; "animate" "play/animate.el" (15941 42963))
;;; Generated autoloads from play/animate.el
(autoload (quote animate-string) "animate" "\
and all slide in parallel to their final positions,
passing through `animate-n-steps' positions before the final ones.
If HPOS is nil (or omitted), center the string horizontally
-in the current window." nil nil)
+in the current window.
+
+\(fn STRING VPOS &optional HPOS)" nil nil)
(autoload (quote animate-sequence) "animate" "\
Display strings from LIST-OF-STRING with animation in a new buffer.
-Strings will be separated from each other by SPACE lines." nil nil)
+Strings will be separated from each other by SPACE lines.
+
+\(fn LIST-OF-STRINGS SPACE)" nil nil)
(autoload (quote animate-birthday-present) "animate" "\
-Display Sarah's birthday present in a new buffer." t nil)
+Display Sarah's birthday present in a new buffer.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (ansi-color-process-output ansi-color-for-comint-mode-on)
-;;;;;; "ansi-color" "ansi-color.el" (15391 60505))
+;;;;;; "ansi-color" "ansi-color.el" (16111 41824))
;;; Generated autoloads from ansi-color.el
(autoload (quote ansi-color-for-comint-mode-on) "ansi-color" "\
-Set `ansi-color-for-comint-mode' to t." t nil)
+Set `ansi-color-for-comint-mode' to t.
+
+\(fn)" t nil)
(autoload (quote ansi-color-process-output) "ansi-color" "\
Maybe translate SGR control sequences of comint output into text-properties.
The comint output is assumed to lie between the marker
`comint-last-output-start' and the process-mark.
-This is a good function to put in `comint-output-filter-functions'." nil nil)
+This is a good function to put in `comint-output-filter-functions'.
+
+\(fn STRING)" nil nil)
;;;***
\f
;;;### (autoloads (antlr-set-tabs antlr-mode antlr-show-makefile-rules)
-;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (15417 7450))
+;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (15941 42963))
;;; Generated autoloads from progmodes/antlr-mode.el
(autoload (quote antlr-show-makefile-rules) "antlr-mode" "\
If the file for a super-grammar cannot be determined, special file names
are used according to variable `antlr-unknown-file-formats' and a
commentary with value `antlr-help-unknown-file-text' is added. The
-*Help* buffer always starts with the text in `antlr-help-rules-intro'." t nil)
+*Help* buffer always starts with the text in `antlr-help-rules-intro'.
+
+\(fn)" t nil)
(autoload (quote antlr-mode) "antlr-mode" "\
Major mode for editing ANTLR grammar files.
-\\{antlr-mode-map}" t nil)
+\\{antlr-mode-map}
+
+\(fn)" t nil)
(autoload (quote antlr-set-tabs) "antlr-mode" "\
Use ANTLR's convention for TABs according to `antlr-tab-offset-alist'.
-Used in `antlr-mode'. Also a useful function in `java-mode-hook'." nil nil)
+Used in `antlr-mode'. Also a useful function in `java-mode-hook'.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (appt-make-list appt-delete appt-add appt-display-diary
;;;;;; appt-display-duration appt-msg-window appt-display-mode-line
;;;;;; appt-visible appt-audible appt-message-warning-time appt-issue-message)
-;;;;;; "appt" "calendar/appt.el" (15391 60522))
+;;;;;; "appt" "calendar/appt.el" (15941 42957))
;;; Generated autoloads from calendar/appt.el
(defvar appt-issue-message t "\
To be detected, the diary entry must have the time
as the first thing on a line.")
+(custom-autoload (quote appt-issue-message) "appt")
+
(defvar appt-message-warning-time 12 "\
*Time in minutes before an appointment that the warning begins.")
+(custom-autoload (quote appt-message-warning-time) "appt")
+
(defvar appt-audible t "\
*Non-nil means beep to indicate appointment.")
+(custom-autoload (quote appt-audible) "appt")
+
(defvar appt-visible t "\
*Non-nil means display appointment message in echo area.")
+(custom-autoload (quote appt-visible) "appt")
+
(defvar appt-display-mode-line t "\
*Non-nil means display minutes to appointment and time on the mode line.")
+(custom-autoload (quote appt-display-mode-line) "appt")
+
(defvar appt-msg-window t "\
*Non-nil means display appointment message in another window.")
+(custom-autoload (quote appt-msg-window) "appt")
+
(defvar appt-display-duration 10 "\
*The number of seconds an appointment message is displayed.")
+(custom-autoload (quote appt-display-duration) "appt")
+
(defvar appt-display-diary t "\
-*Non-nil means to display the next days diary on the screen.
+*Non-nil means to display the next days diary on the screen.
This will occur at midnight when the appointment list is updated.")
+(custom-autoload (quote appt-display-diary) "appt")
+
(autoload (quote appt-add) "appt" "\
Add an appointment for the day at NEW-APPT-TIME and issue message NEW-APPT-MSG.
-The time should be in either 24 hour format or am/pm format." t nil)
+The time should be in either 24 hour format or am/pm format.
+
+\(fn NEW-APPT-TIME NEW-APPT-MSG)" t nil)
(autoload (quote appt-delete) "appt" "\
-Delete an appointment from the list of appointments." t nil)
+Delete an appointment from the list of appointments.
+
+\(fn)" t nil)
(autoload (quote appt-make-list) "appt" "\
Create the appointments list from todays diary buffer.
10:00am group meeting
We assume that the variables DATE and NUMBER
hold the arguments that `list-diary-entries' received.
-They specify the range of dates that the diary is being processed for." nil nil)
+They specify the range of dates that the diary is being processed for.
+
+\(fn)" nil nil)
;;;***
\f
-;;;### (autoloads (apropos-documentation apropos-value apropos apropos-command
-;;;;;; apropos-variable apropos-mode) "apropos" "apropos.el" (15425
-;;;;;; 28360))
+;;;### (autoloads (apropos-documentation apropos-value apropos apropos-documentation-property
+;;;;;; apropos-command apropos-variable apropos-mode) "apropos"
+;;;;;; "apropos.el" (16174 61084))
;;; Generated autoloads from apropos.el
(autoload (quote apropos-mode) "apropos" "\
Major mode for following hyperlinks in output of apropos commands.
-\\{apropos-mode-map}" t nil)
+\\{apropos-mode-map}
+
+\(fn)" t nil)
(autoload (quote apropos-variable) "apropos" "\
Show user variables that match REGEXP.
With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also show
-normal variables." t nil)
+normal variables.
+
+\(fn REGEXP &optional DO-ALL)" t nil)
-(fset (quote command-apropos) (quote apropos-command))
+(defalias (quote command-apropos) (quote apropos-command))
(autoload (quote apropos-command) "apropos" "\
Show commands (interactively callable functions) that match APROPOS-REGEXP.
noninteractive functions.
If VAR-PREDICATE is non-nil, show only variables, and only those that
-satisfy the predicate VAR-PREDICATE." t nil)
+satisfy the predicate VAR-PREDICATE.
+
+\(fn APROPOS-REGEXP &optional DO-ALL VAR-PREDICATE)" t nil)
+
+(autoload (quote apropos-documentation-property) "apropos" "\
+Like (documentation-property SYMBOL PROPERTY RAW) but handle errors.
+
+\(fn SYMBOL PROPERTY RAW)" nil nil)
(autoload (quote apropos) "apropos" "\
Show all bound symbols whose names match APROPOS-REGEXP.
With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also
show unbound symbols and key bindings, which is a little more
-time-consuming. Returns list of symbols and documentation found." t nil)
+time-consuming. Returns list of symbols and documentation found.
+
+\(fn APROPOS-REGEXP &optional DO-ALL)" t nil)
(autoload (quote apropos-value) "apropos" "\
Show all symbols whose value's printed image matches APROPOS-REGEXP.
With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also looks
at the function and at the names and values of properties.
-Returns list of symbols and values found." t nil)
+Returns list of symbols and values found.
+
+\(fn APROPOS-REGEXP &optional DO-ALL)" t nil)
(autoload (quote apropos-documentation) "apropos" "\
Show symbols whose documentation contain matches for APROPOS-REGEXP.
With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also use
documentation that is not stored in the documentation file and show key
bindings.
-Returns list of symbols and documentation found." t nil)
+Returns list of symbols and documentation found.
+
+\(fn APROPOS-REGEXP &optional DO-ALL)" t nil)
;;;***
\f
- ;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (16111
- ;;;;;; 41824))
-;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (15427
-;;;;;; 61500))
++;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (16205
++;;;;;; 24895))
;;; Generated autoloads from arc-mode.el
(autoload (quote archive-mode) "arc-mode" "\
save it, the contents of that buffer will be saved back into the
archive.
-\\{archive-mode-map}" nil nil)
+\\{archive-mode-map}
+
+\(fn &optional FORCE)" nil nil)
;;;***
\f
-;;;### (autoloads (array-mode) "array" "array.el" (15427 61500))
+;;;### (autoloads (array-mode) "array" "array.el" (15941 42951))
;;; Generated autoloads from array.el
(autoload (quote array-mode) "array" "\
\\[array-display-local-variables] Display the current values of local variables.
-Entering array mode calls the function `array-mode-hook'." t nil)
+Entering array mode calls the function `array-mode-hook'.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (artist-mode) "artist" "textmodes/artist.el" (15427
-;;;;;; 61509))
+;;;### (autoloads (artist-mode) "artist" "textmodes/artist.el" (16162
+;;;;;; 11943))
;;; Generated autoloads from textmodes/artist.el
(autoload (quote artist-mode) "artist" "\
Keymap summary
-\\{artist-mode-map}" t nil)
+\\{artist-mode-map}
+
+\(fn &optional STATE)" t nil)
;;;***
\f
-;;;### (autoloads (asm-mode) "asm-mode" "progmodes/asm-mode.el" (15371
-;;;;;; 46426))
+;;;### (autoloads (asm-mode) "asm-mode" "progmodes/asm-mode.el" (16131
+;;;;;; 19792))
;;; Generated autoloads from progmodes/asm-mode.el
(autoload (quote asm-mode) "asm-mode" "\
Special commands:
\\{asm-mode-map}
-" t nil)
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (auto-show-mode auto-show-mode) "auto-show" "obsolete/auto-show.el"
-;;;;;; (15371 46425))
+;;;;;; (15941 42963))
;;; Generated autoloads from obsolete/auto-show.el
(defvar auto-show-mode nil "\
Obsolete.")
+(custom-autoload (quote auto-show-mode) "auto-show")
+
(autoload (quote auto-show-mode) "auto-show" "\
-This command is obsolete." t nil)
+This command is obsolete.
+
+\(fn ARG)" t nil)
;;;***
\f
;;;### (autoloads (autoarg-kp-mode autoarg-mode) "autoarg" "autoarg.el"
-;;;;;; (15371 46415))
+;;;;;; (15856 53268))
;;; Generated autoloads from autoarg.el
(defvar autoarg-mode nil "\
Setting this variable directly does not take effect;
use either \\[customize] or the function `autoarg-mode'.")
-(custom-add-to-group (quote autoarg) (quote autoarg-mode) (quote custom-variable))
-
-(custom-add-load (quote autoarg-mode) (quote autoarg))
+(custom-autoload (quote autoarg-mode) "autoarg")
(autoload (quote autoarg-mode) "autoarg" "\
Toggle Autoarg minor mode globally.
then invokes the normal binding of \\[autoarg-terminate].
`C-u \\[autoarg-terminate]' invokes the normal binding of \\[autoarg-terminate] four times.
-\\{autoarg-mode-map}" t nil)
+\\{autoarg-mode-map}
+
+\(fn &optional ARG)" t nil)
(defvar autoarg-kp-mode nil "\
Non-nil if Autoarg-Kp mode is enabled.
Setting this variable directly does not take effect;
use either \\[customize] or the function `autoarg-kp-mode'.")
-(custom-add-to-group (quote autoarg-kp) (quote autoarg-kp-mode) (quote custom-variable))
-
-(custom-add-load (quote autoarg-kp-mode) (quote autoarg))
+(custom-autoload (quote autoarg-kp-mode) "autoarg")
(autoload (quote autoarg-kp-mode) "autoarg" "\
Toggle Autoarg-KP minor mode globally.
This is similar to \\[autoarg-mode] but rebinds the keypad keys `kp-1'
&c to supply digit arguments.
-\\{autoarg-kp-mode-map}" t nil)
+\\{autoarg-kp-mode-map}
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (autoconf-mode) "autoconf" "progmodes/autoconf.el"
-;;;;;; (15371 46426))
+;;;;;; (16070 35808))
;;; Generated autoloads from progmodes/autoconf.el
(autoload (quote autoconf-mode) "autoconf" "\
-Major mode for editing Autoconf configure.in files." t nil)
+Major mode for editing Autoconf configure.in files.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (auto-insert-mode define-auto-insert auto-insert)
-;;;;;; "autoinsert" "autoinsert.el" (15400 1471))
+;;;;;; "autoinsert" "autoinsert.el" (15941 42951))
;;; Generated autoloads from autoinsert.el
(autoload (quote auto-insert) "autoinsert" "\
Insert default contents into new files if variable `auto-insert' is non-nil.
-Matches the visited file name against the elements of `auto-insert-alist'." t nil)
+Matches the visited file name against the elements of `auto-insert-alist'.
+
+\(fn)" t nil)
(autoload (quote define-auto-insert) "autoinsert" "\
Associate CONDITION with (additional) ACTION in `auto-insert-alist'.
Optional AFTER means to insert action after all existing actions for CONDITION,
-or if CONDITION had no actions, after all other CONDITIONs." nil nil)
+or if CONDITION had no actions, after all other CONDITIONs.
+
+\(fn CONDITION ACTION &optional AFTER)" nil nil)
(defvar auto-insert-mode nil "\
Non-nil if Auto-Insert mode is enabled.
Setting this variable directly does not take effect;
use either \\[customize] or the function `auto-insert-mode'.")
-(custom-add-to-group (quote auto-insert) (quote auto-insert-mode) (quote custom-variable))
-
-(custom-add-load (quote auto-insert-mode) (quote autoinsert))
+(custom-autoload (quote auto-insert-mode) "autoinsert")
(autoload (quote auto-insert-mode) "autoinsert" "\
Toggle Auto-insert mode.
Returns the new status of Auto-insert mode (non-nil means on).
When Auto-insert mode is enabled, when new files are created you can
-insert a template for the file depending on the mode of the buffer." t nil)
+insert a template for the file depending on the mode of the buffer.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
-;;;### (autoloads (batch-update-autoloads update-autoloads-from-directories
+;;;### (autoloads (batch-update-autoloads update-directory-autoloads
;;;;;; update-file-autoloads) "autoload" "emacs-lisp/autoload.el"
-;;;;;; (15441 20092))
+;;;;;; (16072 11522))
;;; Generated autoloads from emacs-lisp/autoload.el
(autoload (quote update-file-autoloads) "autoload" "\
Update the autoloads for FILE in `generated-autoload-file'
\(which FILE might bind in its local variables).
-Return FILE if there was no autoload cookie in it." t nil)
+Return FILE if there was no autoload cookie in it.
+
+\(fn FILE)" t nil)
-(autoload (quote update-autoloads-from-directories) "autoload" "\
+(autoload (quote update-directory-autoloads) "autoload" "\
Update loaddefs.el with all the current autoloads from DIRS, and no old ones.
-This uses `update-file-autoloads' (which see) do its work." t nil)
+This uses `update-file-autoloads' (which see) do its work.
+In an interactive call, you must give one argument, the name
+of a single directory. In a call from Lisp, you can supply multiple
+directories as separate arguments, but this usage is discouraged.
+
+The function does NOT recursively descend into subdirectories of the
+directory or directories specified.
+
+\(fn &rest DIRS)" t nil)
(autoload (quote batch-update-autoloads) "autoload" "\
Update loaddefs.el autoloads in batch mode.
-Calls `update-autoloads-from-directories' on the command line arguments." nil nil)
+Calls `update-directory-autoloads' on the command line arguments.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (global-auto-revert-mode turn-on-auto-revert-mode
-;;;;;; auto-revert-mode global-auto-revert-mode) "autorevert" "autorevert.el"
-;;;;;; (15371 46415))
+;;;;;; auto-revert-mode) "autorevert" "autorevert.el" (15538 43199))
;;; Generated autoloads from autorevert.el
(defvar auto-revert-mode nil "\
*Non-nil when Auto-Revert Mode is active.
-
-Never set this variable directly, use the command `auto-revert-mode'
-instead.")
-
-(defvar global-auto-revert-mode nil "\
-When on, buffers are automatically reverted when files on disk change.
-
-Set this variable using \\[customize] only. Otherwise, use the
-command `global-auto-revert-mode'.")
-
-(custom-add-to-group (quote auto-revert) (quote global-auto-revert-mode) (quote custom-variable))
-
-(custom-add-load (quote global-auto-revert-mode) (quote autorevert))
+Never set this variable directly, use the command `auto-revert-mode' instead.")
(autoload (quote auto-revert-mode) "autorevert" "\
Toggle reverting buffer when file on disk changes.
With arg, turn Auto Revert mode on if and only if arg is positive.
This is a minor mode that affects only the current buffer.
-Use `global-auto-revert-mode' to automatically revert all buffers." t nil)
+Use `global-auto-revert-mode' to automatically revert all buffers.
+
+\(fn &optional ARG)" t nil)
(autoload (quote turn-on-auto-revert-mode) "autorevert" "\
Turn on Auto-Revert Mode.
This function is designed to be added to hooks, for example:
- (add-hook 'c-mode-hook 'turn-on-auto-revert-mode)" nil nil)
+ (add-hook 'c-mode-hook 'turn-on-auto-revert-mode)
+
+\(fn)" nil nil)
+
+(defvar global-auto-revert-mode nil "\
+Non-nil if Global-Auto-Revert mode is enabled.
+See the command `global-auto-revert-mode' for a description of this minor-mode.
+Setting this variable directly does not take effect;
+use either \\[customize] or the function `global-auto-revert-mode'.")
+
+(custom-autoload (quote global-auto-revert-mode) "autorevert")
(autoload (quote global-auto-revert-mode) "autorevert" "\
Revert any buffer when file on disk change.
With arg, turn Auto Revert mode on globally if and only if arg is positive.
This is a minor mode that affects all buffers.
-Use `auto-revert-mode' to revert a particular buffer." t nil)
+Use `auto-revert-mode' to revert a particular buffer.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (mouse-avoidance-mode mouse-avoidance-mode) "avoid"
-;;;;;; "avoid.el" (15371 46415))
+;;;;;; "avoid.el" (15198 32214))
;;; Generated autoloads from avoid.el
(defvar mouse-avoidance-mode nil "\
Setting this variable directly does not take effect;
use either \\[customize] or the function `mouse-avoidance-mode'.")
-(custom-add-to-group (quote avoid) (quote mouse-avoidance-mode) (quote custom-variable))
-
-(custom-add-load (quote mouse-avoidance-mode) (quote avoid))
+(custom-autoload (quote mouse-avoidance-mode) "avoid")
(autoload (quote mouse-avoidance-mode) "avoid" "\
Set cursor avoidance mode to MODE.
\(see `mouse-avoidance-threshold' for definition of \"too close\",
and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for
-definition of \"random distance\".)" t nil)
-
-;;;***
-\f
-;;;### (autoloads (awk-mode) "awk-mode" "progmodes/awk-mode.el" (15371
-;;;;;; 46426))
-;;; Generated autoloads from progmodes/awk-mode.el
+definition of \"random distance\".)
-(autoload (quote awk-mode) "awk-mode" "\
-Major mode for editing AWK code.
-This is much like C mode except for the syntax of comments. Its keymap
-inherits from C mode's and it has the same variables for customizing
-indentation. It has its own abbrev table and its own syntax table.
-
-Turning on AWK mode runs `awk-mode-hook'." t nil)
+\(fn &optional MODE)" t nil)
;;;***
\f
;;;### (autoloads (backquote) "backquote" "emacs-lisp/backquote.el"
-;;;;;; (15371 46419))
+;;;;;; (15941 42958))
;;; Generated autoloads from emacs-lisp/backquote.el
(autoload (quote backquote) "backquote" "\
`(a ,b c) => (a (ba bb bc) c) ; insert the value of b
`(a ,@b c) => (a ba bb bc c) ; splice in the value of b
-Vectors work just like lists. Nested backquotes are permitted." nil (quote macro))
+Vectors work just like lists. Nested backquotes are permitted.
+
+\(fn ARG)" nil (quote macro))
(defalias (quote \`) (symbol-function (quote backquote)))
;;;***
\f
;;;### (autoloads (display-battery battery) "battery" "battery.el"
-;;;;;; (15391 60505))
+;;;;;; (15380 36786))
;;; Generated autoloads from battery.el
(autoload (quote battery) "battery" "\
Display battery status information in the echo area.
The text being displayed in the echo area is controlled by the variables
-`battery-echo-area-format' and `battery-status-function'." t nil)
+`battery-echo-area-format' and `battery-status-function'.
+
+\(fn)" t nil)
(autoload (quote display-battery) "battery" "\
Display battery status information in the mode line.
The text being displayed in the mode line is controlled by the variables
`battery-mode-line-format' and `battery-status-function'.
The mode line will be updated automatically every `battery-update-interval'
-seconds." t nil)
+seconds.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (benchmark benchmark-run-compiled benchmark-run)
+;;;;;; "benchmark" "emacs-lisp/benchmark.el" (15934 33472))
+;;; Generated autoloads from emacs-lisp/benchmark.el
+
+(autoload (quote benchmark-run) "benchmark" "\
+Time execution of FORMS.
+If REPETITIONS is supplied as a number, run forms that many times,
+accounting for the overhead of the resulting loop. Otherwise run
+FORMS once.
+Return a list of the total elapsed time for execution, the number of
+garbage collections that ran, and the time taken by garbage collection.
+See also `benchmark-run-compiled'.
+
+\(fn &optional REPETITIONS &rest FORMS)" nil (quote macro))
+
+(autoload (quote benchmark-run-compiled) "benchmark" "\
+Time execution of compiled version of FORMS.
+This is like `benchmark-run', but what is timed is a funcall of the
+byte code obtained by wrapping FORMS in a `lambda' and compiling the
+result. The overhead of the `lambda's is accounted for.
+
+\(fn &optional REPETITIONS &rest FORMS)" nil (quote macro))
+
+(autoload (quote benchmark) "benchmark" "\
+Print the time taken for REPETITIONS executions of FORM.
+Interactively, REPETITIONS is taken from the prefix arg. For
+non-interactive use see also `benchmark-run' and
+`benchmark-run-compiled'.
+
+\(fn REPETITIONS FORM)" t nil)
;;;***
\f
-;;;### (autoloads (bibtex-mode) "bibtex" "textmodes/bibtex.el" (15474
-;;;;;; 13619))
+;;;### (autoloads (bibtex-mode) "bibtex" "textmodes/bibtex.el" (16136
+;;;;;; 53059))
;;; Generated autoloads from textmodes/bibtex.el
(autoload (quote bibtex-mode) "bibtex" "\
Major mode for editing BibTeX files.
-To submit a problem report, enter \\[bibtex-submit-bug-report] from a
-BibTeX mode buffer. This automatically sets up a mail buffer with
-version information already added. You just need to add a description
-of the problem, including a reproducable test case and send the
-message.
-
-
General information on working with BibTeX mode:
-You should use commands as \\[bibtex-Book] to get a template for a
+You should use commands such as \\[bibtex-Book] to get a template for a
specific entry. You should then fill in all desired fields using
\\[bibtex-next-field] to jump from field to field. After having filled
in all desired fields in the entry, you should clean the new entry
-with command \\[bibtex-clean-entry].
+with the command \\[bibtex-clean-entry].
-Some features of BibTeX mode are available only by setting variable
-bibtex-maintain-sorted-entries to t. However, then BibTeX mode will
-work with buffer containing only valid (syntactical correct) entries
+Some features of BibTeX mode are available only by setting the variable
+`bibtex-maintain-sorted-entries' to non-nil. However, then BibTeX mode will
+work only with buffers containing valid (syntactical correct) entries
and with entries being sorted. This is usually the case, if you have
created a buffer completely with BibTeX mode and finished every new
entry with \\[bibtex-clean-entry].
-For third party BibTeX buffers, please call the function
-`bibtex-convert-alien' to fully take advantage of all features of
-BibTeX mode.
+For third party BibTeX files, call the function `bibtex-convert-alien'
+to fully take advantage of all features of BibTeX mode.
Special information:
The OPT or ALT string may be removed from a field with \\[bibtex-remove-OPT-or-ALT].
\\[bibtex-make-field] inserts a new field after the current one.
\\[bibtex-kill-field] kills the current field entirely.
-\\[bibtex-yank] will yank the last recently killed field after the
-current field.
+\\[bibtex-yank] yanks the last recently killed field after the current field.
\\[bibtex-remove-delimiters] removes the double-quotes or braces around the text of the current field.
\\[bibtex-empty-field] replaces the text of the current field with the default \"\" or {}.
The command \\[bibtex-clean-entry] cleans the current entry, i.e. it removes OPT/ALT
from all non-empty optional or alternative fields, checks that no required
fields are empty, and does some formatting dependent on the value of
-bibtex-entry-format.
+`bibtex-entry-format'.
Note: some functions in BibTeX mode depend on entries being in a special
format (all fields beginning on separate lines), so it is usually a bad
-idea to remove `realign' from bibtex-entry-format.
+idea to remove `realign' from `bibtex-entry-format'.
Use \\[bibtex-find-text] to position the cursor at the end of the current field.
Use \\[bibtex-next-field] to move to end of the next field.
The following may be of interest as well:
Functions:
- bibtex-entry
- bibtex-kill-entry
- bibtex-yank-pop
- bibtex-pop-previous
- bibtex-pop-next
- bibtex-complete-string
- bibtex-complete-key
- bibtex-print-help-message
- bibtex-generate-autokey
- bibtex-beginning-of-entry
- bibtex-end-of-entry
- bibtex-reposition-window
- bibtex-mark-entry
- bibtex-ispell-abstract
- bibtex-ispell-entry
- bibtex-narrow-to-entry
- bibtex-sort-buffer
- bibtex-validate
- bibtex-count
- bibtex-fill-entry
- bibtex-reformat
- bibtex-convert-alien
+ `bibtex-entry'
+ `bibtex-kill-entry'
+ `bibtex-yank-pop'
+ `bibtex-pop-previous'
+ `bibtex-pop-next'
+ `bibtex-complete'
+ `bibtex-print-help-message'
+ `bibtex-generate-autokey'
+ `bibtex-beginning-of-entry'
+ `bibtex-end-of-entry'
+ `bibtex-reposition-window'
+ `bibtex-mark-entry'
+ `bibtex-ispell-abstract'
+ `bibtex-ispell-entry'
+ `bibtex-narrow-to-entry'
+ `bibtex-sort-buffer'
+ `bibtex-validate'
+ `bibtex-count'
+ `bibtex-fill-entry'
+ `bibtex-reformat'
+ `bibtex-convert-alien'
Variables:
- bibtex-field-delimiters
- bibtex-include-OPTcrossref
- bibtex-include-OPTkey
- bibtex-user-optional-fields
- bibtex-entry-format
- bibtex-sort-ignore-string-entries
- bibtex-maintain-sorted-entries
- bibtex-entry-field-alist
- bibtex-predefined-strings
- bibtex-string-files
+ `bibtex-field-delimiters'
+ `bibtex-include-OPTcrossref'
+ `bibtex-include-OPTkey'
+ `bibtex-user-optional-fields'
+ `bibtex-entry-format'
+ `bibtex-sort-ignore-string-entries'
+ `bibtex-maintain-sorted-entries'
+ `bibtex-entry-field-alist'
+ `bibtex-predefined-strings'
+ `bibtex-string-files'
---------------------------------------------------------
Entry to BibTeX mode calls the value of `bibtex-mode-hook' if that value is
non-nil.
-\\{bibtex-mode-map}" t nil)
+\\{bibtex-mode-map}
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads nil "binhex" "gnus/binhex.el" (15464 26329))
+;;;### (autoloads nil "binhex" "gnus/binhex.el" (15856 53273))
;;; Generated autoloads from gnus/binhex.el
(defconst binhex-begin-line "^:...............................................................$")
;;;***
\f
-;;;### (autoloads (blackbox) "blackbox" "play/blackbox.el" (15400
-;;;;;; 1479))
+;;;### (autoloads (blackbox) "blackbox" "play/blackbox.el" (15941
+;;;;;; 42963))
;;; Generated autoloads from play/blackbox.el
(autoload (quote blackbox) "blackbox" "\
Note carefully the relative positions of the ball and the ninety
degree deflection it causes.
- 1
- - * - - - - - - - - - - - - - - - - - - - - - -
- - * - - - - - - - - - - - - - - - - - - - - - -
-1 * * - - - - - - - - - - - - - - - O - - - - O -
+ 1
+ - * - - - - - - - - - - - - - - - - - - - - - -
+ - * - - - - - - - - - - - - - - - - - - - - - -
+1 * * - - - - - - - - - - - - - - - O - - - - O -
- - O - - - - - - - O - - - - - - - * * * * - -
- - - - - - - - - - - * * * * * 2 3 * * * - - * - -
- - - - - - - - - - - - * - - - - - - - O - * - -
- - - - - - - - - - - - * - - - - - - - - * * - -
- - - - - - - - - - - - * - - - - - - - - * - O -
+ - - - - - - - - - - - * - - - - - - - O - * - -
+ - - - - - - - - - - - * - - - - - - - - * * - -
+ - - - - - - - - - - - * - - - - - - - - * - O -
2 3
As mentioned above, a reflection occurs when a ray emerges from the same point
it was sent in. This can happen in several ways:
-
+
- - - - - - - - - - - - - - - - - - - - - - - -
- - - - O - - - - - O - O - - - - - - - - - - -
R * * * * - - - - - - - * - - - - O - - - - - - -
- - - - - - - - - - - - - - - - - - - - - - - -
Be sure to compare the second example of a hit with the first example of
-a reflection." t nil)
+a reflection.
+
+\(fn NUM)" t nil)
;;;***
\f
;;;;;; bookmark-load bookmark-save bookmark-write bookmark-delete
;;;;;; bookmark-insert bookmark-rename bookmark-insert-location
;;;;;; bookmark-relocate bookmark-jump bookmark-set) "bookmark"
-;;;;;; "bookmark.el" (15400 1471))
+;;;;;; "bookmark.el" (16174 61084))
;;; Generated autoloads from bookmark.el
(define-key ctl-x-map "rb" 'bookmark-jump)
(define-key ctl-x-map "rm" 'bookmark-set)
so that you have a bookmark prefix, just use `global-set-key' and bind a
key of your choice to `bookmark-map'. All interactive bookmark
functions have a binding in this keymap.")
-
-(define-prefix-command (quote bookmark-map))
-
-(define-key bookmark-map "x" (quote bookmark-set))
-
-(define-key bookmark-map "m" (quote bookmark-set))
-
-(define-key bookmark-map "j" (quote bookmark-jump))
-
-(define-key bookmark-map "g" (quote bookmark-jump))
-
-(define-key bookmark-map "i" (quote bookmark-insert))
-
-(define-key bookmark-map "e" (quote edit-bookmarks))
-
-(define-key bookmark-map "f" (quote bookmark-insert-location))
-
-(define-key bookmark-map "r" (quote bookmark-rename))
-
-(define-key bookmark-map "d" (quote bookmark-delete))
-
-(define-key bookmark-map "l" (quote bookmark-load))
-
-(define-key bookmark-map "w" (quote bookmark-write))
-
-(define-key bookmark-map "s" (quote bookmark-save))
+ (define-prefix-command 'bookmark-map)
+ (define-key bookmark-map "x" 'bookmark-set)
+ (define-key bookmark-map "m" 'bookmark-set) ; "m" for "mark"
+ (define-key bookmark-map "j" 'bookmark-jump)
+ (define-key bookmark-map "g" 'bookmark-jump) ; "g" for "go"
+ (define-key bookmark-map "i" 'bookmark-insert)
+ (define-key bookmark-map "e" 'edit-bookmarks)
+ (define-key bookmark-map "f" 'bookmark-insert-location) ; "f" for "find"
+ (define-key bookmark-map "r" 'bookmark-rename)
+ (define-key bookmark-map "d" 'bookmark-delete)
+ (define-key bookmark-map "l" 'bookmark-load)
+ (define-key bookmark-map "w" 'bookmark-write)
+ (define-key bookmark-map "s" 'bookmark-save)
(autoload (quote bookmark-set) "bookmark" "\
Set a bookmark named NAME inside a file.
Use \\[bookmark-delete] to remove bookmarks (you give it a name,
and it removes only the first instance of a bookmark with that name from
-the list of bookmarks.)" t nil)
+the list of bookmarks.)
+
+\(fn &optional NAME PARG)" t nil)
(autoload (quote bookmark-jump) "bookmark" "\
Jump to bookmark BOOKMARK (a point in some file).
If the file pointed to by BOOKMARK no longer exists, you will be asked
if you wish to give the bookmark a new location, and bookmark-jump
will then jump to the new location, as well as recording it in place
-of the old one in the permanent bookmark record." t nil)
+of the old one in the permanent bookmark record.
+
+\(fn BOOKMARK)" t nil)
(autoload (quote bookmark-relocate) "bookmark" "\
Relocate BOOKMARK to another file (reading file name with minibuffer).
This makes an already existing bookmark point to that file, instead of
the one it used to point at. Useful when a file has been renamed
-after a bookmark was set in it." t nil)
+after a bookmark was set in it.
+
+\(fn BOOKMARK)" t nil)
(autoload (quote bookmark-insert-location) "bookmark" "\
Insert the name of the file associated with BOOKMARK.
Optional second arg NO-HISTORY means don't record this in the
-minibuffer history list `bookmark-history'." t nil)
+minibuffer history list `bookmark-history'.
+
+\(fn BOOKMARK &optional NO-HISTORY)" t nil)
(defalias (quote bookmark-locate) (quote bookmark-insert-location))
While you are entering the new name, consecutive C-w's insert
consecutive words from the text of the buffer into the new bookmark
-name." t nil)
+name.
+
+\(fn OLD &optional NEW)" t nil)
(autoload (quote bookmark-insert) "bookmark" "\
Insert the text of the file pointed to by bookmark BOOKMARK.
You may have a problem using this function if the value of variable
`bookmark-alist' is nil. If that happens, you need to load in some
bookmarks. See help on function `bookmark-load' for more about
-this." t nil)
+this.
+
+\(fn BOOKMARK)" t nil)
(autoload (quote bookmark-delete) "bookmark" "\
Delete BOOKMARK from the bookmark list.
not be deleted. Defaults to the \"current\" bookmark (that is, the
one most recently used in this file, if any).
Optional second arg BATCH means don't update the bookmark list buffer,
-probably because we were called from there." t nil)
+probably because we were called from there.
+
+\(fn BOOKMARK &optional BATCH)" t nil)
(autoload (quote bookmark-write) "bookmark" "\
Write bookmarks to a file (reading the file name with the minibuffer).
-Don't use this in Lisp programs; use `bookmark-save' instead." t nil)
+Don't use this in Lisp programs; use `bookmark-save' instead.
+
+\(fn)" t nil)
(autoload (quote bookmark-save) "bookmark" "\
Save currently defined bookmarks.
When you want to load in the bookmarks from a file, use
`bookmark-load', \\[bookmark-load]. That function will prompt you
for a file, defaulting to the file defined by variable
-`bookmark-default-file'." t nil)
+`bookmark-default-file'.
+
+\(fn &optional PARG FILE)" t nil)
(autoload (quote bookmark-load) "bookmark" "\
Load bookmarks from FILE (which must be in bookmark format).
If you load a file containing bookmarks with the same names as
bookmarks already present in your Emacs, the new bookmarks will get
unique numeric suffixes \"<2>\", \"<3>\", ... following the same
-method buffers use to resolve name collisions." t nil)
+method buffers use to resolve name collisions.
+
+\(fn FILE &optional OVERWRITE NO-MSG)" t nil)
(autoload (quote bookmark-bmenu-list) "bookmark" "\
Display a list of existing bookmarks.
The list is displayed in a buffer named `*Bookmark List*'.
The leftmost column displays a D if the bookmark is flagged for
-deletion, or > if it is flagged for displaying." t nil)
+deletion, or > if it is flagged for displaying.
+
+\(fn)" t nil)
(defalias (quote list-bookmarks) (quote bookmark-bmenu-list))
Warning: this function only takes an EVENT as argument. Use the
corresponding bookmark function from Lisp (the one without the
-\"-menu-\" in its name)." t nil)
+\"-menu-\" in its name).
+
+\(fn EVENT)" t nil)
(autoload (quote bookmark-menu-jump) "bookmark" "\
Jump to bookmark BOOKMARK (a point in some file).
Warning: this function only takes an EVENT as argument. Use the
corresponding bookmark function from Lisp (the one without the
-\"-menu-\" in its name)." t nil)
+\"-menu-\" in its name).
+
+\(fn EVENT)" t nil)
(autoload (quote bookmark-menu-locate) "bookmark" "\
Insert the name of the file associated with BOOKMARK.
Warning: this function only takes an EVENT as argument. Use the
corresponding bookmark function from Lisp (the one without the
-\"-menu-\" in its name)." t nil)
+\"-menu-\" in its name).
+
+\(fn EVENT)" t nil)
(autoload (quote bookmark-menu-rename) "bookmark" "\
Change the name of OLD-BOOKMARK to NEWNAME.
Warning: this function only takes an EVENT as argument. Use the
corresponding bookmark function from Lisp (the one without the
-\"-menu-\" in its name)." t nil)
+\"-menu-\" in its name).
+
+\(fn EVENT)" t nil)
(autoload (quote bookmark-menu-delete) "bookmark" "\
Delete the bookmark named NAME from the bookmark list.
Warning: this function only takes an EVENT as argument. Use the
corresponding bookmark function from Lisp (the one without the
-\"-menu-\" in its name)." t nil)
+\"-menu-\" in its name).
+
+\(fn EVENT)" t nil)
(defvar menu-bar-bookmark-map (make-sparse-keymap "Bookmark functions"))
(defalias (quote menu-bar-bookmark-map) (symbol-value (quote menu-bar-bookmark-map)))
-
-(define-key menu-bar-bookmark-map [load] (quote ("Load a Bookmark File..." . bookmark-load)))
-
-(define-key menu-bar-bookmark-map [write] (quote ("Save Bookmarks As..." . bookmark-write)))
-
-(define-key menu-bar-bookmark-map [save] (quote ("Save Bookmarks" . bookmark-save)))
-
-(define-key menu-bar-bookmark-map [edit] (quote ("Edit Bookmark List" . bookmark-bmenu-list)))
-
-(define-key menu-bar-bookmark-map [delete] (quote ("Delete Bookmark" . bookmark-menu-delete)))
-
-(define-key menu-bar-bookmark-map [rename] (quote ("Rename Bookmark" . bookmark-menu-rename)))
-
-(define-key menu-bar-bookmark-map [locate] (quote ("Insert Location" . bookmark-menu-locate)))
-
-(define-key menu-bar-bookmark-map [insert] (quote ("Insert Contents" . bookmark-menu-insert)))
-
-(define-key menu-bar-bookmark-map [set] (quote ("Set Bookmark" . bookmark-set)))
-
-(define-key menu-bar-bookmark-map [jump] (quote ("Jump to Bookmark" . bookmark-menu-jump)))
+ (define-key menu-bar-bookmark-map [load]
+ '("Load a Bookmark File..." . bookmark-load))
+ (define-key menu-bar-bookmark-map [write]
+ '("Save Bookmarks As..." . bookmark-write))
+ (define-key menu-bar-bookmark-map [save]
+ '("Save Bookmarks" . bookmark-save))
+ (define-key menu-bar-bookmark-map [edit]
+ '("Edit Bookmark List" . bookmark-bmenu-list))
+ (define-key menu-bar-bookmark-map [delete]
+ '("Delete Bookmark" . bookmark-menu-delete))
+ (define-key menu-bar-bookmark-map [rename]
+ '("Rename Bookmark" . bookmark-menu-rename))
+ (define-key menu-bar-bookmark-map [locate]
+ '("Insert Location" . bookmark-menu-locate))
+ (define-key menu-bar-bookmark-map [insert]
+ '("Insert Contents" . bookmark-menu-insert))
+ (define-key menu-bar-bookmark-map [set]
+ '("Set Bookmark" . bookmark-set))
+ (define-key menu-bar-bookmark-map [jump]
+ '("Jump to Bookmark" . bookmark-menu-jump))
;;;***
\f
;;;;;; browse-url-galeon browse-url-mozilla browse-url-netscape
;;;;;; browse-url-default-browser browse-url-at-mouse browse-url-at-point
;;;;;; browse-url browse-url-of-region browse-url-of-dired-file
-;;;;;; browse-url-of-buffer browse-url-of-file browse-url-generic-program
-;;;;;; browse-url-save-file browse-url-new-window-flag browse-url-galeon-program
-;;;;;; browse-url-browser-display browse-url-browser-function) "browse-url"
-;;;;;; "net/browse-url.el" (15474 13216))
+;;;;;; browse-url-of-buffer browse-url-of-file browse-url-browser-function)
+;;;;;; "browse-url" "net/browse-url.el" (16174 61085))
;;; Generated autoloads from net/browse-url.el
-(defvar browse-url-browser-function (if (memq system-type (quote (windows-nt ms-dos))) (quote browse-url-default-windows-browser) (quote browse-url-default-browser)) "\
+(defvar browse-url-browser-function (cond ((memq system-type (quote (windows-nt ms-dos cygwin))) (quote browse-url-default-windows-browser)) ((memq system-type (quote (darwin))) (quote browse-url-default-macosx-browser)) (t (quote browse-url-default-browser))) "\
*Function to display the current buffer in a WWW browser.
This is used by the `browse-url-at-point', `browse-url-at-mouse', and
`browse-url-of-file' commands.
function is passed the URL and any other args of `browse-url'. The last
regexp should probably be \".\" to specify a default browser.")
-(defvar browse-url-browser-display nil "\
-*The X display for running the browser, if not same as Emacs'.")
-
-(defvar browse-url-galeon-program "galeon" "\
-The name by which to invoke Galeon.")
-
-(defvar browse-url-new-window-flag nil "\
-*If non-nil, always open a new browser window with appropriate browsers.
-Passing an interactive argument to \\[browse-url], or specific browser
-commands reverses the effect of this variable. Requires Netscape version
-1.1N or later or XMosaic version 2.5 or later if using those browsers.")
-
-(defvar browse-url-save-file nil "\
-*If non-nil, save the buffer before displaying its file.
-Used by the `browse-url-of-file' command.")
-
-(defvar browse-url-generic-program nil "\
-*The name of the browser program used by `browse-url-generic'.")
+(custom-autoload (quote browse-url-browser-function) "browse-url")
(autoload (quote browse-url-of-file) "browse-url" "\
Ask a WWW browser to display FILE.
Display the current buffer's file if FILE is nil or if called
interactively. Turn the filename into a URL with function
`browse-url-file-url'. Pass the URL to a browser using the
-`browse-url' function then run `browse-url-of-file-hook'." t nil)
+`browse-url' function then run `browse-url-of-file-hook'.
+
+\(fn &optional FILE)" t nil)
(autoload (quote browse-url-of-buffer) "browse-url" "\
Ask a WWW browser to display BUFFER.
Display the current buffer if BUFFER is nil. Display only the
currently visible part of BUFFER (from a temporary file) if buffer is
-narrowed." t nil)
+narrowed.
+
+\(fn &optional BUFFER)" t nil)
(autoload (quote browse-url-of-dired-file) "browse-url" "\
-In Dired, ask a WWW browser to display the file named on this line." t nil)
+In Dired, ask a WWW browser to display the file named on this line.
+
+\(fn)" t nil)
(autoload (quote browse-url-of-region) "browse-url" "\
-Ask a WWW browser to display the current region." t nil)
+Ask a WWW browser to display the current region.
+
+\(fn MIN MAX)" t nil)
(autoload (quote browse-url) "browse-url" "\
Ask a WWW browser to load URL.
Prompts for a URL, defaulting to the URL at or before point. Variable
-`browse-url-browser-function' says which browser to use." t nil)
+`browse-url-browser-function' says which browser to use.
+
+\(fn URL &rest ARGS)" t nil)
(autoload (quote browse-url-at-point) "browse-url" "\
Ask a WWW browser to load the URL at or before point.
Doesn't let you edit the URL like `browse-url'. Variable
-`browse-url-browser-function' says which browser to use." t nil)
+`browse-url-browser-function' says which browser to use.
+
+\(fn &optional ARG)" t nil)
(autoload (quote browse-url-at-mouse) "browse-url" "\
Ask a WWW browser to load a URL clicked with the mouse.
The URL is the one around or before the position of the mouse click
but point is not changed. Doesn't let you edit the URL like
`browse-url'. Variable `browse-url-browser-function' says which browser
-to use." t nil)
+to use.
+
+\(fn EVENT)" t nil)
(autoload (quote browse-url-default-browser) "browse-url" "\
Find a suitable browser and ask it to load URL.
used instead of `browse-url-new-window-flag'.
The order attempted is gnome-moz-remote, Mozilla, Galeon, Netscape,
-Mosaic, IXI Mosaic, Lynx in an xterm, MMM, Konqueror, and then W3." nil nil)
+Mosaic, IXI Mosaic, Lynx in an xterm, MMM, Konqueror, and then W3.
+
+\(fn URL &rest ARGS)" nil nil)
(autoload (quote browse-url-netscape) "browse-url" "\
Ask the Netscape WWW browser to load URL.
the effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
+used instead of `browse-url-new-window-flag'.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
(autoload (quote browse-url-mozilla) "browse-url" "\
Ask the Mozilla WWW browser to load URL.
random existing one. A non-nil interactive prefix argument reverses
the effect of `browse-url-new-window-flag'.
+If `browse-url-mozilla-new-window-is-tab' is non-nil, then whenever a
+document would otherwise be loaded in a new window, it is loaded in a
+new tab in an existing window instead.
+
When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
+used instead of `browse-url-new-window-flag'.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
(autoload (quote browse-url-galeon) "browse-url" "\
Ask the Galeon WWW browser to load URL.
random existing one. A non-nil interactive prefix argument reverses
the effect of `browse-url-new-window-flag'.
+If `browse-url-galeon-new-window-is-tab' is non-nil, then whenever a
+document would otherwise be loaded in a new window, it is loaded in a
+new tab in an existing window instead.
+
When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
+used instead of `browse-url-new-window-flag'.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
(autoload (quote browse-url-gnome-moz) "browse-url" "\
Ask Mozilla/Netscape to load URL via the GNOME program `gnome-moz-remote'.
effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
+used instead of `browse-url-new-window-flag'.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
(autoload (quote browse-url-mosaic) "browse-url" "\
Ask the XMosaic WWW browser to load URL.
the effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
+used instead of `browse-url-new-window-flag'.
-(defvar browse-url-grail (concat (or (getenv "GRAILDIR") "~/.grail") "/user/rcgrail.py") "\
-Location of Grail remote control client script `rcgrail.py'.
-Typically found in $GRAILDIR/rcgrail.py, or ~/.grail/user/rcgrail.py.")
+\(fn URL &optional NEW-WINDOW)" t nil)
(autoload (quote browse-url-grail) "browse-url" "\
Ask the Grail WWW browser to load URL.
Default to the URL around or before point. Runs the program in the
-variable `browse-url-grail'." t nil)
+variable `browse-url-grail'.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
(autoload (quote browse-url-cci) "browse-url" "\
Ask the XMosaic WWW browser to load URL.
the effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
+used instead of `browse-url-new-window-flag'.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
(autoload (quote browse-url-iximosaic) "browse-url" "\
Ask the IXIMosaic WWW browser to load URL.
-Default to the URL around or before point." t nil)
+Default to the URL around or before point.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
(autoload (quote browse-url-w3) "browse-url" "\
Ask the w3 WWW browser to load URL.
prefix argument reverses the effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
+used instead of `browse-url-new-window-flag'.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
(autoload (quote browse-url-w3-gnudoit) "browse-url" "\
Ask another Emacs running gnuserv to load the URL using the W3 browser.
The `browse-url-gnudoit-program' program is used with options given by
-`browse-url-gnudoit-args'. Default to the URL around or before point." t nil)
+`browse-url-gnudoit-args'. Default to the URL around or before point.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
(autoload (quote browse-url-lynx-xterm) "browse-url" "\
Ask the Lynx WWW browser to load URL.
Default to the URL around or before point. A new Lynx process is run
in an Xterm window using the Xterm program named by `browse-url-xterm-program'
-with possible additional arguments `browse-url-xterm-args'." t nil)
+with possible additional arguments `browse-url-xterm-args'.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
(autoload (quote browse-url-lynx-emacs) "browse-url" "\
Ask the Lynx WWW browser to load URL.
reverses the effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
+used instead of `browse-url-new-window-flag'.
+
+\(fn URL &optional NEW-BUFFER)" t nil)
(autoload (quote browse-url-mmm) "browse-url" "\
Ask the MMM WWW browser to load URL.
-Default to the URL around or before point." t nil)
+Default to the URL around or before point.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
(autoload (quote browse-url-mail) "browse-url" "\
Open a new mail message buffer within Emacs.
`browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
+used instead of `browse-url-new-window-flag'.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
(autoload (quote browse-url-generic) "browse-url" "\
Ask the WWW browser defined by `browse-url-generic-program' to load URL.
Default to the URL around or before point. A fresh copy of the
browser is started up in a new process with possible additional arguments
`browse-url-generic-args'. This is appropriate for browsers which
-don't offer a form of remote control." t nil)
+don't offer a form of remote control.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
(autoload (quote browse-url-kde) "browse-url" "\
Ask the KDE WWW browser to load URL.
-Default to the URL around or before point." t nil)
+Default to the URL around or before point.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
;;;***
\f
-;;;### (autoloads (snarf-bruces bruce) "bruce" "play/bruce.el" (15400
-;;;;;; 1479))
+;;;### (autoloads (snarf-bruces bruce) "bruce" "play/bruce.el" (15830
+;;;;;; 37093))
;;; Generated autoloads from play/bruce.el
(autoload (quote bruce) "bruce" "\
-Adds that special touch of class to your outgoing mail." t nil)
+Adds that special touch of class to your outgoing mail.
+
+\(fn)" t nil)
(autoload (quote snarf-bruces) "bruce" "\
-Return a vector containing the lines from `bruce-phrases-file'." nil nil)
+Return a vector containing the lines from `bruce-phrases-file'.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (bs-show bs-customize bs-cycle-previous bs-cycle-next)
-;;;;;; "bs" "bs.el" (15371 46415))
+;;;;;; "bs" "bs.el" (15731 5408))
;;; Generated autoloads from bs.el
(autoload (quote bs-cycle-next) "bs" "\
Select next buffer defined by buffer cycling.
The buffers taking part in buffer cycling are defined
-by buffer configuration `bs-cycle-configuration-name'." t nil)
+by buffer configuration `bs-cycle-configuration-name'.
+
+\(fn)" t nil)
(autoload (quote bs-cycle-previous) "bs" "\
Select previous buffer defined by buffer cycling.
The buffers taking part in buffer cycling are defined
-by buffer configuration `bs-cycle-configuration-name'." t nil)
+by buffer configuration `bs-cycle-configuration-name'.
+
+\(fn)" t nil)
(autoload (quote bs-customize) "bs" "\
-Customization of group bs for Buffer Selection Menu." t nil)
+Customization of group bs for Buffer Selection Menu.
+
+\(fn)" t nil)
(autoload (quote bs-show) "bs" "\
Make a menu of buffers so you can manipulate buffers or the buffer list.
Type \\[bs-help] after invocation to get help on commands available.
With prefix argument ARG show a different buffer list. Function
`bs--configuration-name-for-prefix-arg' determine accordingly
-name of buffer configuration." t nil)
+name of buffer configuration.
+
+\(fn ARG)" t nil)
;;;***
\f
;;;### (autoloads (insert-text-button make-text-button insert-button
-;;;;;; make-button define-button-type) "button" "button.el" (15425
-;;;;;; 28360))
+;;;;;; make-button define-button-type) "button" "button.el" (15924
+;;;;;; 18767))
;;; Generated autoloads from button.el
-(defvar button-map (let ((map (make-sparse-keymap))) (define-key map "" (quote push-button)) (define-key map [mouse-2] (quote push-button)) map) "\
+(defvar button-map (let ((map (make-sparse-keymap))) (define-key map "\r" (quote push-button)) (define-key map [mouse-2] (quote push-button)) map) "\
Keymap used by buttons.")
(defvar button-buffer-map (let ((map (make-sparse-keymap))) (define-key map [9] (quote forward-button)) (define-key map [backtab] (quote backward-button)) map) "\
In addition, the keyword argument :supertype may be used to specify a
button-type from which NAME inherits its default property values
\(however, the inheritance happens only when NAME is defined; subsequent
-changes to a supertype are not reflected in its subtypes)." nil nil)
+changes to a supertype are not reflected in its subtypes).
+
+\(fn NAME &rest PROPERTIES)" nil nil)
(autoload (quote make-button) "button" "\
Make a button from BEG to END in the current buffer.
button-type from which to inherit other properties; see
`define-button-type'.
-Also see `make-text-button', `insert-button'." nil nil)
+Also see `make-text-button', `insert-button'.
+
+\(fn BEG END &rest PROPERTIES)" nil nil)
(autoload (quote insert-button) "button" "\
Insert a button with the label LABEL.
button-type from which to inherit other properties; see
`define-button-type'.
-Also see `insert-text-button', `make-button'." nil nil)
+Also see `insert-text-button', `make-button'.
+
+\(fn LABEL &rest PROPERTIES)" nil nil)
(autoload (quote make-text-button) "button" "\
Make a button from BEG to END in the current buffer.
large numbers of buttons can also be somewhat faster using
`make-text-button'.
-Also see `insert-text-button'." nil nil)
+Also see `insert-text-button'.
+
+\(fn BEG END &rest PROPERTIES)" nil nil)
(autoload (quote insert-text-button) "button" "\
Insert a button with the label LABEL.
Creating large numbers of buttons can also be somewhat faster using
`insert-text-button'.
-Also see `make-text-button'." nil nil)
+Also see `make-text-button'.
+
+\(fn LABEL &rest PROPERTIES)" nil nil)
;;;***
\f
;;;### (autoloads (batch-byte-recompile-directory batch-byte-compile
-;;;;;; display-call-tree byte-compile compile-defun byte-compile-file
-;;;;;; byte-recompile-directory byte-force-recompile) "bytecomp"
-;;;;;; "emacs-lisp/bytecomp.el" (15596 5403))
+;;;;;; batch-byte-compile-if-not-done display-call-tree byte-compile
+;;;;;; compile-defun byte-compile-file byte-recompile-directory
+;;;;;; byte-force-recompile) "bytecomp" "emacs-lisp/bytecomp.el"
- ;;;;;; (16136 53055))
++;;;;;; (16179 16173))
;;; Generated autoloads from emacs-lisp/bytecomp.el
(autoload (quote byte-force-recompile) "bytecomp" "\
Recompile every `.el' file in DIRECTORY that already has a `.elc' file.
-Files in subdirectories of DIRECTORY are processed also." t nil)
+Files in subdirectories of DIRECTORY are processed also.
+
+\(fn DIRECTORY)" t nil)
(autoload (quote byte-recompile-directory) "bytecomp" "\
Recompile every `.el' file in DIRECTORY that needs recompilation.
This is if a `.elc' file exists but is older than the `.el' file.
Files in subdirectories of DIRECTORY are processed also.
-If the `.elc' file does not exist, normally the `.el' file is *not* compiled.
-But a prefix argument (optional second arg) means ask user,
-for each such `.el' file, whether to compile it. Prefix argument 0 means
-don't ask and compile the file anyway.
+If the `.elc' file does not exist, normally this function *does not*
+compile the corresponding `.el' file. However,
+if ARG (the prefix argument) is 0, that means do compile all those files.
+A nonzero ARG means ask the user, for each such `.el' file,
+whether to compile it.
-A nonzero prefix argument also means ask about each subdirectory.
+A nonzero ARG also means ask about each subdirectory before scanning it.
If the third argument FORCE is non-nil,
-recompile every `.el' file that already has a `.elc' file." t nil)
+recompile every `.el' file that already has a `.elc' file.
+
+\(fn DIRECTORY &optional ARG FORCE)" t nil)
(autoload (quote byte-compile-file) "bytecomp" "\
Compile a file of Lisp code named FILENAME into a file of byte code.
The output file's name is made by appending `c' to the end of FILENAME.
With prefix arg (noninteractively: 2nd arg), LOAD the file after compiling.
-The value is non-nil if there were no errors, nil if errors." t nil)
+The value is non-nil if there were no errors, nil if errors.
+
+\(fn FILENAME &optional LOAD)" t nil)
(autoload (quote compile-defun) "bytecomp" "\
Compile and evaluate the current top-level form.
Print the result in the minibuffer.
-With argument, insert value in current buffer after the form." t nil)
+With argument, insert value in current buffer after the form.
+
+\(fn &optional ARG)" t nil)
(autoload (quote byte-compile) "bytecomp" "\
If FORM is a symbol, byte-compile its function definition.
-If FORM is a lambda or a macro, byte-compile it as a function." nil nil)
+If FORM is a lambda or a macro, byte-compile it as a function.
+
+\(fn FORM)" nil nil)
(autoload (quote display-call-tree) "bytecomp" "\
Display a call graph of a specified file.
The call tree also lists those functions which are not known to be called
\(that is, to which no calls have been compiled), and which cannot be
-invoked interactively." t nil)
+invoked interactively.
+
+\(fn &optional FILENAME)" t nil)
+
+(autoload (quote batch-byte-compile-if-not-done) "bytecomp" "\
+Like `byte-compile-file' but doesn't recompile if already up to date.
+Use this from the command line, with `-batch';
+it won't work in an interactive Emacs.
+
+\(fn)" nil nil)
(autoload (quote batch-byte-compile) "bytecomp" "\
Run `byte-compile-file' on the files remaining on the command line.
Each file is processed even if an error occurred previously.
For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\".
If NOFORCE is non-nil, don't recompile a file that seems to be
-already up-to-date." nil nil)
+already up-to-date.
+
+\(fn &optional NOFORCE)" nil nil)
(autoload (quote batch-byte-recompile-directory) "bytecomp" "\
-Runs `byte-recompile-directory' on the dirs remaining on the command line.
+Run `byte-recompile-directory' on the dirs remaining on the command line.
Must be used only with `-batch', and kills Emacs on completion.
-For example, invoke `emacs -batch -f batch-byte-recompile-directory .'." nil nil)
+For example, invoke `emacs -batch -f batch-byte-recompile-directory .'.
+
+\(fn)" nil nil)
;;;***
\f
-;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (15371 46418))
+;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (15941 42957))
;;; Generated autoloads from calendar/cal-dst.el
(put (quote calendar-daylight-savings-starts) (quote risky-local-variable) t)
;;;***
\f
;;;### (autoloads (list-yahrzeit-dates) "cal-hebrew" "calendar/cal-hebrew.el"
-;;;;;; (15371 46418))
+;;;;;; (16174 61085))
;;; Generated autoloads from calendar/cal-hebrew.el
(autoload (quote list-yahrzeit-dates) "cal-hebrew" "\
List Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to END-YEAR.
When called interactively from the calendar window, the date of death is taken
-from the cursor position." t nil)
+from the cursor position.
+
+\(fn DEATH-DATE START-YEAR END-YEAR)" t nil)
;;;***
\f
;;;### (autoloads (defmath calc-embedded-activate calc-embedded calc-grab-rectangle
;;;;;; calc-grab-region full-calc-keypad calc-keypad calc-eval quick-calc
-;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (15464
-;;;;;; 26324))
+;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (15941
+;;;;;; 42957))
;;; Generated autoloads from calc/calc.el
(defvar calc-info-filename "calc.info" "\
(global-set-key "\e#" 'calc-dispatch)
(autoload (quote calc-dispatch) "calc" "\
-Invoke the GNU Emacs Calculator. See `calc-dispatch-help' for details." t nil)
+Invoke the GNU Emacs Calculator. See `calc-dispatch-help' for details.
+
+\(fn &optional ARG)" t nil)
(autoload (quote calc) "calc" "\
-The Emacs Calculator. Full documentation is listed under \"calc-mode\"." t nil)
+The Emacs Calculator. Full documentation is listed under \"calc-mode\".
+
+\(fn &optional ARG FULL-DISPLAY INTERACTIVE)" t nil)
(autoload (quote full-calc) "calc" "\
-Invoke the Calculator and give it a full-sized window." t nil)
+Invoke the Calculator and give it a full-sized window.
+
+\(fn)" t nil)
(autoload (quote quick-calc) "calc" "\
-Do a quick calculation in the minibuffer without invoking full Calculator." t nil)
+Do a quick calculation in the minibuffer without invoking full Calculator.
+
+\(fn)" t nil)
(autoload (quote calc-eval) "calc" "\
Do a quick calculation and return the result as a string.
Return value will either be the formatted result in string form,
-or a list containing a character position and an error message in string form." nil nil)
+or a list containing a character position and an error message in string form.
+
+\(fn STR &optional SEPARATOR &rest ARGS)" nil nil)
(autoload (quote calc-keypad) "calc" "\
Invoke the Calculator in \"visual keypad\" mode.
This is most useful in the X window system.
In this mode, click on the Calc \"buttons\" using the left mouse button.
-Or, position the cursor manually and do M-x calc-keypad-press." t nil)
+Or, position the cursor manually and do M-x calc-keypad-press.
+
+\(fn)" t nil)
(autoload (quote full-calc-keypad) "calc" "\
Invoke the Calculator in full-screen \"visual keypad\" mode.
-See calc-keypad for details." t nil)
+See calc-keypad for details.
+
+\(fn)" t nil)
(autoload (quote calc-grab-region) "calc" "\
-Parse the region as a vector of numbers and push it on the Calculator stack." t nil)
+Parse the region as a vector of numbers and push it on the Calculator stack.
+
+\(fn TOP BOT ARG)" t nil)
(autoload (quote calc-grab-rectangle) "calc" "\
-Parse a rectangle as a matrix of numbers and push it on the Calculator stack." t nil)
+Parse a rectangle as a matrix of numbers and push it on the Calculator stack.
+
+\(fn TOP BOT ARG)" t nil)
(autoload (quote calc-embedded) "calc" "\
-Start Calc Embedded mode on the formula surrounding point." t nil)
+Start Calc Embedded mode on the formula surrounding point.
+
+\(fn ARG &optional END OBEG OEND)" t nil)
(autoload (quote calc-embedded-activate) "calc" "\
Scan the current editing buffer for all embedded := and => formulas.
-Also looks for the equivalent TeX words, \\gets and \\evalto." t nil)
+Also looks for the equivalent TeX words, \\gets and \\evalto.
+
+\(fn &optional ARG CBUF)" t nil)
-(autoload (quote defmath) "calc" nil nil (quote macro))
+(autoload (quote defmath) "calc" "\
+Not documented
+
+\(fn FUNC ARGS &rest BODY)" nil (quote macro))
;;;***
\f
;;;### (autoloads (calc-extensions) "calc-ext" "calc/calc-ext.el"
-;;;;;; (15483 59373))
+;;;;;; (15941 42957))
;;; Generated autoloads from calc/calc-ext.el
(autoload (quote calc-extensions) "calc-ext" "\
-This function is part of the autoload linkage for parts of Calc." nil nil)
+This function is part of the autoload linkage for parts of Calc.
+
+\(fn)" nil nil)
;;;***
\f
-;;;### (autoloads (calculator) "calculator" "calculator.el" (15457
-;;;;;; 4931))
+;;;### (autoloads (calculator) "calculator" "calculator.el" (15941
+;;;;;; 42951))
;;; Generated autoloads from calculator.el
(autoload (quote calculator) "calculator" "\
Run the Emacs calculator.
-See the documentation for `calculator-mode' for more information." t nil)
+See the documentation for `calculator-mode' for more information.
+
+\(fn)" t nil)
;;;***
\f
;;;;;; calendar-remove-frame-by-deleting mark-diary-entries-in-calendar
;;;;;; number-of-diary-entries view-diary-entries-initially calendar-offset
;;;;;; calendar-week-start-day) "calendar" "calendar/calendar.el"
-;;;;;; (15445 63197))
+;;;;;; (16174 61085))
;;; Generated autoloads from calendar/calendar.el
(defvar calendar-week-start-day 0 "\
*The day of the week on which a week in the calendar begins.
0 means Sunday (default), 1 means Monday, and so on.")
+(custom-autoload (quote calendar-week-start-day) "calendar")
+
(defvar calendar-offset 0 "\
*The offset of the principal month from the center of the calendar window.
0 means the principal month is in the center (default), -1 means on the left,
+1 means on the right. Larger (or smaller) values push the principal month off
the screen.")
+(custom-autoload (quote calendar-offset) "calendar")
+
(defvar view-diary-entries-initially nil "\
*Non-nil means display current date's diary entries on entry.
The diary is displayed in another window when the calendar is first displayed,
if the current date is visible. The number of days of diary entries displayed
is governed by the variable `number-of-diary-entries'.")
+(custom-autoload (quote view-diary-entries-initially) "calendar")
+
(defvar number-of-diary-entries 1 "\
*Specifies how many days of diary entries are to be displayed initially.
This variable affects the diary display when the command \\[diary] is used,
from the calendar; in that case, the prefix argument controls the
number of days of diary entries displayed.")
+(custom-autoload (quote number-of-diary-entries) "calendar")
+
(defvar mark-diary-entries-in-calendar nil "\
*Non-nil means mark dates with diary entries, in the calendar window.
The marking symbol is specified by the variable `diary-entry-marker'.")
+(custom-autoload (quote mark-diary-entries-in-calendar) "calendar")
+
(defvar calendar-remove-frame-by-deleting nil "\
*Determine how the calendar mode removes a frame no longer needed.
If nil, make an icon of the frame. If non-nil, delete the frame.")
+(custom-autoload (quote calendar-remove-frame-by-deleting) "calendar")
+
(defvar view-calendar-holidays-initially nil "\
*Non-nil means display holidays for current three month period on entry.
The holidays are displayed in another window when the calendar is first
displayed.")
+(custom-autoload (quote view-calendar-holidays-initially) "calendar")
+
(defvar mark-holidays-in-calendar nil "\
*Non-nil means mark dates of holidays in the calendar window.
The marking symbol is specified by the variable `calendar-holiday-marker'.")
+(custom-autoload (quote mark-holidays-in-calendar) "calendar")
+
(defvar all-hebrew-calendar-holidays nil "\
*If nil, show only major holidays from the Hebrew calendar.
This means only those Jewish holidays that appear on secular calendars.
If t, show all the holidays that would appear in a complete Hebrew calendar.")
+(custom-autoload (quote all-hebrew-calendar-holidays) "calendar")
+
(defvar all-christian-calendar-holidays nil "\
*If nil, show only major holidays from the Christian calendar.
This means only those Christian holidays that appear on secular calendars.
If t, show all the holidays that would appear in a complete Christian
calendar.")
+(custom-autoload (quote all-christian-calendar-holidays) "calendar")
+
(defvar all-islamic-calendar-holidays nil "\
*If nil, show only major holidays from the Islamic calendar.
This means only those Islamic holidays that appear on secular calendars.
If t, show all the holidays that would appear in a complete Islamic
calendar.")
+(custom-autoload (quote all-islamic-calendar-holidays) "calendar")
+
(defvar calendar-load-hook nil "\
*List of functions to be called after the calendar is first loaded.
This is the place to add key bindings to `calendar-mode-map'.")
+(custom-autoload (quote calendar-load-hook) "calendar")
+
(defvar initial-calendar-window-hook nil "\
*List of functions to be called when the calendar window is first opened.
The functions invoked are called after the calendar window is opened, but
once opened is never called again. Leaving the calendar with the `q' command
and reentering it will cause these functions to be called again.")
+(custom-autoload (quote initial-calendar-window-hook) "calendar")
+
(defvar today-visible-calendar-hook nil "\
*List of functions called whenever the current date is visible.
This can be used, for example, to replace today's date with asterisks; a
characters in the calendar buffer by the hooks may cause the failure of the
functions that move by days and weeks.")
+(custom-autoload (quote today-visible-calendar-hook) "calendar")
+
(defvar today-invisible-calendar-hook nil "\
*List of functions called whenever the current date is not visible.
characters in the calendar buffer by the hooks may cause the failure of the
functions that move by days and weeks.")
+(custom-autoload (quote today-invisible-calendar-hook) "calendar")
+
(defvar calendar-move-hook nil "\
*List of functions called whenever the cursor moves in the calendar.
redisplays the diary for whatever date the cursor is moved to.")
+(custom-autoload (quote calendar-move-hook) "calendar")
+
(defvar diary-file "~/diary" "\
*Name of the file in which one's personal diary of dates is kept.
-The file's entries are lines in any of the forms
+The file's entries are lines beginning with any of the forms
+specified by the variable `american-date-diary-pattern', by default:
MONTH/DAY
MONTH/DAY/YEAR
MONTHNAME DAY, YEAR
DAYNAME
-at the beginning of the line; the remainder of the line is the diary entry
-string for that date. MONTH and DAY are one or two digit numbers, YEAR is
-a number and may be written in full or abbreviated to the final two digits.
-If the date does not contain a year, it is generic and applies to any year.
-DAYNAME entries apply to any date on which is on that day of the week.
-MONTHNAME and DAYNAME can be spelled in full, abbreviated to three
-characters (with or without a period), capitalized or not. Any of DAY,
-MONTH, or MONTHNAME, YEAR can be `*' which matches any day, month, or year,
-respectively.
-
-The European style (in which the day precedes the month) can be used
-instead, if you execute `european-calendar' when in the calendar, or set
-`european-calendar-style' to t in your .emacs file. The European forms are
+with the remainder of the line being the diary entry string for
+that date. MONTH and DAY are one or two digit numbers, YEAR is a
+number and may be written in full or abbreviated to the final two
+digits (if `abbreviated-calendar-year' is non-nil). MONTHNAME
+and DAYNAME can be spelled in full (as specified by the variables
+`calendar-month-name-array' and `calendar-day-name-array'),
+abbreviated (as specified by `calendar-month-abbrev-array' and
+`calendar-day-abbrev-array') with or without a period,
+capitalized or not. Any of DAY, MONTH, or MONTHNAME, YEAR can be
+`*' which matches any day, month, or year, respectively. If the
+date does not contain a year, it is generic and applies to any
+year. A DAYNAME entry applies to the appropriate day of the week
+in every week.
+
+The European style (in which the day precedes the month) can be
+used instead, if you execute `european-calendar' when in the
+calendar, or set `european-calendar-style' to t in your .emacs
+file. The European forms (see `european-date-diary-pattern') are
DAY/MONTH
DAY/MONTH/YEAR
Diary files can contain directives to include the contents of other files; for
details, see the documentation for the variable `list-diary-entries-hook'.")
+(custom-autoload (quote diary-file) "calendar")
+
(defvar diary-nonmarking-symbol "&" "\
*Symbol indicating that a diary entry is not to be marked in the calendar.")
+(custom-autoload (quote diary-nonmarking-symbol) "calendar")
+
(defvar hebrew-diary-entry-symbol "H" "\
*Symbol indicating a diary entry according to the Hebrew calendar.")
+(custom-autoload (quote hebrew-diary-entry-symbol) "calendar")
+
(defvar islamic-diary-entry-symbol "I" "\
*Symbol indicating a diary entry according to the Islamic calendar.")
+(custom-autoload (quote islamic-diary-entry-symbol) "calendar")
+
(defvar diary-include-string "#include" "\
*The string indicating inclusion of another file of diary entries.
See the documentation for the function `include-other-diary-files'.")
+(custom-autoload (quote diary-include-string) "calendar")
+
(defvar sexp-diary-entry-symbol "%%" "\
*The string used to indicate a sexp diary entry in `diary-file'.
See the documentation for the function `list-sexp-diary-entries'.")
+(custom-autoload (quote sexp-diary-entry-symbol) "calendar")
+
(defvar abbreviated-calendar-year t "\
*Interpret a two-digit year DD in a diary entry as either 19DD or 20DD.
For the Gregorian calendar; similarly for the Hebrew and Islamic calendars.
If this variable is nil, years must be written in full.")
+(custom-autoload (quote abbreviated-calendar-year) "calendar")
+
(defvar european-calendar-style nil "\
*Use the European style of dates in the diary and in any displays.
If this variable is t, a date 1/2/1990 would be interpreted as February 1,
-1990. The accepted European date styles are
+1990. The default European date styles (see `european-date-diary-pattern')
+are
DAY/MONTH
DAY/MONTH/YEAR
DAY MONTHNAME YEAR
DAYNAME
-Names can be capitalized or not, written in full, or abbreviated to three
-characters with or without a period.")
+Names can be capitalized or not, written in full (as specified by the
+variable `calendar-day-name-array'), or abbreviated (as specified by
+`calendar-day-abbrev-array') with or without a period.")
+
+(custom-autoload (quote european-calendar-style) "calendar")
(defvar american-date-diary-pattern (quote ((month "/" day "[^/0-9]") (month "/" day "/" year "[^0-9]") (monthname " *" day "[^,0-9]") (monthname " *" day ", *" year "[^0-9]") (dayname "\\W"))) "\
*List of pseudo-patterns describing the American patterns of date used.
See the documentation of `diary-date-forms' for an explanation.")
+(custom-autoload (quote american-date-diary-pattern) "calendar")
+
(defvar european-date-diary-pattern (quote ((day "/" month "[^/0-9]") (day "/" month "/" year "[^0-9]") (backup day " *" monthname "\\W+\\<\\([^*0-9]\\|\\([0-9]+[:aApP]\\)\\)") (day " *" monthname " *" year "[^0-9]") (dayname "\\W"))) "\
*List of pseudo-patterns describing the European patterns of date used.
See the documentation of `diary-date-forms' for an explanation.")
+(custom-autoload (quote european-date-diary-pattern) "calendar")
+
(defvar european-calendar-display-form (quote ((if dayname (concat dayname ", ")) day " " monthname " " year)) "\
*Pseudo-pattern governing the way a date appears in the European style.
-See the documentation of calendar-date-display-form for an explanation.")
+See the documentation of `calendar-date-display-form' for an explanation.")
+
+(custom-autoload (quote european-calendar-display-form) "calendar")
(defvar american-calendar-display-form (quote ((if dayname (concat dayname ", ")) monthname " " day ", " year)) "\
*Pseudo-pattern governing the way a date appears in the American style.
See the documentation of `calendar-date-display-form' for an explanation.")
+(custom-autoload (quote american-calendar-display-form) "calendar")
+
(defvar print-diary-entries-hook (quote lpr-buffer) "\
*List of functions called after a temporary diary buffer is prepared.
The buffer shows only the diary entries currently visible in the diary
example, rearranging the lines into order by day and time, saving the buffer
instead of deleting it, or changing the function used to do the printing.")
+(custom-autoload (quote print-diary-entries-hook) "calendar")
+
(defvar list-diary-entries-hook nil "\
*List of functions called after diary file is culled for relevant entries.
It is to be used for diary entries that are not found in the diary file.
diary entries from various included files, each day's entries sorted into
lexicographic order.")
+(custom-autoload (quote list-diary-entries-hook) "calendar")
+
(defvar diary-hook nil "\
*List of functions called after the display of the diary.
Can be used for appointment notification.")
+(custom-autoload (quote diary-hook) "calendar")
+
(defvar diary-display-hook nil "\
*List of functions that handle the display of the diary.
If nil (the default), `simple-diary-display' is used. Use `ignore' for no
if that day is a holiday; if you want such days to be shown in the fancy
diary buffer, set the variable `diary-list-include-blanks' to t.")
+(custom-autoload (quote diary-display-hook) "calendar")
+
(defvar nongregorian-diary-listing-hook nil "\
*List of functions called for listing diary file and included files.
As the files are processed for diary entries, these functions are used to cull
and `list-islamic-diary-entries'. The documentation for these functions
describes the style of such diary entries.")
+(custom-autoload (quote nongregorian-diary-listing-hook) "calendar")
+
(defvar mark-diary-entries-hook nil "\
*List of functions called after marking diary entries in the calendar.
part of the mark-diary-entries-hook, you will probably also want to use the
function `include-other-diary-files' as part of `list-diary-entries-hook'.")
+(custom-autoload (quote mark-diary-entries-hook) "calendar")
+
(defvar nongregorian-diary-marking-hook nil "\
*List of functions called for marking diary file and included files.
As the files are processed for diary entries, these functions are used to cull
and `mark-islamic-diary-entries'. The documentation for these functions
describes the style of such diary entries.")
+(custom-autoload (quote nongregorian-diary-marking-hook) "calendar")
+
(defvar diary-list-include-blanks nil "\
*If nil, do not include days with no diary entry in the list of diary entries.
Such days will then not be shown in the fancy diary buffer, even if they
are holidays.")
+(custom-autoload (quote diary-list-include-blanks) "calendar")
+
(defvar holidays-in-diary-buffer t "\
*Non-nil means include holidays in the diary display.
The holidays appear in the mode line of the diary buffer, or in the
fancy diary buffer next to the date. This slows down the diary functions
somewhat; setting it to nil makes the diary display faster.")
+(custom-autoload (quote holidays-in-diary-buffer) "calendar")
+
(put (quote general-holidays) (quote risky-local-variable) t)
(defvar general-holidays (quote ((holiday-fixed 1 1 "New Year's Day") (holiday-float 1 1 3 "Martin Luther King Day") (holiday-fixed 2 2 "Groundhog Day") (holiday-fixed 2 14 "Valentine's Day") (holiday-float 2 1 3 "President's Day") (holiday-fixed 3 17 "St. Patrick's Day") (holiday-fixed 4 1 "April Fools' Day") (holiday-float 5 0 2 "Mother's Day") (holiday-float 5 1 -1 "Memorial Day") (holiday-fixed 6 14 "Flag Day") (holiday-float 6 0 3 "Father's Day") (holiday-fixed 7 4 "Independence Day") (holiday-float 9 1 1 "Labor Day") (holiday-float 10 1 2 "Columbus Day") (holiday-fixed 10 31 "Halloween") (holiday-fixed 11 11 "Veteran's Day") (holiday-float 11 4 4 "Thanksgiving"))) "\
*General holidays. Default value is for the United States.
See the documentation for `calendar-holidays' for details.")
+(custom-autoload (quote general-holidays) "calendar")
+
(put (quote oriental-holidays) (quote risky-local-variable) t)
(defvar oriental-holidays (quote ((if (fboundp (quote atan)) (holiday-chinese-new-year)))) "\
*Oriental holidays.
See the documentation for `calendar-holidays' for details.")
+(custom-autoload (quote oriental-holidays) "calendar")
+
(put (quote local-holidays) (quote risky-local-variable) t)
(defvar local-holidays nil "\
*Local holidays.
See the documentation for `calendar-holidays' for details.")
+(custom-autoload (quote local-holidays) "calendar")
+
(put (quote other-holidays) (quote risky-local-variable) t)
(defvar other-holidays nil "\
*User defined holidays.
See the documentation for `calendar-holidays' for details.")
+(custom-autoload (quote other-holidays) "calendar")
+
(put (quote hebrew-holidays-1) (quote risky-local-variable) t)
(defvar hebrew-holidays-1 (quote ((holiday-rosh-hashanah-etc) (if all-hebrew-calendar-holidays (holiday-julian 11 (let* ((m displayed-month) (y displayed-year) (year)) (increment-calendar-month m y -1) (let ((year (extract-calendar-year (calendar-julian-from-absolute (calendar-absolute-from-gregorian (list m 1 y)))))) (if (zerop (% (1+ year) 4)) 22 21))) "\"Tal Umatar\" (evening)")))))
*Jewish holidays.
See the documentation for `calendar-holidays' for details.")
+(custom-autoload (quote hebrew-holidays) "calendar")
+
(put (quote christian-holidays) (quote risky-local-variable) t)
(defvar christian-holidays (quote ((if all-christian-calendar-holidays (holiday-fixed 1 6 "Epiphany")) (holiday-easter-etc) (if all-christian-calendar-holidays (holiday-greek-orthodox-easter)) (if all-christian-calendar-holidays (holiday-fixed 8 15 "Assumption")) (if all-christian-calendar-holidays (holiday-advent)) (holiday-fixed 12 25 "Christmas") (if all-christian-calendar-holidays (holiday-julian 12 25 "Eastern Orthodox Christmas")))) "\
*Christian holidays.
See the documentation for `calendar-holidays' for details.")
+(custom-autoload (quote christian-holidays) "calendar")
+
(put (quote islamic-holidays) (quote risky-local-variable) t)
(defvar islamic-holidays (quote ((holiday-islamic 1 1 (format "Islamic New Year %d" (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y 1) (extract-calendar-year (calendar-islamic-from-absolute (calendar-absolute-from-gregorian (list m (calendar-last-day-of-month m y) y))))))) (if all-islamic-calendar-holidays (holiday-islamic 1 10 "Ashura")) (if all-islamic-calendar-holidays (holiday-islamic 3 12 "Mulad-al-Nabi")) (if all-islamic-calendar-holidays (holiday-islamic 7 26 "Shab-e-Mi'raj")) (if all-islamic-calendar-holidays (holiday-islamic 8 15 "Shab-e-Bara't")) (holiday-islamic 9 1 "Ramadan Begins") (if all-islamic-calendar-holidays (holiday-islamic 9 27 "Shab-e Qadr")) (if all-islamic-calendar-holidays (holiday-islamic 10 1 "Id-al-Fitr")) (if all-islamic-calendar-holidays (holiday-islamic 12 10 "Id-al-Adha")))) "\
*Islamic holidays.
See the documentation for `calendar-holidays' for details.")
+(custom-autoload (quote islamic-holidays) "calendar")
+
(put (quote solar-holidays) (quote risky-local-variable) t)
(defvar solar-holidays (quote ((if (fboundp (quote atan)) (solar-equinoxes-solstices)) (if (progn (require (quote cal-dst)) t) (funcall (quote holiday-sexp) calendar-daylight-savings-starts (quote (format "Daylight Savings Time Begins %s" (if (fboundp (quote atan)) (solar-time-string (/ calendar-daylight-savings-starts-time (float 60)) calendar-standard-time-zone-name) ""))))) (funcall (quote holiday-sexp) calendar-daylight-savings-ends (quote (format "Daylight Savings Time Ends %s" (if (fboundp (quote atan)) (solar-time-string (/ calendar-daylight-savings-ends-time (float 60)) calendar-daylight-time-zone-name) "")))))) "\
*Sun-related holidays.
See the documentation for `calendar-holidays' for details.")
+(custom-autoload (quote solar-holidays) "calendar")
+
(put (quote calendar-holidays) (quote risky-local-variable) t)
(defvar calendar-setup nil "\
(autoload (quote calendar) "calendar" "\
Choose between the one frame, two frame, or basic calendar displays.
-The original function `calendar' has been renamed `calendar-basic-setup'." t nil)
-
-;;;***
-\f
-;;;### (autoloads nil "cc-langs" "progmodes/cc-langs.el" (15371 46426))
-;;; Generated autoloads from progmodes/cc-langs.el
-
-(defvar c-mode-syntax-table nil "\
-Syntax table used in c-mode buffers.")
-
-(defvar c++-mode-syntax-table nil "\
-Syntax table used in c++-mode buffers.")
-
-(defvar objc-mode-syntax-table nil "\
-Syntax table used in objc-mode buffers.")
-
-(defvar java-mode-syntax-table nil "\
-Syntax table used in java-mode buffers.")
+If called with an optional prefix argument, prompts for month and year.
-(defvar idl-mode-syntax-table nil "\
-Syntax table used in idl-mode buffers.")
+The original function `calendar' has been renamed `calendar-basic-setup'.
+See the documentation of that function for more information.
-(defvar pike-mode-syntax-table nil "\
-Syntax table used in pike-mode buffers.")
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (pike-mode idl-mode java-mode objc-mode c++-mode
;;;;;; c-mode c-initialize-cc-mode) "cc-mode" "progmodes/cc-mode.el"
-;;;;;; (15417 7450))
+;;;;;; (16174 61085))
;;; Generated autoloads from progmodes/cc-mode.el
-(autoload (quote c-initialize-cc-mode) "cc-mode" nil nil nil)
+(autoload (quote c-initialize-cc-mode) "cc-mode" "\
+Initialize CC Mode for use in the current buffer.
+If the optional NEW-STYLE-INIT is nil or left out then all necessary
+initialization to run CC Mode for the C language is done. Otherwise
+only some basic setup is done, and a call to `c-init-language-vars' or
+`c-init-language-vars-for' is necessary too (which gives more
+control). See \"cc-mode.el\" for more info.
+
+\(fn &optional NEW-STYLE-INIT)" nil nil)
+
+(defvar c-mode-syntax-table nil "\
+Syntax table used in c-mode buffers.")
+ (add-to-list 'auto-mode-alist '("\\.\\(cc\\|hh\\)\\'" . c++-mode))
+ (add-to-list 'auto-mode-alist '("\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\'" . c++-mode))
+ (add-to-list 'auto-mode-alist '("\\.\\(CC?\\|HH?\\)\\'" . c++-mode))
+ (add-to-list 'auto-mode-alist '("\\.[ch]\\'" . c-mode))
+ (add-to-list 'auto-mode-alist '("\\.y\\(acc\\)?\\'" . c-mode))
+ (add-to-list 'auto-mode-alist '("\\.lex\\'" . c-mode))
(autoload (quote c-mode) "cc-mode" "\
Major mode for editing K&R and ANSI C code.
To submit a problem report, enter `\\[c-submit-bug-report]' from a
c-mode buffer. This automatically sets up a mail buffer with version
information already added. You just need to add a description of the
-problem, including a reproducible test case and send the message.
+problem, including a reproducible test case, and send the message.
To see what version of CC Mode you are running, enter `\\[c-version]'.
-The hook variable `c-mode-hook' is run with no args, if that value is
-bound and has a non-nil value. Also the hook `c-mode-common-hook' is
-run first.
+The hook `c-mode-common-hook' is run with no args at mode
+initialization, then `c-mode-hook'.
Key bindings:
-\\{c-mode-map}" t nil)
+\\{c-mode-map}
+
+\(fn)" t nil)
+
+(defvar c++-mode-syntax-table nil "\
+Syntax table used in c++-mode buffers.")
(autoload (quote c++-mode) "cc-mode" "\
Major mode for editing C++ code.
To see what version of CC Mode you are running, enter `\\[c-version]'.
-The hook variable `c++-mode-hook' is run with no args, if that
-variable is bound and has a non-nil value. Also the hook
-`c-mode-common-hook' is run first.
+The hook `c-mode-common-hook' is run with no args at mode
+initialization, then `c++-mode-hook'.
Key bindings:
-\\{c++-mode-map}" t nil)
+\\{c++-mode-map}
+
+\(fn)" t nil)
+
+(defvar objc-mode-syntax-table nil "\
+Syntax table used in objc-mode buffers.")
+ (add-to-list 'auto-mode-alist '("\\.m\\'" . objc-mode))
(autoload (quote objc-mode) "cc-mode" "\
Major mode for editing Objective C code.
To see what version of CC Mode you are running, enter `\\[c-version]'.
-The hook variable `objc-mode-hook' is run with no args, if that value
-is bound and has a non-nil value. Also the hook `c-mode-common-hook'
-is run first.
+The hook `c-mode-common-hook' is run with no args at mode
+initialization, then `objc-mode-hook'.
Key bindings:
-\\{objc-mode-map}" t nil)
+\\{objc-mode-map}
+
+\(fn)" t nil)
+
+(defvar java-mode-syntax-table nil "\
+Syntax table used in java-mode buffers.")
+ (add-to-list 'auto-mode-alist '("\\.java\\'" . java-mode))
(autoload (quote java-mode) "cc-mode" "\
Major mode for editing Java code.
To submit a problem report, enter `\\[c-submit-bug-report]' from a
java-mode buffer. This automatically sets up a mail buffer with
version information already added. You just need to add a description
-of the problem, including a reproducible test case and send the
+of the problem, including a reproducible test case, and send the
message.
To see what version of CC Mode you are running, enter `\\[c-version]'.
-The hook variable `java-mode-hook' is run with no args, if that value
-is bound and has a non-nil value. Also the common hook
-`c-mode-common-hook' is run first. Note that this mode automatically
-sets the \"java\" style before calling any hooks so be careful if you
-set styles in `c-mode-common-hook'.
+The hook `c-mode-common-hook' is run with no args at mode
+initialization, then `java-mode-hook'.
Key bindings:
-\\{java-mode-map}" t nil)
+\\{java-mode-map}
+
+\(fn)" t nil)
+
+(defvar idl-mode-syntax-table nil "\
+Syntax table used in idl-mode buffers.")
+ (add-to-list 'auto-mode-alist '("\\.idl\\'" . idl-mode))
(autoload (quote idl-mode) "cc-mode" "\
-Major mode for editing CORBA's IDL code.
+Major mode for editing CORBA's IDL, PSDL and CIDL code.
To submit a problem report, enter `\\[c-submit-bug-report]' from an
idl-mode buffer. This automatically sets up a mail buffer with
version information already added. You just need to add a description
To see what version of CC Mode you are running, enter `\\[c-version]'.
-The hook variable `idl-mode-hook' is run with no args, if that
-variable is bound and has a non-nil value. Also the hook
-`c-mode-common-hook' is run first.
+The hook `c-mode-common-hook' is run with no args at mode
+initialization, then `idl-mode-hook'.
Key bindings:
-\\{idl-mode-map}" t nil)
+\\{idl-mode-map}
+
+\(fn)" t nil)
+
+(defvar pike-mode-syntax-table nil "\
+Syntax table used in pike-mode buffers.")
+ (add-to-list 'auto-mode-alist '("\\.\\(u?lpc\\|pike\\|pmod\\(.in\\)?\\)\\'" . pike-mode))
+ (add-to-list 'interpreter-mode-alist '("pike" . pike-mode))
(autoload (quote pike-mode) "cc-mode" "\
Major mode for editing Pike code.
-To submit a problem report, enter `\\[c-submit-bug-report]' from an
-idl-mode buffer. This automatically sets up a mail buffer with
+To submit a problem report, enter `\\[c-submit-bug-report]' from a
+pike-mode buffer. This automatically sets up a mail buffer with
version information already added. You just need to add a description
of the problem, including a reproducible test case, and send the
message.
To see what version of CC Mode you are running, enter `\\[c-version]'.
-The hook variable `pike-mode-hook' is run with no args, if that value
-is bound and has a non-nil value. Also the common hook
-`c-mode-common-hook' is run first.
+The hook `c-mode-common-hook' is run with no args at mode
+initialization, then `pike-mode-hook'.
Key bindings:
-\\{pike-mode-map}" t nil)
+\\{pike-mode-map}
+
+\(fn)" t nil)
+ (add-to-list 'auto-mode-alist '("\\.awk\\'" . awk-mode))
+ (add-to-list 'interpreter-mode-alist '("awk" . awk-mode))
+ (add-to-list 'interpreter-mode-alist '("mawk" . awk-mode))
+ (add-to-list 'interpreter-mode-alist '("nawk" . awk-mode))
+ (add-to-list 'interpreter-mode-alist '("gawk" . awk-mode))
+ (autoload 'awk-mode "cc-mode" "Major mode for editing AWK code.")
;;;***
\f
;;;### (autoloads (c-set-offset c-add-style c-set-style) "cc-styles"
-;;;;;; "progmodes/cc-styles.el" (15371 46426))
+;;;;;; "progmodes/cc-styles.el" (16139 20775))
;;; Generated autoloads from progmodes/cc-styles.el
(autoload (quote c-set-style) "cc-styles" "\
The variable `c-indentation-style' always contains the buffer's current
style name.
-If the optional argument DONT-OVERRIDE is non-nil, no style variables
-that already have values will be overridden. I.e. in the case of
+If the optional argument DONT-OVERRIDE is t, no style variables that
+already have values will be overridden. I.e. in the case of
`c-offsets-alist', syntactic symbols will only be added, and in the
case of all other style variables, only those set to `set-from-style'
will be reassigned.
-Obviously, specifying DONT-OVERRIDE is useful mainly when the initial
-style is chosen for a CC Mode buffer by a major mode. Since this is
-done internally by CC Mode, there's hardly ever a reason to use it." t nil)
+If DONT-OVERRIDE is neither nil nor t, only those style variables that
+have default (i.e. non-buffer local) values will keep their settings
+while the rest will be overridden. This is useful to avoid overriding
+global settings done in ~/.emacs when setting a style from a mode hook
+\(providing the style variables are buffer local, which is the
+default).
+
+Obviously, setting DONT-OVERRIDE to t is useful mainly when the
+initial style is chosen for a CC Mode buffer by a major mode. Since
+that is done internally by CC Mode, it typically won't have any effect
+when used elsewhere.
+
+\(fn STYLENAME &optional DONT-OVERRIDE)" t nil)
(autoload (quote c-add-style) "cc-styles" "\
Adds a style to `c-style-alist', or updates an existing one.
-STYLE is a string identifying the style to add or update. DESCRIP is
-an association list describing the style and must be of the form:
+STYLE is a string identifying the style to add or update. DESCRIPTION
+is an association list describing the style and must be of the form:
([BASESTYLE] (VARIABLE . VALUE) [(VARIABLE . VALUE) ...])
See the variable `c-style-alist' for the semantics of BASESTYLE,
VARIABLE and VALUE. This function also sets the current style to
-STYLE using `c-set-style' if the optional SET-P flag is non-nil." t nil)
+STYLE using `c-set-style' if the optional SET-P flag is non-nil.
+
+\(fn STYLE DESCRIPTION &optional SET-P)" t nil)
(autoload (quote c-set-offset) "cc-styles" "\
Change the value of a syntactic element symbol in `c-offsets-alist'.
SYMBOL is the syntactic element symbol to change and OFFSET is the new
offset for that syntactic element. The optional argument is not used
-and exists only for compatibility reasons." t nil)
-
-;;;***
-\f
-;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (15427 61508))
-;;; Generated autoloads from progmodes/cc-vars.el
-
-(defconst c-emacs-features (let ((infodock-p (boundp (quote infodock-version))) (comments (let ((table (copy-syntax-table)) entry) (modify-syntax-entry 97 ". 12345678" table) (cond ((arrayp table) (setq entry (aref table 97)) (if (consp entry) (setq entry (car entry)))) ((fboundp (quote get-char-table)) (setq entry (get-char-table 97 table))) ((and (fboundp (quote char-table-p)) (char-table-p table)) (setq entry (car (char-table-range table [97])))) (t (error "CC Mode is incompatible with this version of Emacs"))) (if (= (logand (lsh entry -16) 255) 255) (quote 8-bit) (quote 1-bit))))) (if infodock-p (list comments (quote infodock)) (list comments))) "\
-A list of features extant in the Emacs you are using.
-There are many flavors of Emacs out there, each with different
-features supporting those needed by CC Mode. Here's the current
-supported list, along with the values for this variable:
+and exists only for compatibility reasons.
- XEmacs 19, 20, 21: (8-bit)
- Emacs 19, 20: (1-bit)
-
-Infodock (based on XEmacs) has an additional symbol on this list:
-`infodock'.")
+\(fn SYMBOL OFFSET &optional IGNORED)" t nil)
;;;***
\f
;;;### (autoloads (ccl-execute-with-args check-ccl-program define-ccl-program
;;;;;; declare-ccl-program ccl-dump ccl-compile) "ccl" "international/ccl.el"
- ;;;;;; (16111 41831))
-;;;;;; (15371 46423))
++;;;;;; (16179 23394))
;;; Generated autoloads from international/ccl.el
(autoload (quote ccl-compile) "ccl" "\
-Return the compiled code of CCL-PROGRAM as a vector of integers." nil nil)
+Return the compiled code of CCL-PROGRAM as a vector of integers.
+
+\(fn CCL-PROGRAM)" nil nil)
(autoload (quote ccl-dump) "ccl" "\
-Disassemble compiled CCL-CODE." nil nil)
+Disassemble compiled CCL-CODE.
+
+\(fn CCL-CODE)" nil nil)
(autoload (quote declare-ccl-program) "ccl" "\
Declare NAME as a name of CCL program.
now CCL program names are resolved not at compile time but before
execution.
-Optional arg VECTOR is a compiled CCL code of the CCL program." nil (quote macro))
+Optional arg VECTOR is a compiled CCL code of the CCL program.
+
+\(fn NAME &optional VECTOR)" nil (quote macro))
(autoload (quote define-ccl-program) "ccl" "\
Set NAME the compiled code of CCL-PROGRAM.
STATEMENT :=
SET | IF | BRANCH | LOOP | REPEAT | BREAK | READ | WRITE | CALL
- | TRANSLATE | END
+ | TRANSLATE | MAP | LOOKUP | END
SET := (REG = EXPRESSION)
| (REG ASSIGNMENT_OPERATOR EXPRESSION)
;; (REG <8= ARG) is the same as:
;; ((REG <<= 8)
;; (REG |= ARG))
- | <8=
+ | <8=
;; (REG >8= ARG) is the same as:
;; ((r7 = (REG & 255))
(translate-character REG(table) REG(charset) REG(codepoint))
| (translate-character SYMBOL REG(charset) REG(codepoint))
;; SYMBOL must refer to a table defined by `define-translation-table'.
+LOOKUP :=
+ (lookup-character SYMBOL REG(charset) REG(codepoint))
+ | (lookup-integer SYMBOL REG(integer))
+ ;; SYMBOL refers to a table defined by `define-translation-hash-table'.
MAP :=
(iterate-multiple-map REG REG MAP-IDs)
| (map-multiple REG REG (MAP-SET))
MAP-IDs := MAP-ID ...
MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET
MAP-ID := integer
-" nil (quote macro))
+
+\(fn NAME CCL-PROGRAM &optional DOC)" nil (quote macro))
(autoload (quote check-ccl-program) "ccl" "\
Check validity of CCL-PROGRAM.
If CCL-PROGRAM is a symbol denoting a CCL program, return
CCL-PROGRAM, else return nil.
If CCL-PROGRAM is a vector and optional arg NAME (symbol) is supplied,
-register CCL-PROGRAM by name NAME, and return NAME." nil (quote macro))
+register CCL-PROGRAM by name NAME, and return NAME.
+
+\(fn CCL-PROGRAM &optional NAME)" nil (quote macro))
(autoload (quote ccl-execute-with-args) "ccl" "\
Execute CCL-PROGRAM with registers initialized by the remaining args.
The return value is a vector of resulting CCL registers.
-See the documentation of `define-ccl-program' for the detail of CCL program." nil nil)
+See the documentation of `define-ccl-program' for the detail of CCL program.
+
+\(fn CCL-PROG &rest ARGS)" nil nil)
;;;***
\f
;;;;;; checkdoc-comments checkdoc-continue checkdoc-start checkdoc-current-buffer
;;;;;; checkdoc-eval-current-buffer checkdoc-message-interactive
;;;;;; checkdoc-interactive checkdoc) "checkdoc" "emacs-lisp/checkdoc.el"
-;;;;;; (15464 26324))
+;;;;;; (16111 41827))
;;; Generated autoloads from emacs-lisp/checkdoc.el
(autoload (quote checkdoc) "checkdoc" "\
-Interactivly check the entire buffer for style errors.
-The current status of the ckeck will be displayed in a buffer which
-the users will view as each check is completed." t nil)
+Interactively check the entire buffer for style errors.
+The current status of the check will be displayed in a buffer which
+the users will view as each check is completed.
+
+\(fn)" t nil)
(autoload (quote checkdoc-interactive) "checkdoc" "\
Interactively check the current buffer for doc string errors.
buffer. Allows navigation forward and backwards through document
errors. Does not check for comment or space warnings.
Optional argument SHOWSTATUS indicates that we should update the
-checkdoc status window instead of the usual behavior." t nil)
+checkdoc status window instead of the usual behavior.
+
+\(fn &optional START-HERE SHOWSTATUS)" t nil)
(autoload (quote checkdoc-message-interactive) "checkdoc" "\
Interactively check the current buffer for message string errors.
buffer. Allows navigation forward and backwards through document
errors. Does not check for comment or space warnings.
Optional argument SHOWSTATUS indicates that we should update the
-checkdoc status window instead of the usual behavior." t nil)
+checkdoc status window instead of the usual behavior.
+
+\(fn &optional START-HERE SHOWSTATUS)" t nil)
(autoload (quote checkdoc-eval-current-buffer) "checkdoc" "\
Evaluate and check documentation for the current buffer.
Evaluation is done first because good documentation for something that
doesn't work is just not useful. Comments, doc strings, and rogue
-spacing are all verified." t nil)
+spacing are all verified.
+
+\(fn)" t nil)
(autoload (quote checkdoc-current-buffer) "checkdoc" "\
Check current buffer for document, comment, error style, and rogue spaces.
With a prefix argument (in Lisp, the argument TAKE-NOTES),
store all errors found in a warnings buffer,
-otherwise stop after the first error." t nil)
+otherwise stop after the first error.
+
+\(fn &optional TAKE-NOTES)" t nil)
(autoload (quote checkdoc-start) "checkdoc" "\
Start scanning the current buffer for documentation string style errors.
Only documentation strings are checked.
Use `checkdoc-continue' to continue checking if an error cannot be fixed.
Prefix argument TAKE-NOTES means to collect all the warning messages into
-a separate buffer." t nil)
+a separate buffer.
+
+\(fn &optional TAKE-NOTES)" t nil)
(autoload (quote checkdoc-continue) "checkdoc" "\
Find the next doc string in the current buffer which has a style error.
Prefix argument TAKE-NOTES means to continue through the whole buffer and
save warnings in a separate buffer. Second optional argument START-POINT
-is the starting location. If this is nil, `point-min' is used instead." t nil)
+is the starting location. If this is nil, `point-min' is used instead.
+
+\(fn &optional TAKE-NOTES)" t nil)
(autoload (quote checkdoc-comments) "checkdoc" "\
Find missing comment sections in the current Emacs Lisp file.
Prefix argument TAKE-NOTES non-nil means to save warnings in a
separate buffer. Otherwise print a message. This returns the error
-if there is one." t nil)
+if there is one.
+
+\(fn &optional TAKE-NOTES)" t nil)
(autoload (quote checkdoc-rogue-spaces) "checkdoc" "\
Find extra spaces at the end of lines in the current file.
Prefix argument TAKE-NOTES non-nil means to save warnings in a
separate buffer. Otherwise print a message. This returns the error
if there is one.
-Optional argument INTERACT permits more interactive fixing." t nil)
+Optional argument INTERACT permits more interactive fixing.
+
+\(fn &optional TAKE-NOTES INTERACT)" t nil)
(autoload (quote checkdoc-message-text) "checkdoc" "\
Scan the buffer for occurrences of the error function, and verify text.
-Optional argument TAKE-NOTES causes all errors to be logged." t nil)
+Optional argument TAKE-NOTES causes all errors to be logged.
+
+\(fn &optional TAKE-NOTES)" t nil)
(autoload (quote checkdoc-eval-defun) "checkdoc" "\
Evaluate the current form with `eval-defun' and check its documentation.
Evaluation is done first so the form will be read before the
documentation is checked. If there is a documentation error, then the display
-of what was evaluated will be overwritten by the diagnostic message." t nil)
+of what was evaluated will be overwritten by the diagnostic message.
+
+\(fn)" t nil)
(autoload (quote checkdoc-defun) "checkdoc" "\
Examine the doc string of the function or variable under point.
Call `error' if the doc string has problems. If NO-ERROR is
non-nil, then do not call error, but call `message' instead.
If the doc string passes the test, then check the function for rogue white
-space at the end of each line." t nil)
+space at the end of each line.
+
+\(fn &optional NO-ERROR)" t nil)
(autoload (quote checkdoc-ispell) "checkdoc" "\
Check the style and spelling of everything interactively.
Calls `checkdoc' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc'" t nil)
+Prefix argument TAKE-NOTES is the same as for `checkdoc'
+
+\(fn &optional TAKE-NOTES)" t nil)
(autoload (quote checkdoc-ispell-current-buffer) "checkdoc" "\
Check the style and spelling of the current buffer.
Calls `checkdoc-current-buffer' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-current-buffer'" t nil)
+Prefix argument TAKE-NOTES is the same as for `checkdoc-current-buffer'
+
+\(fn &optional TAKE-NOTES)" t nil)
(autoload (quote checkdoc-ispell-interactive) "checkdoc" "\
Check the style and spelling of the current buffer interactively.
Calls `checkdoc-interactive' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-interactive'" t nil)
+Prefix argument TAKE-NOTES is the same as for `checkdoc-interactive'
+
+\(fn &optional TAKE-NOTES)" t nil)
(autoload (quote checkdoc-ispell-message-interactive) "checkdoc" "\
Check the style and spelling of message text interactively.
Calls `checkdoc-message-interactive' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-message-interactive'" t nil)
+Prefix argument TAKE-NOTES is the same as for `checkdoc-message-interactive'
+
+\(fn &optional TAKE-NOTES)" t nil)
(autoload (quote checkdoc-ispell-message-text) "checkdoc" "\
Check the style and spelling of message text interactively.
Calls `checkdoc-message-text' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-message-text'" t nil)
+Prefix argument TAKE-NOTES is the same as for `checkdoc-message-text'
+
+\(fn &optional TAKE-NOTES)" t nil)
(autoload (quote checkdoc-ispell-start) "checkdoc" "\
Check the style and spelling of the current buffer.
Calls `checkdoc-start' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-start'" t nil)
+Prefix argument TAKE-NOTES is the same as for `checkdoc-start'
+
+\(fn &optional TAKE-NOTES)" t nil)
(autoload (quote checkdoc-ispell-continue) "checkdoc" "\
Check the style and spelling of the current buffer after point.
Calls `checkdoc-continue' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-continue'" t nil)
+Prefix argument TAKE-NOTES is the same as for `checkdoc-continue'
+
+\(fn &optional TAKE-NOTES)" t nil)
(autoload (quote checkdoc-ispell-comments) "checkdoc" "\
Check the style and spelling of the current buffer's comments.
Calls `checkdoc-comments' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-comments'" t nil)
+Prefix argument TAKE-NOTES is the same as for `checkdoc-comments'
+
+\(fn &optional TAKE-NOTES)" t nil)
(autoload (quote checkdoc-ispell-defun) "checkdoc" "\
Check the style and spelling of the current defun with Ispell.
Calls `checkdoc-defun' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-defun'" t nil)
+Prefix argument TAKE-NOTES is the same as for `checkdoc-defun'
+
+\(fn &optional TAKE-NOTES)" t nil)
(autoload (quote checkdoc-minor-mode) "checkdoc" "\
Toggle Checkdoc minor mode, a mode for checking Lisp doc strings.
bound to \\<checkdoc-minor-mode-map> \\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
checking of documentation strings.
-\\{checkdoc-minor-mode-map}" t nil)
+\\{checkdoc-minor-mode-map}
+
+\(fn &optional ARG)" t nil)
;;;***
\f
- ;;;### (autoloads (encode-hz-buffer encode-hz-region decode-hz-buffer
- ;;;;;; decode-hz-region) "china-util" "language/china-util.el" (16118
- ;;;;;; 44435))
+ ;;;### (autoloads (pre-write-encode-hz post-read-decode-hz encode-hz-buffer
+ ;;;;;; encode-hz-region decode-hz-buffer decode-hz-region) "china-util"
-;;;;;; "language/china-util.el" (15615 15524))
++;;;;;; "language/china-util.el" (16183 29903))
;;; Generated autoloads from language/china-util.el
(autoload (quote decode-hz-region) "china-util" "\
Decode HZ/ZW encoded text in the current region.
-Return the length of resulting text." t nil)
+Return the length of resulting text.
+
+\(fn BEG END)" t nil)
(autoload (quote decode-hz-buffer) "china-util" "\
-Decode HZ/ZW encoded text in the current buffer." t nil)
+Decode HZ/ZW encoded text in the current buffer.
+
+\(fn)" t nil)
(autoload (quote encode-hz-region) "china-util" "\
Encode the text in the current region to HZ.
-Return the length of resulting text." t nil)
+Return the length of resulting text.
+
+\(fn BEG END)" t nil)
(autoload (quote encode-hz-buffer) "china-util" "\
-Encode the text in the current buffer to HZ." t nil)
+Encode the text in the current buffer to HZ.
+
+\(fn)" t nil)
-(autoload (quote post-read-decode-hz) "china-util" nil nil nil)
++(autoload (quote post-read-decode-hz) "china-util" "\
++Not documented
+
-(autoload (quote pre-write-encode-hz) "china-util" nil nil nil)
++\(fn LEN)" nil nil)
++
++(autoload (quote pre-write-encode-hz) "china-util" "\
++Not documented
++
++\(fn FROM TO)" nil nil)
+
;;;***
\f
;;;### (autoloads (command-history list-command-history repeat-matching-complex-command)
-;;;;;; "chistory" "chistory.el" (15371 46415))
+;;;;;; "chistory" "chistory.el" (15878 5274))
;;; Generated autoloads from chistory.el
(autoload (quote repeat-matching-complex-command) "chistory" "\
Matching occurrences are displayed, most recent first, until you select
a form for evaluation. If PATTERN is empty (or nil), every form in the
command history is offered. The form is placed in the minibuffer for
-editing and the result is evaluated." t nil)
+editing and the result is evaluated.
+
+\(fn &optional PATTERN)" t nil)
(autoload (quote list-command-history) "chistory" "\
List history of commands typed to minibuffer.
Calls value of `list-command-history-filter' (if non-nil) on each history
element to judge if that element should be excluded from the list.
-The buffer is left in Command History mode." t nil)
+The buffer is left in Command History mode.
+
+\(fn)" t nil)
(autoload (quote command-history) "chistory" "\
Examine commands from `command-history' in a buffer.
\\{command-history-map}
This command always recompiles the Command History listing
-and runs the normal hook `command-history-hook'." t nil)
+and runs the normal hook `command-history-hook'.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads nil "cl" "emacs-lisp/cl.el" (15391 60525))
+;;;### (autoloads nil "cl" "emacs-lisp/cl.el" (15856 53273))
;;; Generated autoloads from emacs-lisp/cl.el
(defvar custom-print-functions nil "\
;;;***
\f
;;;### (autoloads (common-lisp-indent-function) "cl-indent" "emacs-lisp/cl-indent.el"
-;;;;;; (15417 7413))
+;;;;;; (16054 60749))
;;; Generated autoloads from emacs-lisp/cl-indent.el
-(autoload (quote common-lisp-indent-function) "cl-indent" nil nil nil)
+(autoload (quote common-lisp-indent-function) "cl-indent" "\
+Not documented
+
+\(fn INDENT-POINT STATE)" nil nil)
;;;***
\f
;;;### (autoloads (c-macro-expand) "cmacexp" "progmodes/cmacexp.el"
-;;;;;; (15371 46426))
+;;;;;; (15251 46612))
;;; Generated autoloads from progmodes/cmacexp.el
(autoload (quote c-macro-expand) "cmacexp" "\
if the user option `c-macro-prompt-flag' is non-nil.
Noninteractive args are START, END, SUBST.
-For use inside Lisp programs, see also `c-macro-expansion'." t nil)
+For use inside Lisp programs, see also `c-macro-expansion'.
+
+\(fn START END SUBST)" t nil)
;;;***
\f
-;;;### (autoloads (run-scheme) "cmuscheme" "cmuscheme.el" (15400
-;;;;;; 1471))
+;;;### (autoloads (run-scheme) "cmuscheme" "cmuscheme.el" (15941
+;;;;;; 42951))
;;; Generated autoloads from cmuscheme.el
(autoload (quote run-scheme) "cmuscheme" "\
With argument, allows you to edit the command line (default is value
of `scheme-program-name'). Runs the hooks `inferior-scheme-mode-hook'
\(after the `comint-mode-hook' is run).
-\(Type \\[describe-mode] in the process buffer for a list of commands.)" t nil)
+\(Type \\[describe-mode] in the process buffer for a list of commands.)
+
+\(fn CMD)" t nil)
(add-hook 'same-window-buffer-names "*scheme*")
;;;***
\f
- ;;;### (autoloads (cp-make-coding-system) "code-pages" "international/code-pages.el"
- ;;;;;; (16121 18697))
- ;;; Generated autoloads from international/code-pages.el
-
- (autoload (quote cp-make-coding-system) "code-pages" "\
- Make coding system NAME for and 8-bit, extended-ASCII character set.
- V is a 128-long vector of characters to translate the upper half of
- the charactert set. DOC-STRING and MNEMONIC are used as the
- corresponding args of `make-coding-system'. If MNEMONIC isn't given,
- ?* is used.
-
- \(fn NAME V &optional DOC-STRING MNEMONIC)" nil (quote macro))
-
- ;;;***
- \f
- ;;;### (autoloads (codepage-setup cp-supported-codepages cp-offset-for-codepage
- ;;;;;; cp-language-for-codepage cp-charset-for-codepage cp-make-coding-systems-for-codepage)
- ;;;;;; "codepage" "international/codepage.el" (15941 42961))
+ ;;;### (autoloads (codepage-setup) "codepage" "international/codepage.el"
-;;;;;; (15588 59293))
++;;;;;; (16179 34039))
;;; Generated autoloads from international/codepage.el
- (autoload (quote cp-make-coding-systems-for-codepage) "codepage" "\
- 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.
-
- \(fn CODEPAGE ISO-NAME OFFSET)" nil nil)
-
- (autoload (quote 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.
-
- \(fn CODEPAGE)" nil nil)
-
- (autoload (quote 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.
-
- \(fn CODEPAGE)" nil nil)
-
- (autoload (quote 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.
-
- \(fn CODEPAGE)" nil nil)
-
- (autoload (quote cp-supported-codepages) "codepage" "\
- 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.
-
- \(fn)" nil nil)
-
(autoload (quote codepage-setup) "codepage" "\
- Create a coding system cpCODEPAGE to support the IBM codepage CODEPAGE.
-Obsolete. All coding systems are set up initially." t nil)
++Obsolete. All coding systems are set up initially.
+
- 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.
-
- \(fn CODEPAGE)" t nil)
++\(fn &optional CODEPAGE)" t nil)
;;;***
\f
;;;### (autoloads (comint-redirect-results-list-from-process comint-redirect-results-list
;;;;;; comint-redirect-send-command-to-process comint-redirect-send-command
;;;;;; comint-run make-comint make-comint-in-buffer) "comint" "comint.el"
-;;;;;; (15482 42811))
+;;;;;; (16168 11508))
;;; Generated autoloads from comint.el
(autoload (quote make-comint-in-buffer) "comint" "\
running process in that buffer, it is not restarted. Optional third arg
STARTFILE is the name of a file to send the contents of to the process.
-If PROGRAM is a string, any more args are arguments to PROGRAM." nil nil)
+If PROGRAM is a string, any more args are arguments to PROGRAM.
+
+\(fn NAME BUFFER PROGRAM &optional STARTFILE &rest SWITCHES)" nil nil)
(autoload (quote make-comint) "comint" "\
Make a comint process NAME in a buffer, running PROGRAM.
running process in that buffer, it is not restarted. Optional third arg
STARTFILE is the name of a file to send the contents of to the process.
-If PROGRAM is a string, any more args are arguments to PROGRAM." nil nil)
+If PROGRAM is a string, any more args are arguments to PROGRAM.
+
+\(fn NAME PROGRAM &optional STARTFILE &rest SWITCHES)" nil nil)
(autoload (quote comint-run) "comint" "\
Run PROGRAM in a comint buffer and switch to it.
The buffer name is made by surrounding the file name of PROGRAM with `*'s.
The file name is used to make a symbol name, such as `comint-sh-hook', and any
hooks on this symbol are run in the buffer.
-See `make-comint' and `comint-exec'." t nil)
+See `make-comint' and `comint-exec'.
+
+\(fn PROGRAM)" t nil)
(autoload (quote comint-redirect-send-command) "comint" "\
Send COMMAND to process in current buffer, with output to OUTPUT-BUFFER.
With prefix arg, echo output in process buffer.
-If NO-DISPLAY is non-nil, do not show the output buffer." t nil)
+If NO-DISPLAY is non-nil, do not show the output buffer.
+
+\(fn COMMAND OUTPUT-BUFFER ECHO &optional NO-DISPLAY)" t nil)
(autoload (quote comint-redirect-send-command-to-process) "comint" "\
Send COMMAND to PROCESS, with output to OUTPUT-BUFFER.
With prefix arg, echo output in process buffer.
-If NO-DISPLAY is non-nil, do not show the output buffer." t nil)
+If NO-DISPLAY is non-nil, do not show the output buffer.
+
+\(fn COMMAND OUTPUT-BUFFER PROCESS ECHO &optional NO-DISPLAY)" t nil)
(autoload (quote comint-redirect-results-list) "comint" "\
Send COMMAND to current process.
Return a list of expressions in the output which match REGEXP.
-REGEXP-GROUP is the regular expression group in REGEXP to use." nil nil)
+REGEXP-GROUP is the regular expression group in REGEXP to use.
+
+\(fn COMMAND REGEXP REGEXP-GROUP)" nil nil)
(autoload (quote comint-redirect-results-list-from-process) "comint" "\
Send COMMAND to PROCESS.
Return a list of expressions in the output which match REGEXP.
-REGEXP-GROUP is the regular expression group in REGEXP to use." nil nil)
+REGEXP-GROUP is the regular expression group in REGEXP to use.
+
+\(fn PROCESS COMMAND REGEXP REGEXP-GROUP)" nil nil)
;;;***
\f
-;;;### (autoloads (compare-windows) "compare-w" "compare-w.el" (15371
-;;;;;; 46415))
+;;;### (autoloads (compare-windows) "compare-w" "compare-w.el" (15678
+;;;;;; 51462))
;;; Generated autoloads from compare-w.el
(autoload (quote compare-windows) "compare-w" "\
A prefix arg means ignore changes in whitespace.
The variable `compare-windows-whitespace' controls how whitespace is skipped.
-If `compare-ignore-case' is non-nil, changes in case are also ignored." t nil)
+If `compare-ignore-case' is non-nil, changes in case are also ignored.
+
+\(fn IGNORE-WHITESPACE)" t nil)
;;;***
\f
;;;### (autoloads (next-error compilation-minor-mode compilation-shell-minor-mode
-;;;;;; compilation-mode grep-find grep compile compilation-search-path
+;;;;;; compilation-mode grep-tree grep-find grep compile compilation-search-path
;;;;;; compilation-ask-about-save compilation-window-height compilation-mode-hook)
-;;;;;; "compile" "progmodes/compile.el" (15464 26331))
+;;;;;; "compile" "progmodes/compile.el" (16167 21090))
;;; Generated autoloads from progmodes/compile.el
(defvar compilation-mode-hook nil "\
*List of hook functions run by `compilation-mode' (see `run-hooks').")
+(custom-autoload (quote compilation-mode-hook) "compile")
+
(defvar compilation-window-height nil "\
*Number of lines in a compilation window. If nil, use Emacs default.")
+(custom-autoload (quote compilation-window-height) "compile")
+
(defvar compilation-process-setup-function nil "\
*Function to call to customize the compilation process.
This functions is called immediately before the compilation process is
*Non-nil means \\[compile] asks which buffers to save before compiling.
Otherwise, it saves all modified buffers without asking.")
+(custom-autoload (quote compilation-ask-about-save) "compile")
+
(defvar compilation-search-path (quote (nil)) "\
*List of directories to search for source files named in error messages.
Elements should be directory names, not file names of directories.
nil as an element means to try the default directory.")
+(custom-autoload (quote compilation-search-path) "compile")
+
(autoload (quote compile) "compile" "\
Compile the program including the current buffer. Default: run `make'.
Runs COMMAND, a shell command, in a separate process asynchronously
Interactively, prompts for the command if `compilation-read-command' is
non-nil; otherwise uses `compile-command'. With prefix arg, always prompts.
-To run more than one compilation at once, start one and rename the
-`*compilation*' buffer to some other name with \\[rename-buffer].
-Then start the next one.
+To run more than one compilation at once, start one and rename
+the `*compilation*' buffer to some other name with
+\\[rename-buffer]. Then start the next one. On most systems,
+termination of the main compilation process kills its
+subprocesses.
The name used for the buffer is actually whatever is returned by
the function in `compilation-buffer-name-function', so you can set that
-to a function that generates a unique name." t nil)
+to a function that generates a unique name.
+
+\(fn COMMAND)" t nil)
(autoload (quote grep) "compile" "\
Run grep, with user-specified args, and collect output in a buffer.
A prefix argument says to default the argument based upon the current
tag the cursor is over, substituting it into the last grep command
in the grep command history (or into `grep-command'
-if that history list is empty)." t nil)
+if that history list is empty).
+
+\(fn COMMAND-ARGS)" t nil)
(autoload (quote grep-find) "compile" "\
Run grep via find, with user-specified args COMMAND-ARGS.
to find the text that grep hits refer to.
This command uses a special history list for its arguments, so you can
-easily repeat a find command." t nil)
+easily repeat a find command.
+
+\(fn COMMAND-ARGS)" t nil)
+
+(autoload (quote grep-tree) "compile" "\
+Grep for REGEXP in FILES in directory tree rooted at DIR.
+Collect output in a buffer.
+Interactively, prompt separately for each search parameter.
+With prefix arg, reuse previous REGEXP.
+The search is limited to file names matching shell pattern FILES.
+FILES may use abbreviations defined in `grep-tree-files-aliases', e.g.
+entering `ch' is equivalent to `*.[ch]'.
+
+While find runs asynchronously, you can use the \\[next-error] command
+to find the text that grep hits refer to.
+
+This command uses a special history list for its arguments, so you can
+easily repeat a find command.
+
+When used non-interactively, optional arg SUBDIRS limits the search to
+those sub directories of DIR.
+
+\(fn REGEXP FILES DIR &optional SUBDIRS)" t nil)
(autoload (quote compilation-mode) "compile" "\
Major mode for compilation log buffers.
move point to the error message line and type \\[compile-goto-error].
To kill the compilation, type \\[kill-compilation].
-Runs `compilation-mode-hook' with `run-hooks' (which see)." t nil)
+Runs `compilation-mode-hook' with `run-hooks' (which see).
+
+\(fn &optional NAME-OF-MODE)" t nil)
(autoload (quote compilation-shell-minor-mode) "compile" "\
Toggle compilation shell minor mode.
With arg, turn compilation mode on if and only if arg is positive.
-See `compilation-mode'.
-Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'." t nil)
+In this minor mode, all the error-parsing commands of the
+Compilation major mode are available but bound to keys that don't
+collide with Shell mode. See `compilation-mode'.
+Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'.
+
+\(fn &optional ARG)" t nil)
(autoload (quote compilation-minor-mode) "compile" "\
Toggle compilation minor mode.
With arg, turn compilation mode on if and only if arg is positive.
-See `compilation-mode'.
-Turning the mode on runs the normal hook `compilation-minor-mode-hook'." t nil)
+In this minor mode, all the error-parsing commands of the
+Compilation major mode are available. See `compilation-mode'.
+Turning the mode on runs the normal hook `compilation-minor-mode-hook'.
+
+\(fn &optional ARG)" t nil)
(autoload (quote next-error) "compile" "\
Visit next compilation error message and corresponding source code.
uses Compilation mode or Compilation Minor mode.
See variables `compilation-parse-errors-function' and
-`compilation-error-regexp-alist' for customization ideas." t nil)
+`compilation-error-regexp-alist' for customization ideas.
+
+\(fn &optional ARGP)" t nil)
(define-key ctl-x-map "`" 'next-error)
;;;***
\f
;;;### (autoloads (partial-completion-mode) "complete" "complete.el"
-;;;;;; (15371 46415))
+;;;;;; (15856 53268))
;;; Generated autoloads from complete.el
(defvar partial-completion-mode nil "\
Setting this variable directly does not take effect;
use either \\[customize] or the function `partial-completion-mode'.")
-(custom-add-to-group (quote partial-completion) (quote partial-completion-mode) (quote custom-variable))
-
-(custom-add-load (quote partial-completion-mode) (quote complete))
+(custom-autoload (quote partial-completion-mode) "complete")
(autoload (quote partial-completion-mode) "complete" "\
Toggle Partial Completion mode.
Unless `PC-disable-includes' is non-nil, the `<...>' sequence is interpreted
specially in \\[find-file]. For example,
\\[find-file] <sys/time.h> RET finds the file `/usr/include/sys/time.h'.
-See also the variable `PC-include-file-path'." t nil)
+See also the variable `PC-include-file-path'.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (dynamic-completion-mode) "completion" "completion.el"
-;;;;;; (15400 1471))
+;;;;;; (15941 42951))
;;; Generated autoloads from completion.el
(autoload (quote dynamic-completion-mode) "completion" "\
-Enable dynamic word-completion." t nil)
-
-;;;***
-\f
-;;;### (autoloads (decompose-composite-char compose-last-chars compose-chars-after
-;;;;;; find-composition compose-chars decompose-string compose-string
-;;;;;; decompose-region compose-region) "composite" "composite.el"
-;;;;;; (15371 46415))
-;;; Generated autoloads from composite.el
-
-(defconst reference-point-alist (quote ((tl . 0) (tc . 1) (tr . 2) (Bl . 3) (Bc . 4) (Br . 5) (bl . 6) (bc . 7) (br . 8) (cl . 9) (cc . 10) (cr . 11) (top-left . 0) (top-center . 1) (top-right . 2) (base-left . 3) (base-center . 4) (base-right . 5) (bottom-left . 6) (bottom-center . 7) (bottom-right . 8) (center-left . 9) (center-center . 10) (center-right . 11) (ml . 3) (mc . 10) (mr . 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'.
-
-Meanings of glyph reference point codes are as follows:
-
- 0----1----2 <---- ascent 0:tl or top-left
- | | 1:tc or top-center
- | | 2:tr or top-right
- | | 3:Bl or base-left 9:cl or center-left
- 9 10 11 <---- center 4:Bc or base-center 10:cc or center-center
- | | 5:Br or base-right 11:cr or center-right
- --3----4----5-- <-- baseline 6:bl or bottom-left
- | | 7:bc or bottom-center
- 6----7----8 <---- descent 8:br or bottom-right
-
-Glyph reference point symbols are to be used to specify composition
-rule of the form (GLOBAL-REF-POINT . NEW-REF-POINT), where
-GLOBAL-REF-POINT is a reference point in the overall glyphs already
-composed, and NEW-REF-POINT is a reference point in the new glyph to
-be added.
-
-For instance, if GLOBAL-REF-POINT is `br' (bottom-right) and
-NEW-REF-POINT is `tc' (top-center), the overall glyph is updated as
-follows (the point `*' corresponds to both reference points):
-
- +-------+--+ <--- new ascent
- | | |
- | global| |
- | glyph | |
- -- | | |-- <--- baseline (doesn't change)
- +----+--*--+
- | | new |
- | |glyph|
- +----+-----+ <--- new descent
-")
-
-(autoload (quote compose-region) "composite" "\
-Compose characters in the current region.
-
-When called from a program, expects these four arguments.
-
-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.
-
-If it is a character, it is an alternate character to display instead
-of the text in the region.
-
-If it is a string, the elements are alternate characters.
-
-If it is a vector or list, it is a sequence of alternate characters and
-composition rules, where (2N)th elements are characters and (2N+1)th
-elements are composition rules to specify how to compose (2N+2)th
-elements with previously composed N glyphs.
-
-A composition rule is a cons of global and new glyph reference point
-symbols. See the documentation of `reference-point-alist' for more
-detail.
+Enable dynamic word-completion.
-Optional 4th argument MODIFICATION-FUNC is a function to call to
-adjust the composition when it gets invalid because of a change of
-text in the composition." t nil)
-
-(autoload (quote decompose-region) "composite" "\
-Decompose text in the current region.
-
-When called from a program, expects two arguments,
-positions (integers or markers) specifying the region." t nil)
-
-(autoload (quote compose-string) "composite" "\
-Compose characters in string STRING.
-
-The return value is STRING where `composition' property is put on all
-the characters in it.
-
-Optional 2nd and 3rd arguments START and END specify the range of
-STRING to be composed. They defaults to the beginning and the end of
-STRING respectively.
-
-Optional 4th argument COMPONENTS, if non-nil, is a character or a
-sequence (vector, list, or string) of integers. See the function
-`compose-region' for more detail.
-
-Optional 5th argument MODIFICATION-FUNC is a function to call to
-adjust the composition when it gets invalid because of a change of
-text in the composition." nil nil)
-
-(autoload (quote decompose-string) "composite" "\
-Return STRING where `composition' property is removed." nil nil)
-
-(autoload (quote compose-chars) "composite" "\
-Return a string from arguments in which all characters are composed.
-For relative composition, arguments are characters.
-For rule-based composition, Mth (where M is odd) arguments are
-characters, and Nth (where N is even) arguments are composition rules.
-A composition rule is a cons of glyph reference points of the form
-\(GLOBAL-REF-POINT . NEW-REF-POINT). See the documentation of
-`reference-point-alist' for more detail." nil nil)
-
-(autoload (quote find-composition) "composite" "\
-Return information about a composition at or nearest to buffer position POS.
-
-If the character at POS has `composition' property, the value is a list
-of FROM, TO, and VALID-P.
-
-FROM and TO specify the range of text that has the same `composition'
-property, VALID-P is non-nil if and only if this composition is valid.
-
-If there's no composition at POS, and the optional 2nd argument LIMIT
-is non-nil, search for a composition toward LIMIT.
-
-If no composition is found, return nil.
-
-Optional 3rd argument STRING, if non-nil, is a string to look for a
-composition in; nil means the current buffer.
-
-If a valid composition is found and the optional 4th argument DETAIL-P
-is non-nil, the return value is a list of FROM, TO, COMPONENTS,
-RELATIVE-P, MOD-FUNC, and WIDTH.
-
-COMPONENTS is a vector of integers, the meaning depends on RELATIVE-P.
-
-RELATIVE-P is t if the composition method is relative, else nil.
-
-If RELATIVE-P is t, COMPONENTS is a vector of characters to be
-composed. If RELATIVE-P is nil, COMPONENTS is a vector of characters
-and composition rules as described in `compose-region'.
-
-MOD-FUNC is a modification function of the composition.
-
-WIDTH is a number of columns the composition occupies on the screen." nil nil)
-
-(autoload (quote compose-chars-after) "composite" "\
-Compose characters in current buffer after position POS.
-
-It looks up the char-table `composition-function-table' (which see) by
-a character after POS. If non-nil value is found, the format of the
-value should be an alist of PATTERNs vs FUNCs, where PATTERNs are
-regular expressions and FUNCs are functions. If the text after POS
-matches one of PATTERNs, call the corresponding FUNC with three
-arguments POS, TO, and PATTERN, where TO is the end position of text
-matching PATTERN, and return what FUNC returns. Otherwise, return
-nil.
-
-FUNC is responsible for composing the text properly. The return value
-is:
- nil -- if no characters were composed.
- CHARS (integer) -- if CHARS characters were composed.
-
-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.
-
-This function is the default value of `compose-chars-after-function'." nil nil)
-
-(autoload (quote compose-last-chars) "composite" "\
-Compose last characters.
-The argument is a parameterized event of the form
- (compose-last-chars N COMPONENTS),
-where N is the number of characters before point to compose,
-COMPONENTS, if non-nil, is the same as the argument to `compose-region'
-\(which see). If it is nil, `compose-chars-after' is called,
-and that function find a proper rule to compose the target characters.
-This function is intended to be used from input methods.
-The global keymap binds special event `compose-last-chars' to this
-function. Input method may generate an event (compose-last-chars N COMPONENTS)
-after a sequence character events." t nil)
-(global-set-key [compose-last-chars] 'compose-last-chars)
-
-(autoload (quote decompose-composite-char) "composite" "\
-Convert CHAR to string.
-This is only for backward compatibility with Emacs 20.4 and the earlier.
-
-If optional 2nd arg TYPE is non-nil, it is `string', `list', or
-`vector'. In this case, CHAR is converted string, list of CHAR, or
-vector of CHAR respectively." nil nil)
+\(fn)" t nil)
- ;;;***
- \f
- ;;;### (autoloads (decompose-composite-char compose-last-chars compose-chars-after
- ;;;;;; find-composition compose-chars decompose-string compose-string
- ;;;;;; decompose-region compose-region) "composite" "composite.el"
- ;;;;;; (15941 42951))
- ;;; Generated autoloads from composite.el
-
- (defconst reference-point-alist (quote ((tl . 0) (tc . 1) (tr . 2) (Bl . 3) (Bc . 4) (Br . 5) (bl . 6) (bc . 7) (br . 8) (cl . 9) (cc . 10) (cr . 11) (top-left . 0) (top-center . 1) (top-right . 2) (base-left . 3) (base-center . 4) (base-right . 5) (bottom-left . 6) (bottom-center . 7) (bottom-right . 8) (center-left . 9) (center-center . 10) (center-right . 11) (ml . 3) (mc . 10) (mr . 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'.
-
- Meanings of glyph reference point codes are as follows:
-
- 0----1----2 <---- ascent 0:tl or top-left
- | | 1:tc or top-center
- | | 2:tr or top-right
- | | 3:Bl or base-left 9:cl or center-left
- 9 10 11 <---- center 4:Bc or base-center 10:cc or center-center
- | | 5:Br or base-right 11:cr or center-right
- --3----4----5-- <-- baseline 6:bl or bottom-left
- | | 7:bc or bottom-center
- 6----7----8 <---- descent 8:br or bottom-right
-
- Glyph reference point symbols are to be used to specify composition
- rule of the form (GLOBAL-REF-POINT . NEW-REF-POINT), where
- GLOBAL-REF-POINT is a reference point in the overall glyphs already
- composed, and NEW-REF-POINT is a reference point in the new glyph to
- be added.
-
- For instance, if GLOBAL-REF-POINT is `br' (bottom-right) and
- NEW-REF-POINT is `tc' (top-center), the overall glyph is updated as
- follows (the point `*' corresponds to both reference points):
-
- +-------+--+ <--- new ascent
- | | |
- | global| |
- | glyph | |
- -- | | |-- <--- baseline (doesn't change)
- +----+--*--+
- | | new |
- | |glyph|
- +----+-----+ <--- new descent
- ")
-
- (autoload (quote compose-region) "composite" "\
- Compose characters in the current region.
-
- Characters are composed relatively, i.e. composed by overstricking or
- stacking depending on ascent, descent and other properties.
-
- When called from a program, expects these four arguments.
-
- 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.
-
- If it is a character, it is an alternate character to display instead
- of the text in the region.
-
- If it is a string, the elements are alternate characters.
-
- If it is a vector or list, it is a sequence of alternate characters and
- composition rules, where (2N)th elements are characters and (2N+1)th
- elements are composition rules to specify how to compose (2N+2)th
- elements with previously composed N glyphs.
-
- A composition rule is a cons of global and new glyph reference point
- symbols. See the documentation of `reference-point-alist' for more
- detail.
-
- Optional 4th argument MODIFICATION-FUNC is a function to call to
- adjust the composition when it gets invalid because of a change of
- text in the composition.
-
- \(fn START END &optional COMPONENTS MODIFICATION-FUNC)" t nil)
-
- (autoload (quote decompose-region) "composite" "\
- Decompose text in the current region.
-
- When called from a program, expects two arguments,
- positions (integers or markers) specifying the region.
-
- \(fn START END)" t nil)
-
- (autoload (quote compose-string) "composite" "\
- Compose characters in string STRING.
-
- The return value is STRING where `composition' property is put on all
- the characters in it.
-
- Optional 2nd and 3rd arguments START and END specify the range of
- STRING to be composed. They defaults to the beginning and the end of
- STRING respectively.
-
- Optional 4th argument COMPONENTS, if non-nil, is a character or a
- sequence (vector, list, or string) of integers. See the function
- `compose-region' for more detail.
-
- Optional 5th argument MODIFICATION-FUNC is a function to call to
- adjust the composition when it gets invalid because of a change of
- text in the composition.
-
- \(fn STRING &optional START END COMPONENTS MODIFICATION-FUNC)" nil nil)
-
- (autoload (quote decompose-string) "composite" "\
- Return STRING where `composition' property is removed.
-
- \(fn STRING)" nil nil)
-
- (autoload (quote compose-chars) "composite" "\
- Return a string from arguments in which all characters are composed.
- For relative composition, arguments are characters.
- For rule-based composition, Mth (where M is odd) arguments are
- characters, and Nth (where N is even) arguments are composition rules.
- A composition rule is a cons of glyph reference points of the form
- \(GLOBAL-REF-POINT . NEW-REF-POINT). See the documentation of
- `reference-point-alist' for more detail.
-
- \(fn &rest ARGS)" nil nil)
-
- (autoload (quote find-composition) "composite" "\
- Return information about a composition at or nearest to buffer position POS.
-
- If the character at POS has `composition' property, the value is a list
- of FROM, TO, and VALID-P.
-
- FROM and TO specify the range of text that has the same `composition'
- property, VALID-P is non-nil if and only if this composition is valid.
-
- If there's no composition at POS, and the optional 2nd argument LIMIT
- is non-nil, search for a composition toward LIMIT.
-
- If no composition is found, return nil.
-
- Optional 3rd argument STRING, if non-nil, is a string to look for a
- composition in; nil means the current buffer.
-
- If a valid composition is found and the optional 4th argument DETAIL-P
- is non-nil, the return value is a list of FROM, TO, COMPONENTS,
- RELATIVE-P, MOD-FUNC, and WIDTH.
-
- COMPONENTS is a vector of integers, the meaning depends on RELATIVE-P.
-
- RELATIVE-P is t if the composition method is relative, else nil.
-
- If RELATIVE-P is t, COMPONENTS is a vector of characters to be
- composed. If RELATIVE-P is nil, COMPONENTS is a vector of characters
- and composition rules as described in `compose-region'.
-
- MOD-FUNC is a modification function of the composition.
-
- WIDTH is a number of columns the composition occupies on the screen.
-
- \(fn POS &optional LIMIT STRING DETAIL-P)" nil nil)
-
- (autoload (quote compose-chars-after) "composite" "\
- Compose characters in current buffer after position POS.
-
- It looks up the char-table `composition-function-table' (which see) by
- a character after POS. If non-nil value is found, the format of the
- value should be an alist of PATTERNs vs FUNCs, where PATTERNs are
- regular expressions and FUNCs are functions. If the text after POS
- matches one of PATTERNs, call the corresponding FUNC with three
- arguments POS, TO, and PATTERN, where TO is the end position of text
- matching PATTERN, and return what FUNC returns. Otherwise, return
- nil.
-
- FUNC is responsible for composing the text properly. The return value
- is:
- nil -- if no characters were composed.
- CHARS (integer) -- if CHARS characters were composed.
-
- 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.
-
- This function is the default value of `compose-chars-after-function'.
-
- \(fn POS &optional LIMIT OBJECT)" nil nil)
-
- (autoload (quote compose-last-chars) "composite" "\
- Compose last characters.
- The argument is a parameterized event of the form
- (compose-last-chars N COMPONENTS),
- where N is the number of characters before point to compose,
- COMPONENTS, if non-nil, is the same as the argument to `compose-region'
- \(which see). If it is nil, `compose-chars-after' is called,
- and that function find a proper rule to compose the target characters.
- This function is intended to be used from input methods.
- The global keymap binds special event `compose-last-chars' to this
- function. Input method may generate an event (compose-last-chars N COMPONENTS)
- after a sequence character events.
-
- \(fn ARGS)" t nil)
- (global-set-key [compose-last-chars] 'compose-last-chars)
-
- (autoload (quote decompose-composite-char) "composite" "\
- Convert CHAR to string.
-
- If optional 2nd arg TYPE is non-nil, it is `string', `list', or
- `vector'. In this case, CHAR is converted to string, list of CHAR, or
- vector of CHAR respectively.
- Optional 3rd arg WITH-COMPOSITION-RULE is ignored.
-
- \(fn CHAR &optional TYPE WITH-COMPOSITION-RULE)" nil nil)
-
- (make-obsolete (quote decompose-composite-char) (quote char-to-string) "21.1")
-
;;;***
\f
;;;### (autoloads (shuffle-vector cookie-snarf cookie-insert cookie)
-;;;;;; "cookie1" "play/cookie1.el" (15391 60712))
+;;;;;; "cookie1" "play/cookie1.el" (15366 772))
;;; Generated autoloads from play/cookie1.el
(autoload (quote cookie) "cookie1" "\
Return a random phrase from PHRASE-FILE.
When the phrase file is read in, display STARTMSG at the beginning
-of load, ENDMSG at the end." nil nil)
+of load, ENDMSG at the end.
+
+\(fn PHRASE-FILE STARTMSG ENDMSG)" nil nil)
(autoload (quote cookie-insert) "cookie1" "\
Insert random phrases from PHRASE-FILE; COUNT of them.
When the phrase file is read in, display STARTMSG at the beginning
-of load, ENDMSG at the end." nil nil)
+of load, ENDMSG at the end.
+
+\(fn PHRASE-FILE &optional COUNT STARTMSG ENDMSG)" nil nil)
(autoload (quote cookie-snarf) "cookie1" "\
Reads in the PHRASE-FILE, returns it as a vector of strings.
Emit STARTMSG and ENDMSG before and after. Caches the result; second
-and subsequent calls on the same file won't go to disk." nil nil)
+and subsequent calls on the same file won't go to disk.
+
+\(fn PHRASE-FILE STARTMSG ENDMSG)" nil nil)
(autoload (quote shuffle-vector) "cookie1" "\
-Randomly permute the elements of VECTOR (all permutations equally likely)." nil nil)
+Randomly permute the elements of VECTOR (all permutations equally likely).
+
+\(fn VECTOR)" nil nil)
;;;***
\f
;;;### (autoloads (copyright copyright-update) "copyright" "emacs-lisp/copyright.el"
- ;;;;;; (16111 41827))
-;;;;;; (15464 26324))
++;;;;;; (16179 16691))
;;; Generated autoloads from emacs-lisp/copyright.el
(autoload (quote copyright-update) "copyright" "\
With prefix ARG, replace the years in the notice rather than adding
the current year after them. If necessary, and
`copyright-current-gpl-version' is set, any copying permissions
-following the copyright are updated as well." t nil)
+following the copyright are updated as well.
+If non-nil, INTERACTIVEP tells the function to behave as when it's called
+interactively.
+
+\(fn &optional ARG INTERACTIVEP)" t nil)
(autoload (quote copyright) "copyright" "\
-Insert a copyright by $ORGANIZATION notice at cursor." t nil)
+Insert a copyright by $ORGANIZATION notice at cursor.
+
+\(fn &optional STR ARG)" t nil)
;;;***
\f
;;;### (autoloads (cperl-mode) "cperl-mode" "progmodes/cperl-mode.el"
-;;;;;; (15427 61508))
+;;;;;; (16066 53440))
;;; Generated autoloads from progmodes/cperl-mode.el
(autoload (quote cperl-mode) "cperl-mode" "\
well, with optional special formatting done on {}. (Disabled by
default.) You can always quote (with \\[quoted-insert]) the left
\"paren\" to avoid the expansion. The processing of < is special,
-since most the time you mean \"less\". Cperl mode tries to guess
+since most the time you mean \"less\". CPerl mode tries to guess
whether you want to type pair <>, and inserts is if it
appropriate. You can set `cperl-electric-parens-string' to the string that
contains the parenths from the above list you want to be electrical.
span the needed amount of lines.
Variables `cperl-pod-here-scan', `cperl-pod-here-fontify',
-`cperl-pod-face', `cperl-pod-head-face' control processing of pod and
+`cperl-pod-face', `cperl-pod-head-face' control processing of POD and
here-docs sections. With capable Emaxen results of scan are used
for indentation too, otherwise they are used for highlighting only.
DO NOT FORGET to read micro-docs (available from `Perl' menu)
or as help on variables `cperl-tips', `cperl-problems',
-`cperl-non-problems', `cperl-praise', `cperl-speed'." t nil)
+`cperl-praise', `cperl-speed'.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (cpp-parse-edit cpp-highlight-buffer) "cpp" "progmodes/cpp.el"
-;;;;;; (15371 46426))
+;;;;;; (16070 35808))
;;; Generated autoloads from progmodes/cpp.el
(autoload (quote cpp-highlight-buffer) "cpp" "\
Highlight C code according to preprocessor conditionals.
This command pops up a buffer which you should edit to specify
what kind of highlighting to use, and the criteria for highlighting.
-A prefix arg suppresses display of that buffer." t nil)
+A prefix arg suppresses display of that buffer.
+
+\(fn ARG)" t nil)
(autoload (quote cpp-parse-edit) "cpp" "\
-Edit display information for cpp conditionals." t nil)
+Edit display information for cpp conditionals.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (crisp-mode crisp-mode) "crisp" "emulation/crisp.el"
-;;;;;; (15371 46419))
+;;;;;; (16012 41367))
;;; Generated autoloads from emulation/crisp.el
(defvar crisp-mode nil "\
Setting this variable directly does not take effect;
use either M-x customize or the function `crisp-mode'.")
-(custom-add-to-group (quote crisp) (quote crisp-mode) (quote custom-variable))
-
-(custom-add-load (quote crisp-mode) (quote crisp))
+(custom-autoload (quote crisp-mode) "crisp")
(autoload (quote crisp-mode) "crisp" "\
Toggle CRiSP/Brief emulation minor mode.
-With ARG, turn CRiSP mode on if ARG is positive, off otherwise." t nil)
+With ARG, turn CRiSP mode on if ARG is positive, off otherwise.
+
+\(fn &optional ARG)" t nil)
(defalias (quote brief-mode) (quote crisp-mode))
;;;***
\f
;;;### (autoloads (completing-read-multiple) "crm" "emacs-lisp/crm.el"
-;;;;;; (15391 60525))
+;;;;;; (15941 42958))
;;; Generated autoloads from emacs-lisp/crm.el
(autoload (quote completing-read-multiple) "crm" "\
See the documentation for `completing-read' for details on the arguments:
PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and
-INHERIT-INPUT-METHOD." nil nil)
+INHERIT-INPUT-METHOD.
+
+\(fn PROMPT TABLE &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF INHERIT-INPUT-METHOD)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (cua-mode) "cua-base" "emulation/cua-base.el" (16111
+;;;;;; 41830))
+;;; Generated autoloads from emulation/cua-base.el
+
+(defvar cua-mode nil "\
+Non-nil if Cua mode is enabled.
+See the command `cua-mode' for a description of this minor-mode.
+Setting this variable directly does not take effect;
+use either \\[customize] or the function `cua-mode'.")
+
+(custom-autoload (quote cua-mode) "cua-base")
+
+(autoload (quote cua-mode) "cua-base" "\
+Toggle CUA key-binding mode.
+When enabled, using shifted movement keys will activate the region (and
+highlight the region using `transient-mark-mode'), and typed text replaces
+the active selection. C-z, C-x, C-c, and C-v will undo, cut, copy, and
+paste (in addition to the normal emacs bindings).
+
+\(fn &optional ARG)" t nil)
+ (eval-after-load 'CUA-mode
+ '(error (concat "\n\n"
+ "CUA-mode is now part of the standard GNU Emacs distribution,\n"
+ "so you may now enable and customize CUA via the Options menu.\n\n"
+ "Your " (file-name-nondirectory user-init-file) " loads an older version of CUA-mode which does\n"
+ "not work correctly with this version of GNU Emacs.\n"
+ "To correct this, remove the loading and customization of the\n"
+ "old version from the " user-init-file " file.\n\n")))
;;;***
\f
-;;;### (autoloads (customize-menu-create custom-menu-create customize-mark-as-set
-;;;;;; customize-mark-to-save custom-save-all customize-save-customized
-;;;;;; custom-file custom-load-symbol customize-browse custom-buffer-create-other-window
+;;;### (autoloads (customize-menu-create custom-menu-create custom-save-all
+;;;;;; customize-save-customized custom-file customize-browse custom-buffer-create-other-window
;;;;;; custom-buffer-create customize-apropos-groups customize-apropos-faces
;;;;;; customize-apropos-options customize-apropos customize-saved
-;;;;;; customize-customized customize-face-other-window customize-face
-;;;;;; customize-option-other-window customize-changed-options customize-option
-;;;;;; customize-group-other-window customize-group customize customize-save-variable
-;;;;;; customize-set-variable customize-set-value) "cus-edit" "cus-edit.el"
-;;;;;; (15480 44801))
+;;;;;; customize-rogue customize-customized customize-face-other-window
+;;;;;; customize-face customize-changed-options customize-option-other-window
+;;;;;; customize-option customize-group-other-window customize-group
+;;;;;; customize-mode customize customize-save-variable customize-set-variable
+;;;;;; customize-set-value) "cus-edit" "cus-edit.el" (16111 41824))
;;; Generated autoloads from cus-edit.el
(add-hook 'same-window-regexps "\\`\\*Customiz.*\\*\\'")
If VARIABLE has a `custom-type' property, it must be a widget and the
`:prompt-value' property of that widget will be used for reading the value.
-If given a prefix (or a COMMENT argument), also prompt for a comment." t nil)
+If given a prefix (or a COMMENT argument), also prompt for a comment.
+
+\(fn VARIABLE VALUE &optional COMMENT)" t nil)
(autoload (quote customize-set-variable) "cus-edit" "\
Set the default for VARIABLE to VALUE, and return VALUE.
If VARIABLE has a `custom-type' property, it must be a widget and the
`:prompt-value' property of that widget will be used for reading the value.
-If given a prefix (or a COMMENT argument), also prompt for a comment." t nil)
+If given a prefix (or a COMMENT argument), also prompt for a comment.
+
+\(fn VARIABLE VALUE &optional COMMENT)" t nil)
(autoload (quote customize-save-variable) "cus-edit" "\
Set the default for VARIABLE to VALUE, and save it for future sessions.
If VARIABLE has a `custom-type' property, it must be a widget and the
`:prompt-value' property of that widget will be used for reading the value.
-If given a prefix (or a COMMENT argument), also prompt for a comment." t nil)
+If given a prefix (or a COMMENT argument), also prompt for a comment.
+
+\(fn VARIABLE VALUE &optional COMMENT)" t nil)
(autoload (quote customize) "cus-edit" "\
Select a customization buffer which you can use to set user options.
User options are structured into \"groups\".
Initially the top-level group `Emacs' and its immediate subgroups
-are shown; the contents of those subgroups are initially hidden." t nil)
+are shown; the contents of those subgroups are initially hidden.
+
+\(fn)" t nil)
+
+(autoload (quote customize-mode) "cus-edit" "\
+Customize options related to the current major mode.
+If a prefix \\[universal-argument] was given (or if the current major mode has no known group),
+then prompt for the MODE to customize.
+
+\(fn MODE)" t nil)
(autoload (quote customize-group) "cus-edit" "\
-Customize GROUP, which must be a customization group." t nil)
+Customize GROUP, which must be a customization group.
+
+\(fn GROUP)" t nil)
(autoload (quote customize-group-other-window) "cus-edit" "\
-Customize GROUP, which must be a customization group." t nil)
+Customize GROUP, which must be a customization group.
+
+\(fn GROUP)" t nil)
(defalias (quote customize-variable) (quote customize-option))
(autoload (quote customize-option) "cus-edit" "\
-Customize SYMBOL, which must be a user option variable." t nil)
+Customize SYMBOL, which must be a user option variable.
-(autoload (quote customize-changed-options) "cus-edit" "\
-Customize all user option variables changed in Emacs itself.
-This includes new user option variables and faces, and new
-customization groups, as well as older options and faces whose default
-values have changed since the previous major Emacs release.
-
-With argument SINCE-VERSION (a string), customize all user option
-variables that were added (or their meanings were changed) since that
-version." t nil)
+\(fn SYMBOL)" t nil)
(defalias (quote customize-variable-other-window) (quote customize-option-other-window))
(autoload (quote customize-option-other-window) "cus-edit" "\
Customize SYMBOL, which must be a user option variable.
-Show the buffer in another window, but don't select it." t nil)
+Show the buffer in another window, but don't select it.
+
+\(fn SYMBOL)" t nil)
+
+(autoload (quote customize-changed-options) "cus-edit" "\
+Customize all user option variables changed in Emacs itself.
+This includes new user option variables and faces, and new
+customization groups, as well as older options and faces whose default
+values have changed since the previous major Emacs release.
+
+With argument SINCE-VERSION (a string), customize all user option
+variables that were added (or their meanings were changed) since that
+version.
+
+\(fn SINCE-VERSION)" t nil)
(autoload (quote customize-face) "cus-edit" "\
Customize SYMBOL, which should be a face name or nil.
-If SYMBOL is nil, customize all faces." t nil)
+If SYMBOL is nil, customize all faces.
+
+Interactively, when point is on text which has a face specified,
+suggest to customized that face, if it's customizable.
+
+\(fn &optional FACE)" t nil)
(autoload (quote customize-face-other-window) "cus-edit" "\
-Show customization buffer for face SYMBOL in other window." t nil)
+Show customization buffer for face SYMBOL in other window.
+
+Interactively, when point is on text which has a face specified,
+suggest to customized that face, if it's customizable.
+
+\(fn &optional FACE)" t nil)
(autoload (quote customize-customized) "cus-edit" "\
-Customize all user options set since the last save in this session." t nil)
+Customize all user options set since the last save in this session.
+
+\(fn)" t nil)
+
+(autoload (quote customize-rogue) "cus-edit" "\
+Customize all user variable modified outside customize.
+
+\(fn)" t nil)
(autoload (quote customize-saved) "cus-edit" "\
-Customize all already saved user options." t nil)
+Customize all already saved user options.
+
+\(fn)" t nil)
(autoload (quote customize-apropos) "cus-edit" "\
Customize all user options matching REGEXP.
If ALL is `faces', include only faces.
If ALL is `groups', include only groups.
If ALL is t (interactively, with prefix arg), include options which are not
-user-settable, as well as faces and groups." t nil)
+user-settable, as well as faces and groups.
+
+\(fn REGEXP &optional ALL)" t nil)
(autoload (quote customize-apropos-options) "cus-edit" "\
Customize all user options matching REGEXP.
-With prefix arg, include options which are not user-settable." t nil)
+With prefix arg, include options which are not user-settable.
+
+\(fn REGEXP &optional ARG)" t nil)
(autoload (quote customize-apropos-faces) "cus-edit" "\
-Customize all user faces matching REGEXP." t nil)
+Customize all user faces matching REGEXP.
+
+\(fn REGEXP)" t nil)
(autoload (quote customize-apropos-groups) "cus-edit" "\
-Customize all user groups matching REGEXP." t nil)
+Customize all user groups matching REGEXP.
+
+\(fn REGEXP)" t nil)
(autoload (quote custom-buffer-create) "cus-edit" "\
Create a buffer containing OPTIONS.
Optional NAME is the name of the buffer.
OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
SYMBOL is a customization option, and WIDGET is a widget for editing
-that option." nil nil)
+that option.
+
+\(fn OPTIONS &optional NAME DESCRIPTION)" nil nil)
(autoload (quote custom-buffer-create-other-window) "cus-edit" "\
Create a buffer containing OPTIONS.
Optional NAME is the name of the buffer.
OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
SYMBOL is a customization option, and WIDGET is a widget for editing
-that option." nil nil)
+that option.
+
+\(fn OPTIONS &optional NAME DESCRIPTION)" nil nil)
(autoload (quote customize-browse) "cus-edit" "\
-Create a tree browser for the customize hierarchy." t nil)
+Create a tree browser for the customize hierarchy.
-(autoload (quote custom-load-symbol) "cus-edit" "\
-Load all dependencies for SYMBOL." nil nil)
+\(fn &optional GROUP)" t nil)
(defvar custom-file nil "\
File used for storing customization information.
and `(custom-set-faces ...)', and copy them (whichever ones you find)
to the new custom file. This will preserve your existing customizations.")
-(autoload (quote customize-save-customized) "cus-edit" "\
-Save all user options which have been set in this session." t nil)
-
-(autoload (quote custom-save-all) "cus-edit" "\
-Save all customizations in `custom-file'." nil nil)
-
-(autoload (quote customize-mark-to-save) "cus-edit" "\
-Mark SYMBOL for later saving.
-
-If the default value of SYMBOL is different from the standard value,
-set the `saved-value' property to a list whose car evaluates to the
-default value. Otherwise, set it til nil.
+(custom-autoload (quote custom-file) "cus-edit")
-To actually save the value, call `custom-save-all'.
-
-Return non-nil iff the `saved-value' property actually changed." nil nil)
+(autoload (quote customize-save-customized) "cus-edit" "\
+Save all user options which have been set in this session.
-(autoload (quote customize-mark-as-set) "cus-edit" "\
-Mark current value of SYMBOL as being set from customize.
+\(fn)" t nil)
-If the default value of SYMBOL is different from the saved value if any,
-or else if it is different from the standard value, set the
-`customized-value' property to a list whose car evaluates to the
-default value. Otherwise, set it til nil.
+(autoload (quote custom-save-all) "cus-edit" "\
+Save all customizations in `custom-file'.
-Return non-nil iff the `customized-value' property actually changed." nil nil)
+\(fn)" nil nil)
(autoload (quote custom-menu-create) "cus-edit" "\
Create menu for customization group SYMBOL.
-The menu is in a format applicable to `easy-menu-define'." nil nil)
+The menu is in a format applicable to `easy-menu-define'.
+
+\(fn SYMBOL)" nil nil)
(autoload (quote customize-menu-create) "cus-edit" "\
Return a customize menu for customization group SYMBOL.
If optional NAME is given, use that as the name of the menu.
Otherwise the menu will be named `Customize'.
-The format is suitable for use with `easy-menu-define'." nil nil)
+The format is suitable for use with `easy-menu-define'.
+
+\(fn SYMBOL &optional NAME)" nil nil)
;;;***
\f
-;;;### (autoloads (custom-set-faces custom-declare-face) "cus-face"
-;;;;;; "cus-face.el" (15371 46415))
+;;;### (autoloads (custom-reset-faces custom-theme-reset-faces custom-theme-face-value
+;;;;;; custom-set-faces custom-declare-face) "cus-face" "cus-face.el"
+;;;;;; (15941 42951))
;;; Generated autoloads from cus-face.el
(autoload (quote custom-declare-face) "cus-face" "\
-Like `defface', but FACE is evaluated as a normal argument." nil nil)
+Like `defface', but FACE is evaluated as a normal argument.
+
+\(fn FACE SPEC DOC &rest ARGS)" nil nil)
(autoload (quote custom-set-faces) "cus-face" "\
Initialize faces according to user preferences.
+This associates the settings with the `user' theme.
The arguments should be a list where each entry has the form:
(FACE SPEC [NOW [COMMENT]])
-SPEC is stored as the saved value for FACE.
+SPEC is stored as the saved value for FACE, as well as the value for the
+`user' theme. The `user' theme is one of the default themes known to Emacs.
+See `custom-known-themes' for more information on the known themes.
+See `custom-theme-set-faces' for more information on the interplay
+between themes and faces.
+See `defface' for the format of SPEC.
+
If NOW is present and non-nil, FACE is created now, according to SPEC.
COMMENT is a string comment about FACE.
-See `defface' for the format of SPEC." nil nil)
+\(fn &rest ARGS)" nil nil)
+
+(autoload (quote custom-theme-face-value) "cus-face" "\
+Return spec of FACE in THEME if THEME modifies FACE.
+Value is nil otherwise. The association between theme and spec for FACE
+is stored in FACE's property `theme-face'. The appropriate face
+is retrieved using `custom-theme-value'.
+
+\(fn FACE THEME)" nil nil)
+
+(autoload (quote custom-theme-reset-faces) "cus-face" "\
+Reset the value of the face to values previously defined.
+Associate this setting with THEME.
+
+ARGS is a list of lists of the form
+
+ (FACE TO-THEME)
+
+This means reset FACE to its value in TO-THEME.
+
+\(fn THEME &rest ARGS)" nil nil)
+
+(autoload (quote custom-reset-faces) "cus-face" "\
+Reset the value of the face to values previously saved.
+This is the setting assosiated the `user' theme.
+
+ARGS is defined as for `custom-theme-reset-faces'
+
+\(fn &rest ARGS)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (customize-create-theme) "cus-theme" "cus-theme.el"
+;;;;;; (16136 53053))
+;;; Generated autoloads from cus-theme.el
+
+(autoload (quote customize-create-theme) "cus-theme" "\
+Create a custom theme.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (cvs-status-mode) "cvs-status" "cvs-status.el"
-;;;;;; (15425 28361))
+;;;;;; (15941 42951))
;;; Generated autoloads from cvs-status.el
(autoload (quote cvs-status-mode) "cvs-status" "\
-Mode used for cvs status output." t nil)
+Mode used for cvs status output.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (global-cwarn-mode turn-on-cwarn-mode cwarn-mode)
-;;;;;; "cwarn" "progmodes/cwarn.el" (15391 60713))
+;;;;;; "cwarn" "progmodes/cwarn.el" (15538 43263))
;;; Generated autoloads from progmodes/cwarn.el
(autoload (quote cwarn-mode) "cwarn" "\
be included in the variable `cwarn-configuration'. By default C and
C++ modes are included.
-With ARG, turn CWarn mode on if and only if arg is positive." t nil)
+With ARG, turn CWarn mode on if and only if arg is positive.
+
+\(fn &optional ARG)" t nil)
(autoload (quote turn-on-cwarn-mode) "cwarn" "\
Turn on CWarn mode.
This function is designed to be added to hooks, for example:
- (add-hook 'c-mode-hook 'turn-on-cwarn-mode)" nil nil)
+ (add-hook 'c-mode-hook 'turn-on-cwarn-mode)
+
+\(fn)" nil nil)
+
+(defvar global-cwarn-mode nil "\
+Non-nil if Global-Cwarn mode is enabled.
+See the command `global-cwarn-mode' for a description of this minor-mode.
+Setting this variable directly does not take effect;
+use either \\[customize] or the function `global-cwarn-mode'.")
+
+(custom-autoload (quote global-cwarn-mode) "cwarn")
(autoload (quote global-cwarn-mode) "cwarn" "\
-Hightlight suspicious C and C++ constructions in all buffers.
+Toggle Cwarn mode in every buffer.
+With prefix ARG, turn Global-Cwarn mode on if and only if ARG is positive.
+Cwarn mode is actually not turned on in every buffer but only in those
+in which `turn-on-cwarn-mode-if-enabled' turns it on.
-With ARG, turn CWarn mode on globally if and only if arg is positive." t nil)
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (standard-display-cyrillic-translit cyrillic-encode-alternativnyj-char
;;;;;; cyrillic-encode-koi8-r-char) "cyril-util" "language/cyril-util.el"
- ;;;;;; (16118 44435))
-;;;;;; (15464 26330))
++;;;;;; (16183 31287))
;;; Generated autoloads from language/cyril-util.el
(autoload (quote cyrillic-encode-koi8-r-char) "cyril-util" "\
-Return KOI8-R external character code of CHAR if appropriate." nil nil)
+Return KOI8-R external character code of CHAR if appropriate.
+
+\(fn CHAR)" nil nil)
(autoload (quote cyrillic-encode-alternativnyj-char) "cyril-util" "\
-Return ALTERNATIVNYJ external character code of CHAR if appropriate." nil nil)
+Return ALTERNATIVNYJ external character code of CHAR if appropriate.
+
+\(fn CHAR)" nil nil)
(autoload (quote standard-display-cyrillic-translit) "cyril-util" "\
Display a cyrillic buffer using a transliteration.
that affects the choice of transliterations slightly.
Possible values are listed in `cyrillic-language-alist'.
If the argument is t, we use the default cyrillic transliteration.
-If the argument is nil, we return the display table to its standard state." t nil)
+If the argument is nil, we return the display table to its standard state.
+
+\(fn &optional CYRILLIC-LANGUAGE)" t nil)
;;;***
\f
;;;### (autoloads (dabbrev-expand dabbrev-completion) "dabbrev" "dabbrev.el"
-;;;;;; (15455 18398))
+;;;;;; (16174 61084))
;;; Generated autoloads from dabbrev.el
-
-(define-key esc-map "/" (quote dabbrev-expand))
-
-(define-key esc-map [67108911] (quote dabbrev-completion))
+ (define-key esc-map "/" 'dabbrev-expand)
+ (define-key esc-map [?\C-/] 'dabbrev-completion)
(autoload (quote dabbrev-completion) "dabbrev" "\
Completion on current word.
then it searches *all* buffers.
With no prefix argument, it reuses an old completion list
-if there is a suitable one already." t nil)
+if there is a suitable one already.
+
+\(fn &optional ARG)" t nil)
(autoload (quote dabbrev-expand) "dabbrev" "\
Expand previous word \"dynamically\".
The variable `dabbrev-backward-only' may be used to limit the
direction of search to backward if set non-nil.
-See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]." t nil)
+See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion].
+
+\(fn ARG)" t nil)
;;;***
\f
-;;;### (autoloads (dcl-mode) "dcl-mode" "progmodes/dcl-mode.el" (15391
-;;;;;; 60713))
+;;;### (autoloads (dcl-mode) "dcl-mode" "progmodes/dcl-mode.el" (15997
+;;;;;; 672))
;;; Generated autoloads from progmodes/dcl-mode.el
(autoload (quote dcl-mode) "dcl-mode" "\
dcl-block-end-regexp.)
Labels are indented to a fixed position unless they begin or end a block.
-Whole-line comments (matching dcl-comment-line-regexp) are not indented.
+Whole-line comments (matching dcl-comment-line-regexp) are not indented.
Data lines are not indented.
Key bindings:
Indentation for a label.
dcl-comment-line-regexp
- Lines matching this regexp will not be indented.
+ Lines matching this regexp will not be indented.
dcl-block-begin-regexp
dcl-block-end-regexp
dcl-tab-always-indent
If t, pressing TAB always indents the current line.
- If nil, pressing TAB indents the current line if point is at the left
+ If nil, pressing TAB indents the current line if point is at the left
margin.
- dcl-electric-characters
+ dcl-electric-characters
Non-nil causes lines to be indented at once when a label, ELSE or ENDIF is
typed.
dcl-imenu-generic-expression
Default value for imenu-generic-expression. The default includes
SUBROUTINE labels in the main listing and sub-listings for
- other labels, CALL, GOTO and GOSUB statements.
+ other labels, CALL, GOTO and GOSUB statements.
dcl-imenu-label-labels
dcl-imenu-label-goto
Change the text that is used as sub-listing labels in imenu.
Loading this package calls the value of the variable
-`dcl-mode-load-hook' with no args, if that value is non-nil.
-Turning on DCL mode calls the value of the variable `dcl-mode-hook'
+`dcl-mode-load-hook' with no args, if that value is non-nil.
+Turning on DCL mode calls the value of the variable `dcl-mode-hook'
with no args, if that value is non-nil.
The following example uses the default values for all variables:
-$! This is a comment line that is not indented (it matches
+$! This is a comment line that is not indented (it matches
$! dcl-comment-line-regexp)
$! Next follows the first command line. It is indented dcl-margin-offset.
$ i = 1
$ ! Other comments are indented like command lines.
$ ! A margin label indented dcl-margin-label-offset:
-$ label:
+$ label:
$ if i.eq.1
$ then
-$ ! Lines between THEN-ELSE and ELSE-ENDIF are
+$ ! Lines between THEN-ELSE and ELSE-ENDIF are
$ ! indented dcl-basic-offset
$ loop1: ! This matches dcl-block-begin-regexp...
$ ! ...so this line is indented dcl-basic-offset
-$ text = \"This \" + - ! is a continued line
+$ text = \"This \" + - ! is a continued line
\"lined up with the command line\"
$ type sys$input
-Data lines are not indented at all.
+Data lines are not indented at all.
$ endloop1: ! This matches dcl-block-end-regexp
$ endif
$
-" t nil)
+
+
+There is some minimal font-lock support (see vars
+`dcl-font-lock-defaults' and `dcl-font-lock-keywords').
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (cancel-debug-on-entry debug-on-entry debug) "debug"
-;;;;;; "emacs-lisp/debug.el" (15464 26327))
+;;;;;; "emacs-lisp/debug.el" (16139 21085))
;;; Generated autoloads from emacs-lisp/debug.el
(setq debugger (quote debug))
You may call with no args, or you may pass nil as the first arg and
any other args you like. In that case, the list of args after the
-first will be printed into the backtrace buffer." t nil)
+first will be printed into the backtrace buffer.
+
+\(fn &rest DEBUGGER-ARGS)" t nil)
(autoload (quote debug-on-entry) "debug" "\
Request FUNCTION to invoke debugger each time it is called.
This works by modifying the definition of FUNCTION,
which must be written in Lisp, not predefined.
Use \\[cancel-debug-on-entry] to cancel the effect of this command.
-Redefining FUNCTION also cancels it." t nil)
+Redefining FUNCTION also cancels it.
+
+\(fn FUNCTION)" t nil)
(autoload (quote cancel-debug-on-entry) "debug" "\
Undo effect of \\[debug-on-entry] on FUNCTION.
-If argument is nil or an empty string, cancel for all functions." t nil)
+If argument is nil or an empty string, cancel for all functions.
+
+\(fn &optional FUNCTION)" t nil)
;;;***
\f
;;;### (autoloads (decipher-mode decipher) "decipher" "play/decipher.el"
-;;;;;; (15400 1479))
+;;;;;; (16066 53440))
;;; Generated autoloads from play/decipher.el
(autoload (quote decipher) "decipher" "\
-Format a buffer of ciphertext for cryptanalysis and enter Decipher mode." t nil)
+Format a buffer of ciphertext for cryptanalysis and enter Decipher mode.
+
+\(fn)" t nil)
(autoload (quote decipher-mode) "decipher" "\
Major mode for decrypting monoalphabetic substitution ciphers.
\\[decipher-frequency-count] Display the frequency of each ciphertext letter
\\[decipher-adjacency-list] Show adjacency list for current letter (lists letters appearing next to it)
\\[decipher-make-checkpoint] Save the current cipher alphabet (checkpoint)
-\\[decipher-restore-checkpoint] Restore a saved cipher alphabet (checkpoint)" t nil)
+\\[decipher-restore-checkpoint] Restore a saved cipher alphabet (checkpoint)
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (delimit-columns-rectangle delimit-columns-region
-;;;;;; delimit-columns-customize) "delim-col" "delim-col.el" (15371
-;;;;;; 46415))
+;;;;;; delimit-columns-customize) "delim-col" "delim-col.el" (15310
+;;;;;; 56703))
;;; Generated autoloads from delim-col.el
(autoload (quote delimit-columns-customize) "delim-col" "\
-Customization of `columns' group." t nil)
+Customization of `columns' group.
+
+\(fn)" t nil)
(autoload (quote delimit-columns-region) "delim-col" "\
Prettify all columns in a text region.
-START and END delimits the text region." t nil)
+START and END delimits the text region.
+
+\(fn START END)" t nil)
(autoload (quote delimit-columns-rectangle) "delim-col" "\
Prettify all columns in a text rectangle.
-START and END delimits the corners of text rectangle." t nil)
+START and END delimits the corners of text rectangle.
+
+\(fn START END)" t nil)
;;;***
\f
-;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (15391
-;;;;;; 60713))
+;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (16111
+;;;;;; 41832))
;;; Generated autoloads from progmodes/delphi.el
(autoload (quote delphi-mode) "delphi" "\
Face used to color everything else.
Turning on Delphi mode calls the value of the variable delphi-mode-hook with
-no args, if that value is non-nil." t nil)
+no args, if that value is non-nil.
+
+\(fn &optional SKIP-INITIAL-PARSING)" t nil)
;;;***
\f
-;;;### (autoloads (delete-selection-mode) "delsel" "delsel.el" (15371
-;;;;;; 46415))
+;;;### (autoloads (delete-selection-mode) "delsel" "delsel.el" (16016
+;;;;;; 56429))
;;; Generated autoloads from delsel.el
(defalias (quote pending-delete-mode) (quote delete-selection-mode))
Setting this variable directly does not take effect;
use either \\[customize] or the function `delete-selection-mode'.")
-(custom-add-to-group (quote editing-basics) (quote delete-selection-mode) (quote custom-variable))
-
-(custom-add-load (quote delete-selection-mode) (quote delsel))
+(custom-autoload (quote delete-selection-mode) "delsel")
(autoload (quote delete-selection-mode) "delsel" "\
Toggle Delete Selection mode.
When Delete Selection mode is enabled, Transient Mark mode is also
enabled and typed text replaces the selection if the selection is
active. Otherwise, typed text is just inserted at point regardless of
-any selection." t nil)
+any selection.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (derived-mode-init-mode-variables define-derived-mode)
-;;;;;; "derived" "derived.el" (15400 1471))
-;;; Generated autoloads from derived.el
+;;;;;; "derived" "emacs-lisp/derived.el" (16162 11942))
+;;; Generated autoloads from emacs-lisp/derived.el
(autoload (quote define-derived-mode) "derived" "\
Create a new mode as a variant of an existing mode.
BODY: forms to execute just before running the
hooks for the new mode. Do not use `interactive' here.
+BODY can start with a bunch of keyword arguments. The following keyword
+ arguments are currently understood:
+:group GROUP
+ Declare the customization group that corresponds to this mode.
+:syntax-table TABLE
+ Use TABLE instead of the default.
+ A nil value means to simply use the same syntax-table as the parent.
+:abbrev-table TABLE
+ Use TABLE instead of the default.
+ A nil value means to simply use the same abbrev-table as the parent.
+
Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
(define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\")
(setq case-fold-search nil))
Note that if the documentation string had been left out, it would have
-been generated automatically, with a reference to the keymap." nil (quote macro))
+been generated automatically, with a reference to the keymap.
+
+The new mode runs the hook constructed by the function
+`derived-mode-hook-name'.
+
+\(fn CHILD PARENT NAME &optional DOCSTRING &rest BODY)" nil (quote macro))
(autoload (quote derived-mode-init-mode-variables) "derived" "\
Initialise variables for a new MODE.
Right now, if they don't already exist, set up a blank keymap, an
empty syntax table, and an empty abbrev table -- these will be merged
-the first time the mode is used." nil nil)
+the first time the mode is used.
+
+\(fn MODE)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (describe-char describe-text-properties) "descr-text"
- ;;;;;; "descr-text.el" (16111 41824))
++;;;;;; "descr-text.el" (16182 59079))
+;;; Generated autoloads from descr-text.el
+
+(autoload (quote describe-text-properties) "descr-text" "\
+Describe widgets, buttons, overlays and text properties at POS.
+Interactively, describe them for the character after point.
+If optional second argument OUTPUT-BUFFER is non-nil,
+insert the output into that buffer, and don't initialize or clear it
+otherwise.
+
+\(fn POS &optional OUTPUT-BUFFER)" t nil)
+
+(autoload (quote describe-char) "descr-text" "\
+Describe the character after POS (interactively, the character after point).
+The information includes character code, charset and code points in it,
+syntax, category, how the character is encoded in a file,
+character composition information (if relevant),
+as well as widgets, buttons, overlays, and text properties.
+
+\(fn POS)" t nil)
;;;***
\f
-;;;### (autoloads (desktop-load-default desktop-read) "desktop" "desktop.el"
-;;;;;; (15602 17998))
+;;;### (autoloads (desktop-revert desktop-save-in-load-dir desktop-change-dir
+;;;;;; desktop-load-default desktop-read) "desktop" "desktop.el"
- ;;;;;; (16148 4632))
++;;;;;; (16179 10603))
;;; Generated autoloads from desktop.el
(autoload (quote desktop-read) "desktop" "\
Read the Desktop file and the files it specifies.
-This is a no-op when Emacs is running in batch mode." t nil)
+This is a no-op when Emacs is running in batch mode.
+Look for the desktop file according to the variables `desktop-base-file-name'
+and `desktop-path'. If no desktop file is found, clear the desktop.
+Returns t if it has read a desktop file, nil otherwise.
+
+\(fn)" t nil)
(autoload (quote desktop-load-default) "desktop" "\
Load the `default' start-up library manually.
Also inhibit further loading of it. Call this from your `.emacs' file
-to provide correct modes for autoloaded files." nil nil)
+to provide correct modes for autoloaded files.
+
+\(fn)" nil nil)
+
+(autoload (quote desktop-change-dir) "desktop" "\
+Save and clear the desktop, then load the desktop from directory DIR.
+However, if `desktop-enable' was nil at call, don't save the old desktop.
+This function always sets `desktop-enable' to t.
+
+\(fn DIR)" t nil)
+
+(autoload (quote desktop-save-in-load-dir) "desktop" "\
+Save desktop in directory from which it was loaded.
+
+\(fn)" t nil)
+
+(autoload (quote desktop-revert) "desktop" "\
+Revert to the last loaded desktop.
+
+\(fn)" t nil)
;;;***
\f
- ;;;### (autoloads nil "devan-util" "language/devan-util.el" (16142
- ;;;;;; 4985))
-;;;### (autoloads nil "devan-util" "language/devan-util.el" (15597
-;;;;;; 8910))
++;;;### (autoloads (devanagari-composition-function devanagari-compose-region)
++;;;;;; "devan-util" "language/devan-util.el" (16194 62590))
;;; Generated autoloads from language/devan-util.el
- (defconst devanagari-consonant "[\x51ad5-\x51af9\x51b38-\x51b3f]")
-(defconst devanagari-consonant "[\x0915-\x0939\x0958-\x095f]")
++(autoload (quote devanagari-compose-region) "devan-util" "\
++Not documented
++
++\(fn FROM TO)" t nil)
++
++(autoload (quote devanagari-composition-function) "devan-util" "\
++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.
++
++\(fn POS &optional STRING)" nil nil)
;;;***
\f
-;;;### (autoloads (diary-mail-entries diary) "diary-lib" "calendar/diary-lib.el"
-;;;;;; (15425 28362))
+;;;### (autoloads (diary-mode diary-mail-entries diary) "diary-lib"
+;;;;;; "calendar/diary-lib.el" (16174 61085))
;;; Generated autoloads from calendar/diary-lib.el
(autoload (quote diary) "diary-lib" "\
Generate the diary window for ARG days starting with the current date.
If no argument is provided, the number of days of diary entries is governed
by the variable `number-of-diary-entries'. This function is suitable for
-execution in a `.emacs' file." t nil)
+execution in a `.emacs' file.
+
+\(fn &optional ARG)" t nil)
(autoload (quote diary-mail-entries) "diary-lib" "\
Send a mail message showing diary entries for next NDAYS days.
If no prefix argument is given, NDAYS is set to `diary-mail-days'.
+Mail is sent to the address specified by `diary-mail-addr'.
You can call `diary-mail-entries' every night using an at/cron job.
For example, this script will run the program at 2am daily. Since
# diary-rem.sh -- repeatedly run the Emacs diary-reminder
emacs -batch \\
-eval \"(setq diary-mail-days 3 \\
+ diary-file \\\"/path/to/diary.file\\\" \\
european-calendar-style t \\
diary-mail-addr \\\"user@host.name\\\" )\" \\
-l diary-lib -f diary-mail-entries
You may have to tweak the syntax of the `at' command to suit your
system. Alternatively, you can specify a cron entry:
0 1 * * * diary-rem.sh
-to run it every morning at 1am." t nil)
+to run it every morning at 1am.
+
+\(fn &optional NDAYS)" t nil)
+
+(autoload (quote diary-mode) "diary-lib" "\
+Major mode for editing the diary file.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (diff-backup diff diff-command diff-switches) "diff"
-;;;;;; "diff.el" (15371 46416))
+;;;;;; "diff.el" (15763 44949))
;;; Generated autoloads from diff.el
(defvar diff-switches "-c" "\
*A string or list of strings specifying switches to be be passed to diff.")
+(custom-autoload (quote diff-switches) "diff")
+
(defvar diff-command "diff" "\
*The command to use to run diff.")
+(custom-autoload (quote diff-command) "diff")
+
(autoload (quote diff) "diff" "\
Find and display the differences between OLD and NEW files.
Interactively the current buffer's file name is the default for NEW
and a backup file for NEW is the default for OLD.
-With prefix arg, prompt for diff switches." t nil)
+With prefix arg, prompt for diff switches.
+If NO-ASYNC is non-nil, call diff synchronously.
+
+\(fn OLD NEW &optional SWITCHES NO-ASYNC)" t nil)
(autoload (quote diff-backup) "diff" "\
Diff this file with its backup file or vice versa.
Uses the latest backup, if there are several numerical backups.
If this file is a backup, diff it with its original.
-The backup file is the first file given to `diff'." t nil)
+The backup file is the first file given to `diff'.
+
+\(fn FILE &optional SWITCHES)" t nil)
;;;***
\f
;;;### (autoloads (diff-minor-mode diff-mode) "diff-mode" "diff-mode.el"
-;;;;;; (15417 7386))
+;;;;;; (15941 42951))
;;; Generated autoloads from diff-mode.el
(autoload (quote diff-mode) "diff-mode" "\
Major mode for viewing/editing context diffs.
Supports unified and context diffs as well as (to a lesser extent)
normal diffs.
-When the buffer is read-only, the ESC prefix is not necessary." t nil)
+When the buffer is read-only, the ESC prefix is not necessary.
+IF you edit the buffer manually, diff-mode will try to update the hunk
+headers for you on-the-fly.
+
+You can also switch between context diff and unified diff with \\[diff-context->unified],
+or vice versa with \\[diff-unified->context] and you can also revert the direction of
+a diff with \\[diff-reverse-direction].
+
+\(fn)" t nil)
(autoload (quote diff-minor-mode) "diff-mode" "\
Minor mode for viewing/editing context diffs.
-\\{diff-minor-mode-map}" t nil)
+\\{diff-minor-mode-map}
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;;;; dired dired-copy-preserve-time dired-dwim-target dired-keep-marker-symlink
;;;;;; dired-keep-marker-hardlink dired-keep-marker-copy dired-keep-marker-rename
;;;;;; dired-trivial-filenames dired-ls-F-marks-symlinks dired-listing-switches)
-;;;;;; "dired" "dired.el" (15464 26323))
+;;;;;; "dired" "dired.el" (16159 27802))
;;; Generated autoloads from dired.el
(defvar dired-listing-switches "-al" "\
some of the `ls' switches are not supported; see the doc string of
`insert-directory' on ls-lisp.el for more details.")
-(defvar dired-chown-program (if (memq system-type (quote (hpux dgux usg-unix-v irix linux gnu/linux))) "chown" (if (file-exists-p "/usr/sbin/chown") "/usr/sbin/chown" "/etc/chown")) "\
+(custom-autoload (quote dired-listing-switches) "dired")
+
+(defvar dired-chown-program (if (memq system-type (quote (hpux dgux usg-unix-v irix linux gnu/linux cygwin))) "chown" (if (file-exists-p "/usr/sbin/chown") "/usr/sbin/chown" "/etc/chown")) "\
Name of chown command (usually `chown' or `/etc/chown').")
(defvar dired-ls-F-marks-symlinks nil "\
don't care about symbolic links which really end in a @, you can
always set this variable to t.")
+(custom-autoload (quote dired-ls-F-marks-symlinks) "dired")
+
(defvar dired-trivial-filenames "^\\.\\.?$\\|^#" "\
*Regexp of files to skip when finding first file of a directory.
A value of nil means move to the subdir line.
A value of t means move to first file.")
+(custom-autoload (quote dired-trivial-filenames) "dired")
+
(defvar dired-keep-marker-rename t "\
*Controls marking of renamed files.
If t, files keep their previous marks when they are renamed.
If a character, renamed files (whether previously marked or not)
are afterward marked with that character.")
+(custom-autoload (quote dired-keep-marker-rename) "dired")
+
(defvar dired-keep-marker-copy 67 "\
*Controls marking of copied files.
If t, copied files are marked if and as the corresponding original files were.
If a character, copied files are unconditionally marked with that character.")
+(custom-autoload (quote dired-keep-marker-copy) "dired")
+
(defvar dired-keep-marker-hardlink 72 "\
*Controls marking of newly made hard links.
If t, they are marked if and as the files linked to were marked.
If a character, new links are unconditionally marked with that character.")
+(custom-autoload (quote dired-keep-marker-hardlink) "dired")
+
(defvar dired-keep-marker-symlink 89 "\
*Controls marking of newly made symbolic links.
If t, they are marked if and as the files linked to were marked.
If a character, new links are unconditionally marked with that character.")
+(custom-autoload (quote dired-keep-marker-symlink) "dired")
+
(defvar dired-dwim-target nil "\
*If non-nil, dired tries to guess a default target directory.
This means: if there is a dired buffer displayed in the next window,
The target is used in the prompt for file copy, rename etc.")
+(custom-autoload (quote dired-dwim-target) "dired")
+
(defvar dired-copy-preserve-time t "\
*If non-nil, Dired preserves the last-modified time in a file copy.
\(This works on only some systems.)")
+
+(custom-autoload (quote dired-copy-preserve-time) "dired")
+
+(defvar dired-directory nil "\
+The directory name or wildcard spec that this Dired directory lists.
+Local to each dired buffer. May be a list, in which case the car is the
+directory name and the cdr is the list of files to mention.
+The directory name must be absolute, but need not be fully expanded.")
(define-key ctl-x-map "d" 'dired)
(autoload (quote dired) "dired" "\
delete them by typing \\[dired-do-flagged-delete].
Type \\[describe-mode] after entering dired for more info.
-If DIRNAME is already in a dired buffer, that buffer is used without refresh." t nil)
+If DIRNAME is already in a dired buffer, that buffer is used without refresh.
+
+\(fn DIRNAME &optional SWITCHES)" t nil)
(define-key ctl-x-4-map "d" 'dired-other-window)
(autoload (quote dired-other-window) "dired" "\
-\"Edit\" directory DIRNAME. Like `dired' but selects in another window." t nil)
+\"Edit\" directory DIRNAME. Like `dired' but selects in another window.
+
+\(fn DIRNAME &optional SWITCHES)" t nil)
(define-key ctl-x-5-map "d" 'dired-other-frame)
(autoload (quote dired-other-frame) "dired" "\
-\"Edit\" directory DIRNAME. Like `dired' but makes a new frame." t nil)
+\"Edit\" directory DIRNAME. Like `dired' but makes a new frame.
+
+\(fn DIRNAME &optional SWITCHES)" t nil)
(autoload (quote dired-noselect) "dired" "\
-Like `dired' but returns the dired buffer as value, does not select it." nil nil)
+Like `dired' but returns the dired buffer as value, does not select it.
+
+\(fn DIR-OR-LIST &optional SWITCHES)" nil nil)
+ (put 'dired-find-alternate-file 'disabled t)
;;;***
\f
;;;;;; dired-do-compress dired-compress-file dired-do-kill-lines
;;;;;; dired-do-shell-command dired-do-print dired-do-chown dired-do-chgrp
;;;;;; dired-do-chmod dired-backup-diff dired-diff) "dired-aux"
-;;;;;; "dired-aux.el" (15427 61500))
+;;;;;; "dired-aux.el" (15961 24150))
;;; Generated autoloads from dired-aux.el
(autoload (quote dired-diff) "dired-aux" "\
\\[set-mark-command], not by Dired's \\[dired-mark] command.)
The prompted-for file is the first file given to `diff'.
With prefix arg, prompt for second argument SWITCHES,
- which is options for `diff'." t nil)
+ which is options for `diff'.
+
+\(fn FILE &optional SWITCHES)" t nil)
(autoload (quote dired-backup-diff) "dired-aux" "\
Diff this file with its backup file or vice versa.
Uses the latest backup, if there are several numerical backups.
If this file is a backup, diff it with its original.
The backup file is the first file given to `diff'.
-With prefix arg, prompt for argument SWITCHES which is options for `diff'." t nil)
+With prefix arg, prompt for argument SWITCHES which is options for `diff'.
+
+\(fn &optional SWITCHES)" t nil)
(autoload (quote dired-do-chmod) "dired-aux" "\
Change the mode of the marked (or next ARG) files.
-This calls chmod, thus symbolic modes like `g+w' are allowed." t nil)
+This calls chmod, thus symbolic modes like `g+w' are allowed.
+
+\(fn &optional ARG)" t nil)
(autoload (quote dired-do-chgrp) "dired-aux" "\
-Change the group of the marked (or next ARG) files." t nil)
+Change the group of the marked (or next ARG) files.
+
+\(fn &optional ARG)" t nil)
(autoload (quote dired-do-chown) "dired-aux" "\
-Change the owner of the marked (or next ARG) files." t nil)
+Change the owner of the marked (or next ARG) files.
+
+\(fn &optional ARG)" t nil)
(autoload (quote dired-do-print) "dired-aux" "\
Print the marked (or next ARG) files.
Uses the shell command coming from variables `lpr-command' and
-`lpr-switches' as default." t nil)
+`lpr-switches' as default.
+
+\(fn &optional ARG)" t nil)
(autoload (quote dired-do-shell-command) "dired-aux" "\
Run a shell command COMMAND on the marked files.
in a subdir.
In a noninteractive call (from Lisp code), you must specify
-the list of file names explicitly with the FILE-LIST argument." t nil)
+the list of file names explicitly with the FILE-LIST argument.
+
+\(fn COMMAND &optional ARG FILE-LIST)" t nil)
(autoload (quote dired-do-kill-lines) "dired-aux" "\
Kill all marked lines (not the files).
With a prefix argument, kill that many lines starting with the current line.
\(A negative argument kills lines before the current line.)
To kill an entire subdirectory, go to its directory header line
-and use this command with a prefix argument (the value does not matter)." t nil)
+and use this command with a prefix argument (the value does not matter).
-(autoload (quote dired-compress-file) "dired-aux" nil nil nil)
+\(fn &optional ARG FMT)" t nil)
+
+(autoload (quote dired-compress-file) "dired-aux" "\
+Not documented
+
+\(fn FILE)" nil nil)
(autoload (quote dired-do-compress) "dired-aux" "\
-Compress or uncompress marked (or next ARG) files." t nil)
+Compress or uncompress marked (or next ARG) files.
+
+\(fn &optional ARG)" t nil)
(autoload (quote dired-do-byte-compile) "dired-aux" "\
-Byte compile marked (or next ARG) Emacs Lisp files." t nil)
+Byte compile marked (or next ARG) Emacs Lisp files.
+
+\(fn &optional ARG)" t nil)
(autoload (quote dired-do-load) "dired-aux" "\
-Load the marked (or next ARG) Emacs Lisp files." t nil)
+Load the marked (or next ARG) Emacs Lisp files.
+
+\(fn &optional ARG)" t nil)
(autoload (quote dired-do-redisplay) "dired-aux" "\
Redisplay all marked (or next ARG) files.
If on a subdir line, redisplay that subdirectory. In that case,
-a prefix arg lets you edit the `ls' switches used for the new listing." t nil)
+a prefix arg lets you edit the `ls' switches used for the new listing.
+
+\(fn &optional ARG TEST-FOR-SUBDIR)" t nil)
+
+(autoload (quote dired-add-file) "dired-aux" "\
+Not documented
+
+\(fn FILENAME &optional MARKER-CHAR)" nil nil)
-(autoload (quote dired-add-file) "dired-aux" nil nil nil)
+(autoload (quote dired-remove-file) "dired-aux" "\
+Not documented
-(autoload (quote dired-remove-file) "dired-aux" nil nil nil)
+\(fn FILE)" nil nil)
-(autoload (quote dired-relist-file) "dired-aux" nil nil nil)
+(autoload (quote dired-relist-file) "dired-aux" "\
+Create or update the line for FILE in all Dired buffers it would belong in.
-(autoload (quote dired-copy-file) "dired-aux" nil nil nil)
+\(fn FILE)" nil nil)
-(autoload (quote dired-rename-file) "dired-aux" nil nil nil)
+(autoload (quote dired-copy-file) "dired-aux" "\
+Not documented
+
+\(fn FROM TO OK-FLAG)" nil nil)
+
+(autoload (quote dired-rename-file) "dired-aux" "\
+Not documented
+
+\(fn FILE NEWNAME OK-IF-ALREADY-EXISTS)" nil nil)
(autoload (quote dired-create-directory) "dired-aux" "\
-Create a directory called DIRECTORY." t nil)
+Create a directory called DIRECTORY.
+
+\(fn DIRECTORY)" t nil)
(autoload (quote dired-do-copy) "dired-aux" "\
Copy all marked (or next ARG) files, or copy the current file.
and new copies of these files are made in that directory
with the same names that the files currently have. The default
suggested for the target directory depends on the value of
-`dired-dwim-target', which see." t nil)
+`dired-dwim-target', which see.
+
+\(fn &optional ARG)" t nil)
(autoload (quote dired-do-symlink) "dired-aux" "\
Make symbolic links to current file or all marked (or next ARG) files.
and new symbolic links are made in that directory
with the same names that the files currently have. The default
suggested for the target directory depends on the value of
-`dired-dwim-target', which see." t nil)
+`dired-dwim-target', which see.
+
+\(fn &optional ARG)" t nil)
(autoload (quote dired-do-hardlink) "dired-aux" "\
Add names (hard links) current file or all marked (or next ARG) files.
and new hard links are made in that directory
with the same names that the files currently have. The default
suggested for the target directory depends on the value of
-`dired-dwim-target', which see." t nil)
+`dired-dwim-target', which see.
+
+\(fn &optional ARG)" t nil)
(autoload (quote dired-do-rename) "dired-aux" "\
Rename current file or all marked (or next ARG) files.
When renaming just the current file, you specify the new name.
When renaming multiple or marked files, you specify a directory.
+This command also renames any buffers that are visiting the files.
The default suggested for the target directory depends on the value
-of `dired-dwim-target', which see." t nil)
+of `dired-dwim-target', which see.
+
+\(fn &optional ARG)" t nil)
(autoload (quote dired-do-rename-regexp) "dired-aux" "\
Rename selected files whose names match REGEXP to NEWNAME.
REGEXP defaults to the last regexp used.
With a zero prefix arg, renaming by regexp affects the absolute file name.
-Normally, only the non-directory part of the file name is used and changed." t nil)
+Normally, only the non-directory part of the file name is used and changed.
+
+\(fn REGEXP NEWNAME &optional ARG WHOLE-NAME)" t nil)
(autoload (quote dired-do-copy-regexp) "dired-aux" "\
Copy selected files whose names match REGEXP to NEWNAME.
-See function `dired-do-rename-regexp' for more info." t nil)
+See function `dired-do-rename-regexp' for more info.
+
+\(fn REGEXP NEWNAME &optional ARG WHOLE-NAME)" t nil)
(autoload (quote dired-do-hardlink-regexp) "dired-aux" "\
Hardlink selected files whose names match REGEXP to NEWNAME.
-See function `dired-do-rename-regexp' for more info." t nil)
+See function `dired-do-rename-regexp' for more info.
+
+\(fn REGEXP NEWNAME &optional ARG WHOLE-NAME)" t nil)
(autoload (quote dired-do-symlink-regexp) "dired-aux" "\
Symlink selected files whose names match REGEXP to NEWNAME.
-See function `dired-do-rename-regexp' for more info." t nil)
+See function `dired-do-rename-regexp' for more info.
+
+\(fn REGEXP NEWNAME &optional ARG WHOLE-NAME)" t nil)
(autoload (quote dired-upcase) "dired-aux" "\
-Rename all marked (or next ARG) files to upper case." t nil)
+Rename all marked (or next ARG) files to upper case.
+
+\(fn &optional ARG)" t nil)
(autoload (quote dired-downcase) "dired-aux" "\
-Rename all marked (or next ARG) files to lower case." t nil)
+Rename all marked (or next ARG) files to lower case.
+
+\(fn &optional ARG)" t nil)
(autoload (quote dired-maybe-insert-subdir) "dired-aux" "\
Insert this subdirectory into the same dired buffer.
With a prefix arg, you may edit the ls switches used for this listing.
You can add `R' to the switches to expand the whole tree starting at
this subdirectory.
-This function takes some pains to conform to `ls -lR' output." t nil)
+This function takes some pains to conform to `ls -lR' output.
+
+\(fn DIRNAME &optional SWITCHES NO-ERROR-IF-NOT-DIR-P)" t nil)
(autoload (quote dired-insert-subdir) "dired-aux" "\
Insert this subdirectory into the same dired buffer.
With a prefix arg, you may edit the `ls' switches used for this listing.
You can add `R' to the switches to expand the whole tree starting at
this subdirectory.
-This function takes some pains to conform to `ls -lR' output." t nil)
+This function takes some pains to conform to `ls -lR' output.
+
+\(fn DIRNAME &optional SWITCHES NO-ERROR-IF-NOT-DIR-P)" t nil)
(autoload (quote dired-prev-subdir) "dired-aux" "\
Go to previous subdirectory, regardless of level.
-When called interactively and not on a subdir line, go to this subdir's line." t nil)
+When called interactively and not on a subdir line, go to this subdir's line.
+
+\(fn ARG &optional NO-ERROR-IF-NOT-FOUND NO-SKIP)" t nil)
(autoload (quote dired-goto-subdir) "dired-aux" "\
Go to end of header line of DIR in this dired buffer.
Return value of point on success, otherwise return nil.
-The next char is either \\n, or \\r if DIR is hidden." t nil)
+The next char is either \\n, or \\r if DIR is hidden.
+
+\(fn DIR)" t nil)
(autoload (quote dired-mark-subdir-files) "dired-aux" "\
Mark all files except `.' and `..' in current subdirectory.
If the Dired buffer shows multiple directories, this command
-marks the files listed in the subdirectory that point is in." t nil)
+marks the files listed in the subdirectory that point is in.
+
+\(fn)" t nil)
(autoload (quote dired-kill-subdir) "dired-aux" "\
Remove all lines of current subdirectory.
-Lower levels are unaffected." t nil)
+Lower levels are unaffected.
+
+\(fn &optional REMEMBER-MARKS)" t nil)
(autoload (quote dired-tree-up) "dired-aux" "\
-Go up ARG levels in the dired tree." t nil)
+Go up ARG levels in the dired tree.
+
+\(fn ARG)" t nil)
(autoload (quote dired-tree-down) "dired-aux" "\
-Go down in the dired tree." t nil)
+Go down in the dired tree.
+
+\(fn)" t nil)
(autoload (quote dired-hide-subdir) "dired-aux" "\
Hide or unhide the current subdirectory and move to next directory.
Optional prefix arg is a repeat factor.
-Use \\[dired-hide-all] to (un)hide all directories." t nil)
+Use \\[dired-hide-all] to (un)hide all directories.
+
+\(fn ARG)" t nil)
(autoload (quote dired-hide-all) "dired-aux" "\
Hide all subdirectories, leaving only their header lines.
If there is already something hidden, make everything visible again.
-Use \\[dired-hide-subdir] to (un)hide a particular subdirectory." t nil)
+Use \\[dired-hide-subdir] to (un)hide a particular subdirectory.
+
+\(fn ARG)" t nil)
(autoload (quote dired-do-search) "dired-aux" "\
Search through all marked files for a match for REGEXP.
Stops when a match is found.
-To continue searching for next match, use command \\[tags-loop-continue]." t nil)
+To continue searching for next match, use command \\[tags-loop-continue].
+
+\(fn REGEXP)" t nil)
(autoload (quote dired-do-query-replace-regexp) "dired-aux" "\
Do `query-replace-regexp' of FROM with TO, on all marked files.
Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
-with the command \\[tags-loop-continue]." t nil)
+with the command \\[tags-loop-continue].
+
+\(fn FROM TO &optional DELIMITED)" t nil)
(autoload (quote dired-show-file-type) "dired-aux" "\
Print the type of FILE, according to the `file' command.
If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is
-true then the type of the file linked to by FILE is printed instead." t nil)
+true then the type of the file linked to by FILE is printed instead.
+
+\(fn FILE &optional DEREF-SYMLINKS)" t nil)
;;;***
\f
-;;;### (autoloads (dired-jump) "dired-x" "dired-x.el" (15425 28361))
+;;;### (autoloads (dired-jump) "dired-x" "dired-x.el" (15997 670))
;;; Generated autoloads from dired-x.el
(autoload (quote dired-jump) "dired-x" "\
If in a file, dired the current directory and move to file's line.
If in dired already, pop up a level and goto old directory's line.
In case the proper dired file line cannot be found, refresh the dired
-buffer and try again." t nil)
+buffer and try again.
+
+\(fn &optional OTHER-WINDOW)" t nil)
;;;***
\f
-;;;### (autoloads (dirtrack) "dirtrack" "dirtrack.el" (15371 46416))
+;;;### (autoloads (dirtrack) "dirtrack" "dirtrack.el" (15997 5127))
;;; Generated autoloads from dirtrack.el
(autoload (quote dirtrack) "dirtrack" "\
If directory tracking does not seem to be working, you can use the
function `dirtrack-debug-toggle' to turn on debugging output.
-You can enable directory tracking by adding this function to
+You can enable directory tracking by adding this function to
`comint-output-filter-functions'.
-" nil nil)
+
+\(fn INPUT)" nil nil)
;;;***
\f
-;;;### (autoloads (disassemble) "disass" "emacs-lisp/disass.el" (15371
-;;;;;; 46419))
+;;;### (autoloads (disassemble) "disass" "emacs-lisp/disass.el" (16111
+;;;;;; 41828))
;;; Generated autoloads from emacs-lisp/disass.el
(autoload (quote disassemble) "disass" "\
OBJECT can be a symbol defined as a function, or a function itself
\(a lambda expression or a compiled-function object).
If OBJECT is not already compiled, we compile it, but do not
-redefine OBJECT if it is a symbol." t nil)
+redefine OBJECT if it is a symbol.
+
+\(fn OBJECT &optional BUFFER INDENT INTERACTIVE-P)" t nil)
;;;***
\f
;;;;;; standard-display-graphic standard-display-g1 standard-display-ascii
;;;;;; standard-display-default standard-display-8bit describe-current-display-table
;;;;;; describe-display-table set-display-table-slot display-table-slot
-;;;;;; make-display-table) "disp-table" "disp-table.el" (15391 60508))
+;;;;;; make-display-table) "disp-table" "disp-table.el" (15941 42951))
;;; Generated autoloads from disp-table.el
(autoload (quote make-display-table) "disp-table" "\
-Return a new, empty display table." nil nil)
+Return a new, empty display table.
+
+\(fn)" nil nil)
(autoload (quote display-table-slot) "disp-table" "\
Return the value of the extra slot in DISPLAY-TABLE named SLOT.
SLOT may be a number from 0 to 5 inclusive, or a slot name (symbol).
Valid symbols are `truncation', `wrap', `escape', `control',
-`selective-display', and `vertical-border'." nil nil)
+`selective-display', and `vertical-border'.
+
+\(fn DISPLAY-TABLE SLOT)" nil nil)
(autoload (quote set-display-table-slot) "disp-table" "\
Set the value of the extra slot in DISPLAY-TABLE named SLOT to VALUE.
SLOT may be a number from 0 to 5 inclusive, or a name (symbol).
Valid symbols are `truncation', `wrap', `escape', `control',
-`selective-display', and `vertical-border'." nil nil)
+`selective-display', and `vertical-border'.
+
+\(fn DISPLAY-TABLE SLOT VALUE)" nil nil)
(autoload (quote describe-display-table) "disp-table" "\
-Describe the display table DT in a help buffer." nil nil)
+Describe the display table DT in a help buffer.
+
+\(fn DT)" nil nil)
(autoload (quote describe-current-display-table) "disp-table" "\
-Describe the display table in use in the selected window and buffer." t nil)
+Describe the display table in use in the selected window and buffer.
+
+\(fn)" t nil)
(autoload (quote standard-display-8bit) "disp-table" "\
-Display characters in the range L to H literally." nil nil)
+Display characters in the range L to H literally.
+
+\(fn L H)" nil nil)
(autoload (quote standard-display-default) "disp-table" "\
-Display characters in the range L to H using the default notation." nil nil)
+Display characters in the range L to H using the default notation.
+
+\(fn L H)" nil nil)
(autoload (quote standard-display-ascii) "disp-table" "\
-Display character C using printable string S." nil nil)
+Display character C using printable string S.
+
+\(fn C S)" nil nil)
(autoload (quote standard-display-g1) "disp-table" "\
Display character C as character SC in the g1 character set.
This function assumes that your terminal uses the SO/SI characters;
-it is meaningless for an X frame." nil nil)
+it is meaningless for an X frame.
+
+\(fn C SC)" nil nil)
(autoload (quote standard-display-graphic) "disp-table" "\
Display character C as character GC in graphics character set.
This function assumes VT100-compatible escapes; it is meaningless for an
-X frame." nil nil)
+X frame.
+
+\(fn C GC)" nil nil)
(autoload (quote standard-display-underline) "disp-table" "\
-Display character C as character UC plus underlining." nil nil)
+Display character C as character UC plus underlining.
+
+\(fn C UC)" nil nil)
(autoload (quote create-glyph) "disp-table" "\
-Allocate a glyph code to display by sending STRING to the terminal." nil nil)
+Allocate a glyph code to display by sending STRING to the terminal.
+
+\(fn STRING)" nil nil)
(autoload (quote standard-display-european) "disp-table" "\
Semi-obsolete way to toggle display of ISO 8859 European characters.
from Lisp code also selects Latin-1 as the language environment, and
selects unibyte mode for all Emacs buffers (both existing buffers and
those created subsequently). This provides increased compatibility
-for users who call this function in `.emacs'." nil nil)
+for users who call this function in `.emacs'.
+
+\(fn ARG)" nil nil)
;;;***
\f
;;;### (autoloads (dissociated-press) "dissociate" "play/dissociate.el"
-;;;;;; (15371 46425))
+;;;;;; (15186 43694))
;;; Generated autoloads from play/dissociate.el
(autoload (quote dissociated-press) "dissociate" "\
Every so often the user must say whether to continue.
If ARG is positive, require ARG chars of continuity.
If ARG is negative, require -ARG words of continuity.
-Default is 2." t nil)
+Default is 2.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
-;;;### (autoloads (doctor) "doctor" "play/doctor.el" (15371 46425))
+;;;### (autoloads (doctor) "doctor" "play/doctor.el" (15941 42963))
;;; Generated autoloads from play/doctor.el
(autoload (quote doctor) "doctor" "\
-Switch to *doctor* buffer and start giving psychotherapy." t nil)
+Switch to *doctor* buffer and start giving psychotherapy.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (double-mode double-mode) "double" "double.el"
-;;;;;; (15371 46415))
+;;;;;; (15941 42951))
;;; Generated autoloads from double.el
(defvar double-mode nil "\
Setting this variable directly does not take effect;
use either \\[customize] or the function `double-mode'.")
-(custom-add-to-group (quote double) (quote double-mode) (quote custom-variable))
-
-(custom-add-load (quote double-mode) (quote double))
+(custom-autoload (quote double-mode) "double")
(autoload (quote double-mode) "double" "\
Toggle Double mode.
With prefix arg, turn Double mode on iff arg is positive.
When Double mode is on, some keys will insert different strings
-when pressed twice. See variable `double-map' for details." t nil)
+when pressed twice. See variable `double-map' for details.
+
+\(fn ARG)" t nil)
;;;***
\f
-;;;### (autoloads (dunnet) "dunnet" "play/dunnet.el" (15371 46425))
+;;;### (autoloads (dunnet) "dunnet" "play/dunnet.el" (15941 42963))
;;; Generated autoloads from play/dunnet.el
(autoload (quote dunnet) "dunnet" "\
-Switch to *dungeon* buffer and start game." t nil)
+Switch to *dungeon* buffer and start game.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (gnus-earcon-display) "earcon" "gnus/earcon.el"
-;;;;;; (15371 46420))
+;;;;;; (15235 28667))
;;; Generated autoloads from gnus/earcon.el
(autoload (quote gnus-earcon-display) "earcon" "\
-Play sounds in message buffers." t nil)
+Play sounds in message buffers.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (easy-mmode-defsyntax easy-mmode-defmap easy-mmode-define-keymap
;;;;;; easy-mmode-define-global-mode define-minor-mode) "easy-mmode"
-;;;;;; "emacs-lisp/easy-mmode.el" (15417 7421))
+;;;;;; "emacs-lisp/easy-mmode.el" (16131 19792))
;;; Generated autoloads from emacs-lisp/easy-mmode.el
(defalias (quote easy-mmode-define-minor-mode) (quote define-minor-mode))
BODY contains code that will be executed each time the mode is (dis)activated.
It will be executed after any toggling but before running the hooks.
- BODY can start with a list of CL-style keys specifying additional arguments.
- The following keyword arguments are supported:
-:group Followed by the group name to use for any generated `defcustom'.
-:global If non-nil specifies that the minor mode is not meant to be
- buffer-local. By default, the variable is made buffer-local.
-:init-value Same as the INIT-VALUE argument.
-:lighter Same as the LIGHTER argument." nil (quote macro))
+ Before the actual body code, you can write
+ keyword arguments (alternating keywords and values).
+ These following keyword arguments are supported (other keywords
+ will be passed to `defcustom' if the minor mode is global):
+:group GROUP Custom group name to use in all generated `defcustom' forms.
+:global GLOBAL If non-nil specifies that the minor mode is not meant to be
+ buffer-local, so don't make the variable MODE buffer-local.
+ By default, the mode is buffer-local.
+:init-value VAL Same as the INIT-VALUE argument.
+:lighter SPEC Same as the LIGHTER argument.
+:keymap MAP Same as the KEYMAP argument.
+:require SYM Same as in `defcustom'.
+
+For example, you could write
+ (define-minor-mode foo-mode \"If enabled, foo on you!\"
+ :lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\"
+ ...BODY CODE...)
+
+\(fn MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)" nil (quote macro))
(autoload (quote easy-mmode-define-global-mode) "easy-mmode" "\
Make GLOBAL-MODE out of the buffer-local minor MODE.
TURN-ON is a function that will be called with no args in every buffer
and that should try to turn MODE on if applicable for that buffer.
KEYS is a list of CL-style keyword arguments:
-:group to specify the custom group." nil (quote macro))
+:group to specify the custom group.
+
+\(fn GLOBAL-MODE MODE TURN-ON &rest KEYS)" nil (quote macro))
(autoload (quote easy-mmode-define-keymap) "easy-mmode" "\
Return a keymap built from bindings BS.
KEY and BINDINGS are suitable for `define-key'.
Optional NAME is passed to `make-sparse-keymap'.
Optional map M can be used to modify an existing map.
-ARGS is a list of additional keyword arguments." nil nil)
+ARGS is a list of additional keyword arguments.
-(autoload (quote easy-mmode-defmap) "easy-mmode" nil nil (quote macro))
+\(fn BS &optional NAME M ARGS)" nil nil)
+
+(autoload (quote easy-mmode-defmap) "easy-mmode" "\
+Not documented
+
+\(fn M BS DOC &rest ARGS)" nil (quote macro))
(autoload (quote easy-mmode-defsyntax) "easy-mmode" "\
Define variable ST as a syntax-table.
-CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)." nil (quote macro))
+CSS contains a list of syntax specifications of the form (CHAR . SYNTAX).
+
+\(fn ST CSS DOC &rest ARGS)" nil (quote macro))
;;;***
\f
;;;### (autoloads (easy-menu-change easy-menu-create-menu easy-menu-do-define
-;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (15400
-;;;;;; 1475))
+;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (16054
+;;;;;; 60749))
;;; Generated autoloads from emacs-lisp/easymenu.el
(put (quote easy-menu-define) (quote lisp-indent-function) (quote defun))
(autoload (quote easy-menu-define) "easymenu" "\
Define a menu bar submenu in maps MAPS, according to MENU.
-The menu keymap is stored in symbol SYMBOL, both as its value
-and as its function definition. DOC is used as the doc string for SYMBOL.
+
+If SYMBOL is non-nil, store the menu keymap in the value of SYMBOL,
+and define SYMBOL as a function to pop up the menu, with DOC as its doc string.
+If SYMBOL is nil, just store the menu keymap into MAPS.
The first element of MENU must be a string. It is the menu bar item name.
It may be followed by the following keyword argument pairs
unselectable text. A string consisting solely of hyphens is displayed
as a solid horizontal line.
-A menu item can be a list with the same format as MENU. This is a submenu." nil (quote macro))
+A menu item can be a list with the same format as MENU. This is a submenu.
-(autoload (quote easy-menu-do-define) "easymenu" nil nil nil)
+\(fn SYMBOL MAPS DOC MENU)" nil (quote macro))
+
+(autoload (quote easy-menu-do-define) "easymenu" "\
+Not documented
+
+\(fn SYMBOL MAPS DOC MENU)" nil nil)
(autoload (quote easy-menu-create-menu) "easymenu" "\
Create a menu called MENU-NAME with items described in MENU-ITEMS.
MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items
-possibly preceded by keyword pairs as described in `easy-menu-define'." nil nil)
+possibly preceded by keyword pairs as described in `easy-menu-define'.
+
+\(fn MENU-NAME MENU-ITEMS)" nil nil)
(autoload (quote easy-menu-change) "easymenu" "\
Change menu found at PATH as item NAME to contain ITEMS.
the submenu named BEFORE, otherwise add it at the end of the menu.
Either call this from `menu-bar-update-hook' or use a menu filter,
-to implement dynamic menus." nil nil)
+to implement dynamic menus.
+
+\(fn PATH NAME ITEMS &optional BEFORE)" nil nil)
;;;***
\f
;;;;;; ebnf-apply-style ebnf-merge-style ebnf-insert-style ebnf-setup
;;;;;; ebnf-syntax-region ebnf-syntax-buffer ebnf-eps-region ebnf-eps-buffer
;;;;;; ebnf-spool-region ebnf-spool-buffer ebnf-print-region ebnf-print-buffer
-;;;;;; ebnf-customize) "ebnf2ps" "progmodes/ebnf2ps.el" (15371 46426))
+;;;;;; ebnf-customize) "ebnf2ps" "progmodes/ebnf2ps.el" (15961 24154))
;;; Generated autoloads from progmodes/ebnf2ps.el
(autoload (quote ebnf-customize) "ebnf2ps" "\
-Customization for ebnf group." t nil)
+Customization for ebnf group.
+
+\(fn)" t nil)
(autoload (quote ebnf-print-buffer) "ebnf2ps" "\
-Generate and print a PostScript syntatic chart image of the buffer.
+Generate and print a PostScript syntactic chart image of the buffer.
When called with a numeric prefix argument (C-u), prompts the user for
the name of a file to save the PostScript image in, instead of sending
More specifically, the FILENAME argument is treated as follows: if it
is nil, send the image to the printer. If FILENAME is a string, save
the PostScript image in a file with that name. If FILENAME is a
-number, prompt the user for the name of the file to save in." t nil)
+number, prompt the user for the name of the file to save in.
+
+\(fn &optional FILENAME)" t nil)
(autoload (quote ebnf-print-region) "ebnf2ps" "\
-Generate and print a PostScript syntatic chart image of the region.
-Like `ebnf-print-buffer', but prints just the current region." t nil)
+Generate and print a PostScript syntactic chart image of the region.
+Like `ebnf-print-buffer', but prints just the current region.
+
+\(fn FROM TO &optional FILENAME)" t nil)
(autoload (quote ebnf-spool-buffer) "ebnf2ps" "\
-Generate and spool a PostScript syntatic chart image of the buffer.
+Generate and spool a PostScript syntactic chart image of the buffer.
Like `ebnf-print-buffer' except that the PostScript image is saved in a
local buffer to be sent to the printer later.
-Use the command `ebnf-despool' to send the spooled images to the printer." t nil)
+Use the command `ebnf-despool' to send the spooled images to the printer.
+
+\(fn)" t nil)
(autoload (quote ebnf-spool-region) "ebnf2ps" "\
-Generate a PostScript syntatic chart image of the region and spool locally.
+Generate a PostScript syntactic chart image of the region and spool locally.
Like `ebnf-spool-buffer', but spools just the current region.
-Use the command `ebnf-despool' to send the spooled images to the printer." t nil)
+Use the command `ebnf-despool' to send the spooled images to the printer.
+
+\(fn FROM TO)" t nil)
(autoload (quote ebnf-eps-buffer) "ebnf2ps" "\
-Generate a PostScript syntatic chart image of the buffer in a EPS file.
+Generate a PostScript syntactic chart image of the buffer in a EPS file.
Indeed, for each production is generated a EPS file.
The EPS file name has the following form:
For example, the production name \"A/B + C\" is mapped to
\"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
-WARNING: It's *NOT* asked any confirmation to override an existing file." t nil)
+WARNING: It's *NOT* asked any confirmation to override an existing file.
+
+\(fn)" t nil)
(autoload (quote ebnf-eps-region) "ebnf2ps" "\
-Generate a PostScript syntatic chart image of the region in a EPS file.
+Generate a PostScript syntactic chart image of the region in a EPS file.
Indeed, for each production is generated a EPS file.
The EPS file name has the following form:
For example, the production name \"A/B + C\" is mapped to
\"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
-WARNING: It's *NOT* asked any confirmation to override an existing file." t nil)
+WARNING: It's *NOT* asked any confirmation to override an existing file.
+
+\(fn FROM TO)" t nil)
(defalias (quote ebnf-despool) (quote ps-despool))
(autoload (quote ebnf-syntax-buffer) "ebnf2ps" "\
-Does a syntatic analysis of the current buffer." t nil)
+Does a syntactic analysis of the current buffer.
+
+\(fn)" t nil)
(autoload (quote ebnf-syntax-region) "ebnf2ps" "\
-Does a syntatic analysis of a region." t nil)
+Does a syntactic analysis of a region.
+
+\(fn FROM TO)" t nil)
(autoload (quote ebnf-setup) "ebnf2ps" "\
-Return the current ebnf2ps setup." nil nil)
+Return the current ebnf2ps setup.
+
+\(fn)" nil nil)
(autoload (quote ebnf-insert-style) "ebnf2ps" "\
-Insert a new style NAME with inheritance INHERITS and values VALUES." t nil)
+Insert a new style NAME with inheritance INHERITS and values VALUES.
+
+\(fn NAME INHERITS &rest VALUES)" t nil)
(autoload (quote ebnf-merge-style) "ebnf2ps" "\
-Merge values of style NAME with style VALUES." t nil)
+Merge values of style NAME with style VALUES.
+
+\(fn NAME &rest VALUES)" t nil)
(autoload (quote ebnf-apply-style) "ebnf2ps" "\
Set STYLE to current style.
-It returns the old style symbol." t nil)
+It returns the old style symbol.
+
+\(fn STYLE)" t nil)
(autoload (quote ebnf-reset-style) "ebnf2ps" "\
Reset current style.
-It returns the old style symbol." t nil)
+It returns the old style symbol.
+
+\(fn &optional STYLE)" t nil)
(autoload (quote ebnf-push-style) "ebnf2ps" "\
Push the current style and set STYLE to current style.
-It returns the old style symbol." t nil)
+It returns the old style symbol.
+
+\(fn &optional STYLE)" t nil)
(autoload (quote ebnf-pop-style) "ebnf2ps" "\
Pop a style and set it to current style.
-It returns the old style symbol." t nil)
+It returns the old style symbol.
+
+\(fn)" t nil)
;;;***
\f
;;;;;; ebrowse-back-in-position-stack ebrowse-tags-search-member-use
;;;;;; ebrowse-tags-query-replace ebrowse-tags-loop-continue ebrowse-tags-complete-symbol
;;;;;; ebrowse-electric-choose-tree ebrowse-tree-mode) "ebrowse"
-;;;;;; "progmodes/ebrowse.el" (15427 61508))
+;;;;;; "progmodes/ebrowse.el" (15961 24154))
;;; Generated autoloads from progmodes/ebrowse.el
(autoload (quote ebrowse-tree-mode) "ebrowse" "\
E.g.\\[save-buffer] writes the tree to the file it was loaded from.
Tree mode key bindings:
-\\{ebrowse-tree-mode-map}" t nil)
+\\{ebrowse-tree-mode-map}
+
+\(fn)" t nil)
(autoload (quote ebrowse-electric-choose-tree) "ebrowse" "\
-Return a buffer containing a tree or nil if no tree found or canceled." t nil)
+Return a buffer containing a tree or nil if no tree found or canceled.
+
+\(fn)" t nil)
(autoload (quote ebrowse-tags-complete-symbol) "ebrowse" "\
Perform completion on the C++ symbol preceding point.
-A second call of this function without changing point inserts the next match.
+A second call of this function without changing point inserts the next match.
A call with prefix PREFIX reads the symbol to insert from the minibuffer with
-completion." t nil)
+completion.
+
+\(fn PREFIX)" t nil)
(autoload (quote ebrowse-tags-loop-continue) "ebrowse" "\
Repeat last operation on files in tree.
FIRST-TIME non-nil means this is not a repetition, but the first time.
-TREE-BUFFER if indirectly specifies which files to loop over." t nil)
+TREE-BUFFER if indirectly specifies which files to loop over.
+
+\(fn &optional FIRST-TIME TREE-BUFFER)" t nil)
(autoload (quote ebrowse-tags-query-replace) "ebrowse" "\
Query replace FROM with TO in all files of a class tree.
-With prefix arg, process files of marked classes only." t nil)
+With prefix arg, process files of marked classes only.
+
+\(fn FROM TO)" t nil)
(autoload (quote ebrowse-tags-search-member-use) "ebrowse" "\
Search for call sites of a member.
If FIX-NAME is specified, search uses of that member.
Otherwise, read a member name from the minibuffer.
Searches in all files mentioned in a class tree for something that
-looks like a function call to the member." t nil)
+looks like a function call to the member.
+
+\(fn &optional FIX-NAME)" t nil)
(autoload (quote ebrowse-back-in-position-stack) "ebrowse" "\
Move backward in the position stack.
-Prefix arg ARG says how much." t nil)
+Prefix arg ARG says how much.
+
+\(fn ARG)" t nil)
(autoload (quote ebrowse-forward-in-position-stack) "ebrowse" "\
Move forward in the position stack.
-Prefix arg ARG says how much." t nil)
+Prefix arg ARG says how much.
+
+\(fn ARG)" t nil)
(autoload (quote ebrowse-electric-position-menu) "ebrowse" "\
-List positions in the position stack in an electric buffer." t nil)
+List positions in the position stack in an electric buffer.
+
+\(fn)" t nil)
(autoload (quote ebrowse-save-tree) "ebrowse" "\
-Save current tree in same file it was loaded from." t nil)
+Save current tree in same file it was loaded from.
+
+\(fn)" t nil)
(autoload (quote ebrowse-save-tree-as) "ebrowse" "\
Write the current tree data structure to a file.
Read the file name from the minibuffer if interactive.
-Otherwise, FILE-NAME specifies the file to save the tree in." t nil)
+Otherwise, FILE-NAME specifies the file to save the tree in.
+
+\(fn &optional FILE-NAME)" t nil)
(autoload (quote ebrowse-statistics) "ebrowse" "\
-Display statistics for a class tree." t nil)
+Display statistics for a class tree.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (electric-buffer-list) "ebuff-menu" "ebuff-menu.el"
-;;;;;; (15371 46415))
+;;;;;; (15997 671))
;;; Generated autoloads from ebuff-menu.el
(autoload (quote electric-buffer-list) "ebuff-menu" "\
Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil.
-\\{electric-buffer-menu-mode-map}" t nil)
+\\{electric-buffer-menu-mode-map}
+
+\(fn ARG)" t nil)
;;;***
\f
;;;### (autoloads (Electric-command-history-redo-expression) "echistory"
-;;;;;; "echistory.el" (15371 46415))
+;;;;;; "echistory.el" (15941 42951))
;;; Generated autoloads from echistory.el
(autoload (quote Electric-command-history-redo-expression) "echistory" "\
Edit current history line in minibuffer and execute result.
-With prefix arg NOCONFIRM, execute current line as-is without editing." t nil)
+With prefix arg NOCONFIRM, execute current line as-is without editing.
+
+\(fn &optional NOCONFIRM)" t nil)
;;;***
\f
;;;### (autoloads (edebug-eval-top-level-form def-edebug-spec edebug-all-forms
-;;;;;; edebug-all-defs) "edebug" "emacs-lisp/edebug.el" (15371 46419))
+;;;;;; edebug-all-defs) "edebug" "emacs-lisp/edebug.el" (16111 41828))
;;; Generated autoloads from emacs-lisp/edebug.el
(defvar edebug-all-defs nil "\
\(make-local-variable 'edebug-all-defs) in your
`emacs-lisp-mode-hook'.")
+(custom-autoload (quote edebug-all-defs) "edebug")
+
(defvar edebug-all-forms nil "\
*Non-nil evaluation of all forms will instrument for Edebug.
This doesn't apply to loading or evaluations in the minibuffer.
Use the command `edebug-all-forms' to toggle the value of this option.")
+(custom-autoload (quote edebug-all-forms) "edebug")
+
(autoload (quote def-edebug-spec) "edebug" "\
Set the `edebug-form-spec' property of SYMBOL according to SPEC.
Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
-\(naming a function), or a list." nil (quote macro))
+\(naming a function), or a list.
+
+\(fn SYMBOL SPEC)" nil (quote macro))
(defalias (quote edebug-defun) (quote edebug-eval-top-level-form))
(autoload (quote edebug-eval-top-level-form) "edebug" "\
-Evaluate a top level form, such as a defun or defmacro.
-This is like `eval-defun', but the code is always instrumented for Edebug.
-Print its name in the minibuffer and leave point where it is,
-or if an error occurs, leave point after it with mark at the original point." t nil)
+Evaluate the top level form point is in, stepping through with Edebug.
+This is like `eval-defun' except that it steps the code for Edebug
+before evaluating it. It displays the value in the echo area
+using `eval-expression' (which see).
+
+If you do this on a function definition
+such as a defun or defmacro, it defines the function and instruments
+its definition for Edebug, so it will do Edebug stepping when called
+later. It displays `Edebug: FUNCTION' in the echo area to indicate
+that FUNCTION is now instrumented for Edebug.
+
+If the current defun is actually a call to `defvar' or `defcustom',
+evaluating it this way resets the variable using its initial value
+expression even if the variable already has some other value.
+\(Normally `defvar' and `defcustom' do not alter the value if there
+already is one.)
+
+\(fn)" t nil)
;;;***
\f
;;;;;; ediff-windows-linewise ediff-windows-wordwise ediff-merge-directory-revisions-with-ancestor
;;;;;; ediff-merge-directory-revisions ediff-merge-directories-with-ancestor
;;;;;; ediff-merge-directories ediff-directories3 ediff-directory-revisions
-;;;;;; ediff-directories ediff-buffers3 ediff-buffers ediff-files3
-;;;;;; ediff-files) "ediff" "ediff.el" (15427 61501))
+;;;;;; ediff-directories ediff-buffers3 ediff-buffers ediff-backup
+;;;;;; ediff-files3 ediff-files) "ediff" "ediff.el" (16111 41824))
;;; Generated autoloads from ediff.el
(autoload (quote ediff-files) "ediff" "\
-Run Ediff on a pair of files, FILE-A and FILE-B." t nil)
+Run Ediff on a pair of files, FILE-A and FILE-B.
+
+\(fn FILE-A FILE-B &optional STARTUP-HOOKS)" t nil)
(autoload (quote ediff-files3) "ediff" "\
-Run Ediff on three files, FILE-A, FILE-B, and FILE-C." t nil)
+Run Ediff on three files, FILE-A, FILE-B, and FILE-C.
+
+\(fn FILE-A FILE-B FILE-C &optional STARTUP-HOOKS)" t nil)
(defalias (quote ediff3) (quote ediff-files3))
(defalias (quote ediff) (quote ediff-files))
+(autoload (quote ediff-backup) "ediff" "\
+Run Ediff on FILE and its backup file.
+Uses the latest backup, if there are several numerical backups.
+If this file is a backup, `ediff' it with its original.
+
+\(fn FILE)" t nil)
+
(autoload (quote ediff-buffers) "ediff" "\
-Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B." t nil)
+Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B.
+
+\(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS JOB-NAME)" t nil)
(defalias (quote ebuffers) (quote ediff-buffers))
(autoload (quote ediff-buffers3) "ediff" "\
-Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C." t nil)
+Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C.
+
+\(fn BUFFER-A BUFFER-B BUFFER-C &optional STARTUP-HOOKS JOB-NAME)" t nil)
(defalias (quote ebuffers3) (quote ediff-buffers3))
(autoload (quote ediff-directories) "ediff" "\
Run Ediff on a pair of directories, DIR1 and DIR2, comparing files that have
-the same name in both. The third argument, REGEXP, is a regular expression
-that can be used to filter out certain file names." t nil)
+the same name in both. The third argument, REGEXP, is nil or a regular
+expression; only file names that match the regexp are considered.
+
+\(fn DIR1 DIR2 REGEXP)" t nil)
(defalias (quote edirs) (quote ediff-directories))
(autoload (quote ediff-directory-revisions) "ediff" "\
Run Ediff on a directory, DIR1, comparing its files with their revisions.
The second argument, REGEXP, is a regular expression that filters the file
-names. Only the files that are under revision control are taken into account." t nil)
+names. Only the files that are under revision control are taken into account.
+
+\(fn DIR1 REGEXP)" t nil)
(defalias (quote edir-revisions) (quote ediff-directory-revisions))
(autoload (quote ediff-directories3) "ediff" "\
Run Ediff on three directories, DIR1, DIR2, and DIR3, comparing files that
-have the same name in all three. The last argument, REGEXP, is a regular
-expression that can be used to filter out certain file names." t nil)
+have the same name in all three. The last argument, REGEXP, is nil or a
+regular expression; only file names that match the regexp are considered.
+
+\(fn DIR1 DIR2 DIR3 REGEXP)" t nil)
(defalias (quote edirs3) (quote ediff-directories3))
(autoload (quote ediff-merge-directories) "ediff" "\
Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have
-the same name in both. The third argument, REGEXP, is a regular expression
-that can be used to filter out certain file names." t nil)
+the same name in both. The third argument, REGEXP, is nil or a regular
+expression; only file names that match the regexp are considered.
+
+\(fn DIR1 DIR2 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
(defalias (quote edirs-merge) (quote ediff-merge-directories))
Merge files in directories DIR1 and DIR2 using files in ANCESTOR-DIR as ancestors.
Ediff merges files that have identical names in DIR1, DIR2. If a pair of files
in DIR1 and DIR2 doesn't have an ancestor in ANCESTOR-DIR, Ediff will merge
-without ancestor. The fourth argument, REGEXP, is a regular expression that
-can be used to filter out certain file names." t nil)
+without ancestor. The fourth argument, REGEXP, is nil or a regular expression;
+only file names that match the regexp are considered.
+
+\(fn DIR1 DIR2 ANCESTOR-DIR REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
(autoload (quote ediff-merge-directory-revisions) "ediff" "\
Run Ediff on a directory, DIR1, merging its files with their revisions.
The second argument, REGEXP, is a regular expression that filters the file
-names. Only the files that are under revision control are taken into account." t nil)
+names. Only the files that are under revision control are taken into account.
+
+\(fn DIR1 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
(defalias (quote edir-merge-revisions) (quote ediff-merge-directory-revisions))
(autoload (quote ediff-merge-directory-revisions-with-ancestor) "ediff" "\
Run Ediff on a directory, DIR1, merging its files with their revisions and ancestors.
The second argument, REGEXP, is a regular expression that filters the file
-names. Only the files that are under revision control are taken into account." t nil)
+names. Only the files that are under revision control are taken into account.
+
+\(fn DIR1 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
(defalias (quote edir-merge-revisions-with-ancestor) (quote ediff-merge-directory-revisions-with-ancestor))
With prefix argument, DUMB-MODE, or on a non-windowing display, works as
follows:
If WIND-A is nil, use selected window.
-If WIND-B is nil, use window next to WIND-A." t nil)
+If WIND-B is nil, use window next to WIND-A.
+
+\(fn DUMB-MODE &optional WIND-A WIND-B STARTUP-HOOKS)" t nil)
(autoload (quote ediff-windows-linewise) "ediff" "\
Compare WIND-A and WIND-B, which are selected by clicking, linewise.
With prefix argument, DUMB-MODE, or on a non-windowing display, works as
follows:
If WIND-A is nil, use selected window.
-If WIND-B is nil, use window next to WIND-A." t nil)
+If WIND-B is nil, use window next to WIND-A.
+
+\(fn DUMB-MODE &optional WIND-A WIND-B STARTUP-HOOKS)" t nil)
(autoload (quote ediff-regions-wordwise) "ediff" "\
Run Ediff on a pair of regions in specified buffers.
In such a case the user is asked to interactively establish the second
region.
This function is effective only for relatively small regions, up to 200
-lines. For large regions, use `ediff-regions-linewise'." t nil)
+lines. For large regions, use `ediff-regions-linewise'.
+
+\(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS)" t nil)
(autoload (quote ediff-regions-linewise) "ediff" "\
Run Ediff on a pair of regions in specified buffers.
region.
Each region is enlarged to contain full lines.
This function is effective for large regions, over 100-200
-lines. For small regions, use `ediff-regions-wordwise'." t nil)
+lines. For small regions, use `ediff-regions-wordwise'.
+
+\(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS)" t nil)
(defalias (quote ediff-merge) (quote ediff-merge-files))
(autoload (quote ediff-merge-files) "ediff" "\
-Merge two files without ancestor." t nil)
+Merge two files without ancestor.
+
+\(fn FILE-A FILE-B &optional STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
(autoload (quote ediff-merge-files-with-ancestor) "ediff" "\
-Merge two files with ancestor." t nil)
+Merge two files with ancestor.
+
+\(fn FILE-A FILE-B FILE-ANCESTOR &optional STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
(defalias (quote ediff-merge-with-ancestor) (quote ediff-merge-files-with-ancestor))
(autoload (quote ediff-merge-buffers) "ediff" "\
-Merge buffers without ancestor." t nil)
+Merge buffers without ancestor.
+
+\(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS JOB-NAME MERGE-BUFFER-FILE)" t nil)
(autoload (quote ediff-merge-buffers-with-ancestor) "ediff" "\
-Merge buffers with ancestor." t nil)
+Merge buffers with ancestor.
+
+\(fn BUFFER-A BUFFER-B BUFFER-ANCESTOR &optional STARTUP-HOOKS JOB-NAME MERGE-BUFFER-FILE)" t nil)
(autoload (quote ediff-merge-revisions) "ediff" "\
Run Ediff by merging two revisions of a file.
The file is the optional FILE argument or the file visited by the current
-buffer." t nil)
+buffer.
+
+\(fn &optional FILE STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
(autoload (quote ediff-merge-revisions-with-ancestor) "ediff" "\
Run Ediff by merging two revisions of a file with a common ancestor.
The file is the optional FILE argument or the file visited by the current
-buffer." t nil)
+buffer.
+
+\(fn &optional FILE STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
(autoload (quote run-ediff-from-cvs-buffer) "ediff" "\
Run Ediff-merge on appropriate revisions of the selected file.
First run after `M-x cvs-update'. Then place the cursor on a line describing a
-file and then run `run-ediff-from-cvs-buffer'." t nil)
+file and then run `run-ediff-from-cvs-buffer'.
+
+\(fn POS)" t nil)
(autoload (quote ediff-patch-file) "ediff" "\
Run Ediff by patching SOURCE-FILENAME.
If optional PATCH-BUF is given, use the patch in that buffer
and don't ask the user.
If prefix argument, then: if even argument, assume that the patch is in a
-buffer. If odd -- assume it is in a file." t nil)
+buffer. If odd -- assume it is in a file.
+
+\(fn &optional ARG PATCH-BUF)" t nil)
(autoload (quote ediff-patch-buffer) "ediff" "\
Run Ediff by patching BUFFER-NAME.
Without prefix argument: asks if the patch is in some buffer and prompts for
the buffer or a file, depending on the answer.
With prefix arg=1: assumes the patch is in a file and prompts for the file.
-With prefix arg=2: assumes the patch is in a buffer and prompts for the buffer." t nil)
+With prefix arg=2: assumes the patch is in a buffer and prompts for the buffer.
+
+\(fn &optional ARG PATCH-BUF)" t nil)
(defalias (quote epatch) (quote ediff-patch-file))
Run Ediff by comparing versions of a file.
The file is an optional FILE argument or the file entered at the prompt.
Default: the file visited by the current buffer.
-Uses `vc.el' or `rcs.el' depending on `ediff-version-control-package'." t nil)
+Uses `vc.el' or `rcs.el' depending on `ediff-version-control-package'.
+
+\(fn &optional FILE STARTUP-HOOKS)" t nil)
(defalias (quote erevision) (quote ediff-revision))
(autoload (quote ediff-version) "ediff" "\
Return string describing the version of Ediff.
-When called interactively, displays the version." t nil)
+When called interactively, displays the version.
+
+\(fn)" t nil)
(autoload (quote ediff-documentation) "ediff" "\
Display Ediff's manual.
-With optional NODE, goes to that node." t nil)
+With optional NODE, goes to that node.
+
+\(fn &optional NODE)" t nil)
;;;***
\f
;;;### (autoloads (ediff-customize) "ediff-help" "ediff-help.el"
-;;;;;; (15425 28361))
+;;;;;; (15941 42951))
;;; Generated autoloads from ediff-help.el
-(autoload (quote ediff-customize) "ediff-help" nil t nil)
+(autoload (quote ediff-customize) "ediff-help" "\
+Not documented
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads nil "ediff-hook" "ediff-hook.el" (15941 42951))
+;;; Generated autoloads from ediff-hook.el
+
+(defvar ediff-window-setup-function)
+ (defmacro ediff-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form) (if (string-match "XEmacs" emacs-version) xemacs-form emacs-form))
+
+(ediff-cond-compile-for-xemacs-or-emacs (defun ediff-xemacs-init-menus nil (if (featurep (quote menubar)) (progn (add-submenu (quote ("Tools")) ediff-menu "OO-Browser...") (add-submenu (quote ("Tools")) ediff-merge-menu "OO-Browser...") (add-submenu (quote ("Tools")) epatch-menu "OO-Browser...") (add-submenu (quote ("Tools")) ediff-misc-menu "OO-Browser...") (add-menu-button (quote ("Tools")) "-------" "OO-Browser...")))) nil)
+
+(ediff-cond-compile-for-xemacs-or-emacs (progn (defvar ediff-menu (quote ("Compare" ["Two Files..." ediff-files t] ["Two Buffers..." ediff-buffers t] ["Three Files..." ediff-files3 t] ["Three Buffers..." ediff-buffers3 t] "---" ["Two Directories..." ediff-directories t] ["Three Directories..." ediff-directories3 t] "---" ["File with Revision..." ediff-revision t] ["Directory Revisions..." ediff-directory-revisions t] "---" ["Windows Word-by-word..." ediff-windows-wordwise t] ["Windows Line-by-line..." ediff-windows-linewise t] "---" ["Regions Word-by-word..." ediff-regions-wordwise t] ["Regions Line-by-line..." ediff-regions-linewise t]))) (defvar ediff-merge-menu (quote ("Merge" ["Files..." ediff-merge-files t] ["Files with Ancestor..." ediff-merge-files-with-ancestor t] ["Buffers..." ediff-merge-buffers t] ["Buffers with Ancestor..." ediff-merge-buffers-with-ancestor t] "---" ["Directories..." ediff-merge-directories t] ["Directories with Ancestor..." ediff-merge-directories-with-ancestor t] "---" ["Revisions..." ediff-merge-revisions t] ["Revisions with Ancestor..." ediff-merge-revisions-with-ancestor t] ["Directory Revisions..." ediff-merge-directory-revisions t] ["Directory Revisions with Ancestor..." ediff-merge-directory-revisions-with-ancestor t]))) (defvar epatch-menu (quote ("Apply Patch" ["To a file..." ediff-patch-file t] ["To a buffer..." ediff-patch-buffer t]))) (defvar ediff-misc-menu (quote ("Ediff Miscellanea" ["Ediff Manual..." ediff-documentation t] ["Customize Ediff..." ediff-customize t] ["List Ediff Sessions..." ediff-show-registry t] ["Use separate frame for Ediff control buffer..." ediff-toggle-multiframe :style toggle :selected (if (and (featurep (quote ediff-util)) (boundp (quote ediff-window-setup-function))) (eq ediff-window-setup-function (quote ediff-setup-windows-multiframe)))] ["Use a toolbar with Ediff control buffer" ediff-toggle-use-toolbar :style toggle :selected (if (featurep (quote ediff-tbar)) (ediff-use-toolbar-p))]))) (if (and (featurep (quote menubar)) (not (featurep (quote infodock))) (not (featurep (quote ediff-hook)))) (ediff-xemacs-init-menus))) (if (featurep (quote menu-bar)) (progn (defvar menu-bar-ediff-misc-menu (make-sparse-keymap "Ediff Miscellanea")) (fset (quote menu-bar-ediff-misc-menu) (symbol-value (quote menu-bar-ediff-misc-menu))) (defvar menu-bar-epatch-menu (make-sparse-keymap "Apply Patch")) (fset (quote menu-bar-epatch-menu) (symbol-value (quote menu-bar-epatch-menu))) (defvar menu-bar-ediff-merge-menu (make-sparse-keymap "Merge")) (fset (quote menu-bar-ediff-merge-menu) (symbol-value (quote menu-bar-ediff-merge-menu))) (defvar menu-bar-ediff-menu (make-sparse-keymap "Compare")) (fset (quote menu-bar-ediff-menu) (symbol-value (quote menu-bar-ediff-menu))) (define-key menu-bar-ediff-menu [window] (quote ("This Window and Next Window" . compare-windows))) (define-key menu-bar-ediff-menu [ediff-windows-linewise] (quote ("Windows Line-by-line..." . ediff-windows-linewise))) (define-key menu-bar-ediff-menu [ediff-windows-wordwise] (quote ("Windows Word-by-word..." . ediff-windows-wordwise))) (define-key menu-bar-ediff-menu [separator-ediff-windows] (quote ("--"))) (define-key menu-bar-ediff-menu [ediff-regions-linewise] (quote ("Regions Line-by-line..." . ediff-regions-linewise))) (define-key menu-bar-ediff-menu [ediff-regions-wordwise] (quote ("Regions Word-by-word..." . ediff-regions-wordwise))) (define-key menu-bar-ediff-menu [separator-ediff-regions] (quote ("--"))) (define-key menu-bar-ediff-menu [ediff-dir-revision] (quote ("Directory Revisions..." . ediff-directory-revisions))) (define-key menu-bar-ediff-menu [ediff-revision] (quote ("File with Revision..." . ediff-revision))) (define-key menu-bar-ediff-menu [separator-ediff-directories] (quote ("--"))) (define-key menu-bar-ediff-menu [ediff-directories3] (quote ("Three Directories..." . ediff-directories3))) (define-key menu-bar-ediff-menu [ediff-directories] (quote ("Two Directories..." . ediff-directories))) (define-key menu-bar-ediff-menu [separator-ediff-files] (quote ("--"))) (define-key menu-bar-ediff-menu [ediff-buffers3] (quote ("Three Buffers..." . ediff-buffers3))) (define-key menu-bar-ediff-menu [ediff-files3] (quote ("Three Files..." . ediff-files3))) (define-key menu-bar-ediff-menu [ediff-buffers] (quote ("Two Buffers..." . ediff-buffers))) (define-key menu-bar-ediff-menu [ediff-files] (quote ("Two Files..." . ediff-files))) (define-key menu-bar-ediff-merge-menu [ediff-merge-dir-revisions-with-ancestor] (quote ("Directory Revisions with Ancestor..." . ediff-merge-directory-revisions-with-ancestor))) (define-key menu-bar-ediff-merge-menu [ediff-merge-dir-revisions] (quote ("Directory Revisions..." . ediff-merge-directory-revisions))) (define-key menu-bar-ediff-merge-menu [ediff-merge-revisions-with-ancestor] (quote ("Revisions with Ancestor..." . ediff-merge-revisions-with-ancestor))) (define-key menu-bar-ediff-merge-menu [ediff-merge-revisions] (quote ("Revisions..." . ediff-merge-revisions))) (define-key menu-bar-ediff-merge-menu [separator-ediff-merge] (quote ("--"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-directories-with-ancestor] (quote ("Directories with Ancestor..." . ediff-merge-directories-with-ancestor))) (define-key menu-bar-ediff-merge-menu [ediff-merge-directories] (quote ("Directories..." . ediff-merge-directories))) (define-key menu-bar-ediff-merge-menu [separator-ediff-merge-dirs] (quote ("--"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-buffers-with-ancestor] (quote ("Buffers with Ancestor..." . ediff-merge-buffers-with-ancestor))) (define-key menu-bar-ediff-merge-menu [ediff-merge-buffers] (quote ("Buffers..." . ediff-merge-buffers))) (define-key menu-bar-ediff-merge-menu [ediff-merge-files-with-ancestor] (quote ("Files with Ancestor..." . ediff-merge-files-with-ancestor))) (define-key menu-bar-ediff-merge-menu [ediff-merge-files] (quote ("Files..." . ediff-merge-files))) (define-key menu-bar-epatch-menu [ediff-patch-buffer] (quote ("To a Buffer..." . ediff-patch-buffer))) (define-key menu-bar-epatch-menu [ediff-patch-file] (quote ("To a File..." . ediff-patch-file))) (define-key menu-bar-ediff-misc-menu [emultiframe] (quote ("Toggle use of separate control buffer frame..." . ediff-toggle-multiframe))) (define-key menu-bar-ediff-misc-menu [eregistry] (quote ("List Ediff Sessions..." . ediff-show-registry))) (define-key menu-bar-ediff-misc-menu [ediff-cust] (quote ("Customize Ediff..." . ediff-customize))) (define-key menu-bar-ediff-misc-menu [ediff-doc] (quote ("Ediff Manual..." . ediff-documentation))))))
;;;***
\f
;;;### (autoloads (ediff-show-registry) "ediff-mult" "ediff-mult.el"
-;;;;;; (15425 28361))
+;;;;;; (16111 41824))
;;; Generated autoloads from ediff-mult.el
(autoload (quote ediff-show-registry) "ediff-mult" "\
-Display Ediff's registry." t nil)
+Display Ediff's registry.
+
+\(fn)" t nil)
(defalias (quote eregistry) (quote ediff-show-registry))
;;;***
\f
;;;### (autoloads (ediff-toggle-use-toolbar ediff-toggle-multiframe)
-;;;;;; "ediff-util" "ediff-util.el" (15464 26323))
+;;;;;; "ediff-util" "ediff-util.el" (16111 41824))
;;; Generated autoloads from ediff-util.el
(autoload (quote ediff-toggle-multiframe) "ediff-util" "\
Switch from multiframe display to single-frame display and back.
To change the default, set the variable `ediff-window-setup-function',
-which see." t nil)
+which see.
+
+\(fn)" t nil)
(autoload (quote ediff-toggle-use-toolbar) "ediff-util" "\
Enable or disable Ediff toolbar.
Works only in versions of Emacs that support toolbars.
-To change the default, set the variable `ediff-use-toolbar-p', which see." t nil)
+To change the default, set the variable `ediff-use-toolbar-p', which see.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (format-kbd-macro read-kbd-macro edit-named-kbd-macro
;;;;;; edit-last-kbd-macro edit-kbd-macro) "edmacro" "edmacro.el"
-;;;;;; (15371 46415))
+;;;;;; (15941 42952))
;;; Generated autoloads from edmacro.el
- (define-key ctl-x-map "\C-k" 'edit-kbd-macro)
(defvar edmacro-eight-bits nil "\
*Non-nil if edit-kbd-macro should leave 8-bit characters intact.
Or, type `C-x e' or RET to edit the last keyboard macro, `C-h l' to edit
the last 100 keystrokes as a keyboard macro, or `M-x' to edit a macro by
its command name.
-With a prefix argument, format the macro in a more concise way." t nil)
+With a prefix argument, format the macro in a more concise way.
+
+\(fn KEYS &optional PREFIX FINISH-HOOK STORE-HOOK)" t nil)
(autoload (quote edit-last-kbd-macro) "edmacro" "\
-Edit the most recently defined keyboard macro." t nil)
+Edit the most recently defined keyboard macro.
+
+\(fn &optional PREFIX)" t nil)
(autoload (quote edit-named-kbd-macro) "edmacro" "\
-Edit a keyboard macro which has been given a name by `name-last-kbd-macro'." t nil)
+Edit a keyboard macro which has been given a name by `name-last-kbd-macro'.
+
+\(fn &optional PREFIX)" t nil)
(autoload (quote read-kbd-macro) "edmacro" "\
Read the region as a keyboard macro definition.
In Lisp, may also be called with a single STRING argument in which case
the result is returned rather than being installed as the current macro.
The result will be a string if possible, otherwise an event vector.
-Second argument NEED-VECTOR means to return an event vector always." t nil)
+Second argument NEED-VECTOR means to return an event vector always.
+
+\(fn START &optional END)" t nil)
(autoload (quote format-kbd-macro) "edmacro" "\
Return the keyboard macro MACRO as a human-readable string.
This string is suitable for passing to `read-kbd-macro'.
Second argument VERBOSE means to put one command per line with comments.
If VERBOSE is `1', put everything on one line. If VERBOSE is omitted
-or nil, use a compact 80-column format." nil nil)
+or nil, use a compact 80-column format.
+
+\(fn &optional MACRO VERBOSE)" nil nil)
;;;***
\f
;;;### (autoloads (edt-emulation-on edt-set-scroll-margins) "edt"
-;;;;;; "emulation/edt.el" (15427 61507))
+;;;;;; "emulation/edt.el" (15941 42958))
;;; Generated autoloads from emulation/edt.el
(autoload (quote edt-set-scroll-margins) "edt" "\
Set scroll margins.
Argument TOP is the top margin in number of lines or percent of window.
-Argument BOTTOM is the bottom margin in number of lines or percent of window." t nil)
+Argument BOTTOM is the bottom margin in number of lines or percent of window.
+
+\(fn TOP BOTTOM)" t nil)
(autoload (quote edt-emulation-on) "edt" "\
-Turn on EDT Emulation." t nil)
+Turn on EDT Emulation.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (electric-helpify with-electric-help) "ehelp" "ehelp.el"
-;;;;;; (15371 46415))
+;;;;;; (16139 21083))
;;; Generated autoloads from ehelp.el
(autoload (quote with-electric-help) "ehelp" "\
When the user exits (with `electric-help-exit', or otherwise), the help
buffer's window disappears (i.e., we use `save-window-excursion'), and
-BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit." nil nil)
+BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit.
+
+\(fn THUNK &optional BUFFER NOERASE MINHEIGHT)" nil nil)
-(autoload (quote electric-helpify) "ehelp" nil nil nil)
+(autoload (quote electric-helpify) "ehelp" "\
+Not documented
+
+\(fn FUN &optional NAME)" nil nil)
;;;***
\f
;;;### (autoloads (turn-on-eldoc-mode eldoc-mode eldoc-minor-mode-string)
-;;;;;; "eldoc" "emacs-lisp/eldoc.el" (15425 28363))
+;;;;;; "eldoc" "emacs-lisp/eldoc.el" (16066 53440))
;;; Generated autoloads from emacs-lisp/eldoc.el
(defvar eldoc-minor-mode-string " ElDoc" "\
*String to display in mode line when Eldoc Mode is enabled; nil for none.")
+(custom-autoload (quote eldoc-minor-mode-string) "eldoc")
+
(autoload (quote eldoc-mode) "eldoc" "\
Toggle ElDoc mode on or off.
Show the defined parameters for the elisp function near point.
If point is over a documented variable, print that variable's docstring
instead.
-With prefix ARG, turn ElDoc mode on if and only if ARG is positive." t nil)
+With prefix ARG, turn ElDoc mode on if and only if ARG is positive.
+
+\(fn &optional ARG)" t nil)
(autoload (quote turn-on-eldoc-mode) "eldoc" "\
-Unequivocally turn on eldoc-mode (see variable documentation)." t nil)
+Unequivocally turn on eldoc-mode (see variable documentation).
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (elide-head) "elide-head" "elide-head.el" (15371
-;;;;;; 46415))
+;;;### (autoloads (elide-head) "elide-head" "elide-head.el" (15829
+;;;;;; 28907))
;;; Generated autoloads from elide-head.el
(autoload (quote elide-head) "elide-head" "\
The header is made invisible with an overlay. With a prefix arg, show
an elided material again.
-This is suitable as an entry on `find-file-hooks' or appropriate mode hooks." t nil)
+This is suitable as an entry on `find-file-hook' or appropriate mode hooks.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (elint-initialize) "elint" "emacs-lisp/elint.el"
-;;;;;; (15417 7421))
+;;;;;; (15829 28908))
;;; Generated autoloads from emacs-lisp/elint.el
(autoload (quote elint-initialize) "elint" "\
-Initialize elint." t nil)
+Initialize elint.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (elp-results elp-instrument-package elp-instrument-list
-;;;;;; elp-instrument-function) "elp" "emacs-lisp/elp.el" (15417
-;;;;;; 7421))
+;;;;;; elp-instrument-function) "elp" "emacs-lisp/elp.el" (15407
+;;;;;; 8858))
;;; Generated autoloads from emacs-lisp/elp.el
(autoload (quote elp-instrument-function) "elp" "\
Instrument FUNSYM for profiling.
-FUNSYM must be a symbol of a defined function." t nil)
+FUNSYM must be a symbol of a defined function.
+
+\(fn FUNSYM)" t nil)
(autoload (quote elp-instrument-list) "elp" "\
Instrument for profiling, all functions in `elp-function-list'.
-Use optional LIST if provided instead." t nil)
+Use optional LIST if provided instead.
+
+\(fn &optional LIST)" t nil)
(autoload (quote elp-instrument-package) "elp" "\
Instrument for profiling, all functions which start with PREFIX.
For example, to instrument all ELP functions, do the following:
- \\[elp-instrument-package] RET elp- RET" t nil)
+ \\[elp-instrument-package] RET elp- RET
+
+\(fn PREFIX)" t nil)
(autoload (quote elp-results) "elp" "\
Display current profiling results.
If `elp-reset-after-results' is non-nil, then current profiling
information for all instrumented functions are reset after results are
-displayed." t nil)
+displayed.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (report-emacs-bug) "emacsbug" "mail/emacsbug.el"
-;;;;;; (15371 46424))
+;;;;;; (15678 51470))
;;; Generated autoloads from mail/emacsbug.el
(autoload (quote report-emacs-bug) "emacsbug" "\
Report a bug in GNU Emacs.
-Prompts for bug subject. Leaves you in a mail buffer." t nil)
+Prompts for bug subject. Leaves you in a mail buffer.
+
+\(fn TOPIC &optional RECENT-KEYS)" t nil)
;;;***
\f
;;;;;; emerge-revisions emerge-files-with-ancestor-remote emerge-files-remote
;;;;;; emerge-files-with-ancestor-command emerge-files-command emerge-buffers-with-ancestor
;;;;;; emerge-buffers emerge-files-with-ancestor emerge-files) "emerge"
-;;;;;; "emerge.el" (15417 7388))
+;;;;;; "emerge.el" (16174 61084))
;;; Generated autoloads from emerge.el
(defvar menu-bar-emerge-menu (make-sparse-keymap "Emerge"))
+ (fset 'menu-bar-emerge-menu (symbol-value 'menu-bar-emerge-menu))
+ (define-key menu-bar-emerge-menu [emerge-merge-directories]
+ '("Merge Directories..." . emerge-merge-directories))
+ (define-key menu-bar-emerge-menu [emerge-revisions-with-ancestor]
+ '("Revisions with Ancestor..." . emerge-revisions-with-ancestor))
+ (define-key menu-bar-emerge-menu [emerge-revisions]
+ '("Revisions..." . emerge-revisions))
+ (define-key menu-bar-emerge-menu [emerge-files-with-ancestor]
+ '("Files with Ancestor..." . emerge-files-with-ancestor))
+ (define-key menu-bar-emerge-menu [emerge-files]
+ '("Files..." . emerge-files))
+ (define-key menu-bar-emerge-menu [emerge-buffers-with-ancestor]
+ '("Buffers with Ancestor..." . emerge-buffers-with-ancestor))
+ (define-key menu-bar-emerge-menu [emerge-buffers]
+ '("Buffers..." . emerge-buffers))
-(fset (quote menu-bar-emerge-menu) (symbol-value (quote menu-bar-emerge-menu)))
+(autoload (quote emerge-files) "emerge" "\
+Run Emerge on two files.
-(define-key menu-bar-emerge-menu [emerge-merge-directories] (quote ("Merge Directories..." . emerge-merge-directories)))
+\(fn ARG FILE-A FILE-B FILE-OUT &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
-(define-key menu-bar-emerge-menu [emerge-revisions-with-ancestor] (quote ("Revisions with Ancestor..." . emerge-revisions-with-ancestor)))
+(autoload (quote emerge-files-with-ancestor) "emerge" "\
+Run Emerge on two files, giving another file as the ancestor.
-(define-key menu-bar-emerge-menu [emerge-revisions] (quote ("Revisions..." . emerge-revisions)))
+\(fn ARG FILE-A FILE-B FILE-ANCESTOR FILE-OUT &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
-(define-key menu-bar-emerge-menu [emerge-files-with-ancestor] (quote ("Files with Ancestor..." . emerge-files-with-ancestor)))
+(autoload (quote emerge-buffers) "emerge" "\
+Run Emerge on two buffers.
-(define-key menu-bar-emerge-menu [emerge-files] (quote ("Files..." . emerge-files)))
+\(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
-(define-key menu-bar-emerge-menu [emerge-buffers-with-ancestor] (quote ("Buffers with Ancestor..." . emerge-buffers-with-ancestor)))
+(autoload (quote emerge-buffers-with-ancestor) "emerge" "\
+Run Emerge on two buffers, giving another buffer as the ancestor.
-(define-key menu-bar-emerge-menu [emerge-buffers] (quote ("Buffers..." . emerge-buffers)))
+\(fn BUFFER-A BUFFER-B BUFFER-ANCESTOR &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
-(autoload (quote emerge-files) "emerge" "\
-Run Emerge on two files." t nil)
+(autoload (quote emerge-files-command) "emerge" "\
+Not documented
-(autoload (quote emerge-files-with-ancestor) "emerge" "\
-Run Emerge on two files, giving another file as the ancestor." t nil)
+\(fn)" nil nil)
-(autoload (quote emerge-buffers) "emerge" "\
-Run Emerge on two buffers." t nil)
+(autoload (quote emerge-files-with-ancestor-command) "emerge" "\
+Not documented
-(autoload (quote emerge-buffers-with-ancestor) "emerge" "\
-Run Emerge on two buffers, giving another buffer as the ancestor." t nil)
+\(fn)" nil nil)
-(autoload (quote emerge-files-command) "emerge" nil nil nil)
+(autoload (quote emerge-files-remote) "emerge" "\
+Not documented
-(autoload (quote emerge-files-with-ancestor-command) "emerge" nil nil nil)
+\(fn FILE-A FILE-B FILE-OUT)" nil nil)
-(autoload (quote emerge-files-remote) "emerge" nil nil nil)
+(autoload (quote emerge-files-with-ancestor-remote) "emerge" "\
+Not documented
-(autoload (quote emerge-files-with-ancestor-remote) "emerge" nil nil nil)
+\(fn FILE-A FILE-B FILE-ANC FILE-OUT)" nil nil)
(autoload (quote emerge-revisions) "emerge" "\
-Emerge two RCS revisions of a file." t nil)
+Emerge two RCS revisions of a file.
+
+\(fn ARG FILE REVISION-A REVISION-B &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
(autoload (quote emerge-revisions-with-ancestor) "emerge" "\
-Emerge two RCS revisions of a file, with another revision as ancestor." t nil)
+Emerge two RCS revisions of a file, with another revision as ancestor.
-(autoload (quote emerge-merge-directories) "emerge" nil t nil)
+\(fn ARG FILE REVISION-A REVISION-B ANCESTOR &optional STARTUP-HOOKS QUIT-HOOKS)" t nil)
+
+(autoload (quote emerge-merge-directories) "emerge" "\
+Not documented
+
+\(fn A-DIR B-DIR ANCESTOR-DIR OUTPUT-DIR)" t nil)
;;;***
\f
;;;### (autoloads (encoded-kbd-mode) "encoded-kb" "international/encoded-kb.el"
- ;;;;;; (15941 42961))
-;;;;;; (15602 6015))
++;;;;;; (16179 34394))
;;; Generated autoloads from international/encoded-kb.el
(defvar encoded-kbd-mode nil "\
Setting this variable directly does not take effect;
use either \\[customize] or the function `encoded-kbd-mode'.")
-(custom-add-to-group (quote encoded-kbd) (quote encoded-kbd-mode) (quote custom-variable))
-
-(custom-add-load (quote encoded-kbd-mode) (quote encoded-kb))
+(custom-autoload (quote encoded-kbd-mode) "encoded-kb")
(autoload (quote encoded-kbd-mode) "encoded-kb" "\
Toggle Encoded-kbd minor mode.
In Encoded-kbd mode, a text sent from keyboard is accepted
as a multilingual text encoded in a coding system set by
-\\[set-keyboard-coding-system]." t nil)
+\\[set-keyboard-coding-system].
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (enriched-decode enriched-encode enriched-mode)
-;;;;;; "enriched" "enriched.el" (15425 28361))
-;;; Generated autoloads from enriched.el
+;;;;;; "enriched" "textmodes/enriched.el" (16162 11943))
+;;; Generated autoloads from textmodes/enriched.el
(autoload (quote enriched-mode) "enriched" "\
Minor mode for editing text/enriched files.
Commands:
-\\{enriched-mode-map}" t nil)
+\\{enriched-mode-map}
-(autoload (quote enriched-encode) "enriched" nil nil nil)
+\(fn &optional ARG)" t nil)
-(autoload (quote enriched-decode) "enriched" nil nil nil)
+(autoload (quote enriched-encode) "enriched" "\
+Not documented
+
+\(fn FROM TO ORIG-BUF)" nil nil)
+
+(autoload (quote enriched-decode) "enriched" "\
+Not documented
+
+\(fn FROM TO)" nil nil)
;;;***
\f
- ;;;### (autoloads (eshell-mode) "esh-mode" "eshell/esh-mode.el" (15678
- ;;;;;; 51469))
-;;;### (autoloads (eshell-mode) "esh-mode" "eshell/esh-mode.el" (15486
-;;;;;; 57849))
++;;;### (autoloads (eshell-mode) "esh-mode" "eshell/esh-mode.el" (16179
++;;;;;; 16825))
;;; Generated autoloads from eshell/esh-mode.el
(autoload (quote eshell-mode) "esh-mode" "\
Emacs shell interactive mode.
-\\{eshell-mode-map}" nil nil)
+\\{eshell-mode-map}
+
+\(fn)" nil nil)
;;;***
\f
-;;;### (autoloads (eshell-test) "esh-test" "eshell/esh-test.el" (15470
-;;;;;; 10698))
+;;;### (autoloads (eshell-test) "esh-test" "eshell/esh-test.el" (15472
+;;;;;; 50922))
;;; Generated autoloads from eshell/esh-test.el
(autoload (quote eshell-test) "esh-test" "\
-Test Eshell to verify that it works as expected." t nil)
+Test Eshell to verify that it works as expected.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (eshell-report-bug eshell-command-result eshell-command
-;;;;;; eshell) "eshell" "eshell/eshell.el" (15470 1515))
+;;;;;; eshell) "eshell" "eshell/eshell.el" (16070 35808))
;;; Generated autoloads from eshell/eshell.el
(autoload (quote eshell) "eshell" "\
The buffer used for Eshell sessions is determined by the value of
`eshell-buffer-name'. If there is already an Eshell session active in
that buffer, Emacs will simply switch to it. Otherwise, a new session
-will begin. A new session is always created if the prefix
-argument ARG is specified. Returns the buffer selected (or created)." t nil)
+will begin. A numeric prefix arg (as in `C-u 42 M-x eshell RET')
+switches to the session with that number, creating it if necessary. A
+nonnumeric prefix arg means to create a new session. Returns the
+buffer selected (or created).
+
+\(fn &optional ARG)" t nil)
(autoload (quote eshell-command) "eshell" "\
Execute the Eshell command string COMMAND.
-With prefix ARG, insert output into the current buffer at point." t nil)
+With prefix ARG, insert output into the current buffer at point.
+
+\(fn &optional COMMAND ARG)" t nil)
(autoload (quote eshell-command-result) "eshell" "\
Execute the given Eshell COMMAND, and return the result.
The result might be any Lisp object.
If STATUS-VAR is a symbol, it will be set to the exit status of the
command. This is the only way to determine whether the value returned
-corresponding to a successful execution." nil nil)
+corresponding to a successful execution.
+
+\(fn COMMAND &optional STATUS-VAR)" nil nil)
(autoload (quote eshell-report-bug) "eshell" "\
Report a bug in Eshell.
Prompts for the TOPIC. Leaves you in a mail buffer.
-Please include any configuration details that might be involved." t nil)
+Please include any configuration details that might be involved.
+
+\(fn TOPIC)" t nil)
;;;***
\f
;;;### (autoloads (complete-tag select-tags-table tags-apropos list-tags
;;;;;; tags-query-replace tags-search tags-loop-continue next-file
;;;;;; pop-tag-mark find-tag-regexp find-tag-other-frame find-tag-other-window
-;;;;;; find-tag find-tag-noselect tags-table-files visit-tags-table
-;;;;;; find-tag-default-function find-tag-hook tags-add-tables tags-compression-info-list
-;;;;;; tags-table-list tags-case-fold-search) "etags" "progmodes/etags.el"
-;;;;;; (15478 29165))
+;;;;;; find-tag find-tag-noselect tags-table-files visit-tags-table-buffer
+;;;;;; visit-tags-table find-tag-default-function find-tag-hook
+;;;;;; tags-add-tables tags-compression-info-list tags-table-list
+;;;;;; tags-case-fold-search) "etags" "progmodes/etags.el" (16148
+;;;;;; 4633))
;;; Generated autoloads from progmodes/etags.el
(defvar tags-file-name nil "\
A value of t means case-insensitive, a value of nil means case-sensitive.
Any other value means use the setting of `case-fold-search'.")
+(custom-autoload (quote tags-case-fold-search) "etags")
+
(defvar tags-table-list nil "\
*List of file names of tags tables to search.
An element that is a directory means the file \"TAGS\" in that directory.
If you set this variable, do not also set `tags-file-name'.
Use the `etags' program to make a tags table file.")
+(custom-autoload (quote tags-table-list) "etags")
+
(defvar tags-compression-info-list (quote ("" ".Z" ".bz2" ".gz" ".tgz")) "\
*List of extensions tried by etags when jka-compr is used.
An empty string means search the non-compressed file.
\(i.e. via customize of `auto-compression-mode' or by calling the function
`auto-compression-mode').")
+(custom-autoload (quote tags-compression-info-list) "etags")
+
(defvar tags-add-tables (quote ask-user) "\
*Control whether to add a new tags table to the current list.
t means do; nil means don't (always start a new list).
Any other value means ask the user whether to add a new tags table
to the current list (as opposed to starting a new list).")
+(custom-autoload (quote tags-add-tables) "etags")
+
(defvar find-tag-hook nil "\
*Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'.
The value in the buffer in which \\[find-tag] is done is used,
not the value in the buffer \\[find-tag] goes to.")
+(custom-autoload (quote find-tag-hook) "etags")
+
(defvar find-tag-default-function nil "\
*A function of no arguments used by \\[find-tag] to pick a default tag.
If nil, and the symbol that is the value of `major-mode'
has a `find-tag-default-function' property (see `put'), that is used.
Otherwise, `find-tag-default' is used.")
+(custom-autoload (quote find-tag-default-function) "etags")
+
(autoload (quote visit-tags-table) "etags" "\
Tell tags commands to use tags table file FILE.
FILE should be the name of a file created with the `etags' program.
With a prefix arg, set the buffer-local value instead.
When you find a tag with \\[find-tag], the buffer it finds the tag
in is given a local value of this variable which is the name of the tags
-file the tag was in." t nil)
+file the tag was in.
+
+\(fn FILE &optional LOCAL)" t nil)
+
+(autoload (quote visit-tags-table-buffer) "etags" "\
+Select the buffer containing the current tags table.
+If optional arg is a string, visit that file as a tags table.
+If optional arg is t, visit the next table in `tags-table-list'.
+If optional arg is the atom `same', don't look for a new table;
+ just select the buffer visiting `tags-file-name'.
+If arg is nil or absent, choose a first buffer from information in
+ `tags-file-name', `tags-table-list', `tags-table-list-pointer'.
+Returns t if it visits a tags table, or nil if there are no more in the list.
+
+\(fn &optional CONT)" nil nil)
(autoload (quote tags-table-files) "etags" "\
Return a list of files in the current tags table.
Assumes the tags table is the current buffer. The file names are returned
as they appeared in the `etags' command that created the table, usually
-without directory names." nil nil)
+without directory names.
+
+\(fn)" nil nil)
(autoload (quote find-tag-noselect) "etags" "\
Find tag (in current tags table) whose name contains TAGNAME.
onto a ring and may be popped back to with \\[pop-tag-mark].
Contrast this with the ring of marks gone to by the command.
-See documentation of variable `tags-file-name'." t nil)
+See documentation of variable `tags-file-name'.
+
+\(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil)
(autoload (quote find-tag) "etags" "\
Find tag (in current tags table) whose name contains TAGNAME.
onto a ring and may be popped back to with \\[pop-tag-mark].
Contrast this with the ring of marks gone to by the command.
-See documentation of variable `tags-file-name'." t nil)
+See documentation of variable `tags-file-name'.
+
+\(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil)
(define-key esc-map "." 'find-tag)
(autoload (quote find-tag-other-window) "etags" "\
onto a ring and may be popped back to with \\[pop-tag-mark].
Contrast this with the ring of marks gone to by the command.
-See documentation of variable `tags-file-name'." t nil)
+See documentation of variable `tags-file-name'.
+
+\(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil)
(define-key ctl-x-4-map "." 'find-tag-other-window)
(autoload (quote find-tag-other-frame) "etags" "\
onto a ring and may be popped back to with \\[pop-tag-mark].
Contrast this with the ring of marks gone to by the command.
-See documentation of variable `tags-file-name'." t nil)
+See documentation of variable `tags-file-name'.
+
+\(fn TAGNAME &optional NEXT-P)" t nil)
(define-key ctl-x-5-map "." 'find-tag-other-frame)
(autoload (quote find-tag-regexp) "etags" "\
onto a ring and may be popped back to with \\[pop-tag-mark].
Contrast this with the ring of marks gone to by the command.
-See documentation of variable `tags-file-name'." t nil)
+See documentation of variable `tags-file-name'.
+
+\(fn REGEXP &optional NEXT-P OTHER-WINDOW)" t nil)
(define-key esc-map [?\C-.] 'find-tag-regexp)
(define-key esc-map "*" 'pop-tag-mark)
This is distinct from invoking \\[find-tag] with a negative argument
since that pops a stack of markers at which tags were found, not from
-where they were found." t nil)
+where they were found.
+
+\(fn)" t nil)
(autoload (quote next-file) "etags" "\
Select next file among files in current tags table.
to save time and avoid uninteresting warnings.
Value is nil if the file was already visited;
-if the file was newly read in, the value is the filename." t nil)
+if the file was newly read in, the value is the filename.
+
+\(fn &optional INITIALIZE NOVISIT)" t nil)
(autoload (quote tags-loop-continue) "etags" "\
Continue last \\[tags-search] or \\[tags-query-replace] command.
`tags-loop-scan' is a form to be executed on each file to see if it is
interesting (it returns non-nil if so) and `tags-loop-operate' is a form to
evaluate to operate on an interesting file. If the latter evaluates to
-nil, we exit; otherwise we scan the next file." t nil)
+nil, we exit; otherwise we scan the next file.
+
+\(fn &optional FIRST-TIME)" t nil)
(define-key esc-map "," 'tags-loop-continue)
(autoload (quote tags-search) "etags" "\
Stops when a match is found.
To continue searching for next match, use command \\[tags-loop-continue].
-See documentation of variable `tags-file-name'." t nil)
+See documentation of variable `tags-file-name'.
+
+\(fn REGEXP &optional FILE-LIST-FORM)" t nil)
(autoload (quote tags-query-replace) "etags" "\
Do `query-replace-regexp' of FROM with TO on all files listed in tags table.
If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
with the command \\[tags-loop-continue].
-See documentation of variable `tags-file-name'." t nil)
+See documentation of variable `tags-file-name'.
+
+\(fn FROM TO &optional DELIMITED FILE-LIST-FORM START END)" t nil)
(autoload (quote list-tags) "etags" "\
Display list of tags in file FILE.
This searches only the first table in the list, and no included tables.
FILE should be as it appeared in the `etags' command, usually without a
-directory specification." t nil)
+directory specification.
+
+\(fn FILE &optional NEXT-MATCH)" t nil)
(autoload (quote tags-apropos) "etags" "\
-Display list of all tags in tags table REGEXP matches." t nil)
+Display list of all tags in tags table REGEXP matches.
+
+\(fn REGEXP)" t nil)
(autoload (quote select-tags-table) "etags" "\
Select a tags table file from a menu of those you have already used.
The list of tags tables to select from is stored in `tags-table-set-list';
-see the doc of that variable if you want to add names to the list." t nil)
+see the doc of that variable if you want to add names to the list.
+
+\(fn)" t nil)
(autoload (quote complete-tag) "etags" "\
Perform tags completion on the text around point.
Completes to the set of names listed in the current tags table.
The string to complete is chosen in the same way as the default
-for \\[find-tag] (which see)." t nil)
+for \\[find-tag] (which see).
+
+\(fn)" t nil)
;;;***
\f
;;;;;; ethio-fidel-to-sera-buffer ethio-fidel-to-sera-region ethio-sera-to-fidel-marker
;;;;;; ethio-sera-to-fidel-mail ethio-sera-to-fidel-mail-or-marker
;;;;;; ethio-sera-to-fidel-buffer ethio-sera-to-fidel-region setup-ethiopic-environment-internal)
-;;;;;; "ethio-util" "language/ethio-util.el" (15400 1477))
+;;;;;; "ethio-util" "language/ethio-util.el" (16118 44435))
;;; Generated autoloads from language/ethio-util.el
-(autoload (quote setup-ethiopic-environment-internal) "ethio-util" nil nil nil)
+(autoload (quote setup-ethiopic-environment-internal) "ethio-util" "\
+Not documented
+
+\(fn)" nil nil)
(autoload (quote ethio-sera-to-fidel-region) "ethio-util" "\
Convert the characters in region from SERA to FIDEL.
See also the descriptions of the variables
`ethio-use-colon-for-colon' and
-`ethio-use-three-dot-question'." t nil)
+`ethio-use-three-dot-question'.
+
+\(fn BEG END &optional SECONDARY FORCE)" t nil)
(autoload (quote ethio-sera-to-fidel-buffer) "ethio-util" "\
Convert the current buffer from SERA to FIDEL.
See also the descriptions of the variables
`ethio-use-colon-for-colon' and
-`ethio-use-three-dot-question'." t nil)
+`ethio-use-three-dot-question'.
+
+\(fn &optional SECONDARY FORCE)" t nil)
(autoload (quote ethio-sera-to-fidel-mail-or-marker) "ethio-util" "\
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." t nil)
+If in rmail-mode or in mail-mode, execute the former; otherwise latter.
+
+\(fn &optional ARG)" t nil)
(autoload (quote ethio-sera-to-fidel-mail) "ethio-util" "\
Convert SERA to FIDEL to read/write mail and news.
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'." t nil)
+and the body into FIDEL using `ethio-sera-to-fidel-region'.
+
+\(fn &optional ARG)" t nil)
(autoload (quote ethio-sera-to-fidel-marker) "ethio-util" "\
Convert the regions surrounded by \"<sera>\" and \"</sera>\" from SERA to FIDEL.
Assume that each region begins with `ethio-primary-language'.
-The markers \"<sera>\" and \"</sera>\" themselves are not deleted." t nil)
+The markers \"<sera>\" and \"</sera>\" themselves are not deleted.
+
+\(fn &optional FORCE)" t nil)
(autoload (quote ethio-fidel-to-sera-region) "ethio-util" "\
Replace all the FIDEL characters in the region to the SERA format.
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'." t nil)
+`ethio-quote-vowel-always' and `ethio-numeric-reduction'.
+
+\(fn BEGIN END &optional SECONDARY FORCE)" t nil)
(autoload (quote ethio-fidel-to-sera-buffer) "ethio-util" "\
Replace all the FIDEL characters in the current buffer to the SERA format.
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'." t nil)
+`ethio-quote-vowel-always' and `ethio-numeric-reduction'.
+
+\(fn &optional SECONDARY FORCE)" t nil)
(autoload (quote ethio-fidel-to-sera-mail-or-marker) "ethio-util" "\
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." t nil)
+If in rmail-mode or in mail-mode, execute the former; otherwise latter.
+
+\(fn &optional ARG)" t nil)
(autoload (quote ethio-fidel-to-sera-mail) "ethio-util" "\
Convert FIDEL to SERA to read/write mail and news.
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." t nil)
+The very same procedure applies to the subject field, too.
+
+\(fn)" t nil)
(autoload (quote ethio-fidel-to-sera-marker) "ethio-util" "\
Convert the regions surrounded by \"<sera>\" and \"</sera>\" from FIDEL to SERA.
-The markers \"<sera>\" and \"</sera>\" themselves are not deleted." t nil)
+The markers \"<sera>\" and \"</sera>\" themselves are not deleted.
+
+\(fn &optional FORCE)" t nil)
(autoload (quote ethio-modify-vowel) "ethio-util" "\
-Modify the vowel of the FIDEL that is under the cursor." t nil)
+Modify the vowel of the FIDEL that is under the cursor.
+
+\(fn)" t nil)
(autoload (quote ethio-replace-space) "ethio-util" "\
Replace ASCII spaces with Ethiopic word separators in the region.
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." t nil)
+The second and third parameters BEGIN and END specify the region.
+
+\(fn CH BEGIN END)" t nil)
(autoload (quote ethio-input-special-character) "ethio-util" "\
-Allow the user to input special characters." t nil)
+Allow the user to input special characters.
+
+\(fn ARG)" t nil)
(autoload (quote ethio-fidel-to-tex-buffer) "ethio-util" "\
Convert each fidel characters in the current buffer into a fidel-tex command.
-Each command is always surrounded by braces." t nil)
+Each command is always surrounded by braces.
+
+\(fn)" t nil)
(autoload (quote ethio-tex-to-fidel-buffer) "ethio-util" "\
-Convert fidel-tex commands in the current buffer into fidel chars." t nil)
+Convert fidel-tex commands in the current buffer into fidel chars.
+
+\(fn)" t nil)
(autoload (quote ethio-fidel-to-java-buffer) "ethio-util" "\
Convert Ethiopic characters into the Java escape sequences.
character's codepoint (in hex) in Unicode.
If `ethio-java-save-lowercase' is non-nil, use [0-9a-f].
-Otherwise, [0-9A-F]." nil nil)
+Otherwise, [0-9A-F].
+
+\(fn)" nil nil)
(autoload (quote ethio-java-to-fidel-buffer) "ethio-util" "\
-Convert the Java escape sequences into corresponding Ethiopic characters." nil nil)
+Convert the Java escape sequences into corresponding Ethiopic characters.
+
+\(fn)" nil nil)
(autoload (quote ethio-find-file) "ethio-util" "\
-Transcribe file content into Ethiopic dependig on filename suffix." nil nil)
+Transcribe file content into Ethiopic dependig on filename suffix.
+
+\(fn)" nil nil)
(autoload (quote ethio-write-file) "ethio-util" "\
-Transcribe Ethiopic characters in ASCII depending on the file extension." nil nil)
+Transcribe Ethiopic characters in ASCII depending on the file extension.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (eudc-load-eudc eudc-query-form eudc-expand-inline
;;;;;; eudc-get-phone eudc-get-email eudc-set-server) "eudc" "net/eudc.el"
-;;;;;; (15441 20096))
+;;;;;; (15829 28909))
;;; Generated autoloads from net/eudc.el
(autoload (quote eudc-set-server) "eudc" "\
Set the directory server to SERVER using PROTOCOL.
Unless NO-SAVE is non-nil, the server is saved as the default
-server for future sessions." t nil)
+server for future sessions.
+
+\(fn SERVER PROTOCOL &optional NO-SAVE)" t nil)
(autoload (quote eudc-get-email) "eudc" "\
-Get the email field of NAME from the directory server." t nil)
+Get the email field of NAME from the directory server.
+
+\(fn NAME)" t nil)
(autoload (quote eudc-get-phone) "eudc" "\
-Get the phone field of NAME from the directory server." t nil)
+Get the phone field of NAME from the directory server.
+
+\(fn NAME)" t nil)
(autoload (quote eudc-expand-inline) "eudc" "\
Query the directory server, and expand the query string before point.
If REPLACE is non-nil, then this expansion replaces the name in the buffer.
`eudc-expansion-overwrites-query' being non-nil inverts the meaning of REPLACE.
Multiple servers can be tried with the same query until one finds a match,
-see `eudc-inline-expansion-servers'" t nil)
+see `eudc-inline-expansion-servers'
+
+\(fn &optional REPLACE)" t nil)
(autoload (quote eudc-query-form) "eudc" "\
Display a form to query the directory server.
If given a non-nil argument GET-FIELDS-FROM-SERVER, the function first
-queries the server for the existing fields and displays a corresponding form." t nil)
+queries the server for the existing fields and displays a corresponding form.
+
+\(fn &optional GET-FIELDS-FROM-SERVER)" t nil)
(autoload (quote eudc-load-eudc) "eudc" "\
Load the Emacs Unified Directory Client.
-This does nothing except loading eudc by autoload side-effect." t nil)
+This does nothing except loading eudc by autoload side-effect.
+
+\(fn)" t nil)
(cond ((not (string-match "XEmacs" emacs-version)) (defvar eudc-tools-menu (make-sparse-keymap "Directory Search")) (fset (quote eudc-tools-menu) (symbol-value (quote eudc-tools-menu))) (define-key eudc-tools-menu [phone] (quote ("Get Phone" . eudc-get-phone))) (define-key eudc-tools-menu [email] (quote ("Get Email" . eudc-get-email))) (define-key eudc-tools-menu [separator-eudc-email] (quote ("--"))) (define-key eudc-tools-menu [expand-inline] (quote ("Expand Inline Query" . eudc-expand-inline))) (define-key eudc-tools-menu [query] (quote ("Query with Form" . eudc-query-form))) (define-key eudc-tools-menu [separator-eudc-query] (quote ("--"))) (define-key eudc-tools-menu [new] (quote ("New Server" . eudc-set-server))) (define-key eudc-tools-menu [load] (quote ("Load Hotlist of Servers" . eudc-load-eudc)))) (t (let ((menu (quote ("Directory Search" ["Load Hotlist of Servers" eudc-load-eudc t] ["New Server" eudc-set-server t] ["---" nil nil] ["Query with Form" eudc-query-form t] ["Expand Inline Query" eudc-expand-inline t] ["---" nil nil] ["Get Email" eudc-get-email t] ["Get Phone" eudc-get-phone t])))) (if (not (featurep (quote eudc-autoloads))) (if eudc-xemacs-p (if (and (featurep (quote menubar)) (not (featurep (quote infodock)))) (add-submenu (quote ("Tools")) menu)) (require (quote easymenu)) (cond ((fboundp (quote easy-menu-add-item)) (easy-menu-add-item nil (quote ("tools")) (easy-menu-create-menu (car menu) (cdr menu)))) ((fboundp (quote easy-menu-create-keymaps)) (define-key global-map [menu-bar tools eudc] (cons "Directory Search" (easy-menu-create-keymaps "Directory Search" (cdr menu)))))))))))
\f
;;;### (autoloads (eudc-display-jpeg-as-button eudc-display-jpeg-inline
;;;;;; eudc-display-sound eudc-display-mail eudc-display-url eudc-display-generic-binary)
-;;;;;; "eudc-bob" "net/eudc-bob.el" (15441 20096))
+;;;;;; "eudc-bob" "net/eudc-bob.el" (15429 17608))
;;; Generated autoloads from net/eudc-bob.el
(autoload (quote eudc-display-generic-binary) "eudc-bob" "\
-Display a button for unidentified binary DATA." nil nil)
+Display a button for unidentified binary DATA.
+
+\(fn DATA)" nil nil)
(autoload (quote eudc-display-url) "eudc-bob" "\
-Display URL and make it clickable." nil nil)
+Display URL and make it clickable.
+
+\(fn URL)" nil nil)
(autoload (quote eudc-display-mail) "eudc-bob" "\
-Display e-mail address and make it clickable." nil nil)
+Display e-mail address and make it clickable.
+
+\(fn MAIL)" nil nil)
(autoload (quote eudc-display-sound) "eudc-bob" "\
-Display a button to play the sound DATA." nil nil)
+Display a button to play the sound DATA.
+
+\(fn DATA)" nil nil)
(autoload (quote eudc-display-jpeg-inline) "eudc-bob" "\
-Display the JPEG DATA inline at point if possible." nil nil)
+Display the JPEG DATA inline at point if possible.
+
+\(fn DATA)" nil nil)
(autoload (quote eudc-display-jpeg-as-button) "eudc-bob" "\
-Display a button for the JPEG DATA." nil nil)
+Display a button for the JPEG DATA.
+
+\(fn DATA)" nil nil)
;;;***
\f
;;;### (autoloads (eudc-try-bbdb-insert eudc-insert-record-at-point-into-bbdb)
-;;;;;; "eudc-export" "net/eudc-export.el" (15441 20096))
+;;;;;; "eudc-export" "net/eudc-export.el" (15429 17608))
;;; Generated autoloads from net/eudc-export.el
(autoload (quote eudc-insert-record-at-point-into-bbdb) "eudc-export" "\
Insert record at point into the BBDB database.
-This function can only be called from a directory query result buffer." t nil)
+This function can only be called from a directory query result buffer.
+
+\(fn)" t nil)
(autoload (quote eudc-try-bbdb-insert) "eudc-export" "\
-Call `eudc-insert-record-at-point-into-bbdb' if on a record." t nil)
+Call `eudc-insert-record-at-point-into-bbdb' if on a record.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (eudc-edit-hotlist) "eudc-hotlist" "net/eudc-hotlist.el"
-;;;;;; (15441 20096))
+;;;;;; (15429 17608))
;;; Generated autoloads from net/eudc-hotlist.el
(autoload (quote eudc-edit-hotlist) "eudc-hotlist" "\
-Edit the hotlist of directory servers in a specialized buffer." t nil)
+Edit the hotlist of directory servers in a specialized buffer.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (executable-make-buffer-file-executable-if-script-p
;;;;;; executable-self-display executable-set-magic executable-find)
-;;;;;; "executable" "progmodes/executable.el" (15371 46426))
+;;;;;; "executable" "progmodes/executable.el" (16111 41832))
;;; Generated autoloads from progmodes/executable.el
(autoload (quote executable-find) "executable" "\
Search for COMMAND in `exec-path' and return the absolute file name.
-Return nil if COMMAND is not found anywhere in `exec-path'." nil nil)
+Return nil if COMMAND is not found anywhere in `exec-path'.
+
+\(fn COMMAND)" nil nil)
(autoload (quote executable-set-magic) "executable" "\
Set this buffer's interpreter to INTERPRETER with optional ARGUMENT.
The variables `executable-magicless-file-regexp', `executable-prefix',
`executable-insert', `executable-query' and `executable-chmod' control
when and how magic numbers are inserted or replaced and scripts made
-executable." t nil)
+executable.
+
+\(fn INTERPRETER &optional ARGUMENT NO-QUERY-FLAG INSERT-FLAG)" t nil)
(autoload (quote executable-self-display) "executable" "\
Turn a text file into a self-displaying Un*x command.
-The magic number of such a command displays all lines but itself." t nil)
+The magic number of such a command displays all lines but itself.
+
+\(fn)" t nil)
(autoload (quote executable-make-buffer-file-executable-if-script-p) "executable" "\
Make file executable according to umask if not already executable.
If file already has any execute bits set at all, do not change existing
-file modes." nil nil)
+file modes.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (expand-jump-to-next-slot expand-jump-to-previous-slot
-;;;;;; expand-add-abbrevs) "expand" "expand.el" (15391 60510))
+;;;;;; expand-add-abbrevs) "expand" "expand.el" (15364 46020))
;;; Generated autoloads from expand.el
(autoload (quote expand-add-abbrevs) "expand" "\
cyclicaly with the functions `expand-jump-to-previous-slot' and
`expand-jump-to-next-slot'.
-If ARG is omitted, point is placed at the end of the expanded text." nil nil)
+If ARG is omitted, point is placed at the end of the expanded text.
+
+\(fn TABLE ABBREVS)" nil nil)
(autoload (quote expand-jump-to-previous-slot) "expand" "\
Move the cursor to the previous slot in the last abbrev expansion.
-This is used only in conjunction with `expand-add-abbrevs'." t nil)
+This is used only in conjunction with `expand-add-abbrevs'.
+
+\(fn)" t nil)
(autoload (quote expand-jump-to-next-slot) "expand" "\
Move the cursor to the next slot in the last abbrev expansion.
-This is used only in conjunction with `expand-add-abbrevs'." t nil)
+This is used only in conjunction with `expand-add-abbrevs'.
+
+\(fn)" t nil)
(define-key ctl-x-map "ap" 'expand-jump-to-previous-slot)
(define-key ctl-x-map "an" 'expand-jump-to-next-slot)
;;;***
\f
-;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (15417 7451))
+;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (16054 60750))
;;; Generated autoloads from progmodes/f90.el
(autoload (quote f90-mode) "f90" "\
-Major mode for editing Fortran 90 code in free format.
+Major mode for editing Fortran 90,95 code in free format.
+For fixed format code, use `fortran-mode'.
-\\[f90-indent-new-line] corrects current indentation and creates new indented line.
-\\[f90-indent-line] indents the current line correctly.
-\\[f90-indent-subprogram] indents the current subprogram.
+\\[f90-indent-line] indents the current line.
+\\[f90-indent-new-line] indents current line and creates a new indented line.
+\\[f90-indent-subprogram] indents the current subprogram.
Type `? or `\\[help-command] to display a list of built-in abbrevs for F90 keywords.
Variables controlling indentation style and extra features:
- f90-do-indent
- Extra indentation within do blocks. (default 3)
- f90-if-indent
- Extra indentation within if/select case/where/forall blocks. (default 3)
- f90-type-indent
- Extra indentation within type/interface/block-data blocks. (default 3)
- f90-program-indent
- Extra indentation within program/module/subroutine/function blocks.
- (default 2)
- f90-continuation-indent
- Extra indentation applied to continuation lines. (default 5)
- f90-comment-region
- String inserted by \\[f90-comment-region] at start of each line in
- region. (default \"!!!$\")
- f90-indented-comment-re
- Regexp determining the type of comment to be intended like code.
- (default \"!\")
- f90-directive-comment-re
- Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented.
- (default \"!hpf\\\\$\")
- f90-break-delimiters
- Regexp holding list of delimiters at which lines may be broken.
- (default \"[-+*/><=,% \\t]\")
- f90-break-before-delimiters
- Non-nil causes `f90-do-auto-fill' to break lines before delimiters.
- (default t)
- f90-beginning-ampersand
- Automatic insertion of & at beginning of continuation lines. (default t)
- f90-smart-end
- From an END statement, check and fill the end using matching block start.
- Allowed values are 'blink, 'no-blink, and nil, which determine
- whether to blink the matching beginning.) (default 'blink)
- f90-auto-keyword-case
- Automatic change of case of keywords. (default nil)
- The possibilities are 'downcase-word, 'upcase-word, 'capitalize-word.
- f90-leave-line-no
- Do not left-justify line numbers. (default nil)
- f90-startup-message
- Set to nil to inhibit message first time F90 mode is used. (default t)
- f90-keywords-re
- List of keywords used for highlighting/upcase-keywords etc.
+`f90-do-indent'
+ Extra indentation within do blocks (default 3).
+`f90-if-indent'
+ Extra indentation within if/select case/where/forall blocks (default 3).
+`f90-type-indent'
+ Extra indentation within type/interface/block-data blocks (default 3).
+`f90-program-indent'
+ Extra indentation within program/module/subroutine/function blocks
+ (default 2).
+`f90-continuation-indent'
+ Extra indentation applied to continuation lines (default 5).
+`f90-comment-region'
+ String inserted by function \\[f90-comment-region] at start of each
+ line in region (default \"!!!$\").
+`f90-indented-comment-re'
+ Regexp determining the type of comment to be intended like code
+ (default \"!\").
+`f90-directive-comment-re'
+ Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented
+ (default \"!hpf\\\\$\").
+`f90-break-delimiters'
+ Regexp holding list of delimiters at which lines may be broken
+ (default \"[-+*/><=,% \\t]\").
+`f90-break-before-delimiters'
+ Non-nil causes `f90-do-auto-fill' to break lines before delimiters
+ (default t).
+`f90-beginning-ampersand'
+ Automatic insertion of & at beginning of continuation lines (default t).
+`f90-smart-end'
+ From an END statement, check and fill the end using matching block start.
+ Allowed values are 'blink, 'no-blink, and nil, which determine
+ whether to blink the matching beginning (default 'blink).
+`f90-auto-keyword-case'
+ Automatic change of case of keywords (default nil).
+ The possibilities are 'downcase-word, 'upcase-word, 'capitalize-word.
+`f90-leave-line-no'
+ Do not left-justify line numbers (default nil).
+`f90-keywords-re'
+ List of keywords used for highlighting/upcase-keywords etc.
Turning on F90 mode calls the value of the variable `f90-mode-hook'
-with no args, if that value is non-nil." t nil)
+with no args, if that value is non-nil.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (list-colors-display facemenu-read-color list-text-properties-at
-;;;;;; describe-text-at facemenu-remove-special facemenu-remove-all
-;;;;;; facemenu-remove-face-props facemenu-set-read-only facemenu-set-intangible
-;;;;;; facemenu-set-invisible facemenu-set-face-from-menu facemenu-set-background
-;;;;;; facemenu-set-foreground facemenu-set-face) "facemenu" "facemenu.el"
-;;;;;; (15474 10566))
+;;;### (autoloads (list-colors-display facemenu-read-color facemenu-remove-special
+;;;;;; facemenu-remove-all facemenu-remove-face-props facemenu-set-read-only
+;;;;;; facemenu-set-intangible facemenu-set-invisible facemenu-set-face-from-menu
+;;;;;; facemenu-set-background facemenu-set-foreground facemenu-set-face)
+;;;;;; "facemenu" "facemenu.el" (15941 42952))
;;; Generated autoloads from facemenu.el
(define-key global-map "\M-g" 'facemenu-keymap)
(autoload 'facemenu-keymap "facemenu" "Keymap for face-changing commands." t 'keymap)
(setq facemenu-menu (make-sparse-keymap "Text Properties"))
-(let ((map facemenu-menu)) (define-key map [dc] (cons (purecopy "Display Colors") (quote list-colors-display))) (define-key map [df] (cons (purecopy "Display Faces") (quote list-faces-display))) (define-key map [dp] (cons (purecopy "Describe Text") (quote describe-text-at))) (define-key map [ra] (cons (purecopy "Remove Text Properties") (quote facemenu-remove-all))) (define-key map [rm] (cons (purecopy "Remove Face Properties") (quote facemenu-remove-face-props))) (define-key map [s1] (list (purecopy "--"))))
+(let ((map facemenu-menu)) (define-key map [dc] (cons (purecopy "Display Colors") (quote list-colors-display))) (define-key map [df] (cons (purecopy "Display Faces") (quote list-faces-display))) (define-key map [dp] (cons (purecopy "Describe Properties") (quote describe-text-properties))) (define-key map [ra] (cons (purecopy "Remove Text Properties") (quote facemenu-remove-all))) (define-key map [rm] (cons (purecopy "Remove Face Properties") (quote facemenu-remove-face-props))) (define-key map [s1] (list (purecopy "--"))))
(let ((map facemenu-menu)) (define-key map [in] (cons (purecopy "Indentation") (quote facemenu-indentation-menu))) (define-key map [ju] (cons (purecopy "Justification") (quote facemenu-justification-menu))) (define-key map [s2] (list (purecopy "--"))) (define-key map [sp] (cons (purecopy "Special Properties") (quote facemenu-special-menu))) (define-key map [bg] (cons (purecopy "Background Color") (quote facemenu-background-menu))) (define-key map [fg] (cons (purecopy "Foreground Color") (quote facemenu-foreground-menu))) (define-key map [fc] (cons (purecopy "Face") (quote facemenu-face-menu))))
Otherwise, this command specifies the face for the next character
inserted. Moving point or switching buffers before
-typing a character to insert cancels the specification." t nil)
+typing a character to insert cancels the specification.
+
+\(fn FACE &optional START END)" t nil)
(autoload (quote facemenu-set-foreground) "facemenu" "\
Set the foreground COLOR of the region or next character typed.
-The color is prompted for. A face named `fg:color' is used (or created).
+This command reads the color in the minibuffer.
If the region is active (normally true except in Transient Mark mode)
and there is no prefix argument, this command sets the region to the
Otherwise, this command specifies the face for the next character
inserted. Moving point or switching buffers before
-typing a character to insert cancels the specification." t nil)
+typing a character to insert cancels the specification.
+
+\(fn COLOR &optional START END)" t nil)
(autoload (quote facemenu-set-background) "facemenu" "\
Set the background COLOR of the region or next character typed.
-Reads the color in the minibuffer.
+This command reads the color in the minibuffer.
If the region is active (normally true except in Transient Mark mode)
and there is no prefix argument, this command sets the region to the
Otherwise, this command specifies the face for the next character
inserted. Moving point or switching buffers before
-typing a character to insert cancels the specification." t nil)
+typing a character to insert cancels the specification.
+
+\(fn COLOR &optional START END)" t nil)
(autoload (quote facemenu-set-face-from-menu) "facemenu" "\
Set the FACE of the region or next character typed.
Otherwise, this command specifies the face for the next character
inserted. Moving point or switching buffers before
-typing a character to insert cancels the specification." t nil)
+typing a character to insert cancels the specification.
+
+\(fn FACE START END)" t nil)
(autoload (quote facemenu-set-invisible) "facemenu" "\
Make the region invisible.
This sets the `invisible' text property; it can be undone with
-`facemenu-remove-special'." t nil)
+`facemenu-remove-special'.
+
+\(fn START END)" t nil)
(autoload (quote facemenu-set-intangible) "facemenu" "\
Make the region intangible: disallow moving into it.
This sets the `intangible' text property; it can be undone with
-`facemenu-remove-special'." t nil)
+`facemenu-remove-special'.
+
+\(fn START END)" t nil)
(autoload (quote facemenu-set-read-only) "facemenu" "\
Make the region unmodifiable.
This sets the `read-only' text property; it can be undone with
-`facemenu-remove-special'." t nil)
+`facemenu-remove-special'.
+
+\(fn START END)" t nil)
(autoload (quote facemenu-remove-face-props) "facemenu" "\
-Remove `face' and `mouse-face' text properties." t nil)
+Remove `face' and `mouse-face' text properties.
+
+\(fn START END)" t nil)
(autoload (quote facemenu-remove-all) "facemenu" "\
-Remove all text properties from the region." t nil)
+Remove all text properties from the region.
+
+\(fn START END)" t nil)
(autoload (quote facemenu-remove-special) "facemenu" "\
Remove all the \"special\" text properties from the region.
-These special properties include `invisible', `intangible' and `read-only'." t nil)
+These special properties include `invisible', `intangible' and `read-only'.
-(autoload (quote describe-text-at) "facemenu" "\
-Describe widgets, buttons, overlays and text properties at POS." t nil)
-
-(autoload (quote list-text-properties-at) "facemenu" "\
-Pop up a buffer listing text-properties at LOCATION." t nil)
+\(fn START END)" t nil)
(autoload (quote facemenu-read-color) "facemenu" "\
-Read a color using the minibuffer." nil nil)
+Read a color using the minibuffer.
+
+\(fn &optional PROMPT)" nil nil)
(autoload (quote list-colors-display) "facemenu" "\
Display names of defined colors, and show what they look like.
If the optional argument LIST is non-nil, it should be a list of
colors to display. Otherwise, this command computes a list
-of colors that the current display can handle." t nil)
+of colors that the current display can handle.
+
+\(fn &optional LIST)" t nil)
;;;***
\f
;;;### (autoloads (turn-on-fast-lock fast-lock-mode) "fast-lock"
-;;;;;; "fast-lock.el" (15391 60510))
+;;;;;; "fast-lock.el" (15941 42952))
;;; Generated autoloads from fast-lock.el
(autoload (quote fast-lock-mode) "fast-lock" "\
Various methods of control are provided for the Font Lock cache. In general,
see variable `fast-lock-cache-directories' and function `fast-lock-cache-name'.
For saving, see variables `fast-lock-minimum-size', `fast-lock-save-events',
-`fast-lock-save-others' and `fast-lock-save-faces'." t nil)
+`fast-lock-save-others' and `fast-lock-save-faces'.
+
+\(fn &optional ARG)" t nil)
(autoload (quote turn-on-fast-lock) "fast-lock" "\
-Unconditionally turn on Fast Lock mode." nil nil)
+Unconditionally turn on Fast Lock mode.
+
+\(fn)" nil nil)
(when (fboundp (quote add-minor-mode)) (defvar fast-lock-mode nil) (add-minor-mode (quote fast-lock-mode) nil))
\f
;;;### (autoloads (feedmail-queue-reminder feedmail-run-the-queue
;;;;;; feedmail-run-the-queue-global-prompt feedmail-run-the-queue-no-prompts
-;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (15441 20095))
+;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (15856 53274))
;;; Generated autoloads from mail/feedmail.el
(autoload (quote feedmail-send-it) "feedmail" "\
Send the current mail buffer using the Feedmail package.
This is a suitable value for `send-mail-function'. It can be used
-with various lower-level mechanisms to provide features such as queueing." nil nil)
+with various lower-level mechanisms to provide features such as queueing.
+
+\(fn)" nil nil)
(autoload (quote feedmail-run-the-queue-no-prompts) "feedmail" "\
-Like feedmail-run-the-queue, but suppress confirmation prompts." t nil)
+Like feedmail-run-the-queue, but suppress confirmation prompts.
+
+\(fn &optional ARG)" t nil)
(autoload (quote feedmail-run-the-queue-global-prompt) "feedmail" "\
Like feedmail-run-the-queue, but with a global confirmation prompt.
This is generally most useful if run non-interactively, since you can
-bail out with an appropriate answer to the global confirmation prompt." t nil)
+bail out with an appropriate answer to the global confirmation prompt.
+
+\(fn &optional ARG)" t nil)
(autoload (quote feedmail-run-the-queue) "feedmail" "\
Visit each message in the feedmail queue directory and send it out.
Return value is a list of three things: number of messages sent, number of
messages skipped, and number of non-message things in the queue (commonly
-backup file names and the like)." t nil)
+backup file names and the like).
+
+\(fn &optional ARG)" t nil)
(autoload (quote feedmail-queue-reminder) "feedmail" "\
Perform some kind of reminder activity about queued and draft messages.
the associated value is a function, it is called without arguments and is expected
to perform the reminder activity. You can supply your own reminder functions
by redefining feedmail-queue-reminder-alist. If you don't want any reminders,
-you can set feedmail-queue-reminder-alist to nil." t nil)
+you can set feedmail-queue-reminder-alist to nil.
+
+\(fn &optional WHAT-EVENT)" t nil)
;;;***
\f
;;;### (autoloads (ffap-bindings dired-at-point ffap-at-mouse ffap-menu
-;;;;;; find-file-at-point ffap-next) "ffap" "ffap.el" (15464 26323))
+;;;;;; find-file-at-point ffap-next) "ffap" "ffap.el" (15997 671))
;;; Generated autoloads from ffap.el
(autoload (quote ffap-next) "ffap" "\
Optional argument WRAP says to try wrapping around if necessary.
Interactively: use a single prefix to search backwards,
double prefix to wrap forward, triple to wrap backwards.
-Actual search is done by `ffap-next-guess'." t nil)
+Actual search is done by `ffap-next-guess'.
+
+\(fn &optional BACK WRAP)" t nil)
(autoload (quote find-file-at-point) "ffap" "\
Find FILENAME, guessing a default from text around point.
See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
and the functions `ffap-file-at-point' and `ffap-url-at-point'.
-See <ftp://ftp.mathcs.emory.edu/pub/mic/emacs/> for latest version." t nil)
-(defalias 'ffap 'find-file-at-point)
+See <ftp://ftp.mathcs.emory.edu/pub/mic/emacs/> for latest version.
+
+\(fn &optional FILENAME)" t nil)
+
+(defalias (quote ffap) (quote find-file-at-point))
(autoload (quote ffap-menu) "ffap" "\
Put up a menu of files and urls mentioned in this buffer.
Then set mark, jump to choice, and try to fetch it. The menu is
cached in `ffap-menu-alist', and rebuilt by `ffap-menu-rescan'.
The optional RESCAN argument (a prefix, interactively) forces
-a rebuild. Searches with `ffap-menu-regexp'." t nil)
+a rebuild. Searches with `ffap-menu-regexp'.
+
+\(fn &optional RESCAN)" t nil)
(autoload (quote ffap-at-mouse) "ffap" "\
Find file or url guessed from text around mouse click.
Return value:
* if a guess string is found, return it (after finding it)
* if the fallback is called, return whatever it returns
- * otherwise, nil" t nil)
+ * otherwise, nil
+
+\(fn E)" t nil)
(autoload (quote dired-at-point) "ffap" "\
-Start Dired, defaulting to file at point. See `ffap'." t nil)
+Start Dired, defaulting to file at point. See `ffap'.
+
+\(fn &optional FILENAME)" t nil)
(autoload (quote ffap-bindings) "ffap" "\
-Evaluate the forms in variable `ffap-bindings'." t nil)
+Evaluate the forms in variable `ffap-bindings'.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (file-cache-minibuffer-complete) "filecache" "filecache.el"
-;;;;;; (15391 60510))
+;;;;;; (15997 5128))
;;; Generated autoloads from filecache.el
(autoload (quote file-cache-minibuffer-complete) "filecache" "\
the cache, and, once it has found a unique name, it cycles through
the directories that the name is available in. With a prefix argument,
the name is considered already unique; only the second substitution
-\(directories) is done." t nil)
+\(directories) is done.
+
+\(fn ARG)" t nil)
(define-key minibuffer-local-completion-map [C-tab] 'file-cache-minibuffer-complete)
(define-key minibuffer-local-map [C-tab] 'file-cache-minibuffer-complete)
(define-key minibuffer-local-must-match-map [C-tab] 'file-cache-minibuffer-complete)
;;;***
\f
;;;### (autoloads (find-grep-dired find-name-dired find-dired find-grep-options
-;;;;;; find-ls-option) "find-dired" "find-dired.el" (15417 7388))
+;;;;;; find-ls-option) "find-dired" "find-dired.el" (15941 42952))
;;; Generated autoloads from find-dired.el
(defvar find-ls-option (if (eq system-type (quote berkeley-unix)) (quote ("-ls" . "-gilsb")) (quote ("-exec ls -ld {} \\;" . "-ld"))) "\
gives the option (or options) to `find' that produce the desired output.
LS-SWITCHES is a list of `ls' switches to tell dired how to parse the output.")
+(custom-autoload (quote find-ls-option) "find-dired")
+
(defvar find-grep-options (if (or (eq system-type (quote berkeley-unix)) (string-match "solaris2" system-configuration) (string-match "irix" system-configuration)) "-s" "-q") "\
*Option to grep to be as silent as possible.
On Berkeley systems, this is `-s'; on Posix, and with GNU grep, `-q' does it.
On other systems, the closest you can come is to use `-l'.")
+(custom-autoload (quote find-grep-options) "find-dired")
+
(autoload (quote find-dired) "find-dired" "\
Run `find' and go into Dired mode on a buffer of the output.
The command run (after changing into DIR) is
find . \\( ARGS \\) -ls
except that the variable `find-ls-option' specifies what to use
-as the final argument." t nil)
+as the final argument.
+
+\(fn DIR ARGS)" t nil)
(autoload (quote find-name-dired) "find-dired" "\
Search DIR recursively for files matching the globbing pattern PATTERN,
PATTERN is a shell wildcard (not an Emacs regexp) and need not be quoted.
The command run (after changing into DIR) is
- find . -name 'PATTERN' -ls" t nil)
+ find . -name 'PATTERN' -ls
+
+\(fn DIR PATTERN)" t nil)
(autoload (quote find-grep-dired) "find-dired" "\
-Find files in DIR containing a regexp ARG and start Dired on output.
+Find files in DIR containing a regexp REGEXP and start Dired on output.
The command run (after changing into DIR) is
- find . -exec grep -s ARG {} \\; -ls
+ find . -exec grep -s -e REGEXP {} \\; -ls
-Thus ARG can also contain additional grep options." t nil)
+Thus ARG can also contain additional grep options.
+
+\(fn DIR REGEXP)" t nil)
;;;***
\f
;;;### (autoloads (ff-mouse-find-other-file-other-window ff-mouse-find-other-file
;;;;;; ff-find-other-file ff-get-other-file) "find-file" "find-file.el"
-;;;;;; (15400 1472))
+;;;;;; (16111 41825))
;;; Generated autoloads from find-file.el
(autoload (quote ff-get-other-file) "find-file" "\
Find the header or source file corresponding to this file.
See also the documentation for `ff-find-other-file'.
-If optional IN-OTHER-WINDOW is non-nil, find the file in another window." t nil)
+If optional IN-OTHER-WINDOW is non-nil, find the file in another window.
+
+\(fn &optional IN-OTHER-WINDOW)" t nil)
+
+(defalias (quote ff-find-related-file) (quote ff-find-other-file))
(autoload (quote ff-find-other-file) "find-file" "\
Find the header or source file corresponding to this file.
List of directories searched through with each extension specified in
`ff-other-file-alist' that matches this file's extension.
- - `ff-pre-find-hooks'
+ - `ff-pre-find-hook'
List of functions to be called before the search for the file starts.
- - `ff-pre-load-hooks'
+ - `ff-pre-load-hook'
List of functions to be called before the other file is loaded.
- - `ff-post-load-hooks'
+ - `ff-post-load-hook'
List of functions to be called after the other file is loaded.
- - `ff-not-found-hooks'
+ - `ff-not-found-hook'
List of functions to be called if the other file could not be found.
- - `ff-file-created-hooks'
- List of functions to be called if the other file has been created." t nil)
+ - `ff-file-created-hook'
+ List of functions to be called if the other file has been created.
+
+\(fn &optional IN-OTHER-WINDOW IGNORE-INCLUDE)" t nil)
(autoload (quote ff-mouse-find-other-file) "find-file" "\
-Visit the file you click on." t nil)
+Visit the file you click on.
+
+\(fn EVENT)" t nil)
(autoload (quote ff-mouse-find-other-file-other-window) "find-file" "\
-Visit the file you click on in another window." t nil)
+Visit the file you click on in another window.
+
+\(fn EVENT)" t nil)
;;;***
\f
;;;;;; find-function-at-point find-function-on-key find-variable-other-frame
;;;;;; find-variable-other-window find-variable find-variable-noselect
;;;;;; find-function-other-frame find-function-other-window find-function
-;;;;;; find-function-noselect) "find-func" "emacs-lisp/find-func.el"
-;;;;;; (15371 46419))
+;;;;;; find-function-noselect find-function-search-for-symbol find-library)
+;;;;;; "find-func" "emacs-lisp/find-func.el" (16111 41828))
;;; Generated autoloads from emacs-lisp/find-func.el
+(autoload (quote find-library) "find-func" "\
+Find the elisp source of LIBRARY.
+
+\(fn LIBRARY)" t nil)
+
+(autoload (quote find-function-search-for-symbol) "find-func" "\
+Search for SYMBOL.
+If VARIABLE-P is nil, `find-function-regexp' is used, otherwise
+`find-variable-regexp' is used. The search is done in library LIBRARY.
+
+\(fn SYMBOL VARIABLE-P LIBRARY)" nil nil)
+
(autoload (quote find-function-noselect) "find-func" "\
Return a pair (BUFFER . POINT) pointing to the definition of FUNCTION.
If the file where FUNCTION is defined is not known, then it is
searched for in `find-function-source-path' if non nil, otherwise
-in `load-path'." nil nil)
+in `load-path'.
+
+\(fn FUNCTION)" nil nil)
(autoload (quote find-function) "find-func" "\
Find the definition of the FUNCTION near point.
The library where FUNCTION is defined is searched for in
`find-function-source-path', if non nil, otherwise in `load-path'.
-See also `find-function-recenter-line' and `find-function-after-hook'." t nil)
+See also `find-function-recenter-line' and `find-function-after-hook'.
+
+\(fn FUNCTION)" t nil)
(autoload (quote find-function-other-window) "find-func" "\
Find, in another window, the definition of FUNCTION near point.
-See `find-function' for more details." t nil)
+See `find-function' for more details.
+
+\(fn FUNCTION)" t nil)
(autoload (quote find-function-other-frame) "find-func" "\
Find, in ananother frame, the definition of FUNCTION near point.
-See `find-function' for more details." t nil)
+See `find-function' for more details.
+
+\(fn FUNCTION)" t nil)
(autoload (quote find-variable-noselect) "find-func" "\
Return a pair `(BUFFER . POINT)' pointing to the definition of SYMBOL.
not selected.
The library where VARIABLE is defined is searched for in FILE or
-`find-function-source-path', if non nil, otherwise in `load-path'." nil nil)
+`find-function-source-path', if non nil, otherwise in `load-path'.
+
+\(fn VARIABLE &optional FILE)" nil nil)
(autoload (quote find-variable) "find-func" "\
Find the definition of the VARIABLE near point.
The library where VARIABLE is defined is searched for in
`find-function-source-path', if non nil, otherwise in `load-path'.
-See also `find-function-recenter-line' and `find-function-after-hook'." t nil)
+See also `find-function-recenter-line' and `find-function-after-hook'.
+
+\(fn VARIABLE)" t nil)
(autoload (quote find-variable-other-window) "find-func" "\
Find, in another window, the definition of VARIABLE near point.
-See `find-variable' for more details." t nil)
+See `find-variable' for more details.
+
+\(fn VARIABLE)" t nil)
(autoload (quote find-variable-other-frame) "find-func" "\
Find, in annother frame, the definition of VARIABLE near point.
-See `find-variable' for more details." t nil)
+See `find-variable' for more details.
+
+\(fn VARIABLE)" t nil)
(autoload (quote find-function-on-key) "find-func" "\
Find the function that KEY invokes. KEY is a string.
-Point is saved if FUNCTION is in the current buffer." t nil)
+Point is saved if FUNCTION is in the current buffer.
+
+\(fn KEY)" t nil)
(autoload (quote find-function-at-point) "find-func" "\
-Find directly the function at point in the other window." t nil)
+Find directly the function at point in the other window.
+
+\(fn)" t nil)
(autoload (quote find-variable-at-point) "find-func" "\
-Find directly the function at point in the other window." t nil)
+Find directly the function at point in the other window.
+
+\(fn)" t nil)
(autoload (quote find-function-setup-keys) "find-func" "\
-Define some key bindings for the find-function family of functions." nil nil)
+Define some key bindings for the find-function family of functions.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (find-lisp-find-dired-filter find-lisp-find-dired-subdirectories
-;;;;;; find-lisp-find-dired) "find-lisp" "find-lisp.el" (15371 46415))
+;;;;;; find-lisp-find-dired) "find-lisp" "find-lisp.el" (15188 556))
;;; Generated autoloads from find-lisp.el
(autoload (quote find-lisp-find-dired) "find-lisp" "\
-Find files in DIR, matching REGEXP." t nil)
+Find files in DIR, matching REGEXP.
+
+\(fn DIR REGEXP)" t nil)
(autoload (quote find-lisp-find-dired-subdirectories) "find-lisp" "\
-Find all subdirectories of DIR." t nil)
+Find all subdirectories of DIR.
+
+\(fn DIR)" t nil)
(autoload (quote find-lisp-find-dired-filter) "find-lisp" "\
-Change the filter on a find-lisp-find-dired buffer to REGEXP." t nil)
+Change the filter on a find-lisp-find-dired buffer to REGEXP.
+
+\(fn REGEXP)" t nil)
;;;***
\f
;;;### (autoloads (finder-by-keyword finder-commentary finder-list-keywords)
-;;;;;; "finder" "finder.el" (15371 46415))
+;;;;;; "finder" "finder.el" (15924 18767))
;;; Generated autoloads from finder.el
(autoload (quote finder-list-keywords) "finder" "\
-Display descriptions of the keywords in the Finder buffer." t nil)
+Display descriptions of the keywords in the Finder buffer.
+
+\(fn)" t nil)
(autoload (quote finder-commentary) "finder" "\
Display FILE's commentary section.
-FILE should be in a form suitable for passing to `locate-library'." t nil)
+FILE should be in a form suitable for passing to `locate-library'.
+
+\(fn FILE)" t nil)
(autoload (quote finder-by-keyword) "finder" "\
-Find packages matching a given keyword." t nil)
+Find packages matching a given keyword.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (enable-flow-control-on enable-flow-control) "flow-ctrl"
-;;;;;; "flow-ctrl.el" (15371 46415))
+;;;;;; "flow-ctrl.el" (15941 42952))
;;; Generated autoloads from flow-ctrl.el
(autoload (quote enable-flow-control) "flow-ctrl" "\
Toggle flow control handling.
When handling is enabled, user can type C-s as C-\\, and C-q as C-^.
-With arg, enable flow control mode if arg is positive, otherwise disable." t nil)
+With arg, enable flow control mode if arg is positive, otherwise disable.
+
+\(fn &optional ARGUMENT)" t nil)
(autoload (quote enable-flow-control-on) "flow-ctrl" "\
Enable flow control if using one of a specified set of terminal types.
Use `(enable-flow-control-on \"vt100\" \"h19\")' to enable flow control
on VT-100 and H19 terminals. When flow control is enabled,
you must type C-\\ to get the effect of a C-s, and type C-^
-to get the effect of a C-q." nil nil)
+to get the effect of a C-q.
+
+\(fn &rest LOSING-TERMINAL-TYPES)" nil nil)
;;;***
\f
;;;### (autoloads (flyspell-buffer flyspell-region flyspell-mode-off
;;;;;; flyspell-version flyspell-mode flyspell-prog-mode flyspell-mode-line-string)
-;;;;;; "flyspell" "textmodes/flyspell.el" (15476 20606))
+;;;;;; "flyspell" "textmodes/flyspell.el" (15589 6175))
;;; Generated autoloads from textmodes/flyspell.el
(defvar flyspell-mode-line-string " Fly" "\
*String displayed on the modeline when flyspell is active.
Set this to nil if you don't want a modeline indicator.")
+(custom-autoload (quote flyspell-mode-line-string) "flyspell")
+
(autoload (quote flyspell-prog-mode) "flyspell" "\
-Turn on `flyspell-mode' for comments and strings." t nil)
+Turn on `flyspell-mode' for comments and strings.
+
+\(fn)" t nil)
(defvar flyspell-mode nil)
in your .emacs file.
\\[flyspell-region] checks all words inside a region.
-\\[flyspell-buffer] checks the whole buffer." t nil)
+\\[flyspell-buffer] checks the whole buffer.
+
+\(fn &optional ARG)" t nil)
(add-minor-mode (quote flyspell-mode) (quote flyspell-mode-line-string) flyspell-mode-map nil (quote flyspell-mode))
(autoload (quote flyspell-version) "flyspell" "\
-The flyspell version" t nil)
+The flyspell version
+
+\(fn)" t nil)
(autoload (quote flyspell-mode-off) "flyspell" "\
-Turn Flyspell mode off." nil nil)
+Turn Flyspell mode off.
+
+\(fn)" nil nil)
(autoload (quote flyspell-region) "flyspell" "\
-Flyspell text between BEG and END." t nil)
+Flyspell text between BEG and END.
+
+\(fn BEG END)" t nil)
(autoload (quote flyspell-buffer) "flyspell" "\
-Flyspell whole buffer." t nil)
+Flyspell whole buffer.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (follow-delete-other-windows-and-split follow-mode
;;;;;; turn-off-follow-mode turn-on-follow-mode) "follow" "follow.el"
-;;;;;; (15441 20087))
+;;;;;; (15856 53268))
;;; Generated autoloads from follow.el
(autoload (quote turn-on-follow-mode) "follow" "\
-Turn on Follow mode. Please see the function `follow-mode'." t nil)
+Turn on Follow mode. Please see the function `follow-mode'.
+
+\(fn)" t nil)
(autoload (quote turn-off-follow-mode) "follow" "\
-Turn off Follow mode. Please see the function `follow-mode'." t nil)
+Turn off Follow mode. Please see the function `follow-mode'.
+
+\(fn)" t nil)
(autoload (quote follow-mode) "follow" "\
Minor mode that combines windows into one tall virtual window.
is called. When turned off, `follow-mode-off-hook' is called.
Keys specific to Follow mode:
-\\{follow-mode-map}" t nil)
+\\{follow-mode-map}
+
+\(fn ARG)" t nil)
(autoload (quote follow-delete-other-windows-and-split) "follow" "\
Create two side by side windows and enter Follow Mode.
To bind this command to a hotkey, place the following line
in your `~/.emacs' file, replacing [f7] by your favourite key:
- (global-set-key [f7] 'follow-delete-other-windows-and-split)" t nil)
+ (global-set-key [f7] 'follow-delete-other-windows-and-split)
+
+\(fn &optional ARG)" t nil)
;;;***
\f
-;;;### (autoloads (font-lock-fontify-buffer global-font-lock-mode
-;;;;;; font-lock-remove-keywords font-lock-add-keywords turn-on-font-lock
-;;;;;; font-lock-mode) "font-lock" "font-lock.el" (15464 26323))
+;;;### (autoloads (font-lock-fontify-buffer font-lock-remove-keywords
+;;;;;; font-lock-add-keywords font-lock-mode-internal) "font-lock"
- ;;;;;; "font-lock.el" (16138 682))
++;;;;;; "font-lock.el" (16179 10735))
;;; Generated autoloads from font-lock.el
-(make-variable-buffer-local (quote font-lock-defaults))
-
-(autoload (quote font-lock-mode) "font-lock" "\
-Toggle Font Lock mode.
-With arg, turn Font Lock mode off if and only if arg is a non-positive
-number; if arg is nil, toggle Font Lock mode; anything else turns Font
-Lock on.
-\(Font Lock is also known as \"syntax highlighting\".)
-
-When Font Lock mode is enabled, text is fontified as you type it:
-
- - Comments are displayed in `font-lock-comment-face';
- - Strings are displayed in `font-lock-string-face';
- - Certain other expressions are displayed in other faces according to the
- value of the variable `font-lock-keywords'.
-
-To customize the faces (colors, fonts, etc.) used by Font Lock for
-fontifying different parts of buffer text, use \\[customize-face].
-
-You can enable Font Lock mode in any major mode automatically by turning on in
-the major mode's hook. For example, put in your ~/.emacs:
-
- (add-hook 'c-mode-hook 'turn-on-font-lock)
-
-Alternatively, you can use Global Font Lock mode to automagically turn on Font
-Lock mode in buffers whose major mode supports it and whose major mode is one
-of `font-lock-global-modes'. For example, put in your ~/.emacs:
-
- (global-font-lock-mode t)
-
-There are a number of support modes that may be used to speed up Font Lock mode
-in various ways, specified via the variable `font-lock-support-mode'. Where
-major modes support different levels of fontification, you can use the variable
-`font-lock-maximum-decoration' to specify which level you generally prefer.
-When you turn Font Lock mode on/off the buffer is fontified/defontified, though
-fontification occurs only if the buffer is less than `font-lock-maximum-size'.
-
-For example, to specify that Font Lock mode use use Lazy Lock mode as a support
-mode and use maximum levels of fontification, put in your ~/.emacs:
-
- (setq font-lock-support-mode 'lazy-lock-mode)
- (setq font-lock-maximum-decoration t)
-
-To add your own highlighting for some major mode, and modify the highlighting
-selected automatically via the variable `font-lock-maximum-decoration', you can
-use `font-lock-add-keywords'.
-
-To fontify a buffer, without turning on Font Lock mode and regardless of buffer
-size, you can use \\[font-lock-fontify-buffer].
+(autoload (quote font-lock-mode-internal) "font-lock" "\
+Not documented
-To fontify a block (the function or paragraph containing point, or a number of
-lines around point), perhaps because modification on the current line caused
-syntactic change on other lines, you can use \\[font-lock-fontify-block].
-
-See the variable `font-lock-defaults-alist' for the Font Lock mode default
-settings. You can set your own default settings for some mode, by setting a
-buffer local value for `font-lock-defaults', via its mode hook." t nil)
-
-(autoload (quote turn-on-font-lock) "font-lock" "\
-Turn on Font Lock mode (only if the terminal can display it)." nil nil)
+\(fn ARG)" nil nil)
(autoload (quote font-lock-add-keywords) "font-lock" "\
Add highlighting KEYWORDS for MODE.
to use nil for MODE (and place the call in a loop or on a hook) to avoid
subtle problems due to details of the implementation.
-Note that some modes have specialised support for additional patterns, e.g.,
+Note that some modes have specialized support for additional patterns, e.g.,
see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types',
-`objc-font-lock-extra-types' and `java-font-lock-extra-types'." nil nil)
+`objc-font-lock-extra-types' and `java-font-lock-extra-types'.
+
+\(fn MODE KEYWORDS &optional APPEND)" nil nil)
(autoload (quote font-lock-remove-keywords) "font-lock" "\
Remove highlighting KEYWORDS for MODE.
When used from an elisp package (such as a minor mode), it is recommended
to use nil for MODE (and place the call in a loop or on a hook) to avoid
-subtle problems due to details of the implementation." nil nil)
-
-(defvar global-font-lock-mode nil "\
-Non-nil if Global-Font-Lock mode is enabled.
-See the command `global-font-lock-mode' for a description of this minor-mode.
-Setting this variable directly does not take effect;
-use either \\[customize] or the function `global-font-lock-mode'.")
-
-(custom-add-to-group (quote font-lock) (quote global-font-lock-mode) (quote custom-variable))
-
-(custom-add-load (quote global-font-lock-mode) (quote font-lock))
+subtle problems due to details of the implementation.
-(autoload (quote global-font-lock-mode) "font-lock" "\
-Toggle Font-Lock mode in every buffer.
-With prefix ARG, turn Global-Font-Lock mode on if and only if ARG is positive.
-Font-Lock mode is actually not turned on in every buffer but only in those
-in which `turn-on-font-lock-if-enabled' turns it on." t nil)
+\(fn MODE KEYWORDS)" nil nil)
(autoload (quote font-lock-fontify-buffer) "font-lock" "\
-Fontify the current buffer the way the function `font-lock-mode' would." t nil)
+Fontify the current buffer the way the function `font-lock-mode' would.
-;;;***
-\f
-;;;### (autoloads (create-fontset-from-fontset-spec) "fontset" "international/fontset.el"
-;;;;;; (15607 17695))
-;;; Generated autoloads from international/fontset.el
-
-(autoload (quote create-fontset-from-fontset-spec) "fontset" "\
-Create a fontset from fontset specification string FONTSET-SPEC.
-FONTSET-SPEC is a string of the format:
- FONTSET-NAME,CHARSET-NAME0:FONT-NAME0,CHARSET-NAME1:FONT-NAME1, ...
-Any number of SPACE, TAB, and NEWLINE can be put before and after commas.
-
-Optional 2nd argument is ignored. It exists just for backward
-compatibility.
-
-If this function attempts to create already existing fontset, error is
-signaled unless the optional 3rd argument NOERROR is non-nil.
-
-It returns a name of the created fontset." nil nil)
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (footnote-mode) "footnote" "mail/footnote.el" (15400
-;;;;;; 1477))
+;;;### (autoloads (footnote-mode) "footnote" "mail/footnote.el" (15941
+;;;;;; 42961))
;;; Generated autoloads from mail/footnote.el
(autoload (quote footnote-mode) "footnote" "\
\\[Footnote-cycle-style] Footnote-cycle-style
\\[Footnote-back-to-message] Footnote-back-to-message
\\[Footnote-add-footnote] Footnote-add-footnote
-" t nil)
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (forms-find-file-other-window forms-find-file forms-mode)
-;;;;;; "forms" "forms.el" (15371 46415))
+;;;;;; "forms" "forms.el" (16111 41825))
;;; Generated autoloads from forms.el
(autoload (quote forms-mode) "forms" "\
Commands: Equivalent keys in read-only mode:
TAB forms-next-field TAB
- C-c TAB forms-next-field
+ C-c TAB forms-next-field
C-c < forms-first-record <
C-c > forms-last-record >
C-c ? describe-mode ?
C-c C-r forms-search-reverse r
C-c C-s forms-search-forward s
C-c C-x forms-exit x
-" t nil)
+
+\(fn &optional PRIMARY)" t nil)
(autoload (quote forms-find-file) "forms" "\
-Visit a file in Forms mode." t nil)
+Visit a file in Forms mode.
+
+\(fn FN)" t nil)
(autoload (quote forms-find-file-other-window) "forms" "\
-Visit a file in Forms mode in other window." t nil)
+Visit a file in Forms mode in other window.
+
+\(fn FN)" t nil)
;;;***
\f
;;;### (autoloads (fortran-mode fortran-tab-mode-default) "fortran"
-;;;;;; "progmodes/fortran.el" (15417 7451))
+;;;;;; "progmodes/fortran.el" (16131 19793))
;;; Generated autoloads from progmodes/fortran.el
(defvar fortran-tab-mode-default nil "\
*Default tabbing/carriage control style for empty files in Fortran mode.
-A value of t specifies tab-digit style of continuation control.
+A non-nil value specifies tab-digit style of continuation control.
A value of nil specifies that continuation lines are marked
with a character in column 6.")
+(custom-autoload (quote fortran-tab-mode-default) "fortran")
+
(autoload (quote fortran-mode) "fortran" "\
-Major mode for editing Fortran code.
+Major mode for editing Fortran code in fixed format.
+For free format code, use `f90-mode'.
+
\\[fortran-indent-line] indents the current Fortran line correctly.
-DO statements must not share a common CONTINUE.
+Note that DO statements must not share a common CONTINUE.
-Type ;? or ;\\[help-command] to display a list of built-in abbrevs for
-Fortran keywords.
+Type ;? or ;\\[help-command] to display a list of built-in abbrevs for Fortran keywords.
Key definitions:
\\{fortran-mode-map}
Variables controlling indentation style and extra features:
- `comment-start'
- If you want to use comments starting with `!',
- set this to the string \"!\".
- `fortran-do-indent'
- Extra indentation within do blocks. (default 3)
- `fortran-if-indent'
- Extra indentation within if blocks. (default 3)
- `fortran-structure-indent'
- Extra indentation within structure, union, map and interface blocks.
- (default 3)
- `fortran-continuation-indent'
- Extra indentation applied to continuation statements. (default 5)
- `fortran-comment-line-extra-indent'
- Amount of extra indentation for text within full-line comments. (default 0)
- `fortran-comment-indent-style'
- nil means don't change indentation of text in full-line comments,
- fixed means indent that text at `fortran-comment-line-extra-indent' beyond
- the value of `fortran-minimum-statement-indent-fixed' (for fixed
- format continuation style) or `fortran-minimum-statement-indent-tab'
- (for TAB format continuation style).
- relative means indent at `fortran-comment-line-extra-indent' beyond the
+`comment-start'
+ To use comments starting with `!', set this to the string \"!\".
+`fortran-do-indent'
+ Extra indentation within DO blocks (default 3).
+`fortran-if-indent'
+ Extra indentation within IF blocks (default 3).
+`fortran-structure-indent'
+ Extra indentation within STRUCTURE, UNION, MAP and INTERFACE blocks.
+ (default 3)
+`fortran-continuation-indent'
+ Extra indentation applied to continuation statements (default 5).
+`fortran-comment-line-extra-indent'
+ Amount of extra indentation for text in full-line comments (default 0).
+`fortran-comment-indent-style'
+ How to indent the text in full-line comments. Allowed values are:
+ nil don't change the indentation
+ fixed indent to `fortran-comment-line-extra-indent' beyond the
+ value of either
+ `fortran-minimum-statement-indent-fixed' (fixed format) or
+ `fortran-minimum-statement-indent-tab' (TAB format),
+ depending on the continuation format in use.
+ relative indent to `fortran-comment-line-extra-indent' beyond the
indentation for a line of code.
- (default 'fixed)
- `fortran-comment-indent-char'
- Single-character string to be inserted instead of space for
- full-line comment indentation. (default \" \")
- `fortran-minimum-statement-indent-fixed'
- Minimum indentation for Fortran statements in fixed format mode. (def.6)
- `fortran-minimum-statement-indent-tab'
- Minimum indentation for Fortran statements in TAB format mode. (default 9)
- `fortran-line-number-indent'
- Maximum indentation for line numbers. A line number will get
- less than this much indentation if necessary to avoid reaching
- column 5. (default 1)
- `fortran-check-all-num-for-matching-do'
- Non-nil causes all numbered lines to be treated as possible \"continue\"
- statements. (default nil)
- `fortran-blink-matching-if'
- Non-nil causes \\[fortran-indent-line] on an ENDIF statement to blink on
- matching IF. Also, from an ENDDO statement, blink on matching DO [WHILE]
- statement. (default nil)
- `fortran-continuation-string'
- Single-character string to be inserted in column 5 of a continuation
- line. (default \"$\")
- `fortran-comment-region'
- String inserted by \\[fortran-comment-region] at start of each line in
- region. (default \"c$$$\")
- `fortran-electric-line-number'
- Non-nil causes line number digits to be moved to the correct column
- as typed. (default t)
- `fortran-break-before-delimiters'
- Non-nil causes lines to be broken before delimiters.
- (default t)
+ (default 'fixed)
+`fortran-comment-indent-char'
+ Single-character string to be inserted instead of space for
+ full-line comment indentation (default \" \").
+`fortran-minimum-statement-indent-fixed'
+ Minimum indentation for statements in fixed format mode (default 6).
+`fortran-minimum-statement-indent-tab'
+ Minimum indentation for statements in TAB format mode (default 9).
+`fortran-line-number-indent'
+ Maximum indentation for line numbers (default 1). A line number will
+ get less than this much indentation if necessary to avoid reaching
+ column 5.
+`fortran-check-all-num-for-matching-do'
+ Non-nil causes all numbered lines to be treated as possible \"continue\"
+ statements (default nil).
+`fortran-blink-matching-if'
+ Non-nil causes \\[fortran-indent-line] on an ENDIF (or ENDDO) statement
+ to blink on the matching IF (or DO [WHILE]). (default nil)
+`fortran-continuation-string'
+ Single-character string to be inserted in column 5 of a continuation
+ line (default \"$\").
+`fortran-comment-region'
+ String inserted by \\[fortran-comment-region] at start of each line in
+ the region (default \"c$$$\").
+`fortran-electric-line-number'
+ Non-nil causes line number digits to be moved to the correct column
+ as typed (default t).
+`fortran-break-before-delimiters'
+ Non-nil causes lines to be broken before delimiters (default t).
Turning on Fortran mode calls the value of the variable `fortran-mode-hook'
-with no args, if that value is non-nil." t nil)
+with no args, if that value is non-nil.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (fortune fortune-to-signature fortune-compile fortune-from-region
-;;;;;; fortune-add-fortune) "fortune" "play/fortune.el" (15371 46425))
+;;;;;; fortune-add-fortune) "fortune" "play/fortune.el" (15941 42963))
;;; Generated autoloads from play/fortune.el
(autoload (quote fortune-add-fortune) "fortune" "\
Add STRING to a fortune file FILE.
Interactively, if called with a prefix argument,
-read the file name to use. Otherwise use the value of `fortune-file'." t nil)
+read the file name to use. Otherwise use the value of `fortune-file'.
+
+\(fn STRING FILE)" t nil)
(autoload (quote fortune-from-region) "fortune" "\
Append the current region to a local fortune-like data file.
Interactively, if called with a prefix argument,
-read the file name to use. Otherwise use the value of `fortune-file'." t nil)
+read the file name to use. Otherwise use the value of `fortune-file'.
+
+\(fn BEG END FILE)" t nil)
(autoload (quote fortune-compile) "fortune" "\
Compile fortune file.
If called with a prefix asks for the FILE to compile, otherwise uses
-the value of `fortune-file'. This currently cannot handle directories." t nil)
+the value of `fortune-file'. This currently cannot handle directories.
+
+\(fn &optional FILE)" t nil)
(autoload (quote fortune-to-signature) "fortune" "\
Create signature from output of the fortune program.
If called with a prefix asks for the FILE to choose the fortune from,
otherwise uses the value of `fortune-file'. If you want to have fortune
choose from a set of files in a directory, call interactively with prefix
-and choose the directory as the fortune-file." t nil)
+and choose the directory as the fortune-file.
+
+\(fn &optional FILE)" t nil)
(autoload (quote fortune) "fortune" "\
Display a fortune cookie.
If called with a prefix asks for the FILE to choose the fortune from,
otherwise uses the value of `fortune-file'. If you want to have fortune
choose from a set of files in a directory, call interactively with prefix
-and choose the directory as the fortune-file." t nil)
+and choose the directory as the fortune-file.
+
+\(fn &optional FILE)" t nil)
;;;***
\f
-;;;### (autoloads (generic-mode define-generic-mode) "generic" "generic.el"
-;;;;;; (15371 46415))
-;;; Generated autoloads from generic.el
+;;;### (autoloads (set-fringe-style fringe-mode fringe-mode) "fringe"
+;;;;;; "fringe.el" (15997 671))
+;;; Generated autoloads from fringe.el
-(autoload (quote define-generic-mode) "generic" "\
-Create a new generic mode with NAME.
+(defvar fringe-mode nil "\
+*Specify appearance of fringes on all frames.
+This variable can be nil (the default) meaning the fringes should have
+the default width (8 pixels), it can be an integer value specifying
+the width of both left and right fringe (where 0 means no fringe), or
+a cons cell where car indicates width of left fringe and cdr indicates
+width of right fringe (where again 0 can be used to indicate no
+fringe).
+To set this variable in a Lisp program, use `set-fringe-mode' to make
+it take real effect.
+Setting the variable with a customization buffer also takes effect.
+If you only want to modify the appearance of the fringe in one frame,
+you can use the interactive function `toggle-fringe'")
-Args: (NAME COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST
+(custom-autoload (quote fringe-mode) "fringe")
+
+(autoload (quote fringe-mode) "fringe" "\
+Toggle appearance of fringes on all frames.
+Valid values for MODE include `none', `default', `left-only',
+`right-only', `minimal' and `half'. MODE can also be a cons cell
+where the integer in car will be used as left fringe width and the
+integer in cdr will be used as right fringe width. If MODE is not
+specified, the user is queried.
+It applies to all frames that exist and frames to be created in the
+future.
+If you want to set appearance of fringes on the selected frame only,
+see `set-fringe-style'.
+
+\(fn &optional MODE)" t nil)
+
+(autoload (quote set-fringe-style) "fringe" "\
+Set appearance of fringes on selected frame.
+Valid values for MODE include `none', `default', `left-only',
+`right-only', `minimal' and `half'. MODE can also be a cons cell
+where the integer in car will be used as left fringe width and the
+integer in cdr will be used as right fringe width. If MODE is not
+specified, the user is queried.
+If you want to set appearance of fringes on all frames, see `fringe-mode'.
+
+\(fn &optional MODE)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (gdba) "gdb-ui" "gdb-ui.el" (16167 21090))
+;;; Generated autoloads from gdb-ui.el
+
+(autoload (quote gdba) "gdb-ui" "\
+Run gdb on program FILE in buffer *gud-FILE*.
+The directory containing FILE becomes the initial working directory
+and source-file directory for your debugger.
+
+If `gdb-many-windows' is nil (the default value) then gdb starts with
+just two windows : the GUD and the source buffer. If it is t the
+following layout will appear (keybindings given in relevant buffer) :
+
+---------------------------------------------------------------------
+ GDB Toolbar
+---------------------------------------------------------------------
+GUD buffer (I/O of GDB) | Locals buffer
+ |
+ |
+ |
+---------------------------------------------------------------------
+Source buffer | Input/Output (of debuggee) buffer
+ | (comint-mode)
+ |
+ |
+ |
+ |
+ |
+ |
+---------------------------------------------------------------------
+Stack buffer | Breakpoints buffer
+ RET gdb-frames-select | SPC gdb-toggle-breakpoint
+ | RET gdb-goto-breakpoint
+ | d gdb-delete-breakpoint
+---------------------------------------------------------------------
+
+All the buffers share the toolbar and source should always display in the same
+window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint
+icons are displayed both by setting a break with gud-break and by typing break
+in the GUD buffer.
+
+This works best (depending on the size of your monitor) using most of the
+screen.
+
+Displayed expressions appear in separate frames. Arrays may be displayed
+as slices and visualised using the graph program from plotutils if installed.
+Pointers in structures may be followed in a tree-like fashion.
+
+The following interactive lisp functions help control operation :
+
+`gdb-many-windows' - Toggle the number of windows gdb uses.
+`gdb-restore-windows' - To restore the window layout.
+`gdb-quit' - To delete (most) of the buffers used by GDB-UI and
+ reset variables.
+
+\(fn COMMAND-LINE)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (generic-mode define-generic-mode) "generic" "generic.el"
+;;;;;; (15188 557))
+;;; Generated autoloads from generic.el
+
+(autoload (quote define-generic-mode) "generic" "\
+Create a new generic mode with NAME.
+
+Args: (NAME COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST
FUNCTION-LIST &optional DESCRIPTION)
NAME should be a symbol; its string representation is used as the function
FUNCTION-LIST is a list of functions to call to do some additional setup.
-See the file generic-x.el for some examples of `define-generic-mode'." nil nil)
+See the file generic-x.el for some examples of `define-generic-mode'.
+
+\(fn NAME COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST FUNCTION-LIST &optional DESCRIPTION)" nil nil)
(autoload (quote generic-mode) "generic" "\
Basic comment and font-lock functionality for `generic' files.
comment characters, keywords, and the like.)
To define a generic-mode, use the function `define-generic-mode'.
-Some generic modes are defined in `generic-x.el'." t nil)
+Some generic modes are defined in `generic-x.el'.
+
+\(fn TYPE)" t nil)
;;;***
\f
;;;### (autoloads (glasses-mode) "glasses" "progmodes/glasses.el"
-;;;;;; (15371 46426))
+;;;;;; (15251 46612))
;;; Generated autoloads from progmodes/glasses.el
(autoload (quote glasses-mode) "glasses" "\
Minor mode for making identifiers likeThis readable.
When this mode is active, it tries to add virtual separators (like underscores)
-at places they belong to." t nil)
+at places they belong to.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (gnus gnus-other-frame gnus-slave gnus-no-server
-;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (15417 7423))
+;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (15941 42960))
;;; Generated autoloads from gnus/gnus.el
(autoload (quote gnus-slave-no-server) "gnus" "\
-Read network news as a slave, without connecting to local server." t nil)
+Read network news as a slave, without connecting to local server.
+
+\(fn &optional ARG)" t nil)
(autoload (quote gnus-no-server) "gnus" "\
Read network news.
startup level. If ARG is nil, Gnus will be started at level 2.
If ARG is non-nil and not a positive number, Gnus will
prompt the user for the name of an NNTP server to use.
-As opposed to `gnus', this command will not connect to the local server." t nil)
+As opposed to `gnus', this command will not connect to the local server.
+
+\(fn &optional ARG SLAVE)" t nil)
(autoload (quote gnus-slave) "gnus" "\
-Read news as a slave." t nil)
+Read news as a slave.
+
+\(fn &optional ARG)" t nil)
(autoload (quote gnus-other-frame) "gnus" "\
-Pop up a frame to read news." t nil)
+Pop up a frame to read news.
+
+\(fn &optional ARG)" t nil)
(autoload (quote gnus) "gnus" "\
Read network news.
If ARG is non-nil and a positive number, Gnus will use that as the
startup level. If ARG is non-nil and not a positive number, Gnus will
-prompt the user for the name of an NNTP server to use." t nil)
+prompt the user for the name of an NNTP server to use.
+
+\(fn &optional ARG DONT-CONNECT SLAVE)" t nil)
;;;***
\f
;;;### (autoloads (gnus-agent-batch gnus-agent-batch-fetch gnus-agentize
;;;;;; gnus-plugged gnus-unplugged) "gnus-agent" "gnus/gnus-agent.el"
-;;;;;; (15371 46421))
+;;;;;; (15941 42960))
;;; Generated autoloads from gnus/gnus-agent.el
(autoload (quote gnus-unplugged) "gnus-agent" "\
-Start Gnus unplugged." t nil)
+Start Gnus unplugged.
+
+\(fn)" t nil)
(autoload (quote gnus-plugged) "gnus-agent" "\
-Start Gnus plugged." t nil)
+Start Gnus plugged.
+
+\(fn)" t nil)
(autoload (quote gnus-agentize) "gnus-agent" "\
Allow Gnus to be an offline newsreader.
This will modify the `gnus-before-startup-hook', `gnus-post-method',
and `message-send-mail-function' variables, and install the Gnus
-agent minor mode in all Gnus buffers." t nil)
+agent minor mode in all Gnus buffers.
+
+\(fn)" t nil)
(autoload (quote gnus-agent-batch-fetch) "gnus-agent" "\
-Start Gnus and fetch session." t nil)
+Start Gnus and fetch session.
+
+\(fn)" t nil)
+
+(autoload (quote gnus-agent-batch) "gnus-agent" "\
+Not documented
-(autoload (quote gnus-agent-batch) "gnus-agent" nil t nil)
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (gnus-article-prepare-display) "gnus-art" "gnus/gnus-art.el"
-;;;;;; (15477 13591))
+;;;;;; (16066 53440))
;;; Generated autoloads from gnus/gnus-art.el
(autoload (quote gnus-article-prepare-display) "gnus-art" "\
-Make the current buffer look like a nice article." nil nil)
+Make the current buffer look like a nice article.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (gnus-audio-play) "gnus-audio" "gnus/gnus-audio.el"
-;;;;;; (15371 46421))
+;;;;;; (15186 43688))
;;; Generated autoloads from gnus/gnus-audio.el
(autoload (quote gnus-audio-play) "gnus-audio" "\
-Play a sound FILE through the speaker." t nil)
+Play a sound FILE through the speaker.
+
+\(fn FILE)" t nil)
;;;***
\f
;;;### (autoloads (gnus-cache-generate-nov-databases gnus-cache-generate-active
-;;;;;; gnus-jog-cache) "gnus-cache" "gnus/gnus-cache.el" (15371
-;;;;;; 46421))
+;;;;;; gnus-jog-cache) "gnus-cache" "gnus/gnus-cache.el" (15941
+;;;;;; 42960))
;;; Generated autoloads from gnus/gnus-cache.el
(autoload (quote gnus-jog-cache) "gnus-cache" "\
Go through all groups and put the articles into the cache.
Usage:
-$ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" t nil)
+$ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache
+
+\(fn)" t nil)
(autoload (quote gnus-cache-generate-active) "gnus-cache" "\
-Generate the cache active file." t nil)
+Generate the cache active file.
+
+\(fn &optional DIRECTORY)" t nil)
(autoload (quote gnus-cache-generate-nov-databases) "gnus-cache" "\
-Generate NOV files recursively starting in DIR." t nil)
+Generate NOV files recursively starting in DIR.
+
+\(fn DIR)" t nil)
;;;***
\f
;;;### (autoloads (gnus-fetch-group-other-frame gnus-fetch-group)
-;;;;;; "gnus-group" "gnus/gnus-group.el" (15391 60529))
+;;;;;; "gnus-group" "gnus/gnus-group.el" (16131 19792))
;;; Generated autoloads from gnus/gnus-group.el
(autoload (quote gnus-fetch-group) "gnus-group" "\
Start Gnus if necessary and enter GROUP.
-Returns whether the fetching was successful or not." t nil)
+Returns whether the fetching was successful or not.
+
+\(fn GROUP)" t nil)
(autoload (quote gnus-fetch-group-other-frame) "gnus-group" "\
-Pop up a frame and enter GROUP." t nil)
+Pop up a frame and enter GROUP.
+
+\(fn GROUP)" t nil)
;;;***
\f
;;;### (autoloads (gnus-batch-score) "gnus-kill" "gnus/gnus-kill.el"
-;;;;;; (15371 46421))
+;;;;;; (14813 33717))
;;; Generated autoloads from gnus/gnus-kill.el
(defalias (quote gnus-batch-kill) (quote gnus-batch-score))
(autoload (quote gnus-batch-score) "gnus-kill" "\
Run batched scoring.
-Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score" t nil)
+Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (gnus-mailing-list-mode turn-on-gnus-mailing-list-mode)
-;;;;;; "gnus-ml" "gnus/gnus-ml.el" (15371 46421))
+;;;;;; "gnus-ml" "gnus/gnus-ml.el" (15941 42960))
;;; Generated autoloads from gnus/gnus-ml.el
-(autoload (quote turn-on-gnus-mailing-list-mode) "gnus-ml" nil nil nil)
+(autoload (quote turn-on-gnus-mailing-list-mode) "gnus-ml" "\
+Not documented
+
+\(fn)" nil nil)
(autoload (quote gnus-mailing-list-mode) "gnus-ml" "\
Minor mode for providing mailing-list commands.
-\\{gnus-mailing-list-mode-map}" t nil)
+\\{gnus-mailing-list-mode-map}
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (gnus-group-split-fancy gnus-group-split gnus-group-split-update
;;;;;; gnus-group-split-setup) "gnus-mlspl" "gnus/gnus-mlspl.el"
-;;;;;; (15400 1475))
+;;;;;; (15856 53273))
;;; Generated autoloads from gnus/gnus-mlspl.el
(autoload (quote gnus-group-split-setup) "gnus-mlspl" "\
uses are as simple as the name of a default mail group, but more
elaborate fancy splits may also be useful to split mail that doesn't
match any of the group-specified splitting rules. See
-gnus-group-split-fancy for details." t nil)
+gnus-group-split-fancy for details.
+
+\(fn &optional AUTO-UPDATE CATCH-ALL)" t nil)
(autoload (quote gnus-group-split-update) "gnus-mlspl" "\
Computes nnmail-split-fancy from group params and CATCH-ALL, by
calling (gnus-group-split-fancy nil nil CATCH-ALL).
If CATCH-ALL is nil, gnus-group-split-default-catch-all-group is used
-instead. This variable is set by gnus-group-split-setup." t nil)
+instead. This variable is set by gnus-group-split-setup.
+
+\(fn &optional CATCH-ALL)" t nil)
(autoload (quote gnus-group-split) "gnus-mlspl" "\
Uses information from group parameters in order to split mail.
See gnus-group-split-fancy for more information.
-gnus-group-split is a valid value for nnmail-split-methods." nil nil)
+gnus-group-split is a valid value for nnmail-split-methods.
+
+\(fn)" nil nil)
(autoload (quote gnus-group-split-fancy) "gnus-mlspl" "\
Uses information from group parameters in order to split mail.
\(: gnus-group-split-fancy GROUPS NO-CROSSPOST CATCH-ALL)
GROUPS may be a regular expression or a list of group names, that will
-be used to select candidate groups. If it is ommited or nil, all
+be used to select candidate groups. If it is omitted or nil, all
existing groups are considered.
-if NO-CROSSPOST is ommitted or nil, a & split will be returned,
+if NO-CROSSPOST is omitted or nil, a & split will be returned,
otherwise, a | split, that does not allow crossposting, will be
returned.
\"mail.bar\")
(any \"\\\\(foo@nowhere\\\\.gov\\\\|foo@localhost\\\\|foo-redist@home\\\\)\"
- \"bugs-foo\" - \"rambling-foo\" \"mail.foo\"))
- \"mail.others\")" nil nil)
+ \"mail.others\")
+
+\(fn &optional GROUPS NO-CROSSPOST CATCH-ALL)" nil nil)
;;;***
\f
;;;### (autoloads (gnus-change-server) "gnus-move" "gnus/gnus-move.el"
-;;;;;; (15371 46421))
+;;;;;; (14792 28984))
;;; Generated autoloads from gnus/gnus-move.el
(autoload (quote gnus-change-server) "gnus-move" "\
Move from FROM-SERVER to TO-SERVER.
-Update the .newsrc.eld file to reflect the change of nntp server." t nil)
+Update the .newsrc.eld file to reflect the change of nntp server.
+
+\(fn FROM-SERVER TO-SERVER)" t nil)
;;;***
\f
-;;;### (autoloads (gnus-msg-mail) "gnus-msg" "gnus/gnus-msg.el" (15470
-;;;;;; 47364))
+;;;### (autoloads (gnus-msg-mail) "gnus-msg" "gnus/gnus-msg.el" (15941
+;;;;;; 42960))
;;; Generated autoloads from gnus/gnus-msg.el
(autoload (quote gnus-msg-mail) "gnus-msg" "\
Start editing a mail message to be sent.
Like `message-mail', but with Gnus paraphernalia, particularly the
-Gcc: header for archiving purposes." t nil)
+Gcc: header for archiving purposes.
+
+\(fn &rest ARGS)" t nil)
(define-mail-user-agent (quote gnus-user-agent) (quote gnus-msg-mail) (quote message-send-and-exit) (quote message-kill-buffer) (quote message-send-hook))
;;;***
\f
;;;### (autoloads (gnus-mule-add-group) "gnus-mule" "gnus/gnus-mule.el"
-;;;;;; (15371 46421))
+;;;;;; (15856 53273))
;;; Generated autoloads from gnus/gnus-mule.el
(autoload (quote gnus-mule-add-group) "gnus-mule" "\
If CODING-SYSTEM is a cons, the car part is used and the cdr
part is ignored.
-This function exists for backward comaptibility with Emacs 20. It is
+This function exists for backward compatibility with Emacs 20. It is
recommended to customize the variable `gnus-group-charset-alist'
-rather than using this function." nil nil)
+rather than using this function.
+
+\(fn NAME CODING-SYSTEM)" nil nil)
;;;***
\f
;;;### (autoloads (gnus-batch-brew-soup) "gnus-soup" "gnus/gnus-soup.el"
-;;;;;; (15371 46421))
+;;;;;; (14792 28985))
;;; Generated autoloads from gnus/gnus-soup.el
(autoload (quote gnus-batch-brew-soup) "gnus-soup" "\
$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"
-Note -- this function hasn't been implemented yet." t nil)
+Note -- this function hasn't been implemented yet.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (gnus-update-format) "gnus-spec" "gnus/gnus-spec.el"
-;;;;;; (15371 46421))
+;;;;;; (14870 42286))
;;; Generated autoloads from gnus/gnus-spec.el
(autoload (quote gnus-update-format) "gnus-spec" "\
-Update the format specification near point." t nil)
+Update the format specification near point.
+
+\(fn VAR)" t nil)
;;;***
\f
;;;### (autoloads (gnus-declare-backend gnus-unload) "gnus-start"
- ;;;;;; "gnus/gnus-start.el" (15678 51469))
-;;;;;; "gnus/gnus-start.el" (15425 28363))
++;;;;;; "gnus/gnus-start.el" (16179 17130))
;;; Generated autoloads from gnus/gnus-start.el
(autoload (quote gnus-unload) "gnus-start" "\
Unload all Gnus features.
\(For some value of `all' or `Gnus'.) Currently, features whose names
have prefixes `gnus-', `nn', `mm-' or `rfc' are unloaded. Use
-cautiously -- unloading may cause trouble." t nil)
+cautiously -- unloading may cause trouble.
+
+\(fn)" t nil)
(autoload (quote gnus-declare-backend) "gnus-start" "\
-Declare backend NAME with ABILITIES as a Gnus backend." nil nil)
+Declare backend NAME with ABILITIES as a Gnus backend.
+
+\(fn NAME &rest ABILITIES)" nil nil)
;;;***
\f
;;;### (autoloads (gnus-add-configuration) "gnus-win" "gnus/gnus-win.el"
-;;;;;; (15371 46421))
+;;;;;; (15856 53274))
;;; Generated autoloads from gnus/gnus-win.el
(autoload (quote gnus-add-configuration) "gnus-win" "\
-Add the window configuration CONF to `gnus-buffer-configuration'." nil nil)
+Add the window configuration CONF to `gnus-buffer-configuration'.
+
+\(fn CONF)" nil nil)
;;;***
\f
-;;;### (autoloads (gomoku) "gomoku" "play/gomoku.el" (15400 1479))
+;;;### (autoloads (gomoku) "gomoku" "play/gomoku.el" (16027 27252))
;;; Generated autoloads from play/gomoku.el
(autoload (quote gomoku) "gomoku" "\
This program actually plays a simplified or archaic version of the
Gomoku game, and ought to be upgraded to use the full modern rules.
-Use \\[describe-mode] for more info." t nil)
+Use \\[describe-mode] for more info.
+
+\(fn &optional N M)" t nil)
;;;***
\f
;;;### (autoloads (goto-address goto-address-at-point goto-address-at-mouse)
-;;;;;; "goto-addr" "net/goto-addr.el" (15371 46424))
+;;;;;; "goto-addr" "net/goto-addr.el" (16111 41831))
;;; Generated autoloads from net/goto-addr.el
(autoload (quote goto-address-at-mouse) "goto-addr" "\
Send to the e-mail address or load the URL clicked with the mouse.
Send mail to address at position of mouse click. See documentation for
`goto-address-find-address-at-point'. If no address is found
-there, then load the URL at or before the position of the mouse click." t nil)
+there, then load the URL at or before the position of the mouse click.
+
+\(fn EVENT)" t nil)
(autoload (quote goto-address-at-point) "goto-addr" "\
Send to the e-mail address or load the URL at point.
Send mail to address at point. See documentation for
`goto-address-find-address-at-point'. If no address is found
-there, then load the URL at or before point." t nil)
+there, then load the URL at or before point.
+
+\(fn)" t nil)
(autoload (quote goto-address) "goto-addr" "\
Sets up goto-address functionality in the current buffer.
By default, goto-address binds to mouse-2 and C-c RET.
Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
-`goto-address-highlight-p' for more information)." t nil)
+`goto-address-highlight-p' for more information).
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (gs-load-image) "gs" "gs.el" (15371 46415))
+;;;### (autoloads (gs-load-image) "gs" "gs.el" (15289 33013))
;;; Generated autoloads from gs.el
(autoload (quote gs-load-image) "gs" "\
Load a PS image for display on FRAME.
SPEC is an image specification, IMG-HEIGHT and IMG-WIDTH are width
and height of the image in pixels. WINDOW-AND-PIXMAP-ID is a string of
-the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful." nil nil)
+the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful.
+
+\(fn FRAME SPEC IMG-WIDTH IMG-HEIGHT WINDOW-AND-PIXMAP-ID PIXEL-COLORS)" nil nil)
;;;***
\f
-;;;### (autoloads (jdb pdb perldb xdb dbx sdb gdb) "gud" "gud.el"
-;;;;;; (15464 26323))
-;;; Generated autoloads from gud.el
+;;;### (autoloads (gdb-script-mode bashdb jdb pdb perldb xdb dbx
+;;;;;; sdb gdb) "gud" "progmodes/gud.el" (16165 36290))
+;;; Generated autoloads from progmodes/gud.el
(autoload (quote gdb) "gud" "\
Run gdb on program FILE in buffer *gud-FILE*.
The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger." t nil)
+and source-file directory for your debugger.
+
+\(fn COMMAND-LINE)" t nil)
(autoload (quote sdb) "gud" "\
Run sdb on program FILE in buffer *gud-FILE*.
The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger." t nil)
+and source-file directory for your debugger.
+
+\(fn COMMAND-LINE)" t nil)
(autoload (quote dbx) "gud" "\
Run dbx on program FILE in buffer *gud-FILE*.
The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger." t nil)
+and source-file directory for your debugger.
+
+\(fn COMMAND-LINE)" t nil)
(autoload (quote xdb) "gud" "\
Run xdb on program FILE in buffer *gud-FILE*.
and source-file directory for your debugger.
You can set the variable 'gud-xdb-directories' to a list of program source
-directories if your program contains sources from more than one directory." t nil)
+directories if your program contains sources from more than one directory.
+
+\(fn COMMAND-LINE)" t nil)
(autoload (quote perldb) "gud" "\
Run perldb on program FILE in buffer *gud-FILE*.
The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger." t nil)
+and source-file directory for your debugger.
+
+\(fn COMMAND-LINE)" t nil)
(autoload (quote pdb) "gud" "\
Run pdb on program FILE in buffer `*gud-FILE*'.
The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger." t nil)
+and source-file directory for your debugger.
+
+\(fn COMMAND-LINE)" t nil)
(autoload (quote jdb) "gud" "\
Run jdb with command line COMMAND-LINE in a buffer.
The buffer is named \"*gud*\" if no initial class is given or
-\"*gud-<initial-class-basename>*\" if there is. If the \"-classpath\"
+\"*gud-<initial-class-basename>*\" if there is. If the \"-classpath\"
switch is given, omit all whitespace between it and its value.
See `gud-jdb-use-classpath' and `gud-jdb-classpath' documentation for
original source file access method.
For general information about commands available to control jdb from
-gud, see `gud-mode'." t nil)
+gud, see `gud-mode'.
+
+\(fn COMMAND-LINE)" t nil)
+
+(autoload (quote bashdb) "gud" "\
+Run bashdb on program FILE in buffer *gud-FILE*.
+The directory containing FILE becomes the initial working directory
+and source-file directory for your debugger.
+
+\(fn COMMAND-LINE)" t nil)
(add-hook 'same-window-regexps "\\*gud-.*\\*\\(\\|<[0-9]+>\\)")
+(add-to-list (quote auto-mode-alist) (quote ("/\\.gdbinit" . gdb-script-mode)))
+
+(autoload (quote gdb-script-mode) "gud" "\
+Major mode for editing GDB scripts
+
+\(fn)" t nil)
+
;;;***
\f
-;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (15371
-;;;;;; 46425))
+;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (15941
+;;;;;; 42963))
;;; Generated autoloads from play/handwrite.el
(autoload (quote handwrite) "handwrite" "\
Variables: handwrite-linespace (default 12)
handwrite-fontsize (default 11)
handwrite-numlines (default 60)
- handwrite-pagenumbering (default nil)" t nil)
+ handwrite-pagenumbering (default nil)
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (hanoi-unix-64 hanoi-unix hanoi) "hanoi" "play/hanoi.el"
-;;;;;; (15371 46425))
+;;;;;; (15941 42963))
;;; Generated autoloads from play/hanoi.el
(autoload (quote hanoi) "hanoi" "\
-Towers of Hanoi diversion. Use NRINGS rings." t nil)
+Towers of Hanoi diversion. Use NRINGS rings.
+
+\(fn NRINGS)" t nil)
(autoload (quote hanoi-unix) "hanoi" "\
Towers of Hanoi, UNIX doomsday version.
Displays 32-ring towers that have been progressing at one move per
second since 1970-01-01 00:00:00 GMT.
-Repent before ring 31 moves." t nil)
+Repent before ring 31 moves.
+
+\(fn)" t nil)
(autoload (quote hanoi-unix-64) "hanoi" "\
-Like hanoi-unix, but pretend to have a 64-bit clock.
+Like hanoi-unix, but pretend to have a 64-bit clock.
This is, necessarily (as of emacs 20.3), a crock. When the
current-time interface is made s2G-compliant, hanoi.el will need
-to be updated." t nil)
+to be updated.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (describe-categories describe-syntax describe-variable
;;;;;; variable-at-point describe-function-1 describe-function locate-library
-;;;;;; help-with-tutorial) "help-fns" "help-fns.el" (15480 5979))
+;;;;;; help-with-tutorial) "help-fns" "help-fns.el" (16070 35806))
;;; Generated autoloads from help-fns.el
(autoload (quote help-with-tutorial) "help-fns" "\
If there is a tutorial version written in the language
of the selected language environment, that version is used.
If there's no tutorial in that language, `TUTORIAL' is selected.
-With arg, you are asked to choose which language." t nil)
+With ARG, you are asked to choose which language.
+
+\(fn &optional ARG)" t nil)
(autoload (quote locate-library) "help-fns" "\
Show the precise file name of Emacs library LIBRARY.
-This command searches the directories in `load-path' like `M-x load-library'
-to find the file that `M-x load-library RET LIBRARY RET' would load.
+This command searches the directories in `load-path' like `\\[load-library]'
+to find the file that `\\[load-library] RET LIBRARY RET' would load.
Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes'
to the specified name LIBRARY.
When called from a program, the file name is normaly returned as a
string. When run interactively, the argument INTERACTIVE-CALL is t,
-and the file name is displayed in the echo area." t nil)
+and the file name is displayed in the echo area.
+
+\(fn LIBRARY &optional NOSUFFIX PATH INTERACTIVE-CALL)" t nil)
(autoload (quote describe-function) "help-fns" "\
-Display the full documentation of FUNCTION (a symbol)." t nil)
+Display the full documentation of FUNCTION (a symbol).
-(autoload (quote describe-function-1) "help-fns" nil nil nil)
+\(fn FUNCTION)" t nil)
+
+(autoload (quote describe-function-1) "help-fns" "\
+Not documented
+
+\(fn FUNCTION)" nil nil)
(autoload (quote variable-at-point) "help-fns" "\
Return the bound variable symbol found around point.
-Return 0 if there is no such symbol." nil nil)
+Return 0 if there is no such symbol.
+
+\(fn)" nil nil)
(autoload (quote describe-variable) "help-fns" "\
Display the full documentation of VARIABLE (a symbol).
Returns the documentation as a string, also.
If VARIABLE has a buffer-local value in BUFFER (default to the current buffer),
-it is displayed along with the global value." t nil)
+it is displayed along with the global value.
+
+\(fn VARIABLE &optional BUFFER)" t nil)
(autoload (quote describe-syntax) "help-fns" "\
Describe the syntax specifications in the syntax table of BUFFER.
The descriptions are inserted in a help buffer, which is then displayed.
-BUFFER defaults to the current buffer." t nil)
+BUFFER defaults to the current buffer.
+
+\(fn &optional BUFFER)" t nil)
(autoload (quote describe-categories) "help-fns" "\
Describe the category specifications in the current category table.
-The descriptions are inserted in a buffer, which is then displayed." t nil)
+The descriptions are inserted in a buffer, which is then displayed.
+
+\(fn &optional BUFFER)" t nil)
;;;***
\f
;;;### (autoloads (three-step-help) "help-macro" "help-macro.el"
-;;;;;; (15371 46415))
+;;;;;; (15961 24150))
;;; Generated autoloads from help-macro.el
(defvar three-step-help nil "\
A value of nil means skip the middle step, so that
\\[help-command] \\[help-command] gives the window that lists the options.")
+(custom-autoload (quote three-step-help) "help-macro")
+
;;;***
\f
;;;### (autoloads (help-xref-on-pp help-insert-xref-button help-xref-button
;;;;;; help-make-xrefs help-setup-xref help-mode-finish help-mode-setup
-;;;;;; help-mode) "help-mode" "help-mode.el" (15427 61501))
+;;;;;; help-mode) "help-mode" "help-mode.el" (16054 60746))
;;; Generated autoloads from help-mode.el
(autoload (quote help-mode) "help-mode" "\
Major mode for viewing help text and navigating references in it.
Entry to this mode runs the normal hook `help-mode-hook'.
Commands:
-\\{help-mode-map}" t nil)
+\\{help-mode-map}
+
+\(fn)" t nil)
-(autoload (quote help-mode-setup) "help-mode" nil nil nil)
+(autoload (quote help-mode-setup) "help-mode" "\
+Not documented
-(autoload (quote help-mode-finish) "help-mode" nil nil nil)
+\(fn)" nil nil)
+
+(autoload (quote help-mode-finish) "help-mode" "\
+Not documented
+
+\(fn)" nil nil)
(autoload (quote help-setup-xref) "help-mode" "\
Invoked from commands using the \"*Help*\" buffer to install some xref info.
This should be called very early, before the output buffer is cleared,
because we want to record the \"previous\" position of point so we can
-restore it properly when going back." nil nil)
+restore it properly when going back.
+
+\(fn ITEM INTERACTIVE-P)" nil nil)
(autoload (quote help-make-xrefs) "help-mode" "\
Parse and hyperlink documentation cross-references in the given BUFFER.
-Find cross-reference information in a buffer and, if
-`help-highlight-p' is non-nil, highlight it with face defined by
-`help-highlight-face'; activate such cross references for selection
-with `help-follow'. Cross-references have the canonical form `...'
-and the type of reference may be disambiguated by the preceding
-word(s) used in `help-xref-symbol-regexp'.
+Find cross-reference information in a buffer and activate such cross
+references for selection with `help-follow'. Cross-references have
+the canonical form `...' and the type of reference may be
+disambiguated by the preceding word(s) used in
+`help-xref-symbol-regexp'.
If the variable `help-xref-mule-regexp' is non-nil, find also
cross-reference information related to multilingual environment
A special reference `back' is made to return back through a stack of
help buffers. Variable `help-back-label' specifies the text for
-that." t nil)
+that.
+
+\(fn &optional BUFFER)" t nil)
(autoload (quote help-xref-button) "help-mode" "\
Make a hyperlink for cross-reference text previously matched.
MATCH-NUMBER is the subexpression of interest in the last matched
regexp. TYPE is the type of button to use. Any remaining arguments are
passed to the button's help-function when it is invoked.
-See `help-make-xrefs'." nil nil)
+See `help-make-xrefs'.
+
+\(fn MATCH-NUMBER TYPE &rest ARGS)" nil nil)
(autoload (quote help-insert-xref-button) "help-mode" "\
Insert STRING and make a hyperlink from cross-reference text on it.
TYPE is the type of button to use. Any remaining arguments are passed
to the button's help-function when it is invoked.
-See `help-make-xrefs'." nil nil)
+See `help-make-xrefs'.
+
+\(fn STRING TYPE &rest ARGS)" nil nil)
(autoload (quote help-xref-on-pp) "help-mode" "\
-Add xrefs for symbols in `pp's output between FROM and TO." nil nil)
+Add xrefs for symbols in `pp's output between FROM and TO.
+
+\(fn FROM TO)" nil nil)
;;;***
\f
;;;### (autoloads (Helper-help Helper-describe-bindings) "helper"
-;;;;;; "emacs-lisp/helper.el" (15371 46419))
+;;;;;; "emacs-lisp/helper.el" (15961 24152))
;;; Generated autoloads from emacs-lisp/helper.el
(autoload (quote Helper-describe-bindings) "helper" "\
-Describe local key bindings of current mode." t nil)
+Describe local key bindings of current mode.
+
+\(fn)" t nil)
(autoload (quote Helper-help) "helper" "\
-Provide help for current mode." t nil)
+Provide help for current mode.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (hexlify-buffer hexl-find-file hexl-mode) "hexl"
-;;;;;; "hexl.el" (15391 60516))
+;;;;;; "hexl.el" (16054 60746))
;;; Generated autoloads from hexl.el
(autoload (quote hexl-mode) "hexl" "\
\\<hexl-mode-map>A mode for editing binary files in hex dump format.
This is not an ordinary major mode; it alters some aspects
-if the current mode's behavior, but not all; also, you can exit
+of the current mode's behavior, but not all; also, you can exit
Hexl mode and return to the previous mode using `hexl-mode-exit'.
This function automatically converts a buffer into the hexl format
00000050: 6162 6c65 2041 5343 4949 2063 6861 7261 able ASCII chara
00000060: 6374 6572 732e 2020 416e 7920 636f 6e74 cters. Any cont
00000070: 726f 6c20 6f72 206e 6f6e 2d41 5343 4949 rol or non-ASCII
- 00000080: 2063 6861 7261 6374 6572 730a 6172 6520 characters.are
+ 00000080: 2063 6861 7261 6374 6572 730a 6172 6520 characters.are
00000090: 6469 7370 6c61 7965 6420 6173 2070 6572 displayed as per
000000a0: 696f 6473 2069 6e20 7468 6520 7072 696e iods in the prin
- 000000b0: 7461 626c 6520 6368 6172 6163 7465 7220 table character
+ 000000b0: 7461 626c 6520 6368 6172 6163 7465 7220 table character
000000c0: 7265 6769 6f6e 2e0a region..
Movement is as simple as movement in a normal emacs text buffer. Most
You can use \\[hexl-find-file] to visit a file in Hexl mode.
-\\[describe-bindings] for advanced commands." t nil)
+\\[describe-bindings] for advanced commands.
+
+\(fn &optional ARG)" t nil)
(autoload (quote hexl-find-file) "hexl" "\
Edit file FILENAME in hexl-mode.
-Switch to a buffer visiting file FILENAME, creating one in none exists." t nil)
+Switch to a buffer visiting file FILENAME, creating one in none exists.
+
+\(fn FILENAME)" t nil)
(autoload (quote hexlify-buffer) "hexl" "\
Convert a binary buffer to hexl format.
-This discards the buffer's undo information." t nil)
+This discards the buffer's undo information.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (hi-lock-write-interactive-patterns hi-lock-unface-buffer
;;;;;; hi-lock-face-phrase-buffer hi-lock-face-buffer hi-lock-line-face-buffer
-;;;;;; hi-lock-mode hi-lock-mode) "hi-lock" "hi-lock.el" (15455
-;;;;;; 18398))
+;;;;;; hi-lock-mode hi-lock-mode) "hi-lock" "hi-lock.el" (15941
+;;;;;; 42952))
;;; Generated autoloads from hi-lock.el
-(defgroup hi-lock-interactive-text-highlighting nil "Interactively add and remove font-lock patterns for highlighting text." :group (quote faces))
-
(defvar hi-lock-mode nil "\
Toggle hi-lock, for interactively adding font-lock text-highlighting patterns.")
-(custom-add-to-group (quote hi-lock-interactive-text-highlighting) (quote hi-lock-mode) (quote custom-variable))
-
-(custom-add-load (quote hi-lock-mode) (quote hi-lock))
+(custom-autoload (quote hi-lock-mode) "hi-lock")
(autoload (quote hi-lock-mode) "hi-lock" "\
Toggle minor mode for interactively adding font-lock highlighting patterns.
Highlight matches of phrase PHRASE in current buffer with FACE.
(PHRASE can be any REGEXP, but spaces will be replaced by matches
to whitespace and initial lower-case letters will become case insensitive.)
-
+
\\[highlight-lines-matching-regexp] REGEXP FACE
Highlight lines containing matches of REGEXP in current buffer with FACE.
of characters into buffer) `hi-lock-file-patterns-range'. Patterns
will be read until
Hi-lock: end
-is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'." t nil)
+is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'.
+
+\(fn &optional ARG)" t nil)
(defalias (quote highlight-lines-matching-regexp) (quote hi-lock-line-face-buffer))
Interactively, prompt for REGEXP then FACE. Buffer-local history
list maintained for regexps, global history maintained for faces.
\\<minibuffer-local-map>Use \\[next-history-element] and \\[previous-history-element] to retrieve next or previous history item.
-\(See info node `Minibuffer History')" t nil)
+\(See info node `Minibuffer History')
+
+\(fn REGEXP &optional FACE)" t nil)
(defalias (quote highlight-regexp) (quote hi-lock-face-buffer))
Interactively, prompt for REGEXP then FACE. Buffer-local history
list maintained for regexps, global history maintained for faces.
\\<minibuffer-local-map>Use \\[next-history-element] and \\[previous-history-element] to retrieve next or previous history item.
-\(See info node `Minibuffer History')" t nil)
+\(See info node `Minibuffer History')
+
+\(fn REGEXP &optional FACE)" t nil)
(defalias (quote highlight-phrase) (quote hi-lock-face-phrase-buffer))
Set face of each match of phrase REGEXP to FACE.
Whitespace in REGEXP converted to arbitrary whitespace and initial
-lower-case letters made case insensitive." t nil)
+lower-case letters made case insensitive.
+
+\(fn REGEXP &optional FACE)" t nil)
(defalias (quote unhighlight-regexp) (quote hi-lock-unface-buffer))
regexp's maintained. Will accept only regexps inserted by hi-lock
interactive functions. (See `hi-lock-interactive-patterns'.)
\\<minibuffer-local-must-match-map>Use \\[minibuffer-complete] to complete a partially typed regexp.
-\(See info node `Minibuffer History'.)" t nil)
+\(See info node `Minibuffer History'.)
+
+\(fn REGEXP)" t nil)
(autoload (quote hi-lock-write-interactive-patterns) "hi-lock" "\
Write interactively added patterns, if any, into buffer at point.
Interactively added patterns are those normally specified using
`highlight-regexp' and `highlight-lines-matching-regexp'; they can
-be found in variable `hi-lock-interactive-patterns'." t nil)
+be found in variable `hi-lock-interactive-patterns'.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (hide-ifdef-lines hide-ifdef-read-only hide-ifdef-initially
-;;;;;; hide-ifdef-mode) "hideif" "progmodes/hideif.el" (15391 60715))
+;;;;;; hide-ifdef-mode) "hideif" "progmodes/hideif.el" (15941 42965))
;;; Generated autoloads from progmodes/hideif.el
(autoload (quote hide-ifdef-mode) "hideif" "\
is used.
`hide-ifdef-define-alist'
- An association list of defined symbol lists.
+ An association list of defined symbol lists.
Use `hide-ifdef-set-define-alist' to save the current `hide-ifdef-env'
and `hide-ifdef-use-define-alist' to set the current `hide-ifdef-env'
from one of the lists in `hide-ifdef-define-alist'.
Set to non-nil if you want to make buffers read only while hiding.
After `show-ifdefs', read-only status is restored to previous value.
-\\{hide-ifdef-mode-map}" t nil)
+\\{hide-ifdef-mode-map}
+
+\(fn &optional ARG)" t nil)
(defvar hide-ifdef-initially nil "\
*Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated.")
+(custom-autoload (quote hide-ifdef-initially) "hideif")
+
(defvar hide-ifdef-read-only nil "\
*Set to non-nil if you want buffer to be read-only while hiding text.")
+(custom-autoload (quote hide-ifdef-read-only) "hideif")
+
(defvar hide-ifdef-lines nil "\
*Non-nil means hide the #ifX, #else, and #endif lines.")
+(custom-autoload (quote hide-ifdef-lines) "hideif")
+
;;;***
\f
;;;### (autoloads (hs-minor-mode hs-hide-comments-when-hiding-all)
-;;;;;; "hideshow" "progmodes/hideshow.el" (15371 46426))
+;;;;;; "hideshow" "progmodes/hideshow.el" (16162 11943))
;;; Generated autoloads from progmodes/hideshow.el
(defvar hs-hide-comments-when-hiding-all t "\
*Hide the comments too when you do an `hs-hide-all'.")
+(custom-autoload (quote hs-hide-comments-when-hiding-all) "hideshow")
+
(defvar hs-special-modes-alist (quote ((c-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) (c++-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) (bibtex-mode ("^@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning))) "\
*Alist for initializing the hideshow variables for different modes.
Each element has the form
As a special case, START may be a list of the form (COMPLEX-START
MDATA-SELECTOR), where COMPLEX-START is a regexp w/ multiple parts and
MDATA-SELECTOR an integer that specifies which sub-match is the proper
-place to adjust point, before calling `hs-forward-sexp-func'. For
-example, see the `hs-special-modes-alist' entry for `bibtex-mode'.
+place to adjust point, before calling `hs-forward-sexp-func'. Point
+is adjusted to the beginning of the specified match. For example,
+see the `hs-special-modes-alist' entry for `bibtex-mode'.
For some major modes, `forward-sexp' does not work properly. In those
cases, FORWARD-SEXP-FUNC specifies another function to use instead.
Lastly, the normal hook `hs-minor-mode-hook' is run using `run-hooks'.
Key bindings:
-\\{hs-minor-mode-map}" t nil)
+\\{hs-minor-mode-map}
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (global-highlight-changes highlight-compare-with-file
;;;;;; highlight-changes-rotate-faces highlight-changes-previous-change
;;;;;; highlight-changes-next-change highlight-changes-mode highlight-changes-remove-highlight)
-;;;;;; "hilit-chg" "hilit-chg.el" (15464 26323))
+;;;;;; "hilit-chg" "hilit-chg.el" (15941 42952))
;;; Generated autoloads from hilit-chg.el
(defvar highlight-changes-mode nil)
(autoload (quote highlight-changes-remove-highlight) "hilit-chg" "\
-Remove the change face from the region between BEG and END.
-This allows you to manually remove highlighting from uninteresting changes." t nil)
+Remove the change face from the region between BEG and END.
+This allows you to manually remove highlighting from uninteresting changes.
+
+\(fn BEG END)" t nil)
(autoload (quote highlight-changes-mode) "hilit-chg" "\
Toggle (or initially set) Highlight Changes mode.
-Without an argument:
+Without an argument:
If Highlight Changes mode is not enabled, then enable it (in either active
or passive state as determined by the variable
`highlight-changes-initial-state'); otherwise, toggle between active
Functions:
\\[highlight-changes-next-change] - move point to beginning of next change
-\\[highlight-changes-previous-change] - move to beginning of previous change
+\\[highlight-changes-previous-change] - move to beginning of previous change
\\[highlight-compare-with-file] - mark text as changed by comparing this
buffer with the contents of a file
\\[highlight-changes-remove-highlight] - remove the change face from the region
-\\[highlight-changes-rotate-faces] - rotate different \"ages\" of changes through
+\\[highlight-changes-rotate-faces] - rotate different \"ages\" of changes through
various faces.
Hook variables:
`highlight-changes-enable-hook' - when enabling Highlight Changes mode.
`highlight-changes-toggle-hook' - when entering active or passive state
-`highlight-changes-disable-hook' - when turning off Highlight Changes mode." t nil)
+`highlight-changes-disable-hook' - when turning off Highlight Changes mode.
+
+\(fn &optional ARG)" t nil)
(autoload (quote highlight-changes-next-change) "hilit-chg" "\
-Move to the beginning of the next change, if in Highlight Changes mode." t nil)
+Move to the beginning of the next change, if in Highlight Changes mode.
+
+\(fn)" t nil)
(autoload (quote highlight-changes-previous-change) "hilit-chg" "\
-Move to the beginning of the previous change, if in Highlight Changes mode." t nil)
+Move to the beginning of the previous change, if in Highlight Changes mode.
+
+\(fn)" t nil)
(autoload (quote highlight-changes-rotate-faces) "hilit-chg" "\
Rotate the faces used by Highlight Changes mode.
shown in the last face in the list.
You can automatically rotate colours when the buffer is saved
-by adding the following to `local-write-file-hooks', by evaling it in the
+by adding the following to `local-write-file-hooks', by evaling it in the
buffer to be saved):
- (add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)" t nil)
+ (add-hook 'local-write-file-hooks 'highlight-changes-rotate-faces)
+
+\(fn)" t nil)
(autoload (quote highlight-compare-with-file) "hilit-chg" "\
Compare this buffer with a file, and highlight differences.
If the buffer is read-only, differences will be highlighted but no property
changes are made, so \\[highlight-changes-next-change] and
-\\[highlight-changes-previous-change] will not work." t nil)
+\\[highlight-changes-previous-change] will not work.
+
+\(fn FILE-B)" t nil)
(autoload (quote global-highlight-changes) "hilit-chg" "\
Turn on or off global Highlight Changes mode.
When called from a program:
- if ARG is nil or omitted, turn it off
-- if ARG is `active', turn it on in active mode
+- if ARG is `active', turn it on in active mode
- if ARG is `passive', turn it on in passive mode
-- otherwise just turn it on
+- otherwise just turn it on
When global Highlight Changes mode is enabled, Highlight Changes mode is turned
on for future \"suitable\" buffers (and for \"suitable\" existing buffers if
variable `highlight-changes-global-changes-existing-buffers' is non-nil).
-\"Suitability\" is determined by variable `highlight-changes-global-modes'." t nil)
+\"Suitability\" is determined by variable `highlight-changes-global-modes'.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;;;; hippie-expand-ignore-buffers hippie-expand-max-buffers hippie-expand-no-restriction
;;;;;; hippie-expand-dabbrev-as-symbol hippie-expand-dabbrev-skip-space
;;;;;; hippie-expand-verbose hippie-expand-try-functions-list) "hippie-exp"
-;;;;;; "hippie-exp.el" (15400 1472))
+;;;;;; "hippie-exp.el" (15941 42952))
;;; Generated autoloads from hippie-exp.el
(defvar hippie-expand-try-functions-list (quote (try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially try-complete-lisp-symbol)) "\
To change the behavior of `hippie-expand', remove, change the order of,
or insert functions in this list.")
+(custom-autoload (quote hippie-expand-try-functions-list) "hippie-exp")
+
(defvar hippie-expand-verbose t "\
*Non-nil makes `hippie-expand' output which function it is trying.")
+(custom-autoload (quote hippie-expand-verbose) "hippie-exp")
+
(defvar hippie-expand-dabbrev-skip-space nil "\
*Non-nil means tolerate trailing spaces in the abbreviation to expand.")
+(custom-autoload (quote hippie-expand-dabbrev-skip-space) "hippie-exp")
+
(defvar hippie-expand-dabbrev-as-symbol t "\
*Non-nil means expand as symbols, i.e. syntax `_' is considered a letter.")
+(custom-autoload (quote hippie-expand-dabbrev-as-symbol) "hippie-exp")
+
(defvar hippie-expand-no-restriction t "\
*Non-nil means that narrowed buffers are widened during search.")
+(custom-autoload (quote hippie-expand-no-restriction) "hippie-exp")
+
(defvar hippie-expand-max-buffers nil "\
*The maximum number of buffers (apart from the current) searched.
If nil, all buffers are searched.")
+(custom-autoload (quote hippie-expand-max-buffers) "hippie-exp")
+
(defvar hippie-expand-ignore-buffers (quote ("^ \\*.*\\*$" dired-mode)) "\
*A list specifying which buffers not to search (if not current).
Can contain both regexps matching buffer names (as strings) and major modes
\(as atoms)")
+(custom-autoload (quote hippie-expand-ignore-buffers) "hippie-exp")
+
(defvar hippie-expand-only-buffers nil "\
*A list specifying the only buffers to search (in addition to current).
Can contain both regexps matching buffer names (as strings) and major modes
\(as atoms). If non-nil, this variable overrides the variable
`hippie-expand-ignore-buffers'.")
+(custom-autoload (quote hippie-expand-only-buffers) "hippie-exp")
+
(autoload (quote hippie-expand) "hippie-exp" "\
Try to expand text before point, using multiple methods.
The expansion functions in `hippie-expand-try-functions-list' are
tried in order, until a possible expansion is found. Repeated
application of `hippie-expand' inserts successively possible
-expansions.
+expansions.
With a positive numeric argument, jumps directly to the ARG next
-function in this list. With a negative argument or just \\[universal-argument],
-undoes the expansion." t nil)
+function in this list. With a negative argument or just \\[universal-argument],
+undoes the expansion.
+
+\(fn ARG)" t nil)
(autoload (quote make-hippie-expand-function) "hippie-exp" "\
Construct a function similar to `hippie-expand'.
Make it use the expansion functions in TRY-LIST. An optional second
-argument VERBOSE non-nil makes the function verbose." nil (quote macro))
+argument VERBOSE non-nil makes the function verbose.
+
+\(fn TRY-LIST &optional VERBOSE)" nil (quote macro))
;;;***
\f
;;;### (autoloads (global-hl-line-mode hl-line-mode) "hl-line" "hl-line.el"
-;;;;;; (15455 18398))
+;;;;;; (16072 11522))
;;; Generated autoloads from hl-line.el
(autoload (quote hl-line-mode) "hl-line" "\
-Minor mode to highlight the line about point in the current window.
+Buffer-local minor mode to highlight the line about point.
With ARG, turn Hl-Line mode on if ARG is positive, off otherwise.
-Uses functions `hl-line-unhighlight' and `hl-line-highlight' on
-`pre-command-hook' and `post-command-hook'." t nil)
+
+If `hl-line-sticky-flag' is non-nil, Hl-Line mode highlights the
+line about the buffer's point in all windows. Caveat: the
+buffer's point might be different from the point of a
+non-selected window. Hl-Line mode uses the function
+`hl-line-highlight' on `post-command-hook' in this case.
+
+When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the
+line about point in the selected window only. In this case, it
+uses the function `hl-line-unhighlight' on `pre-command-hook' in
+addition to `hl-line-highlight' on `post-command-hook'.
+
+\(fn &optional ARG)" t nil)
(defvar global-hl-line-mode nil "\
Non-nil if Global-Hl-Line mode is enabled.
Setting this variable directly does not take effect;
use either \\[customize] or the function `global-hl-line-mode'.")
-(custom-add-to-group (quote hl-line) (quote global-hl-line-mode) (quote custom-variable))
-
-(custom-add-load (quote global-hl-line-mode) (quote hl-line))
+(custom-autoload (quote global-hl-line-mode) "hl-line")
(autoload (quote global-hl-line-mode) "hl-line" "\
-Toggle Hl-Line mode in every buffer.
-With prefix ARG, turn Global-Hl-Line mode on if and only if ARG is positive.
-Hl-Line mode is actually not turned on in every buffer but only in those
-in which `hl-line-mode' turns it on." t nil)
+Global minor mode to highlight the line about point in the current window.
+With ARG, turn Global-Hl-Line mode on if ARG is positive, off otherwise.
+
+Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and
+`global-hl-line-highlight' on `pre-command-hook' and `post-command-hook'.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (list-holidays holidays) "holidays" "calendar/holidays.el"
-;;;;;; (15371 46418))
+;;;;;; (16174 61085))
;;; Generated autoloads from calendar/holidays.el
(autoload (quote holidays) "holidays" "\
Display the holidays for last month, this month, and next month.
If called with an optional prefix argument, prompts for month and year.
-This function is suitable for execution in a .emacs file." t nil)
+This function is suitable for execution in a .emacs file.
+
+\(fn &optional ARG)" t nil)
(autoload (quote list-holidays) "holidays" "\
Display holidays for years Y1 to Y2 (inclusive).
The optional list of holidays L defaults to `calendar-holidays'. See the
documentation for that variable for a description of holiday lists.
-The optional LABEL is used to label the buffer created." t nil)
+The optional LABEL is used to label the buffer created.
+
+\(fn Y1 Y2 &optional L LABEL)" t nil)
;;;***
\f
;;;### (autoloads (hscroll-global-mode hscroll-mode turn-on-hscroll)
-;;;;;; "hscroll" "obsolete/hscroll.el" (15371 46425))
+;;;;;; "hscroll" "obsolete/hscroll.el" (15941 42963))
;;; Generated autoloads from obsolete/hscroll.el
(autoload (quote turn-on-hscroll) "hscroll" "\
This function is obsolete.
Emacs now does hscrolling automatically, if `truncate-lines' is non-nil.
-Also see `automatic-hscrolling'." nil nil)
+Also see `automatic-hscrolling'.
+
+\(fn)" nil nil)
(autoload (quote hscroll-mode) "hscroll" "\
This function is obsolete.
Emacs now does hscrolling automatically, if `truncate-lines' is non-nil.
-Also see `automatic-hscrolling'." t nil)
+Also see `automatic-hscrolling'.
+
+\(fn &optional ARG)" t nil)
(autoload (quote hscroll-global-mode) "hscroll" "\
This function is obsolete.
Emacs now does hscrolling automatically, if `truncate-lines' is non-nil.
-Also see `automatic-hscrolling'." t nil)
+Also see `automatic-hscrolling'.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;;;; ibuffer-add-saved-filters ibuffer-delete-saved-filters ibuffer-save-filters
;;;;;; ibuffer-or-filter ibuffer-negate-filter ibuffer-exchange-filters
;;;;;; ibuffer-decompose-filter ibuffer-pop-filter ibuffer-filter-disable
-;;;;;; ibuffer-included-in-filters-p ibuffer-interactive-filter-by-mode
-;;;;;; ibuffer-mouse-filter-by-mode ibuffer-auto-mode) "ibuf-ext"
-;;;;;; "ibuf-ext.el" (15483 59348))
+;;;;;; ibuffer-switch-to-saved-filter-groups ibuffer-delete-saved-filter-groups
+;;;;;; ibuffer-save-filter-groups ibuffer-yank-filter-group ibuffer-yank
+;;;;;; ibuffer-kill-line ibuffer-kill-filter-group ibuffer-jump-to-filter-group
+;;;;;; ibuffer-clear-filter-groups ibuffer-decompose-filter-group
+;;;;;; ibuffer-pop-filter-group ibuffer-set-filter-groups-by-mode
+;;;;;; ibuffer-filters-to-filter-group ibuffer-included-in-filters-p
+;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group
+;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group
+;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode
+;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" (16136 53054))
;;; Generated autoloads from ibuf-ext.el
(autoload (quote ibuffer-auto-mode) "ibuf-ext" "\
Toggle use of Ibuffer's auto-update facility.
-With numeric ARG, enable auto-update if and only if ARG is positive." t nil)
+With numeric ARG, enable auto-update if and only if ARG is positive.
+
+\(fn &optional ARG)" t nil)
(autoload (quote ibuffer-mouse-filter-by-mode) "ibuf-ext" "\
-Enable or disable filtering by the major mode chosen via mouse." t nil)
+Enable or disable filtering by the major mode chosen via mouse.
+
+\(fn EVENT)" t nil)
(autoload (quote ibuffer-interactive-filter-by-mode) "ibuf-ext" "\
-Enable or disable filtering by the major mode at point." t nil)
+Enable or disable filtering by the major mode at point.
+
+\(fn EVENT-OR-POINT)" t nil)
+
+(autoload (quote ibuffer-mouse-toggle-filter-group) "ibuf-ext" "\
+Toggle the display status of the filter group chosen with the mouse.
+
+\(fn EVENT)" t nil)
+
+(autoload (quote ibuffer-toggle-filter-group) "ibuf-ext" "\
+Toggle the display status of the filter group on this line.
+
+\(fn)" t nil)
+
+(autoload (quote ibuffer-forward-filter-group) "ibuf-ext" "\
+Move point forwards by COUNT filtering groups.
+
+\(fn &optional COUNT)" t nil)
+
+(autoload (quote ibuffer-backward-filter-group) "ibuf-ext" "\
+Move point backwards by COUNT filtering groups.
+
+\(fn &optional COUNT)" t nil)
+ (autoload 'ibuffer-do-shell-command-pipe "ibuf-ext.el")
+ (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext.el")
+ (autoload 'ibuffer-do-shell-command-file "ibuf-ext.el")
+ (autoload 'ibuffer-do-eval "ibuf-ext.el")
+ (autoload 'ibuffer-do-view-and-eval "ibuf-ext.el")
+ (autoload 'ibuffer-do-rename-uniquely "ibuf-ext.el")
+ (autoload 'ibuffer-do-revert "ibuf-ext.el")
+ (autoload 'ibuffer-do-replace-regexp "ibuf-ext.el")
+ (autoload 'ibuffer-do-query-replace "ibuf-ext.el")
+ (autoload 'ibuffer-do-query-replace-regexp "ibuf-ext.el")
+ (autoload 'ibuffer-do-print "ibuf-ext.el")
+
+(autoload (quote ibuffer-included-in-filters-p) "ibuf-ext" "\
+Not documented
+
+\(fn BUF FILTERS)" nil nil)
+
+(autoload (quote ibuffer-filters-to-filter-group) "ibuf-ext" "\
+Make the current filters into a filtering group.
+
+\(fn NAME)" t nil)
+
+(autoload (quote ibuffer-set-filter-groups-by-mode) "ibuf-ext" "\
+Set the current filter groups to filter by mode.
+
+\(fn)" t nil)
+
+(autoload (quote ibuffer-pop-filter-group) "ibuf-ext" "\
+Remove the first filter group.
+
+\(fn)" t nil)
+
+(autoload (quote ibuffer-decompose-filter-group) "ibuf-ext" "\
+Decompose the filter group GROUP into active filters.
+
+\(fn GROUP)" t nil)
+
+(autoload (quote ibuffer-clear-filter-groups) "ibuf-ext" "\
+Remove all filter groups.
+
+\(fn)" t nil)
+
+(autoload (quote ibuffer-jump-to-filter-group) "ibuf-ext" "\
+Move point to the filter group whose name is NAME.
+
+\(fn NAME)" t nil)
+
+(autoload (quote ibuffer-kill-filter-group) "ibuf-ext" "\
+Kill the filter group named NAME.
+The group will be added to `ibuffer-filter-group-kill-ring'.
+
+\(fn NAME)" t nil)
+
+(autoload (quote ibuffer-kill-line) "ibuf-ext" "\
+Kill the filter group at point.
+See also `ibuffer-kill-filter-group'.
+
+\(fn &optional ARG)" t nil)
-(autoload (quote ibuffer-included-in-filters-p) "ibuf-ext" nil nil nil)
+(autoload (quote ibuffer-yank) "ibuf-ext" "\
+Yank the last killed filter group before group at point.
+
+\(fn)" t nil)
+
+(autoload (quote ibuffer-yank-filter-group) "ibuf-ext" "\
+Yank the last killed filter group before group named NAME.
+
+\(fn NAME)" t nil)
+
+(autoload (quote ibuffer-save-filter-groups) "ibuf-ext" "\
+Save all active filter groups GROUPS as NAME.
+They are added to `ibuffer-saved-filter-groups'. Interactively,
+prompt for NAME, and use the current filters.
+
+\(fn NAME GROUPS)" t nil)
+
+(autoload (quote ibuffer-delete-saved-filter-groups) "ibuf-ext" "\
+Delete saved filter groups with NAME.
+They are removed from `ibuffer-saved-filter-groups'.
+
+\(fn NAME)" t nil)
+
+(autoload (quote ibuffer-switch-to-saved-filter-groups) "ibuf-ext" "\
+Set this buffer's filter groups to saved version with NAME.
+The value from `ibuffer-saved-filters' is used.
+If prefix argument ADD is non-nil, then add the saved filters instead
+of replacing the current filters.
+
+\(fn NAME)" t nil)
(autoload (quote ibuffer-filter-disable) "ibuf-ext" "\
-Disable all filters currently in effect in this buffer." t nil)
+Disable all filters currently in effect in this buffer.
+
+\(fn)" t nil)
(autoload (quote ibuffer-pop-filter) "ibuf-ext" "\
-Remove the top filter in this buffer." t nil)
+Remove the top filter in this buffer.
+
+\(fn)" t nil)
(autoload (quote ibuffer-decompose-filter) "ibuf-ext" "\
Separate the top compound filter (OR, NOT, or SAVED) in this buffer.
This means that the topmost filter on the filtering stack, which must
be a complex filter like (OR [name: foo] [mode: bar-mode]), will be
-turned into two separate filters [name: foo] and [mode: bar-mode]." t nil)
+turned into two separate filters [name: foo] and [mode: bar-mode].
+
+\(fn)" t nil)
(autoload (quote ibuffer-exchange-filters) "ibuf-ext" "\
-Exchange the top two filters on the stack in this buffer." t nil)
+Exchange the top two filters on the stack in this buffer.
+
+\(fn)" t nil)
(autoload (quote ibuffer-negate-filter) "ibuf-ext" "\
-Negate the sense of the top filter in the current buffer." t nil)
+Negate the sense of the top filter in the current buffer.
+
+\(fn)" t nil)
(autoload (quote ibuffer-or-filter) "ibuf-ext" "\
Replace the top two filters in this buffer with their logical OR.
If optional argument REVERSE is non-nil, instead break the top OR
-filter into parts." t nil)
+filter into parts.
+
+\(fn &optional REVERSE)" t nil)
(autoload (quote ibuffer-save-filters) "ibuf-ext" "\
Save FILTERS in this buffer with name NAME in `ibuffer-saved-filters'.
-Interactively, prompt for NAME, and use the current filters." t nil)
+Interactively, prompt for NAME, and use the current filters.
+
+\(fn NAME FILTERS)" t nil)
(autoload (quote ibuffer-delete-saved-filters) "ibuf-ext" "\
-Delete saved filters with NAME from `ibuffer-saved-filters'." t nil)
+Delete saved filters with NAME from `ibuffer-saved-filters'.
+
+\(fn NAME)" t nil)
(autoload (quote ibuffer-add-saved-filters) "ibuf-ext" "\
-Add saved filters from `ibuffer-saved-filters' to this buffer's filters." t nil)
+Add saved filters from `ibuffer-saved-filters' to this buffer's filters.
+
+\(fn NAME)" t nil)
(autoload (quote ibuffer-switch-to-saved-filters) "ibuf-ext" "\
Set this buffer's filters to filters with NAME from `ibuffer-saved-filters'.
If prefix argument ADD is non-nil, then add the saved filters instead
-of replacing the current filters." t nil)
+of replacing the current filters.
+
+\(fn NAME)" t nil)
+ (autoload 'ibuffer-filter-by-mode "ibuf-ext.el")
+ (autoload 'ibuffer-filter-by-used-mode "ibuf-ext.el")
+ (autoload 'ibuffer-filter-by-name "ibuf-ext.el")
+ (autoload 'ibuffer-filter-by-filename "ibuf-ext.el")
+ (autoload 'ibuffer-filter-by-size-gt "ibuf-ext.el")
+ (autoload 'ibuffer-filter-by-size-lt "ibuf-ext.el")
+ (autoload 'ibuffer-filter-by-content "ibuf-ext.el")
+ (autoload 'ibuffer-filter-by-predicate "ibuf-ext.el")
(autoload (quote ibuffer-toggle-sorting-mode) "ibuf-ext" "\
Toggle the current sorting mode.
Recency - the last time the buffer was viewed
Name - the name of the buffer
Major Mode - the name of the major mode of the buffer
- Size - the size of the buffer" t nil)
+ Size - the size of the buffer
+
+\(fn)" t nil)
(autoload (quote ibuffer-invert-sorting) "ibuf-ext" "\
-Toggle whether or not sorting is in reverse order." t nil)
+Toggle whether or not sorting is in reverse order.
+
+\(fn)" t nil)
+ (autoload 'ibuffer-do-sort-by-major-mode "ibuf-ext.el")
+ (autoload 'ibuffer-do-sort-by-mode-name "ibuf-ext.el")
+ (autoload 'ibuffer-do-sort-by-alphabetic "ibuf-ext.el")
+ (autoload 'ibuffer-do-sort-by-size "ibuf-ext.el")
(autoload (quote ibuffer-bs-show) "ibuf-ext" "\
-Emulate `bs-show' from the bs.el package." t nil)
+Emulate `bs-show' from the bs.el package.
+
+\(fn)" t nil)
(autoload (quote ibuffer-add-to-tmp-hide) "ibuf-ext" "\
Add REGEXP to `ibuffer-tmp-hide-regexps'.
This means that buffers whose name matches REGEXP will not be shown
-for this ibuffer session." t nil)
+for this Ibuffer session.
+
+\(fn REGEXP)" t nil)
(autoload (quote ibuffer-add-to-tmp-show) "ibuf-ext" "\
Add REGEXP to `ibuffer-tmp-show-regexps'.
This means that buffers whose name matches REGEXP will always be shown
-for this ibuffer session." t nil)
+for this Ibuffer session.
+
+\(fn REGEXP)" t nil)
(autoload (quote ibuffer-forward-next-marked) "ibuf-ext" "\
Move forward by COUNT marked buffers (default 1).
to move by. The default is `ibuffer-marked-char'.
If DIRECTION is non-nil, it should be an integer; negative integers
-mean move backwards, non-negative integers mean move forwards." t nil)
+mean move backwards, non-negative integers mean move forwards.
+
+\(fn &optional COUNT MARK DIRECTION)" t nil)
(autoload (quote ibuffer-backwards-next-marked) "ibuf-ext" "\
Move backwards by COUNT marked buffers (default 1).
If MARK is non-nil, it should be a character denoting the type of mark
-to move by. The default is `ibuffer-marked-char'." t nil)
+to move by. The default is `ibuffer-marked-char'.
+
+\(fn &optional COUNT MARK)" t nil)
(autoload (quote ibuffer-do-kill-lines) "ibuf-ext" "\
-Hide all of the currently marked lines." t nil)
+Hide all of the currently marked lines.
+
+\(fn)" t nil)
(autoload (quote ibuffer-jump-to-buffer) "ibuf-ext" "\
-Move point to the buffer whose name is NAME." t nil)
+Move point to the buffer whose name is NAME.
+
+\(fn NAME)" t nil)
(autoload (quote ibuffer-diff-with-file) "ibuf-ext" "\
View the differences between this buffer and its associated file.
-This requires the external program \"diff\" to be in your `exec-path'." t nil)
+This requires the external program \"diff\" to be in your `exec-path'.
+
+\(fn)" t nil)
(autoload (quote ibuffer-copy-filename-as-kill) "ibuf-ext" "\
Copy filenames of marked buffers into the kill ring.
+
The names are separated by a space.
If a buffer has no filename, it is ignored.
-With a zero prefix arg, use the complete pathname of each marked file.
-You can then feed the file name(s) to other commands with C-y.
+With no prefix arg, use the filename sans its directory of each marked file.
+With a zero prefix arg, use the complete filename of each marked file.
+With \\[universal-argument], use the filename of each marked file relative
+to `ibuffer-default-directory' iff non-nil, otherwise `default-directory'.
+
+You can then feed the file name(s) to other commands with \\[yank].
- [ This docstring shamelessly stolen from the
- `dired-copy-filename-as-kill' in \"dired-x\". ]" t nil)
+\(fn &optional ARG)" t nil)
(autoload (quote ibuffer-mark-by-name-regexp) "ibuf-ext" "\
-Mark all buffers whose name matches REGEXP." t nil)
+Mark all buffers whose name matches REGEXP.
+
+\(fn REGEXP)" t nil)
(autoload (quote ibuffer-mark-by-mode-regexp) "ibuf-ext" "\
-Mark all buffers whose major mode matches REGEXP." t nil)
+Mark all buffers whose major mode matches REGEXP.
+
+\(fn REGEXP)" t nil)
(autoload (quote ibuffer-mark-by-file-name-regexp) "ibuf-ext" "\
-Mark all buffers whose file name matches REGEXP." t nil)
+Mark all buffers whose file name matches REGEXP.
+
+\(fn REGEXP)" t nil)
(autoload (quote ibuffer-mark-by-mode) "ibuf-ext" "\
-Mark all buffers whose major mode equals MODE." t nil)
+Mark all buffers whose major mode equals MODE.
+
+\(fn MODE)" t nil)
(autoload (quote ibuffer-mark-modified-buffers) "ibuf-ext" "\
-Mark all modified buffers." t nil)
+Mark all modified buffers.
+
+\(fn)" t nil)
(autoload (quote ibuffer-mark-unsaved-buffers) "ibuf-ext" "\
-Mark all modified buffers that have an associated file." t nil)
+Mark all modified buffers that have an associated file.
+
+\(fn)" t nil)
(autoload (quote ibuffer-mark-dissociated-buffers) "ibuf-ext" "\
-Mark all buffers whose associated file does not exist." t nil)
+Mark all buffers whose associated file does not exist.
+
+\(fn)" t nil)
(autoload (quote ibuffer-mark-help-buffers) "ibuf-ext" "\
-Mark buffers like *Help*, *Apropos*, *Info*." t nil)
+Mark buffers like *Help*, *Apropos*, *Info*.
+
+\(fn)" t nil)
(autoload (quote ibuffer-mark-old-buffers) "ibuf-ext" "\
-Mark buffers which have not been viewed in `ibuffer-old-time' days." t nil)
+Mark buffers which have not been viewed in `ibuffer-old-time' days.
+
+\(fn)" t nil)
(autoload (quote ibuffer-mark-special-buffers) "ibuf-ext" "\
-Mark all buffers whose name begins and ends with '*'." t nil)
+Mark all buffers whose name begins and ends with '*'.
+
+\(fn)" t nil)
(autoload (quote ibuffer-mark-read-only-buffers) "ibuf-ext" "\
-Mark all read-only buffers." t nil)
+Mark all read-only buffers.
+
+\(fn)" t nil)
(autoload (quote ibuffer-mark-dired-buffers) "ibuf-ext" "\
-Mark all `dired' buffers." t nil)
+Mark all `dired' buffers.
+
+\(fn)" t nil)
(autoload (quote ibuffer-do-occur) "ibuf-ext" "\
View lines which match REGEXP in all marked buffers.
Optional argument NLINES says how many lines of context to display: it
-defaults to one." t nil)
+defaults to one.
+
+\(fn REGEXP &optional NLINES)" t nil)
;;;***
\f
;;;### (autoloads (define-ibuffer-filter define-ibuffer-op define-ibuffer-sorter
-;;;;;; define-ibuffer-column) "ibuf-macs" "ibuf-macs.el" (15457
-;;;;;; 4937))
+;;;;;; define-ibuffer-column) "ibuf-macs" "ibuf-macs.el" (16111
+;;;;;; 41826))
;;; Generated autoloads from ibuf-macs.el
(autoload (quote define-ibuffer-column) "ibuf-macs" "\
Define a column SYMBOL for use with `ibuffer-formats'.
BODY will be called with `buffer' bound to the buffer object, and
-`mark' bound to the current mark on the buffer. The current buffer
-will be `buffer'.
+`mark' bound to the current mark on the buffer. The original ibuffer
+buffer will be bound to `ibuffer-buf'.
If NAME is given, it will be used as a title for the column.
Otherwise, the title will default to a capitalized version of the
ibuffer-make-column-NAME. If INLINE is non-nil, then the form will be
inlined into the compiled format versions. This means that if you
change its definition, you should explicitly call
-`ibuffer-recompile-formats'." nil (quote macro))
+`ibuffer-recompile-formats'.
+
+\(fn SYMBOL (&KEY name inline props summarizer) &rest BODY)" nil (quote macro))
(autoload (quote define-ibuffer-sorter) "ibuf-macs" "\
Define a method of sorting named NAME.
For sorting, the forms in BODY will be evaluated with `a' bound to one
buffer object, and `b' bound to another. BODY should return a non-nil
-value if and only if `a' is \"less than\" `b'." nil (quote macro))
+value if and only if `a' is \"less than\" `b'.
+
+\(fn NAME DOCUMENTATION (&KEY description) &rest BODY)" nil (quote macro))
(autoload (quote define-ibuffer-op) "ibuf-macs" "\
-Generate a function named `ibuffer-do-OP', which operates on a buffer.
+Generate a function which operates on a buffer.
+OP becomes the name of the function; if it doesn't begin with
+`ibuffer-do-', then that is prepended to it.
When an operation is performed, this function will be called once for
each marked buffer, with that buffer current.
confirmation message, in the form:
\"Really ACTIVE-OPSTRING x buffers?\"
COMPLEX means this function is special; see the source code of this
-macro for exactly what it does." nil (quote macro))
+macro for exactly what it does.
+
+\(fn OP ARGS DOCUMENTATION (&KEY interactive mark modifier-p dangerous (opstring operated on) (active-opstring Operate on) complex) &rest BODY)" nil (quote macro))
(autoload (quote define-ibuffer-filter) "ibuf-macs" "\
Define a filter named NAME.
BODY should contain forms which will be evaluated to test whether or
not a particular buffer should be displayed or not. The forms in BODY
will be evaluated with BUF bound to the buffer object, and QUALIFIER
-bound to the current value of the filter." nil (quote macro))
+bound to the current value of the filter.
+
+\(fn NAME DOCUMENTATION (&KEY reader description) &rest BODY)" nil (quote macro))
;;;***
\f
;;;### (autoloads (ibuffer ibuffer-other-window ibuffer-list-buffers)
-;;;;;; "ibuffer" "ibuffer.el" (15480 2733))
+;;;;;; "ibuffer" "ibuffer.el" (16136 53054))
;;; Generated autoloads from ibuffer.el
(autoload (quote ibuffer-list-buffers) "ibuffer" "\
Display a list of buffers, in another window.
If optional argument FILES-ONLY is non-nil, then add a filter for
-buffers which are visiting a file." t nil)
+buffers which are visiting a file.
+
+\(fn &optional FILES-ONLY)" t nil)
(autoload (quote ibuffer-other-window) "ibuffer" "\
Like `ibuffer', but displayed in another window by default.
If optional argument FILES-ONLY is non-nil, then add a filter for
-buffers which are visiting a file." t nil)
+buffers which are visiting a file.
+
+\(fn &optional FILES-ONLY)" t nil)
(autoload (quote ibuffer) "ibuffer" "\
Begin using `ibuffer' to edit a list of buffers.
to use; see `ibuffer-filtering-qualifiers'.
Optional argument NOSELECT means don't select the Ibuffer buffer.
Optional argument SHRINK means shrink the buffer to minimal size. The
-special value `onewindow' means always use another window." t nil)
+special value `onewindow' means always use another window.
+Optional argument FILTER-GROUPS is an initial set of filtering
+groups to use; see `ibuffer-filter-groups'.
+Optional argument FORMATS is the value to use for `ibuffer-formats'.
+If specified, then the variable `ibuffer-formats' will have that value
+locally in this buffer.
+
+\(fn &optional OTHER-WINDOW-P NAME QUALIFIERS NOSELECT SHRINK FILTER-GROUPS FORMATS)" t nil)
;;;***
\f
;;;### (autoloads (icomplete-minibuffer-setup icomplete-mode) "icomplete"
-;;;;;; "icomplete.el" (15483 45647))
+;;;;;; "icomplete.el" (15941 42953))
;;; Generated autoloads from icomplete.el
(autoload (quote icomplete-mode) "icomplete" "\
Toggle incremental minibuffer completion for this Emacs session.
-With a numeric argument, turn Icomplete mode on iff ARG is positive." t nil)
+With a numeric argument, turn Icomplete mode on iff ARG is positive.
+
+\(fn &optional ARG)" t nil)
(autoload (quote icomplete-minibuffer-setup) "icomplete" "\
Run in minibuffer on activation to establish incremental completion.
-Usually run by inclusion in `minibuffer-setup-hook'." nil nil)
+Usually run by inclusion in `minibuffer-setup-hook'.
+
+\(fn)" nil nil)
;;;***
\f
-;;;### (autoloads (icon-mode) "icon" "progmodes/icon.el" (15371 46426))
+;;;### (autoloads (icon-mode) "icon" "progmodes/icon.el" (15941 42965))
;;; Generated autoloads from progmodes/icon.el
(autoload (quote icon-mode) "icon" "\
this far to the right of the start of its line.
Turning on Icon mode calls the value of the variable `icon-mode-hook'
-with no args, if that value is non-nil." t nil)
+with no args, if that value is non-nil.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (idlwave-shell) "idlw-shell" "progmodes/idlw-shell.el"
-;;;;;; (15470 21905))
+;;;;;; (15829 28909))
;;; Generated autoloads from progmodes/idlw-shell.el
(autoload (quote idlwave-shell) "idlw-shell" "\
is non-nil, the shell buffer and the source buffers will be in
separate frames.
-The command to run comes from variable `idlwave-shell-explicit-file-name'.
+The command to run comes from variable `idlwave-shell-explicit-file-name',
+with options taken from `idlwave-shell-command-line-options'.
The buffer is put in `idlwave-shell-mode', providing commands for sending
input and controlling the IDL job. See help on `idlwave-shell-mode'.
See also the variable `idlwave-shell-prompt-pattern'.
-\(Type \\[describe-mode] in the shell buffer for a list of commands.)" t nil)
+\(Type \\[describe-mode] in the shell buffer for a list of commands.)
+
+\(fn &optional ARG QUICK)" t nil)
;;;***
\f
;;;### (autoloads (idlwave-mode) "idlwave" "progmodes/idlwave.el"
-;;;;;; (15470 22102))
+;;;;;; (16162 11943))
;;; Generated autoloads from progmodes/idlwave.el
(autoload (quote idlwave-mode) "idlwave" "\
Like other Emacs programming modes, C-j inserts a newline and indents.
TAB is used for explicit indentation of the current line.
- To start a continuation line, use \\[idlwave-split-line]. This function can also
- be used in the middle of a line to split the line at that point.
- When used inside a long constant string, the string is split at
- that point with the `+' concatenation operator.
+ To start a continuation line, use \\[idlwave-split-line]. This
+ function can also be used in the middle of a line to split the line
+ at that point. When used inside a long constant string, the string
+ is split at that point with the `+' concatenation operator.
Comments are indented as follows:
The indentation of comments starting in column 0 is never changed.
- Use \\[idlwave-fill-paragraph] to refill a paragraph inside a comment. The indentation
- of the second line of the paragraph relative to the first will be
- retained. Use \\[idlwave-auto-fill-mode] to toggle auto-fill mode for these comments.
- When the variable `idlwave-fill-comment-line-only' is nil, code
- can also be auto-filled and auto-indented (not recommended).
+ Use \\[idlwave-fill-paragraph] to refill a paragraph inside a
+ comment. The indentation of the second line of the paragraph
+ relative to the first will be retained. Use
+ \\[idlwave-auto-fill-mode] to toggle auto-fill mode for these
+ comments. When the variable `idlwave-fill-comment-line-only' is
+ nil, code can also be auto-filled and auto-indented (not
+ recommended).
To convert pre-existing IDL code to your formatting style, mark the
- entire buffer with \\[mark-whole-buffer] and execute \\[idlwave-expand-region-abbrevs].
- Then mark the entire buffer again followed by \\[indent-region] (`indent-region').
+ entire buffer with \\[mark-whole-buffer] and execute
+ \\[idlwave-expand-region-abbrevs]. Then mark the entire buffer
+ again followed by \\[indent-region] (`indent-region').
2. Routine Info
------------
- IDLWAVE displays information about the calling sequence and the accepted
- keyword parameters of a procedure or function with \\[idlwave-routine-info].
- \\[idlwave-find-module] jumps to the source file of a module.
- These commands know about system routines, all routines in idlwave-mode
- buffers and (when the idlwave-shell is active) about all modules
- currently compiled under this shell. Use \\[idlwave-update-routine-info] to update this
+ IDLWAVE displays information about the calling sequence and the
+ accepted keyword parameters of a procedure or function with
+ \\[idlwave-routine-info]. \\[idlwave-find-module] jumps to the
+ source file of a module. These commands know about system
+ routines, all routines in idlwave-mode buffers and (when the
+ idlwave-shell is active) about all modules currently compiled under
+ this shell. Use \\[idlwave-update-routine-info] to update this
information, which is also used for completion (see item 4).
3. Online IDL Help
\\i IF statement template
\\elif IF-ELSE statement template
\\b BEGIN
-
+
For a full list, use \\[idlwave-list-abbrevs]. Some templates also have
direct keybindings - see the list of keybindings below.
9. Documentation and Customization
-------------------------------
- Info documentation for this package is available. Use \\[idlwave-info]
- to display (complain to your sysadmin if that does not work).
- For Postscript and HTML versions of the documentation, check IDLWAVE's
- homepage at `http://www.strw.leidenuniv.nl/~dominik/Tools/idlwave'.
+ Info documentation for this package is available. Use
+ \\[idlwave-info] to display (complain to your sysadmin if that does
+ not work). For Postscript, PDF, and HTML versions of the
+ documentation, check IDLWAVE's homepage at `http://idlwave.org'.
IDLWAVE has customize support - see the group `idlwave'.
10.Keybindings
If some of the key bindings below show with ??, use \\[describe-key]
followed by the key sequence to see what the key sequence does.
-\\{idlwave-mode-map}" t nil)
+\\{idlwave-mode-map}
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (ielm) "ielm" "ielm.el" (15482 24869))
-;;; Generated autoloads from ielm.el
- (add-hook 'same-window-buffer-names "*ielm*")
+;;;### (autoloads (ido-read-directory-name ido-read-file-name ido-dired
+;;;;;; ido-insert-file ido-write-file ido-find-file-other-frame
+;;;;;; ido-display-file ido-find-file-read-only-other-frame ido-find-file-read-only-other-window
+;;;;;; ido-find-file-read-only ido-find-alternate-file ido-find-file-other-window
+;;;;;; ido-find-file ido-find-file-in-dir ido-switch-buffer-other-frame
+;;;;;; ido-insert-buffer ido-kill-buffer ido-display-buffer ido-switch-buffer-other-window
+;;;;;; ido-switch-buffer ido-read-buffer ido-mode ido-mode) "ido"
+;;;;;; "ido.el" (15997 5129))
+;;; Generated autoloads from ido.el
-(autoload (quote ielm) "ielm" "\
-Interactively evaluate Emacs Lisp expressions.
-Switches to the buffer `*ielm*', or creates it if it does not exist." t nil)
+(defvar ido-mode nil "\
+Determines for which functional group (buffer and files) ido behavior
+should be enabled. The following values are possible:
+- `buffer': Turn only on ido buffer behavior (switching, killing,
+ displaying...)
+- `file': Turn only on ido file behavior (finding, writing, inserting...)
+- `both': Turn on ido buffer and file behavior.
+- `nil': Turn off any ido switching.
-;;;***
+Setting this variable directly does not take effect;
+use either \\[customize] or the function `ido-mode'.")
+
+(custom-autoload (quote ido-mode) "ido")
+
+(autoload (quote ido-mode) "ido" "\
+Toggle ido speed-ups on or off.
+With ARG, turn ido speed-up on if arg is positive, off otherwise.
+Turning on ido-mode will remap (via a minor-mode keymap) the default
+keybindings for the `find-file' and `switch-to-buffer' families of
+commands to the ido versions of these functions.
+However, if ARG arg equals 'files, remap only commands for files, or
+if it equals 'buffers, remap only commands for buffer switching.
+This function also adds a hook to the minibuffer.
+
+\(fn &optional ARG)" t nil)
+
+(autoload (quote ido-read-buffer) "ido" "\
+Replacement for the built-in `read-buffer'.
+Return the name of a buffer selected.
+PROMPT is the prompt to give to the user. DEFAULT if given is the default
+buffer to be selected, which will go to the front of the list.
+If REQUIRE-MATCH is non-nil, an existing-buffer must be selected.
+If INITIAL is non-nil, it specifies the initial input string.
+
+\(fn PROMPT &optional DEFAULT REQUIRE-MATCH INITIAL)" nil nil)
+
+(autoload (quote ido-switch-buffer) "ido" "\
+Switch to another buffer.
+The buffer is displayed according to `ido-default-buffer-method' -- the
+default is to show it in the same window, unless it is already visible
+in another frame.
+
+As you type in a string, all of the buffers matching the string are
+displayed if substring-matching is used (default). Look at
+`ido-enable-prefix' and `ido-toggle-prefix'. When you have found the
+buffer you want, it can then be selected. As you type, most keys have their
+normal keybindings, except for the following: \\<ido-mode-map>
+
+RET Select the buffer at the front of the list of matches. If the
+list is empty, possibly prompt to create new buffer.
+
+\\[ido-select-text] Select the current prompt as the buffer.
+If no buffer is found, prompt for a new one.
+
+\\[ido-next-match] Put the first element at the end of the list.
+\\[ido-prev-match] Put the last element at the start of the list.
+\\[ido-complete] Complete a common suffix to the current string that
+matches all buffers. If there is only one match, select that buffer.
+If there is no common suffix, show a list of all matching buffers
+in a separate window.
+\\[ido-edit-input] Edit input string.
+\\[ido-fallback-command] Fallback to non-ido version of current command.
+\\[ido-toggle-regexp] Toggle regexp searching.
+\\[ido-toggle-prefix] Toggle between substring and prefix matching.
+\\[ido-toggle-case] Toggle case-sensitive searching of buffer names.
+\\[ido-completion-help] Show list of matching buffers in separate window.
+\\[ido-enter-find-file] Drop into ido-find-file.
+\\[ido-kill-buffer-at-head] Kill buffer at head of buffer list.
+\\[ido-toggle-ignore] Toggle ignoring buffers listed in `ido-ignore-buffers'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-switch-buffer-other-window) "ido" "\
+Switch to another buffer and show it in another window.
+The buffer name is selected interactively by typing a substring.
+For details of keybindings, do `\\[describe-function] ido'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-display-buffer) "ido" "\
+Display a buffer in another window but don't select it.
+The buffer name is selected interactively by typing a substring.
+For details of keybindings, do `\\[describe-function] ido'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-kill-buffer) "ido" "\
+Kill a buffer.
+The buffer name is selected interactively by typing a substring.
+For details of keybindings, do `\\[describe-function] ido'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-insert-buffer) "ido" "\
+Insert contents of a buffer in current buffer after point.
+The buffer name is selected interactively by typing a substring.
+For details of keybindings, do `\\[describe-function] ido'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-switch-buffer-other-frame) "ido" "\
+Switch to another buffer and show it in another frame.
+The buffer name is selected interactively by typing a substring.
+For details of keybindings, do `\\[describe-function] ido'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-find-file-in-dir) "ido" "\
+Switch to another file starting from DIR.
+
+\(fn DIR)" t nil)
+
+(autoload (quote ido-find-file) "ido" "\
+Edit file with name obtained via minibuffer.
+The file is displayed according to `ido-default-file-method' -- the
+default is to show it in the same window, unless it is already
+visible in another frame.
+
+The file name is selected interactively by typing a substring. As you type
+in a string, all of the filenames matching the string are displayed if
+substring-matching is used (default). Look at `ido-enable-prefix' and
+`ido-toggle-prefix'. When you have found the filename you want, it can
+then be selected. As you type, most keys have their normal keybindings,
+except for the following: \\<ido-mode-map>
+
+RET Select the file at the front of the list of matches. If the
+list is empty, possibly prompt to create new file.
+
+\\[ido-select-text] Select the current prompt as the buffer or file.
+If no buffer or file is found, prompt for a new one.
+
+\\[ido-next-match] Put the first element at the end of the list.
+\\[ido-prev-match] Put the last element at the start of the list.
+\\[ido-complete] Complete a common suffix to the current string that
+matches all files. If there is only one match, select that file.
+If there is no common suffix, show a list of all matching files
+in a separate window.
+\\[ido-edit-input] Edit input string (including directory).
+\\[ido-prev-work-directory] or \\[ido-next-work-directory] go to previous/next directory in work directory history.
+\\[ido-merge-work-directories] search for file in the work directory history.
+\\[ido-forget-work-directory] removes current directory from the work directory history.
+\\[ido-prev-work-file] or \\[ido-next-work-file] cycle through the work file history.
+\\[ido-wide-find-file] and \\[ido-wide-find-dir] prompts and uses find to locate files or directories.
+\\[ido-make-directory] prompts for a directory to create in current directory.
+\\[ido-fallback-command] Fallback to non-ido version of current command.
+\\[ido-toggle-regexp] Toggle regexp searching.
+\\[ido-toggle-prefix] Toggle between substring and prefix matching.
+\\[ido-toggle-case] Toggle case-sensitive searching of file names.
+\\[ido-toggle-vc] Toggle version control for this file.
+\\[ido-toggle-literal] Toggle literal reading of this file.
+\\[ido-completion-help] Show list of matching files in separate window.
+\\[ido-toggle-ignore] Toggle ignoring files listed in `ido-ignore-files'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-find-file-other-window) "ido" "\
+Switch to another file and show it in another window.
+The file name is selected interactively by typing a substring.
+For details of keybindings, do `\\[describe-function] ido-find-file'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-find-alternate-file) "ido" "\
+Switch to another file and show it in another window.
+The file name is selected interactively by typing a substring.
+For details of keybindings, do `\\[describe-function] ido-find-file'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-find-file-read-only) "ido" "\
+Edit file read-only with name obtained via minibuffer.
+The file name is selected interactively by typing a substring.
+For details of keybindings, do `\\[describe-function] ido-find-file'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-find-file-read-only-other-window) "ido" "\
+Edit file read-only in other window with name obtained via minibuffer.
+The file name is selected interactively by typing a substring.
+For details of keybindings, do `\\[describe-function] ido-find-file'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-find-file-read-only-other-frame) "ido" "\
+Edit file read-only in other frame with name obtained via minibuffer.
+The file name is selected interactively by typing a substring.
+For details of keybindings, do `\\[describe-function] ido-find-file'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-display-file) "ido" "\
+Display a file in another window but don't select it.
+The file name is selected interactively by typing a substring.
+For details of keybindings, do `\\[describe-function] ido-find-file'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-find-file-other-frame) "ido" "\
+Switch to another file and show it in another frame.
+The file name is selected interactively by typing a substring.
+For details of keybindings, do `\\[describe-function] ido-find-file'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-write-file) "ido" "\
+Write current buffer to a file.
+The file name is selected interactively by typing a substring.
+For details of keybindings, do `\\[describe-function] ido-find-file'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-insert-file) "ido" "\
+Insert contents of file in current buffer.
+The file name is selected interactively by typing a substring.
+For details of keybindings, do `\\[describe-function] ido-find-file'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-dired) "ido" "\
+Call dired the ido way.
+The directory is selected interactively by typing a substring.
+For details of keybindings, do `\\[describe-function] ido-find-file'.
+
+\(fn)" t nil)
+
+(autoload (quote ido-read-file-name) "ido" "\
+Read file name, prompting with PROMPT and completing in directory DIR.
+See `read-file-name' for additional parameters.
+
+\(fn PROMPT &optional DIR DEFAULT-FILENAME MUSTMATCH INITIAL PREDICATE)" nil nil)
+
+(autoload (quote ido-read-directory-name) "ido" "\
+Read directory name, prompting with PROMPT and completing in directory DIR.
+See `read-file-name' for additional parameters.
+
+\(fn PROMPT &optional DIR DEFAULT-DIRNAME MUSTMATCH INITIAL)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (ielm) "ielm" "ielm.el" (15941 42953))
+;;; Generated autoloads from ielm.el
+ (add-hook 'same-window-buffer-names "*ielm*")
+
+(autoload (quote ielm) "ielm" "\
+Interactively evaluate Emacs Lisp expressions.
+Switches to the buffer `*ielm*', or creates it if it does not exist.
+
+\(fn)" t nil)
+
+;;;***
\f
;;;### (autoloads (defimage find-image remove-images insert-image
;;;;;; put-image create-image image-type-available-p image-type-from-file-header
-;;;;;; image-type-from-data) "image" "image.el" (15417 7401))
+;;;;;; image-type-from-data) "image" "image.el" (15941 42953))
;;; Generated autoloads from image.el
(autoload (quote image-type-from-data) "image" "\
Determine the image type from image data DATA.
Value is a symbol specifying the image type or nil if type cannot
-be determined." nil nil)
+be determined.
+
+\(fn DATA)" nil nil)
(autoload (quote image-type-from-file-header) "image" "\
Determine the type of image file FILE from its first few bytes.
Value is a symbol specifying the image type, or nil if type cannot
-be determined." nil nil)
+be determined.
+
+\(fn FILE)" nil nil)
(autoload (quote image-type-available-p) "image" "\
Value is non-nil if image type TYPE is available.
-Image types are symbols like `xbm' or `jpeg'." nil nil)
+Image types are symbols like `xbm' or `jpeg'.
+
+\(fn TYPE)" nil nil)
(autoload (quote create-image) "image" "\
Create an image.
Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
Optional PROPS are additional image attributes to assign to the image,
like, e.g. `:mask MASK'.
-Value is the image created, or nil if images of type TYPE are not supported." nil nil)
+Value is the image created, or nil if images of type TYPE are not supported.
+
+\(fn FILE-OR-DATA &optional TYPE DATA-P &rest PROPS)" nil nil)
(autoload (quote put-image) "image" "\
Put image IMAGE in front of POS in the current buffer.
AREA is where to display the image. AREA nil or omitted means
display it in the text area, a value of `left-margin' means
display it in the left marginal area, a value of `right-margin'
-means display it in the right marginal area." nil nil)
+means display it in the right marginal area.
+
+\(fn IMAGE POS &optional STRING AREA)" nil nil)
(autoload (quote insert-image) "image" "\
Insert IMAGE into current buffer at point.
AREA is where to display the image. AREA nil or omitted means
display it in the text area, a value of `left-margin' means
display it in the left marginal area, a value of `right-margin'
-means display it in the right marginal area." nil nil)
+means display it in the right marginal area.
+
+\(fn IMAGE &optional STRING AREA)" nil nil)
(autoload (quote remove-images) "image" "\
Remove images between START and END in BUFFER.
Remove only images that were put in BUFFER with calls to `put-image'.
-BUFFER nil or omitted means use the current buffer." nil nil)
+BUFFER nil or omitted means use the current buffer.
+
+\(fn START END &optional BUFFER)" nil nil)
(autoload (quote find-image) "image" "\
Find an image, choosing one of a list of image specifications.
specification to be returned. Return nil if no specification is
satisfied.
-The image is looked for first on `load-path' and then in `data-directory'." nil nil)
+The image is looked for first on `load-path' and then in `data-directory'.
+
+\(fn SPECS)" nil nil)
(autoload (quote defimage) "image" "\
Define SYMBOL as an image.
Example:
(defimage test-image ((:type xpm :file \"~/test1.xpm\")
- (:type xbm :file \"~/test1.xbm\")))" nil (quote macro))
+ (:type xbm :file \"~/test1.xbm\")))
+
+\(fn SYMBOL SPECS &optional DOC)" nil (quote macro))
;;;***
\f
;;;### (autoloads (auto-image-file-mode insert-image-file image-file-name-regexp
;;;;;; image-file-name-regexps image-file-name-extensions) "image-file"
-;;;;;; "image-file.el" (15425 28362))
+;;;;;; "image-file.el" (15829 28907))
;;; Generated autoloads from image-file.el
(defvar image-file-name-extensions (quote ("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm")) "\
`auto-image-file-mode' is re-enabled; this happens automatically when
the variable is set using \\[customize].")
+(custom-autoload (quote image-file-name-extensions) "image-file")
+
(defvar image-file-name-regexps nil "\
*List of regexps matching image-file filenames.
Filenames matching one of these regexps are considered image files,
`auto-image-file-mode' is re-enabled; this happens automatically when
the variable is set using \\[customize].")
+(custom-autoload (quote image-file-name-regexps) "image-file")
+
(autoload (quote image-file-name-regexp) "image-file" "\
-Return a regular expression matching image-file filenames." nil nil)
+Return a regular expression matching image-file filenames.
+
+\(fn)" nil nil)
(autoload (quote insert-image-file) "image-file" "\
Insert the image file FILE into the current buffer.
Optional arguments VISIT, BEG, END, and REPLACE are interpreted as for
-the command `insert-file-contents'." nil nil)
+the command `insert-file-contents'.
+
+\(fn FILE &optional VISIT BEG END REPLACE)" nil nil)
(defvar auto-image-file-mode nil "\
Non-nil if Auto-Image-File mode is enabled.
Setting this variable directly does not take effect;
use either \\[customize] or the function `auto-image-file-mode'.")
-(custom-add-to-group (quote image) (quote auto-image-file-mode) (quote custom-variable))
-
-(custom-add-load (quote auto-image-file-mode) (quote image-file))
+(custom-autoload (quote auto-image-file-mode) "image-file")
(autoload (quote auto-image-file-mode) "image-file" "\
Toggle visiting of image files as images.
Image files are those whose name has an extension in
`image-file-name-extensions', or matches a regexp in
-`image-file-name-regexps'." t nil)
+`image-file-name-regexps'.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (imenu imenu-add-menubar-index imenu-add-to-menubar
-;;;;;; imenu-sort-function) "imenu" "imenu.el" (15371 46416))
+;;;;;; imenu-sort-function) "imenu" "imenu.el" (16072 11522))
;;; Generated autoloads from imenu.el
(defvar imenu-sort-function nil "\
element should come before the second. The arguments are cons cells;
\(NAME . POSITION). Look at `imenu--sort-by-name' for an example.")
+(custom-autoload (quote imenu-sort-function) "imenu")
+
(defvar imenu-generic-expression nil "\
The regex pattern to use for creating a buffer index.
(autoload (quote imenu-add-to-menubar) "imenu" "\
Add an `imenu' entry to the menu bar for the current buffer.
NAME is a string used to name the menu bar item.
-See the command `imenu' for more information." t nil)
+See the command `imenu' for more information.
+
+\(fn NAME)" t nil)
(autoload (quote imenu-add-menubar-index) "imenu" "\
Add an Imenu \"Index\" entry on the menu bar for the current buffer.
-A trivial interface to `imenu-add-to-menubar' suitable for use in a hook." t nil)
+A trivial interface to `imenu-add-to-menubar' suitable for use in a hook.
+
+\(fn)" t nil)
(autoload (quote imenu) "imenu" "\
Jump to a place in the buffer chosen using a buffer menu or mouse menu.
INDEX-ITEM specifies the position. See `imenu-choose-buffer-index'
-for more information." t nil)
+for more information.
+
+\(fn INDEX-ITEM)" t nil)
;;;***
\f
--;;;### (autoloads (indian-char-glyph indian-glyph-char in-is13194-pre-write-conversion
++;;;### (autoloads (indian-2-column-to-ucs-region in-is13194-pre-write-conversion
;;;;;; in-is13194-post-read-conversion indian-compose-string indian-compose-region)
- ;;;;;; "ind-util" "language/ind-util.el" (16118 44435))
-;;;;;; "ind-util" "language/ind-util.el" (15597 13220))
++;;;;;; "ind-util" "language/ind-util.el" (16183 40136))
;;; Generated autoloads from language/ind-util.el
(autoload (quote indian-compose-region) "ind-util" "\
- Compose the region according to `composition-function-table'.
-Compose the region according to `composition-function-table'. " t nil)
++Compose the region according to `composition-function-table'.
+
+\(fn FROM TO)" t nil)
+
+(autoload (quote indian-compose-string) "ind-util" "\
+Not documented
+
+\(fn STRING)" nil nil)
-(autoload (quote indian-compose-string) "ind-util" nil nil nil)
+(autoload (quote in-is13194-post-read-conversion) "ind-util" "\
+Not documented
-(autoload (quote in-is13194-post-read-conversion) "ind-util" nil nil nil)
+\(fn LEN)" nil nil)
-(autoload (quote in-is13194-pre-write-conversion) "ind-util" nil nil nil)
+(autoload (quote in-is13194-pre-write-conversion) "ind-util" "\
+Not documented
-(autoload (quote indian-glyph-char) "ind-util" "\
-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'." nil nil)
+\(fn FROM TO)" nil nil)
- (autoload (quote indian-glyph-char) "ind-util" "\
- 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'.
-
- \(fn INDEX &optional SCRIPT)" nil nil)
-(autoload (quote indian-char-glyph) "ind-util" "\
-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'." nil nil)
++(autoload (quote indian-2-column-to-ucs-region) "ind-util" "\
++Convert old Emacs Devanagari characters to UCS.
+
- (autoload (quote indian-char-glyph) "ind-util" "\
- 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'.
-
- \(fn CHAR)" nil nil)
++\(fn FROM TO)" t nil)
;;;***
\f
;;;### (autoloads (inferior-lisp) "inf-lisp" "progmodes/inf-lisp.el"
-;;;;;; (15400 1480))
+;;;;;; (15678 51473))
;;; Generated autoloads from progmodes/inf-lisp.el
(defvar inferior-lisp-filter-regexp "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'" "\
With argument, allows you to edit the command line (default is value
of `inferior-lisp-program'). Runs the hooks from
`inferior-lisp-mode-hook' (after the `comint-mode-hook' is run).
-\(Type \\[describe-mode] in the process buffer for a list of commands.)" t nil)
+\(Type \\[describe-mode] in the process buffer for a list of commands.)
+
+\(fn CMD)" t nil)
(add-hook 'same-window-buffer-names "*inferior-lisp*")
(defalias (quote run-lisp) (quote inferior-lisp))
;;;***
\f
;;;### (autoloads (Info-speedbar-browser Info-goto-emacs-key-command-node
-;;;;;; Info-goto-emacs-command-node Info-directory info-standalone
-;;;;;; info info-other-window) "info" "info.el" (15417 7402))
+;;;;;; Info-goto-emacs-command-node Info-index Info-directory info-standalone
+;;;;;; info-emacs-manual info info-other-window) "info" "info.el"
+;;;;;; (16162 11942))
;;; Generated autoloads from info.el
(autoload (quote info-other-window) "info" "\
-Like `info' but show the Info buffer in another window." t nil)
+Like `info' but show the Info buffer in another window.
+
+\(fn &optional FILE)" t nil)
(add-hook 'same-window-buffer-names "*info*")
(autoload (quote info) "info" "\
The search path for Info files is in the variable `Info-directory-list'.
The top-level Info directory is made by combining all the files named `dir'
-in all the directories in that path." t nil)
+in all the directories in that path.
+
+\(fn &optional FILE)" t nil)
+
+(autoload (quote info-emacs-manual) "info" "\
+Display the Emacs manual in Info mode.
+
+\(fn)" t nil)
(autoload (quote info-standalone) "info" "\
Run Emacs as a standalone Info reader.
Usage: emacs -f info-standalone [filename]
-In standalone mode, \\<Info-mode-map>\\[Info-exit] exits Emacs itself." nil nil)
+In standalone mode, \\<Info-mode-map>\\[Info-exit] exits Emacs itself.
+
+\(fn)" nil nil)
(autoload (quote Info-directory) "info" "\
-Go to the Info directory node." t nil)
+Go to the Info directory node.
+
+\(fn)" t nil)
+
+(autoload (quote Info-index) "info" "\
+Look up a string TOPIC in the index for this file.
+The index is defined as the first node in the top level menu whose
+name contains the word \"Index\", plus any immediately following
+nodes whose names also contain the word \"Index\".
+If there are no exact matches to the specified topic, this chooses
+the first match which is a case-insensitive substring of a topic.
+Use the `,' command to see the other matches.
+Give a blank topic name to go to the Index node itself.
+
+\(fn TOPIC)" t nil)
(autoload (quote Info-goto-emacs-command-node) "info" "\
Go to the Info node in the Emacs manual for command COMMAND.
The command is found by looking up in Emacs manual's indices
or in another manual found via COMMAND's `info-file' property or
-the variable `Info-file-list-for-emacs'." t nil)
+the variable `Info-file-list-for-emacs'. COMMAND must be a symbol
+or string.
+
+\(fn COMMAND)" t nil)
(autoload (quote Info-goto-emacs-key-command-node) "info" "\
Go to the node in the Emacs manual which describes the command bound to KEY.
Interactively, if the binding is `execute-extended-command', a command is read.
The command is found by looking up in Emacs manual's indices
or in another manual found via COMMAND's `info-file' property or
-the variable `Info-file-list-for-emacs'." t nil)
+the variable `Info-file-list-for-emacs'.
+
+\(fn KEY)" t nil)
(autoload (quote Info-speedbar-browser) "info" "\
Initialize speedbar to display an info node browser.
-This will add a speedbar major display mode." t nil)
+This will add a speedbar major display mode.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (info-complete-file info-complete-symbol info-lookup-file
;;;;;; info-lookup-symbol info-lookup-reset) "info-look" "info-look.el"
-;;;;;; (15444 42462))
+;;;;;; (16111 41826))
;;; Generated autoloads from info-look.el
(autoload (quote info-lookup-reset) "info-look" "\
Throw away all cached data.
This command is useful if the user wants to start at the beginning without
quitting Emacs, for example, after some Info documents were updated on the
-system." t nil)
+system.
+
+\(fn)" t nil)
(autoload (quote info-lookup-symbol) "info-look" "\
Display the definition of SYMBOL, as found in the relevant manual.
into the minibuffer so you can edit it.
The default symbol is the one found at point.
-With prefix arg a query for the symbol help mode is offered." t nil)
+With prefix arg a query for the symbol help mode is offered.
+
+\(fn SYMBOL &optional MODE)" t nil)
(autoload (quote info-lookup-file) "info-look" "\
Display the documentation of a file.
into the minibuffer so you can edit it.
The default file name is the one found at point.
-With prefix arg a query for the file help mode is offered." t nil)
+With prefix arg a query for the file help mode is offered.
+
+\(fn FILE &optional MODE)" t nil)
(autoload (quote info-complete-symbol) "info-look" "\
-Perform completion on symbol preceding point." t nil)
+Perform completion on symbol preceding point.
+
+\(fn &optional MODE)" t nil)
(autoload (quote info-complete-file) "info-look" "\
-Perform completion on file preceding point." t nil)
+Perform completion on file preceding point.
+
+\(fn &optional MODE)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (info-xref-check-all info-xref-check) "info-xref"
+;;;;;; "info-xref.el" (15952 18239))
+;;; Generated autoloads from info-xref.el
+
+(autoload (quote info-xref-check) "info-xref" "\
+Check external references in FILENAME, an info document.
+
+\(fn FILENAME)" t nil)
+
+(autoload (quote info-xref-check-all) "info-xref" "\
+Check external references in all info documents in the usual path.
+The usual path is `Info-directory-list' and `Info-additional-directory-list'.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (batch-info-validate Info-validate Info-split Info-tagify)
-;;;;;; "informat" "informat.el" (15371 46416))
+;;;;;; "informat" "informat.el" (15941 42953))
;;; Generated autoloads from informat.el
(autoload (quote Info-tagify) "informat" "\
-Create or update Info file tag table in current buffer or in a region." t nil)
+Create or update Info file tag table in current buffer or in a region.
+
+\(fn &optional INPUT-BUFFER-NAME)" t nil)
(autoload (quote Info-split) "informat" "\
Split an info file into an indirect file plus bounded-size subfiles.
The subfiles are written in the same directory the original file is
in, with names generated by appending `-' and a number to the original
file name. The indirect file still functions as an Info file, but it
-contains just the tag table and a directory of subfiles." t nil)
+contains just the tag table and a directory of subfiles.
+
+\(fn)" t nil)
(autoload (quote Info-validate) "informat" "\
Check current buffer for validity as an Info file.
-Check that every node pointer points to an existing node." t nil)
+Check that every node pointer points to an existing node.
+
+\(fn)" t nil)
(autoload (quote batch-info-validate) "informat" "\
Runs `Info-validate' on the files remaining on the command line.
Must be used only with -batch, and kills Emacs on completion.
Each file will be processed even if an error occurred previously.
-For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"" nil nil)
+For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (isearch-process-search-multibyte-characters isearch-toggle-input-method
;;;;;; isearch-toggle-specified-input-method) "isearch-x" "international/isearch-x.el"
-;;;;;; (15371 46423))
+;;;;;; (15251 46612))
;;; Generated autoloads from international/isearch-x.el
(autoload (quote isearch-toggle-specified-input-method) "isearch-x" "\
-Select an input method and turn it on in interactive search." t nil)
+Select an input method and turn it on in interactive search.
+
+\(fn)" t nil)
(autoload (quote isearch-toggle-input-method) "isearch-x" "\
-Toggle input method in interactive search." t nil)
+Toggle input method in interactive search.
+
+\(fn)" t nil)
+
+(autoload (quote isearch-process-search-multibyte-characters) "isearch-x" "\
+Not documented
-(autoload (quote isearch-process-search-multibyte-characters) "isearch-x" nil nil nil)
+\(fn LAST-CHAR)" nil nil)
;;;***
\f
;;;### (autoloads (iso-accents-mode) "iso-acc" "international/iso-acc.el"
-;;;;;; (15455 18402))
+;;;;;; (15941 42961))
;;; Generated autoloads from international/iso-acc.el
(autoload (quote iso-accents-mode) "iso-acc" "\
~! gives an inverted exclamation mark.
~? gives an inverted question mark.
-With an argument, a positive argument enables ISO Accents mode,
-and a negative argument disables it." t nil)
+With an argument, a positive argument enables ISO Accents mode,
+and a negative argument disables it.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (iso-cvt-define-menu iso-cvt-write-only iso-cvt-read-only
;;;;;; iso-sgml2iso iso-iso2sgml iso-iso2duden iso-iso2gtex iso-gtex2iso
;;;;;; iso-tex2iso iso-iso2tex iso-german iso-spanish) "iso-cvt"
-;;;;;; "international/iso-cvt.el" (15371 46423))
+;;;;;; "international/iso-cvt.el" (15941 42961))
;;; Generated autoloads from international/iso-cvt.el
(autoload (quote iso-spanish) "iso-cvt" "\
Translate net conventions for Spanish to ISO 8859-1.
The region between FROM and TO is translated using the table TRANS-TAB.
-Optional arg BUFFER is ignored (for use in `format-alist')." t nil)
+Optional arg BUFFER is ignored (for use in `format-alist').
+
+\(fn FROM TO &optional BUFFER)" t nil)
(autoload (quote iso-german) "iso-cvt" "\
Translate net conventions for German to ISO 8859-1.
The region between FROM and TO is translated using the table TRANS-TAB.
-Optional arg BUFFER is ignored (for use in `format-alist')." t nil)
+Optional arg BUFFER is ignored (for use in `format-alist').
+
+\(fn FROM TO &optional BUFFER)" t nil)
(autoload (quote iso-iso2tex) "iso-cvt" "\
Translate ISO 8859-1 characters to TeX sequences.
The region between FROM and TO is translated using the table TRANS-TAB.
-Optional arg BUFFER is ignored (for use in `format-alist')." t nil)
+Optional arg BUFFER is ignored (for use in `format-alist').
+
+\(fn FROM TO &optional BUFFER)" t nil)
(autoload (quote iso-tex2iso) "iso-cvt" "\
Translate TeX sequences to ISO 8859-1 characters.
The region between FROM and TO is translated using the table TRANS-TAB.
-Optional arg BUFFER is ignored (for use in `format-alist')." t nil)
+Optional arg BUFFER is ignored (for use in `format-alist').
+
+\(fn FROM TO &optional BUFFER)" t nil)
(autoload (quote iso-gtex2iso) "iso-cvt" "\
Translate German TeX sequences to ISO 8859-1 characters.
The region between FROM and TO is translated using the table TRANS-TAB.
-Optional arg BUFFER is ignored (for use in `format-alist')." t nil)
+Optional arg BUFFER is ignored (for use in `format-alist').
+
+\(fn FROM TO &optional BUFFER)" t nil)
(autoload (quote iso-iso2gtex) "iso-cvt" "\
Translate ISO 8859-1 characters to German TeX sequences.
The region between FROM and TO is translated using the table TRANS-TAB.
-Optional arg BUFFER is ignored (for use in `format-alist')." t nil)
+Optional arg BUFFER is ignored (for use in `format-alist').
+
+\(fn FROM TO &optional BUFFER)" t nil)
(autoload (quote iso-iso2duden) "iso-cvt" "\
Translate ISO 8859-1 characters to German TeX sequences.
The region between FROM and TO is translated using the table TRANS-TAB.
-Optional arg BUFFER is ignored (for use in `format-alist')." t nil)
+Optional arg BUFFER is ignored (for use in `format-alist').
+
+\(fn FROM TO &optional BUFFER)" t nil)
(autoload (quote iso-iso2sgml) "iso-cvt" "\
Translate ISO 8859-1 characters in the region to SGML entities.
The entities used are from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\".
-Optional arg BUFFER is ignored (for use in `format-alist')." t nil)
+Optional arg BUFFER is ignored (for use in `format-alist').
+
+\(fn FROM TO &optional BUFFER)" t nil)
(autoload (quote iso-sgml2iso) "iso-cvt" "\
Translate SGML entities in the region to ISO 8859-1 characters.
The entities used are from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\".
-Optional arg BUFFER is ignored (for use in `format-alist')." t nil)
+Optional arg BUFFER is ignored (for use in `format-alist').
+
+\(fn FROM TO &optional BUFFER)" t nil)
(autoload (quote iso-cvt-read-only) "iso-cvt" "\
-Warn that format is read-only." t nil)
+Warn that format is read-only.
+
+\(fn)" t nil)
(autoload (quote iso-cvt-write-only) "iso-cvt" "\
-Warn that format is write-only." t nil)
+Warn that format is write-only.
+
+\(fn)" t nil)
(autoload (quote iso-cvt-define-menu) "iso-cvt" "\
-Add submenus to the Files menu, to convert to and from various formats." t nil)
+Add submenus to the Files menu, to convert to and from various formats.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads nil "iso-transl" "international/iso-transl.el"
-;;;;;; (15417 7424))
+;;;;;; (15941 42961))
;;; Generated autoloads from international/iso-transl.el
(or key-translation-map (setq key-translation-map (make-sparse-keymap)))
(define-key key-translation-map "\C-x8" 'iso-transl-ctl-x-8-map)
;;;;;; ispell-region ispell-change-dictionary ispell-kill-ispell
;;;;;; ispell-help ispell-pdict-save ispell-word ispell-dictionary-alist
;;;;;; ispell-local-dictionary-alist ispell-personal-dictionary)
-;;;;;; "ispell" "textmodes/ispell.el" (15471 40661))
+;;;;;; "ispell" "textmodes/ispell.el" (16174 61085))
;;; Generated autoloads from textmodes/ispell.el
-(defconst xemacsp (string-match "Lucid\\|XEmacs" emacs-version) "\
-Non nil if using XEmacs.")
-
(defvar ispell-personal-dictionary nil "\
*File name of your personal spelling dictionary, or nil.
If nil, the default personal dictionary, \"~/.ispell_DICTNAME\" is used,
where DICTNAME is the name of your default dictionary.")
+(custom-autoload (quote ispell-personal-dictionary) "ispell")
+
(defvar ispell-local-dictionary-alist nil "\
*Contains local or customized dictionary definitions.
-See `ispell-dictionary-alist'.")
-(setq ispell-dictionary-alist-1 (quote ((nil "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1) ("american" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1) ("brasileiro" "[A-Z\301\311\315\323\332\300\310\314\322\331\303\325\307\334\302\312\324a-z\341\351\355\363\372\340\350\354\362\371\343\365\347\374\342\352\364]" "[^A-Z\301\311\315\323\332\300\310\314\322\331\303\325\307\334\302\312\324a-z\341\351\355\363\372\340\350\354\362\371\343\365\347\374\342\352\364]" "[']" nil ("-d" "brasileiro") nil iso-8859-1) ("british" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B" "-d" "british") nil iso-8859-1) ("castellano" "[A-Z\301\311\315\321\323\332\334a-z\341\351\355\361\363\372\374]" "[^A-Z\301\311\315\321\323\332\334a-z\341\351\355\361\363\372\374]" "[-]" nil ("-B" "-d" "castellano") "~tex" iso-8859-1) ("castellano8" "[A-Z\301\311\315\321\323\332\334a-z\341\351\355\361\363\372\374]" "[^A-Z\301\311\315\321\323\332\334a-z\341\351\355\361\363\372\374]" "[-]" nil ("-B" "-d" "castellano") "~latin1" iso-8859-1))))
+These will override the values in `ispell-dictionary-alist'.
+
+Customization changes made to `ispell-dictionary-alist' will not operate
+over emacs sessions. To make permanent changes to your dictionary
+definitions, you will need to make your changes in this variable, save,
+and then re-start emacs.")
-(setq ispell-dictionary-alist-2 (quote (("czech" "[A-Za-z\301\311\314\315\323\332\331\335\256\251\310\330\317\253\322\341\351\354\355\363\372\371\375\276\271\350\370\357\273\362]" "[^A-Za-z\301\311\314\315\323\332\331\335\256\251\310\330\317\253\322\341\351\354\355\363\372\371\375\276\271\350\370\357\273\362]" "" nil ("-B" "-d" "czech") nil iso-8859-2) ("dansk" "[A-Z\306\330\305a-z\346\370\345]" "[^A-Z\306\330\305a-z\346\370\345]" "[']" nil ("-C") nil iso-8859-1) ("deutsch" "[a-zA-Z\"]" "[^a-zA-Z\"]" "[']" t ("-C") "~tex" iso-8859-1) ("deutsch8" "[a-zA-Z\304\326\334\344\366\337\374]" "[^a-zA-Z\304\326\334\344\366\337\374]" "[']" t ("-C" "-d" "deutsch") "~latin1" iso-8859-1) ("english" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1))))
+(custom-autoload (quote ispell-local-dictionary-alist) "ispell")
-(setq ispell-dictionary-alist-3 (quote (("esperanto" "[A-Za-z\246\254\266\274\306\330\335\336\346\370\375\376]" "[^A-Za-z\246\254\266\274\306\330\335\336\346\370\375\376]" "[-']" t ("-C") "~latin3" iso-8859-1) ("esperanto-tex" "[A-Za-z^\\]" "[^A-Za-z^\\]" "[-'`\"]" t ("-C" "-d" "esperanto") "~tex" iso-8859-1) ("francais7" "[A-Za-z]" "[^A-Za-z]" "[`'^---]" t nil nil iso-8859-1) ("francais" "[A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374]" "[^A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374]" "[-']" t nil "~list" iso-8859-1))))
+(setq ispell-dictionary-alist-1 (quote ((nil "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1) ("american" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1) ("brasileiro" "[A-Z\301\311\315\323\332\300\310\314\322\331\303\325\307\334\302\312\324a-z\341\351\355\363\372\340\350\354\362\371\343\365\347\374\342\352\364]" "[^A-Z\301\311\315\323\332\300\310\314\322\331\303\325\307\334\302\312\324a-z\341\351\355\363\372\340\350\354\362\371\343\365\347\374\342\352\364]" "[']" nil nil nil iso-8859-1) ("british" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1) ("castellano" "[A-Z\301\311\315\321\323\332\334a-z\341\351\355\361\363\372\374]" "[^A-Z\301\311\315\321\323\332\334a-z\341\351\355\361\363\372\374]" "[-]" nil ("-B") "~tex" iso-8859-1) ("castellano8" "[A-Z\301\311\315\321\323\332\334a-z\341\351\355\361\363\372\374]" "[^A-Z\301\311\315\321\323\332\334a-z\341\351\355\361\363\372\374]" "[-]" nil ("-B" "-d" "castellano") "~latin1" iso-8859-1))))
-(setq ispell-dictionary-alist-4 (quote (("francais-tex" "[A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374\\]" "[^A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374\\]" "[-'^`\"]" t nil "~tex" iso-8859-1) ("german" "[a-zA-Z\"]" "[^a-zA-Z\"]" "[']" t ("-C") "~tex" iso-8859-1) ("german8" "[a-zA-Z\304\326\334\344\366\337\374]" "[^a-zA-Z\304\326\334\344\366\337\374]" "[']" t ("-C" "-d" "german") "~latin1" iso-8859-1) ("italiano" "[A-Z\300\301\310\311\314\315\322\323\331\332a-z\340\341\350\351\354\355\363\371\372]" "[^A-Z\300\301\310\311\314\315\322\323\331\332a-z\340\341\350\351\354\355\363\371\372]" "[-]" nil ("-B" "-d" "italian") "~tex" iso-8859-1))))
+(setq ispell-dictionary-alist-2 (quote (("czech" "[A-Za-z\301\311\314\315\323\332\331\335\256\251\310\330\317\253\322\341\351\354\355\363\372\371\375\276\271\350\370\357\273\362]" "[^A-Za-z\301\311\314\315\323\332\331\335\256\251\310\330\317\253\322\341\351\354\355\363\372\371\375\276\271\350\370\357\273\362]" "" nil ("-B") nil iso-8859-2) ("dansk" "[A-Z\306\330\305a-z\346\370\345]" "[^A-Z\306\330\305a-z\346\370\345]" "[']" nil ("-C") nil iso-8859-1) ("deutsch" "[a-zA-Z\"]" "[^a-zA-Z\"]" "[']" t ("-C") "~tex" iso-8859-1) ("deutsch8" "[a-zA-Z\304\326\334\344\366\337\374]" "[^a-zA-Z\304\326\334\344\366\337\374]" "[']" t ("-C" "-d" "deutsch") "~latin1" iso-8859-1) ("english" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil iso-8859-1))))
-(setq ispell-dictionary-alist-5 (quote (("nederlands" "[A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]" "[^A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]" "[']" t ("-C") nil iso-8859-1) ("nederlands8" "[A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]" "[^A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]" "[']" t ("-C") nil iso-8859-1) ("norsk" "[A-Za-z\305\306\307\310\311\322\324\330\345\346\347\350\351\362\364\370]" "[^A-Za-z\305\306\307\310\311\322\324\330\345\346\347\350\351\362\364\370]" "[\"]" nil ("-d" "norsk") "~list" iso-8859-1) ("norsk7-tex" "[A-Za-z{}\\'^`]" "[^A-Za-z{}\\'^`]" "[\"]" nil ("-d" "norsk") "~plaintex" iso-8859-1))))
+(setq ispell-dictionary-alist-3 (quote (("esperanto" "[A-Za-z\246\254\266\274\306\330\335\336\346\370\375\376]" "[^A-Za-z\246\254\266\274\306\330\335\336\346\370\375\376]" "[-']" t ("-C") "~latin3" iso-8859-1) ("esperanto-tex" "[A-Za-z^\\]" "[^A-Za-z^\\]" "[-'`\"]" t ("-C" "-d" "esperanto") "~tex" iso-8859-1) ("francais7" "[A-Za-z]" "[^A-Za-z]" "[`'^---]" t nil nil iso-8859-1) ("francais" "[A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374]" "[^A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374]" "[-']" t nil "~list" iso-8859-1) ("francais-tex" "[A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374\\]" "[^A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374\\]" "[-'^`\"]" t nil "~tex" iso-8859-1))))
-(setq ispell-dictionary-alist-6 (quote (("polish" "[A-Za-z\241\243\246\254\257\261\263\266\274\277\306\312\321\323\346\352\361\363]" "[^A-Za-z\241\243\246\254\257\261\263\266\274\277\306\312\321\323\346\352\361\363]" "" nil ("-d" "polish") nil iso-8859-2) ("russian" "[\341\342\367\347\344\345\263\366\372\351\352\353\354\355\356\357\360\362\363\364\365\346\350\343\376\373\375\370\371\377\374\340\361\301\302\327\307\304\305\243\326\332\311\312\313\314\315\316\317\320\322\323\324\325\306\310\303\336\333\335\330\331\337\334\300\321]" "[^\341\342\367\347\344\345\263\366\372\351\352\353\354\355\356\357\360\362\363\364\365\346\350\343\376\373\375\370\371\377\374\340\361\301\302\327\307\304\305\243\326\332\311\312\313\314\315\316\317\320\322\323\324\325\306\310\303\336\333\335\330\331\337\334\300\321]" "" nil ("-d" "russian") nil koi8-r) ("svenska" "[A-Za-z\345\344\366\351\340\374\350\346\370\347\305\304\326\311\300\334\310\306\330\307]" "[^A-Za-z\345\344\366\351\340\374\350\346\370\347\305\304\326\311\300\334\310\306\330\307]" "[']" nil ("-C") "~list" iso-8859-1) ("portugues" "[a-zA-Z\301\302\311\323\340\341\342\351\352\355\363\343\372]" "[^a-zA-Z\301\302\311\323\340\341\342\351\352\355\363\343\372]" "[']" t ("-C" "-d" "portugues") "~latin1" iso-8859-1) ("slovak" "[A-Za-z\301\304\311\315\323\332\324\300\305\245\335\256\251\310\317\253\322\341\344\351\355\363\372\364\340\345\265\375\276\271\350\357\273\362]" "[^A-Za-z\301\304\311\315\323\332\324\300\305\245\335\256\251\310\317\253\322\341\344\351\355\363\372\364\340\345\265\375\276\271\350\357\273\362]" "" nil ("-B" "-d" "slovak") nil iso-8859-2))))
+(setq ispell-dictionary-alist-4 (quote (("german" "[a-zA-Z\"]" "[^a-zA-Z\"]" "[']" t ("-C") "~tex" iso-8859-1) ("german8" "[a-zA-Z\304\326\334\344\366\337\374]" "[^a-zA-Z\304\326\334\344\366\337\374]" "[']" t ("-C" "-d" "german") "~latin1" iso-8859-1) ("italiano" "[A-Z\300\301\310\311\314\315\322\323\331\332a-z\340\341\350\351\354\355\363\371\372]" "[^A-Z\300\301\310\311\314\315\322\323\331\332a-z\340\341\350\351\354\355\363\371\372]" "[-]" nil ("-B" "-d" "italian") "~tex" iso-8859-1) ("nederlands" "[A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]" "[^A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]" "[']" t ("-C") nil iso-8859-1) ("nederlands8" "[A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]" "[^A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]" "[']" t ("-C") nil iso-8859-1))))
+
+(setq ispell-dictionary-alist-5 (quote (("norsk" "[A-Za-z\305\306\307\310\311\322\324\330\345\346\347\350\351\362\364\370]" "[^A-Za-z\305\306\307\310\311\322\324\330\345\346\347\350\351\362\364\370]" "[\"]" nil nil "~list" iso-8859-1) ("norsk7-tex" "[A-Za-z{}\\'^`]" "[^A-Za-z{}\\'^`]" "[\"]" nil ("-d" "norsk") "~plaintex" iso-8859-1) ("polish" "[A-Za-z\241\243\246\254\257\261\263\266\274\277\306\312\321\323\346\352\361\363]" "[^A-Za-z\241\243\246\254\257\261\263\266\274\277\306\312\321\323\346\352\361\363]" "" nil nil nil iso-8859-2) ("portugues" "[a-zA-Z\301\302\311\323\340\341\342\351\352\355\363\343\372]" "[^a-zA-Z\301\302\311\323\340\341\342\351\352\355\363\343\372]" "[']" t ("-C") "~latin1" iso-8859-1))))
+
+(setq ispell-dictionary-alist-6 (quote (("russian" "[\341\342\367\347\344\345\263\366\372\351\352\353\354\355\356\357\360\362\363\364\365\346\350\343\376\373\375\370\371\377\374\340\361\301\302\327\307\304\305\243\326\332\311\312\313\314\315\316\317\320\322\323\324\325\306\310\303\336\333\335\330\331\337\334\300\321]" "[^\341\342\367\347\344\345\263\366\372\351\352\353\354\355\356\357\360\362\363\364\365\346\350\343\376\373\375\370\371\377\374\340\361\301\302\327\307\304\305\243\326\332\311\312\313\314\315\316\317\320\322\323\324\325\306\310\303\336\333\335\330\331\337\334\300\321]" "" nil nil nil koi8-r) ("slovak" "[A-Za-z\301\304\311\315\323\332\324\300\305\245\335\256\251\310\317\253\322\341\344\351\355\363\372\364\340\345\265\375\276\271\350\357\273\362]" "[^A-Za-z\301\304\311\315\323\332\324\300\305\245\335\256\251\310\317\253\322\341\344\351\355\363\372\364\340\345\265\375\276\271\350\357\273\362]" "" nil ("-B") nil iso-8859-2) ("svenska" "[A-Za-z\345\344\366\351\340\374\350\346\370\347\305\304\326\311\300\334\310\306\330\307]" "[^A-Za-z\345\344\366\351\340\374\350\346\370\347\305\304\326\311\300\334\310\306\330\307]" "[']" nil ("-C") "~list" iso-8859-1))))
(defvar ispell-dictionary-alist (append ispell-local-dictionary-alist ispell-dictionary-alist-1 ispell-dictionary-alist-2 ispell-dictionary-alist-3 ispell-dictionary-alist-4 ispell-dictionary-alist-5 ispell-dictionary-alist-6) "\
An alist of dictionaries and their associated parameters.
contain the same character set as casechars and otherchars in the
LANGUAGE.aff file (e.g., english.aff).")
+(custom-autoload (quote ispell-dictionary-alist) "ispell")
+
(defvar ispell-menu-map nil "\
Key map for ispell menu.")
If nil when package is loaded, a standard menu will be set,
and added as a submenu of the \"Edit\" menu.")
-(defvar ispell-menu-map-needed (and (not ispell-menu-map) (not xemacsp) (quote reload)))
+(defvar ispell-menu-map-needed (and (not ispell-menu-map) (not (featurep (quote xemacs))) (quote reload)))
-(if (and ispell-menu-map-needed (or (not (fboundp (quote byte-compiling-files-p))) (not (byte-compiling-files-p)))) (let ((dicts (reverse (cons (cons "default" nil) ispell-dictionary-alist))) (path (and (boundp (quote ispell-library-path)) ispell-library-path)) name load-dict) (setq ispell-menu-map (make-sparse-keymap "Spell")) (while dicts (setq name (car (car dicts)) load-dict (car (cdr (member "-d" (nth 5 (car dicts))))) dicts (cdr dicts)) (cond ((not (stringp name)) (define-key ispell-menu-map (vector (quote default)) (cons "Select Default Dict" (cons "Dictionary for which Ispell was configured" (list (quote lambda) nil (quote (interactive)) (list (quote ispell-change-dictionary) "default")))))) ((or (not path) (file-exists-p (concat path "/" name ".hash")) (file-exists-p (concat path "/" name ".has")) (and load-dict (or (file-exists-p (concat path "/" load-dict ".hash")) (file-exists-p (concat path "/" load-dict ".has"))))) (define-key ispell-menu-map (vector (intern name)) (cons (concat "Select " (capitalize name) " Dict") (list (quote lambda) nil (quote (interactive)) (list (quote ispell-change-dictionary) name)))))))))
+(if ispell-menu-map-needed (let ((dicts (if (fboundp (quote ispell-valid-dictionary-list)) (ispell-valid-dictionary-list) (mapcar (lambda (x) (or (car x) "default")) ispell-dictionary-alist))) (dict-map (make-sparse-keymap "Dictionaries"))) (setq ispell-menu-map (make-sparse-keymap "Spell")) (if (not dicts) (define-key ispell-menu-map [default] (quote ("Select Default Dict" "Dictionary for which Ispell was configured" lambda nil (interactive) (ispell-change-dictionary "default"))))) (fset (quote ispell-dict-map) dict-map) (define-key ispell-menu-map [dictionaries] (\` (menu-item "Select Dict" ispell-dict-map))) (dolist (name dicts) (define-key dict-map (vector (intern name)) (cons (concat "Select " (capitalize name) " Dict") (\` (lambda nil (interactive) (ispell-change-dictionary (\, name)))))))))
-(if (and ispell-menu-map-needed (or (not (fboundp (quote byte-compiling-files-p))) (not (byte-compiling-files-p)))) (progn (define-key ispell-menu-map [ispell-change-dictionary] (quote (menu-item "Change Dictionary..." ispell-change-dictionary :help "Supply explicit path to dictionary"))) (define-key ispell-menu-map [ispell-kill-ispell] (quote (menu-item "Kill Process" ispell-kill-ispell :enable (and (boundp (quote ispell-process)) ispell-process (eq (ispell-process-status) (quote run))) :help "Terminate Ispell subprocess"))) (define-key ispell-menu-map [ispell-pdict-save] (quote (menu-item "Save Dictionary" (lambda nil (interactive) (ispell-pdict-save t t)) :help "Save personal dictionary"))) (define-key ispell-menu-map [ispell-customize] (quote (menu-item "Customize..." (lambda nil (interactive) (customize-group (quote ispell))) :help "Customize spell checking options"))) (define-key ispell-menu-map [ispell-help] (quote (menu-item "Help" (lambda nil (interactive) (describe-function (quote ispell-help))) :help "Show standard Ispell keybindings and commands"))) (define-key ispell-menu-map [flyspell-mode] (quote (menu-item "Automatic spell checking (Flyspell)" flyspell-mode :help "Check spelling while you edit the text" :button (:toggle . flyspell-mode)))) (define-key ispell-menu-map [ispell-complete-word] (quote (menu-item "Complete Word" ispell-complete-word :help "Complete word at cursor using dictionary"))) (define-key ispell-menu-map [ispell-complete-word-interior-frag] (quote (menu-item "Complete Word Fragment" ispell-complete-word-interior-frag :help "Complete word fragment at cursor")))))
+(if ispell-menu-map-needed (progn (define-key ispell-menu-map [ispell-change-dictionary] (quote (menu-item "Change Dictionary..." ispell-change-dictionary :help "Supply explicit dictionary file name"))) (define-key ispell-menu-map [ispell-kill-ispell] (quote (menu-item "Kill Process" ispell-kill-ispell :enable (and (boundp (quote ispell-process)) ispell-process (eq (ispell-process-status) (quote run))) :help "Terminate Ispell subprocess"))) (define-key ispell-menu-map [ispell-pdict-save] (quote (menu-item "Save Dictionary" (lambda nil (interactive) (ispell-pdict-save t t)) :help "Save personal dictionary"))) (define-key ispell-menu-map [ispell-customize] (quote (menu-item "Customize..." (lambda nil (interactive) (customize-group (quote ispell))) :help "Customize spell checking options"))) (define-key ispell-menu-map [ispell-help] (quote (menu-item "Help" (lambda nil (interactive) (describe-function (quote ispell-help))) :help "Show standard Ispell keybindings and commands"))) (define-key ispell-menu-map [flyspell-mode] (quote (menu-item "Automatic spell checking (Flyspell)" flyspell-mode :help "Check spelling while you edit the text" :button (:toggle . flyspell-mode)))) (define-key ispell-menu-map [ispell-complete-word] (quote (menu-item "Complete Word" ispell-complete-word :help "Complete word at cursor using dictionary"))) (define-key ispell-menu-map [ispell-complete-word-interior-frag] (quote (menu-item "Complete Word Fragment" ispell-complete-word-interior-frag :help "Complete word fragment at cursor")))))
-(if (and ispell-menu-map-needed (or (not (fboundp (quote byte-compiling-files-p))) (not (byte-compiling-files-p)))) (progn (define-key ispell-menu-map [ispell-continue] (quote (menu-item "Continue Spell-Checking" ispell-continue :enable (and (boundp (quote ispell-region-end)) (marker-position ispell-region-end) (equal (marker-buffer ispell-region-end) (current-buffer))) :help "Continue spell checking last region"))) (define-key ispell-menu-map [ispell-word] (quote (menu-item "Spell-Check Word" ispell-word :help "Spell-check word at cursor"))) (define-key ispell-menu-map [ispell-comments-and-strings] (quote (menu-item "Spell-Check Comments" ispell-comments-and-strings :help "Spell-check only comments and strings")))))
+(if ispell-menu-map-needed (progn (define-key ispell-menu-map [ispell-continue] (quote (menu-item "Continue Spell-Checking" ispell-continue :enable (and (boundp (quote ispell-region-end)) (marker-position ispell-region-end) (equal (marker-buffer ispell-region-end) (current-buffer))) :help "Continue spell checking last region"))) (define-key ispell-menu-map [ispell-word] (quote (menu-item "Spell-Check Word" ispell-word :help "Spell-check word at cursor"))) (define-key ispell-menu-map [ispell-comments-and-strings] (quote (menu-item "Spell-Check Comments" ispell-comments-and-strings :help "Spell-check only comments and strings")))))
-(if (and ispell-menu-map-needed (or (not (fboundp (quote byte-compiling-files-p))) (not (byte-compiling-files-p)))) (progn (define-key ispell-menu-map [ispell-region] (quote (menu-item "Spell-Check Region" ispell-region :enable mark-active :help "Spell-check text in marked region"))) (define-key ispell-menu-map [ispell-message] (quote (menu-item "Spell-Check Message" ispell-message :help "Skip headers and included message text"))) (define-key ispell-menu-map [ispell-buffer] (quote (menu-item "Spell-Check Buffer" ispell-buffer :help "Check spelling of selected buffer"))) (fset (quote ispell-menu-map) (symbol-value (quote ispell-menu-map)))))
+(if ispell-menu-map-needed (progn (define-key ispell-menu-map [ispell-region] (quote (menu-item "Spell-Check Region" ispell-region :enable mark-active :help "Spell-check text in marked region"))) (define-key ispell-menu-map [ispell-message] (quote (menu-item "Spell-Check Message" ispell-message :help "Skip headers and included message text"))) (define-key ispell-menu-map [ispell-buffer] (quote (menu-item "Spell-Check Buffer" ispell-buffer :help "Check spelling of selected buffer"))) (fset (quote ispell-menu-map) (symbol-value (quote ispell-menu-map)))))
-(defvar ispell-skip-region-alist (quote ((ispell-words-keyword forward-line) (ispell-dictionary-keyword forward-line) (ispell-pdict-keyword forward-line) (ispell-parsing-keyword forward-line) ("^---*BEGIN PGP [A-Z ]*--*" . "^---*END PGP [A-Z ]*--*") ("^---* \\(Start of \\)?[Ff]orwarded [Mm]essage" . "^---* End of [Ff]orwarded [Mm]essage") ("\\(-+\\|\\(/\\|\\(\\(\\w\\|[-_]\\)+[.:@]\\)\\)\\(\\w\\|[-_]\\)*\\([.:/@]+\\(\\w\\|[-_]\\|~\\)+\\)+\\)"))) "\
+(defvar ispell-skip-region-alist (quote ((ispell-words-keyword forward-line) (ispell-dictionary-keyword forward-line) (ispell-pdict-keyword forward-line) (ispell-parsing-keyword forward-line) ("^---*BEGIN PGP [A-Z ]*--*" . "^---*END PGP [A-Z ]*--*") ("^begin [0-9][0-9][0-9] [^ ]+$" . "\nend\n") ("^%!PS-Adobe-[123].0" . "\n%%EOF\n") ("^---* \\(Start of \\)?[Ff]orwarded [Mm]essage" . "^---* End of [Ff]orwarded [Mm]essage") ("\\(--+\\|\\(/\\w\\|\\(\\(\\w\\|[-_]\\)+[.:@]\\)\\)\\(\\w\\|[-_]\\)*\\([.:/@]+\\(\\w\\|[-_~=?&]\\)+\\)+\\)"))) "\
Alist expressing beginning and end of regions not to spell check.
The alist key must be a regular expression.
Valid forms include:
Delete or add any regions you want to be automatically selected
for skipping in latex mode.")
-(define-key esc-map "$" (quote ispell-word))
+(defvar ispell-html-skip-alists (quote (("<[cC][oO][dD][eE]\\>[^>]*>" "</[cC][oO][dD][eE]*>") ("<[sS][cC][rR][iI][pP][tT]\\>[^>]*>" "</[sS][cC][rR][iI][pP][tT]>") ("<[aA][pP][pP][lL][eE][tT]\\>[^>]*>" "</[aA][pP][pP][lL][eE][tT]>") ("<[vV][eE][rR][bB]\\>[^>]*>" "<[vV][eE][rR][bB]\\>[^>]*>") ("<[tT][tT]/" "/") ("<[^ \n>]" ">") ("&[^ \n;]" "[; \n]"))) "\
+*Lists of start and end keys to skip in HTML buffers.
+Same format as `ispell-skip-region-alist'
+Note - substrings of other matches must come last
+ (e.g. \"<[tT][tT]/\" and \"<[^
+>]\").")
+ (define-key esc-map "$" 'ispell-word)
(autoload (quote ispell-word) "ispell" "\
Check spelling of word under or before the cursor.
or \\[ispell-region] to update the Ispell process.
return values:
-nil word is correct or spelling is accpeted.
+nil word is correct or spelling is accepted.
0 word is inserted into buffer-local definitions.
\"word\" word corrected from word list.
\(\"word\" arg) word is hand entered.
-quit spell session exited." t nil)
+quit spell session exited.
+
+\(fn &optional FOLLOWING QUIETLY CONTINUE)" t nil)
(autoload (quote ispell-pdict-save) "ispell" "\
Check to see if the personal dictionary has been modified.
-If so, ask if it needs to be saved." t nil)
+If so, ask if it needs to be saved.
+
+\(fn &optional NO-QUERY FORCE-SAVE)" t nil)
(autoload (quote ispell-help) "ispell" "\
Display a list of the options available when a misspelling is encountered.
`m': Place typed-in value in personal dictionary, then recheck current word.
`C-l': redraws screen
`C-r': recursive edit
-`C-z': suspend emacs or iconify frame" nil nil)
+`C-z': suspend emacs or iconify frame
+
+\(fn)" nil nil)
(autoload (quote ispell-kill-ispell) "ispell" "\
Kill current Ispell process (so that you may start a fresh one).
-With NO-ERROR, just return non-nil if there was no Ispell running." t nil)
+With NO-ERROR, just return non-nil if there was no Ispell running.
+
+\(fn &optional NO-ERROR)" t nil)
(autoload (quote ispell-change-dictionary) "ispell" "\
Change `ispell-dictionary' (q.v.) to DICT and kill old Ispell process.
By just answering RET you can find out what the current dictionary is.
-With prefix argument, set the default dictionary." t nil)
+With prefix argument, set the default dictionary.
+
+\(fn DICT &optional ARG)" t nil)
(autoload (quote ispell-region) "ispell" "\
Interactively check a region for spelling errors.
Return nil if spell session is quit,
- otherwise returns shift offset amount for last line processed." t nil)
+ otherwise returns shift offset amount for last line processed.
+
+\(fn REG-START REG-END &optional RECHECKP SHIFT)" t nil)
(autoload (quote ispell-comments-and-strings) "ispell" "\
-Check comments and strings in the current buffer for spelling errors." t nil)
+Check comments and strings in the current buffer for spelling errors.
+
+\(fn)" t nil)
(autoload (quote ispell-buffer) "ispell" "\
-Check the current buffer for spelling errors interactively." t nil)
+Check the current buffer for spelling errors interactively.
+
+\(fn)" t nil)
(autoload (quote ispell-continue) "ispell" "\
-Continue a halted spelling session beginning with the current word." t nil)
+Continue a halted spelling session beginning with the current word.
+
+\(fn)" t nil)
(autoload (quote ispell-complete-word) "ispell" "\
Try to complete the word before or under point (see `lookup-words').
If optional INTERIOR-FRAG is non-nil then the word may be a character
sequence inside of a word.
-Standard ispell choices are then available." t nil)
+Standard ispell choices are then available.
+
+\(fn &optional INTERIOR-FRAG)" t nil)
(autoload (quote ispell-complete-word-interior-frag) "ispell" "\
-Completes word matching character sequence inside a word." t nil)
+Completes word matching character sequence inside a word.
+
+\(fn)" t nil)
(autoload (quote ispell) "ispell" "\
Interactively check a region or buffer for spelling errors.
Ispell dictionaries are not distributed with Emacs. If you are
looking for a dictionary, please see the distribution of the GNU ispell
program, or do an Internet search; there are various dictionaries
-available on the net." t nil)
+available on the net.
+
+\(fn)" t nil)
(autoload (quote ispell-minor-mode) "ispell" "\
Toggle Ispell minor mode.
warns you if the previous word is incorrectly spelled.
All the buffer-local variables and dictionaries are ignored -- to read
-them into the running ispell process, type \\[ispell-word] SPC." t nil)
+them into the running ispell process, type \\[ispell-word] SPC.
+
+\(fn &optional ARG)" t nil)
(autoload (quote ispell-message) "ispell" "\
Check the spelling of a mail message or news post.
You can bind this to the key C-c i in GNUS or mail by adding to
`news-reply-mode-hook' or `mail-mode-hook' the following lambda expression:
- (function (lambda () (local-set-key \"\\C-ci\" 'ispell-message)))" t nil)
+ (function (lambda () (local-set-key \"\\C-ci\" 'ispell-message)))
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (iswitchb-mode iswitchb-buffer-other-frame iswitchb-display-buffer
;;;;;; iswitchb-buffer-other-window iswitchb-buffer iswitchb-default-keybindings
-;;;;;; iswitchb-read-buffer) "iswitchb" "iswitchb.el" (15391 60517))
+;;;;;; iswitchb-read-buffer) "iswitchb" "iswitchb.el" (16131 19788))
;;; Generated autoloads from iswitchb.el
(autoload (quote iswitchb-read-buffer) "iswitchb" "\
Return the name of a buffer selected.
PROMPT is the prompt to give to the user. DEFAULT if given is the default
buffer to be selected, which will go to the front of the list.
-If REQUIRE-MATCH is non-nil, an existing-buffer must be selected." nil nil)
+If REQUIRE-MATCH is non-nil, an existing-buffer must be selected.
+
+\(fn PROMPT &optional DEFAULT REQUIRE-MATCH)" nil nil)
(autoload (quote iswitchb-default-keybindings) "iswitchb" "\
Set up default keybindings for `iswitchb-buffer'.
Call this function to override the normal bindings. This function also
adds a hook to the minibuffer.
-Obsolescent. Use `iswitchb-mode'." t nil)
+Obsolescent. Use `iswitchb-mode'.
+
+\(fn)" t nil)
(autoload (quote iswitchb-buffer) "iswitchb" "\
Switch to another buffer.
buffer is displayed according to `iswitchb-default-method' -- the
default is to show it in the same window, unless it is already visible
in another frame.
-For details of keybindings, do `\\[describe-function] iswitchb'." t nil)
+For details of keybindings, do `\\[describe-function] iswitchb'.
+
+\(fn)" t nil)
(autoload (quote iswitchb-buffer-other-window) "iswitchb" "\
Switch to another buffer and show it in another window.
The buffer name is selected interactively by typing a substring.
-For details of keybindings, do `\\[describe-function] iswitchb'." t nil)
+For details of keybindings, do `\\[describe-function] iswitchb'.
+
+\(fn)" t nil)
(autoload (quote iswitchb-display-buffer) "iswitchb" "\
Display a buffer in another window but don't select it.
The buffer name is selected interactively by typing a substring.
-For details of keybindings, do `\\[describe-function] iswitchb'." t nil)
+For details of keybindings, do `\\[describe-function] iswitchb'.
+
+\(fn)" t nil)
(autoload (quote iswitchb-buffer-other-frame) "iswitchb" "\
Switch to another buffer and show it in another frame.
The buffer name is selected interactively by typing a substring.
-For details of keybindings, do `\\[describe-function] iswitchb'." t nil)
+For details of keybindings, do `\\[describe-function] iswitchb'.
+
+\(fn)" t nil)
(defvar iswitchb-mode nil "\
Non-nil if Iswitchb mode is enabled.
Setting this variable directly does not take effect;
use either \\[customize] or the function `iswitchb-mode'.")
-(custom-add-to-group (quote iswitchb) (quote iswitchb-mode) (quote custom-variable))
-
-(custom-add-load (quote iswitchb-mode) (quote iswitchb))
+(custom-autoload (quote iswitchb-mode) "iswitchb")
(autoload (quote iswitchb-mode) "iswitchb" "\
Toggle Iswitchb global minor mode.
With arg, turn Iswitchb mode on if and only iff ARG is positive.
This mode enables switching between buffers using substrings. See
-`iswitchb' for details." t nil)
+`iswitchb' for details.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (read-hiragana-string japanese-zenkaku-region japanese-hankaku-region
;;;;;; japanese-hiragana-region japanese-katakana-region japanese-zenkaku
;;;;;; japanese-hankaku japanese-hiragana japanese-katakana setup-japanese-environment-internal)
-;;;;;; "japan-util" "language/japan-util.el" (15371 46423))
+;;;;;; "japan-util" "language/japan-util.el" (16118 44435))
;;; Generated autoloads from language/japan-util.el
-(autoload (quote setup-japanese-environment-internal) "japan-util" nil nil nil)
+(autoload (quote setup-japanese-environment-internal) "japan-util" "\
+Not documented
+
+\(fn)" nil nil)
(autoload (quote japanese-katakana) "japan-util" "\
Convert argument to Katakana and return that.
Optional argument HANKAKU t means to convert to `hankaku' Katakana
(`japanese-jisx0201-kana'), in which case return value
may be a string even if OBJ is a character if two Katakanas are
- necessary to represent OBJ." nil nil)
+ necessary to represent OBJ.
+
+\(fn OBJ &optional HANKAKU)" nil nil)
(autoload (quote japanese-hiragana) "japan-util" "\
Convert argument to Hiragana and return that.
The argument may be a character or string. The result has the same type.
-The argument object is not altered--the value is a copy." nil nil)
+The argument object is not altered--the value is a copy.
+
+\(fn OBJ)" nil nil)
(autoload (quote japanese-hankaku) "japan-util" "\
Convert argument to `hankaku' and return that.
The argument may be a character or string. The result has the same type.
The argument object is not altered--the value is a copy.
-Optional argument ASCII-ONLY non-nil means to return only ASCII character." nil nil)
+Optional argument ASCII-ONLY non-nil means to return only ASCII character.
+
+\(fn OBJ &optional ASCII-ONLY)" nil nil)
(autoload (quote japanese-zenkaku) "japan-util" "\
Convert argument to `zenkaku' and return that.
The argument may be a character or string. The result has the same type.
-The argument object is not altered--the value is a copy." nil nil)
+The argument object is not altered--the value is a copy.
+
+\(fn OBJ)" nil nil)
(autoload (quote japanese-katakana-region) "japan-util" "\
Convert Japanese `hiragana' chars in the region to `katakana' chars.
Optional argument HANKAKU t means to convert to `hankaku katakana' character
-of which charset is `japanese-jisx0201-kana'." t nil)
+of which charset is `japanese-jisx0201-kana'.
+
+\(fn FROM TO &optional HANKAKU)" t nil)
(autoload (quote japanese-hiragana-region) "japan-util" "\
-Convert Japanese `katakana' chars in the region to `hiragana' chars." t nil)
+Convert Japanese `katakana' chars in the region to `hiragana' chars.
+
+\(fn FROM TO)" t nil)
(autoload (quote japanese-hankaku-region) "japan-util" "\
Convert Japanese `zenkaku' chars in the region to `hankaku' chars.
`Zenkaku' chars belong to `japanese-jisx0208'
`Hankaku' chars belong to `ascii' or `japanese-jisx0201-kana'.
-Optional argument ASCII-ONLY non-nil means to convert only to ASCII char." t nil)
+Optional argument ASCII-ONLY non-nil means to convert only to ASCII char.
+
+\(fn FROM TO &optional ASCII-ONLY)" t nil)
(autoload (quote japanese-zenkaku-region) "japan-util" "\
Convert hankaku' chars in the region to Japanese `zenkaku' chars.
`Zenkaku' chars belong to `japanese-jisx0208'
`Hankaku' chars belong to `ascii' or `japanese-jisx0201-kana'.
-Optional argument KATAKANA-ONLY non-nil means to convert only KATAKANA char." t nil)
+Optional argument KATAKANA-ONLY non-nil means to convert only KATAKANA char.
+
+\(fn FROM TO &optional KATAKANA-ONLY)" t nil)
(autoload (quote read-hiragana-string) "japan-util" "\
Read a Hiragana string from the minibuffer, prompting with string PROMPT.
-If non-nil, second arg INITIAL-INPUT is a string to insert before reading." nil nil)
+If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
+
+\(fn PROMPT &optional INITIAL-INPUT)" nil nil)
;;;***
\f
-;;;### (autoloads (jit-lock-register) "jit-lock" "jit-lock.el" (15391
-;;;;;; 60517))
+;;;### (autoloads (jit-lock-register) "jit-lock" "jit-lock.el" (15941
+;;;;;; 42953))
;;; Generated autoloads from jit-lock.el
(autoload (quote jit-lock-register) "jit-lock" "\
Register FUN as a fontification function to be called in this buffer.
FUN will be called with two arguments START and END indicating the region
that needs to be (re)fontified.
-If non-nil, CONTEXTUAL means that a contextual fontification would be useful." nil nil)
+If non-nil, CONTEXTUAL means that a contextual fontification would be useful.
+
+\(fn FUN &optional CONTEXTUAL)" nil nil)
;;;***
\f
;;;### (autoloads (with-auto-compression-mode auto-compression-mode)
-;;;;;; "jka-compr" "jka-compr.el" (15417 7402))
+;;;;;; "jka-compr" "jka-compr.el" (16111 41826))
;;; Generated autoloads from jka-compr.el
(defvar auto-compression-mode nil "\
Setting this variable directly does not take effect;
use either \\[customize] or the function `auto-compression-mode'.")
-(custom-add-to-group (quote jka-compr) (quote auto-compression-mode) (quote custom-variable))
-
-(custom-add-load (quote auto-compression-mode) (quote jka-compr))
+(custom-autoload (quote auto-compression-mode) "jka-compr")
(autoload (quote auto-compression-mode) "jka-compr" "\
Toggle automatic file compression and uncompression.
With prefix argument ARG, turn auto compression on if positive, else off.
-Returns the new status of auto compression (non-nil means on)." t nil)
+Returns the new status of auto compression (non-nil means on).
+
+\(fn &optional ARG)" t nil)
(autoload (quote with-auto-compression-mode) "jka-compr" "\
-Evalute BODY with automatic file compression and uncompression enabled." nil (quote macro))
+Evalute BODY with automatic file compression and uncompression enabled.
+
+\(fn &rest BODY)" nil (quote macro))
+
+;;;***
+\f
+;;;### (autoloads (keypad-setup keypad-numlock-shifted-setup keypad-shifted-setup
+;;;;;; keypad-numlock-setup keypad-setup) "keypad" "emulation/keypad.el"
+;;;;;; (15941 42958))
+;;; Generated autoloads from emulation/keypad.el
+
+(defvar keypad-setup nil "\
+Specifies the keypad setup for unshifted keypad keys when NumLock is off.
+When selecting the plain numeric keypad setup, the character returned by the
+decimal key must be specified.")
+
+(custom-autoload (quote keypad-setup) "keypad")
+
+(defvar keypad-numlock-setup nil "\
+Specifies the keypad setup for unshifted keypad keys when NumLock is on.
+When selecting the plain numeric keypad setup, the character returned by the
+decimal key must be specified.")
+
+(custom-autoload (quote keypad-numlock-setup) "keypad")
+
+(defvar keypad-shifted-setup nil "\
+Specifies the keypad setup for shifted keypad keys when NumLock is off.
+When selecting the plain numeric keypad setup, the character returned by the
+decimal key must be specified.")
+
+(custom-autoload (quote keypad-shifted-setup) "keypad")
+
+(defvar keypad-numlock-shifted-setup nil "\
+Specifies the keypad setup for shifted keypad keys when NumLock is off.
+When selecting the plain numeric keypad setup, the character returned by the
+decimal key must be specified.")
+
+(custom-autoload (quote keypad-numlock-shifted-setup) "keypad")
+
+(autoload (quote keypad-setup) "keypad" "\
+Set keypad bindings in function-key-map according to SETUP.
+If optional second argument NUMLOCK is non-nil, the NumLock On bindings
+are changed. Otherwise, the NumLock Off bindings are changed.
+If optional third argument SHIFT is non-nil, the shifted keypad
+keys are bound.
+
+ Setup Binding
+ -------------------------------------------------------------
+ 'prefix Command prefix argument, i.e. M-0 .. M-9 and M--
+ 'S-cursor Bind shifted keypad keys to the shifted cursor movement keys.
+ 'cursor Bind keypad keys to the cursor movement keys.
+ 'numeric Plain numeric keypad, i.e. 0 .. 9 and . (or DECIMAL arg)
+ 'none Removes all bindings for keypad keys in function-key-map;
+ this enables any user-defined bindings for the keypad keys
+ in the global and local keymaps.
+
+If SETUP is 'numeric and the optional fourth argument DECIMAL is non-nil,
+the decimal key on the keypad is mapped to DECIMAL instead of `.'
+
+\(fn SETUP &optional NUMLOCK SHIFT DECIMAL)" nil nil)
;;;***
\f
;;;### (autoloads (kinsoku) "kinsoku" "international/kinsoku.el"
-;;;;;; (15371 46423))
+;;;;;; (15941 42961))
;;; Generated autoloads from international/kinsoku.el
(autoload (quote kinsoku) "kinsoku" "\
`Kinsoku' is a Japanese word which originally means ordering to stay
in one place, and is used for the text processing described above in
-the context of text formatting." nil nil)
+the context of text formatting.
+
+\(fn LINEBEG)" nil nil)
;;;***
\f
-;;;### (autoloads (kkc-region) "kkc" "international/kkc.el" (15371
-;;;;;; 46423))
+;;;### (autoloads (kkc-region) "kkc" "international/kkc.el" (16153
+;;;;;; 36586))
;;; Generated autoloads from international/kkc.el
(defvar kkc-after-update-conversion-functions nil "\
When called from a program, expects two arguments,
positions FROM and TO (integers or markers) specifying the target region.
When it returns, the point is at the tail of the selected conversion,
-and the return value is the length of the conversion." t nil)
+and the return value is the length of the conversion.
+
+\(fn FROM TO)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (kmacro-end-call-mouse kmacro-end-and-call-macro
+;;;;;; kmacro-end-or-call-macro kmacro-start-macro-or-insert-counter
+;;;;;; kmacro-call-macro kmacro-end-macro kmacro-start-macro) "kmacro"
+;;;;;; "kmacro.el" (16016 56429))
+;;; Generated autoloads from kmacro.el
+ (global-set-key "\C-x(" 'kmacro-start-macro)
+ (global-set-key "\C-x)" 'kmacro-end-macro)
+ (global-set-key "\C-xe" 'kmacro-end-and-call-macro)
+ (global-set-key [f3] 'kmacro-start-macro-or-insert-counter)
+ (global-set-key [f4] 'kmacro-end-or-call-macro)
+ (global-set-key "\C-x\C-k" 'kmacro-keymap)
+ (autoload 'kmacro-keymap "kmacro" "Keymap for keyboard macro commands." t 'keymap)
+
+(autoload (quote kmacro-start-macro) "kmacro" "\
+Record subsequent keyboard input, defining a keyboard macro.
+The commands are recorded even as they are executed.
+Use \\[kmacro-end-macro] to finish recording and make the macro available.
+Use \\[kmacro-end-and-call-macro] to execute the macro.
+Use \\[name-last-kbd-macro] to give it a permanent name.
+Non-nil arg (prefix arg) means append to last macro defined;
+
+With \\[universal-argument] prefix, append to last keyboard macro
+defined. Depending on `kmacro-execute-before-append', this may begin
+by re-executing the last macro as if you typed it again.
+
+Otherwise, it sets `kmacro-counter' to ARG or 0 if missing before
+defining the macro.
+
+Use \\[kmacro-insert-counter] to insert (and increment) the macro counter.
+The counter value can be set or modified via \\[kmacro-set-counter] and \\[kmacro-add-counter].
+The format of the counter can be modified via \\[kmacro-set-format].
+
+\(fn ARG)" t nil)
+
+(autoload (quote kmacro-end-macro) "kmacro" "\
+Finish defining a keyboard macro.
+The definition was started by \\[kmacro-start-macro].
+The macro is now available for use via \\[kmacro-call-macro],
+or it can be given a name with \\[name-last-kbd-macro] and then invoked
+under that name.
+
+With numeric arg, repeat macro now that many times,
+counting the definition just completed as the first repetition.
+An argument of zero means repeat until error.
+
+\(fn ARG)" t nil)
+
+(autoload (quote kmacro-call-macro) "kmacro" "\
+Call the last keyboard macro that you defined with \\[kmacro-start-macro].
+A prefix argument serves as a repeat count. Zero means repeat until error.
+
+When you call the macro, you can call the macro again by repeating
+just the last key in the key sequence that you used to call this
+command. See `kmacro-call-repeat-key' and `kmacro-call-repeat-with-arg'
+for details on how to adjust or disable this behaviour.
+
+To make a macro permanent so you can call it even after defining
+others, use M-x name-last-kbd-macro.
+
+\(fn ARG &optional NO-REPEAT END-MACRO)" t nil)
+
+(autoload (quote kmacro-start-macro-or-insert-counter) "kmacro" "\
+Record subsequent keyboard input, defining a keyboard macro.
+The commands are recorded even as they are executed.
+
+Sets the `kmacro-counter' to ARG (or 0 if no prefix arg) before defining the
+macro.
+
+With \\[universal-argument], appends to current keyboard macro (keeping
+the current value of `kmacro-counter').
+
+When defining/executing macro, inserts macro counter and increments
+the counter with ARG or 1 if missing. With \\[universal-argument],
+inserts previous kmacro-counter (but do not modify counter).
+
+The macro counter can be modified via \\[kmacro-set-counter] and \\[kmacro-add-counter].
+The format of the counter can be modified via \\[kmacro-set-format].
+
+\(fn ARG)" t nil)
+
+(autoload (quote kmacro-end-or-call-macro) "kmacro" "\
+End kbd macro if currently being defined; else call last kbd macro.
+With numeric prefix ARG, repeat macro that many times.
+With \\[universal-argument], call second macro in macro ring.
+
+\(fn ARG &optional NO-REPEAT)" t nil)
+
+(autoload (quote kmacro-end-and-call-macro) "kmacro" "\
+Call last keyboard macro, ending it first if currently being defined.
+With numeric prefix ARG, repeat macro that many times.
+Zero argument means repeat until there is an error.
+
+To give a macro a permanent name, so you can call it
+even after defining other macros, use \\[name-last-kbd-macro].
+
+\(fn ARG &optional NO-REPEAT)" t nil)
+
+(autoload (quote kmacro-end-call-mouse) "kmacro" "\
+Move point to the position clicked with the mouse and call last kbd macro.
+If kbd macro currently being defined end it before activating it.
+
+\(fn EVENT)" t nil)
;;;***
\f
;;;### (autoloads (setup-korean-environment-internal) "korea-util"
-;;;;;; "language/korea-util.el" (15371 46423))
+;;;;;; "language/korea-util.el" (16118 44435))
;;; Generated autoloads from language/korea-util.el
(defvar default-korean-keyboard (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" "") "\
*The kind of Korean keyboard for Korean input method.
\"\" for 2, \"3\" for 3.")
-(autoload (quote setup-korean-environment-internal) "korea-util" nil nil nil)
+(autoload (quote setup-korean-environment-internal) "korea-util" "\
+Not documented
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (lm lm-test-run) "landmark" "play/landmark.el"
-;;;;;; (15371 46425))
+;;;;;; (15924 18775))
;;; Generated autoloads from play/landmark.el
(defalias (quote landmark-repeat) (quote lm-test-run))
(autoload (quote lm-test-run) "landmark" "\
-Run 100 Lm games, each time saving the weights from the previous game." t nil)
+Run 100 Lm games, each time saving the weights from the previous game.
+
+\(fn)" t nil)
(defalias (quote landmark) (quote lm))
You start by moving to a square and typing \\[lm-start-robot],
if you did not use a prefix arg to ask for automatic start.
-Use \\[describe-mode] for more info." t nil)
+Use \\[describe-mode] for more info.
+
+\(fn PARG)" t nil)
;;;***
\f
--;;;### (autoloads (lao-compose-region lao-composition-function lao-post-read-conversion
--;;;;;; lao-transcribe-roman-to-lao-string lao-transcribe-single-roman-syllable-to-lao
- ;;;;;; lao-compose-string) "lao-util" "language/lao-util.el" (16118
- ;;;;;; 44435))
-;;;;;; lao-compose-string) "lao-util" "language/lao-util.el" (15391
-;;;;;; 60703))
++;;;### (autoloads (lao-compose-region lao-composition-function lao-transcribe-roman-to-lao-string
++;;;;;; lao-transcribe-single-roman-syllable-to-lao lao-compose-string)
++;;;;;; "lao-util" "language/lao-util.el" (16183 37779))
;;; Generated autoloads from language/lao-util.el
-(autoload (quote lao-compose-string) "lao-util" nil nil nil)
+(autoload (quote lao-compose-string) "lao-util" "\
+Not documented
+
+\(fn STR)" nil nil)
(autoload (quote lao-transcribe-single-roman-syllable-to-lao) "lao-util" "\
Transcribe a Romanized Lao syllable in the region FROM and TO to Lao string.
LAO-STRING is the Lao character transcription of it.
Optional 3rd arg STR, if non-nil, is a string to search for Roman Lao
-syllable. In that case, FROM and TO are indexes to STR." nil nil)
+syllable. In that case, FROM and TO are indexes to STR.
+
+\(fn FROM TO &optional STR)" nil nil)
(autoload (quote lao-transcribe-roman-to-lao-string) "lao-util" "\
-Transcribe Romanized Lao string STR to Lao character string." nil nil)
+Transcribe Romanized Lao string STR to Lao character string.
-(autoload (quote lao-post-read-conversion) "lao-util" nil nil nil)
+\(fn STR)" nil nil)
- (autoload (quote lao-post-read-conversion) "lao-util" "\
- Not documented
-
- \(fn LEN)" nil nil)
-
(autoload (quote lao-composition-function) "lao-util" "\
--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.
++Not documented
+
- \(fn FROM TO PATTERN &optional STRING)" nil nil)
++\(fn POS &optional STRING)" nil nil)
-The return value is number of composed characters." nil nil)
+(autoload (quote lao-compose-region) "lao-util" "\
+Not documented
-(autoload (quote lao-compose-region) "lao-util" nil t nil)
+\(fn FROM TO)" t nil)
;;;***
\f
;;;### (autoloads (latin1-display-ucs-per-lynx latin1-display latin1-display)
-;;;;;; "latin1-disp" "international/latin1-disp.el" (15391 60562))
+;;;;;; "latin1-disp" "international/latin1-disp.el" (15997 672))
;;; Generated autoloads from international/latin1-disp.el
(defvar latin1-display nil "\
Setting this variable directly does not take effect;
use either M-x customize of the function `latin1-display'.")
-(custom-add-to-group (quote latin1-display) (quote latin1-display) (quote custom-variable))
-
-(custom-add-load (quote latin1-display) (quote latin1-disp))
+(custom-autoload (quote latin1-display) "latin1-disp")
(autoload (quote latin1-display) "latin1-disp" "\
Set up Latin-1/ASCII display for the arguments character SETS.
display for all of `latin1-display-sets'. See also
`latin1-display-setup'. As well as iso-8859 characters, this treats
some characters in the `mule-unicode-...' charsets if you don't have
-a Unicode font with which to display them." nil nil)
+a Unicode font with which to display them.
+
+\(fn &rest SETS)" nil nil)
(defvar latin1-display-ucs-per-lynx nil "\
Set up Latin-1/ASCII display for Unicode characters.
Setting this variable directly does not take effect;
use either M-x customize of the function `latin1-display'.")
-(custom-add-to-group (quote latin1-display) (quote latin1-display-ucs-per-lynx) (quote custom-variable))
-
-(custom-add-load (quote latin1-display-ucs-per-lynx) (quote latin1-disp))
+(custom-autoload (quote latin1-display-ucs-per-lynx) "latin1-disp")
;;;***
\f
;;;### (autoloads (turn-on-lazy-lock lazy-lock-mode) "lazy-lock"
-;;;;;; "lazy-lock.el" (15444 42462))
+;;;;;; "lazy-lock.el" (15941 42953))
;;; Generated autoloads from lazy-lock.el
(autoload (quote lazy-lock-mode) "lazy-lock" "\
If the system load rises above `lazy-lock-stealth-load' percent, stealth
fontification is suspended. Stealth fontification intensity is controlled via
the variable `lazy-lock-stealth-nice' and `lazy-lock-stealth-lines', and
-verbosity is controlled via the variable `lazy-lock-stealth-verbose'." t nil)
+verbosity is controlled via the variable `lazy-lock-stealth-verbose'.
+
+\(fn &optional ARG)" t nil)
(autoload (quote turn-on-lazy-lock) "lazy-lock" "\
-Unconditionally turn on Lazy Lock mode." nil nil)
+Unconditionally turn on Lazy Lock mode.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (ledit-from-lisp-mode ledit-mode) "ledit" "ledit.el"
-;;;;;; (15371 46416))
+;;;;;; (15186 43677))
;;; Generated autoloads from ledit.el
(defconst ledit-save-files t "\
and transmit saved text.
\\{ledit-mode-map}
To make Lisp mode automatically change to Ledit mode,
-do (setq lisp-mode-hook 'ledit-from-lisp-mode)" t nil)
+do (setq lisp-mode-hook 'ledit-from-lisp-mode)
+
+\(fn)" t nil)
-(autoload (quote ledit-from-lisp-mode) "ledit" nil nil nil)
+(autoload (quote ledit-from-lisp-mode) "ledit" "\
+Not documented
+
+\(fn)" nil nil)
;;;***
\f
-;;;### (autoloads (life) "life" "play/life.el" (15371 46425))
+;;;### (autoloads (life) "life" "play/life.el" (15941 42963))
;;; Generated autoloads from play/life.el
(autoload (quote life) "life" "\
Run Conway's Life simulation.
The starting pattern is randomly selected. Prefix arg (optional first
arg non-nil from a program) is the number of seconds to sleep between
-generations (this defaults to 1)." t nil)
+generations (this defaults to 1).
+
+\(fn &optional SLEEPTIME)" t nil)
;;;***
\f
-;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (15371
-;;;;;; 46415))
+;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (15781
+;;;;;; 48896))
;;; Generated autoloads from loadhist.el
(autoload (quote unload-feature) "loadhist" "\
Unload the library that provided FEATURE, restoring all its autoloads.
If the feature is required by any other loaded code, and prefix arg FORCE
-is nil, raise an error." t nil)
+is nil, raise an error.
+
+\(fn FEATURE &optional FORCE)" t nil)
;;;***
\f
;;;### (autoloads (locate-with-filter locate) "locate" "locate.el"
-;;;;;; (15417 7408))
+;;;;;; (15941 42956))
;;; Generated autoloads from locate.el
(autoload (quote locate) "locate" "\
Run the program `locate', putting results in `*Locate*' buffer.
-With prefix arg, prompt for the locate command to run." t nil)
+With prefix arg, prompt for the locate command to run.
+
+\(fn SEARCH-STRING &optional FILTER)" t nil)
(autoload (quote locate-with-filter) "locate" "\
Run the locate command with a filter.
The filter is a regular expression. Only results matching the filter are
-shown; this is often useful to constrain a big search." t nil)
+shown; this is often useful to constrain a big search.
+
+\(fn SEARCH-STRING FILTER)" t nil)
;;;***
\f
-;;;### (autoloads (log-edit) "log-edit" "log-edit.el" (15371 46415))
+;;;### (autoloads (log-edit) "log-edit" "log-edit.el" (16111 41826))
;;; Generated autoloads from log-edit.el
(autoload (quote log-edit) "log-edit" "\
that are concerned by the current operation (using relative names).
If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the
log message and go back to the current buffer when done. Otherwise, it
- uses the current buffer." nil nil)
+ uses the current buffer.
+
+\(fn CALLBACK &optional SETUP LISTFUN BUFFER &rest IGNORE)" nil nil)
;;;***
\f
-;;;### (autoloads (log-view-mode) "log-view" "log-view.el" (15417
-;;;;;; 7408))
+;;;### (autoloads (log-view-mode) "log-view" "log-view.el" (16070
+;;;;;; 35806))
;;; Generated autoloads from log-view.el
(autoload (quote log-view-mode) "log-view" "\
-Major mode for browsing CVS log output." t nil)
+Major mode for browsing CVS log output.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (print-region lpr-region print-buffer lpr-buffer
-;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (15371
-;;;;;; 46416))
+;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (16174
+;;;;;; 61085))
;;; Generated autoloads from lpr.el
(defvar lpr-windows-system (memq system-type (quote (emx win32 w32 mswindows ms-dos windows-nt))))
it to the name of a file, in which case the output gets appended to that
file. If you want to discard the printed output, set this to \"NUL\".")
+(custom-autoload (quote printer-name) "lpr")
+
(defvar lpr-switches nil "\
*List of strings to pass as extra options for the printer program.
It is recommended to set `printer-name' instead of including an explicit
switch on this list.
See `lpr-command'.")
+(custom-autoload (quote lpr-switches) "lpr")
+
(defvar lpr-command (cond (lpr-windows-system "") (lpr-lp-system "lp") (t "lpr")) "\
*Name of program for printing a file.
treated like `lpr' except that an explicit filename is given as the last
argument.")
+(custom-autoload (quote lpr-command) "lpr")
+
(autoload (quote lpr-buffer) "lpr" "\
Print buffer contents without pagination or page headers.
See the variables `lpr-switches' and `lpr-command'
-for customization of the printer command." t nil)
+for customization of the printer command.
+
+\(fn)" t nil)
(autoload (quote print-buffer) "lpr" "\
Paginate and print buffer contents.
Otherwise, the switches in `lpr-headers-switches' are used
in the print command itself; we expect them to request pagination.
-
+
See the variables `lpr-switches' and `lpr-command'
-for further customization of the printer command." t nil)
+for further customization of the printer command.
+
+\(fn)" t nil)
(autoload (quote lpr-region) "lpr" "\
Print region contents without pagination or page headers.
See the variables `lpr-switches' and `lpr-command'
-for customization of the printer command." t nil)
+for customization of the printer command.
+
+\(fn START END)" t nil)
(autoload (quote print-region) "lpr" "\
Paginate and print the region contents.
Otherwise, the switches in `lpr-headers-switches' are used
in the print command itself; we expect them to request pagination.
-
+
See the variables `lpr-switches' and `lpr-command'
-for further customization of the printer command." t nil)
+for further customization of the printer command.
+
+\(fn START END)" t nil)
;;;***
\f
-;;;### (autoloads nil "ls-lisp" "ls-lisp.el" (15417 7408))
+;;;### (autoloads (ls-lisp-support-shell-wildcards) "ls-lisp" "ls-lisp.el"
+;;;;;; (16070 35806))
;;; Generated autoloads from ls-lisp.el
-(defgroup ls-lisp nil "Emulate the ls program completely in Emacs Lisp." :version "21.1" :group (quote dired))
+(defvar ls-lisp-support-shell-wildcards t "\
+*Non-nil means ls-lisp treats file patterns as shell wildcards.
+Otherwise they are treated as Emacs regexps (for backward compatibility).")
+
+(custom-autoload (quote ls-lisp-support-shell-wildcards) "ls-lisp")
;;;***
\f
-;;;### (autoloads (phases-of-moon) "lunar" "calendar/lunar.el" (15371
-;;;;;; 46418))
+;;;### (autoloads (phases-of-moon) "lunar" "calendar/lunar.el" (16174
+;;;;;; 61085))
;;; Generated autoloads from calendar/lunar.el
(autoload (quote phases-of-moon) "lunar" "\
Display the quarters of the moon for last month, this month, and next month.
If called with an optional prefix argument, prompts for month and year.
-This function is suitable for execution in a .emacs file." t nil)
+This function is suitable for execution in a .emacs file.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
-;;;### (autoloads (m4-mode) "m4-mode" "progmodes/m4-mode.el" (15371
-;;;;;; 46426))
+;;;### (autoloads (m4-mode) "m4-mode" "progmodes/m4-mode.el" (15941
+;;;;;; 42965))
;;; Generated autoloads from progmodes/m4-mode.el
(autoload (quote m4-mode) "m4-mode" "\
A major mode to edit m4 macro files.
\\{m4-mode-map}
-" t nil)
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (apply-macro-to-region-lines kbd-macro-query insert-kbd-macro
-;;;;;; name-last-kbd-macro) "macros" "macros.el" (15371 46416))
+;;;;;; name-last-kbd-macro) "macros" "macros.el" (16162 11942))
;;; Generated autoloads from macros.el
(autoload (quote name-last-kbd-macro) "macros" "\
Assign a name to the last keyboard macro defined.
Argument SYMBOL is the name to define.
The symbol's function definition becomes the keyboard macro string.
-Such a \"function\" cannot be called from Lisp, but it is a valid editor command." t nil)
+Such a \"function\" cannot be called from Lisp, but it is a valid editor command.
+
+\(fn SYMBOL)" t nil)
(autoload (quote insert-kbd-macro) "macros" "\
Insert in buffer the definition of kbd macro NAME, as Lisp code.
bindings.
To save a kbd macro, visit a file of Lisp code such as your `~/.emacs',
-use this command, and then save the file." t nil)
+use this command, and then save the file.
+
+\(fn MACRONAME &optional KEYS)" t nil)
(autoload (quote kbd-macro-query) "macros" "\
Query user during kbd macro execution.
\\[skip] Skip the rest of this iteration, and start the next.
\\[exit] Stop the macro entirely right now.
\\[recenter] Redisplay the screen, then ask again.
-\\[edit] Enter recursive edit; ask again when you exit from that." t nil)
+\\[edit] Enter recursive edit; ask again when you exit from that.
+
+\(fn FLAG)" t nil)
(autoload (quote apply-macro-to-region-lines) "macros" "\
For each complete line between point and mark, move to the beginning
Suppose you wanted to build a keyword table in C where each entry
looked like this:
- { \"foo\", foo_data, foo_function },
+ { \"foo\", foo_data, foo_function },
{ \"bar\", bar_data, bar_function },
{ \"baz\", baz_data, baz_function },
and then select the region of un-tablified names and use
`\\[apply-macro-to-region-lines]' to build the table from the names.
-" t nil)
+
+\(fn TOP BOTTOM &optional MACRO)" t nil)
(define-key ctl-x-map "q" 'kbd-macro-query)
;;;***
\f
;;;### (autoloads (what-domain mail-extract-address-components) "mail-extr"
-;;;;;; "mail/mail-extr.el" (15371 46424))
+;;;;;; "mail/mail-extr.el" (16111 41831))
;;; Generated autoloads from mail/mail-extr.el
(autoload (quote mail-extract-address-components) "mail-extr" "\
Given an RFC-822 address ADDRESS, extract full name and canonical address.
Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).
-If no name can be extracted, FULL-NAME will be nil.
+If no name can be extracted, FULL-NAME will be nil. Also see
+`mail-extr-ignore-single-names'.
If the optional argument ALL is non-nil, then ADDRESS can contain zero
or more recipients, separated by commas, and we return a list of
one recipients, all but the first is ignored.
ADDRESS may be a string or a buffer. If it is a buffer, the visible
- (narrowed) portion of the buffer will be interpreted as the address.
- (This feature exists so that the clever caller might be able to avoid
- consing a string.)" nil nil)
+\(narrowed) portion of the buffer will be interpreted as the address.
+\(This feature exists so that the clever caller might be able to avoid
+consing a string.)
+
+\(fn ADDRESS &optional ALL)" nil nil)
(autoload (quote what-domain) "mail-extr" "\
-Convert mail domain DOMAIN to the country it corresponds to." t nil)
+Convert mail domain DOMAIN to the country it corresponds to.
+
+\(fn DOMAIN)" t nil)
;;;***
\f
;;;### (autoloads (mail-hist-put-headers-into-history mail-hist-keep-history
;;;;;; mail-hist-enable mail-hist-define-keys) "mail-hist" "mail/mail-hist.el"
-;;;;;; (15371 46424))
+;;;;;; (15941 42961))
;;; Generated autoloads from mail/mail-hist.el
(autoload (quote mail-hist-define-keys) "mail-hist" "\
-Define keys for accessing mail header history. For use in hooks." nil nil)
+Define keys for accessing mail header history. For use in hooks.
+
+\(fn)" nil nil)
-(autoload (quote mail-hist-enable) "mail-hist" nil nil nil)
+(autoload (quote mail-hist-enable) "mail-hist" "\
+Not documented
+
+\(fn)" nil nil)
(defvar mail-hist-keep-history t "\
*Non-nil means keep a history for headers and text of outgoing mail.")
+(custom-autoload (quote mail-hist-keep-history) "mail-hist")
+
(autoload (quote mail-hist-put-headers-into-history) "mail-hist" "\
-Put headers and contents of this message into mail header history.
+Put headers and contents of this message into mail header history.
Each header has its own independent history, as does the body of the
message.
-This function normally would be called when the message is sent." nil nil)
+This function normally would be called when the message is sent.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (mail-fetch-field mail-unquote-printable-region
;;;;;; mail-unquote-printable mail-quote-printable mail-file-babyl-p
-;;;;;; mail-use-rfc822) "mail-utils" "mail/mail-utils.el" (15371
-;;;;;; 46424))
+;;;;;; mail-use-rfc822) "mail-utils" "mail/mail-utils.el" (15941
+;;;;;; 42961))
;;; Generated autoloads from mail/mail-utils.el
(defvar mail-use-rfc822 nil "\
Otherwise, (the default) use a smaller, somewhat faster, and
often correct parser.")
-(autoload (quote mail-file-babyl-p) "mail-utils" nil nil nil)
+(custom-autoload (quote mail-use-rfc822) "mail-utils")
+
+(autoload (quote mail-file-babyl-p) "mail-utils" "\
+Not documented
+
+\(fn FILE)" nil nil)
(autoload (quote mail-quote-printable) "mail-utils" "\
Convert a string to the \"quoted printable\" Q encoding.
If the optional argument WRAPPER is non-nil,
-we add the wrapper characters =?ISO-8859-1?Q?....?=." nil nil)
+we add the wrapper characters =?ISO-8859-1?Q?....?=.
+
+\(fn STRING &optional WRAPPER)" nil nil)
(autoload (quote mail-unquote-printable) "mail-utils" "\
Undo the \"quoted printable\" encoding.
If the optional argument WRAPPER is non-nil,
-we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=." nil nil)
+we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=.
+
+\(fn STRING &optional WRAPPER)" nil nil)
(autoload (quote mail-unquote-printable-region) "mail-utils" "\
Undo the \"quoted printable\" encoding in buffer from BEG to END.
If the optional argument WRAPPER is non-nil,
-we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=." t nil)
+we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=.
+
+\(fn BEG END &optional WRAPPER)" t nil)
(autoload (quote mail-fetch-field) "mail-utils" "\
Return the value of the header field whose type is FIELD-NAME.
The buffer is expected to be narrowed to just the header of the message.
If second arg LAST is non-nil, use the last field of type FIELD-NAME.
If third arg ALL is non-nil, concatenate all such fields with commas between.
-If 4th arg LIST is non-nil, return a list of all such fields." nil nil)
+If 4th arg LIST is non-nil, return a list of all such fields.
+
+\(fn FIELD-NAME &optional LAST ALL LIST)" nil nil)
;;;***
\f
;;;### (autoloads (define-mail-abbrev build-mail-abbrevs mail-abbrevs-setup)
-;;;;;; "mailabbrev" "mail/mailabbrev.el" (15468 8218))
+;;;;;; "mailabbrev" "mail/mailabbrev.el" (15924 18773))
;;; Generated autoloads from mail/mailabbrev.el
(autoload (quote mail-abbrevs-setup) "mailabbrev" "\
-Initialize use of the `mailabbrev' package." nil nil)
+Initialize use of the `mailabbrev' package.
+
+\(fn)" nil nil)
(autoload (quote build-mail-abbrevs) "mailabbrev" "\
Read mail aliases from personal mail alias file and set `mail-abbrevs'.
-By default this is the file specified by `mail-personal-alias-file'." nil nil)
+By default this is the file specified by `mail-personal-alias-file'.
+
+\(fn &optional FILE RECURSIVEP)" nil nil)
(autoload (quote define-mail-abbrev) "mailabbrev" "\
Define NAME as a mail alias abbrev that translates to DEFINITION.
-If DEFINITION contains multiple addresses, separate them with commas." t nil)
+If DEFINITION contains multiple addresses, separate them with commas.
+
+\(fn NAME DEFINITION &optional FROM-MAILRC-FILE)" t nil)
;;;***
\f
;;;### (autoloads (mail-complete define-mail-alias expand-mail-aliases
-;;;;;; mail-complete-style) "mailalias" "mail/mailalias.el" (15371
-;;;;;; 46424))
+;;;;;; mail-complete-style) "mailalias" "mail/mailalias.el" (16066
+;;;;;; 53440))
;;; Generated autoloads from mail/mailalias.el
(defvar mail-complete-style (quote angles) "\
If `angles', they look like:
Elvis Parsley <king@grassland.com>")
+(custom-autoload (quote mail-complete-style) "mailalias")
+
(autoload (quote expand-mail-aliases) "mailalias" "\
Expand all mail aliases in suitable header fields found between BEG and END.
If interactive, expand in header fields.
their `Resent-' variants.
Optional second arg EXCLUDE may be a regular expression defining text to be
-removed from alias expansions." t nil)
+removed from alias expansions.
+
+\(fn BEG END &optional EXCLUDE)" t nil)
(autoload (quote define-mail-alias) "mailalias" "\
Define NAME as a mail alias that translates to DEFINITION.
This means that sending a message to NAME will actually send to DEFINITION.
Normally, the addresses in DEFINITION must be separated by commas.
-If FROM-MAILRC-FILE is non-nil, then addresses in DEFINITION
+If FROM-MAILRC-FILE is non-nil, then addresses in DEFINITION
can be separated by spaces; an address can contain spaces
-if it is quoted with double-quotes." t nil)
+if it is quoted with double-quotes.
+
+\(fn NAME DEFINITION &optional FROM-MAILRC-FILE)" t nil)
(autoload (quote mail-complete) "mailalias" "\
Perform completion on header field or word preceding point.
Completable headers are according to `mail-complete-alist'. If none matches
-current header, calls `mail-complete-function' and passes prefix arg if any." t nil)
+current header, calls `mail-complete-function' and passes prefix arg if any.
+
+\(fn ARG)" t nil)
;;;***
\f
;;;### (autoloads (makefile-mode) "make-mode" "progmodes/make-mode.el"
-;;;;;; (15391 60717))
+;;;;;; (15997 672))
;;; Generated autoloads from progmodes/make-mode.el
(autoload (quote makefile-mode) "make-mode" "\
(i.e. it calls `makefile-pickup-filenames-as-targets'), otherwise
filenames are omitted.
-`makefile-cleanup-continuations-p':
+`makefile-cleanup-continuations':
If this variable is set to a non-nil value then Makefile mode
will assure that no line in the file ends with a backslash
(the continuation character) followed by any whitespace.
`makefile-special-targets-list':
List of special targets. You will be offered to complete
on one of those in the minibuffer whenever you enter a `.'.
- at the beginning of a line in Makefile mode." t nil)
+ at the beginning of a line in Makefile mode.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (make-command-summary) "makesum" "makesum.el" (15371
-;;;;;; 46416))
+;;;### (autoloads (make-command-summary) "makesum" "makesum.el" (13229
+;;;;;; 28917))
;;; Generated autoloads from makesum.el
(autoload (quote make-command-summary) "makesum" "\
Make a summary of current key bindings in the buffer *Summary*.
-Previous contents of that buffer are killed first." t nil)
+Previous contents of that buffer are killed first.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (man-follow man) "man" "man.el" (15427 61506))
+;;;### (autoloads (man-follow man) "man" "man.el" (16148 4632))
;;; Generated autoloads from man.el
(defalias (quote manual-entry) (quote man))
To specify a man page from a certain section, type SUBJECT(SECTION) or
SECTION SUBJECT when prompted for a manual entry. To see manpages from
all sections related to a subject, put something appropriate into the
-`Man-switches' variable, which see." t nil)
+`Man-switches' variable, which see.
+
+\(fn MAN-ARGS)" t nil)
(autoload (quote man-follow) "man" "\
-Get a Un*x manual page of the item under point and put it in a buffer." t nil)
+Get a Un*x manual page of the item under point and put it in a buffer.
+
+\(fn MAN-ARGS)" t nil)
;;;***
\f
-;;;### (autoloads (master-mode) "master" "master.el" (15417 7408))
+;;;### (autoloads (master-mode) "master" "master.el" (15941 42956))
;;; Generated autoloads from master.el
(autoload (quote master-mode) "master" "\
The slave buffer is stored in the buffer-local variable `master-of'.
You can set this variable using `master-set-slave'. You can show
-yourself the value of `master-of' by calling `master-show-slave'." t nil)
+yourself the value of `master-of' by calling `master-show-slave'.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (menu-bar-mode) "menu-bar" "menu-bar.el" (16162
+;;;;;; 11942))
+;;; Generated autoloads from menu-bar.el
+
+(put (quote menu-bar-mode) (quote standard-value) (quote (t)))
+
+(defvar menu-bar-mode nil "\
+Non-nil if Menu-Bar mode is enabled.
+See the command `menu-bar-mode' for a description of this minor-mode.
+Setting this variable directly does not take effect;
+use either \\[customize] or the function `menu-bar-mode'.")
+
+(custom-autoload (quote menu-bar-mode) "menu-bar")
+
+(autoload (quote menu-bar-mode) "menu-bar" "\
+Toggle display of a menu bar on each frame.
+This command applies to all frames that exist and frames to be
+created in the future.
+With a numeric argument, if the argument is positive,
+turn on menu bars; otherwise, turn off menu bars.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;;;; message-signature message-indent-citation-function message-cite-function
;;;;;; message-yank-prefix message-citation-line-function message-send-mail-function
;;;;;; message-user-organization-file message-signature-separator
-;;;;;; message-from-style) "message" "gnus/message.el" (15455 18402))
+;;;;;; message-from-style) "message" "gnus/message.el" (16070 35808))
;;; Generated autoloads from gnus/message.el
(defvar message-from-style (quote default) "\
Otherwise, most addresses look like `angles', but they look like
`parens' if `angles' would need quoting and `parens' would not.")
+(custom-autoload (quote message-from-style) "message")
+
(defvar message-signature-separator "^-- *$" "\
Regexp matching the signature separator.")
+(custom-autoload (quote message-signature-separator) "message")
+
(defvar message-user-organization-file "/usr/lib/news/organization" "\
*Local news organization file.")
+(custom-autoload (quote message-user-organization-file) "message")
+
(defvar message-send-mail-function (quote message-send-mail-with-sendmail) "\
Function to call to send the current buffer as mail.
The headers should be delimited by a line whose contents match the
See also `send-mail-function'.")
+(custom-autoload (quote message-send-mail-function) "message")
+
(defvar message-citation-line-function (quote message-insert-citation-line) "\
*Function called to insert the \"Whomever writes:\" line.")
+(custom-autoload (quote message-citation-line-function) "message")
+
(defvar message-yank-prefix "> " "\
*Prefix inserted on the lines of yanked messages.")
+(custom-autoload (quote message-yank-prefix) "message")
+
(defvar message-cite-function (quote message-cite-original) "\
*Function for citing an original message.
Predefined functions include `message-cite-original' and
`message-cite-original-without-signature'.
Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil.")
+(custom-autoload (quote message-cite-function) "message")
+
(defvar message-indent-citation-function (quote message-indent-citation) "\
*Function for modifying a citation just inserted in the mail buffer.
This can also be a list of functions. Each function can find the
citation between (point) and (mark t). And each function should leave
point and mark around the citation text as modified.")
+(custom-autoload (quote message-indent-citation-function) "message")
+
(defvar message-signature t "\
*String to be inserted at the end of the message buffer.
If t, the `message-signature-file' file will be inserted instead.
If a function, the result from the function will be used instead.
If a form, the result from the form will be used instead.")
+(custom-autoload (quote message-signature) "message")
+
(defvar message-signature-file "~/.signature" "\
*Name of file containing the text inserted at end of message buffer.
Ignored if the named file doesn't exist.
If nil, don't insert a signature.")
+(custom-autoload (quote message-signature-file) "message")
+
(define-mail-user-agent (quote message-user-agent) (quote message-mail) (quote message-send-and-exit) (quote message-kill-buffer) (quote message-send-hook))
(autoload (quote message-mode) "message" "\
C-c C-z `message-kill-to-signature' (kill the text up to the signature).
C-c C-r `message-caesar-buffer-body' (rot13 the message body).
C-c C-a `mml-attach-file' (attach a file as MIME).
-M-RET `message-newline-and-reformat' (break the line and reformat)." t nil)
+M-RET `message-newline-and-reformat' (break the line and reformat).
+
+\(fn)" t nil)
(autoload (quote message-mail) "message" "\
Start editing a mail message to be sent.
-OTHER-HEADERS is an alist of header/value pairs." t nil)
+OTHER-HEADERS is an alist of header/value pairs.
+
+\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION SEND-ACTIONS)" t nil)
(autoload (quote message-news) "message" "\
-Start editing a news article to be sent." t nil)
+Start editing a news article to be sent.
+
+\(fn &optional NEWSGROUPS SUBJECT)" t nil)
(autoload (quote message-reply) "message" "\
-Start editing a reply to the article in the current buffer." t nil)
+Start editing a reply to the article in the current buffer.
+
+\(fn &optional TO-ADDRESS WIDE)" t nil)
(autoload (quote message-wide-reply) "message" "\
-Make a \"wide\" reply to the message in the current buffer." t nil)
+Make a \"wide\" reply to the message in the current buffer.
+
+\(fn &optional TO-ADDRESS)" t nil)
(autoload (quote message-followup) "message" "\
Follow up to the message in the current buffer.
-If TO-NEWSGROUPS, use that as the new Newsgroups line." t nil)
+If TO-NEWSGROUPS, use that as the new Newsgroups line.
+
+\(fn &optional TO-NEWSGROUPS)" t nil)
(autoload (quote message-cancel-news) "message" "\
Cancel an article you posted.
-If ARG, allow editing of the cancellation message." t nil)
+If ARG, allow editing of the cancellation message.
+
+\(fn &optional ARG)" t nil)
(autoload (quote message-supersede) "message" "\
Start composing a message to supersede the current message.
This is done simply by taking the old article and adding a Supersedes
-header line with the old Message-ID." t nil)
+header line with the old Message-ID.
+
+\(fn)" t nil)
(autoload (quote message-recover) "message" "\
-Reread contents of current buffer from its last auto-save file." t nil)
+Reread contents of current buffer from its last auto-save file.
+
+\(fn)" t nil)
(autoload (quote message-forward) "message" "\
Forward the current message via mail.
Optional NEWS will use news to forward instead of mail.
-Optional DIGEST will use digest to forward." t nil)
+Optional DIGEST will use digest to forward.
+
+\(fn &optional NEWS DIGEST)" t nil)
+
+(autoload (quote message-forward-make-body) "message" "\
+Not documented
+
+\(fn FORWARD-BUFFER &optional DIGEST)" nil nil)
-(autoload (quote message-forward-make-body) "message" nil nil nil)
+(autoload (quote message-forward-rmail-make-body) "message" "\
+Not documented
-(autoload (quote message-forward-rmail-make-body) "message" nil nil nil)
+\(fn FORWARD-BUFFER)" nil nil)
(autoload (quote message-insinuate-rmail) "message" "\
-Let RMAIL uses message to forward." t nil)
+Let RMAIL uses message to forward.
+
+\(fn)" t nil)
(autoload (quote message-resend) "message" "\
-Resend the current article to ADDRESS." t nil)
+Resend the current article to ADDRESS.
+
+\(fn ADDRESS)" t nil)
(autoload (quote message-bounce) "message" "\
Re-mail the current message.
This only makes sense if the current message is a bounce message that
contains some mail you have written which has been bounced back to
-you." t nil)
+you.
+
+\(fn)" t nil)
(autoload (quote message-mail-other-window) "message" "\
-Like `message-mail' command, but display mail buffer in another window." t nil)
+Like `message-mail' command, but display mail buffer in another window.
+
+\(fn &optional TO SUBJECT)" t nil)
(autoload (quote message-mail-other-frame) "message" "\
-Like `message-mail' command, but display mail buffer in another frame." t nil)
+Like `message-mail' command, but display mail buffer in another frame.
+
+\(fn &optional TO SUBJECT)" t nil)
(autoload (quote message-news-other-window) "message" "\
-Start editing a news article to be sent." t nil)
+Start editing a news article to be sent.
+
+\(fn &optional NEWSGROUPS SUBJECT)" t nil)
(autoload (quote message-news-other-frame) "message" "\
-Start editing a news article to be sent." t nil)
+Start editing a news article to be sent.
+
+\(fn &optional NEWSGROUPS SUBJECT)" t nil)
(autoload (quote bold-region) "message" "\
Bold all nonblank characters in the region.
Works by overstriking characters.
Called from program, takes two arguments START and END
-which specify the range to operate on." t nil)
+which specify the range to operate on.
+
+\(fn START END)" t nil)
(autoload (quote unbold-region) "message" "\
Remove all boldness (overstruck characters) in the region.
Called from program, takes two arguments START and END
-which specify the range to operate on." t nil)
+which specify the range to operate on.
+
+\(fn START END)" t nil)
;;;***
\f
;;;### (autoloads (metapost-mode metafont-mode) "meta-mode" "progmodes/meta-mode.el"
-;;;;;; (15371 46426))
+;;;;;; (15961 24155))
;;; Generated autoloads from progmodes/meta-mode.el
(autoload (quote metafont-mode) "meta-mode" "\
\\{meta-mode-map}
Turning on Metafont mode calls the value of the variables
-`meta-common-mode-hook' and `metafont-mode-hook'." t nil)
+`meta-common-mode-hook' and `metafont-mode-hook'.
+
+\(fn)" t nil)
(autoload (quote metapost-mode) "meta-mode" "\
Major mode for editing MetaPost sources.
\\{meta-mode-map}
Turning on MetaPost mode calls the value of the variable
-`meta-common-mode-hook' and `metafont-mode-hook'." t nil)
+`meta-common-mode-hook' and `metafont-mode-hook'.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (metamail-region metamail-buffer metamail-interpret-body
;;;;;; metamail-interpret-header) "metamail" "mail/metamail.el"
-;;;;;; (15371 46424))
+;;;;;; (15941 42961))
;;; Generated autoloads from mail/metamail.el
(autoload (quote metamail-interpret-header) "metamail" "\
Interpret a header part of a MIME message in current buffer.
-Its body part is not interpreted at all." t nil)
+Its body part is not interpreted at all.
+
+\(fn)" t nil)
(autoload (quote metamail-interpret-body) "metamail" "\
Interpret a body part of a MIME message in current buffer.
EMACS_VIEW_MODE environment variable (defaulted to 1).
Optional argument NODISPLAY non-nil means buffer is not
redisplayed as output is inserted.
-Its header part is not interpreted at all." t nil)
+Its header part is not interpreted at all.
+
+\(fn &optional VIEWMODE NODISPLAY)" t nil)
(autoload (quote metamail-buffer) "metamail" "\
Process current buffer through `metamail'.
Optional argument BUFFER specifies a buffer to be filled (nil
means current).
Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted." t nil)
+redisplayed as output is inserted.
+
+\(fn &optional VIEWMODE BUFFER NODISPLAY)" t nil)
(autoload (quote metamail-region) "metamail" "\
Process current region through 'metamail'.
Optional argument BUFFER specifies a buffer to be filled (nil
means current).
Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted." t nil)
+redisplayed as output is inserted.
+
+\(fn BEG END &optional VIEWMODE BUFFER NODISPLAY)" t nil)
;;;***
\f
-;;;### (autoloads (mh-letter-mode mh-smail-other-window mh-smail-batch
-;;;;;; mh-smail) "mh-comp" "mail/mh-comp.el" (15400 1477))
-;;; Generated autoloads from mail/mh-comp.el
+;;;### (autoloads (mh-letter-mode mh-smail-other-window mh-user-agent-compose
+;;;;;; mh-smail-batch mh-smail) "mh-comp" "mh-e/mh-comp.el" (16054
+;;;;;; 60750))
+;;; Generated autoloads from mh-e/mh-comp.el
(autoload (quote mh-smail) "mh-comp" "\
Compose and send mail with the MH mail system.
-This function is an entry point to mh-e, the Emacs front end
+This function is an entry point to MH-E, the Emacs front end
to the MH mail system.
-See documentation of `\\[mh-send]' for more details on composing mail." t nil)
+See documentation of `\\[mh-send]' for more details on composing mail.
+
+\(fn)" t nil)
(autoload (quote mh-smail-batch) "mh-comp" "\
Set up a mail composition draft with the MH mail system.
-This function is an entry point to mh-e, the Emacs front end
+This function is an entry point to MH-E, the Emacs front end
to the MH mail system. This function does not prompt the user
for any header fields, and thus is suitable for use by programs
that want to create a mail buffer.
-Users should use `\\[mh-smail]' to compose mail." nil nil)
+Users should use `\\[mh-smail]' to compose mail.
+Optional arguments for setting certain fields include TO, SUBJECT, and
+OTHER-HEADERS. Additional arguments are IGNORED.
+
+\(fn &optional TO SUBJECT OTHER-HEADERS &rest IGNORED)" nil nil)
+
+(autoload (quote mh-user-agent-compose) "mh-comp" "\
+Set up mail composition draft with the MH mail system.
+This is `mail-user-agent' entry point to MH-E.
+
+The optional arguments TO and SUBJECT specify recipients and the
+initial Subject field, respectively.
+
+OTHER-HEADERS is an alist specifying additional
+header fields. Elements look like (HEADER . VALUE) where both
+HEADER and VALUE are strings.
+
+CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored.
+
+\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION SEND-ACTIONS)" nil nil)
(autoload (quote mh-smail-other-window) "mh-comp" "\
Compose and send mail in other window with the MH mail system.
-This function is an entry point to mh-e, the Emacs front end
+This function is an entry point to MH-E, the Emacs front end
to the MH mail system.
-See documentation of `\\[mh-send]' for more details on composing mail." t nil)
+See documentation of `\\[mh-send]' for more details on composing mail.
+
+\(fn)" t nil)
(autoload (quote mh-letter-mode) "mh-comp" "\
-Mode for composing letters in mh-e.\\<mh-letter-mode-map>
+Mode for composing letters in MH-E.\\<mh-letter-mode-map>
+
When you have finished composing, type \\[mh-send-letter] to send the message
using the MH mail handling system.
-See the documentation for \\[mh-edit-mhn] for information on composing MIME
-messages.
-
-\\{mh-letter-mode-map}
-Variables controlling this mode (defaults in parentheses):
+There are two types of MIME directives used by MH-E: Gnus and MH. The option
+`mh-compose-insertion' controls what type of directives are inserted by MH-E
+commands. These directives can be converted to MIME body parts by running
+\\[mh-edit-mhn] for mhn directives or \\[mh-mml-to-mime] for Gnus directives.
+This step is mandatory if these directives are added manually. If the
+directives are inserted with MH-E commands such as \\[mh-compose-insertion],
+the directives are expanded automatically when the letter is sent.
- mh-delete-yanked-msg-window (nil)
- If non-nil, \\[mh-yank-cur-msg] will delete any windows displaying
- the yanked message.
+Options that control this mode can be changed with
+\\[customize-group]; specify the \"mh-compose\" group.
- mh-yank-from-start-of-msg (t)
- If non-nil, \\[mh-yank-cur-msg] will include the entire message.
- If `body', just yank the body (no header).
- If nil, only the portion of the message following the point will be yanked.
- If there is a region, this variable is ignored.
+When a message is composed, the hooks `text-mode-hook' and
+`mh-letter-mode-hook' are run.
- mh-ins-buf-prefix (\"> \")
- String to insert before each non-blank line of a message as it is
- inserted in a draft letter.
-
- mh-signature-file-name (\"~/.signature\")
- File to be inserted into message by \\[mh-insert-signature].
+\\{mh-letter-mode-map}
-This command runs the normal hooks `text-mode-hook' and `mh-letter-mode-hook'." t nil)
+\(fn)" t nil)
+(add-to-list 'auto-mode-alist '("/drafts/[0-9]+\\'" . mh-letter-mode))
;;;***
\f
-;;;### (autoloads (mh-version mh-rmail) "mh-e" "mail/mh-e.el" (15400
-;;;;;; 1477))
-;;; Generated autoloads from mail/mh-e.el
+;;;### (autoloads (mh-version mh-nmail mh-rmail) "mh-e" "mh-e/mh-e.el"
+;;;;;; (16054 60750))
+;;; Generated autoloads from mh-e/mh-e.el
(autoload (quote mh-rmail) "mh-e" "\
-Inc(orporate) new mail with MH, or, with arg, scan an MH mail folder.
-This function is an entry point to mh-e, the Emacs front end
-to the MH mail system." t nil)
+Inc(orporate) new mail with MH.
+Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
+the Emacs front end to the MH mail system.
-(autoload (quote mh-version) "mh-e" "\
-Display version information about mh-e and the MH mail handling system." t nil)
+\(fn &optional ARG)" t nil)
-;;;***
-\f
-;;;### (autoloads nil "mh-mime" "mail/mh-mime.el" (15371 46424))
-;;; Generated autoloads from mail/mh-mime.el
+(autoload (quote mh-nmail) "mh-e" "\
+Check for new mail in inbox folder.
+Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
+the Emacs front end to the MH mail system.
+
+\(fn &optional ARG)" t nil)
+
+(autoload (quote mh-version) "mh-e" "\
+Display version information about MH-E and the MH mail handling system.
-(defvar mh-mime-content-types (quote (("text/plain") ("text/richtext") ("multipart/mixed") ("multipart/alternative") ("multipart/digest") ("multipart/parallel") ("message/rfc822") ("message/partial") ("message/external-body") ("application/octet-stream") ("application/postscript") ("image/jpeg") ("image/gif") ("audio/basic") ("video/mpeg"))) "\
-Legal MIME content types. See documentation for \\[mh-edit-mhn].")
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads nil "mh-utils" "mail/mh-utils.el" (15417 7424))
-;;; Generated autoloads from mail/mh-utils.el
+;;;### (autoloads nil "mh-utils" "mh-e/mh-utils.el" (16054 60750))
+;;; Generated autoloads from mh-e/mh-utils.el
(put (quote mh-progs) (quote risky-local-variable) t)
(put (quote mh-lib-progs) (quote risky-local-variable) t)
-(put (quote mh-nmh-p) (quote risky-local-variable) t)
+(put (quote mh-nmh-flag) (quote risky-local-variable) t)
;;;***
\f
;;;### (autoloads (midnight-delay-set clean-buffer-list) "midnight"
-;;;;;; "midnight.el" (15371 46416))
+;;;;;; "midnight.el" (15186 43679))
;;; Generated autoloads from midnight.el
(autoload (quote clean-buffer-list) "midnight" "\
While processing buffers, this procedure displays messages containing
the current date/time, buffer name, how many seconds ago it was
displayed (can be nil if the buffer was never displayed) and its
-lifetime, i.e., its \"age\" when it will be purged." t nil)
+lifetime, i.e., its \"age\" when it will be purged.
+
+\(fn)" t nil)
(autoload (quote midnight-delay-set) "midnight" "\
Modify `midnight-timer' according to `midnight-delay'.
Sets the first argument SYMB (which must be symbol `midnight-delay')
-to its second argument TM." nil nil)
+to its second argument TM.
+
+\(fn SYMB TM)" nil nil)
;;;***
\f
;;;### (autoloads (minibuffer-electric-default-mode) "minibuf-eldef"
-;;;;;; "minibuf-eldef.el" (15391 60519))
+;;;;;; "minibuf-eldef.el" (15941 42956))
;;; Generated autoloads from minibuf-eldef.el
(defvar minibuffer-electric-default-mode nil "\
Setting this variable directly does not take effect;
use either \\[customize] or the function `minibuffer-electric-default-mode'.")
-(custom-add-to-group (quote minibuffer) (quote minibuffer-electric-default-mode) (quote custom-variable))
-
-(custom-add-load (quote minibuffer-electric-default-mode) (quote minibuf-eldef))
+(custom-autoload (quote minibuffer-electric-default-mode) "minibuf-eldef")
(autoload (quote minibuffer-electric-default-mode) "minibuf-eldef" "\
Toggle Minibuffer Electric Default mode.
default indication.
With prefix argument ARG, turn on if positive, otherwise off.
-Returns non-nil if the new state is enabled." t nil)
+Returns non-nil if the new state is enabled.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (mixal-mode) "mixal-mode" "progmodes/mixal-mode.el"
+;;;;;; (16110 13979))
+;;; Generated autoloads from progmodes/mixal-mode.el
+
+(autoload (quote mixal-mode) "mixal-mode" "\
+Major mode for the mixal asm language.
+\\{mixal-mode-map}
+
+\(fn)" t nil)
+
+(add-to-list (quote auto-mode-alist) (quote ("\\.mixal\\'" . mixal-mode)))
+
+;;;***
+\f
+;;;### (autoloads (malayalam-composition-function malayalam-compose-region)
- ;;;;;; "mlm-util" "language/mlm-util.el" (16118 44435))
++;;;;;; "mlm-util" "language/mlm-util.el" (16194 57623))
+;;; Generated autoloads from language/mlm-util.el
+
+(autoload (quote malayalam-compose-region) "mlm-util" "\
+Not documented
+
+\(fn FROM TO)" t nil)
+
+(autoload (quote malayalam-composition-function) "mlm-util" "\
- Compose Malayalam characters in REGION, or STRING if specified.
- Assume that the REGION or STRING must fully match the composable
- PATTERN regexp.
++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.
+
- \(fn FROM TO PATTERN &optional STRING)" nil nil)
++\(fn POS &optional STRING)" nil nil)
;;;***
\f
;;;### (autoloads (mm-inline-partial) "mm-partial" "gnus/mm-partial.el"
-;;;;;; (15371 46420))
+;;;;;; (15941 42960))
;;; Generated autoloads from gnus/mm-partial.el
(autoload (quote mm-inline-partial) "mm-partial" "\
Show the partial part of HANDLE.
-This function replaces the buffer of HANDLE with a buffer contains
+This function replaces the buffer of HANDLE with a buffer contains
the entire message.
-If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." nil nil)
+If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing.
+
+\(fn HANDLE &optional NO-DISPLAY)" nil nil)
;;;***
\f
;;;### (autoloads (mm-uu-test mm-uu-dissect) "mm-uu" "gnus/mm-uu.el"
-;;;;;; (15371 46420))
+;;;;;; (15961 24153))
;;; Generated autoloads from gnus/mm-uu.el
(autoload (quote mm-uu-dissect) "mm-uu" "\
-Dissect the current buffer and return a list of uu handles." nil nil)
+Dissect the current buffer and return a list of uu handles.
+
+\(fn)" nil nil)
(autoload (quote mm-uu-test) "mm-uu" "\
-Check whether the current buffer contains uu stuff." nil nil)
+Check whether the current buffer contains uu stuff.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (modula-2-mode) "modula2" "progmodes/modula2.el"
-;;;;;; (15371 46426))
+;;;;;; (15941 42965))
;;; Generated autoloads from progmodes/modula2.el
(autoload (quote modula-2-mode) "modula2" "\
`m2-indent' controls the number of spaces for each indentation.
`m2-compile-command' holds the command to compile a Modula-2 program.
- `m2-link-command' holds the command to link a Modula-2 program." t nil)
+ `m2-link-command' holds the command to link a Modula-2 program.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (unmorse-region morse-region) "morse" "play/morse.el"
-;;;;;; (15371 46425))
+;;;;;; (15856 53275))
;;; Generated autoloads from play/morse.el
(autoload (quote morse-region) "morse" "\
-Convert all text in a given region to morse code." t nil)
+Convert all text in a given region to morse code.
+
+\(fn BEG END)" t nil)
(autoload (quote unmorse-region) "morse" "\
-Convert morse coded text in region to ordinary ASCII text." t nil)
+Convert morse coded text in region to ordinary ASCII text.
+
+\(fn BEG END)" t nil)
;;;***
\f
-;;;### (autoloads (mouse-sel-mode) "mouse-sel" "mouse-sel.el" (15391
-;;;;;; 60519))
+;;;### (autoloads (mouse-sel-mode) "mouse-sel" "mouse-sel.el" (16162
+;;;;;; 11942))
;;; Generated autoloads from mouse-sel.el
+(defvar mouse-sel-mode nil "\
+Non-nil if Mouse-Sel mode is enabled.
+See the command `mouse-sel-mode' for a description of this minor-mode.
+Setting this variable directly does not take effect;
+use either \\[customize] or the function `mouse-sel-mode'.")
+
+(custom-autoload (quote mouse-sel-mode) "mouse-sel")
+
(autoload (quote mouse-sel-mode) "mouse-sel" "\
Toggle Mouse Sel mode.
With prefix ARG, turn Mouse Sel mode on if and only if ARG is positive.
Quad-clicking selects paragraphs.
- Selecting sets the region & X primary selection, but does NOT affect
-the kill-ring, nor do the kill-ring function change the X selection.
+the `kill-ring', nor do the kill-ring functions change the X selection.
Because the mouse handlers set the primary selection directly,
-mouse-sel sets the variables interprogram-cut-function and
-interprogram-paste-function to nil.
+mouse-sel sets the variables `interprogram-cut-function' and
+`interprogram-paste-function' to nil.
- Clicking mouse-2 inserts the contents of the primary selection at
the mouse position (or point, if `mouse-yank-at-point' is non-nil).
- M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2
& mouse-3, but operate on the X secondary selection rather than the
-primary selection and region." t nil)
+primary selection and region.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
-;;;### (autoloads (mpuz) "mpuz" "play/mpuz.el" (15400 1479))
+;;;### (autoloads (mpuz) "mpuz" "play/mpuz.el" (16066 53440))
;;; Generated autoloads from play/mpuz.el
(autoload (quote mpuz) "mpuz" "\
-Multiplication puzzle with GNU Emacs." t nil)
+Multiplication puzzle with GNU Emacs.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (msb-mode) "msb" "msb.el" (15400 1473))
+;;;### (autoloads (msb-mode) "msb" "msb.el" (15941 42956))
;;; Generated autoloads from msb.el
(defvar msb-mode nil "\
Setting this variable directly does not take effect;
use either \\[customize] or the function `msb-mode'.")
-(custom-add-to-group (quote msb) (quote msb-mode) (quote custom-variable))
-
-(custom-add-load (quote msb-mode) (quote msb))
+(custom-autoload (quote msb-mode) "msb")
(autoload (quote msb-mode) "msb" "\
Toggle Msb mode.
With arg, turn Msb mode on if and only if arg is positive.
This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
-different buffer menu using the function `msb'." t nil)
+different buffer menu using the function `msb'.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
--;;;### (autoloads (mule-diag list-input-methods list-fontsets describe-fontset
--;;;;;; describe-font list-coding-categories list-coding-systems
--;;;;;; describe-current-coding-system describe-current-coding-system-briefly
-;;;;;; describe-coding-system describe-char-after describe-character-set
-;;;;;; list-charset-chars read-charset list-character-sets) "mule-diag"
-;;;;;; "international/mule-diag.el" (15615 15525))
++;;;### (autoloads (unicode-data unicodedata-file mule-diag list-input-methods
++;;;;;; list-fontsets describe-fontset describe-font list-coding-categories
++;;;;;; list-coding-systems describe-current-coding-system describe-current-coding-system-briefly
+;;;;;; describe-coding-system describe-character-set list-charset-chars
+;;;;;; read-charset list-character-sets) "mule-diag" "international/mule-diag.el"
- ;;;;;; (16174 63062))
++;;;;;; (16194 5746))
;;; Generated autoloads from international/mule-diag.el
- (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) ((161 254) 64 126 161 254))) (sjis (ascii katakana-jisx0201 japanese-jisx0208) decode-sjis-char ((32 127 161 223) ((129 159 224 239) 64 126 128 252))))) "\
- 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 (quote list-character-sets) "mule-diag" "\
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
for designating this character set in ISO-2022-based coding systems.
With prefix arg, the output format gets more cryptic,
-but still shows the full information." t nil)
+but still shows the full information.
+
+\(fn ARG)" t nil)
(autoload (quote read-charset) "mule-diag" "\
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." nil nil)
+detailed meanings of these arguments.
+
+\(fn PROMPT &optional DEFAULT-VALUE INITIAL-INPUT)" nil nil)
(autoload (quote list-charset-chars) "mule-diag" "\
- 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." t nil)
++Display a list of characters in character set CHARSET.
+
+\(fn CHARSET)" t nil)
(autoload (quote describe-character-set) "mule-diag" "\
-Display information about built-in character set CHARSET." t nil)
+Display information about built-in character set CHARSET.
-(autoload (quote describe-char-after) "mule-diag" "\
-Display information about the character at POS in the current buffer.
-POS defaults to point.
-The information includes character code, charset and code points in it,
-syntax, category, how the character is encoded in a file,
-which font is being used for displaying the character." t nil)
+\(fn CHARSET)" t nil)
(autoload (quote describe-coding-system) "mule-diag" "\
-Display information about CODING-SYSTEM." t nil)
+Display information about CODING-SYSTEM.
+
+\(fn CODING-SYSTEM)" t nil)
(autoload (quote describe-current-coding-system-briefly) "mule-diag" "\
Display coding systems currently used in a brief format in echo area.
`default-process-coding-system' for read
eol-type of `default-process-coding-system' for read
`default-process-coding-system' for write
- eol-type of `default-process-coding-system'" t nil)
+ eol-type of `default-process-coding-system'
+
+\(fn)" t nil)
(autoload (quote describe-current-coding-system) "mule-diag" "\
-Display coding systems currently used, in detail." t nil)
+Display coding systems currently used, in detail.
+
+\(fn)" t nil)
(autoload (quote list-coding-systems) "mule-diag" "\
Display a list of all coding systems.
This shows the mnemonic letter, name, and description of each coding system.
With prefix arg, the output format gets more cryptic,
-but still contains full information about each coding system." t nil)
+but still contains full information about each coding system.
+
+\(fn &optional ARG)" t nil)
(autoload (quote list-coding-categories) "mule-diag" "\
-Display a list of all coding categories." nil nil)
+Display a list of all coding categories.
+
+\(fn)" nil nil)
(autoload (quote describe-font) "mule-diag" "\
-Display information about fonts which partially match FONTNAME." t nil)
+Display information about fonts which partially match FONTNAME.
+
+\(fn FONTNAME)" t nil)
(autoload (quote describe-fontset) "mule-diag" "\
Display information about FONTSET.
-This shows which font is used for which character(s)." t nil)
+This shows which font is used for which character(s).
+
+\(fn FONTSET)" t nil)
(autoload (quote list-fontsets) "mule-diag" "\
Display a list of all fontsets.
This shows the name, size, and style of each fontset.
With prefix arg, also list the fonts contained in each fontset;
-see the function `describe-fontset' for the format of the list." t nil)
+see the function `describe-fontset' for the format of the list.
+
+\(fn ARG)" t nil)
(autoload (quote list-input-methods) "mule-diag" "\
-Display information about all input methods." t nil)
+Display information about all input methods.
+
+\(fn)" t nil)
(autoload (quote mule-diag) "mule-diag" "\
Display diagnosis of the multilingual environment (Mule).
This shows various information related to the current multilingual
environment, including lists of input methods, coding systems,
character sets, and fontsets (if Emacs is running under a window
-system which uses fontsets)." t nil)
+system which uses fontsets).
+
+\(fn)" t nil)
+
++(defvar 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.")
++
++(custom-autoload (quote unicodedata-file) "mule-diag")
++
++(autoload (quote unicode-data) "mule-diag" "\
++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'.
++
++\(fn CHAR)" nil nil)
+
;;;***
\f
-;;;### (autoloads (with-coding-priority detect-coding-with-language-environment
-;;;;;; detect-coding-with-priority coding-system-equal coding-system-translation-table-for-encode
+;;;### (autoloads (detect-coding-with-language-environment detect-coding-with-priority
- ;;;;;; coding-system-equal coding-system-translation-table-for-encode
++;;;;;; with-coding-priority coding-system-equal coding-system-translation-table-for-encode
;;;;;; coding-system-translation-table-for-decode coding-system-pre-write-conversion
-;;;;;; coding-system-post-read-conversion coding-system-eol-type-mnemonic
-;;;;;; lookup-nested-alist set-nested-alist truncate-string-to-width
-;;;;;; store-substring string-to-sequence) "mule-util" "international/mule-util.el"
-;;;;;; (15601 26086))
+;;;;;; coding-system-post-read-conversion lookup-nested-alist set-nested-alist
+;;;;;; truncate-string-to-width store-substring string-to-sequence)
- ;;;;;; "mule-util" "international/mule-util.el" (15829 28908))
++;;;;;; "mule-util" "international/mule-util.el" (16182 61069))
;;; Generated autoloads from international/mule-util.el
(autoload (quote string-to-sequence) "mule-util" "\
Convert STRING to a sequence of TYPE which contains characters in STRING.
-TYPE should be `list' or `vector'." nil nil)
+TYPE should be `list' or `vector'.
+
+\(fn STRING TYPE)" nil nil)
+
+(make-obsolete (quote string-to-sequence) "use `string-to-list' or `string-to-vector'." "21.4")
(defsubst string-to-list (string) "\
Return a list of characters in STRING." (append string nil))
Return a vector of characters in STRING." (vconcat string))
(autoload (quote store-substring) "mule-util" "\
-Embed OBJ (string or character) at index IDX of STRING." nil nil)
+Embed OBJ (string or character) at index IDX of STRING.
+
+\(fn STRING IDX OBJ)" nil nil)
(autoload (quote truncate-string-to-width) "mule-util" "\
Truncate string STR to end at column END-COLUMN.
-The optional 3rd arg START-COLUMN, if non-nil, specifies
-the starting column; that means to return the characters occupying
-columns START-COLUMN ... END-COLUMN of STR.
-
-The optional 4th arg PADDING, if non-nil, specifies a padding character
-to add at the end of the result if STR doesn't reach column END-COLUMN,
-or if END-COLUMN comes in the middle of a character in STR.
-PADDING is also added at the beginning of the result
-if column START-COLUMN appears in the middle of a character in STR.
+The optional 3rd arg START-COLUMN, if non-nil, specifies the starting
+column; that means to return the characters occupying columns
+START-COLUMN ... END-COLUMN of STR. Both END-COLUMN and START-COLUMN
+are specified in terms of character display width in the current
+buffer; see also `char-width'.
+
+The optional 4th arg PADDING, if non-nil, specifies a padding
+character (which should have a display width of 1) to add at the end
+of the result if STR doesn't reach column END-COLUMN, or if END-COLUMN
+comes in the middle of a character in STR. PADDING is also added at
+the beginning of the result if column START-COLUMN appears in the
+middle of a character in STR.
If PADDING is nil, no padding is added in these cases, so
-the resulting string may be narrower than END-COLUMN." nil nil)
+the resulting string may be narrower than END-COLUMN.
+
+If ELLIPSIS is non-nil, it should be a string which will replace the
+end of STR (including any padding) if it extends beyond END-COLUMN,
+unless the display width of STR is equal to or less than the display
+width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS
+defaults to \"...\".
+
+\(fn STR END-COLUMN &optional START-COLUMN PADDING ELLIPSIS)" nil nil)
(defalias (quote truncate-string) (quote truncate-string-to-width))
+(make-obsolete (quote truncate-string) (quote truncate-string-to-width) "20.1")
+
(defsubst nested-alist-p (obj) "\
Return t if OBJ is a nested alist.
is considered.
Optional argument BRANCHES if non-nil is branches for a keyseq
longer than KEYSEQ.
-See the documentation of `nested-alist-p' for more detail." nil nil)
+See the documentation of `nested-alist-p' for more detail.
+
+\(fn KEYSEQ ENTRY ALIST &optional LEN BRANCHES)" nil nil)
(autoload (quote lookup-nested-alist) "mule-util" "\
Look up key sequence KEYSEQ in nested alist ALIST. Return the definition.
how many key elements at the front of KEYSEQ it takes
to reach a leaf in ALIST.
Optional 3rd argument NIL-FOR-TOO-LONG non-nil means return nil
- even if ALIST is not deep enough." nil nil)
+ even if ALIST is not deep enough.
-(autoload (quote coding-system-eol-type-mnemonic) "mule-util" "\
-Return the string indicating end-of-line format of CODING-SYSTEM." nil nil)
+\(fn KEYSEQ ALIST &optional LEN START NIL-FOR-TOO-LONG)" nil nil)
(autoload (quote coding-system-post-read-conversion) "mule-util" "\
-Return the value of CODING-SYSTEM's `post-read-conversion' property." nil nil)
+Return the value of CODING-SYSTEM's `post-read-conversion' property.
+
+\(fn CODING-SYSTEM)" nil nil)
(autoload (quote coding-system-pre-write-conversion) "mule-util" "\
-Return the value of CODING-SYSTEM's `pre-write-conversion' property." nil nil)
+Return the value of CODING-SYSTEM's `pre-write-conversion' property.
+
+\(fn CODING-SYSTEM)" nil nil)
(autoload (quote coding-system-translation-table-for-decode) "mule-util" "\
- Return the value of CODING-SYSTEM's `translation-table-for-decode' property.
-Return the value of CODING-SYSTEM's `translation-table-for-decode' property." nil nil)
++Return the value of CODING-SYSTEM's `decode-translation-table' property.
+
+\(fn CODING-SYSTEM)" nil nil)
(autoload (quote coding-system-translation-table-for-encode) "mule-util" "\
- Return the value of CODING-SYSTEM's `translation-table-for-encode' property.
-Return the value of CODING-SYSTEM's `translation-table-for-encode' property." nil nil)
++Return the value of CODING-SYSTEM's `encode-translation-table' property.
+
+\(fn CODING-SYSTEM)" nil nil)
(autoload (quote coding-system-equal) "mule-util" "\
Return t if and only if CODING-SYSTEM-1 and CODING-SYSTEM-2 are identical.
Two coding systems are identical if two symbols are equal
-or one is an alias of the other." nil nil)
+or one is an alias of the other.
+
+\(fn CODING-SYSTEM-1 CODING-SYSTEM-2)" nil nil)
+
++(autoload (quote with-coding-priority) "mule-util" "\
++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'.
++
++\(fn CODING-SYSTEMS &rest BODY)" nil (quote macro))
+
(autoload (quote detect-coding-with-priority) "mule-util" "\
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." nil (quote macro))
+coding systems ordered by priority.
+
+\(fn FROM TO PRIORITY-LIST)" nil (quote macro))
(autoload (quote detect-coding-with-language-environment) "mule-util" "\
Detect a coding system of the text between FROM and TO with LANG-ENV.
The detection takes into account the coding system priorities for the
-language environment LANG-ENV." nil nil)
+language environment LANG-ENV.
-(autoload (quote with-coding-priority) "mule-util" "\
-Execute BODY like `progn' with CODING-SYSTEMS at the front of priority list.
-CODING-SYSTEMS is a list of coding systems." nil (quote macro))
+\(fn FROM TO LANG-ENV)" nil nil)
;;;***
\f
;;;### (autoloads (mwheel-install mouse-wheel-mode) "mwheel" "mwheel.el"
-;;;;;; (15482 52417))
+;;;;;; (16111 41826))
;;; Generated autoloads from mwheel.el
(defvar mouse-wheel-mode nil "\
Setting this variable directly does not take effect;
use either \\[customize] or the function `mouse-wheel-mode'.")
-(custom-add-to-group (quote mouse) (quote mouse-wheel-mode) (quote custom-variable))
-
-(custom-add-load (quote mouse-wheel-mode) (quote mwheel))
+(custom-autoload (quote mouse-wheel-mode) "mwheel")
(autoload (quote mouse-wheel-mode) "mwheel" "\
Toggle mouse wheel support.
With prefix argument ARG, turn on if positive, otherwise off.
-Returns non-nil if the new state is enabled." t nil)
+Returns non-nil if the new state is enabled.
+
+\(fn &optional ARG)" t nil)
(autoload (quote mwheel-install) "mwheel" "\
-Enable mouse wheel support." nil nil)
+Enable mouse wheel support.
+
+\(fn &optional UNINSTALL)" nil nil)
;;;***
\f
;;;### (autoloads (network-connection network-connection-to-service
-;;;;;; whois-reverse-lookup whois finger ftp dig nslookup nslookup-host
-;;;;;; route arp netstat ipconfig ping traceroute) "net-utils" "net/net-utils.el"
-;;;;;; (15425 28364))
+;;;;;; whois-reverse-lookup whois finger ftp dig dns-lookup-host
+;;;;;; nslookup nslookup-host route arp netstat ipconfig ping traceroute)
+;;;;;; "net-utils" "net/net-utils.el" (16011 28193))
;;; Generated autoloads from net/net-utils.el
(autoload (quote traceroute) "net-utils" "\
-Run traceroute program for TARGET." t nil)
+Run traceroute program for TARGET.
+
+\(fn TARGET)" t nil)
(autoload (quote ping) "net-utils" "\
Ping HOST.
If your system's ping continues until interrupted, you can try setting
-`ping-program-options'." t nil)
+`ping-program-options'.
+
+\(fn HOST)" t nil)
(autoload (quote ipconfig) "net-utils" "\
-Run ipconfig program." t nil)
+Run ipconfig program.
+
+\(fn)" t nil)
(defalias (quote ifconfig) (quote ipconfig))
(autoload (quote netstat) "net-utils" "\
-Run netstat program." t nil)
+Run netstat program.
+
+\(fn)" t nil)
(autoload (quote arp) "net-utils" "\
-Run the arp program." t nil)
+Run the arp program.
+
+\(fn)" t nil)
(autoload (quote route) "net-utils" "\
-Run the route program." t nil)
+Run the route program.
+
+\(fn)" t nil)
(autoload (quote nslookup-host) "net-utils" "\
-Lookup the DNS information for HOST." t nil)
+Lookup the DNS information for HOST.
+
+\(fn HOST)" t nil)
(autoload (quote nslookup) "net-utils" "\
-Run nslookup program." t nil)
+Run nslookup program.
+
+\(fn)" t nil)
+
+(autoload (quote dns-lookup-host) "net-utils" "\
+Lookup the DNS information for HOST (name or IP address).
+
+\(fn HOST)" t nil)
(autoload (quote dig) "net-utils" "\
-Run dig program." t nil)
+Run dig program.
+
+\(fn HOST)" t nil)
(autoload (quote ftp) "net-utils" "\
-Run ftp program." t nil)
+Run ftp program.
+
+\(fn HOST)" t nil)
(autoload (quote finger) "net-utils" "\
-Finger USER on HOST." t nil)
+Finger USER on HOST.
+
+\(fn USER HOST)" t nil)
(autoload (quote whois) "net-utils" "\
Send SEARCH-STRING to server defined by the `whois-server-name' variable.
If `whois-guess-server' is non-nil, then try to deduce the correct server
-from SEARCH-STRING. With argument, prompt for whois server." t nil)
+from SEARCH-STRING. With argument, prompt for whois server.
+
+\(fn ARG SEARCH-STRING)" t nil)
-(autoload (quote whois-reverse-lookup) "net-utils" nil t nil)
+(autoload (quote whois-reverse-lookup) "net-utils" "\
+Not documented
+
+\(fn)" t nil)
(autoload (quote network-connection-to-service) "net-utils" "\
-Open a network connection to SERVICE on HOST." t nil)
+Open a network connection to SERVICE on HOST.
+
+\(fn HOST SERVICE)" t nil)
(autoload (quote network-connection) "net-utils" "\
-Open a network connection to HOST on PORT." t nil)
+Open a network connection to HOST on PORT.
+
+\(fn HOST PORT)" t nil)
;;;***
\f
-;;;### (autoloads (comment-indent-new-line comment-dwim comment-region
-;;;;;; uncomment-region comment-kill comment-set-column comment-indent
-;;;;;; comment-indent-default comment-normalize-vars comment-multi-line
-;;;;;; comment-padding comment-style comment-column) "newcomment"
-;;;;;; "newcomment.el" (15427 61506))
+;;;### (autoloads (comment-indent-new-line comment-dwim comment-or-uncomment-region
+;;;;;; comment-region uncomment-region comment-kill comment-set-column
+;;;;;; comment-indent comment-indent-default comment-normalize-vars
+;;;;;; comment-multi-line comment-padding comment-style comment-column)
+;;;;;; "newcomment" "newcomment.el" (16136 53054))
;;; Generated autoloads from newcomment.el
(defalias (quote indent-for-comment) (quote comment-indent))
(defalias (quote indent-new-comment-line) (quote comment-indent-new-line))
-(defgroup comment nil "Indenting and filling of comments." :prefix "comment-" :version "21.1" :group (quote fill))
+(defvar comment-use-syntax (quote undecided) "\
+Non-nil if syntax-tables can be used instead of regexps.
+Can also be `undecided' which means that a somewhat expensive test will
+be used to try to determine whether syntax-tables should be trusted
+to understand comments or not in the given buffer.
+Major modes should set this variable.")
(defvar comment-column 32 "\
*Column to indent right-margin comments to.
-Setting this variable automatically makes it local to the current buffer.
Each mode establishes a different default value for this variable; you
-can set the value for a particular mode using that mode's hook.")
+can set the value for a particular mode using that mode's hook.
+Comments might be indented to a value smaller than this in order
+not to go beyond `comment-fill-column'.")
+
+(custom-autoload (quote comment-column) "newcomment")
(defvar comment-start nil "\
*String to insert to start a new comment, or nil if no comment syntax.")
*Style to be used for `comment-region'.
See `comment-styles' for a list of available styles.")
+(custom-autoload (quote comment-style) "newcomment")
+
(defvar comment-padding " " "\
Padding string that `comment-region' puts between comment chars and text.
Can also be an integer which will be automatically turned into a string
Extra spacing between the comment characters and the comment text
makes the comment easier to read. Default is 1. nil means 0.")
+(custom-autoload (quote comment-padding) "newcomment")
+
(defvar comment-multi-line nil "\
*Non-nil means \\[comment-indent-new-line] continues comments, with no new terminator or starter.
This is obsolete because you might as well use \\[newline-and-indent].")
-(autoload (quote comment-normalize-vars) "newcomment" nil nil nil)
+(custom-autoload (quote comment-multi-line) "newcomment")
+
+(autoload (quote comment-normalize-vars) "newcomment" "\
+Check and setup the variables needed by other commenting functions.
+Functions autoloaded from newcomment.el, being entry points, should call
+this function before any other, so the rest of the code can assume that
+the variables are properly set.
+
+\(fn &optional NOERROR)" nil nil)
(autoload (quote comment-indent-default) "newcomment" "\
-Default for `comment-indent-function'." nil nil)
+Default for `comment-indent-function'.
+
+\(fn)" nil nil)
(autoload (quote comment-indent) "newcomment" "\
Indent this line's comment to comment column, or insert an empty comment.
-If CONTINUE is non-nil, use the `comment-continue' markers if any." t nil)
+If CONTINUE is non-nil, use the `comment-continue' markers if any.
+
+\(fn &optional CONTINUE)" t nil)
(autoload (quote comment-set-column) "newcomment" "\
Set the comment column based on point.
With no ARG, set the comment column to the current column.
With just minus as arg, kill any comment on this line.
With any other arg, set comment column to indentation of the previous comment
- and then align or create a comment on this line at that column." t nil)
+ and then align or create a comment on this line at that column.
+
+\(fn ARG)" t nil)
(autoload (quote comment-kill) "newcomment" "\
Kill the comment on this line, if any.
-With prefix ARG, kill comments on that many lines starting with this one." t nil)
+With prefix ARG, kill comments on that many lines starting with this one.
+
+\(fn ARG)" t nil)
(autoload (quote uncomment-region) "newcomment" "\
-Uncomment each line in the BEG..END region.
+Uncomment each line in the BEG .. END region.
The numeric prefix ARG can specify a number of chars to remove from the
-comment markers." t nil)
+comment markers.
+
+\(fn BEG END &optional ARG)" t nil)
(autoload (quote comment-region) "newcomment" "\
Comment or uncomment each line in the region.
-With just \\[universal-argument] prefix arg, uncomment each line in region BEG..END.
+With just \\[universal-argument] prefix arg, uncomment each line in region BEG .. END.
Numeric prefix arg ARG means use ARG comment characters.
If ARG is negative, delete that many comment characters instead.
By default, comments start at the left margin, are terminated on each line,
do not get comments. This can be changed with `comment-style'.
The strings used as comment starts are built from
-`comment-start' without trailing spaces and `comment-padding'." t nil)
+`comment-start' without trailing spaces and `comment-padding'.
+
+\(fn BEG END &optional ARG)" t nil)
+
+(autoload (quote comment-or-uncomment-region) "newcomment" "\
+Call `comment-region', unless the region only consists of comments,
+in which case call `uncomment-region'. If a prefix arg is given, it
+is passed on to the respective function.
+
+\(fn BEG END &optional ARG)" t nil)
(autoload (quote comment-dwim) "newcomment" "\
Call the comment command you want (Do What I Mean).
case it calls `uncomment-region').
Else, if the current line is empty, insert a comment and indent it.
Else if a prefix ARG is specified, call `comment-kill'.
-Else, call `comment-indent'." t nil)
+Else, call `comment-indent'.
+
+\(fn ARG)" t nil)
(autoload (quote comment-indent-new-line) "newcomment" "\
Break line at point and indent, continuing comment if within one.
or comment indentation.
The inserted newline is marked hard if variable `use-hard-newlines' is true,
-unless optional argument SOFT is non-nil." t nil)
+unless optional argument SOFT is non-nil.
+
+\(fn &optional SOFT)" t nil)
;;;***
\f
-;;;### (autoloads (nndoc-add-type) "nndoc" "gnus/nndoc.el" (15371
-;;;;;; 46420))
+;;;### (autoloads (nndoc-add-type) "nndoc" "gnus/nndoc.el" (15941
+;;;;;; 42960))
;;; Generated autoloads from gnus/nndoc.el
(autoload (quote nndoc-add-type) "nndoc" "\
If POSITION is nil or `last', the definition will be added
as the last checked definition, if t or `first', add as the
first definition, and if any other symbol, add after that
-symbol in the alist." nil nil)
+symbol in the alist.
+
+\(fn DEFINITION &optional POSITION)" nil nil)
;;;***
\f
;;;### (autoloads (nnfolder-generate-active-file) "nnfolder" "gnus/nnfolder.el"
-;;;;;; (15400 1476))
+;;;;;; (15997 671))
;;; Generated autoloads from gnus/nnfolder.el
(autoload (quote nnfolder-generate-active-file) "nnfolder" "\
Look for mbox folders in the nnfolder directory and make them into groups.
-This command does not work if you use short group names." t nil)
+This command does not work if you use short group names.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (nnkiboze-generate-groups) "nnkiboze" "gnus/nnkiboze.el"
-;;;;;; (15371 46421))
+;;;;;; (15941 42960))
;;; Generated autoloads from gnus/nnkiboze.el
(autoload (quote nnkiboze-generate-groups) "nnkiboze" "\
\"Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups\".
-Finds out what articles are to be part of the nnkiboze groups." t nil)
+Finds out what articles are to be part of the nnkiboze groups.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (nnml-generate-nov-databases) "nnml" "gnus/nnml.el"
-;;;;;; (15371 46421))
+;;;;;; (15941 42960))
;;; Generated autoloads from gnus/nnml.el
(autoload (quote nnml-generate-nov-databases) "nnml" "\
-Generate NOV databases in all nnml directories." t nil)
+Generate NOV databases in all nnml directories.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (nnsoup-revert-variables nnsoup-set-variables nnsoup-pack-replies)
-;;;;;; "nnsoup" "gnus/nnsoup.el" (15371 46421))
+;;;;;; "nnsoup" "gnus/nnsoup.el" (15941 42960))
;;; Generated autoloads from gnus/nnsoup.el
(autoload (quote nnsoup-pack-replies) "nnsoup" "\
-Make an outbound package of SOUP replies." t nil)
+Make an outbound package of SOUP replies.
+
+\(fn)" t nil)
(autoload (quote nnsoup-set-variables) "nnsoup" "\
-Use the SOUP methods for posting news and mailing mail." t nil)
+Use the SOUP methods for posting news and mailing mail.
+
+\(fn)" t nil)
(autoload (quote nnsoup-revert-variables) "nnsoup" "\
-Revert posting and mailing methods to the standard Emacs methods." t nil)
+Revert posting and mailing methods to the standard Emacs methods.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (disable-command enable-command disabled-command-hook)
-;;;;;; "novice" "novice.el" (15455 18400))
+;;;;;; "novice" "novice.el" (15513 43128))
;;; Generated autoloads from novice.el
(defvar disabled-command-hook (quote disabled-command-hook) "\
Function to call to handle disabled commands.
If nil, the feature is disabled, i.e., all commands work normally.")
-(autoload (quote disabled-command-hook) "novice" nil nil nil)
+(autoload (quote disabled-command-hook) "novice" "\
+Not documented
+
+\(fn &rest IGNORE)" nil nil)
(autoload (quote enable-command) "novice" "\
Allow COMMAND to be executed without special confirmation from now on.
The user's .emacs file is altered so that this will apply
-to future sessions." t nil)
+to future sessions.
+
+\(fn COMMAND)" t nil)
(autoload (quote disable-command) "novice" "\
Require special confirmation to execute COMMAND from now on.
The user's .emacs file is altered so that this will apply
-to future sessions." t nil)
+to future sessions.
+
+\(fn COMMAND)" t nil)
;;;***
\f
;;;### (autoloads (nroff-mode) "nroff-mode" "textmodes/nroff-mode.el"
-;;;;;; (15371 46416))
+;;;;;; (15924 18776))
;;; Generated autoloads from textmodes/nroff-mode.el
(autoload (quote nroff-mode) "nroff-mode" "\
\\{nroff-mode-map}
Turning on Nroff mode runs `text-mode-hook', then `nroff-mode-hook'.
Also, try `nroff-electric-mode', for automatically inserting
-closing requests for requests that are used in matched pairs." t nil)
+closing requests for requests that are used in matched pairs.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (octave-help) "octave-hlp" "progmodes/octave-hlp.el"
-;;;;;; (15371 46426))
+;;;;;; (15941 42965))
;;; Generated autoloads from progmodes/octave-hlp.el
(autoload (quote octave-help) "octave-hlp" "\
Get help on Octave symbols from the Octave info files.
Look up KEY in the function, operator and variable indices of the files
specified by `octave-help-files'.
-If KEY is not a string, prompt for it with completion." t nil)
+If KEY is not a string, prompt for it with completion.
+
+\(fn KEY)" t nil)
;;;***
\f
;;;### (autoloads (inferior-octave) "octave-inf" "progmodes/octave-inf.el"
-;;;;;; (15371 46426))
+;;;;;; (15941 42965))
;;; Generated autoloads from progmodes/octave-inf.el
(autoload (quote inferior-octave) "octave-inf" "\
Additional commands to be executed on startup can be provided either in
the file specified by `inferior-octave-startup-file' or by the default
-startup file, `~/.emacs-octave'." t nil)
+startup file, `~/.emacs-octave'.
+
+\(fn &optional ARG)" t nil)
(defalias (quote run-octave) (quote inferior-octave))
;;;***
\f
;;;### (autoloads (octave-mode) "octave-mod" "progmodes/octave-mod.el"
-;;;;;; (15417 7451))
+;;;;;; (15941 42965))
;;; Generated autoloads from progmodes/octave-mod.el
(autoload (quote octave-mode) "octave-mod" "\
To submit a problem report, enter \\[octave-submit-bug-report] from an Octave mode buffer.
This automatically sets up a mail buffer with version information
already added. You just need to add a description of the problem,
-including a reproducible test case and send the message." t nil)
+including a reproducible test case and send the message.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (edit-options list-options) "options" "options.el"
-;;;;;; (15371 46418))
-;;; Generated autoloads from options.el
+;;;### (autoloads (edit-options list-options) "options" "obsolete/options.el"
+;;;;;; (16087 59373))
+;;; Generated autoloads from obsolete/options.el
(autoload (quote list-options) "options" "\
Display a list of Emacs user options, with values and documentation.
-It is now better to use Customize instead." t nil)
+It is now better to use Customize instead.
+
+\(fn)" t nil)
(autoload (quote edit-options) "options" "\
Edit a list of Emacs user option values.
in which there are commands to set the option values.
Type \\[describe-mode] in that buffer for a list of commands.
-The Custom feature is intended to make this obsolete." t nil)
+The Custom feature is intended to make this obsolete.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (outline-minor-mode outline-mode) "outline" "textmodes/outline.el"
-;;;;;; (15391 60719))
-;;; Generated autoloads from textmodes/outline.el
+;;;### (autoloads (outline-minor-mode outline-mode) "outline" "outline.el"
+;;;;;; (16168 11508))
+;;; Generated autoloads from outline.el
(autoload (quote outline-mode) "outline" "\
Set major mode for editing outlines with selective display.
\\[hide-body] make all text invisible (not headings).
\\[show-all] make everything in buffer visible.
+\\[hide-sublevels] make only the first N levels of headers visible.
The remaining commands are used when point is on a heading line.
They apply to some of the body or subheadings of that heading.
beginning of the line. The longer the match, the deeper the level.
Turning on outline mode calls the value of `text-mode-hook' and then of
-`outline-mode-hook', if they are non-nil." t nil)
+`outline-mode-hook', if they are non-nil.
+
+\(fn)" t nil)
(autoload (quote outline-minor-mode) "outline" "\
Toggle Outline minor mode.
With arg, turn Outline minor mode on if arg is positive, off otherwise.
-See the command `outline-mode' for more information on this mode." t nil)
+See the command `outline-mode' for more information on this mode.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
-;;;### (autoloads (show-paren-mode) "paren" "paren.el" (15371 46418))
+;;;### (autoloads (show-paren-mode) "paren" "paren.el" (15941 42956))
;;; Generated autoloads from paren.el
(defvar show-paren-mode nil "\
Setting this variable directly does not take effect;
use either \\[customize] or the function `show-paren-mode'.")
-(custom-add-to-group (quote paren-showing) (quote show-paren-mode) (quote custom-variable))
-
-(custom-add-load (quote show-paren-mode) (quote paren))
+(custom-autoload (quote show-paren-mode) "paren")
(autoload (quote show-paren-mode) "paren" "\
Toggle Show Paren mode.
Returns the new status of Show Paren mode (non-nil means on).
When Show Paren mode is enabled, any matching parenthesis is highlighted
-in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time." t nil)
+in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
-;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (15465
-;;;;;; 50527))
+;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (15941
+;;;;;; 42965))
;;; Generated autoloads from progmodes/pascal.el
(autoload (quote pascal-mode) "pascal" "\
pascal-separator-keywords.
Turning on Pascal mode calls the value of the variable pascal-mode-hook with
-no args, if that value is non-nil." t nil)
+no args, if that value is non-nil.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (pc-bindings-mode) "pc-mode" "emulation/pc-mode.el"
-;;;;;; (15371 46419))
+;;;;;; (15223 38063))
;;; Generated autoloads from emulation/pc-mode.el
(autoload (quote pc-bindings-mode) "pc-mode" "\
M-Backspace does undo.
Home and End move to beginning and end of line
C-Home and C-End move to beginning and end of buffer.
-C-Escape does list-buffers." t nil)
+C-Escape does list-buffers.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (pc-selection-mode pc-selection-mode) "pc-select"
-;;;;;; "emulation/pc-select.el" (15455 18402))
+;;;;;; "emulation/pc-select.el" (15941 42958))
;;; Generated autoloads from emulation/pc-select.el
(defvar pc-selection-mode nil "\
Setting this variable directly does not take effect;
use either \\[customize] or the function `pc-selection-mode'.")
-(custom-add-to-group (quote pc-select) (quote pc-selection-mode) (quote custom-variable))
-
-(custom-add-load (quote pc-selection-mode) (quote pc-select))
+(custom-autoload (quote pc-selection-mode) "pc-select")
(autoload (quote pc-selection-mode) "pc-select" "\
Change mark behaviour to emulate Motif, MAC or MS-Windows cut and paste style.
M-DELETE kill-word
C-M-DELETE kill-sexp
C-BACKSPACE backward-kill-word
- M-BACKSPACE undo" t nil)
+ M-BACKSPACE undo
+
+\(fn &optional ARG)" t nil)
(defvar pc-selection-mode nil "\
Toggle PC Selection mode.
This mode enables Delete Selection mode and Transient Mark mode.
You must modify via \\[customize] for this variable to have an effect.")
-(custom-add-to-group (quote pc-select) (quote pc-selection-mode) (quote custom-variable))
-
-(custom-add-load (quote pc-selection-mode) (quote pc-select))
+(custom-autoload (quote pc-selection-mode) "pc-select")
;;;***
\f
-;;;### (autoloads (pcomplete/cvs) "pcmpl-cvs" "pcmpl-cvs.el" (15371
-;;;;;; 46418))
+;;;### (autoloads (pcomplete/cvs) "pcmpl-cvs" "pcmpl-cvs.el" (15678
+;;;;;; 51468))
;;; Generated autoloads from pcmpl-cvs.el
(autoload (quote pcomplete/cvs) "pcmpl-cvs" "\
-Completion rules for the `cvs' command." nil nil)
+Completion rules for the `cvs' command.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (pcomplete/tar pcomplete/make pcomplete/bzip2 pcomplete/gzip)
-;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (15371 46418))
+;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (15186 43679))
;;; Generated autoloads from pcmpl-gnu.el
(autoload (quote pcomplete/gzip) "pcmpl-gnu" "\
-Completion for `gzip'." nil nil)
+Completion for `gzip'.
+
+\(fn)" nil nil)
(autoload (quote pcomplete/bzip2) "pcmpl-gnu" "\
-Completion for `bzip2'." nil nil)
+Completion for `bzip2'.
+
+\(fn)" nil nil)
(autoload (quote pcomplete/make) "pcmpl-gnu" "\
-Completion for GNU `make'." nil nil)
+Completion for GNU `make'.
+
+\(fn)" nil nil)
(autoload (quote pcomplete/tar) "pcmpl-gnu" "\
-Completion for the GNU tar utility." nil nil)
+Completion for the GNU tar utility.
+
+\(fn)" nil nil)
(defalias (quote pcomplete/gdb) (quote pcomplete/xargs))
;;;***
\f
;;;### (autoloads (pcomplete/mount pcomplete/umount pcomplete/kill)
-;;;;;; "pcmpl-linux" "pcmpl-linux.el" (15371 46418))
+;;;;;; "pcmpl-linux" "pcmpl-linux.el" (15186 43679))
;;; Generated autoloads from pcmpl-linux.el
(autoload (quote pcomplete/kill) "pcmpl-linux" "\
-Completion for GNU/Linux `kill', using /proc filesystem." nil nil)
+Completion for GNU/Linux `kill', using /proc filesystem.
+
+\(fn)" nil nil)
(autoload (quote pcomplete/umount) "pcmpl-linux" "\
-Completion for GNU/Linux `umount'." nil nil)
+Completion for GNU/Linux `umount'.
+
+\(fn)" nil nil)
(autoload (quote pcomplete/mount) "pcmpl-linux" "\
-Completion for GNU/Linux `mount'." nil nil)
+Completion for GNU/Linux `mount'.
+
+\(fn)" nil nil)
;;;***
\f
-;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (15371
-;;;;;; 46418))
+;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (15186
+;;;;;; 43679))
;;; Generated autoloads from pcmpl-rpm.el
(autoload (quote pcomplete/rpm) "pcmpl-rpm" "\
These rules were taken from the output of `rpm --help' on a RedHat 6.1
system. They follow my interpretation of what followed, but since I'm
not a major rpm user/builder, please send me any corrections you find.
-You can use \\[eshell-report-bug] to do so." nil nil)
+You can use \\[eshell-report-bug] to do so.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (pcomplete/chgrp pcomplete/chown pcomplete/which
;;;;;; pcomplete/xargs pcomplete/rm pcomplete/rmdir pcomplete/cd)
-;;;;;; "pcmpl-unix" "pcmpl-unix.el" (15371 46418))
+;;;;;; "pcmpl-unix" "pcmpl-unix.el" (15186 43679))
;;; Generated autoloads from pcmpl-unix.el
(autoload (quote pcomplete/cd) "pcmpl-unix" "\
-Completion for `cd'." nil nil)
+Completion for `cd'.
+
+\(fn)" nil nil)
(defalias (quote pcomplete/pushd) (quote pcomplete/cd))
(autoload (quote pcomplete/rmdir) "pcmpl-unix" "\
-Completion for `rmdir'." nil nil)
+Completion for `rmdir'.
+
+\(fn)" nil nil)
(autoload (quote pcomplete/rm) "pcmpl-unix" "\
-Completion for `rm'." nil nil)
+Completion for `rm'.
+
+\(fn)" nil nil)
(autoload (quote pcomplete/xargs) "pcmpl-unix" "\
-Completion for `xargs'." nil nil)
+Completion for `xargs'.
+
+\(fn)" nil nil)
(defalias (quote pcomplete/time) (quote pcomplete/xargs))
(autoload (quote pcomplete/which) "pcmpl-unix" "\
-Completion for `which'." nil nil)
+Completion for `which'.
+
+\(fn)" nil nil)
(autoload (quote pcomplete/chown) "pcmpl-unix" "\
-Completion for the `chown' command." nil nil)
+Completion for the `chown' command.
+
+\(fn)" nil nil)
(autoload (quote pcomplete/chgrp) "pcmpl-unix" "\
-Completion for the `chgrp' command." nil nil)
+Completion for the `chgrp' command.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (pcomplete-shell-setup pcomplete-comint-setup pcomplete-list
;;;;;; pcomplete-help pcomplete-expand pcomplete-continue pcomplete-expand-and-complete
-;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (15371
-;;;;;; 46418))
+;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (15941
+;;;;;; 42956))
;;; Generated autoloads from pcomplete.el
(autoload (quote pcomplete) "pcomplete" "\
Support extensible programmable completion.
To use this function, just bind the TAB key to it, or add it to your
-completion functions list (it should occur fairly early in the list)." t nil)
+completion functions list (it should occur fairly early in the list).
+
+\(fn)" t nil)
(autoload (quote pcomplete-reverse) "pcomplete" "\
-If cycling completion is in use, cycle backwards." t nil)
+If cycling completion is in use, cycle backwards.
+
+\(fn)" t nil)
(autoload (quote pcomplete-expand-and-complete) "pcomplete" "\
Expand the textual value of the current argument.
-This will modify the current buffer." t nil)
+This will modify the current buffer.
+
+\(fn)" t nil)
(autoload (quote pcomplete-continue) "pcomplete" "\
-Complete without reference to any cycling completions." t nil)
+Complete without reference to any cycling completions.
+
+\(fn)" t nil)
(autoload (quote pcomplete-expand) "pcomplete" "\
Expand the textual value of the current argument.
-This will modify the current buffer." t nil)
+This will modify the current buffer.
+
+\(fn)" t nil)
(autoload (quote pcomplete-help) "pcomplete" "\
-Display any help information relative to the current argument." t nil)
+Display any help information relative to the current argument.
+
+\(fn)" t nil)
(autoload (quote pcomplete-list) "pcomplete" "\
-Show the list of possible completions for the current argument." t nil)
+Show the list of possible completions for the current argument.
+
+\(fn)" t nil)
(autoload (quote pcomplete-comint-setup) "pcomplete" "\
Setup a comint buffer to use pcomplete.
COMPLETEF-SYM should be the symbol where the
dynamic-complete-functions are kept. For comint mode itself, this is
-`comint-dynamic-complete-functions'." nil nil)
+`comint-dynamic-complete-functions'.
+
+\(fn COMPLETEF-SYM)" nil nil)
(autoload (quote pcomplete-shell-setup) "pcomplete" "\
-Setup shell-mode to use pcomplete." nil nil)
+Setup shell-mode to use pcomplete.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (cvs-dired-use-hook cvs-dired-action cvs-status
;;;;;; cvs-update cvs-examine cvs-quickdir cvs-checkout) "pcvs"
-;;;;;; "pcvs.el" (15444 42462))
+;;;;;; "pcvs.el" (16111 41826))
;;; Generated autoloads from pcvs.el
(autoload (quote cvs-checkout) "pcvs" "\
Feed the output to a *cvs* buffer, display it in the current window,
and run `cvs-mode' on it.
-With a prefix argument, prompt for cvs FLAGS to use." t nil)
+With a prefix argument, prompt for cvs FLAGS to use.
+
+\(fn MODULES DIR FLAGS)" t nil)
(autoload (quote cvs-quickdir) "pcvs" "\
Open a *cvs* buffer on DIR without running cvs.
A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
prevents reuse of an existing *cvs* buffer.
Optional argument NOSHOW if non-nil means not to display the buffer.
-FLAGS is ignored." t nil)
+FLAGS is ignored.
+
+\(fn DIR &optional FLAGS NOSHOW)" t nil)
(autoload (quote cvs-examine) "pcvs" "\
Run a `cvs -n update' in the specified DIRECTORY.
With a prefix argument, prompt for a directory and cvs FLAGS to use.
A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
prevents reuse of an existing *cvs* buffer.
-Optional argument NOSHOW if non-nil means not to display the buffer." t nil)
+Optional argument NOSHOW if non-nil means not to display the buffer.
+
+\(fn DIRECTORY FLAGS &optional NOSHOW)" t nil)
(autoload (quote cvs-update) "pcvs" "\
Run a `cvs update' in the current working DIRECTORY.
Feed the output to a *cvs* buffer and run `cvs-mode' on it.
-With a prefix argument, prompt for a directory and cvs FLAGS to use.
+With a \\[universal-argument] prefix argument, prompt for a directory to use.
A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
- prevents reuse of an existing *cvs* buffer." t nil)
+ prevents reuse of an existing *cvs* buffer.
+The prefix is also passed to `cvs-flags-query' to select the FLAGS
+ passed to cvs.
+
+\(fn DIRECTORY FLAGS)" t nil)
(autoload (quote cvs-status) "pcvs" "\
Run a `cvs status' in the current working DIRECTORY.
With a prefix argument, prompt for a directory and cvs FLAGS to use.
A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
prevents reuse of an existing *cvs* buffer.
-Optional argument NOSHOW if non-nil means not to display the buffer." t nil)
+Optional argument NOSHOW if non-nil means not to display the buffer.
+
+\(fn DIRECTORY FLAGS &optional NOSHOW)" t nil)
(add-to-list (quote completion-ignored-extensions) "CVS/")
The action to be performed when opening a CVS directory.
Sensible values are `cvs-examine', `cvs-status' and `cvs-quickdir'.")
+(custom-autoload (quote cvs-dired-action) "pcvs")
+
(defvar cvs-dired-use-hook (quote (4)) "\
Whether or not opening a CVS directory should run PCL-CVS.
nil means never do it.
command that prompted the opening of the directory.
Anything else means to do it only if the prefix arg is equal to this value.")
+(custom-autoload (quote cvs-dired-use-hook) "pcvs")
+
(defun cvs-dired-noselect (dir) "\
Run `cvs-examine' if DIR is a CVS administrative directory.
The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp dir) (setq dir (directory-file-name dir)) (when (and (string= "CVS" (file-name-nondirectory dir)) (file-readable-p (expand-file-name "Entries" dir)) cvs-dired-use-hook (if (eq cvs-dired-use-hook (quote always)) (not current-prefix-arg) (equal current-prefix-arg cvs-dired-use-hook))) (save-excursion (funcall cvs-dired-action (file-name-directory dir) t t)))))
;;;***
\f
-;;;### (autoloads nil "pcvs-defs" "pcvs-defs.el" (15400 1473))
+;;;### (autoloads nil "pcvs-defs" "pcvs-defs.el" (16111 41826))
;;; Generated autoloads from pcvs-defs.el
-(defvar cvs-global-menu (let ((m (make-sparse-keymap "PCL-CVS"))) (define-key m [status] (quote (menu-item "Directory Status" cvs-status :help "A more verbose status of a workarea"))) (define-key m [checkout] (quote (menu-item "Checkout Module" cvs-checkout :help "Check out a module from the repository"))) (define-key m [update] (quote (menu-item "Update Directory" cvs-update :help "Fetch updates from the repository"))) (define-key m [examine] (quote (menu-item "Examine Directory" cvs-examine :help "Examine the current state of a workarea"))) m))
+(defvar cvs-global-menu (let ((m (make-sparse-keymap "PCL-CVS"))) (define-key m [status] (quote (menu-item "Directory Status" cvs-status :help "A more verbose status of a workarea"))) (define-key m [checkout] (quote (menu-item "Checkout Module" cvs-checkout :help "Check out a module from the repository"))) (define-key m [update] (quote (menu-item "Update Directory" cvs-update :help "Fetch updates from the repository"))) (define-key m [examine] (quote (menu-item "Examine Directory" cvs-examine :help "Examine the current state of a workarea"))) (fset (quote cvs-global-menu) m)))
;;;***
\f
;;;### (autoloads (perl-mode) "perl-mode" "progmodes/perl-mode.el"
-;;;;;; (15441 20097))
+;;;;;; (16111 41834))
;;; Generated autoloads from progmodes/perl-mode.el
(autoload (quote perl-mode) "perl-mode" "\
regardless of where in the line point is when the TAB command is used.
`perl-tab-to-comment'
Non-nil means that for lines which don't need indenting, TAB will
- either delete an empty comment, indent an existing comment, move
+ either delete an empty comment, indent an existing comment, move
to end-of-line, or if at end-of-line already, create a new comment.
`perl-nochange'
Lines starting with this regular expression are not auto-indented.
perl-brace-imaginary-offset 0 0 4 0 0
perl-label-offset -5 -8 -2 -2 -2
-Turning on Perl mode runs the normal hook `perl-mode-hook'." t nil)
+Turning on Perl mode runs the normal hook `perl-mode-hook'.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (picture-mode) "picture" "textmodes/picture.el"
-;;;;;; (15391 60719))
+;;;;;; (15924 18776))
;;; Generated autoloads from textmodes/picture.el
(autoload (quote picture-mode) "picture" "\
Entry to this mode calls the value of `picture-mode-hook' if non-nil.
Note that Picture mode commands will work outside of Picture mode, but
-they are not defaultly assigned to keys." t nil)
+they are not defaultly assigned to keys.
+
+\(fn)" t nil)
(defalias (quote edit-picture) (quote picture-mode))
;;;***
\f
-;;;### (autoloads (pong) "pong" "play/pong.el" (15464 26331))
+;;;### (autoloads (po-find-file-coding-system) "po" "textmodes/po.el"
+;;;;;; (16148 4633))
+;;; Generated autoloads from textmodes/po.el
+
+(autoload (quote po-find-file-coding-system) "po" "\
+Return a (DECODING . ENCODING) pair, according to PO file's charset.
+Called through `file-coding-system-alist', before the file is visited for real.
+
+\(fn ARG-LIST)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (pong) "pong" "play/pong.el" (15941 42963))
;;; Generated autoloads from play/pong.el
(autoload (quote pong) "pong" "\
pong-mode keybindings:\\<pong-mode-map>
-\\{pong-mode-map}" t nil)
+\\{pong-mode-map}
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (pp-eval-last-sexp pp-eval-expression pp pp-to-string)
-;;;;;; "pp" "emacs-lisp/pp.el" (15468 8218))
+;;;;;; "pp" "emacs-lisp/pp.el" (15941 42958))
;;; Generated autoloads from emacs-lisp/pp.el
(autoload (quote pp-to-string) "pp" "\
Return a string containing the pretty-printed representation of OBJECT.
OBJECT can be any Lisp object. Quoting characters are used as needed
-to make output that `read' can handle, whenever this is possible." nil nil)
+to make output that `read' can handle, whenever this is possible.
+
+\(fn OBJECT)" nil nil)
(autoload (quote pp) "pp" "\
Output the pretty-printed representation of OBJECT, any Lisp object.
Quoting characters are printed as needed to make output that `read'
can handle, whenever this is possible.
-Output stream is STREAM, or value of `standard-output' (which see)." nil nil)
+Output stream is STREAM, or value of `standard-output' (which see).
+
+\(fn OBJECT &optional STREAM)" nil nil)
(autoload (quote pp-eval-expression) "pp" "\
Evaluate EXPRESSION and pretty-print value into a new display buffer.
If the pretty-printed value fits on one line, the message line is used
instead. The value is also consed onto the front of the list
-in the variable `values'." t nil)
+in the variable `values'.
+
+\(fn EXPRESSION)" t nil)
(autoload (quote pp-eval-last-sexp) "pp" "\
Run `pp-eval-expression' on sexp before point (which see).
With argument, pretty-print output into current buffer.
-Ignores leading comment characters." t nil)
+Ignores leading comment characters.
+
+\(fn ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (pr-txt-fast-fire pr-ps-fast-fire pr-show-lpr-setup
+;;;;;; pr-show-pr-setup pr-show-ps-setup pr-ps-utility pr-txt-name
+;;;;;; pr-ps-name pr-help lpr-customize pr-customize pr-toggle-mode
+;;;;;; pr-toggle-region pr-toggle-lock pr-toggle-header-frame pr-toggle-header
+;;;;;; pr-toggle-zebra pr-toggle-line pr-toggle-upside-down pr-toggle-landscape
+;;;;;; pr-toggle-tumble pr-toggle-duplex pr-toggle-spool pr-toggle-faces
+;;;;;; pr-toggle-ghostscript pr-toggle-file-landscape pr-toggle-file-tumble
+;;;;;; pr-toggle-file-duplex pr-ps-file-up-ps-print pr-ps-file-ps-print
+;;;;;; pr-ps-file-print pr-ps-file-using-ghostscript pr-ps-file-up-preview
+;;;;;; pr-ps-file-preview pr-despool-ps-print pr-despool-print pr-despool-using-ghostscript
+;;;;;; pr-despool-preview pr-txt-mode pr-txt-region pr-txt-buffer
+;;;;;; pr-txt-directory pr-printify-region pr-printify-buffer pr-printify-directory
+;;;;;; pr-ps-mode-ps-print pr-ps-mode-print pr-ps-mode-using-ghostscript
+;;;;;; pr-ps-mode-preview pr-ps-region-ps-print pr-ps-region-print
+;;;;;; pr-ps-region-using-ghostscript pr-ps-region-preview pr-ps-buffer-ps-print
+;;;;;; pr-ps-buffer-print pr-ps-buffer-using-ghostscript pr-ps-buffer-preview
+;;;;;; pr-ps-directory-ps-print pr-ps-directory-print pr-ps-directory-using-ghostscript
+;;;;;; pr-ps-directory-preview pr-interface) "printing" "printing.el"
+;;;;;; (15997 671))
+;;; Generated autoloads from printing.el
+
+(autoload (quote pr-interface) "printing" "\
+Activate the printing interface buffer.
+
+If BUFFER is nil, it uses the current buffer for printing.
+
+For more informations, type \\[pr-interface-help].
+
+\(fn &optional BUFFER)" t nil)
+
+(autoload (quote pr-ps-directory-preview) "printing" "\
+Preview directory using ghostview.
+
+Interactively, the command prompts for N-UP printing number, a directory, a
+file name regexp for matching and, when you use a prefix argument (C-u), the
+command prompts the user for a file name, and saves the PostScript image in
+that file instead of saving it in a temporary file.
+
+Noninteractively, if N-UP is nil, prompts for N-UP printing number. If DIR is
+nil, prompts for DIRectory. If FILE-REGEXP is nil, prompts for
+FILE(name)-REGEXP. The argument FILENAME is treated as follows: if it's nil,
+save the image in a temporary file. If FILENAME is a string, save the
+PostScript image in a file with that name. If FILENAME is t, prompts for a
+file name.
+
+See also documentation for `pr-list-directory'.
+
+\(fn N-UP DIR FILE-REGEXP &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-directory-using-ghostscript) "printing" "\
+Print directory using PostScript through ghostscript.
+
+Interactively, the command prompts for N-UP printing number, a directory, a
+file name regexp for matching and, when you use a prefix argument (C-u), the
+command prompts the user for a file name, and saves the PostScript image in
+that file instead of saving it in a temporary file.
+
+Noninteractively, if N-UP is nil, prompts for N-UP printing number. If DIR is
+nil, prompts for DIRectory. If FILE-REGEXP is nil, prompts for
+FILE(name)-REGEXP. The argument FILENAME is treated as follows: if it's nil,
+save the image in a temporary file. If FILENAME is a string, save the
+PostScript image in a file with that name. If FILENAME is t, prompts for a
+file name.
+
+See also documentation for `pr-list-directory'.
+
+\(fn N-UP DIR FILE-REGEXP &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-directory-print) "printing" "\
+Print directory using PostScript printer.
+
+Interactively, the command prompts for N-UP printing number, a directory, a
+file name regexp for matching and, when you use a prefix argument (C-u), the
+command prompts the user for a file name, and saves the PostScript image in
+that file instead of saving it in a temporary file.
+
+Noninteractively, if N-UP is nil, prompts for N-UP printing number. If DIR is
+nil, prompts for DIRectory. If FILE-REGEXP is nil, prompts for
+FILE(name)-REGEXP. The argument FILENAME is treated as follows: if it's nil,
+save the image in a temporary file. If FILENAME is a string, save the
+PostScript image in a file with that name. If FILENAME is t, prompts for a
+file name.
+
+See also documentation for `pr-list-directory'.
+
+\(fn N-UP DIR FILE-REGEXP &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-directory-ps-print) "printing" "\
+Print directory using PostScript printer or through ghostscript.
+
+It depends on `pr-print-using-ghostscript'.
+
+Interactively, the command prompts for N-UP printing number, a directory, a
+file name regexp for matching and, when you use a prefix argument (C-u), the
+command prompts the user for a file name, and saves the PostScript image in
+that file instead of saving it in a temporary file.
+
+Noninteractively, if N-UP is nil, prompts for N-UP printing number. If DIR is
+nil, prompts for DIRectory. If FILE-REGEXP is nil, prompts for
+FILE(name)-REGEXP. The argument FILENAME is treated as follows: if it's nil,
+save the image in a temporary file. If FILENAME is a string, save the
+PostScript image in a file with that name. If FILENAME is t, prompts for a
+file name.
+
+See also documentation for `pr-list-directory'.
+
+\(fn N-UP DIR FILE-REGEXP &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-buffer-preview) "printing" "\
+Preview buffer using ghostview.
+
+Interactively, the command prompts for N-UP printing number and, when you use a
+prefix argument (C-u), the command prompts the user for a file name, and saves
+the PostScript image in that file instead of saving it in a temporary file.
+
+Noninteractively, if N-UP is nil, prompts for N-UP printing number. The
+argument FILENAME is treated as follows: if it's nil, save the image in a
+temporary file. If FILENAME is a string, save the PostScript image in a file
+with that name. If FILENAME is t, prompts for a file name.
+
+\(fn N-UP &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-buffer-using-ghostscript) "printing" "\
+Print buffer using PostScript through ghostscript.
+
+Interactively, the command prompts for N-UP printing number and, when you use a
+prefix argument (C-u), the command prompts the user for a file name, and saves
+the PostScript image in that file instead of sending it to the printer.
+
+Noninteractively, if N-UP is nil, prompts for N-UP printing number. The
+argument FILENAME is treated as follows: if it's nil, send the image to the
+printer. If FILENAME is a string, save the PostScript image in a file with
+that name. If FILENAME is t, prompts for a file name.
+
+\(fn N-UP &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-buffer-print) "printing" "\
+Print buffer using PostScript printer.
+
+Interactively, the command prompts for N-UP printing number and, when you use a
+prefix argument (C-u), the command prompts the user for a file name, and saves
+the PostScript image in that file instead of sending it to the printer.
+
+Noninteractively, if N-UP is nil, prompts for N-UP printing number. The
+argument FILENAME is treated as follows: if it's nil, send the image to the
+printer. If FILENAME is a string, save the PostScript image in a file with
+that name. If FILENAME is t, prompts for a file name.
+
+\(fn N-UP &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-buffer-ps-print) "printing" "\
+Print buffer using PostScript printer or through ghostscript.
+
+It depends on `pr-print-using-ghostscript'.
+
+Interactively, the command prompts for N-UP printing number and, when you use a
+prefix argument (C-u), the command prompts the user for a file name, and saves
+the PostScript image in that file instead of sending it to the printer.
+
+Noninteractively, if N-UP is nil, prompts for N-UP printing number. The
+argument FILENAME is treated as follows: if it's nil, send the image to the
+printer. If FILENAME is a string, save the PostScript image in a file with
+that name. If FILENAME is t, prompts for a file name.
+
+\(fn N-UP &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-region-preview) "printing" "\
+Preview region using ghostview.
+
+See also `pr-ps-buffer-preview'.
+
+\(fn N-UP &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-region-using-ghostscript) "printing" "\
+Print region using PostScript through ghostscript.
+
+See also `pr-ps-buffer-using-ghostscript'.
+
+\(fn N-UP &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-region-print) "printing" "\
+Print region using PostScript printer.
+
+See also `pr-ps-buffer-print'.
+
+\(fn N-UP &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-region-ps-print) "printing" "\
+Print region using PostScript printer or through ghostscript.
+
+See also `pr-ps-buffer-ps-print'.
+
+\(fn N-UP &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-mode-preview) "printing" "\
+Preview major mode using ghostview.
+
+See also `pr-ps-buffer-preview'.
+
+\(fn N-UP &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-mode-using-ghostscript) "printing" "\
+Print major mode using PostScript through ghostscript.
+
+See also `pr-ps-buffer-using-ghostscript'.
+
+\(fn N-UP &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-mode-print) "printing" "\
+Print major mode using PostScript printer.
+
+See also `pr-ps-buffer-print'.
+
+\(fn N-UP &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-mode-ps-print) "printing" "\
+Print major mode using PostScript or through ghostscript.
+
+See also `pr-ps-buffer-ps-print'.
+
+\(fn N-UP &optional FILENAME)" t nil)
+
+(autoload (quote pr-printify-directory) "printing" "\
+Replace nonprinting characters in directory with printable representations.
+The printable representations use ^ (for ASCII control characters) or hex.
+The characters tab, linefeed, space, return and formfeed are not affected.
+
+Interactively, the command prompts for a directory and a file name regexp for
+matching.
+
+Noninteractively, if DIR is nil, prompts for DIRectory. If FILE-REGEXP is nil,
+prompts for FILE(name)-REGEXP.
+
+See also documentation for `pr-list-directory'.
+
+\(fn &optional DIR FILE-REGEXP)" t nil)
+
+(autoload (quote pr-printify-buffer) "printing" "\
+Replace nonprinting characters in buffer with printable representations.
+The printable representations use ^ (for ASCII control characters) or hex.
+The characters tab, linefeed, space, return and formfeed are not affected.
+
+\(fn)" t nil)
+
+(autoload (quote pr-printify-region) "printing" "\
+Replace nonprinting characters in region with printable representations.
+The printable representations use ^ (for ASCII control characters) or hex.
+The characters tab, linefeed, space, return and formfeed are not affected.
+
+\(fn)" t nil)
+
+(autoload (quote pr-txt-directory) "printing" "\
+Print directory using text printer.
+
+Interactively, the command prompts for a directory and a file name regexp for
+matching.
+
+Noninteractively, if DIR is nil, prompts for DIRectory. If FILE-REGEXP is nil,
+prompts for FILE(name)-REGEXP.
+
+See also documentation for `pr-list-directory'.
+
+\(fn &optional DIR FILE-REGEXP)" t nil)
+
+(autoload (quote pr-txt-buffer) "printing" "\
+Print buffer using text printer.
+
+\(fn)" t nil)
+
+(autoload (quote pr-txt-region) "printing" "\
+Print region using text printer.
+
+\(fn)" t nil)
+
+(autoload (quote pr-txt-mode) "printing" "\
+Print major mode using text printer.
+
+\(fn)" t nil)
+
+(autoload (quote pr-despool-preview) "printing" "\
+Preview spooled PostScript.
+
+Interactively, when you use a prefix argument (C-u), the command prompts the
+user for a file name, and saves the spooled PostScript image in that file
+instead of saving it in a temporary file.
+
+Noninteractively, the argument FILENAME is treated as follows: if it is nil,
+save the image in a temporary file. If FILENAME is a string, save the
+PostScript image in a file with that name.
+
+\(fn &optional FILENAME)" t nil)
+
+(autoload (quote pr-despool-using-ghostscript) "printing" "\
+Print spooled PostScript using ghostscript.
+
+Interactively, when you use a prefix argument (C-u), the command prompts the
+user for a file name, and saves the spooled PostScript image in that file
+instead of sending it to the printer.
+
+Noninteractively, the argument FILENAME is treated as follows: if it is nil,
+send the image to the printer. If FILENAME is a string, save the PostScript
+image in a file with that name.
+
+\(fn &optional FILENAME)" t nil)
+
+(autoload (quote pr-despool-print) "printing" "\
+Send the spooled PostScript to the printer.
+
+Interactively, when you use a prefix argument (C-u), the command prompts the
+user for a file name, and saves the spooled PostScript image in that file
+instead of sending it to the printer.
+
+Noninteractively, the argument FILENAME is treated as follows: if it is nil,
+send the image to the printer. If FILENAME is a string, save the PostScript
+image in a file with that name.
+
+\(fn &optional FILENAME)" t nil)
+
+(autoload (quote pr-despool-ps-print) "printing" "\
+Send the spooled PostScript to the printer or use ghostscript to print it.
+
+Interactively, when you use a prefix argument (C-u), the command prompts the
+user for a file name, and saves the spooled PostScript image in that file
+instead of sending it to the printer.
+
+Noninteractively, the argument FILENAME is treated as follows: if it is nil,
+send the image to the printer. If FILENAME is a string, save the PostScript
+image in a file with that name.
+
+\(fn &optional FILENAME)" t nil)
+
+(autoload (quote pr-ps-file-preview) "printing" "\
+Preview PostScript file FILENAME.
+
+\(fn FILENAME)" t nil)
+
+(autoload (quote pr-ps-file-up-preview) "printing" "\
+Preview PostScript file FILENAME.
+
+\(fn N-UP IFILENAME &optional OFILENAME)" t nil)
+
+(autoload (quote pr-ps-file-using-ghostscript) "printing" "\
+Print PostScript file FILENAME using ghostscript.
+
+\(fn FILENAME)" t nil)
+
+(autoload (quote pr-ps-file-print) "printing" "\
+Print PostScript file FILENAME.
+
+\(fn FILENAME)" t nil)
+
+(autoload (quote pr-ps-file-ps-print) "printing" "\
+Send PostScript file FILENAME to printer or use ghostscript to print it.
+
+\(fn FILENAME)" t nil)
+
+(autoload (quote pr-ps-file-up-ps-print) "printing" "\
+Process a PostScript file IFILENAME and send it to printer.
+
+Interactively, the command prompts for N-UP printing number, for an input
+PostScript file IFILENAME and, when you use a prefix argument (C-u), the
+command prompts the user for an output PostScript file name OFILENAME, and
+saves the PostScript image in that file instead of sending it to the printer.
+
+Noninteractively, if N-UP is nil, prompts for N-UP printing number. The
+argument IFILENAME is treated as follows: if it's t, prompts for an input
+PostScript file name; otherwise, it *must* be a string that it's an input
+PostScript file name. The argument OFILENAME is treated as follows: if it's
+nil, send the image to the printer. If OFILENAME is a string, save the
+PostScript image in a file with that name. If OFILENAME is t, prompts for a
+file name.
+
+\(fn N-UP IFILENAME &optional OFILENAME)" t nil)
+
+(autoload (quote pr-toggle-file-duplex) "printing" "\
+Toggle duplex for PostScript file.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-file-tumble) "printing" "\
+Toggle tumble for PostScript file.
+
+If tumble is off, produces a printing suitable for binding on the left or
+right.
+If tumble is on, produces a printing suitable for binding at the top or
+bottom.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-file-landscape) "printing" "\
+Toggle landscape for PostScript file.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-ghostscript) "printing" "\
+Toggle printing using ghostscript.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-faces) "printing" "\
+Toggle printing with faces.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-spool) "printing" "\
+Toggle spooling.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-duplex) "printing" "\
+Toggle duplex.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-tumble) "printing" "\
+Toggle tumble.
+
+If tumble is off, produces a printing suitable for binding on the left or
+right.
+If tumble is on, produces a printing suitable for binding at the top or
+bottom.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-landscape) "printing" "\
+Toggle landscape.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-upside-down) "printing" "\
+Toggle upside-down.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-line) "printing" "\
+Toggle line number.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-zebra) "printing" "\
+Toggle zebra stripes.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-header) "printing" "\
+Toggle printing header.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-header-frame) "printing" "\
+Toggle printing header frame.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-lock) "printing" "\
+Toggle menu lock.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-region) "printing" "\
+Toggle auto region.
+
+\(fn)" t nil)
+
+(autoload (quote pr-toggle-mode) "printing" "\
+Toggle auto mode.
+
+\(fn)" t nil)
+
+(autoload (quote pr-customize) "printing" "\
+Customization of `printing' group.
+
+\(fn &rest IGNORE)" t nil)
+
+(autoload (quote lpr-customize) "printing" "\
+Customization of `lpr' group.
+
+\(fn &rest IGNORE)" t nil)
+
+(autoload (quote pr-help) "printing" "\
+Help for printing package.
+
+\(fn &rest IGNORE)" t nil)
+
+(autoload (quote pr-ps-name) "printing" "\
+Select interactively a PostScript printer.
+
+\(fn)" t nil)
+
+(autoload (quote pr-txt-name) "printing" "\
+Select interactively a text printer.
+
+\(fn)" t nil)
+
+(autoload (quote pr-ps-utility) "printing" "\
+Select interactively a PostScript utility.
+
+\(fn)" t nil)
+
+(autoload (quote pr-show-ps-setup) "printing" "\
+Show current ps-print settings.
+
+\(fn &rest IGNORE)" t nil)
+
+(autoload (quote pr-show-pr-setup) "printing" "\
+Show current printing settings.
+
+\(fn &rest IGNORE)" t nil)
+
+(autoload (quote pr-show-lpr-setup) "printing" "\
+Show current lpr settings.
+
+\(fn &rest IGNORE)" t nil)
+
+(autoload (quote pr-ps-fast-fire) "printing" "\
+Fast fire function for PostScript printing.
+
+If a region is active, the region will be printed instead of the whole buffer.
+Also if the current major-mode is defined in `pr-mode-alist', the settings in
+`pr-mode-alist' will be used, that is, the current buffer or region will be
+printed using `pr-ps-mode-ps-print'.
+
+
+Interactively, you have the following situations:
+
+ M-x pr-ps-fast-fire RET
+ The command prompts the user for a N-UP value and printing will
+ immediatelly be done using the current active printer.
+
+ C-u M-x pr-ps-fast-fire RET
+ C-u 0 M-x pr-ps-fast-fire RET
+ The command prompts the user for a N-UP value and also for a current
+ PostScript printer, then printing will immediatelly be done using the new
+ current active printer.
+
+ C-u 1 M-x pr-ps-fast-fire RET
+ The command prompts the user for a N-UP value and also for a file name,
+ and saves the PostScript image in that file instead of sending it to the
+ printer.
+
+ C-u 2 M-x pr-ps-fast-fire RET
+ The command prompts the user for a N-UP value, then for a current
+ PostScript printer and, finally, for a file name. Then change the active
+ printer to that choosen by user and saves the PostScript image in
+ that file instead of sending it to the printer.
+
+
+Noninteractively, the argument N-UP should be a positive integer greater than
+zero and the argument SELECT is treated as follows:
+
+ If it's nil, send the image to the printer.
+
+ If it's a list or an integer lesser or equal to zero, the command prompts
+ the user for a current PostScript printer, then printing will immediatelly
+ be done using the new current active printer.
+
+ If it's an integer equal to 1, the command prompts the user for a file name
+ and saves the PostScript image in that file instead of sending it to the
+ printer.
+
+ If it's an integer greater or equal to 2, the command prompts the user for a
+ current PostScript printer and for a file name. Then change the active
+ printer to that choosen by user and saves the PostScript image in that file
+ instead of sending it to the printer.
+
+ If it's a symbol which it's defined in `pr-ps-printer-alist', it's the new
+ active printer and printing will immediatelly be done using the new active
+ printer.
+
+ Otherwise, send the image to the printer.
+
+
+Note that this command always behaves as if `pr-auto-region' and `pr-auto-mode'
+are both set to t.
+
+\(fn N-UP &optional SELECT)" t nil)
+
+(autoload (quote pr-txt-fast-fire) "printing" "\
+Fast fire function for text printing.
+
+If a region is active, the region will be printed instead of the whole buffer.
+Also if the current major-mode is defined in `pr-mode-alist', the settings in
+`pr-mode-alist' will be used, that is, the current buffer or region will be
+printed using `pr-txt-mode'.
+
+Interactively, when you use a prefix argument (C-u), the command prompts the
+user for a new active text printer.
+
+Noninteractively, the argument SELECT-PRINTER is treated as follows:
+
+ If it's nil, the printing is sent to the current active text printer.
+
+ If it's a symbol which it's defined in `pr-txt-printer-alist', it's the new
+ active printer and printing will immediatelly be done using the new active
+ printer.
+
+ If it's non-nil, the command prompts the user for a new active text printer.
+
+Note that this command always behaves as if `pr-auto-region' and `pr-auto-mode'
+are both set to t.
+
+\(fn &optional SELECT-PRINTER)" t nil)
;;;***
\f
;;;### (autoloads (run-prolog prolog-mode) "prolog" "progmodes/prolog.el"
-;;;;;; (15371 46426))
+;;;;;; (15611 12634))
;;; Generated autoloads from progmodes/prolog.el
(autoload (quote prolog-mode) "prolog" "\
Commands:
\\{prolog-mode-map}
Entry to this mode calls the value of `prolog-mode-hook'
-if that value is non-nil." t nil)
+if that value is non-nil.
+
+\(fn)" t nil)
(autoload (quote run-prolog) "prolog" "\
-Run an inferior Prolog process, input and output via buffer *prolog*." t nil)
+Run an inferior Prolog process, input and output via buffer *prolog*.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads nil "ps-bdf" "ps-bdf.el" (15371 46418))
+;;;### (autoloads nil "ps-bdf" "ps-bdf.el" (16148 4633))
;;; Generated autoloads from ps-bdf.el
-(defvar bdf-directory-list (if (and (memq system-type (quote (ms-dos windows-nt))) (boundp (quote installation-directory))) (list (expand-file-name "fonts/bdf" installation-directory)) (quote ("/usr/local/share/emacs/fonts/bdf"))) "\
+(defvar bdf-directory-list (if (memq system-type (quote (ms-dos windows-nt))) (list (expand-file-name "fonts/bdf" installation-directory)) (quote ("/usr/local/share/emacs/fonts/bdf"))) "\
*List of directories to search for `BDF' font files.
The default value is '(\"/usr/local/share/emacs/fonts/bdf\").")
;;;***
\f
-;;;### (autoloads nil "ps-mode" "progmodes/ps-mode.el" (15371 46426))
+;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (16111
+;;;;;; 41834))
;;; Generated autoloads from progmodes/ps-mode.el
- (autoload (quote ps-mode) "ps-mode" "Major mode for editing PostScript with GNU Emacs.\n" t)
+
+(autoload (quote ps-mode) "ps-mode" "\
+Major mode for editing PostScript with GNU Emacs.
+
+Entry to this mode calls `ps-mode-hook'.
+
+The following variables hold user options, and can
+be set through the `customize' command:
+
+ `ps-mode-auto-indent'
+ `ps-mode-tab'
+ `ps-mode-paper-size'
+ `ps-mode-print-function'
+ `ps-run-prompt'
+ `ps-run-font-lock-keywords-2'
+ `ps-run-x'
+ `ps-run-dumb'
+ `ps-run-init'
+ `ps-run-error-line-numbers'
+ `ps-run-tmp-dir'
+
+Type \\[describe-variable] for documentation on these options.
+
+
+\\{ps-mode-map}
+
+
+When starting an interactive PostScript process with \\[ps-run-start],
+a second window will be displayed, and `ps-run-mode-hook' will be called.
+The keymap for this second window is:
+
+\\{ps-run-mode-map}
+
+
+When Ghostscript encounters an error it displays an error message
+with a file position. Clicking mouse-2 on this number will bring
+point to the corresponding spot in the PostScript window, if input
+to the interpreter was sent from that window.
+Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number has the same effect.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (ps-mule-begin-page ps-mule-begin-job ps-mule-header-string-charsets
;;;;;; 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" (15371 46418))
+;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" (16085 62843))
;;; Generated autoloads from ps-mule.el
(defvar ps-multibyte-buffer nil "\
Any other value is treated as nil.")
+(custom-autoload (quote ps-multibyte-buffer) "ps-mule")
+
(autoload (quote ps-mule-prepare-ascii-font) "ps-mule" "\
Setup special ASCII font for STRING.
-STRING should contain only ASCII characters." nil nil)
+STRING should contain only ASCII characters.
+
+\(fn STRING)" nil nil)
+
+(autoload (quote ps-mule-set-ascii-font) "ps-mule" "\
+Not documented
-(autoload (quote ps-mule-set-ascii-font) "ps-mule" nil nil nil)
+\(fn)" nil nil)
(autoload (quote ps-mule-plot-string) "ps-mule" "\
Generate PostScript code for plotting characters in the region FROM and TO.
(ENDPOS . RUN-WIDTH)
Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
-the sequence." nil nil)
+the sequence.
+
+\(fn FROM TO &optional BG-COLOR)" nil nil)
(autoload (quote ps-mule-plot-composition) "ps-mule" "\
Generate PostScript code for plotting composition in the region FROM and TO.
(ENDPOS . RUN-WIDTH)
Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
-the sequence." nil nil)
+the sequence.
+
+\(fn FROM TO &optional BG-COLOR)" nil nil)
(autoload (quote ps-mule-initialize) "ps-mule" "\
-Initialize global data for printing multi-byte characters." nil nil)
+Initialize global data for printing multi-byte characters.
+
+\(fn)" nil nil)
(autoload (quote ps-mule-encode-header-string) "ps-mule" "\
Generate PostScript code for ploting STRING by font FONTTAG.
-FONTTAG should be a string \"/h0\" or \"/h1\"." nil nil)
+FONTTAG should be a string \"/h0\" or \"/h1\".
+
+\(fn STRING FONTTAG)" nil nil)
(autoload (quote ps-mule-header-string-charsets) "ps-mule" "\
-Return a list of character sets that appears in header strings." nil nil)
+Return a list of character sets that appears in header strings.
+
+\(fn)" nil nil)
(autoload (quote ps-mule-begin-job) "ps-mule" "\
Start printing job for multi-byte chars between FROM and TO.
-This checks if all multi-byte characters in the region are printable or not." nil nil)
+This checks if all multi-byte characters in the region are printable or not.
-(autoload (quote ps-mule-begin-page) "ps-mule" nil nil nil)
+\(fn FROM TO)" nil nil)
+
+(autoload (quote ps-mule-begin-page) "ps-mule" "\
+Not documented
+
+\(fn)" nil nil)
;;;***
\f
;;;;;; ps-nb-pages-buffer ps-line-lengths ps-despool ps-spool-region-with-faces
;;;;;; ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer
;;;;;; ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces
-;;;;;; ps-print-buffer ps-print-customize ps-paper-type) "ps-print"
-;;;;;; "ps-print.el" (15482 26242))
+;;;;;; ps-print-buffer ps-print-customize ps-print-color-p ps-paper-type
+;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (16148
+;;;;;; 4633))
;;; Generated autoloads from ps-print.el
+(defvar ps-page-dimensions-database (list (list (quote a4) (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4") (list (quote a3) (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3") (list (quote letter) (* 72 8.5) (* 72 11.0) "Letter") (list (quote legal) (* 72 8.5) (* 72 14.0) "Legal") (list (quote letter-small) (* 72 7.68) (* 72 10.16) "LetterSmall") (list (quote tabloid) (* 72 11.0) (* 72 17.0) "Tabloid") (list (quote ledger) (* 72 17.0) (* 72 11.0) "Ledger") (list (quote statement) (* 72 5.5) (* 72 8.5) "Statement") (list (quote executive) (* 72 7.5) (* 72 10.0) "Executive") (list (quote a4small) (* 72 7.47) (* 72 10.85) "A4Small") (list (quote b4) (* 72 10.125) (* 72 14.33) "B4") (list (quote b5) (* 72 7.16) (* 72 10.125) "B5")) "\
+*List associating a symbolic paper type to its width, height and doc media.
+See `ps-paper-type'.")
+
+(custom-autoload (quote ps-page-dimensions-database) "ps-print")
+
(defvar ps-paper-type (quote letter) "\
*Specify the size of paper to format for.
Should be one of the paper types defined in `ps-page-dimensions-database', for
example `letter', `legal' or `a4'.")
+(custom-autoload (quote ps-paper-type) "ps-print")
+
+(defvar ps-print-color-p (or (fboundp (quote x-color-values)) (fboundp (quote color-instance-rgb-components))) "\
+*Specify how buffer's text color is printed.
+
+Valid values are:
+
+ nil Do not print colors.
+
+ t Print colors.
+
+ black-white Print colors on black/white printer.
+ See also `ps-black-white-faces'.
+
+Any other value is treated as t.")
+
+(custom-autoload (quote ps-print-color-p) "ps-print")
+
(autoload (quote ps-print-customize) "ps-print" "\
-Customization of ps-print group." t nil)
+Customization of ps-print group.
+
+\(fn)" t nil)
(autoload (quote ps-print-buffer) "ps-print" "\
Generate and print a PostScript image of the buffer.
-Interactively, when you use a prefix argument (C-u), the command prompts the
+Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the
user for a file name, and saves the PostScript image in that file instead of
sending it to the printer.
Noninteractively, the argument FILENAME is treated as follows: if it is nil,
send the image to the printer. If FILENAME is a string, save the PostScript
-image in a file with that name." t nil)
+image in a file with that name.
+
+\(fn &optional FILENAME)" t nil)
(autoload (quote ps-print-buffer-with-faces) "ps-print" "\
Generate and print a PostScript image of the buffer.
Like `ps-print-buffer', but includes font, color, and underline information in
the generated image. This command works only if you are using a window system,
-so it has a way to determine color values." t nil)
+so it has a way to determine color values.
+
+\(fn &optional FILENAME)" t nil)
(autoload (quote ps-print-region) "ps-print" "\
Generate and print a PostScript image of the region.
-Like `ps-print-buffer', but prints just the current region." t nil)
+Like `ps-print-buffer', but prints just the current region.
+
+\(fn FROM TO &optional FILENAME)" t nil)
(autoload (quote ps-print-region-with-faces) "ps-print" "\
Generate and print a PostScript image of the region.
Like `ps-print-region', but includes font, color, and underline information in
the generated image. This command works only if you are using a window system,
-so it has a way to determine color values." t nil)
+so it has a way to determine color values.
+
+\(fn FROM TO &optional FILENAME)" t nil)
(autoload (quote ps-spool-buffer) "ps-print" "\
Generate and spool a PostScript image of the buffer.
Like `ps-print-buffer' except that the PostScript image is saved in a local
buffer to be sent to the printer later.
-Use the command `ps-despool' to send the spooled images to the printer." t nil)
+Use the command `ps-despool' to send the spooled images to the printer.
+
+\(fn)" t nil)
(autoload (quote ps-spool-buffer-with-faces) "ps-print" "\
Generate and spool a PostScript image of the buffer.
the generated image. This command works only if you are using a window system,
so it has a way to determine color values.
-Use the command `ps-despool' to send the spooled images to the printer." t nil)
+Use the command `ps-despool' to send the spooled images to the printer.
+
+\(fn)" t nil)
(autoload (quote ps-spool-region) "ps-print" "\
Generate a PostScript image of the region and spool locally.
Like `ps-spool-buffer', but spools just the current region.
-Use the command `ps-despool' to send the spooled images to the printer." t nil)
+Use the command `ps-despool' to send the spooled images to the printer.
+
+\(fn FROM TO)" t nil)
(autoload (quote ps-spool-region-with-faces) "ps-print" "\
Generate a PostScript image of the region and spool locally.
the generated image. This command works only if you are using a window system,
so it has a way to determine color values.
-Use the command `ps-despool' to send the spooled images to the printer." t nil)
+Use the command `ps-despool' to send the spooled images to the printer.
+
+\(fn FROM TO)" t nil)
(autoload (quote ps-despool) "ps-print" "\
Send the spooled PostScript to the printer.
-Interactively, when you use a prefix argument (C-u), the command prompts the
+Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the
user for a file name, and saves the spooled PostScript image in that file
instead of sending it to the printer.
Noninteractively, the argument FILENAME is treated as follows: if it is nil,
send the image to the printer. If FILENAME is a string, save the PostScript
-image in a file with that name." t nil)
+image in a file with that name.
+
+\(fn &optional FILENAME)" t nil)
(autoload (quote ps-line-lengths) "ps-print" "\
-Display the correspondence between a line length and a font size, using the
-current ps-print setup.
+Display the correspondence between a line length and a font size.
+Done using the current ps-print setup.
Try: pr -t file | awk '{printf \"%3d %s
-\", length($0), $0}' | sort -r | head" t nil)
+\", length($0), $0}' | sort -r | head
+
+\(fn)" t nil)
(autoload (quote ps-nb-pages-buffer) "ps-print" "\
Display number of pages to print this buffer, for various font heights.
-The table depends on the current ps-print setup." t nil)
+The table depends on the current ps-print setup.
+
+\(fn NB-LINES)" t nil)
(autoload (quote ps-nb-pages-region) "ps-print" "\
Display number of pages to print the region, for various font heights.
-The table depends on the current ps-print setup." t nil)
+The table depends on the current ps-print setup.
+
+\(fn NB-LINES)" t nil)
(autoload (quote ps-setup) "ps-print" "\
-Return the current PostScript-generation setup." nil nil)
+Return the current PostScript-generation setup.
+
+\(fn)" nil nil)
(autoload (quote ps-extend-face-list) "ps-print" "\
Extend face in ALIST-SYM.
The elements in FACE-EXTENSION-LIST is like those for `ps-extend-face'.
-See `ps-extend-face' for documentation." nil nil)
+See `ps-extend-face' for documentation.
+
+\(fn FACE-EXTENSION-LIST &optional MERGE-P ALIST-SYM)" nil nil)
(autoload (quote ps-extend-face) "ps-print" "\
Extend face in ALIST-SYM.
box - text will be surrounded by a box.
outline - print characters as hollow outlines.
-If EXTENSION is any other symbol, it is ignored." nil nil)
+If EXTENSION is any other symbol, it is ignored.
+
+\(fn FACE-EXTENSION &optional MERGE-P ALIST-SYM)" nil nil)
;;;***
\f
;;;;;; quail-defrule quail-install-decode-map quail-install-map
;;;;;; quail-define-rules quail-show-keyboard-layout quail-set-keyboard-layout
;;;;;; quail-define-package quail-use-package quail-title) "quail"
- ;;;;;; "international/quail.el" (16162 48286))
-;;;;;; "international/quail.el" (15455 18402))
++;;;;;; "international/quail.el" (16183 19626))
;;; Generated autoloads from international/quail.el
(autoload (quote quail-title) "quail" "\
-Return the title of the current Quail package." nil nil)
+Return the title of the current Quail package.
+
+\(fn)" nil nil)
(autoload (quote quail-use-package) "quail" "\
Start using Quail package PACKAGE-NAME.
The remaining arguments are libraries to be loaded before using the package.
This activates input method defined by PACKAGE-NAME by running
-`quail-activate', which see." nil nil)
+`quail-activate', which see.
+
+\(fn PACKAGE-NAME &rest LIBRARIES)" nil nil)
(autoload (quote quail-define-package) "quail" "\
Define NAME as a new Quail package for input LANGUAGE.
If SIMPLE is non-nil, then we do not alter the meanings of
commands such as C-f, C-b, C-n, C-p and TAB; they are treated as
-non-Quail commands." nil nil)
+non-Quail commands.
+
+\(fn NAME LANGUAGE TITLE &optional GUIDANCE DOCSTRING TRANSLATION-KEYS FORGET-LAST-SELECTION DETERMINISTIC KBD-TRANSLATE SHOW-LAYOUT CREATE-DECODE-MAP MAXIMUM-SHORTEST OVERLAY-PLIST UPDATE-TRANSLATION-FUNCTION CONVERSION-KEYS SIMPLE)" nil nil)
(autoload (quote quail-set-keyboard-layout) "quail" "\
Set the current keyboard layout to the same as keyboard KBD-TYPE.
characters generated by them), those are created by assuming the
standard layout defined in `quail-keyboard-layout-standard'. This
function tells Quail system the layout of your keyboard so that what
-you type is correctly handled." t nil)
+you type is correctly handled.
+
+\(fn KBD-TYPE)" t nil)
(autoload (quote quail-show-keyboard-layout) "quail" "\
Show the physical layout of the keyboard type KEYBOARD-TYPE.
The variable `quail-keyboard-layout-type' holds the currently selected
-keyboard type." t nil)
+keyboard type.
+
+\(fn &optional KEYBOARD-TYPE)" t nil)
(autoload (quote quail-define-rules) "quail" "\
Define translation rules of the current Quail package.
inserted.
no-decode-map --- the value non-nil means that decoding map is not
- generated for the following translations." nil (quote macro))
+ generated for the following translations.
+
+\(fn &rest RULES)" nil (quote macro))
(autoload (quote quail-install-map) "quail" "\
Install the Quail map MAP in the current Quail package.
Optional 2nd arg NAME, if non-nil, is a name of Quail package for
which to install MAP.
-The installed map can be referred by the function `quail-map'." nil nil)
+The installed map can be referred by the function `quail-map'.
+
+\(fn MAP &optional NAME)" nil nil)
(autoload (quote quail-install-decode-map) "quail" "\
Install the Quail decode map DECODE-MAP in the current Quail package.
Optional 2nd arg NAME, if non-nil, is a name of Quail package for
which to install MAP.
-The installed decode map can be referred by the function `quail-decode-map'." nil nil)
+The installed decode map can be referred by the function `quail-decode-map'.
+
+\(fn DECODE-MAP &optional NAME)" nil nil)
(autoload (quote quail-defrule) "quail" "\
Add one translation rule, KEY to TRANSLATION, in the current Quail package.
current Quail package.
Optional 4th argument APPEND, if non-nil, appends TRANSLATION
-to the current translations for KEY instead of replacing them." nil nil)
+to the current translations for KEY instead of replacing them.
+
+\(fn KEY TRANSLATION &optional NAME APPEND)" nil nil)
(autoload (quote quail-defrule-internal) "quail" "\
Define KEY as TRANS in a Quail map MAP.
Optional 5th arg DECODE-MAP is a Quail decode map.
Optional 6th arg PROPS is a property list annotating TRANS. See the
-function `quail-define-rules' for the detail." nil nil)
+function `quail-define-rules' for the detail.
+
+\(fn KEY TRANS MAP &optional APPEND DECODE-MAP PROPS)" nil nil)
(autoload (quote quail-update-leim-list-file) "quail" "\
Update entries for Quail packages in `LEIM' list file in directory DIRNAME.
When called from a program, the remaining arguments are additional
directory names to search for Quail packages under `quail' subdirectory
-of each directory." t nil)
+of each directory.
+
+\(fn DIRNAME &rest DIRNAMES)" t nil)
;;;***
\f
;;;### (autoloads (quickurl-list quickurl-list-mode quickurl-edit-urls
;;;;;; quickurl-browse-url-ask quickurl-browse-url quickurl-add-url
-;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (15371
-;;;;;; 46424))
+;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (15941
+;;;;;; 42963))
;;; Generated autoloads from net/quickurl.el
(defconst quickurl-reread-hook-postfix "\n;; Local Variables:\n;; eval: (progn (require 'quickurl) (add-hook 'local-write-file-hooks (lambda () (quickurl-read) nil)))\n;; End:\n" "\
If not supplied LOOKUP is taken to be the word at point in the current
buffer, this default action can be modifed via
-`quickurl-grab-lookup-function'." t nil)
+`quickurl-grab-lookup-function'.
+
+\(fn &optional (LOOKUP (funcall quickurl-grab-lookup-function)))" t nil)
(autoload (quote quickurl-ask) "quickurl" "\
-Insert an URL, with `completing-read' prompt, based on LOOKUP." t nil)
+Insert an URL, with `completing-read' prompt, based on LOOKUP.
+
+\(fn LOOKUP)" t nil)
(autoload (quote quickurl-add-url) "quickurl" "\
Allow the user to interactively add a new URL associated with WORD.
See `quickurl-grab-url' for details on how the default word/url combination
-is decided." t nil)
+is decided.
+
+\(fn WORD URL COMMENT)" t nil)
(autoload (quote quickurl-browse-url) "quickurl" "\
Browse the URL associated with LOOKUP.
If not supplied LOOKUP is taken to be the word at point in the
current buffer, this default action can be modifed via
-`quickurl-grab-lookup-function'." t nil)
+`quickurl-grab-lookup-function'.
+
+\(fn &optional (LOOKUP (funcall quickurl-grab-lookup-function)))" t nil)
(autoload (quote quickurl-browse-url-ask) "quickurl" "\
-Browse the URL, with `completing-read' prompt, associated with LOOKUP." t nil)
+Browse the URL, with `completing-read' prompt, associated with LOOKUP.
+
+\(fn LOOKUP)" t nil)
(autoload (quote quickurl-edit-urls) "quickurl" "\
-Pull `quickurl-url-file' into a buffer for hand editing." t nil)
+Pull `quickurl-url-file' into a buffer for hand editing.
+
+\(fn)" t nil)
(autoload (quote quickurl-list-mode) "quickurl" "\
A mode for browsing the quickurl URL list.
The key bindings for `quickurl-list-mode' are:
-\\{quickurl-list-mode-map}" t nil)
+\\{quickurl-list-mode-map}
+
+\(fn)" t nil)
(autoload (quote quickurl-list) "quickurl" "\
-Display `quickurl-list' as a formatted list using `quickurl-list-mode'." t nil)
+Display `quickurl-list' as a formatted list using `quickurl-list-mode'.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (remote-compile) "rcompile" "net/rcompile.el" (15427
-;;;;;; 61508))
+;;;### (autoloads (remote-compile) "rcompile" "net/rcompile.el" (15941
+;;;;;; 42963))
;;; Generated autoloads from net/rcompile.el
(autoload (quote remote-compile) "rcompile" "\
Compile the current buffer's directory on HOST. Log in as USER.
-See \\[compile]." t nil)
+See \\[compile].
+
+\(fn HOST USER COMMAND)" t nil)
;;;***
\f
;;;### (autoloads (re-builder) "re-builder" "emacs-lisp/re-builder.el"
-;;;;;; (15391 60528))
+;;;;;; (15941 42958))
;;; Generated autoloads from emacs-lisp/re-builder.el
(autoload (quote re-builder) "re-builder" "\
-Call up the RE Builder for the current window." t nil)
+Call up the RE Builder for the current window.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (recentf-mode recentf-open-more-files recentf-open-files
-;;;;;; recentf-cleanup recentf-edit-list recentf-save-list) "recentf"
-;;;;;; "recentf.el" (15400 1473))
+;;;### (autoloads (recentf-mode) "recentf" "recentf.el" (16055 8591))
;;; Generated autoloads from recentf.el
-(autoload (quote recentf-save-list) "recentf" "\
-Save the current `recentf-list' to the file `recentf-save-file'." t nil)
-
-(autoload (quote recentf-edit-list) "recentf" "\
-Allow the user to edit the files that are kept in the recent list." t nil)
-
-(autoload (quote recentf-cleanup) "recentf" "\
-Remove all non-readable and excluded files from `recentf-list'." t nil)
-
-(autoload (quote recentf-open-files) "recentf" "\
-Display buffer allowing user to choose a file from recently-opened list.
-The optional argument FILES may be used to specify the list, otherwise
-`recentf-list' is used. The optional argument BUFFER-NAME specifies
-which buffer to use for the interaction." t nil)
-
-(autoload (quote recentf-open-more-files) "recentf" "\
-Allow the user to open files that are not in the menu." t nil)
-
(defvar recentf-mode nil "\
Non-nil if Recentf mode is enabled.
See the command `recentf-mode' for a description of this minor-mode.
Setting this variable directly does not take effect;
use either \\[customize] or the function `recentf-mode'.")
-(custom-add-to-group (quote recentf) (quote recentf-mode) (quote custom-variable))
-
-(custom-add-load (quote recentf-mode) (quote recentf))
+(custom-autoload (quote recentf-mode) "recentf")
(autoload (quote recentf-mode) "recentf" "\
Toggle recentf mode.
With prefix argument ARG, turn on if positive, otherwise off.
Returns non-nil if the new state is enabled.
-When recentf mode is enabled, it maintains a menu for visiting files that
-were operated on recently." t nil)
+When recentf mode is enabled, it maintains a menu for visiting files
+that were operated on recently.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (clear-rectangle string-insert-rectangle string-rectangle
;;;;;; delete-whitespace-rectangle open-rectangle insert-rectangle
;;;;;; yank-rectangle kill-rectangle extract-rectangle delete-extract-rectangle
-;;;;;; delete-rectangle move-to-column-force) "rect" "rect.el" (15483
-;;;;;; 45660))
+;;;;;; delete-rectangle move-to-column-force) "rect" "rect.el" (15941
+;;;;;; 42956))
;;; Generated autoloads from rect.el
(autoload (quote move-to-column-force) "rect" "\
-Obsolete. Use `move-to-column'.
If COLUMN is within a multi-column character, replace it by spaces and tab.
As for `move-to-column', passing anything but nil or t in FLAG will move to
-the desired column only if the line is long enough." nil nil)
+the desired column only if the line is long enough.
+
+\(fn COLUMN &optional FLAG)" nil nil)
+
+(make-obsolete (quote move-to-column-force) (quote move-to-column) "21.2")
(autoload (quote delete-rectangle) "rect" "\
Delete (don't save) text in the region-rectangle.
When called from a program the rectangle's corners are START and END.
With a prefix (or a FILL) argument, also fill lines where nothing has
-to be deleted." t nil)
+to be deleted.
+
+\(fn START END &optional FILL)" t nil)
(autoload (quote delete-extract-rectangle) "rect" "\
Delete the contents of the rectangle with corners at START and END.
When called from a program the rectangle's corners are START and END.
With an optional FILL argument, also fill lines where nothing has to be
-deleted." nil nil)
+deleted.
+
+\(fn START END &optional FILL)" nil nil)
(autoload (quote extract-rectangle) "rect" "\
Return the contents of the rectangle with corners at START and END.
-Return it as a list of strings, one for each line of the rectangle." nil nil)
+Return it as a list of strings, one for each line of the rectangle.
+
+\(fn START END)" nil nil)
(autoload (quote kill-rectangle) "rect" "\
Delete the region-rectangle and save it as the last killed one.
You might prefer to use `delete-extract-rectangle' from a program.
With a prefix (or a FILL) argument, also fill lines where nothing has to be
-deleted." t nil)
+deleted.
+
+\(fn START END &optional FILL)" t nil)
(autoload (quote yank-rectangle) "rect" "\
-Yank the last killed rectangle with upper left corner at point." t nil)
+Yank the last killed rectangle with upper left corner at point.
+
+\(fn)" t nil)
(autoload (quote insert-rectangle) "rect" "\
Insert text of RECTANGLE with upper left corner at point.
line is inserted at a point vertically under point, etc.
RECTANGLE should be a list of strings.
After this command, the mark is at the upper left corner
-and point is at the lower right corner." nil nil)
+and point is at the lower right corner.
+
+\(fn RECTANGLE)" nil nil)
(autoload (quote open-rectangle) "rect" "\
Blank out the region-rectangle, shifting text right.
When called from a program the rectangle's corners are START and END.
With a prefix (or a FILL) argument, fill with blanks even if there is no text
-on the right side of the rectangle." t nil)
- (defalias 'close-rectangle 'delete-whitespace-rectangle) ;; Old name
+on the right side of the rectangle.
+
+\(fn START END &optional FILL)" t nil)
+
+(defalias (quote close-rectangle) (quote delete-whitespace-rectangle))
(autoload (quote delete-whitespace-rectangle) "rect" "\
Delete all whitespace following a specified column in each line.
rectangle, all continuous whitespace starting at that column is deleted.
When called from a program the rectangle's corners are START and END.
-With a prefix (or a FILL) argument, also fill too short lines." t nil)
+With a prefix (or a FILL) argument, also fill too short lines.
+
+\(fn START END &optional FILL)" t nil)
(autoload (quote string-rectangle) "rect" "\
Replace rectangle contents with STRING on each line.
The length of STRING need not be the same as the rectangle width.
-Called from a program, takes three args; START, END and STRING." t nil)
+Called from a program, takes three args; START, END and STRING.
+
+\(fn START END STRING)" t nil)
+
+(defalias (quote replace-rectangle) (quote string-rectangle))
(autoload (quote string-insert-rectangle) "rect" "\
Insert STRING on each line of region-rectangle, shifting text right.
When called from a program, the rectangle's corners are START and END.
The left edge of the rectangle specifies the column for insertion.
-This command does not delete or overwrite any existing text." t nil)
+This command does not delete or overwrite any existing text.
+
+\(fn START END STRING)" t nil)
(autoload (quote clear-rectangle) "rect" "\
Blank out the region-rectangle.
When called from a program the rectangle's corners are START and END.
With a prefix (or a FILL) argument, also fill with blanks the parts of the
-rectangle which were empty." t nil)
+rectangle which were empty.
+
+\(fn START END &optional FILL)" t nil)
;;;***
\f
-;;;### (autoloads (refill-mode) "refill" "textmodes/refill.el" (15417
-;;;;;; 7452))
+;;;### (autoloads (refill-mode) "refill" "textmodes/refill.el" (16111
+;;;;;; 41838))
;;; Generated autoloads from textmodes/refill.el
(autoload (quote refill-mode) "refill" "\
When Refill mode is on, the current paragraph will be formatted when
changes are made within it. Self-inserting characters only cause
-refilling if they would cause auto-filling." t nil)
+refilling if they would cause auto-filling.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
-;;;### (autoloads (reftex-mode turn-on-reftex) "reftex" "textmodes/reftex.el"
-;;;;;; (15371 46417))
+;;;### (autoloads (reftex-scanning-info-available-p reftex-mode turn-on-reftex)
+;;;;;; "reftex" "textmodes/reftex.el" (16142 9352))
;;; Generated autoloads from textmodes/reftex.el
(autoload (quote turn-on-reftex) "reftex" "\
-Turn on RefTeX mode." nil nil)
+Turn on RefTeX mode.
+
+\(fn)" nil nil)
(autoload (quote reftex-mode) "reftex" "\
Minor mode with distinct support for \\label, \\ref and \\cite in LaTeX.
Under X, these and other functions will also be available as `Ref' menu
on the menu bar.
-------------------------------------------------------------------------------" t nil)
+------------------------------------------------------------------------------
+
+\(fn &optional ARG)" t nil)
+
+(autoload (quote reftex-scanning-info-available-p) "reftex" "\
+Is the scanning info about the current document available?
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (reftex-citation) "reftex-cite" "textmodes/reftex-cite.el"
-;;;;;; (15371 46416))
+;;;;;; (16070 35808))
;;; Generated autoloads from textmodes/reftex-cite.el
(autoload (quote reftex-citation) "reftex-cite" "\
Make a citation using BibTeX database files.
After prompting for a regular expression, scans the buffers with
bibtex entries (taken from the \\bibliography command) and offers the
-matching entries for selection. The selected entry is formated according
+matching entries for selection. The selected entry is formatted according
to `reftex-cite-format' and inserted into the buffer.
If NO-INSERT is non-nil, nothing is inserted, only the selected key returned.
The regular expression uses an expanded syntax: && is interpreted as `and'.
Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'.
While entering the regexp, completion on knows citation keys is possible.
-`=' is a good regular expression to match all entries in all files." t nil)
+`=' is a good regular expression to match all entries in all files.
+
+\(fn &optional NO-INSERT FORMAT-KEY)" t nil)
;;;***
\f
;;;### (autoloads (reftex-index-phrases-mode) "reftex-index" "textmodes/reftex-index.el"
-;;;;;; (15391 60719))
+;;;;;; (15941 42966))
;;; Generated autoloads from textmodes/reftex-index.el
(autoload (quote reftex-index-phrases-mode) "reftex-index" "\
Here are all local bindings.
-\\{reftex-index-phrases-map}" t nil)
+\\{reftex-index-phrases-map}
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (reftex-all-document-files) "reftex-parse" "textmodes/reftex-parse.el"
+;;;;;; (16142 9352))
+;;; Generated autoloads from textmodes/reftex-parse.el
+
+(autoload (quote reftex-all-document-files) "reftex-parse" "\
+Return a list of all files belonging to the current document.
+When RELATIVE is non-nil, give file names relative to directory
+of master file.
+
+\(fn &optional RELATIVE)" nil nil)
;;;***
\f
;;;### (autoloads (regexp-opt-depth regexp-opt) "regexp-opt" "emacs-lisp/regexp-opt.el"
- ;;;;;; (16054 60749))
-;;;;;; (15486 57600))
++;;;;;; (16179 16744))
;;; Generated autoloads from emacs-lisp/regexp-opt.el
(autoload (quote regexp-opt) "regexp-opt" "\
(concat open (mapconcat 'regexp-quote STRINGS \"\\\\|\") close))
If PAREN is `words', then the resulting regexp is additionally surrounded
-by \\=\\< and \\>." nil nil)
+by \\=\\< and \\>.
+
+\(fn STRINGS &optional PAREN)" nil nil)
(autoload (quote regexp-opt-depth) "regexp-opt" "\
Return the depth of REGEXP.
This means the number of regexp grouping constructs (parenthesised expressions)
-in REGEXP." nil nil)
+in REGEXP.
+
+\(fn REGEXP)" nil nil)
;;;***
\f
-;;;### (autoloads (repeat) "repeat" "repeat.el" (15371 46418))
+;;;### (autoloads (repeat) "repeat" "repeat.el" (15941 42956))
;;; Generated autoloads from repeat.el
(autoload (quote repeat) "repeat" "\
If this command is invoked by a multi-character key sequence, it can then
be repeated by repeating the final character of that sequence. This behavior
-can be modified by the global variable `repeat-on-final-keystroke'." t nil)
+can be modified by the global variable `repeat-on-final-keystroke'.
+
+\(fn REPEAT-ARG)" t nil)
;;;***
\f
;;;### (autoloads (reporter-submit-bug-report) "reporter" "mail/reporter.el"
-;;;;;; (15371 46424))
+;;;;;; (15356 55960))
;;; Generated autoloads from mail/reporter.el
(autoload (quote reporter-submit-bug-report) "reporter" "\
This function does not send a message; it uses the given information
to initialize a message, which the user can then edit and finally send
\(or decline to send). The variable `mail-user-agent' controls which
-mail-sending package is used for editing and sending the message." nil nil)
+mail-sending package is used for editing and sending the message.
+
+\(fn ADDRESS PKGNAME VARLIST &optional PRE-HOOKS POST-HOOKS SALUTATION)" nil nil)
;;;***
\f
;;;### (autoloads (reposition-window) "reposition" "reposition.el"
-;;;;;; (15391 60519))
+;;;;;; (15364 46020))
;;; Generated autoloads from reposition.el
(autoload (quote reposition-window) "reposition" "\
visible (if only part could otherwise be made so), to make the defun line
visible (if point is in code and it could not be made so, or if only
comments, including the first comment line, are visible), or to make the
-first comment line visible (if point is in a comment)." t nil)
+first comment line visible (if point is in a comment).
+
+\(fn &optional ARG)" t nil)
(define-key esc-map "\C-l" 'reposition-window)
;;;***
\f
-;;;### (autoloads (resume-suspend-hook) "resume" "resume.el" (15371
-;;;;;; 46418))
+;;;### (autoloads (resume-suspend-hook) "resume" "resume.el" (15941
+;;;;;; 42956))
;;; Generated autoloads from resume.el
(autoload (quote resume-suspend-hook) "resume" "\
-Clear out the file used for transmitting args when Emacs resumes." nil nil)
+Clear out the file used for transmitting args when Emacs resumes.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (global-reveal-mode reveal-mode) "reveal" "reveal.el"
-;;;;;; (15417 7409))
+;;;;;; (16054 60749))
;;; Generated autoloads from reveal.el
(autoload (quote reveal-mode) "reveal" "\
Interactively, with no prefix argument, toggle the mode.
With universal prefix ARG (or if ARG is nil) turn mode on.
-With zero or negative ARG turn mode off." t nil)
+With zero or negative ARG turn mode off.
+
+\(fn &optional ARG)" t nil)
(defvar global-reveal-mode nil "\
Non-nil if Global-Reveal mode is enabled.
Setting this variable directly does not take effect;
use either \\[customize] or the function `global-reveal-mode'.")
-(custom-add-to-group (quote global-reveal) (quote global-reveal-mode) (quote custom-variable))
-
-(custom-add-load (quote global-reveal-mode) (quote reveal))
+(custom-autoload (quote global-reveal-mode) "reveal")
(autoload (quote global-reveal-mode) "reveal" "\
Toggle Reveal mode in all buffers on or off.
Interactively, with no prefix argument, toggle the mode.
With universal prefix ARG (or if ARG is nil) turn mode on.
-With zero or negative ARG turn mode off." t nil)
+With zero or negative ARG turn mode off.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
-;;;### (autoloads (read-file-name-electric-shadow-mode read-file-name-electric-shadow-tty-properties
-;;;;;; read-file-name-electric-shadow-properties) "rfn-eshadow"
-;;;;;; "rfn-eshadow.el" (15391 60519))
+;;;### (autoloads (file-name-shadow-mode file-name-shadow-tty-properties
+;;;;;; file-name-shadow-properties) "rfn-eshadow" "rfn-eshadow.el"
+;;;;;; (15728 55520))
;;; Generated autoloads from rfn-eshadow.el
-(defvar read-file-name-electric-shadow-properties (quote (face read-file-name-electric-shadow field shadow)) "\
+(defvar file-name-shadow-properties (quote (face file-name-shadow field shadow)) "\
Properties given to the `shadowed' part of a filename in the minibuffer.
-Only used when `read-file-name-electric-shadow-mode' is active.
+Only used when `file-name-shadow-mode' is active.
If emacs is not running under a window system,
-`read-file-name-electric-shadow-tty-properties' is used instead.")
+`file-name-shadow-tty-properties' is used instead.")
+
+(custom-autoload (quote file-name-shadow-properties) "rfn-eshadow")
-(defvar read-file-name-electric-shadow-tty-properties (quote (before-string "{" after-string "} " field shadow)) "\
+(defvar file-name-shadow-tty-properties (quote (before-string "{" after-string "} " field shadow)) "\
Properties given to the `shadowed' part of a filename in the minibuffer.
-Only used when `read-file-name-electric-shadow-mode' is active and emacs
+Only used when `file-name-shadow-mode' is active and emacs
is not running under a window-system; if emacs is running under a window
-system, `read-file-name-electric-shadow-properties' is used instead.")
+system, `file-name-shadow-properties' is used instead.")
-(defvar read-file-name-electric-shadow-mode nil "\
-Non-nil if Read-File-Name-Electric-Shadow mode is enabled.
-See the command `read-file-name-electric-shadow-mode' for a description of this minor-mode.
-Setting this variable directly does not take effect;
-use either \\[customize] or the function `read-file-name-electric-shadow-mode'.")
+(custom-autoload (quote file-name-shadow-tty-properties) "rfn-eshadow")
-(custom-add-to-group (quote minibuffer) (quote read-file-name-electric-shadow-mode) (quote custom-variable))
+(defvar file-name-shadow-mode nil "\
+Non-nil if File-Name-Shadow mode is enabled.
+See the command `file-name-shadow-mode' for a description of this minor-mode.
+Setting this variable directly does not take effect;
+use either \\[customize] or the function `file-name-shadow-mode'.")
-(custom-add-load (quote read-file-name-electric-shadow-mode) (quote rfn-eshadow))
+(custom-autoload (quote file-name-shadow-mode) "rfn-eshadow")
-(autoload (quote read-file-name-electric-shadow-mode) "rfn-eshadow" "\
-Toggle Read-File-Name Electric Shadow mode.
-When active, any part of the a filename being read in the minibuffer
-that would be ignored because the result is passed through
-`substitute-in-file-name' is given the properties in
-`read-file-name-electric-shadow-properties', which can be used to make
-that portion dim, invisible, or otherwise less visually noticable.
+(autoload (quote file-name-shadow-mode) "rfn-eshadow" "\
+Toggle File-Name Shadow mode.
+When active, any part of a filename being read in the minibuffer
+that would be ignored (because the result is passed through
+`substitute-in-file-name') is given the properties in
+`file-name-shadow-properties', which can be used to make
+that portion dim, invisible, or otherwise less visually noticeable.
With prefix argument ARG, turn on if positive, otherwise off.
-Returns non-nil if the new state is enabled." t nil)
+Returns non-nil if the new state is enabled.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (make-ring ring-p) "ring" "emacs-lisp/ring.el"
-;;;;;; (15371 46419))
+;;;;;; (16148 4633))
;;; Generated autoloads from emacs-lisp/ring.el
(autoload (quote ring-p) "ring" "\
-Returns t if X is a ring; nil otherwise." nil nil)
+Return t if X is a ring; nil otherwise.
+
+\(fn X)" nil nil)
(autoload (quote make-ring) "ring" "\
-Make a ring that can contain SIZE elements." nil nil)
+Make a ring that can contain SIZE elements.
+
+\(fn SIZE)" nil nil)
;;;***
\f
-;;;### (autoloads (rlogin) "rlogin" "net/rlogin.el" (15371 46424))
+;;;### (autoloads (rlogin) "rlogin" "net/rlogin.el" (16066 53440))
;;; Generated autoloads from net/rlogin.el
(add-hook 'same-window-regexps "^\\*rlogin-.*\\*\\(\\|<[0-9]+>\\)")
If you wish to change directory tracking styles during a session, use the
function `rlogin-directory-tracking-mode' rather than simply setting the
-variable." t nil)
+variable.
+
+\(fn INPUT-ARGS &optional BUFFER)" t nil)
;;;***
\f
;;;;;; rmail-mail-new-frame rmail-primary-inbox-list rmail-delete-after-output
;;;;;; rmail-highlight-face rmail-highlighted-headers rmail-retry-ignored-headers
;;;;;; rmail-displayed-headers rmail-ignored-headers rmail-dont-reply-to-names)
-;;;;;; "rmail" "mail/rmail.el" (15464 26331))
+;;;;;; "rmail" "mail/rmail.el" (16072 11522))
;;; Generated autoloads from mail/rmail.el
(defvar rmail-dont-reply-to-names nil "\
-*A regexp specifying names to prune of reply to messages.
-A value of nil means exclude your own login name as an address
+*A regexp specifying addresses to prune from a reply message.
+A value of nil means exclude your own email address as an address
plus whatever is specified by `rmail-default-dont-reply-to-names'.")
+(custom-autoload (quote rmail-dont-reply-to-names) "rmail")
+
(defvar rmail-default-dont-reply-to-names "info-" "\
A regular expression specifying part of the value of the default value of
the variable `rmail-dont-reply-to-names', for when the user does not set
`rmail-dont-reply-to-names' explicitly. (The other part of the default
-value is the user's name.)
+value is the user's email address and name.)
It is useful to set this variable in the site customization file.")
-(defvar rmail-ignored-headers (concat "^via:\\|^mail-from:\\|^origin:\\|^references:" "\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:" "\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:" "\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:" "\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:" "\\|^x-mailer:\\|^delivered-to:\\|^lines:\\|^mime-version:" "\\|^content-transfer-encoding:\\|^x-coding-system:" "\\|^return-path:\\|^errors-to:\\|^return-receipt-to:" "\\|^x-sign:\\|^x-beenthere:\\|^x-mailman-version:" "\\|^precedence:\\|^list-help:\\|^list-post:\\|^list-subscribe:" "\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:" "\\|^content-type:\\|^content-length:" "\\|^x-attribution:\\|^x-disclaimer:\\|^x-trace:" "\\|^x-complaints-to:\\|^nntp-posting-date:\\|^user-agent:") "\
+(defvar rmail-ignored-headers (concat "^via:\\|^mail-from:\\|^origin:\\|^references:" "\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:" "\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:" "\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:" "\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:\\|^face:" "\\|^x-mailer:\\|^delivered-to:\\|^lines:\\|^mime-version:" "\\|^content-transfer-encoding:\\|^x-coding-system:" "\\|^return-path:\\|^errors-to:\\|^return-receipt-to:" "\\|^x-sign:\\|^x-beenthere:\\|^x-mailman-version:" "\\|^precedence:\\|^list-help:\\|^list-post:\\|^list-subscribe:" "\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:" "\\|^content-type:\\|^content-length:" "\\|^x-attribution:\\|^x-disclaimer:\\|^x-trace:" "\\|^x-complaints-to:\\|^nntp-posting-date:\\|^user-agent" "\\|^importance:\\|^envelope-to:\\|^delivery-date" "\\|^x.*-priority:\\|^x-mimeole:") "\
*Regexp to match header fields that Rmail should normally hide.
This variable is used for reformatting the message header,
which normally happens once for each message,
for a message that you have already viewed,
go to that message and type \\[rmail-toggle-header] twice.")
+(custom-autoload (quote rmail-ignored-headers) "rmail")
+
(defvar rmail-displayed-headers nil "\
*Regexp to match Header fields that Rmail should display.
If nil, display all header fields except those matched by
`rmail-ignored-headers'.")
+(custom-autoload (quote rmail-displayed-headers) "rmail")
+
(defvar rmail-retry-ignored-headers "^x-authentication-warning:" "\
*Headers that should be stripped when retrying a failed message.")
+(custom-autoload (quote rmail-retry-ignored-headers) "rmail")
+
(defvar rmail-highlighted-headers "^From:\\|^Subject:" "\
*Regexp to match Header fields that Rmail should normally highlight.
A value of nil means don't highlight.
See also `rmail-highlight-face'.")
+(custom-autoload (quote rmail-highlighted-headers) "rmail")
+
(defvar rmail-highlight-face nil "\
*Face used by Rmail for highlighting headers.")
+(custom-autoload (quote rmail-highlight-face) "rmail")
+
(defvar rmail-delete-after-output nil "\
*Non-nil means automatically delete a message that is copied to a file.")
+(custom-autoload (quote rmail-delete-after-output) "rmail")
+
(defvar rmail-primary-inbox-list nil "\
*List of files which are inboxes for user's primary mail file `~/RMAIL'.
-`nil' means the default, which is (\"/usr/spool/mail/$USER\")
+nil means the default, which is (\"/usr/spool/mail/$USER\")
\(the name varies depending on the operating system,
and the value of the environment variable MAIL overrides it).")
+(custom-autoload (quote rmail-primary-inbox-list) "rmail")
+
(defvar rmail-mail-new-frame nil "\
*Non-nil means Rmail makes a new frame for composing outgoing mail.")
+(custom-autoload (quote rmail-mail-new-frame) "rmail")
+
(defvar rmail-secondary-file-directory "~/" "\
*Directory for additional secondary Rmail files.")
+(custom-autoload (quote rmail-secondary-file-directory) "rmail")
+
(defvar rmail-secondary-file-regexp "\\.xmail$" "\
*Regexp for which files are secondary Rmail files.")
+(custom-autoload (quote rmail-secondary-file-regexp) "rmail")
+
(defvar rmail-confirm-expunge (quote y-or-n-p) "\
*Whether and how to ask for confirmation before expunging deleted messages.")
+(custom-autoload (quote rmail-confirm-expunge) "rmail")
+
(defvar rmail-mode-hook nil "\
List of functions to call when Rmail is invoked.")
(defvar rmail-show-message-hook nil "\
List of functions to call when Rmail displays a message.")
+(custom-autoload (quote rmail-show-message-hook) "rmail")
+
(defvar rmail-quit-hook nil "\
List of functions to call when quitting out of Rmail.")
If the value is neither t nor nil, RMAIL does not show MIME decoded message
until a user explicitly requires it.")
+(custom-autoload (quote rmail-enable-mime) "rmail")
+
(defvar rmail-show-mime-function nil "\
Function to show MIME decoded message of RMAIL file.
This function is called when `rmail-enable-mime' is non-nil.
(defvar rmail-insert-mime-forwarded-message-function nil "\
Function to insert a message in MIME format so it can be forwarded.
-This function is called if `rmail-enable-mime' or
+This function is called if `rmail-enable-mime' or
`rmail-enable-mime-composing' is non-nil.
It is called with one argument FORWARD-BUFFER, which is a
buffer containing the message to forward. The current buffer
(defvar rmail-search-mime-header-function nil "\
Function to check if a regexp matches a header of MIME message.
This function is called if `rmail-enable-mime' is non-nil.
-It is called with four arguments MSG, REGEXP, and LIMIT, where
+It is called with three arguments MSG, REGEXP, and LIMIT, where
MSG is the message number,
REGEXP is the regular expression,
LIMIT is the position specifying the end of header.")
Interactively, if you supply a prefix argument, then you
have a chance to specify a file name with the minibuffer.
-If `rmail-display-summary' is non-nil, make a summary for this RMAIL file." t nil)
+If `rmail-display-summary' is non-nil, make a summary for this RMAIL file.
+
+\(fn &optional FILE-NAME-ARG)" t nil)
(autoload (quote rmail-mode) "rmail" "\
Rmail Mode is used by \\<rmail-mode-map>\\[rmail] for editing Rmail files.
\\[rmail-summary-by-recipients] Summarize only messages with particular recipient(s).
\\[rmail-summary-by-regexp] Summarize only messages with particular regexp(s).
\\[rmail-summary-by-topic] Summarize only messages with subject line regexp(s).
-\\[rmail-toggle-header] Toggle display of complete header." t nil)
+\\[rmail-toggle-header] Toggle display of complete header.
+
+\(fn)" t nil)
(autoload (quote rmail-input) "rmail" "\
-Run Rmail on file FILENAME." t nil)
+Run Rmail on file FILENAME.
+
+\(fn FILENAME)" t nil)
(autoload (quote rmail-set-pop-password) "rmail" "\
-Set PASSWORD to be used for retrieving mail from a POP server." t nil)
+Set PASSWORD to be used for retrieving mail from a POP server.
+
+\(fn PASSWORD)" t nil)
;;;***
\f
;;;### (autoloads (rmail-edit-current-message) "rmailedit" "mail/rmailedit.el"
-;;;;;; (15371 46424))
+;;;;;; (15830 37093))
;;; Generated autoloads from mail/rmailedit.el
(autoload (quote rmail-edit-current-message) "rmailedit" "\
-Edit the contents of this message." t nil)
+Edit the contents of this message.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (rmail-next-labeled-message rmail-previous-labeled-message
;;;;;; rmail-read-label rmail-kill-label rmail-add-label) "rmailkwd"
-;;;;;; "mail/rmailkwd.el" (15371 46424))
+;;;;;; "mail/rmailkwd.el" (15186 43692))
;;; Generated autoloads from mail/rmailkwd.el
(autoload (quote rmail-add-label) "rmailkwd" "\
Add LABEL to labels associated with current RMAIL message.
-Completion is performed over known labels when reading." t nil)
+Completion is performed over known labels when reading.
+
+\(fn STRING)" t nil)
(autoload (quote rmail-kill-label) "rmailkwd" "\
Remove LABEL from labels associated with current RMAIL message.
-Completion is performed over known labels when reading." t nil)
+Completion is performed over known labels when reading.
+
+\(fn STRING)" t nil)
-(autoload (quote rmail-read-label) "rmailkwd" nil nil nil)
+(autoload (quote rmail-read-label) "rmailkwd" "\
+Not documented
+
+\(fn PROMPT)" nil nil)
(autoload (quote rmail-previous-labeled-message) "rmailkwd" "\
Show previous message with one of the labels LABELS.
LABELS should be a comma-separated list of label names.
If LABELS is empty, the last set of labels specified is used.
-With prefix argument N moves backward N messages with these labels." t nil)
+With prefix argument N moves backward N messages with these labels.
+
+\(fn N LABELS)" t nil)
(autoload (quote rmail-next-labeled-message) "rmailkwd" "\
Show next message with one of the labels LABELS.
LABELS should be a comma-separated list of label names.
If LABELS is empty, the last set of labels specified is used.
-With prefix argument N moves forward N messages with these labels." t nil)
+With prefix argument N moves forward N messages with these labels.
+
+\(fn N LABELS)" t nil)
;;;***
\f
;;;### (autoloads (set-rmail-inbox-list) "rmailmsc" "mail/rmailmsc.el"
-;;;;;; (15371 46424))
+;;;;;; (15186 43692))
;;; Generated autoloads from mail/rmailmsc.el
(autoload (quote set-rmail-inbox-list) "rmailmsc" "\
Set the inbox list of the current RMAIL file to FILE-NAME.
You can specify one file name, or several names separated by commas.
-If FILE-NAME is empty, remove any existing inbox list." t nil)
+If FILE-NAME is empty, remove any existing inbox list.
+
+\(fn FILE-NAME)" t nil)
;;;***
\f
;;;### (autoloads (rmail-output-body-to-file rmail-output rmail-fields-not-to-output
;;;;;; rmail-output-to-rmail-file rmail-output-file-alist) "rmailout"
-;;;;;; "mail/rmailout.el" (15371 46424))
+;;;;;; "mail/rmailout.el" (15941 42961))
;;; Generated autoloads from mail/rmailout.el
(defvar rmail-output-file-alist nil "\
or more generally it may be any kind of expression that returns
a file name as a string.")
+(custom-autoload (quote rmail-output-file-alist) "rmailout")
+
(autoload (quote rmail-output-to-rmail-file) "rmailout" "\
Append the current message to an Rmail file named FILE-NAME.
If the file does not exist, ask if it should be created.
starting with the current one. Deleted messages are skipped and don't count.
If optional argument STAY is non-nil, then leave the last filed
-mesasge up instead of moving forward to the next non-deleted message." t nil)
+mesasge up instead of moving forward to the next non-deleted message.
+
+\(fn FILE-NAME &optional COUNT STAY)" t nil)
(defvar rmail-fields-not-to-output nil "\
*Regexp describing fields to exclude when outputting a message to a file.")
+(custom-autoload (quote rmail-fields-not-to-output) "rmailout")
+
(autoload (quote rmail-output) "rmailout" "\
Append this message to system-inbox-format mail file named FILE-NAME.
A prefix argument N says to output N consecutive messages
The optional third argument NOATTRIBUTE, if non-nil, says not
to set the `filed' attribute, and not to display a message.
-The optional fourth argument FROM-GNUS is set when called from GNUS." t nil)
+The optional fourth argument FROM-GNUS is set when called from GNUS.
+
+\(fn FILE-NAME &optional COUNT NOATTRIBUTE FROM-GNUS)" t nil)
(autoload (quote rmail-output-body-to-file) "rmailout" "\
Write this message body to the file FILE-NAME.
-FILE-NAME defaults, interactively, from the Subject field of the message." t nil)
+FILE-NAME defaults, interactively, from the Subject field of the message.
+
+\(fn FILE-NAME)" t nil)
;;;***
\f
;;;### (autoloads (rmail-sort-by-labels rmail-sort-by-lines rmail-sort-by-correspondent
;;;;;; rmail-sort-by-recipient rmail-sort-by-author rmail-sort-by-subject
-;;;;;; rmail-sort-by-date) "rmailsort" "mail/rmailsort.el" (15371
-;;;;;; 46424))
+;;;;;; rmail-sort-by-date) "rmailsort" "mail/rmailsort.el" (15941
+;;;;;; 42961))
;;; Generated autoloads from mail/rmailsort.el
(autoload (quote rmail-sort-by-date) "rmailsort" "\
Sort messages of current Rmail file by date.
-If prefix argument REVERSE is non-nil, sort them in reverse order." t nil)
+If prefix argument REVERSE is non-nil, sort them in reverse order.
+
+\(fn REVERSE)" t nil)
(autoload (quote rmail-sort-by-subject) "rmailsort" "\
Sort messages of current Rmail file by subject.
-If prefix argument REVERSE is non-nil, sort them in reverse order." t nil)
+If prefix argument REVERSE is non-nil, sort them in reverse order.
+
+\(fn REVERSE)" t nil)
(autoload (quote rmail-sort-by-author) "rmailsort" "\
Sort messages of current Rmail file by author.
-If prefix argument REVERSE is non-nil, sort them in reverse order." t nil)
+If prefix argument REVERSE is non-nil, sort them in reverse order.
+
+\(fn REVERSE)" t nil)
(autoload (quote rmail-sort-by-recipient) "rmailsort" "\
Sort messages of current Rmail file by recipient.
-If prefix argument REVERSE is non-nil, sort them in reverse order." t nil)
+If prefix argument REVERSE is non-nil, sort them in reverse order.
+
+\(fn REVERSE)" t nil)
(autoload (quote rmail-sort-by-correspondent) "rmailsort" "\
Sort messages of current Rmail file by other correspondent.
-If prefix argument REVERSE is non-nil, sort them in reverse order." t nil)
+If prefix argument REVERSE is non-nil, sort them in reverse order.
+
+\(fn REVERSE)" t nil)
(autoload (quote rmail-sort-by-lines) "rmailsort" "\
Sort messages of current Rmail file by number of lines.
-If prefix argument REVERSE is non-nil, sort them in reverse order." t nil)
+If prefix argument REVERSE is non-nil, sort them in reverse order.
+
+\(fn REVERSE)" t nil)
(autoload (quote rmail-sort-by-labels) "rmailsort" "\
Sort messages of current Rmail file by labels.
If prefix argument REVERSE is non-nil, sort them in reverse order.
-KEYWORDS is a comma-separated list of labels." t nil)
+KEYWORDS is a comma-separated list of labels.
+
+\(fn REVERSE LABELS)" t nil)
;;;***
\f
;;;;;; rmail-summary-by-senders rmail-summary-by-topic rmail-summary-by-regexp
;;;;;; rmail-summary-by-recipients rmail-summary-by-labels rmail-summary
;;;;;; rmail-summary-line-count-flag rmail-summary-scroll-between-messages)
-;;;;;; "rmailsum" "mail/rmailsum.el" (15479 52723))
+;;;;;; "rmailsum" "mail/rmailsum.el" (16025 36884))
;;; Generated autoloads from mail/rmailsum.el
(defvar rmail-summary-scroll-between-messages t "\
*Non-nil means Rmail summary scroll commands move between messages.")
+(custom-autoload (quote rmail-summary-scroll-between-messages) "rmailsum")
+
(defvar rmail-summary-line-count-flag t "\
-*Non-nil if Rmail summary should show the number of lines in each message.")
+*Non-nil means Rmail summary should show the number of lines in each message.")
+
+(custom-autoload (quote rmail-summary-line-count-flag) "rmailsum")
(autoload (quote rmail-summary) "rmailsum" "\
-Display a summary of all messages, one line per message." t nil)
+Display a summary of all messages, one line per message.
+
+\(fn)" t nil)
(autoload (quote rmail-summary-by-labels) "rmailsum" "\
Display a summary of all messages with one or more LABELS.
-LABELS should be a string containing the desired labels, separated by commas." t nil)
+LABELS should be a string containing the desired labels, separated by commas.
+
+\(fn LABELS)" t nil)
(autoload (quote rmail-summary-by-recipients) "rmailsum" "\
Display a summary of all messages with the given RECIPIENTS.
Normally checks the To, From and Cc fields of headers;
but if PRIMARY-ONLY is non-nil (prefix arg given),
only look in the To and From fields.
-RECIPIENTS is a string of regexps separated by commas." t nil)
+RECIPIENTS is a string of regexps separated by commas.
+
+\(fn RECIPIENTS &optional PRIMARY-ONLY)" t nil)
(autoload (quote rmail-summary-by-regexp) "rmailsum" "\
Display a summary of all messages according to regexp REGEXP.
If the regular expression is found in the header of the message
\(including in the date and other lines, as well as the subject line),
-Emacs will list the header line in the RMAIL-summary." t nil)
+Emacs will list the header line in the RMAIL-summary.
+
+\(fn REGEXP)" t nil)
(autoload (quote rmail-summary-by-topic) "rmailsum" "\
Display a summary of all messages with the given SUBJECT.
Normally checks the Subject field of headers;
-but if WHOLE-MESSAGE is non-nil (prefix arg given),
+but if WHOLE-MESSAGE is non-nil (prefix arg given),
look in the whole message.
-SUBJECT is a string of regexps separated by commas." t nil)
+SUBJECT is a string of regexps separated by commas.
+
+\(fn SUBJECT &optional WHOLE-MESSAGE)" t nil)
(autoload (quote rmail-summary-by-senders) "rmailsum" "\
Display a summary of all messages with the given SENDERS.
-SENDERS is a string of names separated by commas." t nil)
+SENDERS is a string of names separated by commas.
+
+\(fn SENDERS)" t nil)
(defvar rmail-summary-line-decoder (function identity) "\
*Function to decode summary-line.
By default, `identity' is set.")
+(custom-autoload (quote rmail-summary-line-decoder) "rmailsum")
+
(defvar rmail-user-mail-address-regexp nil "\
*Regexp matching user mail addresses.
If non-nil, this variable is used to identify the correspondent
Usually you don't have to set this variable, except if you collect mails
sent by you under different user names.
-Then it should be a regexp matching your mail adresses.
+Then it should be a regexp matching your mail addresses.
Setting this variable has an effect only before reading a mail.")
+(custom-autoload (quote rmail-user-mail-address-regexp) "rmailsum")
+
;;;***
\f
;;;### (autoloads (news-post-news) "rnewspost" "obsolete/rnewspost.el"
-;;;;;; (15371 46425))
+;;;;;; (15941 42963))
;;; Generated autoloads from obsolete/rnewspost.el
(autoload (quote news-post-news) "rnewspost" "\
Begin editing a new USENET news article to be posted.
Type \\[describe-mode] once editing the article to get a list of commands.
-If NOQUERY is non-nil, we do not query before doing the work." t nil)
+If NOQUERY is non-nil, we do not query before doing the work.
+
+\(fn &optional NOQUERY)" t nil)
;;;***
\f
-;;;### (autoloads (toggle-rot13-mode rot13-other-window) "rot13"
-;;;;;; "rot13.el" (15371 46418))
+;;;### (autoloads (toggle-rot13-mode rot13-other-window rot13-region
+;;;;;; rot13-string rot13) "rot13" "rot13.el" (15941 42956))
;;; Generated autoloads from rot13.el
+(autoload (quote rot13) "rot13" "\
+Return Rot13 encryption of OBJECT, a buffer or string.
+
+\(fn OBJECT &optional START END)" nil nil)
+
+(autoload (quote rot13-string) "rot13" "\
+Return Rot13 encryption of STRING.
+
+\(fn STRING)" nil nil)
+
+(autoload (quote rot13-region) "rot13" "\
+Rot13 encrypt the region between START and END in current buffer.
+
+\(fn START END)" t nil)
+
(autoload (quote rot13-other-window) "rot13" "\
Display current buffer in rot 13 in another window.
The text itself is not modified, only the way it is displayed is affected.
is not deleted, any buffer displayed in it will become instantly encoded
in rot 13.
-See also `toggle-rot13-mode'." t nil)
+See also `toggle-rot13-mode'.
+
+\(fn)" t nil)
(autoload (quote toggle-rot13-mode) "rot13" "\
-Toggle the use of rot 13 encoding for the current window." t nil)
+Toggle the use of rot 13 encoding for the current window.
+
+\(fn)" t nil)
;;;***
\f
;;;;;; resize-minibuffer-frame-max-height resize-minibuffer-frame
;;;;;; resize-minibuffer-window-exactly resize-minibuffer-window-max-height
;;;;;; resize-minibuffer-mode) "rsz-mini" "obsolete/rsz-mini.el"
-;;;;;; (15371 46425))
+;;;;;; (15245 60238))
;;; Generated autoloads from obsolete/rsz-mini.el
(defvar resize-minibuffer-mode nil "\
*This variable is obsolete.")
-(custom-add-to-group (quote resize-minibuffer) (quote resize-minibuffer-mode) (quote custom-variable))
-
-(custom-add-load (quote resize-minibuffer-mode) (quote rsz-mini))
+(custom-autoload (quote resize-minibuffer-mode) "rsz-mini")
(defvar resize-minibuffer-window-max-height nil "\
*This variable is obsolete.")
+(custom-autoload (quote resize-minibuffer-window-max-height) "rsz-mini")
+
(defvar resize-minibuffer-window-exactly t "\
*This variable is obsolete.")
+(custom-autoload (quote resize-minibuffer-window-exactly) "rsz-mini")
+
(defvar resize-minibuffer-frame nil "\
*This variable is obsolete.")
+(custom-autoload (quote resize-minibuffer-frame) "rsz-mini")
+
(defvar resize-minibuffer-frame-max-height nil "\
*This variable is obsolete.")
+(custom-autoload (quote resize-minibuffer-frame-max-height) "rsz-mini")
+
(defvar resize-minibuffer-frame-exactly t "\
*This variable is obsolete.")
+(custom-autoload (quote resize-minibuffer-frame-exactly) "rsz-mini")
+
(autoload (quote resize-minibuffer-mode) "rsz-mini" "\
-This function is obsolete." t nil)
+This function is obsolete.
+
+\(fn &optional PREFIX)" t nil)
;;;***
\f
- ;;;### (autoloads (ruler-mode) "ruler-mode" "ruler-mode.el" (16111
- ;;;;;; 41826))
-;;;### (autoloads (ruler-mode) "ruler-mode" "ruler-mode.el" (15441
-;;;;;; 20091))
++;;;### (autoloads (ruler-mode) "ruler-mode" "ruler-mode.el" (16179
++;;;;;; 11153))
;;; Generated autoloads from ruler-mode.el
(autoload (quote ruler-mode) "ruler-mode" "\
-Display a ruler in the header line if ARG > 0." t nil)
+Display a ruler in the header line if ARG > 0.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
-;;;### (autoloads (rx rx-to-string) "rx" "emacs-lisp/rx.el" (15371
-;;;;;; 46419))
+;;;### (autoloads (rx rx-to-string) "rx" "emacs-lisp/rx.el" (15941
+;;;;;; 42958))
;;; Generated autoloads from emacs-lisp/rx.el
(autoload (quote rx-to-string) "rx" "\
Parse and produce code for regular expression FORM.
FORM is a regular expression in sexp form.
-NO-GROUP non-nil means don't put shy groups around the result." nil nil)
+NO-GROUP non-nil means don't put shy groups around the result.
+
+\(fn FORM &optional NO-GROUP)" nil nil)
(autoload (quote rx) "rx" "\
Translate a regular expression REGEXP in sexp form to a regexp string.
matches any character in SET. SET may be a character or string.
Ranges of characters can be specified as `A-Z' in strings.
-'(in SET)'
+'(in SET)'
like `any'.
`(not (any SET))'
still match. A non-greedy regexp matches as little as possible.
`(maximal-match SEXP)'
- produce a greedy regexp for SEXP. This is the default.
+ produce a greedy regexp for SEXP. This is the default.
`(zero-or-more SEXP)'
matches zero or more occurrences of what SEXP matches.
`(one-or-more SEXP)'
matches one or more occurrences of A.
-
+
`(1+ SEXP)'
like `one-or-more'.
`(zero-or-one SEXP)'
matches zero or one occurrences of A.
-
+
`(optional SEXP)'
like `zero-or-one'.
matches N to M occurrences of what SEXP matches.
`(eval FORM)'
- evaluate FORM and insert result. If result is a string,
+ evaluate FORM and insert result. If result is a string,
`regexp-quote' it.
`(regexp REGEXP)'
- include REGEXP in string notation in the result." nil (quote macro))
+ include REGEXP in string notation in the result.
+
+\(fn REGEXP)" nil (quote macro))
;;;***
\f
;;;### (autoloads (dsssl-mode scheme-mode) "scheme" "progmodes/scheme.el"
-;;;;;; (15371 46426))
+;;;;;; (16054 60750))
;;; Generated autoloads from progmodes/scheme.el
(autoload (quote scheme-mode) "scheme" "\
Blank lines separate paragraphs. Semicolons start comments.
\\{scheme-mode-map}
Entry to this mode calls the value of `scheme-mode-hook'
-if that value is non-nil." t nil)
+if that value is non-nil.
+
+\(fn)" t nil)
(autoload (quote dsssl-mode) "scheme" "\
Major mode for editing DSSSL code.
\\{scheme-mode-map}
Entering this mode runs the hooks `scheme-mode-hook' and then
`dsssl-mode-hook' and inserts the value of `dsssl-sgml-declaration' if
-that variable's value is a string." t nil)
+that variable's value is a string.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (gnus-score-mode) "score-mode" "gnus/score-mode.el"
-;;;;;; (15371 46421))
+;;;;;; (14792 28989))
;;; Generated autoloads from gnus/score-mode.el
(autoload (quote gnus-score-mode) "score-mode" "\
Mode for editing Gnus score files.
This mode is an extended emacs-lisp mode.
-\\{gnus-score-mode-map}" t nil)
+\\{gnus-score-mode-map}
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (scribe-mode) "scribe" "textmodes/scribe.el" (15400
-;;;;;; 1481))
-;;; Generated autoloads from textmodes/scribe.el
+;;;### (autoloads (scribe-mode) "scribe" "obsolete/scribe.el" (16087
+;;;;;; 59373))
+;;; Generated autoloads from obsolete/scribe.el
(autoload (quote scribe-mode) "scribe" "\
Major mode for editing files of Scribe (a text formatter) source.
`scribe-electric-parenthesis'
Non-nil makes an open-parenthesis char (one of `([<{')
- automatically insert its close if typed after an @Command form." t nil)
+ automatically insert its close if typed after an @Command form.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (scroll-all-mode scroll-all-mode) "scroll-all"
-;;;;;; "scroll-all.el" (15371 46423))
+;;;### (autoloads (scroll-all-mode) "scroll-all" "scroll-all.el"
+;;;;;; (15941 42956))
;;; Generated autoloads from scroll-all.el
(defvar scroll-all-mode nil "\
-Control/track scroll locking.
-
+Non-nil if Scroll-All mode is enabled.
+See the command `scroll-all-mode' for a description of this minor-mode.
Setting this variable directly does not take effect;
-use either M-x customize or the function `scroll-all-mode'.")
-
-(custom-add-to-group (quote windows) (quote scroll-all-mode) (quote custom-variable))
+use either \\[customize] or the function `scroll-all-mode'.")
-(custom-add-load (quote scroll-all-mode) (quote scroll-all))
+(custom-autoload (quote scroll-all-mode) "scroll-all")
(autoload (quote scroll-all-mode) "scroll-all" "\
-Toggle Scroll-All minor mode." t nil)
+Toggle Scroll-All minor mode.
+With ARG, turn Scroll-All minor mode on if ARG is positive, off otherwise.
+When Scroll-All mode is on, scrolling commands entered in one window
+apply to all visible windows in the same frame.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (mail-other-frame mail-other-window mail mail-mode
-;;;;;; mail-signature mail-personal-alias-file mail-alias-file mail-default-reply-to
-;;;;;; mail-archive-file-name mail-header-separator send-mail-function
-;;;;;; mail-yank-ignored-headers mail-interactive mail-self-blind
-;;;;;; mail-specify-envelope-from mail-from-style) "sendmail" "mail/sendmail.el"
-;;;;;; (15602 18408))
+;;;;;; mail-default-directory mail-signature mail-personal-alias-file
+;;;;;; mail-alias-file mail-default-reply-to mail-archive-file-name
+;;;;;; mail-header-separator send-mail-function mail-yank-ignored-headers
+;;;;;; mail-interactive mail-self-blind mail-specify-envelope-from
- ;;;;;; mail-from-style) "sendmail" "mail/sendmail.el" (16136 53055))
++;;;;;; mail-from-style) "sendmail" "mail/sendmail.el" (16183 39073))
;;; Generated autoloads from mail/sendmail.el
(defvar mail-from-style (quote angles) "\
to the mailer to specify the envelope-from address. But that is now
controlled by a separate variable, `mail-specify-envelope-from'.")
+(custom-autoload (quote mail-from-style) "sendmail")
+
(defvar mail-specify-envelope-from nil "\
*If non-nil, specify the envelope-from address when sending mail.
The value used to specify it is whatever is found in
`mail-envelope-from', with `user-mail-address' as fallback.
-On most systems, specifying the envelope-from address
-is a privileged operation.")
+On most systems, specifying the envelope-from address is a
+privileged operation. This variable is only used if
+`send-mail-function' is set to `sendmail-send-it'.")
+
+(custom-autoload (quote mail-specify-envelope-from) "sendmail")
(defvar mail-self-blind nil "\
*Non-nil means insert BCC to self in messages to be sent.
This is done when the message is initialized,
so you can remove or alter the BCC field to override the default.")
+(custom-autoload (quote mail-self-blind) "sendmail")
+
(defvar mail-interactive nil "\
*Non-nil means when sending a message wait for and display errors.
nil means let mailer mail back a message to report errors.")
+(custom-autoload (quote mail-interactive) "sendmail")
+
(defvar mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" "\
*Delete these headers from old message when it's inserted in a reply.")
+(custom-autoload (quote mail-yank-ignored-headers) "sendmail")
+
(defvar send-mail-function (quote sendmail-send-it) "\
Function to call to send the current buffer as mail.
The headers should be delimited by a line which is
This is used by the default mail-sending commands. See also
`message-send-mail-function' for use with the Message package.")
+(custom-autoload (quote send-mail-function) "sendmail")
+
(defvar mail-header-separator "--text follows this line--" "\
*Line used to separate headers from text in messages being composed.")
+(custom-autoload (quote mail-header-separator) "sendmail")
+
(defvar mail-archive-file-name nil "\
*Name of file to write all outgoing messages in, or nil for none.
This can be an inbox file or an Rmail file.")
+(custom-autoload (quote mail-archive-file-name) "sendmail")
+
(defvar mail-default-reply-to nil "\
*Address to insert as default Reply-to field of outgoing messages.
If nil, it will be initialized from the REPLYTO environment variable
when you first send mail.")
+(custom-autoload (quote mail-default-reply-to) "sendmail")
+
(defvar mail-alias-file nil "\
*If non-nil, the name of a file to use instead of `/usr/lib/aliases'.
This file defines aliases to be expanded by the mailer; this is a different
feature from that of defining aliases in `.mailrc' to be expanded in Emacs.
This variable has no effect unless your system uses sendmail as its mailer.")
+(custom-autoload (quote mail-alias-file) "sendmail")
+
(defvar mail-personal-alias-file "~/.mailrc" "\
*If non-nil, the name of the user's personal mail alias file.
This file typically should be in same format as the `.mailrc' file used by
the `Mail' or `mailx' program.
This file need not actually exist.")
+(custom-autoload (quote mail-personal-alias-file) "sendmail")
+
(defvar mail-signature nil "\
*Text inserted at end of mail buffer when a message is initialized.
If t, it means to insert the contents of the file `mail-signature-file'.
Otherwise, it should be an expression; it is evaluated
and should insert whatever you want to insert.")
+(custom-autoload (quote mail-signature) "sendmail")
+
+(defvar mail-default-directory "~/" "\
+*Directory for mail buffers.
+Value of `default-directory' for mail buffers.
+This directory is used for auto-save files of mail buffers.")
+
+(custom-autoload (quote mail-default-directory) "sendmail")
+
(autoload (quote mail-mode) "sendmail" "\
Major mode for editing mail to be sent.
Like Text Mode but with these additional commands:
\\[mail-fill-yanked-message] mail-fill-yanked-message (fill what was yanked).
\\[mail-sent-via] mail-sent-via (add a Sent-via field for each To or CC).
Turning on Mail mode runs the normal hooks `text-mode-hook' and
-`mail-mode-hook' (in that order)." t nil)
+`mail-mode-hook' (in that order).
+
+\(fn)" t nil)
(defvar sendmail-coding-system nil "\
*Coding system for encoding the outgoing mail.
The seventh argument ACTIONS is a list of actions to take
if/when the message is sent. Each action looks like (FUNCTION . ARGS);
when the message is sent, we apply FUNCTION to ARGS.
- This is how Rmail arranges to mark messages `answered'." t nil)
+ This is how Rmail arranges to mark messages `answered'.
+
+\(fn &optional NOERASE TO SUBJECT IN-REPLY-TO CC REPLYBUFFER ACTIONS)" t nil)
(autoload (quote mail-other-window) "sendmail" "\
-Like `mail' command, but display mail buffer in another window." t nil)
+Like `mail' command, but display mail buffer in another window.
+
+\(fn &optional NOERASE TO SUBJECT IN-REPLY-TO CC REPLYBUFFER SENDACTIONS)" t nil)
(autoload (quote mail-other-frame) "sendmail" "\
-Like `mail' command, but display mail buffer in another frame." t nil)
+Like `mail' command, but display mail buffer in another frame.
+
+\(fn &optional NOERASE TO SUBJECT IN-REPLY-TO CC REPLYBUFFER SENDACTIONS)" t nil)
;;;***
\f
-;;;### (autoloads (server-start) "server" "server.el" (15400 1473))
+;;;### (autoloads (server-mode server-start) "server" "server.el"
+;;;;;; (16162 11942))
;;; Generated autoloads from server.el
(autoload (quote server-start) "server" "\
To use the server, set up the program `emacsclient' in the
Emacs distribution as your standard \"editor\".
-Prefix arg means just kill any existing server communications subprocess." t nil)
+Prefix arg means just kill any existing server communications subprocess.
+
+\(fn &optional LEAVE-DEAD)" t nil)
+
+(defvar server-mode nil "\
+Non-nil if Server mode is enabled.
+See the command `server-mode' for a description of this minor-mode.
+Setting this variable directly does not take effect;
+use either \\[customize] or the function `server-mode'.")
+
+(custom-autoload (quote server-mode) "server")
+
+(autoload (quote server-mode) "server" "\
+Toggle Server mode.
+With ARG, turn Server mode on if ARG is positive, off otherwise.
+Server mode runs a process that accepts commands from the
+`emacsclient' program. See `server-start' and Info node `Emacs server'.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (ses-mode) "ses" "ses.el" (16162 11942))
+;;; Generated autoloads from ses.el
+
+(autoload (quote ses-mode) "ses" "\
+Major mode for Simple Emacs Spreadsheet. See \"ses-readme.txt\" for more info.
+
+Key definitions:
+\\{ses-mode-map}
+These key definitions are active only in the print area (the visible part):
+\\{ses-mode-print-map}
+These are active only in the minibuffer, when entering or editing a formula:
+\\{ses-mode-edit-map}
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (html-mode sgml-mode) "sgml-mode" "textmodes/sgml-mode.el"
- ;;;;;; (16139 21086))
-;;;;;; (15486 59257))
++;;;;;; (16183 39901))
;;; Generated autoloads from textmodes/sgml-mode.el
(autoload (quote sgml-mode) "sgml-mode" "\
Major mode for editing SGML documents.
-Makes > match <. Makes / blink matching /.
-Keys <, &, SPC within <>, \" and ' can be electric depending on
+Makes > match <.
+Keys <, &, SPC within <>, \", / and ' can be electric depending on
`sgml-quick-keys'.
An argument of N to a tag-inserting command means to wrap it around
Do \\[describe-variable] sgml- SPC to see available variables.
Do \\[describe-key] on the following bindings to discover what they do.
-\\{sgml-mode-map}" t nil)
+\\{sgml-mode-map}
+
+\(fn)" t nil)
+
+(defalias (quote xml-mode) (quote sgml-mode))
(autoload (quote html-mode) "sgml-mode" "\
Major mode based on SGML mode for editing HTML documents.
To work around that, do:
(eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil))
-\\{html-mode-map}" t nil)
+\\{html-mode-map}
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (sh-mode) "sh-script" "progmodes/sh-script.el"
-;;;;;; (15441 20097))
+;;;;;; (16174 61085))
;;; Generated autoloads from progmodes/sh-script.el
-(put (quote sh-mode) (quote mode-class) (quote special))
-
(autoload (quote sh-mode) "sh-script" "\
Major mode for editing shell scripts.
This mode works for many shells, since they all have roughly the same syntax,
indicate what shell it is use `sh-alias-alist' to translate.
If your shell gives error messages with line numbers, you can use \\[executable-interpret]
-with your script for an edit-interpret-debug cycle." t nil)
+with your script for an edit-interpret-debug cycle.
+
+\(fn)" t nil)
(defalias (quote shell-script-mode) (quote sh-mode))
;;;***
\f
;;;### (autoloads (list-load-path-shadows) "shadow" "emacs-lisp/shadow.el"
-;;;;;; (15371 46419))
+;;;;;; (15941 42958))
;;; Generated autoloads from emacs-lisp/shadow.el
(autoload (quote list-load-path-shadows) "shadow" "\
When run interactively, the shadowings (if any) are displayed in a
buffer called `*Shadows*'. Shadowings are located by calling the
-\(non-interactive) companion function, `find-emacs-lisp-shadows'." t nil)
+\(non-interactive) companion function, `find-emacs-lisp-shadows'.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (shadow-initialize shadow-define-regexp-group shadow-define-literal-group
-;;;;;; shadow-define-cluster) "shadowfile" "shadowfile.el" (15371
-;;;;;; 46425))
+;;;;;; shadow-define-cluster) "shadowfile" "shadowfile.el" (16016
+;;;;;; 56429))
;;; Generated autoloads from shadowfile.el
(autoload (quote shadow-define-cluster) "shadowfile" "\
one of them is sufficient to update the file on all of them. Clusters are
defined by a name, the network address of a primary host (the one we copy
files to), and a regular expression that matches the hostnames of all the sites
-in the cluster." t nil)
+in the cluster.
+
+\(fn NAME)" t nil)
(autoload (quote shadow-define-literal-group) "shadowfile" "\
Declare a single file to be shared between sites.
It may have different filenames on each site. When this file is edited, the
new version will be copied to each of the other locations. Sites can be
-specific hostnames, or names of clusters (see `shadow-define-cluster')." t nil)
+specific hostnames, or names of clusters (see `shadow-define-cluster').
+
+\(fn)" t nil)
(autoload (quote shadow-define-regexp-group) "shadowfile" "\
Make each of a group of files be shared between hosts.
of sites, which are also prompted for. The filenames must be identical on all
hosts (if they aren't, use shadow-define-group instead of this function).
Each site can be either a hostname or the name of a cluster (see
-`shadow-define-cluster')." t nil)
+`shadow-define-cluster').
+
+\(fn)" t nil)
(autoload (quote shadow-initialize) "shadowfile" "\
-Set up file shadowing." t nil)
+Set up file shadowing.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (shell shell-dumb-shell-regexp) "shell" "shell.el"
-;;;;;; (15482 42688))
+;;;;;; (16111 41826))
;;; Generated autoloads from shell.el
(defvar shell-dumb-shell-regexp "cmd\\(proxy\\)?\\.exe" "\
shell finishes, and won't remove backslashes when it unquotes shell
arguments.")
+(custom-autoload (quote shell-dumb-shell-regexp) "shell")
+
(autoload (quote shell) "shell" "\
Run an inferior shell, with I/O through BUFFER (which defaults to `*shell*').
Interactively, a prefix arg means to prompt for BUFFER.
its value is used as a list of arguments when invoking the shell.
Otherwise, one argument `-i' is passed to the shell.
-\(Type \\[describe-mode] in the shell buffer for a list of commands.)" t nil)
+\(Type \\[describe-mode] in the shell buffer for a list of commands.)
+
+\(fn &optional BUFFER)" t nil)
(add-hook 'same-window-buffer-names "*shell*")
;;;***
\f
-;;;### (autoloads (simula-mode) "simula" "progmodes/simula.el" (15400
-;;;;;; 1480))
+;;;### (autoloads (simula-mode) "simula" "progmodes/simula.el" (15997
+;;;;;; 672))
;;; Generated autoloads from progmodes/simula.el
(autoload (quote simula-mode) "simula" "\
Major mode for editing SIMULA code.
\\{simula-mode-map}
Variables controlling indentation style:
- simula-tab-always-indent
+ `simula-tab-always-indent'
Non-nil means TAB in SIMULA mode should always reindent the current line,
regardless of where in the line point is when the TAB command is used.
- simula-indent-level
+ `simula-indent-level'
Indentation of SIMULA statements with respect to containing block.
- simula-substatement-offset
+ `simula-substatement-offset'
Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.
- simula-continued-statement-offset 3
+ `simula-continued-statement-offset' 3
Extra indentation for lines not starting a statement or substatement,
e.g. a nested FOR-loop. If value is a list, each line in a multiple-
line continued statement will have the car of the list extra indentation
with respect to the previous line of the statement.
- simula-label-offset -4711
+ `simula-label-offset' -4711
Offset of SIMULA label lines relative to usual indentation.
- simula-if-indent '(0 . 0)
+ `simula-if-indent' '(0 . 0)
Extra indentation of THEN and ELSE with respect to the starting IF.
Value is a cons cell, the car is extra THEN indentation and the cdr
extra ELSE indentation. IF after ELSE is indented as the starting IF.
- simula-inspect-indent '(0 . 0)
+ `simula-inspect-indent' '(0 . 0)
Extra indentation of WHEN and OTHERWISE with respect to the
corresponding INSPECT. Value is a cons cell, the car is
extra WHEN indentation and the cdr extra OTHERWISE indentation.
- simula-electric-indent nil
+ `simula-electric-indent' nil
If this variable is non-nil, `simula-indent-line'
will check the previous line to see if it has to be reindented.
- simula-abbrev-keyword 'upcase
+ `simula-abbrev-keyword' 'upcase
Determine how SIMULA keywords will be expanded. Value is one of
the symbols `upcase', `downcase', `capitalize', (as in) `abbrev-table',
or nil if they should not be changed.
- simula-abbrev-stdproc 'abbrev-table
+ `simula-abbrev-stdproc' 'abbrev-table
Determine how standard SIMULA procedure and class names will be
expanded. Value is one of the symbols `upcase', `downcase', `capitalize',
(as in) `abbrev-table', or nil if they should not be changed.
Turning on SIMULA mode calls the value of the variable simula-mode-hook
-with no arguments, if that value is non-nil
+with no arguments, if that value is non-nil.
-Warning: simula-mode-hook should not read in an abbrev file without calling
-the function simula-install-standard-abbrevs afterwards, preferably not
-at all." t nil)
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (skeleton-pair-insert-maybe skeleton-insert skeleton-proxy
-;;;;;; skeleton-proxy-new define-skeleton) "skeleton" "skeleton.el"
-;;;;;; (15371 46425))
+;;;### (autoloads (skeleton-pair-insert-maybe skeleton-insert skeleton-proxy-new
+;;;;;; define-skeleton) "skeleton" "skeleton.el" (16111 41826))
;;; Generated autoloads from skeleton.el
(defvar skeleton-filter (quote identity) "\
(autoload (quote define-skeleton) "skeleton" "\
Define a user-configurable COMMAND that enters a statement skeleton.
-DOCUMENTATION is that of the command, while the variable of the same name,
-which contains the skeleton, has a documentation to that effect.
-INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'." nil (quote macro))
+DOCUMENTATION is that of the command.
+SKELETON is as defined under `skeleton-insert'.
+
+\(fn COMMAND DOCUMENTATION &rest SKELETON)" nil (quote macro))
(autoload (quote skeleton-proxy-new) "skeleton" "\
-Insert skeleton defined by variable of same name (see `skeleton-insert').
+Insert SKELETON.
Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
If no ARG was given, but the region is visible, ARG defaults to -1 depending
on `skeleton-autowrap'. An ARG of M-0 will prevent this just for once.
This command can also be an abbrev expansion (3rd and 4th columns in
\\[edit-abbrevs] buffer: \"\" command-name).
-When called as a function, optional first argument STR may also be a string
-which will be the value of `str' whereas the skeleton's interactor is then
-ignored." t nil)
-
-(autoload (quote skeleton-proxy) "skeleton" "\
-Insert skeleton defined by variable of same name (see `skeleton-insert').
-Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
-If no ARG was given, but the region is visible, ARG defaults to -1 depending
-on `skeleton-autowrap'. An ARG of M-0 will prevent this just for once.
-This command can also be an abbrev expansion (3rd and 4th columns in
-\\[edit-abbrevs] buffer: \"\" command-name).
+Optional first argument STR may also be a string which will be the value
+of `str' whereas the skeleton's interactor is then ignored.
-When called as a function, optional first argument STR may also be a string
-which will be the value of `str' whereas the skeleton's interactor is then
-ignored." t nil)
+\(fn SKELETON &optional STR ARG)" nil nil)
(autoload (quote skeleton-insert) "skeleton" "\
Insert the complex statement skeleton SKELETON describes very concisely.
\\n go to next line and indent according to mode
_ interesting point, interregion here
+ - interesting point, no interregion interaction, overrides
+ interesting point set by _
> indent line (or interregion if > _) according to major mode
@ add position to `skeleton-positions'
& do next ELEMENT iff previous moved point
resume: skipped, continue here if quit is signaled
nil skipped
-After termination, point will be positioned at the first occurrence
-of _ or @ or at the end of the inserted text.
+After termination, point will be positioned at the last occurrence of -
+or at the first occurrence of _ or at the end of the inserted text.
Further elements can be defined via `skeleton-further-elements'. ELEMENT may
itself be a SKELETON with an INTERACTOR. The user is prompted repeatedly for
Quoted Lisp expressions are evaluated for their side-effects.
Other Lisp expressions are evaluated and the value treated as above.
-Note that expressions may not return `t' since this implies an
+Note that expressions may not return t since this implies an
endless loop. Modes can define other symbols by locally setting them
to any valid skeleton element. The following local variables are
available:
str first time: read a string according to INTERACTOR
then: insert previously read string once more
- help help-form during interaction with the user or `nil'
+ help help-form during interaction with the user or nil
input initial input (string or cons with index) while reading str
v1, v2 local variables for memorizing anything you want
When done with skeleton, but before going back to `_'-point call
-`skeleton-end-hook' if that is non-`nil'." nil nil)
+`skeleton-end-hook' if that is non-nil.
+
+\(fn SKELETON &optional REGIONS STR)" nil nil)
(autoload (quote skeleton-pair-insert-maybe) "skeleton" "\
Insert the character you type ARG times.
If a match is found in `skeleton-pair-alist', that is inserted, else
the defaults are used. These are (), [], {}, <> and `' for the
-symmetrical ones, and the same character twice for the others." t nil)
+symmetrical ones, and the same character twice for the others.
+
+\(fn ARG)" t nil)
;;;***
\f
-;;;### (autoloads (smerge-mode) "smerge-mode" "smerge-mode.el" (15371
-;;;;;; 46426))
+;;;### (autoloads (smerge-mode smerge-ediff) "smerge-mode" "smerge-mode.el"
+;;;;;; (15941 42957))
;;; Generated autoloads from smerge-mode.el
+(autoload (quote smerge-ediff) "smerge-mode" "\
+Invoke ediff to resolve the conflicts.
+NAME-MINE, NAME-OTHER, and NAME-BASE, if non-nil, are used for the
+buffer names.
+
+\(fn &optional NAME-MINE NAME-OTHER NAME-BASE)" t nil)
+
(autoload (quote smerge-mode) "smerge-mode" "\
Minor mode to simplify editing output from the diff3 program.
-\\{smerge-mode-map}" t nil)
+\\{smerge-mode-map}
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (smiley-region) "smiley-ems" "gnus/smiley-ems.el"
-;;;;;; (15371 46420))
+;;;;;; (15856 53274))
;;; Generated autoloads from gnus/smiley-ems.el
(autoload (quote smiley-region) "smiley-ems" "\
Display textual smileys as images.
START and END specify the region; interactively, use the values
of point and mark. The value of `smiley-regexp-alist' determines
-which smileys to operate on and which images to use for them." t nil)
+which smileys to operate on and which images to use for them.
+
+\(fn START END)" t nil)
;;;***
\f
-;;;### (autoloads (smtpmail-send-it) "smtpmail" "mail/smtpmail.el"
-;;;;;; (15417 7425))
+;;;### (autoloads (smtpmail-send-queued-mail smtpmail-send-it) "smtpmail"
+;;;;;; "mail/smtpmail.el" (16148 4633))
;;; Generated autoloads from mail/smtpmail.el
-(autoload (quote smtpmail-send-it) "smtpmail" nil nil nil)
+(autoload (quote smtpmail-send-it) "smtpmail" "\
+Not documented
+
+\(fn)" nil nil)
+
+(autoload (quote smtpmail-send-queued-mail) "smtpmail" "\
+Send mail that was queued as a result of setting `smtpmail-queue-mail'.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (snake) "snake" "play/snake.el" (15478 24938))
+;;;### (autoloads (snake) "snake" "play/snake.el" (15763 44954))
;;; Generated autoloads from play/snake.el
(autoload (quote snake) "snake" "\
\\[snake-move-left] Makes the snake move left
\\[snake-move-right] Makes the snake move right
\\[snake-move-up] Makes the snake move up
-\\[snake-move-down] Makes the snake move down" t nil)
+\\[snake-move-down] Makes the snake move down
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (snmpv2-mode snmp-mode) "snmp-mode" "net/snmp-mode.el"
-;;;;;; (15371 46424))
+;;;;;; (15491 28594))
;;; Generated autoloads from net/snmp-mode.el
(autoload (quote snmp-mode) "snmp-mode" "\
Delete converts tabs to spaces as it moves back.
\\{snmp-mode-map}
Turning on snmp-mode runs the hooks in `snmp-common-mode-hook', then
-`snmp-mode-hook'." t nil)
+`snmp-mode-hook'.
+
+\(fn)" t nil)
(autoload (quote snmpv2-mode) "snmp-mode" "\
Major mode for editing SNMPv2 MIBs.
Delete converts tabs to spaces as it moves back.
\\{snmp-mode-map}
Turning on snmp-mode runs the hooks in `snmp-common-mode-hook',
-then `snmpv2-mode-hook'." t nil)
+then `snmpv2-mode-hook'.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (solar-equinoxes-solstices sunrise-sunset calendar-location-name
;;;;;; calendar-longitude calendar-latitude calendar-time-display-form)
-;;;;;; "solar" "calendar/solar.el" (15427 61507))
+;;;;;; "solar" "calendar/solar.el" (16174 61085))
;;; Generated autoloads from calendar/solar.el
(defvar calendar-time-display-form (quote (12-hours ":" minutes am-pm (if time-zone " (") time-zone (if time-zone ")"))) "\
*The pseudo-pattern that governs the way a time of day is formatted.
A pseudo-pattern is a list of expressions that can involve the keywords
-`12-hours', `24-hours', and `minutes', all numbers in string form,
-and `am-pm' and `time-zone', both alphabetic strings.
+`12-hours', `24-hours', and `minutes', all numbers in string form,
+and `am-pm' and `time-zone', both alphabetic strings.
For example, the form
would give military-style times like `21:07 (UTC)'.")
+(custom-autoload (quote calendar-time-display-form) "solar")
+
(defvar calendar-latitude nil "\
*Latitude of `calendar-location-name' in degrees.
This variable should be set in `site-start'.el.")
+(custom-autoload (quote calendar-latitude) "solar")
+
(defvar calendar-longitude nil "\
*Longitude of `calendar-location-name' in degrees.
This variable should be set in `site-start'.el.")
+(custom-autoload (quote calendar-longitude) "solar")
+
(defvar calendar-location-name (quote (let ((float-output-format "%.1f")) (format "%s%s, %s%s" (if (numberp calendar-latitude) (abs calendar-latitude) (+ (aref calendar-latitude 0) (/ (aref calendar-latitude 1) 60.0))) (if (numberp calendar-latitude) (if (> calendar-latitude 0) "N" "S") (if (equal (aref calendar-latitude 2) (quote north)) "N" "S")) (if (numberp calendar-longitude) (abs calendar-longitude) (+ (aref calendar-longitude 0) (/ (aref calendar-longitude 1) 60.0))) (if (numberp calendar-longitude) (if (> calendar-longitude 0) "E" "W") (if (equal (aref calendar-longitude 2) (quote east)) "E" "W"))))) "\
*Expression evaluating to name of `calendar-longitude', `calendar-latitude'.
For example, \"New York City\". Default value is just the latitude, longitude
This variable should be set in `site-start'.el.")
+(custom-autoload (quote calendar-location-name) "solar")
+
(autoload (quote sunrise-sunset) "solar" "\
Local time of sunrise and sunset for today. Accurate to a few seconds.
If called with an optional prefix argument, prompt for date.
If called with an optional double prefix argument, prompt for longitude,
latitude, time zone, and date, and always use standard time.
-This function is suitable for execution in a .emacs file." t nil)
+This function is suitable for execution in a .emacs file.
+
+\(fn &optional ARG)" t nil)
(autoload (quote solar-equinoxes-solstices) "solar" "\
*local* date and time of equinoxes and solstices, if visible in the calendar window.
-Requires floating point." nil nil)
+Requires floating point.
+
+\(fn)" nil nil)
;;;***
\f
-;;;### (autoloads (solitaire) "solitaire" "play/solitaire.el" (15371
-;;;;;; 46425))
+;;;### (autoloads (solitaire) "solitaire" "play/solitaire.el" (15941
+;;;;;; 42963))
;;; Generated autoloads from play/solitaire.el
(autoload (quote solitaire) "solitaire" "\
its origin seems to be northern Africa. Here's how to play:
Initially, the board will look similar to this:
- Le Solitaire
- ============
-
- o o o
-
- o o o
-
+ Le Solitaire
+ ============
+
+ o o o
+
+ o o o
+
o o o o o o o
-
+
o o o . o o o
-
+
o o o o o o o
-
- o o o
-
- o o o
+
+ o o o
+
+ o o o
Let's call the o's stones and the .'s holes. One stone fits into one
hole. As you can see, all holes but one are occupied by stones. The
That's all. Here's the board after two moves:
- o o o
-
- . o o
-
+ o o o
+
+ . o o
+
o o . o o o o
-
+
o . o o o o o
-
+
o o o o o o o
-
- o o o
-
+
+ o o o
+
o o o
Pick your favourite shortcuts:
-\\{solitaire-mode-map}" t nil)
+\\{solitaire-mode-map}
+
+\(fn ARG)" t nil)
;;;***
\f
;;;### (autoloads (reverse-region sort-columns sort-regexp-fields
;;;;;; sort-fields sort-numeric-fields sort-pages sort-paragraphs
-;;;;;; sort-lines sort-subr) "sort" "sort.el" (15417 7410))
+;;;;;; sort-lines sort-subr) "sort" "sort.el" (16111 41826))
;;; Generated autoloads from sort.el
(autoload (quote sort-subr) "sort" "\
General text sorting routine to divide buffer into records and sort them.
-Arguments are REVERSE NEXTRECFUN ENDRECFUN &optional STARTKEYFUN ENDKEYFUN.
We divide the accessible portion of the buffer into disjoint pieces
called sort records. A portion of each sort record (perhaps all of
ENDKEYFUN moves from the start of the sort key to the end of the sort key.
ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the
-same as ENDRECFUN." nil nil)
+same as ENDRECFUN.
+
+PREDICATE is the function to use to compare keys. If keys are numbers,
+it defaults to `<', otherwise it defaults to `string<'.
+
+\(fn REVERSE NEXTRECFUN ENDRECFUN &optional STARTKEYFUN ENDKEYFUN PREDICATE)" nil nil)
(autoload (quote sort-lines) "sort" "\
Sort lines in region alphabetically; argument means descending order.
Called from a program, there are three arguments:
REVERSE (non-nil means reverse order), BEG and END (region to sort).
The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order." t nil)
+the sort order.
+
+\(fn REVERSE BEG END)" t nil)
(autoload (quote sort-paragraphs) "sort" "\
Sort paragraphs in region alphabetically; argument means descending order.
Called from a program, there are three arguments:
REVERSE (non-nil means reverse order), BEG and END (region to sort).
The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order." t nil)
+the sort order.
+
+\(fn REVERSE BEG END)" t nil)
(autoload (quote sort-pages) "sort" "\
Sort pages in region alphabetically; argument means descending order.
Called from a program, there are three arguments:
REVERSE (non-nil means reverse order), BEG and END (region to sort).
The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order." t nil)
+the sort order.
+
+\(fn REVERSE BEG END)" t nil)
(autoload (quote sort-numeric-fields) "sort" "\
Sort lines in region numerically by the ARGth field of each line.
Otherwise, the number is interpreted according to sort-numeric-base.
With a negative arg, sorts by the ARGth field counted from the right.
Called from a program, there are three arguments:
-FIELD, BEG and END. BEG and END specify region to sort." t nil)
+FIELD, BEG and END. BEG and END specify region to sort.
+
+\(fn FIELD BEG END)" t nil)
(autoload (quote sort-fields) "sort" "\
Sort lines in region lexicographically by the ARGth field of each line.
Called from a program, there are three arguments:
FIELD, BEG and END. BEG and END specify region to sort.
The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order." t nil)
+the sort order.
+
+\(fn FIELD BEG END)" t nil)
(autoload (quote sort-regexp-fields) "sort" "\
Sort the region lexicographically as specified by RECORD-REGEXP and KEY.
For example: to sort lines in the region by the first word on each line
starting with the letter \"f\",
- RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\\\=\\<f\\\\w*\\\\>\"" t nil)
+ RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\\\=\\<f\\\\w*\\\\>\"
+
+\(fn REVERSE RECORD-REGEXP KEY-REGEXP BEG END)" t nil)
(autoload (quote sort-columns) "sort" "\
Sort lines in region alphabetically by a certain range of columns.
because tabs could be split across the specified columns
and it doesn't know how to handle that. Also, when possible,
it uses the `sort' utility program, which doesn't understand tabs.
-Use \\[untabify] to convert tabs to spaces before sorting." t nil)
+Use \\[untabify] to convert tabs to spaces before sorting.
+
+\(fn REVERSE &optional BEG END)" t nil)
(autoload (quote reverse-region) "sort" "\
Reverse the order of lines in a region.
-From a program takes two point or marker arguments, BEG and END." t nil)
+From a program takes two point or marker arguments, BEG and END.
+
+\(fn BEG END)" t nil)
;;;***
\f
;;;### (autoloads (speedbar-get-focus speedbar-frame-mode) "speedbar"
-;;;;;; "speedbar.el" (15417 7410))
+;;;;;; "speedbar.el" (15941 42957))
;;; Generated autoloads from speedbar.el
(defalias (quote speedbar) (quote speedbar-frame-mode))
`speedbar-mode' will be displayed. Currently, only one speedbar is
supported at a time.
`speedbar-before-popup-hook' is called before popping up the speedbar frame.
-`speedbar-before-delete-hook' is called before the frame is deleted." t nil)
+`speedbar-before-delete-hook' is called before the frame is deleted.
+
+\(fn &optional ARG)" t nil)
(autoload (quote speedbar-get-focus) "speedbar" "\
Change frame focus to or from the speedbar frame.
If the selected frame is not speedbar, then speedbar frame is
-selected. If the speedbar frame is active, then select the attached frame." t nil)
+selected. If the speedbar frame is active, then select the attached frame.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (spell-string spell-region spell-word spell-buffer)
-;;;;;; "spell" "textmodes/spell.el" (15371 46417))
+;;;;;; "spell" "textmodes/spell.el" (15186 43697))
;;; Generated autoloads from textmodes/spell.el
(put (quote spell-filter) (quote risky-local-variable) t)
For each incorrect word, you are asked for the correct spelling
and then put into a query-replace to fix some or all occurrences.
If you do not want to change a word, just give the same word
-as its \"correct\" spelling; then the query replace is skipped." t nil)
+as its \"correct\" spelling; then the query replace is skipped.
+
+\(fn)" t nil)
(autoload (quote spell-word) "spell" "\
Check spelling of word at or before point.
If it is not correct, ask user for the correct spelling
-and `query-replace' the entire buffer to substitute it." t nil)
+and `query-replace' the entire buffer to substitute it.
+
+\(fn)" t nil)
(autoload (quote spell-region) "spell" "\
Like `spell-buffer' but applies only to region.
Used in a program, applies from START to END.
DESCRIPTION is an optional string naming the unit being checked:
-for example, \"word\"." t nil)
+for example, \"word\".
+
+\(fn START END &optional DESCRIPTION)" t nil)
(autoload (quote spell-string) "spell" "\
-Check spelling of string supplied as argument." t nil)
+Check spelling of string supplied as argument.
+
+\(fn STRING)" t nil)
;;;***
\f
-;;;### (autoloads (snarf-spooks spook) "spook" "play/spook.el" (15371
-;;;;;; 46425))
+;;;### (autoloads (snarf-spooks spook) "spook" "play/spook.el" (14817
+;;;;;; 31868))
;;; Generated autoloads from play/spook.el
(autoload (quote spook) "spook" "\
-Adds that special touch of class to your outgoing mail." t nil)
+Adds that special touch of class to your outgoing mail.
+
+\(fn)" t nil)
(autoload (quote snarf-spooks) "spook" "\
-Return a vector containing the lines from `spook-phrases-file'." nil nil)
+Return a vector containing the lines from `spook-phrases-file'.
+
+\(fn)" nil nil)
;;;***
\f
-;;;### (autoloads (sql-db2 sql-interbase sql-postgres sql-ms sql-ingres
-;;;;;; sql-solid sql-mysql sql-informix sql-sybase sql-oracle sql-mode
-;;;;;; sql-help) "sql" "progmodes/sql.el" (15441 20097))
+;;;### (autoloads (sql-linter sql-db2 sql-interbase sql-postgres
+;;;;;; sql-ms sql-ingres sql-solid sql-mysql sql-sqlite sql-informix
+;;;;;; sql-sybase sql-oracle sql-mode sql-help) "sql" "progmodes/sql.el"
+;;;;;; (16148 4633))
;;; Generated autoloads from progmodes/sql.el
(autoload (quote sql-help) "sql" "\
PostGres: \\[sql-postgres]
MySQL: \\[sql-mysql]
+ SQLite: \\[sql-sqlite]
Other non-free SQL implementations are also supported:
Ingres: \\[sql-ingres]
Microsoft: \\[sql-ms]
Interbase: \\[sql-interbase]
+ Linter: \\[sql-linter]
But we urge you to choose a free implementation instead of these.
In this SQL buffer (SQL mode), you can send the region or the entire
buffer to the interactive SQL buffer (SQLi mode). The results are
-appended to the SQLi buffer without disturbing your SQL buffer." t nil)
+appended to the SQLi buffer without disturbing your SQL buffer.
+
+\(fn)" t nil)
(autoload (quote sql-mode) "sql" "\
Major mode to edit SQL.
\(add-hook 'sql-mode-hook
(lambda ()
- (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))" t nil)
+ (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))
+
+\(fn)" t nil)
(autoload (quote sql-oracle) "sql" "\
Run sqlplus by Oracle as an inferior process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
+\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+
+\(fn)" t nil)
(autoload (quote sql-sybase) "sql" "\
Run isql by SyBase as an inferior process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
+\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+
+\(fn)" t nil)
(autoload (quote sql-informix) "sql" "\
Run dbaccess by Informix as an inferior process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
+\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+
+\(fn)" t nil)
+
+(autoload (quote sql-sqlite) "sql" "\
+Run sqlite as an inferior process.
+
+SQLite is free software.
+
+If buffer `*SQL*' exists but no process is running, make a new process.
+If buffer exists and a process is running, just switch to buffer
+`*SQL*'.
+
+Interpreter used comes from variable `sql-sqlite-program'. Login uses
+the variables `sql-user', `sql-password', `sql-database', and
+`sql-server' as defaults, if set. Additional command line parameters
+can be stored in the list `sql-sqlite-options'.
+
+The buffer is put in sql-interactive-mode, giving commands for sending
+input. See `sql-interactive-mode'.
+
+To specify a coding system for converting non-ASCII characters
+in the input and output to the process, use \\[universal-coding-system-argument]
+before \\[sql-sqlite]. You can also specify this with \\[set-buffer-process-coding-system]
+in the SQL buffer, after you start the process.
+The default comes from `process-coding-system-alist' and
+`default-process-coding-system'.
+
+\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+
+\(fn)" t nil)
(autoload (quote sql-mysql) "sql" "\
Run mysql by TcX as an inferior process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
+\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+
+\(fn)" t nil)
(autoload (quote sql-solid) "sql" "\
Run solsql by Solid as an inferior process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
+\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+
+\(fn)" t nil)
(autoload (quote sql-ingres) "sql" "\
Run sql by Ingres as an inferior process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
+\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+
+\(fn)" t nil)
(autoload (quote sql-ms) "sql" "\
Run isql by Microsoft as an inferior process.
Interpreter used comes from variable `sql-ms-program'. Login uses the
variables `sql-user', `sql-password', `sql-database', and `sql-server'
-as defaults, if set.
+as defaults, if set. Additional command line parameters can be stored
+in the list `sql-ms-options'.
The buffer is put in sql-interactive-mode, giving commands for sending
input. See `sql-interactive-mode'.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
+\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+
+\(fn)" t nil)
(autoload (quote sql-postgres) "sql" "\
Run psql by Postgres as an inferior process.
\(setq comint-output-filter-functions (append comint-output-filter-functions
'(comint-strip-ctrl-m)))
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
+\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+
+\(fn)" t nil)
(autoload (quote sql-interbase) "sql" "\
Run isql by Interbase as an inferior process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
+\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+
+\(fn)" t nil)
(autoload (quote sql-db2) "sql" "\
Run db2 by IBM as an inferior process.
The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
+\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+
+\(fn)" t nil)
+
+(autoload (quote sql-linter) "sql" "\
+Run inl by RELEX as an inferior process.
+
+If buffer `*SQL*' exists but no process is running, make a new process.
+If buffer exists and a process is running, just switch to buffer
+`*SQL*'.
+
+Interpreter used comes from variable `sql-linter-program' - usually `inl'.
+Login uses the variables `sql-user', `sql-password', `sql-database' and
+`sql-server' as defaults, if set. Additional command line parameters
+can be stored in the list `sql-linter-options'. Run inl -h to get help on
+parameters.
+
+`sql-database' is used to set the LINTER_MBX environment variable for
+local connections, `sql-server' refers to the server name from the
+`nodetab' file for the network connection (dbc_tcp or friends must run
+for this to work). If `sql-password' is an empty string, inl will use
+an empty password.
+
+The buffer is put in sql-interactive-mode, giving commands for sending
+input. See `sql-interactive-mode'.
+
+To use LINTER font locking by default, put this line into your .emacs :
+ (setq sql-mode-font-lock-keywords sql-mode-linter-font-lock-keywords)
+
+\(Type \\[describe-mode] in the SQL buffer for a list of commands.)
+
+\(fn)" t nil)
;;;***
\f
;;;;;; strokes-mode strokes-list-strokes strokes-load-user-strokes
;;;;;; strokes-help strokes-describe-stroke strokes-do-complex-stroke
;;;;;; strokes-do-stroke strokes-read-complex-stroke strokes-read-stroke
-;;;;;; strokes-global-set-stroke strokes-mode) "strokes" "strokes.el"
-;;;;;; (15465 22816))
+;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (15961
+;;;;;; 24151))
;;; Generated autoloads from strokes.el
-(defvar strokes-mode nil "\
-Non-nil when `strokes' is globally enabled.
-Setting this variable directly does not take effect. Use either Customize
-or M-x strokes-mode.")
-
-(custom-add-to-group (quote strokes) (quote strokes-mode) (quote custom-variable))
-
-(custom-add-load (quote strokes-mode) (quote strokes))
-
(autoload (quote strokes-global-set-stroke) "strokes" "\
Interactively give STROKE the global binding as COMMAND.
Operated just like `global-set-key', except for strokes.
COMMAND is a symbol naming an interactively-callable function. STROKE
is a list of sampled positions on the stroke grid as described in the
-documentation for the `strokes-define-stroke' function." t nil)
+documentation for the `strokes-define-stroke' function.
-(defalias (quote global-set-stroke) (quote strokes-global-set-stroke))
+\(fn STROKE COMMAND)" t nil)
(autoload (quote strokes-read-stroke) "strokes" "\
Read a simple stroke (interactively) and return the stroke.
This function will display the stroke interactively as it is being
entered in the strokes buffer if the variable
`strokes-use-strokes-buffer' is non-nil.
-Optional EVENT is acceptable as the starting event of the stroke" nil nil)
+Optional EVENT is acceptable as the starting event of the stroke
+
+\(fn &optional PROMPT EVENT)" nil nil)
(autoload (quote strokes-read-complex-stroke) "strokes" "\
Read a complex stroke (interactively) and return the stroke.
Optional PROMPT in minibuffer displays before and during stroke reading.
Note that a complex stroke allows the user to pen-up and pen-down. This
-is implemented by allowing the user to paint with button1 or button2 and
-then complete the stroke with button3.
-Optional EVENT is acceptable as the starting event of the stroke" nil nil)
+is implemented by allowing the user to paint with button 1 or button 2 and
+then complete the stroke with button 3.
+Optional EVENT is acceptable as the starting event of the stroke
+
+\(fn &optional PROMPT EVENT)" nil nil)
(autoload (quote strokes-do-stroke) "strokes" "\
Read a simple stroke from the user and then execute its command.
-This must be bound to a mouse event." t nil)
+This must be bound to a mouse event.
+
+\(fn EVENT)" t nil)
(autoload (quote strokes-do-complex-stroke) "strokes" "\
Read a complex stroke from the user and then execute its command.
-This must be bound to a mouse event." t nil)
+This must be bound to a mouse event.
+
+\(fn EVENT)" t nil)
(autoload (quote strokes-describe-stroke) "strokes" "\
-Displays the command which STROKE maps to, reading STROKE interactively." t nil)
+Displays the command which STROKE maps to, reading STROKE interactively.
-(defalias (quote describe-stroke) (quote strokes-describe-stroke))
+\(fn STROKE)" t nil)
(autoload (quote strokes-help) "strokes" "\
-Get instructional help on using the `strokes' package." t nil)
+Get instruction on using the `strokes' package.
+
+\(fn)" t nil)
(autoload (quote strokes-load-user-strokes) "strokes" "\
-Load user-defined strokes from file named by `strokes-file'." t nil)
+Load user-defined strokes from file named by `strokes-file'.
-(defalias (quote load-user-strokes) (quote strokes-load-user-strokes))
+\(fn)" t nil)
(autoload (quote strokes-list-strokes) "strokes" "\
Pop up a buffer containing an alphabetical listing of strokes in STROKES-MAP.
With CHRONOLOGICAL prefix arg (\\[universal-argument]) list strokes
chronologically by command name.
-If STROKES-MAP is not given, `strokes-global-map' will be used instead." t nil)
+If STROKES-MAP is not given, `strokes-global-map' will be used instead.
-(autoload (quote strokes-mode) "strokes" "\
-Toggle strokes being enabled.
-With ARG, turn strokes on if and only if ARG is positive or true.
-Note that `strokes-mode' is a global mode. Think of it as a minor
-mode in all buffers when activated.
-By default, strokes are invoked with mouse button-2. You can define
-new strokes with
+\(fn &optional CHRONOLOGICAL STROKES-MAP)" t nil)
+
+(defvar strokes-mode nil "\
+Non-nil if Strokes mode is enabled.
+See the command `strokes-mode' for a description of this minor-mode.
+Setting this variable directly does not take effect;
+use either \\[customize] or the function `strokes-mode'.")
-> M-x global-set-stroke
+(custom-autoload (quote strokes-mode) "strokes")
+
+(autoload (quote strokes-mode) "strokes" "\
+Toggle Strokes global minor mode.\\<strokes-mode-map>
+With ARG, turn strokes on if and only if ARG is positive.
+Strokes are pictographic mouse gestures which invoke commands.
+Strokes are invoked with \\[strokes-do-stroke]. You can define
+new strokes with \\[strokes-global-set-stroke]. See also
+\\[strokes-do-complex-stroke] for `complex' strokes.
To use strokes for pictographic editing, such as Chinese/Japanese, use
-S-mouse-2, which draws strokes and inserts them. Encode/decode your
-strokes with
+\\[strokes-compose-complex-stroke], which draws strokes and inserts them.
+Encode/decode your strokes with \\[strokes-encode-buffer],
+\\[strokes-decode-buffer].
-> M-x strokes-encode-buffer
-> M-x strokes-decode-buffer" t nil)
+\\{strokes-mode-map}
+
+\(fn &optional ARG)" t nil)
(autoload (quote strokes-decode-buffer) "strokes" "\
Decode stroke strings in BUFFER and display their corresponding glyphs.
Optional BUFFER defaults to the current buffer.
-Optional FORCE non-nil will ignore the buffer's read-only status." t nil)
+Optional FORCE non-nil will ignore the buffer's read-only status.
+
+\(fn &optional BUFFER FORCE)" t nil)
(autoload (quote strokes-compose-complex-stroke) "strokes" "\
-Read a complex stroke and insert its glyph into the current buffer." t nil)
+Read a complex stroke and insert its glyph into the current buffer.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (studlify-buffer studlify-word studlify-region)
-;;;;;; "studly" "play/studly.el" (15391 60712))
+;;;;;; "studly" "play/studly.el" (15366 772))
;;; Generated autoloads from play/studly.el
(autoload (quote studlify-region) "studly" "\
-Studlify-case the region." t nil)
+Studlify-case the region.
+
+\(fn BEGIN END)" t nil)
(autoload (quote studlify-word) "studly" "\
-Studlify-case the current word, or COUNT words if given an argument." t nil)
+Studlify-case the current word, or COUNT words if given an argument.
+
+\(fn COUNT)" t nil)
(autoload (quote studlify-buffer) "studly" "\
-Studlify-case the current buffer." t nil)
+Studlify-case the current buffer.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (sc-cite-original) "supercite" "mail/supercite.el"
-;;;;;; (15400 1478))
+;;;;;; (16111 41831))
;;; Generated autoloads from mail/supercite.el
(autoload (quote sc-cite-original) "supercite" "\
Workhorse citing function which performs the initial citation.
This is callable from the various mail and news readers' reply
-function according to the agreed upon standard. See `\\[sc-describe]'
-for more details. `sc-cite-original' does not do any yanking of the
+function according to the agreed upon standard. See the associated
+info node `(SC)Top' for more details.
+`sc-cite-original' does not do any yanking of the
original message but it does require a few things:
1) The reply buffer is the current buffer.
For Emacs 19's, the region need not be active (and typically isn't
when this function is called. Also, the hook `sc-pre-hook' is run
-before, and `sc-post-hook' is run after the guts of this function." nil nil)
+before, and `sc-post-hook' is run after the guts of this function.
+
+\(fn)" nil nil)
;;;***
\f
-;;;### (autoloads (syntax-ppss) "syntax" "emacs-lisp/syntax.el" (15391
-;;;;;; 60528))
+;;;### (autoloads (syntax-ppss) "syntax" "emacs-lisp/syntax.el" (16162
+;;;;;; 11942))
;;; Generated autoloads from emacs-lisp/syntax.el
(autoload (quote syntax-ppss) "syntax" "\
Parse-Partial-Sexp State at POS.
The returned value is the same as `parse-partial-sexp' except that
the 2nd and 6th values of the returned state cannot be relied upon.
+Point is at POS when this function returns.
-If the caller knows the PPSS of a nearby position, she can pass it
-in OLP-PPSS (with or without its corresponding OLD-POS) to try and
-avoid a more expansive scan.
-Point is at POS when this function returns." nil nil)
+\(fn &optional POS)" nil nil)
;;;***
\f
-;;;### (autoloads (tabify untabify) "tabify" "tabify.el" (15371 46416))
+;;;### (autoloads (tabify untabify) "tabify" "tabify.el" (13227 8639))
;;; Generated autoloads from tabify.el
(autoload (quote untabify) "tabify" "\
Convert all tabs in region to multiple spaces, preserving columns.
Called non-interactively, the region is specified by arguments
START and END, rather than by the position of point and mark.
-The variable `tab-width' controls the spacing of tab stops." t nil)
+The variable `tab-width' controls the spacing of tab stops.
+
+\(fn START END)" t nil)
(autoload (quote tabify) "tabify" "\
Convert multiple spaces in region to tabs when possible.
when this can be done without changing the column they end at.
Called non-interactively, the region is specified by arguments
START and END, rather than by the position of point and mark.
-The variable `tab-width' controls the spacing of tab stops." t nil)
+The variable `tab-width' controls the spacing of tab stops.
+
+\(fn START END)" t nil)
;;;***
\f
-;;;### (autoloads (talk-connect) "talk" "talk.el" (15371 46416))
+;;;### (autoloads (table-release table-capture table-delete-column
+;;;;;; table-delete-row table-insert-sequence table-generate-source
+;;;;;; table-query-dimension table-fixed-width-mode table-justify-column
+;;;;;; table-justify-row table-justify-cell table-justify table-split-cell
+;;;;;; table-split-cell-horizontally table-split-cell-vertically
+;;;;;; table-span-cell table-backward-cell table-forward-cell table-narrow-cell
+;;;;;; table-widen-cell table-shorten-cell table-heighten-cell table-unrecognize-cell
+;;;;;; table-recognize-cell table-unrecognize-table table-recognize-table
+;;;;;; table-unrecognize-region table-recognize-region table-unrecognize
+;;;;;; table-recognize table-insert-row-column table-insert-column
+;;;;;; table-insert-row table-insert table-point-left-cell-hook
+;;;;;; table-point-entered-cell-hook table-load-hook table-cell-map-hook)
+;;;;;; "table" "textmodes/table.el" (16111 41838))
+;;; Generated autoloads from textmodes/table.el
+
+(defvar table-cell-map-hook nil "\
+*Normal hooks run when finishing construction of `table-cell-map'.
+User can modify `table-cell-map' by adding custom functions here.")
+
+(custom-autoload (quote table-cell-map-hook) "table")
+
+(defvar table-load-hook nil "\
+*List of functions to be called after the table is first loaded.")
+
+(custom-autoload (quote table-load-hook) "table")
+
+(defvar table-point-entered-cell-hook nil "\
+*List of functions to be called after point entered a table cell.")
+
+(custom-autoload (quote table-point-entered-cell-hook) "table")
+
+(defvar table-point-left-cell-hook nil "\
+*List of functions to be called after point left a table cell.")
+
+(custom-autoload (quote table-point-left-cell-hook) "table")
+
+(autoload (quote table-insert) "table" "\
+Insert an editable text table.
+Insert a table of specified number of COLUMNS and ROWS. Optional
+parameter CELL-WIDTH and CELL-HEIGHT can specify the size of each
+cell. The cell size is uniform across the table if the specified size
+is a number. They can be a list of numbers to specify different size
+for each cell. When called interactively, the list of number is
+entered by simply listing all the numbers with space characters
+delimiting them.
+
+Examples:
+
+\\[table-insert] inserts a table at the current point location.
+
+Suppose we have the following situation where `-!-' indicates the
+location of point.
+
+ -!-
+
+Type \\[table-insert] and hit ENTER key. As it asks table
+specification, provide 3 for number of columns, 1 for number of rows,
+5 for cell width and 1 for cell height. Now you shall see the next
+table and the point is automatically moved to the beginning of the
+first cell.
+
+ +-----+-----+-----+
+ |-!- | | |
+ +-----+-----+-----+
+
+Inside a table cell, there are special key bindings. \\<table-cell-map>
+
+M-9 \\[table-widen-cell] (or \\[universal-argument] 9 \\[table-widen-cell]) widens the first cell by 9 character
+width, which results as
+
+ +--------------+-----+-----+
+ |-!- | | |
+ +--------------+-----+-----+
+
+Type TAB \\[table-widen-cell] then type TAB M-2 M-7 \\[table-widen-cell] (or \\[universal-argument] 2 7 \\[table-widen-cell]). Typing
+TAB moves the point forward by a cell. The result now looks like this:
+
+ +--------------+------+--------------------------------+
+ | | |-!- |
+ +--------------+------+--------------------------------+
+
+If you knew each width of the columns prior to the table creation,
+what you could have done better was to have had given the complete
+width information to `table-insert'.
+
+Cell width(s): 14 6 32
+
+instead of
+
+Cell width(s): 5
+
+This would have eliminated the previously mentioned width adjustment
+work all together.
+
+If the point is in the last cell type S-TAB S-TAB to move it to the
+first cell. Now type \\[table-heighten-cell] which heighten the row by a line.
+
+ +--------------+------+--------------------------------+
+ |-!- | | |
+ | | | |
+ +--------------+------+--------------------------------+
+
+Type \\[table-insert-row-column] and tell it to insert a row.
+
+ +--------------+------+--------------------------------+
+ |-!- | | |
+ | | | |
+ +--------------+------+--------------------------------+
+ | | | |
+ | | | |
+ +--------------+------+--------------------------------+
+
+Move the point under the table as shown below.
+
+ +--------------+------+--------------------------------+
+ | | | |
+ | | | |
+ +--------------+------+--------------------------------+
+ | | | |
+ | | | |
+ +--------------+------+--------------------------------+
+ -!-
+
+Type M-x table-insert-row instead of \\[table-insert-row-column]. \\[table-insert-row-column] does not work
+when the point is outside of the table. This insertion at
+outside of the table effectively appends a row at the end.
+
+ +--------------+------+--------------------------------+
+ | | | |
+ | | | |
+ +--------------+------+--------------------------------+
+ | | | |
+ | | | |
+ +--------------+------+--------------------------------+
+ |-!- | | |
+ | | | |
+ +--------------+------+--------------------------------+
+
+Text editing inside the table cell produces reasonably expected
+results.
+
+ +--------------+------+--------------------------------+
+ | | | |
+ | | | |
+ +--------------+------+--------------------------------+
+ | | |Text editing inside the table |
+ | | |cell produces reasonably |
+ | | |expected results.-!- |
+ +--------------+------+--------------------------------+
+ | | | |
+ | | | |
+ +--------------+------+--------------------------------+
+
+Inside a table cell has a special keymap.
+
+\\{table-cell-map}
+
+\(fn COLUMNS ROWS &optional CELL-WIDTH CELL-HEIGHT)" t nil)
+
+(autoload (quote table-insert-row) "table" "\
+Insert N table row(s).
+When point is in a table the newly inserted row(s) are placed above
+the current row. When point is outside of the table it must be below
+the table within the table width range, then the newly created row(s)
+are appended at the bottom of the table.
+
+\(fn N)" t nil)
+
+(autoload (quote table-insert-column) "table" "\
+Insert N table column(s).
+When point is in a table the newly inserted column(s) are placed left
+of the current column. When point is outside of the table it must be
+right side of the table within the table height range, then the newly
+created column(s) are appended at the right of the table.
+
+\(fn N)" t nil)
+
+(autoload (quote table-insert-row-column) "table" "\
+Insert row(s) or column(s).
+See `table-insert-row' and `table-insert-column'.
+
+\(fn ROW-COLUMN N)" t nil)
+
+(autoload (quote table-recognize) "table" "\
+Recognize all tables within the current buffer and activate them.
+Scans the entire buffer and recognizes valid table cells. If the
+optional numeric prefix argument ARG is negative the tables in the
+buffer become inactive, meaning the tables become plain text and loses
+all the table specific features.
+
+\(fn &optional ARG)" t nil)
+
+(autoload (quote table-unrecognize) "table" "\
+Not documented
+
+\(fn)" t nil)
+
+(autoload (quote table-recognize-region) "table" "\
+Recognize all tables within region.
+BEG and END specify the region to work on. If the optional numeric
+prefix argument ARG is negative the tables in the region become
+inactive, meaning the tables become plain text and lose all the table
+specific features.
+
+\(fn BEG END &optional ARG)" t nil)
+
+(autoload (quote table-unrecognize-region) "table" "\
+Not documented
+
+\(fn BEG END)" t nil)
+
+(autoload (quote table-recognize-table) "table" "\
+Recognize a table at point.
+If the optional numeric prefix argument ARG is negative the table
+becomes inactive, meaning the table becomes plain text and loses all
+the table specific features.
+
+\(fn &optional ARG)" t nil)
+
+(autoload (quote table-unrecognize-table) "table" "\
+Not documented
+
+\(fn)" t nil)
+
+(autoload (quote table-recognize-cell) "table" "\
+Recognize a table cell that contains current point.
+Probe the cell dimension and prepare the cell information. The
+optional two arguments FORCE and NO-COPY are for internal use only and
+must not be specified. When the optional numeric prefix argument ARG
+is negative the cell becomes inactive, meaning that the cell becomes
+plain text and loses all the table specific features.
+
+\(fn &optional FORCE NO-COPY ARG)" t nil)
+
+(autoload (quote table-unrecognize-cell) "table" "\
+Not documented
+
+\(fn)" t nil)
+
+(autoload (quote table-heighten-cell) "table" "\
+Heighten the current cell by N lines by expanding the cell vertically.
+Heightening is done by adding blank lines at the bottom of the current
+cell. Other cells aligned horizontally with the current one are also
+heightened in order to keep the rectangular table structure. The
+optional argument NO-COPY is internal use only and must not be
+specified.
+
+\(fn N &optional NO-COPY NO-UPDATE)" t nil)
+
+(autoload (quote table-shorten-cell) "table" "\
+Shorten the current cell by N lines by shrinking the cell vertically.
+Shortening is done by removing blank lines from the bottom of the cell
+and possibly from the top of the cell as well. Therefor, the cell
+must have some bottom/top blank lines to be shorten effectively. This
+is applicable to all the cells aligned horizontally with the current
+one because they are also shortened in order to keep the rectangular
+table structure.
+
+\(fn N)" t nil)
+
+(autoload (quote table-widen-cell) "table" "\
+Widen the current cell by N columns and expand the cell horizontally.
+Some other cells in the same table are widen as well to keep the
+table's rectangle structure.
+
+\(fn N &optional NO-COPY NO-UPDATE)" t nil)
+
+(autoload (quote table-narrow-cell) "table" "\
+Narrow the current cell by N columns and shrink the cell horizontally.
+Some other cells in the same table are narrowed as well to keep the
+table's rectangle structure.
+
+\(fn N)" t nil)
+
+(autoload (quote table-forward-cell) "table" "\
+Move point forward to the beginning of the next cell.
+With argument ARG, do it ARG times;
+a negative argument ARG = -N means move backward N cells.
+Do not specify NO-RECOGNIZE and UNRECOGNIZE. They are for internal use only.
+
+Sample Cell Traveling Order (In Irregular Table Cases)
+
+You can actually try how it works in this buffer. Press
+\\[table-recognize] and go to cells in the following tables and press
+\\[table-forward-cell] or TAB key.
+
++-----+--+ +--+-----+ +--+--+--+ +--+--+--+ +---------+ +--+---+--+
+|0 |1 | |0 |1 | |0 |1 |2 | |0 |1 |2 | |0 | |0 |1 |2 |
++--+--+ | | +--+--+ +--+ | | | | +--+ +----+----+ +--+-+-+--+
+|2 |3 | | | |2 |3 | |3 +--+ | | +--+3 | |1 |2 | |3 |4 |
+| +--+--+ +--+--+ | +--+4 | | | |4 +--+ +--+-+-+--+ +----+----+
+| |4 | |4 | | |5 | | | | | |5 | |3 |4 |5 | |5 |
++--+-----+ +-----+--+ +--+--+--+ +--+--+--+ +--+---+--+ +---------+
+
++--+--+--+ +--+--+--+ +--+--+--+ +--+--+--+
+|0 |1 |2 | |0 |1 |2 | |0 |1 |2 | |0 |1 |2 |
+| | | | | +--+ | | | | | +--+ +--+
++--+ +--+ +--+3 +--+ | +--+ | |3 +--+4 |
+|3 | |4 | |4 +--+5 | | |3 | | +--+5 +--+
+| | | | | |6 | | | | | | |6 | |7 |
++--+--+--+ +--+--+--+ +--+--+--+ +--+--+--+
+
++--+--+--+ +--+--+--+ +--+--+--+--+ +--+-----+--+ +--+--+--+--+
+|0 |1 |2 | |0 |1 |2 | |0 |1 |2 |3 | |0 |1 |2 | |0 |1 |2 |3 |
+| +--+ | | +--+ | | +--+--+ | | | | | | +--+--+ |
+| |3 +--+ +--+3 | | +--+4 +--+ +--+ +--+ +--+4 +--+
++--+ |4 | |4 | +--+ |5 +--+--+6 | |3 +--+--+4 | |5 | |6 |
+|5 +--+ | | +--+5 | | |7 |8 | | | |5 |6 | | | | | |
+| |6 | | | |6 | | +--+--+--+--+ +--+--+--+--+ +--+-----+--+
++--+--+--+ +--+--+--+
+
+\(fn &optional ARG NO-RECOGNIZE UNRECOGNIZE)" t nil)
+
+(autoload (quote table-backward-cell) "table" "\
+Move backward to the beginning of the previous cell.
+With argument ARG, do it ARG times;
+a negative argument ARG = -N means move forward N cells.
+
+\(fn &optional ARG)" t nil)
+
+(autoload (quote table-span-cell) "table" "\
+Span current cell into adjacent cell in DIRECTION.
+DIRECTION is one of symbols; right, left, above or below.
+
+\(fn DIRECTION)" t nil)
+
+(autoload (quote table-split-cell-vertically) "table" "\
+Split current cell vertically.
+Creates a cell above and a cell below the current point location.
+
+\(fn)" t nil)
+
+(autoload (quote table-split-cell-horizontally) "table" "\
+Split current cell horizontally.
+Creates a cell on the left and a cell on the right of the current point location.
+
+\(fn)" t nil)
+
+(autoload (quote table-split-cell) "table" "\
+Split current cell in ORIENTATION.
+ORIENTATION is a symbol either horizontally or vertically.
+
+\(fn ORIENTATION)" t nil)
+
+(autoload (quote table-justify) "table" "\
+Justify contents of a cell, a row of cells or a column of cells.
+WHAT is a symbol 'cell, 'row or 'column. JUSTIFY is a symbol 'left,
+'center, 'right, 'top, 'middle, 'bottom or 'none.
+
+\(fn WHAT JUSTIFY)" t nil)
+
+(autoload (quote table-justify-cell) "table" "\
+Justify cell contents.
+JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or 'top,
+'middle, 'bottom or 'none for vertical. When optional PARAGRAPH is
+non-nil the justify operation is limited to the current paragraph,
+otherwise the entire cell contents is justified.
+
+\(fn JUSTIFY &optional PARAGRAPH)" t nil)
+
+(autoload (quote table-justify-row) "table" "\
+Justify cells of a row.
+JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or top,
+'middle, 'bottom or 'none for vertical.
+
+\(fn JUSTIFY)" t nil)
+
+(autoload (quote table-justify-column) "table" "\
+Justify cells of a column.
+JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or top,
+'middle, 'bottom or 'none for vertical.
+
+\(fn JUSTIFY)" t nil)
+
+(autoload (quote table-fixed-width-mode) "table" "\
+Toggle fixing width mode.
+In the fixed width mode, typing inside a cell never changes the cell
+width where in the normal mode the cell width expands automatically in
+order to prevent a word being folded into multiple lines.
+
+\(fn &optional ARG)" t nil)
+
+(autoload (quote table-query-dimension) "table" "\
+Return the dimension of the current cell and the current table.
+The result is a list (cw ch tw th c r cells) where cw is the cell
+width, ch is the cell height, tw is the table width, th is the table
+height, c is the number of columns, r is the number of rows and cells
+is the total number of cells. The cell dimension excludes the cell
+frame while the table dimension includes the table frame. The columns
+and the rows are counted by the number of cell boundaries. Therefore
+the number tends to be larger than it appears for the tables with
+non-uniform cell structure (heavily spanned and split). When optional
+WHERE is provided the cell and table at that location is reported.
+
+\(fn &optional WHERE)" t nil)
+
+(autoload (quote table-generate-source) "table" "\
+Generate source of the current table in the specified language.
+LANGUAGE is a symbol that specifies the language to describe the
+structure of the table. It must be either 'html, 'latex or 'cals.
+The resulted source text is inserted into DEST-BUFFER and the buffer
+object is returned. When DEST-BUFFER is omitted or nil the default
+buffer specified in `table-dest-buffer-name' is used. In this case
+the content of the default buffer is erased prior to the generation.
+When DEST-BUFFER is non-nil it is expected to be either a destination
+buffer or a name of the destination buffer. In this case the
+generated result is inserted at the current point in the destination
+buffer and the previously existing contents in the buffer are
+untouched.
+
+References used for this implementation:
+
+HTML:
+ http://www.w3.org
+
+LaTeX:
+ http://www.maths.tcd.ie/~dwilkins/LaTeXPrimer/Tables.html
+
+CALS (DocBook DTD):
+ http://www.oasis-open.org/html/a502.htm
+ http://www.oreilly.com/catalog/docbook/chapter/book/table.html#AEN114751
+
+\(fn LANGUAGE &optional DEST-BUFFER CAPTION)" t nil)
+
+(autoload (quote table-insert-sequence) "table" "\
+Travel cells forward while inserting a specified sequence string in each cell.
+STR is the base string from which the sequence starts. When STR is an
+empty string then each cell content is erased. When STR ends with
+numerical characters (they may optionally be surrounded by a pair of
+parentheses) they are incremented as a decimal number. Otherwise the
+last character in STR is incremented in ASCII code order. N is the
+number of sequence elements to insert. When N is negative the cell
+traveling direction is backward. When N is zero it travels forward
+entire table. INCREMENT is the increment between adjacent sequence
+elements and can be a negative number for effectively decrementing.
+INTERVAL is the number of cells to travel between sequence element
+insertion which is normally 1. When zero or less is given for
+INTERVAL it is interpreted as number of cells per row so that sequence
+is placed straight down vertically as long as the table's cell
+structure is uniform. JUSTIFY is one of the symbol 'left, 'center or
+'right, that specifies justification of the inserted string.
+
+Example:
+
+ (progn
+ (table-insert 16 3 5 1)
+ (table-forward-cell 15)
+ (table-insert-sequence \"D0\" -16 1 1 'center)
+ (table-forward-cell 16)
+ (table-insert-sequence \"A[0]\" -16 1 1 'center)
+ (table-forward-cell 1)
+ (table-insert-sequence \"-\" 16 0 1 'center))
+
+ (progn
+ (table-insert 16 8 5 1)
+ (table-insert-sequence \"@\" 0 1 2 'right)
+ (table-forward-cell 1)
+ (table-insert-sequence \"64\" 0 1 2 'left))
+
+\(fn STR N INCREMENT INTERVAL JUSTIFY)" t nil)
+
+(autoload (quote table-delete-row) "table" "\
+Delete N row(s) of cells.
+Delete N rows of cells from current row. The current row is the row
+contains the current cell where point is located. Each row must
+consists from cells of same height.
+
+\(fn N)" t nil)
+
+(autoload (quote table-delete-column) "table" "\
+Delete N column(s) of cells.
+Delete N columns of cells from current column. The current column is
+the column contains the current cell where point is located. Each
+column must consists from cells of same width.
+
+\(fn N)" t nil)
+
+(autoload (quote table-capture) "table" "\
+Convert plain text into a table by capturing the text in the region.
+Create a table with the text in region as cell contents. BEG and END
+specify the region. The text in the region is replaced with a table.
+The removed text is inserted in the table. When optional
+COL-DELIM-REGEXP and ROW-DELIM-REGEXP are provided the region contents
+is parsed and separated into individual cell contents by using the
+delimiter regular expressions. This parsing determines the number of
+columns and rows of the table automatically. If COL-DELIM-REGEXP and
+ROW-DELIM-REGEXP are omitted the result table has only one cell and
+the entire region contents is placed in that cell. Optional JUSTIFY
+is one of 'left, 'center or 'right, which specifies the cell
+justification. Optional MIN-CELL-WIDTH specifies the minimum cell
+width. Optional COLUMNS specify the number of columns when
+ROW-DELIM-REGEXP is not specified.
+
+
+Example 1:
+
+1, 2, 3, 4
+5, 6, 7, 8
+, 9, 10
+
+Running `table-capture' on above 3 line region with COL-DELIM-REGEXP
+\",\" and ROW-DELIM-REGEXP \"\\n\" creates the following table. In
+this example the cells are centered and minimum cell width is
+specified as 5.
+
++-----+-----+-----+-----+
+| 1 | 2 | 3 | 4 |
++-----+-----+-----+-----+
+| 5 | 6 | 7 | 8 |
++-----+-----+-----+-----+
+| | 9 | 10 | |
++-----+-----+-----+-----+
+
+Note:
+
+In case the function is called interactively user must use \\[quoted-insert] `quoted-insert'
+in order to enter \"\\n\" successfully. COL-DELIM-REGEXP at the end
+of each row is optional.
+
+
+Example 2:
+
+This example shows how a table can be used for text layout editing.
+Let `table-capture' capture the following region starting from
+-!- and ending at -*-, that contains three paragraphs and two item
+name headers. This time specify empty string for both
+COL-DELIM-REGEXP and ROW-DELIM-REGEXP.
+
+-!-`table-capture' is a powerful command however mastering its power
+requires some practice. Here is a list of items what it can do.
+
+Parse Cell Items By using column delimiter regular
+ expression and raw delimiter regular
+ expression, it parses the specified text
+ area and extracts cell items from
+ non-table text and then forms a table out
+ of them.
+
+Capture Text Area When no delimiters are specified it
+ creates a single cell table. The text in
+ the specified region is placed in that
+ cell.-*-
+
+Now the entire content is captured in a cell which is itself a table
+like this.
+
++-----------------------------------------------------------------+
+|`table-capture' is a powerful command however mastering its power|
+|requires some practice. Here is a list of items what it can do. |
+| |
+|Parse Cell Items By using column delimiter regular |
+| expression and raw delimiter regular |
+| expression, it parses the specified text |
+| area and extracts cell items from |
+| non-table text and then forms a table out |
+| of them. |
+| |
+|Capture Text Area When no delimiters are specified it |
+| creates a single cell table. The text in |
+| the specified region is placed in that |
+| cell. |
++-----------------------------------------------------------------+
+
+By splitting the cell appropriately we now have a table consisting of
+paragraphs occupying its own cell. Each cell can now be edited
+independently.
+
++-----------------------------------------------------------------+
+|`table-capture' is a powerful command however mastering its power|
+|requires some practice. Here is a list of items what it can do. |
++---------------------+-------------------------------------------+
+|Parse Cell Items |By using column delimiter regular |
+| |expression and raw delimiter regular |
+| |expression, it parses the specified text |
+| |area and extracts cell items from |
+| |non-table text and then forms a table out |
+| |of them. |
++---------------------+-------------------------------------------+
+|Capture Text Area |When no delimiters are specified it |
+| |creates a single cell table. The text in |
+| |the specified region is placed in that |
+| |cell. |
++---------------------+-------------------------------------------+
+
+By applying `table-release', which does the opposite process, the
+contents become once again plain text. `table-release' works as
+companion command to `table-capture' this way.
+
+\(fn BEG END &optional COL-DELIM-REGEXP ROW-DELIM-REGEXP JUSTIFY MIN-CELL-WIDTH COLUMNS)" t nil)
+
+(autoload (quote table-release) "table" "\
+Convert a table into plain text by removing the frame from a table.
+Remove the frame from a table and inactivate the table. This command
+converts a table into plain text without frames. It is a companion to
+`table-capture' which does the opposite process.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (talk-connect) "talk" "talk.el" (15589 6165))
;;; Generated autoloads from talk.el
(autoload (quote talk-connect) "talk" "\
-Connect to display DISPLAY for the Emacs talk group." t nil)
+Connect to display DISPLAY for the Emacs talk group.
+
+\(fn DISPLAY)" t nil)
;;;***
\f
- ;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (15961 24151))
-;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (15475 26218))
++;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (16205 24332))
;;; Generated autoloads from tar-mode.el
(autoload (quote tar-mode) "tar-mode" "\
Major mode for viewing a tar file as a dired-like listing of its contents.
-You can move around using the usual cursor motion commands.
+You can move around using the usual cursor motion commands.
Letters no longer insert themselves.
Type `e' to pull a file out of the tar file and into its own buffer;
or click mouse-2 on the file's line in the Tar mode buffer.
Type `c' to copy an entry from the tar file into another file on disk.
-If you edit a sub-file of this archive (as with the `e' command) and
-save it with Control-x Control-s, the contents of that buffer will be
-saved back into the tar-file buffer; in this way you can edit a file
+If you edit a sub-file of this archive (as with the `e' command) and
+save it with Control-x Control-s, the contents of that buffer will be
+saved back into the tar-file buffer; in this way you can edit a file
inside of a tar archive without extracting it and re-archiving it.
See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
-\\{tar-mode-map}" t nil)
+\\{tar-mode-map}
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (tcl-help-on-word inferior-tcl tcl-mode) "tcl"
-;;;;;; "progmodes/tcl.el" (15476 9279))
+;;;;;; "progmodes/tcl.el" (16111 41834))
;;; Generated autoloads from progmodes/tcl.el
(autoload (quote tcl-mode) "tcl" "\
`tcl-auto-newline'
Non-nil means automatically newline before and after braces, brackets,
and semicolons inserted in Tcl code.
- `tcl-electric-hash-style'
- Controls action of `#' key.
`tcl-use-smart-word-finder'
If not nil, use a smarter, Tcl-specific way to find the current
word when looking up help on a Tcl command.
-Turning on Tcl mode calls the value of the variable `tcl-mode-hook'
-with no args, if that value is non-nil. Read the documentation for
+Turning on Tcl mode runs `tcl-mode-hook'. Read the documentation for
`tcl-mode-hook' to see what kinds of interesting hook functions
already exist.
Commands:
-\\{tcl-mode-map}" t nil)
+\\{tcl-mode-map}
+
+\(fn)" t nil)
(autoload (quote inferior-tcl) "tcl" "\
Run inferior Tcl process.
Prefix arg means enter program name interactively.
-See documentation for function `inferior-tcl-mode' for more information." t nil)
+See documentation for function `inferior-tcl-mode' for more information.
+
+\(fn CMD)" t nil)
(autoload (quote tcl-help-on-word) "tcl" "\
Get help on Tcl command. Default is word at point.
-Prefix argument means invert sense of `tcl-use-smart-word-finder'." t nil)
+Prefix argument means invert sense of `tcl-use-smart-word-finder'.
+
+\(fn COMMAND &optional ARG)" t nil)
;;;***
\f
-;;;### (autoloads (rsh telnet) "telnet" "net/telnet.el" (15441 20096))
+;;;### (autoloads (rsh telnet) "telnet" "net/telnet.el" (15941 42963))
;;; Generated autoloads from net/telnet.el
(add-hook 'same-window-regexps "\\*telnet-.*\\*\\(\\|<[0-9]+>\\)")
where PROGRAM is the telnet program being used. This program
is controlled by the contents of the global variable `telnet-host-properties',
falling back on the value of the global variable `telnet-program'.
-Normally input is edited in Emacs and sent a line at a time." t nil)
+Normally input is edited in Emacs and sent a line at a time.
+
+\(fn HOST)" t nil)
(add-hook 'same-window-regexps "\\*rsh-[^-]*\\*\\(\\|<[0-9]*>\\)")
(autoload (quote rsh) "telnet" "\
Open a network login connection to host named HOST (a string).
Communication with HOST is recorded in a buffer `*rsh-HOST*'.
-Normally input is edited in Emacs and sent a line at a time." t nil)
+Normally input is edited in Emacs and sent a line at a time.
+
+\(fn HOST)" t nil)
;;;***
\f
- ;;;### (autoloads (ansi-term term make-term) "term" "term.el" (15941
- ;;;;;; 42957))
-;;;### (autoloads (ansi-term term make-term) "term" "term.el" (15455
-;;;;;; 18400))
++;;;### (autoloads (ansi-term term make-term) "term" "term.el" (16179
++;;;;;; 13250))
;;; Generated autoloads from term.el
(autoload (quote make-term) "term" "\
The name of the buffer is made by surrounding NAME with `*'s.
If there is already a running process in that buffer, it is not restarted.
Optional third arg STARTFILE is the name of a file to send the contents of to
-the process. Any more args are arguments to PROGRAM." nil nil)
+the process. Any more args are arguments to PROGRAM.
+
+\(fn NAME PROGRAM &optional STARTFILE &rest SWITCHES)" nil nil)
(autoload (quote term) "term" "\
-Start a terminal-emulator in a new buffer." t nil)
+Start a terminal-emulator in a new buffer.
+The buffer is in Term mode; see `term-mode' for the
+commands to use in that buffer.
+
+\\<term-raw-map>Type \\[switch-to-buffer] to switch to another buffer.
+
+\(fn PROGRAM)" t nil)
(autoload (quote ansi-term) "term" "\
-Start a terminal-emulator in a new buffer." t nil)
+Start a terminal-emulator in a new buffer.
+
+\(fn PROGRAM &optional NEW-BUFFER-NAME)" t nil)
;;;***
\f
-;;;### (autoloads (terminal-emulator) "terminal" "terminal.el" (15464
-;;;;;; 26324))
+;;;### (autoloads (terminal-emulator) "terminal" "terminal.el" (15491
+;;;;;; 28591))
;;; Generated autoloads from terminal.el
(autoload (quote terminal-emulator) "terminal" "\
This function calls the value of terminal-mode-hook if that exists
and is non-nil after the terminal buffer has been set up and the
-subprocess started." t nil)
+subprocess started.
+
+\(fn BUFFER PROGRAM ARGS &optional WIDTH HEIGHT)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (testcover-this-defun testcover-start) "testcover"
+;;;;;; "emacs-lisp/testcover.el" (16162 11942))
+;;; Generated autoloads from emacs-lisp/testcover.el
+
+(autoload (quote testcover-start) "testcover" "\
+Uses edebug to instrument all macros and functions in FILENAME, then
+changes the instrumentation from edebug to testcover--much faster, no
+problems with type-ahead or post-command-hook, etc. If BYTE-COMPILE is
+non-nil, byte-compiles each function after instrumenting.
+
+\(fn FILENAME &optional BYTE-COMPILE)" t nil)
+
+(autoload (quote testcover-this-defun) "testcover" "\
+Start coverage on function under point.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (tetris) "tetris" "play/tetris.el" (15441 20096))
+;;;### (autoloads (tetris) "tetris" "play/tetris.el" (15763 44954))
;;; Generated autoloads from play/tetris.el
(autoload (quote tetris) "tetris" "\
\\[tetris-rotate-next] Rotates the shape anticlockwise
\\[tetris-move-bottom] Drops the shape to the bottom of the playing area
-" t nil)
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (tex-start-shell slitex-mode latex-mode plain-tex-mode
-;;;;;; tex-mode tex-close-quote tex-open-quote tex-default-mode
+;;;### (autoloads (doctex-mode tex-start-shell slitex-mode latex-mode
+;;;;;; plain-tex-mode tex-mode tex-close-quote tex-open-quote tex-default-mode
;;;;;; tex-show-queue-command tex-dvi-view-command tex-alt-dvi-print-command
;;;;;; tex-dvi-print-command tex-bibtex-command latex-block-names
-;;;;;; tex-start-options-string slitex-run-command latex-run-command
+;;;;;; tex-start-commands tex-start-options slitex-run-command latex-run-command
;;;;;; tex-run-command tex-offer-save tex-main-file tex-first-line-header-regexp
;;;;;; tex-directory tex-shell-file-name) "tex-mode" "textmodes/tex-mode.el"
-;;;;;; (15469 16379))
+;;;;;; (16139 21086))
;;; Generated autoloads from textmodes/tex-mode.el
(defvar tex-shell-file-name nil "\
*If non-nil, the shell file name to run in the subshell used to run TeX.")
+(custom-autoload (quote tex-shell-file-name) "tex-mode")
+
(defvar tex-directory "." "\
*Directory in which temporary files are written.
You can make this `/tmp' if your TEXINPUTS has no relative directories in it
and you don't try to apply \\[tex-region] or \\[tex-buffer] when there are
`\\input' commands with relative directories.")
+(custom-autoload (quote tex-directory) "tex-mode")
+
(defvar tex-first-line-header-regexp nil "\
Regexp for matching a first line which `tex-region' should include.
If this is non-nil, it should be a regular expression string;
if it matches the first line of the file,
`tex-region' always includes the first line in the TeX run.")
+(custom-autoload (quote tex-first-line-header-regexp) "tex-mode")
+
(defvar tex-main-file nil "\
*The main TeX source file which includes this buffer's file.
The command `tex-file' runs TeX on the file specified by `tex-main-file'
if the variable is non-nil.")
+(custom-autoload (quote tex-main-file) "tex-mode")
+
(defvar tex-offer-save t "\
*If non-nil, ask about saving modified buffers before \\[tex-file] is run.")
+(custom-autoload (quote tex-offer-save) "tex-mode")
+
(defvar tex-run-command "tex" "\
*Command used to run TeX subjob.
TeX Mode sets `tex-command' to this string.
See the documentation of that variable.")
+(custom-autoload (quote tex-run-command) "tex-mode")
+
(defvar latex-run-command "latex" "\
*Command used to run LaTeX subjob.
LaTeX Mode sets `tex-command' to this string.
See the documentation of that variable.")
+(custom-autoload (quote latex-run-command) "tex-mode")
+
(defvar slitex-run-command "slitex" "\
*Command used to run SliTeX subjob.
SliTeX Mode sets `tex-command' to this string.
See the documentation of that variable.")
-(defvar tex-start-options-string "\\nonstopmode\\input" "\
-*TeX options to use when running TeX.
-These precede the input file name. If nil, TeX runs without option.
-See the documentation of `tex-command'.")
+(custom-autoload (quote slitex-run-command) "tex-mode")
+
+(defvar tex-start-options "" "\
+*TeX options to use when starting TeX.
+These immediately precede the commands in `tex-start-commands'
+and the input file name, with no separating space and are not shell-quoted.
+If nil, TeX runs with no options. See the documentation of `tex-command'.")
+
+(custom-autoload (quote tex-start-options) "tex-mode")
+
+(defvar tex-start-commands "\\nonstopmode\\input" "\
+*TeX commands to use when starting TeX.
+They are shell-quoted and precede the input file name, with a separating space.
+If nil, no commands are used. See the documentation of `tex-command'.")
+
+(custom-autoload (quote tex-start-commands) "tex-mode")
(defvar latex-block-names nil "\
*User defined LaTeX block names.
-Combined with `standard-latex-block-names' for minibuffer completion.")
+Combined with `latex-standard-block-names' for minibuffer completion.")
+
+(custom-autoload (quote latex-block-names) "tex-mode")
(defvar tex-bibtex-command "bibtex" "\
*Command used by `tex-bibtex-file' to gather bibliographic data.
If this string contains an asterisk (`*'), that is replaced by the file name;
otherwise, the file name, preceded by blank, is added at the end.")
+(custom-autoload (quote tex-bibtex-command) "tex-mode")
+
(defvar tex-dvi-print-command "lpr -d" "\
*Command used by \\[tex-print] to print a .dvi file.
If this string contains an asterisk (`*'), that is replaced by the file name;
otherwise, the file name, preceded by blank, is added at the end.")
+(custom-autoload (quote tex-dvi-print-command) "tex-mode")
+
(defvar tex-alt-dvi-print-command "lpr -d" "\
*Command used by \\[tex-print] with a prefix arg to print a .dvi file.
If this string contains an asterisk (`*'), that is replaced by the file name;
would tell \\[tex-print] with a prefix argument to ask you which printer to
use.")
-(defvar tex-dvi-view-command nil "\
+(custom-autoload (quote tex-alt-dvi-print-command) "tex-mode")
+
+(defvar tex-dvi-view-command (quote (if (eq window-system (quote x)) \"xdvi\" \"dvi2tty * | cat -s\")) "\
*Command used by \\[tex-view] to display a `.dvi' file.
+If it is a string, that specifies the command directly.
If this string contains an asterisk (`*'), that is replaced by the file name;
-otherwise, the file name, preceded by blank, is added at the end.
+otherwise, the file name, preceded by a space, is added at the end.
-This can be set conditionally so that the previewer used is suitable for the
-window system being used. For example,
+If the value is a form, it is evaluated to get the command to use.")
- (setq tex-dvi-view-command
- (if (eq window-system 'x) \"xdvi\" \"dvi2tty * | cat -s\"))
-
-would tell \\[tex-view] to use xdvi under X windows and to use dvi2tty
-otherwise.")
+(custom-autoload (quote tex-dvi-view-command) "tex-mode")
(defvar tex-show-queue-command "lpq" "\
*Command used by \\[tex-show-print-queue] to show the print queue.
Should show the queue(s) that \\[tex-print] puts jobs on.")
+(custom-autoload (quote tex-show-queue-command) "tex-mode")
+
(defvar tex-default-mode (quote latex-mode) "\
*Mode to enter for a new file that might be either TeX or LaTeX.
This variable is used when it can't be determined whether the file
is plain TeX or LaTeX or what because the file contains no commands.
Normally set to either `plain-tex-mode' or `latex-mode'.")
+(custom-autoload (quote tex-default-mode) "tex-mode")
+
(defvar tex-open-quote "``" "\
*String inserted by typing \\[tex-insert-quote] to open a quotation.")
+(custom-autoload (quote tex-open-quote) "tex-mode")
+
(defvar tex-close-quote "''" "\
*String inserted by typing \\[tex-insert-quote] to close a quotation.")
+(custom-autoload (quote tex-close-quote) "tex-mode")
+
(autoload (quote tex-mode) "tex-mode" "\
Major mode for editing files of input for TeX, LaTeX, or SliTeX.
Tries to determine (by looking at the beginning of the file) whether
this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode',
`latex-mode', or `slitex-mode', respectively. If it cannot be determined,
such as if there are no commands in the file, the value of `tex-default-mode'
-says which mode to use." t nil)
+says which mode to use.
+
+\(fn)" t nil)
(defalias (quote TeX-mode) (quote tex-mode))
Entering Plain-tex mode runs the hook `text-mode-hook', then the hook
`tex-mode-hook', and finally the hook `plain-tex-mode-hook'. When the
-special subshell is initiated, the hook `tex-shell-hook' is run." t nil)
+special subshell is initiated, the hook `tex-shell-hook' is run.
+
+\(fn)" t nil)
(autoload (quote latex-mode) "tex-mode" "\
Major mode for editing files of input for LaTeX.
Entering Latex mode runs the hook `text-mode-hook', then
`tex-mode-hook', and finally `latex-mode-hook'. When the special
-subshell is initiated, `tex-shell-hook' is run." t nil)
+subshell is initiated, `tex-shell-hook' is run.
+
+\(fn)" t nil)
(autoload (quote slitex-mode) "tex-mode" "\
Major mode for editing files of input for SliTeX.
Entering SliTeX mode runs the hook `text-mode-hook', then the hook
`tex-mode-hook', then the hook `latex-mode-hook', and finally the hook
`slitex-mode-hook'. When the special subshell is initiated, the hook
-`tex-shell-hook' is run." t nil)
+`tex-shell-hook' is run.
+
+\(fn)" t nil)
+
+(autoload (quote tex-start-shell) "tex-mode" "\
+Not documented
-(autoload (quote tex-start-shell) "tex-mode" nil nil nil)
+\(fn)" nil nil)
+
+(autoload (quote doctex-mode) "tex-mode" "\
+Major mode to edit DocTeX files.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (texi2info texinfo-format-region texinfo-format-buffer)
-;;;;;; "texinfmt" "textmodes/texinfmt.el" (15371 46417))
+;;;;;; "texinfmt" "textmodes/texinfmt.el" (16111 41838))
;;; Generated autoloads from textmodes/texinfmt.el
(autoload (quote texinfo-format-buffer) "texinfmt" "\
Non-nil argument (prefix, if interactive) means don't make tag table
and don't split the file if large. You can use Info-tagify and
-Info-split to do these manually." t nil)
+Info-split to do these manually.
+
+\(fn &optional NOSPLIT)" t nil)
(autoload (quote texinfo-format-region) "texinfmt" "\
Convert the current region of the Texinfo file to Info format.
This lets you see what that part of the file will look like in Info.
The command is bound to \\[texinfo-format-region]. The text that is
-converted to Info is stored in a temporary buffer." t nil)
+converted to Info is stored in a temporary buffer.
+
+\(fn REGION-BEGINNING REGION-END)" t nil)
(autoload (quote texi2info) "texinfmt" "\
Convert the current buffer (written in Texinfo code) into an Info file.
Texinfo source buffer is not changed.
Non-nil argument (prefix, if interactive) means don't split the file
-if large. You can use Info-split to do this manually." t nil)
+if large. You can use Info-split to do this manually.
+
+\(fn &optional NOSPLIT)" t nil)
;;;***
\f
;;;### (autoloads (texinfo-mode texinfo-close-quote texinfo-open-quote)
-;;;;;; "texinfo" "textmodes/texinfo.el" (15425 28364))
+;;;;;; "texinfo" "textmodes/texinfo.el" (16148 4633))
;;; Generated autoloads from textmodes/texinfo.el
(defvar texinfo-open-quote "``" "\
*String inserted by typing \\[texinfo-insert-quote] to open a quotation.")
+(custom-autoload (quote texinfo-open-quote) "texinfo")
+
(defvar texinfo-close-quote "''" "\
*String inserted by typing \\[texinfo-insert-quote] to close a quotation.")
+(custom-autoload (quote texinfo-close-quote) "texinfo")
+
(autoload (quote texinfo-mode) "texinfo" "\
Major mode for editing Texinfo files.
be the first node in the file.
Entering Texinfo mode calls the value of `text-mode-hook', and then the
-value of `texinfo-mode-hook'." t nil)
+value of `texinfo-mode-hook'.
+
+\(fn)" t nil)
;;;***
\f
--;;;### (autoloads (thai-composition-function thai-post-read-conversion
--;;;;;; thai-compose-buffer thai-compose-string thai-compose-region)
- ;;;;;; "thai-util" "language/thai-util.el" (16118 44435))
-;;;;;; "thai-util" "language/thai-util.el" (15391 60704))
++;;;### (autoloads (thai-composition-function thai-compose-buffer
++;;;;;; thai-compose-string thai-compose-region) "thai-util" "language/thai-util.el"
++;;;;;; (16185 55426))
;;; Generated autoloads from language/thai-util.el
(autoload (quote thai-compose-region) "thai-util" "\
Compose Thai characters in the region.
When called from a program, expects two arguments,
-positions (integers or markers) specifying the region." t nil)
+positions (integers or markers) specifying the region.
+
+\(fn BEG END)" t nil)
(autoload (quote thai-compose-string) "thai-util" "\
-Compose Thai characters in STRING and return the resulting string." nil nil)
+Compose Thai characters in STRING and return the resulting string.
+
+\(fn STRING)" nil nil)
(autoload (quote thai-compose-buffer) "thai-util" "\
-Compose Thai characters in the current buffer." t nil)
+Compose Thai characters in the current buffer.
-(autoload (quote thai-post-read-conversion) "thai-util" nil nil nil)
+\(fn)" t nil)
- (autoload (quote thai-post-read-conversion) "thai-util" "\
- Not documented
-
- \(fn LEN)" nil nil)
-
(autoload (quote thai-composition-function) "thai-util" "\
--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.
++Not documented
- \(fn FROM TO PATTERN &optional STRING)" nil nil)
-The return value is number of composed characters." nil nil)
++\(fn POS &optional STRING)" nil nil)
;;;***
\f
;;;### (autoloads (list-at-point number-at-point symbol-at-point
;;;;;; sexp-at-point thing-at-point bounds-of-thing-at-point forward-thing)
-;;;;;; "thingatpt" "thingatpt.el" (15371 46418))
+;;;;;; "thingatpt" "thingatpt.el" (15941 42957))
;;; Generated autoloads from thingatpt.el
(autoload (quote forward-thing) "thingatpt" "\
-Move forward to the end of the next THING." nil nil)
+Move forward to the end of the next THING.
+
+\(fn THING &optional N)" nil nil)
(autoload (quote bounds-of-thing-at-point) "thingatpt" "\
Determine the start and end buffer locations for the THING at point.
a symbol as a valid THING.
The value is a cons cell (START . END) giving the start and end positions
-of the textual entity that was found." nil nil)
+of the textual entity that was found.
+
+\(fn THING)" nil nil)
(autoload (quote thing-at-point) "thingatpt" "\
Return the THING at point.
`word', `sentence', `whitespace', `line', `page' and others.
See the file `thingatpt.el' for documentation on how to define
-a symbol as a valid THING." nil nil)
+a symbol as a valid THING.
+
+\(fn THING)" nil nil)
+
+(autoload (quote sexp-at-point) "thingatpt" "\
+Not documented
+
+\(fn)" nil nil)
-(autoload (quote sexp-at-point) "thingatpt" nil nil nil)
+(autoload (quote symbol-at-point) "thingatpt" "\
+Not documented
-(autoload (quote symbol-at-point) "thingatpt" nil nil nil)
+\(fn)" nil nil)
-(autoload (quote number-at-point) "thingatpt" nil nil nil)
+(autoload (quote number-at-point) "thingatpt" "\
+Not documented
-(autoload (quote list-at-point) "thingatpt" nil nil nil)
+\(fn)" nil nil)
+
+(autoload (quote list-at-point) "thingatpt" "\
+Not documented
+
+\(fn)" nil nil)
;;;***
\f
-;;;### (autoloads (tibetan-pre-write-conversion tibetan-post-read-conversion
-;;;;;; tibetan-compose-buffer tibetan-decompose-buffer tibetan-composition-function
-;;;;;; tibetan-decompose-string tibetan-decompose-region tibetan-compose-region
-;;;;;; tibetan-compose-string tibetan-transcription-to-tibetan tibetan-tibetan-to-transcription
-;;;;;; tibetan-char-p) "tibet-util" "language/tibet-util.el" (15441
-;;;;;; 20095))
+;;;### (autoloads (tibetan-pre-write-canonicalize-for-unicode tibetan-pre-write-conversion
+;;;;;; tibetan-post-read-conversion tibetan-compose-buffer tibetan-decompose-buffer
+;;;;;; tibetan-composition-function tibetan-decompose-string tibetan-decompose-region
+;;;;;; tibetan-compose-region tibetan-compose-string tibetan-transcription-to-tibetan
+;;;;;; tibetan-tibetan-to-transcription tibetan-char-p) "tibet-util"
- ;;;;;; "language/tibet-util.el" (16118 44435))
++;;;;;; "language/tibet-util.el" (16195 2278))
;;; Generated autoloads from language/tibet-util.el
(autoload (quote tibetan-char-p) "tibet-util" "\
Check if char CH is Tibetan character.
-Returns non-nil if CH is Tibetan. Otherwise, returns nil." nil nil)
+Returns non-nil if CH is Tibetan. Otherwise, returns nil.
+
+\(fn CH)" nil nil)
(autoload (quote tibetan-tibetan-to-transcription) "tibet-util" "\
-Transcribe Tibetan string STR and return the corresponding Roman string." nil nil)
+Transcribe Tibetan string STR and return the corresponding Roman string.
+
+\(fn STR)" nil nil)
(autoload (quote tibetan-transcription-to-tibetan) "tibet-util" "\
Convert Tibetan Roman string STR to Tibetan character string.
-The returned string has no composition information." nil nil)
+The returned string has no composition information.
+
+\(fn STR)" nil nil)
(autoload (quote tibetan-compose-string) "tibet-util" "\
-Compose Tibetan string STR." nil nil)
+Compose Tibetan string STR.
+
+\(fn STR)" nil nil)
(autoload (quote tibetan-compose-region) "tibet-util" "\
-Compose Tibetan text the region BEG and END." t nil)
+Compose Tibetan text the region BEG and END.
+
+\(fn BEG END)" t nil)
(autoload (quote tibetan-decompose-region) "tibet-util" "\
Decompose Tibetan text in the region FROM and TO.
This is different from decompose-region because precomposed Tibetan characters
-are decomposed into normal Tibetan character sequences." t nil)
+are decomposed into normal Tibetan character sequences.
+
+\(fn FROM TO)" t nil)
(autoload (quote tibetan-decompose-string) "tibet-util" "\
Decompose Tibetan string STR.
This is different from decompose-string because precomposed Tibetan characters
-are decomposed into normal Tibetan character sequences." nil nil)
+are decomposed into normal Tibetan character sequences.
-(autoload (quote tibetan-composition-function) "tibet-util" nil nil nil)
+\(fn STR)" nil nil)
+
+(autoload (quote tibetan-composition-function) "tibet-util" "\
+Not documented
+
- \(fn FROM TO PATTERN &optional STRING)" nil nil)
++\(fn POS &optional STRING)" nil nil)
(autoload (quote tibetan-decompose-buffer) "tibet-util" "\
Decomposes Tibetan characters in the buffer into their components.
-See also the documentation of the function `tibetan-decompose-region'." t nil)
+See also the documentation of the function `tibetan-decompose-region'.
+
+\(fn)" t nil)
(autoload (quote tibetan-compose-buffer) "tibet-util" "\
Composes Tibetan character components in the buffer.
-See also docstring of the function tibetan-compose-region." t nil)
+See also docstring of the function tibetan-compose-region.
+
+\(fn)" t nil)
-(autoload (quote tibetan-post-read-conversion) "tibet-util" nil nil nil)
+(autoload (quote tibetan-post-read-conversion) "tibet-util" "\
+Not documented
-(autoload (quote tibetan-pre-write-conversion) "tibet-util" nil nil nil)
+\(fn LEN)" nil nil)
+
+(autoload (quote tibetan-pre-write-conversion) "tibet-util" "\
+Not documented
+
+\(fn FROM TO)" nil nil)
+
+(autoload (quote tibetan-pre-write-canonicalize-for-unicode) "tibet-util" "\
+Not documented
+
+\(fn FROM TO)" nil nil)
;;;***
\f
;;;### (autoloads (tildify-buffer tildify-region) "tildify" "textmodes/tildify.el"
-;;;;;; (15371 46417))
+;;;;;; (15941 42966))
;;; Generated autoloads from textmodes/tildify.el
(autoload (quote tildify-region) "tildify" "\
See variables `tildify-pattern-alist', `tildify-string-alist', and
`tildify-ignored-environments-alist' for information about configuration
parameters.
-This function performs no refilling of the changed text." t nil)
+This function performs no refilling of the changed text.
+
+\(fn BEG END)" t nil)
(autoload (quote tildify-buffer) "tildify" "\
Add hard spaces in the current buffer.
See variables `tildify-pattern-alist', `tildify-string-alist', and
`tildify-ignored-environments-alist' for information about configuration
parameters.
-This function performs no refilling of the changed text." t nil)
+This function performs no refilling of the changed text.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (display-time-mode display-time display-time-day-and-date)
-;;;;;; "time" "time.el" (15587 40325))
+;;;;;; "time" "time.el" (16011 37576))
;;; Generated autoloads from time.el
(defvar display-time-day-and-date nil "\
*Non-nil means \\[display-time] should display day and date as well as time.")
+(custom-autoload (quote display-time-day-and-date) "time")
+
(autoload (quote display-time) "time" "\
Enable display of time, load level, and mail flag in mode lines.
This display updates automatically every minute.
If `display-time-day-and-date' is non-nil, the current day and date
are displayed as well.
-This runs the normal hook `display-time-hook' after each update." t nil)
+This runs the normal hook `display-time-hook' after each update.
+
+\(fn)" t nil)
(defvar display-time-mode nil "\
Non-nil if Display-Time mode is enabled.
Setting this variable directly does not take effect;
use either \\[customize] or the function `display-time-mode'.")
-(custom-add-to-group (quote display-time) (quote display-time-mode) (quote custom-variable))
-
-(custom-add-load (quote display-time-mode) (quote time))
+(custom-autoload (quote display-time-mode) "time")
(autoload (quote display-time-mode) "time" "\
Toggle display of time, load level, and mail flag in mode lines.
When this display is enabled, it updates automatically every minute.
If `display-time-day-and-date' is non-nil, the current day and date
are displayed as well.
-This runs the normal hook `display-time-hook' after each update." t nil)
+This runs the normal hook `display-time-hook' after each update.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;; Generated autoloads from calendar/time-date.el
(autoload (quote date-to-time) "time-date" "\
-Parse a string that represents a date-time and return a time value." nil nil)
+Parse a string that represents a date-time and return a time value.
+
+\(fn DATE)" nil nil)
(autoload (quote seconds-to-time) "time-date" "\
-Convert SECONDS (a floating point number) to a time value." nil nil)
+Convert SECONDS (a floating point number) to a time value.
+
+\(fn SECONDS)" nil nil)
(autoload (quote time-less-p) "time-date" "\
-Say whether time value T1 is less than time value T2." nil nil)
+Say whether time value T1 is less than time value T2.
+
+\(fn T1 T2)" nil nil)
(autoload (quote days-to-time) "time-date" "\
-Convert DAYS into a time value." nil nil)
+Convert DAYS into a time value.
+
+\(fn DAYS)" nil nil)
(autoload (quote time-since) "time-date" "\
Return the time elapsed since TIME.
-TIME should be either a time value or a date-time string." nil nil)
+TIME should be either a time value or a date-time string.
+
+\(fn TIME)" nil nil)
(defalias (quote subtract-time) (quote time-subtract))
(autoload (quote time-subtract) "time-date" "\
Subtract two time values.
-Return the difference in the format of a time value." nil nil)
+Return the difference in the format of a time value.
+
+\(fn T1 T2)" nil nil)
(autoload (quote time-add) "time-date" "\
-Add two time values. One should represent a time difference." nil nil)
+Add two time values. One should represent a time difference.
+
+\(fn T1 T2)" nil nil)
(autoload (quote date-to-day) "time-date" "\
Return the number of days between year 1 and DATE.
-DATE should be a date-time string." nil nil)
+DATE should be a date-time string.
+
+\(fn DATE)" nil nil)
(autoload (quote days-between) "time-date" "\
Return the number of days between DATE1 and DATE2.
-DATE1 and DATE2 should be date-time strings." nil nil)
+DATE1 and DATE2 should be date-time strings.
+
+\(fn DATE1 DATE2)" nil nil)
(autoload (quote date-leap-year-p) "time-date" "\
-Return t if YEAR is a leap year." nil nil)
+Return t if YEAR is a leap year.
+
+\(fn YEAR)" nil nil)
(autoload (quote time-to-day-in-year) "time-date" "\
-Return the day number within the year of the date month/day/year." nil nil)
+Return the day number within the year of the date month/day/year.
+
+\(fn TIME)" nil nil)
(autoload (quote time-to-days) "time-date" "\
The number of days between the Gregorian date 0001-12-31bce and TIME.
TIME should be a time value.
-The Gregorian date Sunday, December 31, 1bce is imaginary." nil nil)
+The Gregorian date Sunday, December 31, 1bce is imaginary.
+
+\(fn TIME)" nil nil)
(autoload (quote safe-date-to-time) "time-date" "\
Parse a string that represents a date-time and return a time value.
-If DATE is malformed, return a time value of zeros." nil nil)
+If DATE is malformed, return a time value of zeros.
+
+\(fn DATE)" nil nil)
;;;***
\f
;;;### (autoloads (time-stamp-toggle-active time-stamp) "time-stamp"
-;;;;;; "time-stamp.el" (15371 46418))
+;;;;;; "time-stamp.el" (15941 42957))
;;; Generated autoloads from time-stamp.el
(autoload (quote time-stamp) "time-stamp" "\
Time-stamp: <>
Time-stamp: \" \"
The time stamp is written between the brackets or quotes:
- Time-stamp: <1998-02-18 10:20:51 gildea>
+ Time-stamp: <2001-02-18 10:20:51 gildea>
The time stamp is updated only if the variable `time-stamp-active' is non-nil.
The format of the time stamp is set by the variable `time-stamp-format'.
The variables `time-stamp-line-limit', `time-stamp-start', `time-stamp-end',
`time-stamp-count', and `time-stamp-inserts-lines' control finding the
-template." t nil)
+template.
+
+\(fn)" t nil)
(autoload (quote time-stamp-toggle-active) "time-stamp" "\
Toggle `time-stamp-active', setting whether \\[time-stamp] updates a buffer.
-With arg, turn time stamping on if and only if arg is positive." t nil)
+With ARG, turn time stamping on if and only if arg is positive.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;;;; timeclock-workday-remaining-string timeclock-reread-log timeclock-query-out
;;;;;; timeclock-change timeclock-status-string timeclock-out timeclock-in
;;;;;; timeclock-modeline-display) "timeclock" "calendar/timeclock.el"
-;;;;;; (15371 46418))
+;;;;;; (16148 4633))
;;; Generated autoloads from calendar/timeclock.el
(autoload (quote timeclock-modeline-display) "timeclock" "\
Toggle display of the amount of time left today in the modeline.
-If `timeclock-use-display-time' is non-nil, the modeline will be
-updated whenever the time display is updated. Otherwise, the
-timeclock will use its own sixty second timer to do its updating.
-With prefix ARG, turn modeline display on if and only if ARG is
-positive. Returns the new status of timeclock modeline display
-\(non-nil means on)." t nil)
+If `timeclock-use-display-time' is non-nil (the default), then
+the function `display-time-mode' must be active, and the modeline
+will be updated whenever the time display is updated. Otherwise,
+the timeclock will use its own sixty second timer to do its
+updating. With prefix ARG, turn modeline display on if and only
+if ARG is positive. Returns the new status of timeclock modeline
+display (non-nil means on).
+
+\(fn &optional ARG)" t nil)
(autoload (quote timeclock-in) "timeclock" "\
Clock in, recording the current time moment in the timelog.
PROJECT as the project being clocked into. If PROJECT is nil, and
FIND-PROJECT is non-nil -- or the user calls `timeclock-in'
interactively -- call the function `timeclock-get-project-function' to
-discover the name of the project." t nil)
+discover the name of the project.
+
+\(fn &optional ARG PROJECT FIND-PROJECT)" t nil)
(autoload (quote timeclock-out) "timeclock" "\
Clock out, recording the current time moment in the timelog.
REASON is the user's reason for clocking out. If REASON is nil, and
FIND-REASON is non-nil -- or the user calls `timeclock-out'
interactively -- call the function `timeclock-get-reason-function' to
-discover the reason." t nil)
+discover the reason.
+
+\(fn &optional ARG REASON FIND-REASON)" t nil)
(autoload (quote timeclock-status-string) "timeclock" "\
-Report the overall timeclock status at the present moment." t nil)
+Report the overall timeclock status at the present moment.
+If SHOW-SECONDS is non-nil, display second resolution.
+If TODAY-ONLY is non-nil, the display will be relative only to time
+worked today, ignoring the time worked on previous days.
+
+\(fn &optional SHOW-SECONDS TODAY-ONLY)" t nil)
(autoload (quote timeclock-change) "timeclock" "\
Change to working on a different project, by clocking in then out.
With a prefix ARG, consider the previous project as having been
finished at the time of changeover. PROJECT is the name of the last
-project you were working on." t nil)
+project you were working on.
+
+\(fn &optional ARG PROJECT)" t nil)
(autoload (quote timeclock-query-out) "timeclock" "\
Ask the user before clocking out.
-This is a useful function for adding to `kill-emacs-hook'." nil nil)
+This is a useful function for adding to `kill-emacs-query-functions'.
+
+\(fn)" nil nil)
(autoload (quote timeclock-reread-log) "timeclock" "\
Re-read the timeclock, to account for external changes.
-Returns the new value of `timeclock-discrepancy'." t nil)
+Returns the new value of `timeclock-discrepancy'.
+
+\(fn)" t nil)
(autoload (quote timeclock-workday-remaining-string) "timeclock" "\
Return a string representing the amount of time left today.
Display second resolution if SHOW-SECONDS is non-nil. If TODAY-ONLY
is non-nil, the display will be relative only to time worked today.
See `timeclock-relative' for more information about the meaning of
-\"relative to today\"." t nil)
+\"relative to today\".
+
+\(fn &optional SHOW-SECONDS TODAY-ONLY)" t nil)
(autoload (quote timeclock-workday-elapsed-string) "timeclock" "\
Return a string representing the amount of time worked today.
Display seconds resolution if SHOW-SECONDS is non-nil. If RELATIVE is
-non-nil, the amount returned will be relative to past time worked." t nil)
+non-nil, the amount returned will be relative to past time worked.
+
+\(fn &optional SHOW-SECONDS)" t nil)
(autoload (quote timeclock-when-to-leave-string) "timeclock" "\
Return a string representing at what time the workday ends today.
This string is relative to the value of `timeclock-workday'. If
-NO-MESSAGE is non-nil, no messages will be displayed in the
-minibuffer. If SHOW-SECONDS is non-nil, the value printed/returned
-will include seconds. If TODAY-ONLY is non-nil, the value returned
-will be relative only to the time worked today, and not to past time.
-This argument only makes a difference if `timeclock-relative' is
-non-nil." t nil)
+SHOW-SECONDS is non-nil, the value printed/returned will include
+seconds. If TODAY-ONLY is non-nil, the value returned will be
+relative only to the time worked today, and not to past time.
+
+\(fn &optional SHOW-SECONDS TODAY-ONLY)" t nil)
;;;***
\f
;;;### (autoloads (with-timeout run-with-idle-timer add-timeout run-with-timer
;;;;;; run-at-time cancel-function-timers cancel-timer) "timer"
-;;;;;; "timer.el" (15371 46418))
-;;; Generated autoloads from timer.el
+;;;;;; "emacs-lisp/timer.el" (16087 59607))
+;;; Generated autoloads from emacs-lisp/timer.el
(defalias (quote disable-timeout) (quote cancel-timer))
(autoload (quote cancel-timer) "timer" "\
-Remove TIMER from the list of active timers." nil nil)
+Remove TIMER from the list of active timers.
+
+\(fn TIMER)" nil nil)
(autoload (quote cancel-function-timers) "timer" "\
-Cancel all timers scheduled by `run-at-time' which would run FUNCTION." t nil)
+Cancel all timers scheduled by `run-at-time' which would run FUNCTION.
+
+\(fn FUNCTION)" t nil)
(autoload (quote run-at-time) "timer" "\
Perform an action at time TIME.
REPEAT may be an integer or floating point number.
The action is to call FUNCTION with arguments ARGS.
-This function returns a timer object which you can use in `cancel-timer'." t nil)
+This function returns a timer object which you can use in `cancel-timer'.
+
+\(fn TIME REPEAT FUNCTION &rest ARGS)" t nil)
(autoload (quote run-with-timer) "timer" "\
Perform an action after a delay of SECS seconds.
SECS and REPEAT may be integers or floating point numbers.
The action is to call FUNCTION with arguments ARGS.
-This function returns a timer object which you can use in `cancel-timer'." t nil)
+This function returns a timer object which you can use in `cancel-timer'.
+
+\(fn SECS REPEAT FUNCTION &rest ARGS)" t nil)
(autoload (quote add-timeout) "timer" "\
Add a timer to run SECS seconds from now, to call FUNCTION on OBJECT.
If REPEAT is non-nil, repeat the timer every REPEAT seconds.
-This function is for compatibility; see also `run-with-timer'." nil nil)
+This function is for compatibility; see also `run-with-timer'.
+
+\(fn SECS FUNCTION OBJECT &optional REPEAT)" nil nil)
(autoload (quote run-with-idle-timer) "timer" "\
Perform an action the next time Emacs is idle for SECS seconds.
If REPEAT is non-nil, do the action each time Emacs has been idle for
exactly SECS seconds (that is, only once for each time Emacs becomes idle).
-This function returns a timer object which you can use in `cancel-timer'." t nil)
+This function returns a timer object which you can use in `cancel-timer'.
+
+\(fn SECS REPEAT FUNCTION &rest ARGS)" t nil)
(put 'with-timeout 'lisp-indent-function 1)
(autoload (quote with-timeout) "timer" "\
The timeout is checked whenever Emacs waits for some kind of external
event (such as keyboard input, input from subprocesses, or a certain time);
if the program loops without waiting in any way, the timeout will not
-be detected." nil (quote macro))
+be detected.
+
+\(fn LIST &rest BODY)" nil (quote macro))
;;;***
\f
;;;### (autoloads (batch-titdic-convert titdic-convert) "titdic-cnv"
- ;;;;;; "international/titdic-cnv.el" (15941 42961))
-;;;;;; "international/titdic-cnv.el" (15597 11253))
++;;;;;; "international/titdic-cnv.el" (16183 29727))
;;; Generated autoloads from international/titdic-cnv.el
(autoload (quote titdic-convert) "titdic-cnv" "\
Convert a TIT dictionary of FILENAME into a Quail package.
Optional argument DIRNAME if specified is the directory name under which
-the generated Quail package is saved." t nil)
+the generated Quail package is saved.
+
+\(fn FILENAME &optional DIRNAME)" t nil)
(autoload (quote batch-titdic-convert) "titdic-cnv" "\
Run `titdic-convert' on the files remaining on the command line.
it won't work in an interactive Emacs.
For example, invoke \"emacs -batch -f batch-titdic-convert XXX.tit\" to
generate Quail package file \"xxx.el\" from TIT dictionary file \"XXX.tit\".
-To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." nil nil)
+To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\".
+
+\(fn &optional FORCE)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (tamil-composition-function tamil-compose-region)
- ;;;;;; "tml-util" "language/tml-util.el" (16118 44435))
++;;;;;; "tml-util" "language/tml-util.el" (16194 56852))
+;;; Generated autoloads from language/tml-util.el
+
+(autoload (quote tamil-compose-region) "tml-util" "\
+Not documented
+
+\(fn FROM TO)" t nil)
+
+(autoload (quote tamil-composition-function) "tml-util" "\
- Compose Tamil characters in REGION, or STRING if specified.
- Assume that the REGION or STRING must fully match the composable
- PATTERN regexp.
++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.
+
- \(fn FROM TO PATTERN &optional STRING)" nil nil)
++\(fn POS &optional STRING)" nil nil)
;;;***
\f
;;;### (autoloads (tmm-prompt tmm-menubar-mouse tmm-menubar) "tmm"
-;;;;;; "tmm.el" (15450 56540))
+;;;;;; "tmm.el" (15557 10300))
;;; Generated autoloads from tmm.el
(define-key global-map "\M-`" 'tmm-menubar)
(define-key global-map [f10] 'tmm-menubar)
Text-mode emulation of looking and choosing from a menubar.
See the documentation for `tmm-prompt'.
X-POSITION, if non-nil, specifies a horizontal position within the menu bar;
-we make that menu bar item (the one at that position) the default choice." t nil)
+we make that menu bar item (the one at that position) the default choice.
+
+\(fn &optional X-POSITION)" t nil)
(autoload (quote tmm-menubar-mouse) "tmm" "\
Text-mode emulation of looking and choosing from a menubar.
This command is used when you click the mouse in the menubar
on a console which has no window system but does have a mouse.
-See the documentation for `tmm-prompt'." t nil)
+See the documentation for `tmm-prompt'.
+
+\(fn EVENT)" t nil)
(autoload (quote tmm-prompt) "tmm" "\
Text-mode emulation of calling the bindings in keymap.
MENU is like the MENU argument to `x-popup-menu': either a
keymap or an alist of alists.
DEFAULT-ITEM, if non-nil, specifies an initial default choice.
-Its value should be an event that has a binding in MENU." nil nil)
+Its value should be an event that has a binding in MENU.
+
+\(fn MENU &optional IN-POPUP DEFAULT-ITEM)" nil nil)
;;;***
\f
;;;### (autoloads (todo-show todo-cp todo-mode todo-print todo-top-priorities
;;;;;; todo-insert-item todo-add-item-non-interactively todo-add-category)
-;;;;;; "todo-mode" "calendar/todo-mode.el" (15391 60522))
+;;;;;; "todo-mode" "calendar/todo-mode.el" (15381 53844))
;;; Generated autoloads from calendar/todo-mode.el
(autoload (quote todo-add-category) "todo-mode" "\
-Add new category CAT to the TODO list." t nil)
+Add new category CAT to the TODO list.
+
+\(fn CAT)" t nil)
(autoload (quote todo-add-item-non-interactively) "todo-mode" "\
-Insert NEW-ITEM in TODO list as a new entry in CATEGORY." nil nil)
+Insert NEW-ITEM in TODO list as a new entry in CATEGORY.
+
+\(fn NEW-ITEM CATEGORY)" nil nil)
(autoload (quote todo-insert-item) "todo-mode" "\
Insert new TODO list entry.
With a prefix argument solicit the category, otherwise use the current
-category." t nil)
+category.
+
+\(fn ARG)" t nil)
(autoload (quote todo-top-priorities) "todo-mode" "\
List top priorities for each category.
defaults to 'todo-show-priorities'.
If CATEGORY-PR-PAGE is non-nil, a page separator '^L' is inserted
-between each category." t nil)
+between each category.
+
+\(fn &optional NOF-PRIORITIES CATEGORY-PR-PAGE)" t nil)
(autoload (quote todo-print) "todo-mode" "\
Print todo summary using `todo-print-function'.
If CATEGORY-PR-PAGE is non-nil, a page separator `^L' is inserted
between each category.
-Number of entries for each category is given by `todo-print-priorities'." t nil)
+Number of entries for each category is given by `todo-print-priorities'.
+
+\(fn &optional CATEGORY-PR-PAGE)" t nil)
(autoload (quote todo-mode) "todo-mode" "\
Major mode for editing TODO lists.
-\\{todo-mode-map}" t nil)
+\\{todo-mode-map}
+
+\(fn)" t nil)
(autoload (quote todo-cp) "todo-mode" "\
-Make a diary entry appear only in the current date's diary." nil nil)
+Make a diary entry appear only in the current date's diary.
+
+\(fn)" nil nil)
(autoload (quote todo-show) "todo-mode" "\
-Show TODO list." t nil)
+Show TODO list.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (tool-bar-add-item-from-menu tool-bar-add-item
-;;;;;; tool-bar-mode) "tool-bar" "toolbar/tool-bar.el" (15476 49243))
+;;;### (autoloads (tool-bar-local-item-from-menu tool-bar-add-item-from-menu
+;;;;;; tool-bar-local-item tool-bar-add-item tool-bar-mode) "tool-bar"
+;;;;;; "toolbar/tool-bar.el" (15678 51473))
;;; Generated autoloads from toolbar/tool-bar.el
(defvar tool-bar-mode nil "\
Setting this variable directly does not take effect;
use either \\[customize] or the function `tool-bar-mode'.")
-(custom-add-to-group (quote mouse) (quote tool-bar-mode) (quote custom-variable))
-
-(custom-add-load (quote tool-bar-mode) (quote tool-bar))
+(custom-autoload (quote tool-bar-mode) "tool-bar")
(autoload (quote tool-bar-mode) "tool-bar" "\
Toggle use of the tool bar.
With numeric ARG, display the tool bar if and only if ARG is positive.
-See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for
-conveniently adding tool bar items." t nil)
+See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for
+conveniently adding tool bar items.
+
+\(fn &optional ARG)" t nil)
+
+(put (quote tool-bar-mode) (quote standard-value) (quote (t)))
+
+(autoload (quote tool-bar-add-item) "tool-bar" "\
+Add an item to the tool bar.
+ICON names the image, DEF is the key definition and KEY is a symbol
+for the fake function key in the menu keymap. Remaining arguments
+PROPS are additional items to add to the menu item specification. See
+Info node `(elisp)Tool Bar'. Items are added from left to right.
+
+ICON is the base name of a file containing the image to use. The
+function will first try to use ICON.xpm, then ICON.pbm, and finally
+ICON.xbm, using `find-image'.
+
+Use this function only to make bindings in the global value of `tool-bar-map'.
+To define items in any other map, use `tool-bar-local-item'.
-(put (quote tool-bar-mode) (quote standard-value) (quote (t)))
+\(fn ICON DEF KEY &rest PROPS)" nil nil)
-(autoload (quote tool-bar-add-item) "tool-bar" "\
-Add an item to the tool bar.
+(autoload (quote tool-bar-local-item) "tool-bar" "\
+Add an item to the tool bar in map MAP.
ICON names the image, DEF is the key definition and KEY is a symbol
for the fake function key in the menu keymap. Remaining arguments
PROPS are additional items to add to the menu item specification. See
function will first try to use ICON.xpm, then ICON.pbm, and finally
ICON.xbm, using `find-image'.
-Keybindings are made in the map `tool-bar-map'. To define items in
-some local map, bind `tool-bar-map' with `let' around calls of this
-function." nil nil)
+\(fn ICON DEF KEY MAP &rest PROPS)" nil nil)
(autoload (quote tool-bar-add-item-from-menu) "tool-bar" "\
Define tool bar binding for COMMAND using the given ICON in keymap MAP.
-The binding of COMMAND is looked up in the menu bar in MAP (default
-`global-map') and modified to add an image specification for ICON, which
-is looked for as by `tool-bar-add-item'.
-MAP must contain an appropriate keymap bound to `[menu-bar]'.
-PROPS is a list of additional properties to add to the binding.
+This makes a binding for COMMAND in `tool-bar-map', copying its
+binding from the menu bar in MAP (which defaults to `global-map'), but
+modifies the binding by adding an image specification for ICON. It
+finds ICON just like `tool-bar-add-item'. PROPS are additional
+properties to add to the binding.
+
+MAP must contain appropriate binding for `[menu-bar]' which holds a keymap.
+
+Use this function only to make bindings in the global value of `tool-bar-map'.
+To define items in any other map, use `tool-bar-local-item'.
+
+\(fn COMMAND ICON &optional MAP &rest PROPS)" nil nil)
+
+(autoload (quote tool-bar-local-item-from-menu) "tool-bar" "\
+Define tool bar binding for COMMAND using the given ICON in keymap MAP.
+This makes a binding for COMMAND in IN-MAP, copying its binding from
+the menu bar in FROM-MAP (which defaults to `global-map'), but
+modifies the binding by adding an image specification for ICON. It
+finds ICON just like `tool-bar-add-item'. PROPS are additional
+properties to add to the binding.
+
+MAP must contain appropriate binding for `[menu-bar]' which holds a keymap.
-Keybindings are made in the map `tool-bar-map'. To define items in
-some local map, bind `tool-bar-map' with `let' around calls of this
-function." nil nil)
+\(fn COMMAND ICON IN-MAP &optional FROM-MAP &rest PROPS)" nil nil)
;;;***
\f
;;;### (autoloads (tooltip-mode tooltip-mode) "tooltip" "tooltip.el"
-;;;;;; (15427 61506))
+;;;;;; (16162 11942))
;;; Generated autoloads from tooltip.el
(autoload (quote tooltip-mode) "tooltip" "\
Mode for tooltip display.
-With ARG, turn tooltip mode on if and only if ARG is positive." t nil)
+With ARG, turn tooltip mode on if and only if ARG is positive.
+
+\(fn &optional ARG)" t nil)
(defvar tooltip-mode nil "\
Toggle tooltip-mode.
Setting this variable directly does not take effect;
use either \\[customize] or the function `tooltip-mode'.")
-(custom-add-to-group (quote tooltip) (quote tooltip-mode) (quote custom-variable))
-
-(custom-add-load (quote tooltip-mode) (quote tooltip))
+(custom-autoload (quote tooltip-mode) "tooltip")
;;;***
\f
-;;;### (autoloads (tpu-edt-on) "tpu-edt" "emulation/tpu-edt.el" (15417
-;;;;;; 7421))
+;;;### (autoloads (tpu-edt-on) "tpu-edt" "emulation/tpu-edt.el" (15678
+;;;;;; 51469))
;;; Generated autoloads from emulation/tpu-edt.el
(defalias (quote tpu-edt-mode) (quote tpu-edt-on))
(defalias (quote tpu-edt) (quote tpu-edt-on))
(autoload (quote tpu-edt-on) "tpu-edt" "\
-Turn on TPU/edt emulation." t nil)
+Turn on TPU/edt emulation.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins)
-;;;;;; "tpu-extras" "emulation/tpu-extras.el" (15371 46419))
+;;;;;; "tpu-extras" "emulation/tpu-extras.el" (15188 565))
;;; Generated autoloads from emulation/tpu-extras.el
(autoload (quote tpu-set-scroll-margins) "tpu-extras" "\
-Set scroll margins." t nil)
+Set scroll margins.
+
+\(fn TOP BOTTOM)" t nil)
(autoload (quote tpu-set-cursor-free) "tpu-extras" "\
-Allow the cursor to move freely about the screen." t nil)
+Allow the cursor to move freely about the screen.
+
+\(fn)" t nil)
(autoload (quote tpu-set-cursor-bound) "tpu-extras" "\
-Constrain the cursor to the flow of the text." t nil)
+Constrain the cursor to the flow of the text.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (tq-create) "tq" "emacs-lisp/tq.el" (15371 46419))
+;;;### (autoloads (tq-create) "tq" "emacs-lisp/tq.el" (15961 24152))
;;; Generated autoloads from emacs-lisp/tq.el
(autoload (quote tq-create) "tq" "\
Create and return a transaction queue communicating with PROCESS.
PROCESS should be a subprocess capable of sending and receiving
streams of bytes. It may be a local process, or it may be connected
-to a tcp server on another machine." nil nil)
+to a tcp server on another machine.
+
+\(fn PROCESS)" nil nil)
;;;***
\f
;;;### (autoloads (trace-function-background trace-function trace-buffer)
-;;;;;; "trace" "emacs-lisp/trace.el" (15371 46419))
+;;;;;; "trace" "emacs-lisp/trace.el" (15763 44953))
;;; Generated autoloads from emacs-lisp/trace.el
(defvar trace-buffer "*trace-output*" "\
*Trace output will by default go to that buffer.")
+(custom-autoload (quote trace-buffer) "trace")
+
(autoload (quote trace-function) "trace" "\
Traces FUNCTION with trace output going to BUFFER.
For every call of FUNCTION Lisp-style trace messages that display argument
-and return values will be inserted into BUFFER. This function generates the
+and return values will be inserted into BUFFER. This function generates the
trace advice for FUNCTION and activates it together with any other advice
there might be!! The trace BUFFER will popup whenever FUNCTION is called.
Do not use this to trace functions that switch buffers or do any other
-display oriented stuff, use `trace-function-background' instead." t nil)
+display oriented stuff, use `trace-function-background' instead.
+
+\(fn FUNCTION &optional BUFFER)" t nil)
(autoload (quote trace-function-background) "trace" "\
Traces FUNCTION with trace output going quietly to BUFFER.
For every call of FUNCTION Lisp-style trace messages that display argument
-and return values will be inserted into BUFFER. This function generates the
+and return values will be inserted into BUFFER. This function generates the
trace advice for FUNCTION and activates it together with any other advice
there might be!! Trace output will quietly go to BUFFER without changing
-the window or buffer configuration at all." t nil)
+the window or buffer configuration at all.
+
+\(fn FUNCTION &optional BUFFER)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (tramp-completion-file-name-handler tramp-file-name-handler
+;;;;;; tramp-completion-file-name-regexp tramp-file-name-regexp)
+;;;;;; "tramp" "net/tramp.el" (16162 11943))
+;;; Generated autoloads from net/tramp.el
+
+(defvar tramp-unified-filenames (not (featurep (quote xemacs))) "\
+Non-nil means to use unified Ange-FTP/Tramp filename syntax.
+Nil means to use a separate filename syntax for Tramp.")
+
+(defconst tramp-file-name-regexp-unified "\\`/[^/:]+:" "\
+Value for `tramp-file-name-regexp' for unified remoting.
+Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
+Tramp. See `tramp-file-name-structure-unified' for more explanations.")
+
+(defconst tramp-file-name-regexp-separate "\\`/\\[.*\\]" "\
+Value for `tramp-file-name-regexp' for separate remoting.
+XEmacs uses a separate filename syntax for Tramp and EFS.
+See `tramp-file-name-structure-separate' for more explanations.")
+
+(defvar tramp-file-name-regexp (if tramp-unified-filenames tramp-file-name-regexp-unified tramp-file-name-regexp-separate) "\
+*Regular expression matching file names handled by tramp.
+This regexp should match tramp file names but no other file names.
+\(When tramp.el is loaded, this regular expression is prepended to
+`file-name-handler-alist', and that is searched sequentially. Thus,
+if the tramp entry appears rather early in the `file-name-handler-alist'
+and is a bit too general, then some files might be considered tramp
+files which are not really tramp files.
+
+Please note that the entry in `file-name-handler-alist' is made when
+this file (tramp.el) is loaded. This means that this variable must be set
+before loading tramp.el. Alternatively, `file-name-handler-alist' can be
+updated after changing this variable.
+
+Also see `tramp-file-name-structure'.")
+
+(custom-autoload (quote tramp-file-name-regexp) "tramp")
+
+(defconst tramp-completion-file-name-regexp-unified "^/[^/]*$" "\
+Value for `tramp-completion-file-name-regexp' for unified remoting.
+Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
+Tramp. See `tramp-file-name-structure-unified' for more explanations.")
+
+(defconst tramp-completion-file-name-regexp-separate "^/\\([[][^]]*\\)?$" "\
+Value for `tramp-completion-file-name-regexp' for separate remoting.
+XEmacs uses a separate filename syntax for Tramp and EFS.
+See `tramp-file-name-structure-separate' for more explanations.")
+
+(defvar tramp-completion-file-name-regexp (if tramp-unified-filenames tramp-completion-file-name-regexp-unified tramp-completion-file-name-regexp-separate) "\
+*Regular expression matching file names handled by tramp completion.
+This regexp should match partial tramp file names only.
+
+Please note that the entry in `file-name-handler-alist' is made when
+this file (tramp.el) is loaded. This means that this variable must be set
+before loading tramp.el. Alternatively, `file-name-handler-alist' can be
+updated after changing this variable.
+
+Also see `tramp-file-name-structure'.")
+
+(custom-autoload (quote tramp-completion-file-name-regexp) "tramp")
+
+(autoload (quote tramp-file-name-handler) "tramp" "\
+Invoke Tramp file name handler.
+Falls back to normal file name handler if no tramp file name handler exists.
+
+\(fn OPERATION &rest ARGS)" nil nil)
+
+(put (quote tramp-file-name-handler) (quote file-remote-p) t)
+
+(autoload (quote tramp-completion-file-name-handler) "tramp" "\
+Invoke tramp file name completion handler.
+Falls back to normal file name handler if no tramp file name handler exists.
+
+\(fn OPERATION &rest ARGS)" nil nil)
+
+(put (quote tramp-completion-file-name-handler) (quote safe-magic) t)
+
+(add-to-list (quote file-name-handler-alist) (cons tramp-file-name-regexp (quote tramp-file-name-handler)))
;;;***
\f
;;;### (autoloads (2C-split 2C-associate-buffer 2C-two-columns) "two-column"
-;;;;;; "textmodes/two-column.el" (15371 46417))
+;;;;;; "textmodes/two-column.el" (16162 11944))
;;; Generated autoloads from textmodes/two-column.el
(autoload '2C-command "two-column" () t 'keymap)
(global-set-key "\C-x6" '2C-command)
buffer in two-column minor mode (see \\[describe-mode] ).
Runs `2C-other-buffer-hook' in the new buffer.
When called again, restores the screen layout with the current buffer
-first and the associated buffer to its right." t nil)
+first and the associated buffer to its right.
+
+\(fn &optional BUFFER)" t nil)
(autoload (quote 2C-associate-buffer) "two-column" "\
Associate another buffer with this one in two-column minor mode.
Can also be used to associate a just previously visited file, by
accepting the proposed default buffer.
-\(See \\[describe-mode] .)" t nil)
+\(See \\[describe-mode] .)
+
+\(fn)" t nil)
(autoload (quote 2C-split) "two-column" "\
Split a two-column text at point, into two buffers in two-column minor mode.
/ \\
5 character Separator You type M-5 \\[2C-split] with the point here.
-\(See \\[describe-mode] .)" t nil)
+\(See \\[describe-mode] .)
+
+\(fn ARG)" t nil)
;;;***
\f
;;;### (autoloads (type-break-guesstimate-keystroke-threshold type-break-statistics
;;;;;; type-break type-break-mode type-break-keystroke-threshold
;;;;;; type-break-good-rest-interval type-break-interval type-break-mode)
-;;;;;; "type-break" "type-break.el" (15371 46418))
+;;;;;; "type-break" "type-break.el" (16111 41826))
;;; Generated autoloads from type-break.el
(defvar type-break-mode nil "\
Setting this variable directly does not take effect;
use either \\[customize] or the function `type-break-mode'.")
-(custom-add-to-group (quote type-break) (quote type-break-mode) (quote custom-variable))
-
-(custom-add-load (quote type-break-mode) (quote type-break))
+(custom-autoload (quote type-break-mode) "type-break")
(defvar type-break-interval (* 60 60) "\
*Number of seconds between scheduled typing breaks.")
+(custom-autoload (quote type-break-interval) "type-break")
+
(defvar type-break-good-rest-interval (/ type-break-interval 6) "\
*Number of seconds of idle time considered to be an adequate typing rest.
-When this variable is non-`nil', emacs checks the idle time between
+When this variable is non-nil, emacs checks the idle time between
keystrokes. If this idle time is long enough to be considered a \"good\"
rest from typing, then the next typing break is simply rescheduled for later.
If a break is interrupted before this much time elapses, the user will be
asked whether or not really to interrupt the break.")
+(custom-autoload (quote type-break-good-rest-interval) "type-break")
+
(defvar type-break-keystroke-threshold (let* ((wpm 35) (avg-word-length 5) (upper (* wpm avg-word-length (/ type-break-interval 60))) (lower (/ upper 5))) (cons lower upper)) "\
*Upper and lower bound on number of keystrokes for considering typing break.
This structure is a pair of numbers (MIN . MAX).
The command `type-break-guesstimate-keystroke-threshold' can be used to
guess a reasonably good pair of values for this variable.")
+(custom-autoload (quote type-break-keystroke-threshold) "type-break")
+
(autoload (quote type-break-mode) "type-break" "\
Enable or disable typing-break mode.
This is a minor mode, but it is global to all buffers by default.
`type-break-query-function'
`type-break-query-interval'
-Finally, the command `type-break-statistics' prints interesting things." t nil)
+Finally, the command `type-break-statistics' prints interesting things.
+
+\(fn &optional PREFIX)" t nil)
(autoload (quote type-break) "type-break" "\
Take a typing break.
`type-break-demo-functions' is run.
After the typing break is finished, the next break is scheduled
-as per the function `type-break-schedule'." t nil)
+as per the function `type-break-schedule'.
+
+\(fn)" t nil)
(autoload (quote type-break-statistics) "type-break" "\
Print statistics about typing breaks in a temporary buffer.
This includes the last time a typing break was taken, when the next one is
-scheduled, the keystroke thresholds and the current keystroke count, etc." t nil)
+scheduled, the keystroke thresholds and the current keystroke count, etc.
+
+\(fn)" t nil)
(autoload (quote type-break-guesstimate-keystroke-threshold) "type-break" "\
Guess values for the minimum/maximum keystroke threshold for typing breaks.
used to override the default assumption about average word length and the
fraction of the maximum threshold to which to set the minimum threshold.
FRAC should be the inverse of the fractional value; for example, a value of
-2 would mean to use one half, a value of 4 would mean to use one quarter, etc." t nil)
+2 would mean to use one half, a value of 4 would mean to use one quarter, etc.
+
+\(fn WPM &optional WORDLEN FRAC)" t nil)
;;;***
\f
;;;### (autoloads (ununderline-region underline-region) "underline"
-;;;;;; "textmodes/underline.el" (15371 46417))
+;;;;;; "textmodes/underline.el" (15186 43697))
;;; Generated autoloads from textmodes/underline.el
(autoload (quote underline-region) "underline" "\
Underline all nonblank characters in the region.
Works by overstriking underscores.
Called from program, takes two arguments START and END
-which specify the range to operate on." t nil)
+which specify the range to operate on.
+
+\(fn START END)" t nil)
(autoload (quote ununderline-region) "underline" "\
Remove all underlining (overstruck underscores) in the region.
Called from program, takes two arguments START and END
-which specify the range to operate on." t nil)
+which specify the range to operate on.
+
+\(fn START END)" t nil)
;;;***
\f
;;;### (autoloads (unforward-rmail-message undigestify-rmail-message)
-;;;;;; "undigest" "mail/undigest.el" (15371 46424))
+;;;;;; "undigest" "mail/undigest.el" (15961 24154))
;;; Generated autoloads from mail/undigest.el
(autoload (quote undigestify-rmail-message) "undigest" "\
Break up a digest message into its constituent messages.
-Leaves original message, deleted, before the undigestified messages." t nil)
+Leaves original message, deleted, before the undigestified messages.
+
+\(fn)" t nil)
(autoload (quote unforward-rmail-message) "undigest" "\
Extract a forwarded message from the containing message.
This puts the forwarded message into a separate rmail message
-following the containing message." t nil)
+following the containing message.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (unrmail batch-unrmail) "unrmail" "mail/unrmail.el"
-;;;;;; (15371 46424))
+;;;;;; (15764 7537))
;;; Generated autoloads from mail/unrmail.el
(autoload (quote batch-unrmail) "unrmail" "\
Specify the input Rmail file names as command line arguments.
For each Rmail file, the corresponding output file name
is made by adding `.mail' at the end.
-For example, invoke `emacs -batch -f batch-unrmail RMAIL'." nil nil)
+For example, invoke `emacs -batch -f batch-unrmail RMAIL'.
+
+\(fn)" nil nil)
(autoload (quote unrmail) "unrmail" "\
-Convert Rmail file FILE to system inbox format file TO-FILE." t nil)
+Convert Rmail file FILE to system inbox format file TO-FILE.
+
+\(fn FILE TO-FILE)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (unsafep) "unsafep" "emacs-lisp/unsafep.el" (16162
+;;;;;; 11942))
+;;; Generated autoloads from emacs-lisp/unsafep.el
+
+(autoload (quote unsafep) "unsafep" "\
+Return nil if evaluating FORM couldn't possibly do any harm;
+otherwise result is a reason why FORM is unsafe. UNSAFEP-VARS is a list
+of symbols with local bindings.
+
+\(fn FORM &optional UNSAFEP-VARS)" nil nil)
;;;***
\f
;;;### (autoloads (ask-user-about-supersession-threat ask-user-about-lock)
-;;;;;; "userlock" "userlock.el" (15371 46418))
+;;;;;; "userlock" "userlock.el" (15781 48897))
;;; Generated autoloads from userlock.el
(autoload (quote ask-user-about-lock) "userlock" "\
return t (grab the lock on the file)
return nil (edit the file even though it is locked).
You can redefine this function to choose among those three alternatives
-in any way you like." nil nil)
+in any way you like.
+
+\(fn FILE OPPONENT)" nil nil)
(autoload (quote ask-user-about-supersession-threat) "userlock" "\
Ask a user who is about to modify an obsolete buffer what to do.
in which case the proposed buffer modification will not be made.
You can rewrite this to use any criterion you like to choose which one to do.
-The buffer in question is current when this function is called." nil nil)
+The buffer in question is current when this function is called.
+
+\(fn FN)" nil nil)
;;;***
\f
;;;### (autoloads (uudecode-decode-region uudecode-decode-region-external)
-;;;;;; "uudecode" "gnus/uudecode.el" (15371 46421))
+;;;;;; "uudecode" "gnus/uudecode.el" (15186 43690))
;;; Generated autoloads from gnus/uudecode.el
(autoload (quote uudecode-decode-region-external) "uudecode" "\
Uudecode region between START and END using external program.
If FILE-NAME is non-nil, save the result to FILE-NAME. The program
-used is specified by `uudecode-decoder-program'." t nil)
+used is specified by `uudecode-decoder-program'.
+
+\(fn START END &optional FILE-NAME)" t nil)
(autoload (quote uudecode-decode-region) "uudecode" "\
Uudecode region between START and END without using an external program.
-If FILE-NAME is non-nil, save the result to FILE-NAME." t nil)
+If FILE-NAME is non-nil, save the result to FILE-NAME.
+
+\(fn START END &optional FILE-NAME)" t nil)
;;;***
\f
;;;### (autoloads (vc-annotate vc-update-change-log vc-rename-file
-;;;;;; vc-transfer-file vc-switch-backend vc-cancel-version vc-revert-buffer
-;;;;;; vc-print-log vc-retrieve-snapshot vc-create-snapshot vc-directory
-;;;;;; vc-resolve-conflicts vc-merge vc-insert-headers vc-version-other-window
+;;;;;; vc-transfer-file vc-switch-backend vc-cancel-version vc-update
+;;;;;; vc-revert-buffer vc-print-log vc-retrieve-snapshot vc-create-snapshot
+;;;;;; vc-directory vc-merge vc-insert-headers vc-version-other-window
;;;;;; vc-diff vc-register vc-next-action vc-do-command edit-vc-file
-;;;;;; with-vc-file vc-before-checkin-hook vc-checkin-hook vc-checkout-hook)
-;;;;;; "vc" "vc.el" (15482 46099))
+;;;;;; with-vc-file vc-branch-part vc-before-checkin-hook vc-checkin-hook
+;;;;;; vc-checkout-hook) "vc" "vc.el" (16139 21084))
;;; Generated autoloads from vc.el
(defvar vc-checkout-hook nil "\
*Normal hook (list of functions) run after checking out a file.
See `run-hooks'.")
+(custom-autoload (quote vc-checkout-hook) "vc")
+
(defvar vc-checkin-hook nil "\
*Normal hook (list of functions) run after a checkin is done.
-See `run-hooks'.")
+See also `log-edit-done-hook'.")
+
+(custom-autoload (quote vc-checkin-hook) "vc")
(defvar vc-before-checkin-hook nil "\
*Normal hook (list of functions) run before a file is checked in.
See `run-hooks'.")
+(custom-autoload (quote vc-before-checkin-hook) "vc")
+
+(autoload (quote vc-branch-part) "vc" "\
+Return the branch part of a revision number REV.
+
+\(fn REV)" nil nil)
+
(autoload (quote with-vc-file) "vc" "\
Check out a writable copy of FILE if necessary, then execute BODY.
Check in FILE with COMMENT (a string) after BODY has been executed.
FILE is passed through `expand-file-name'; BODY executed within
`save-excursion'. If FILE is not under version control, or locked by
-somebody else, signal error." nil (quote macro))
+somebody else, signal error.
+
+\(fn FILE COMMENT &rest BODY)" nil (quote macro))
(autoload (quote edit-vc-file) "vc" "\
Edit FILE under version control, executing body.
Checkin with COMMENT after executing BODY.
This macro uses `with-vc-file', passing args to it.
-However, before executing BODY, find FILE, and after BODY, save buffer." nil (quote macro))
+However, before executing BODY, find FILE, and after BODY, save buffer.
+
+\(fn FILE COMMENT &rest BODY)" nil (quote macro))
(autoload (quote vc-do-command) "vc" "\
Execute a VC command, notifying user and checking for errors.
means not to wait for termination of the subprocess). FILE is the
name of the working file (may also be nil, to execute commands that
don't expect a file name). If an optional list of FLAGS is present,
-that is inserted into the command line before the filename." nil nil)
+that is inserted into the command line before the filename.
+
+\(fn BUFFER OKSTATUS COMMAND FILE &rest FLAGS)" nil nil)
(autoload (quote vc-next-action) "vc" "\
Do the next logical version control operation on the current file.
message has been entered, it checks in the resulting changes along
with the logmessage as change commentary. A writable file is retained.
If the repository file is changed, you are asked if you want to
-merge in the changes into your working copy." t nil)
+merge in the changes into your working copy.
+
+\(fn VERBOSE)" t nil)
(autoload (quote vc-register) "vc" "\
Register the current file into a version control system.
itself responsible for the file (usually because other files in that
directory are already registered under that backend) will be used to
register the file. If no backend declares itself responsible, the
-first backend that could register the file is used." t nil)
+first backend that could register the file is used.
+
+\(fn &optional SET-VERSION COMMENT)" t nil)
(autoload (quote vc-diff) "vc" "\
Display diffs between file versions.
a prefix argument HISTORIC, it reads the file name to use and two
version designators specifying which versions to compare. The
optional argument NOT-URGENT non-nil means it is ok to say no to
-saving the buffer." t nil)
+saving the buffer.
+
+\(fn HISTORIC &optional NOT-URGENT)" t nil)
(autoload (quote vc-version-other-window) "vc" "\
Visit version REV of the current file in another window.
If the current file is named `F', the version is named `F.~REV~'.
-If `F.~REV~' already exists, use it instead of checking it out again." t nil)
+If `F.~REV~' already exists, use it instead of checking it out again.
+
+\(fn REV)" t nil)
(autoload (quote vc-insert-headers) "vc" "\
Insert headers into a file for use with a version control system.
Headers desired are inserted at point, and are pulled from
-the variable `vc-BACKEND-header'." t nil)
+the variable `vc-BACKEND-header'.
+
+\(fn)" t nil)
(autoload (quote vc-merge) "vc" "\
Merge changes between two versions into the current buffer's file.
branch. If the first version is empty, merge news, i.e. recent changes
from the current branch.
-See Info node `Merging'." t nil)
+See Info node `Merging'.
-(autoload (quote vc-resolve-conflicts) "vc" "\
-Invoke ediff to resolve conflicts in the current buffer.
-The conflicts must be marked with rcsmerge conflict markers." t nil)
+\(fn)" t nil)
+
+(defalias (quote vc-resolve-conflicts) (quote smerge-ediff))
(autoload (quote vc-directory) "vc" "\
Create a buffer in VC Dired Mode for directory DIR.
See Info node `VC Dired Mode'.
With prefix arg READ-SWITCHES, specify a value to override
-`dired-listing-switches' when generating the listing." t nil)
+`dired-listing-switches' when generating the listing.
+
+\(fn DIR READ-SWITCHES)" t nil)
(autoload (quote vc-create-snapshot) "vc" "\
Descending recursively from DIR, make a snapshot called NAME.
For each registered file, the version level of its latest version
becomes part of the named configuration. If the prefix argument
BRANCHP is given, the snapshot is made as a new branch and the files
-are checked out in that new branch." t nil)
+are checked out in that new branch.
+
+\(fn DIR NAME BRANCHP)" t nil)
(autoload (quote vc-retrieve-snapshot) "vc" "\
Descending recursively from DIR, retrieve the snapshot called NAME.
If NAME is empty, it refers to the latest versions.
If locking is used for the files in DIR, then there must not be any
locked files at or below DIR (but if NAME is empty, locked files are
-allowed and simply skipped)." t nil)
+allowed and simply skipped).
+
+\(fn DIR NAME)" t nil)
(autoload (quote vc-print-log) "vc" "\
-List the change log of the current buffer in a window." t nil)
+List the change log of the current buffer in a window.
+
+\(fn)" t nil)
(autoload (quote vc-revert-buffer) "vc" "\
Revert the current buffer's file to the version it was based on.
This asks for confirmation if the buffer contents are not identical
to that version. This function does not automatically pick up newer
-changes found in the master file; use \\[universal-argument] \\[vc-next-action] to do so." t nil)
+changes found in the master file; use \\[universal-argument] \\[vc-next-action] to do so.
+
+\(fn)" t nil)
+
+(autoload (quote vc-update) "vc" "\
+Update the current buffer's file to the latest version on its branch.
+If the file contains no changes, and is not locked, then this simply replaces
+the working file with the latest version on its branch. If the file contains
+changes, and the backend supports merging news, then any recent changes from
+the current branch are merged into the working file.
+
+\(fn)" t nil)
(autoload (quote vc-cancel-version) "vc" "\
Get rid of most recently checked in version of this file.
-A prefix argument NOREVERT means do not revert the buffer afterwards." t nil)
+A prefix argument NOREVERT means do not revert the buffer afterwards.
+
+\(fn NOREVERT)" t nil)
(autoload (quote vc-switch-backend) "vc" "\
Make BACKEND the current version control system for FILE.
permanent, only for the current session. This function only changes
VC's perspective on FILE, it does not register or unregister it.
By default, this command cycles through the registered backends.
-To get a prompt, use a prefix argument." t nil)
+To get a prompt, use a prefix argument.
+
+\(fn FILE BACKEND)" t nil)
(autoload (quote vc-transfer-file) "vc" "\
Transfer FILE to another version control system NEW-BACKEND.
base level. If NEW-BACKEND has a lower precedence than the current
backend, then commit all changes that were made under the current
backend to NEW-BACKEND, and unregister FILE from the current backend.
-\(If FILE is not yet registered under NEW-BACKEND, register it.)" nil nil)
+\(If FILE is not yet registered under NEW-BACKEND, register it.)
+
+\(fn FILE NEW-BACKEND)" nil nil)
(autoload (quote vc-rename-file) "vc" "\
-Rename file OLD to NEW, and rename its master file likewise." t nil)
+Rename file OLD to NEW, and rename its master file likewise.
+
+\(fn OLD NEW)" t nil)
(autoload (quote vc-update-change-log) "vc" "\
Find change log file and add entries from recent version control logs.
log for the default directory, which may not be appropriate.
From a program, any ARGS are assumed to be filenames for which
-log entries should be gathered." t nil)
+log entries should be gathered.
+
+\(fn &rest ARGS)" t nil)
(autoload (quote vc-annotate) "vc" "\
Display the edit history of the current file using colours.
`vc-annotate-menu-elements' customizes the menu elements of the
mode-specific menu. `vc-annotate-color-map' and
`vc-annotate-very-old-color' defines the mapping of time to
-colors. `vc-annotate-background' specifies the background color." t nil)
+colors. `vc-annotate-background' specifies the background color.
+
+\(fn PREFIX)" t nil)
;;;***
\f
-;;;### (autoloads nil "vc-cvs" "vc-cvs.el" (15482 46252))
+;;;### (autoloads nil "vc-cvs" "vc-cvs.el" (16136 53054))
;;; Generated autoloads from vc-cvs.el
(defun vc-cvs-registered (f)
(when (file-readable-p (expand-file-name
"CVS/Entries" (file-name-directory f)))
- (require 'vc-cvs)
+ (load "vc-cvs")
(vc-cvs-registered f)))
+;;;***
+\f
+;;;### (autoloads nil "vc-mcvs" "vc-mcvs.el" (16070 35807))
+;;; Generated autoloads from vc-mcvs.el
+ (defun vc-mcvs-registered (file)
+ (let ((dir file))
+ (while (and (stringp dir)
+ (not (equal
+ dir (setq dir (file-name-directory dir))))
+ dir)
+ (setq dir (if (file-directory-p
+ (expand-file-name "MCVS/CVS" dir))
+ t (directory-file-name dir))))
+ (if (eq dir t)
+ (progn
+ (load "vc-mcvs")
+ (vc-mcvs-registered file)))))
+
;;;***
\f
;;;### (autoloads (vc-rcs-master-templates) "vc-rcs" "vc-rcs.el"
-;;;;;; (15482 46317))
+;;;;;; (16070 35807))
;;; Generated autoloads from vc-rcs.el
(defvar vc-rcs-master-templates (quote ("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) "\
*Where to look for RCS master files.
For a description of possible values, see `vc-check-master-templates'.")
-(defun vc-rcs-registered (f) (vc-default-registered (quote RCS) f))
+(custom-autoload (quote vc-rcs-master-templates) "vc-rcs")
+ (defun vc-rcs-registered (f) (vc-default-registered 'RCS f))
;;;***
\f
;;;### (autoloads (vc-sccs-master-templates) "vc-sccs" "vc-sccs.el"
-;;;;;; (15482 46364))
+;;;;;; (16070 35807))
;;; Generated autoloads from vc-sccs.el
(defvar vc-sccs-master-templates (quote ("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) "\
*Where to look for SCCS master files.
For a description of possible values, see `vc-check-master-templates'.")
-(defun vc-sccs-registered (f) (vc-default-registered (quote SCCS) f))
+(custom-autoload (quote vc-sccs-master-templates) "vc-sccs")
+ (defun vc-sccs-registered(f) (vc-default-registered 'SCCS f))
(defun vc-sccs-search-project-dir (dirname basename) "\
Return the name of a master file in the SCCS project directory.
Does not check whether the file exists but returns nil if it does not
find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) (when project-dir (if (file-name-absolute-p project-dir) (setq dirs (quote ("SCCS" ""))) (setq dirs (quote ("src/SCCS" "src" "source/SCCS" "source"))) (setq project-dir (expand-file-name (concat "~" project-dir)))) (while (and (not dir) dirs) (setq dir (expand-file-name (car dirs) project-dir)) (unless (file-directory-p dir) (setq dir nil) (setq dirs (cdr dirs)))) (and dir (expand-file-name (concat "s." basename) dir)))))
+;;;***
+\f
+;;;### (autoloads nil "vc-svn" "vc-svn.el" (16162 11942))
+;;; Generated autoloads from vc-svn.el
+ (defun vc-svn-registered (f)
+ (when (file-readable-p (expand-file-name
+ ".svn/entries" (file-name-directory f)))
+ (load "vc-svn")
+ (vc-svn-registered f)))
+
+(add-to-list (quote completion-ignored-extensions) ".svn/")
+
;;;***
\f
;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el"
-;;;;;; (15444 42464))
+;;;;;; (15997 673))
;;; Generated autoloads from progmodes/vhdl-mode.el
(autoload (quote vhdl-mode) "vhdl-mode" "\
Usage:
------
-- TEMPLATE INSERTION (electrification): After typing a VHDL keyword and
- entering `\\[vhdl-electric-space]', you are prompted for arguments while a template is generated
- for that VHDL construct. Typing `\\[vhdl-electric-return]' or `\\[keyboard-quit]' at the first (mandatory)
- prompt aborts the current template generation. Optional arguments are
- indicated by square brackets and removed if the queried string is left empty.
- Prompts for mandatory arguments remain in the code if the queried string is
- left empty. They can be queried again by `\\[vhdl-template-search-prompt]'.
- Typing `\\[just-one-space]' after a keyword inserts a space without calling the template
- generator. Automatic template generation (i.e. electrification) can be
- disabled (enabled) by typing `\\[vhdl-electric-mode]' or by setting custom variable
- `vhdl-electric-mode' (see CUSTOMIZATION).
- Enabled electrification is indicated by `/e' in the modeline.
- Template generators can be invoked from the VHDL menu, by key bindings, by
- typing `C-c C-i C-c' and choosing a construct, or by typing the keyword (i.e.
- first word of menu entry not in parenthesis) and `\\[vhdl-electric-space]'.
- The following abbreviations can also be used:
- arch, attr, cond, conf, comp, cons, func, inst, pack, sig, var.
- Template styles can be customized in customization group `vhdl-electric'
- (see CUSTOMIZATION).
-
-- HEADER INSERTION: A file header can be inserted by `\\[vhdl-template-header]'. A
- file footer (template at the end of the file) can be inserted by
- `\\[vhdl-template-footer]'. See customization group `vhdl-header'.
-
-- STUTTERING: Double striking of some keys inserts cumbersome VHDL syntax
- elements. Stuttering can be disabled (enabled) by typing `\\[vhdl-stutter-mode]' or by
- variable `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in
- the modeline. The stuttering keys and their effects are:
- ;; --> \" : \" [ --> ( -- --> comment
- ;;; --> \" := \" [[ --> [ --CR --> comment-out code
- .. --> \" => \" ] --> ) --- --> horizontal line
- ,, --> \" <= \" ]] --> ] ---- --> display comment
- == --> \" == \" '' --> \\\"
-
-- WORD COMPLETION: Typing `\\[vhdl-electric-tab]' after a (not completed) word looks for a VHDL
- keyword or a word in the buffer that starts alike, inserts it and adjusts
- case. Re-typing `\\[vhdl-electric-tab]' toggles through alternative word completions.
- This also works in the minibuffer (i.e. in template generator prompts).
- Typing `\\[vhdl-electric-tab]' after `(' looks for and inserts complete parenthesized
- expressions (e.g. for array index ranges). All keywords as well as standard
- types and subprograms of VHDL have predefined abbreviations (e.g. type \"std\"
- and `\\[vhdl-electric-tab]' will toggle through all standard types beginning with \"std\").
-
- Typing `\\[vhdl-electric-tab]' after a non-word character indents the line if at the beginning
- of a line (i.e. no preceding non-blank characters),and inserts a tabulator
- stop otherwise. `\\[tab-to-tab-stop]' always inserts a tabulator stop.
-
-- COMMENTS:
- `--' puts a single comment.
- `---' draws a horizontal line for separating code segments.
- `----' inserts a display comment, i.e. two horizontal lines with a
- comment in between.
- `--CR' comments out code on that line. Re-hitting CR comments out
- following lines.
- `\\[vhdl-comment-uncomment-region]' comments out a region if not commented out,
- uncomments a region if already commented out.
-
- You are prompted for comments after object definitions (i.e. signals,
- variables, constants, ports) and after subprogram and process specifications
- if variable `vhdl-prompt-for-comments' is non-nil. Comments are
- automatically inserted as additional labels (e.g. after begin statements) and
- as help comments if `vhdl-self-insert-comments' is non-nil.
- Inline comments (i.e. comments after a piece of code on the same line) are
- indented at least to `vhdl-inline-comment-column'. Comments go at maximum to
- `vhdl-end-comment-column'. `\\[vhdl-electric-return]' after a space in a comment will open a
- new comment line. Typing beyond `vhdl-end-comment-column' in a comment
- automatically opens a new comment line. `\\[fill-paragraph]' re-fills
- multi-line comments.
-
-- INDENTATION: `\\[vhdl-electric-tab]' indents a line if at the beginning of the line.
- The amount of indentation is specified by variable `vhdl-basic-offset'.
- `\\[vhdl-indent-line]' always indents the current line (is bound to `TAB' if variable
- `vhdl-intelligent-tab' is nil). Indentation can be done for an entire region
- (`\\[vhdl-indent-region]') or buffer (menu). Argument and port lists are indented normally
- (nil) or relative to the opening parenthesis (non-nil) according to variable
- `vhdl-argument-list-indent'. If variable `vhdl-indent-tabs-mode' is nil,
- spaces are used instead of tabs. `\\[tabify]' and `\\[untabify]' allow
- to convert spaces to tabs and vice versa.
-
-- ALIGNMENT: The alignment functions align operators, keywords, and inline
- comment to beautify argument lists, port maps, etc. `\\[vhdl-align-group]' aligns a group
- of consecutive lines separated by blank lines. `\\[vhdl-align-noindent-region]' aligns an
- entire region. If variable `vhdl-align-groups' is non-nil, groups of code
- lines separated by empty lines are aligned individually. `\\[vhdl-align-inline-comment-group]' aligns
- inline comments for a group of lines, and `\\[vhdl-align-inline-comment-region]' for a region.
- Some templates are automatically aligned after generation if custom variable
- `vhdl-auto-align' is non-nil.
- `\\[vhdl-fixup-whitespace-region]' fixes up whitespace in a region. That is, operator symbols
- are surrounded by one space, and multiple spaces are eliminated.
-
-- PORT TRANSLATION: Generic and port clauses from entity or component
- declarations can be copied (`\\[vhdl-port-copy]') and pasted as entity and
- component declarations, as component instantiations and corresponding
- internal constants and signals, as a generic map with constants as actual
- parameters, and as a test bench (menu).
- A clause with several generic/port names on the same line can be flattened
- (`\\[vhdl-port-flatten]') so that only one name per line exists. Names for actual
- ports, instances, test benches, and design-under-test instances can be
- derived from existing names according to variables `vhdl-...-name'.
- Variables `vhdl-testbench-...' allow the insertion of additional templates
- into a test bench. New files are created for the test bench entity and
- architecture according to variable `vhdl-testbench-create-files'.
- See customization group `vhdl-port'.
-
-- TEST BENCH GENERATION: See PORT TRANSLATION.
-
-- KEY BINDINGS: Key bindings (`C-c ...') exist for most commands (see in
- menu).
-
-- VHDL MENU: All commands can be invoked from the VHDL menu.
-
-- FILE BROWSER: The speedbar allows browsing of directories and file contents.
- It can be accessed from the VHDL menu and is automatically opened if
- variable `vhdl-speedbar' is non-nil.
- In speedbar, open files and directories with `mouse-2' on the name and
- browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'.
-
-- DESIGN HIERARCHY BROWSER: The speedbar can also be used for browsing the
- hierarchy of design units contained in the source files of the current
- directory or in the source files/directories specified for a project (see
- variable `vhdl-project-alist').
- The speedbar can be switched between file and hierarchy browsing mode in the
- VHDL menu or by typing `f' and `h' in speedbar.
- In speedbar, open design units with `mouse-2' on the name and browse their
- hierarchy with `mouse-2' on the `+'. The hierarchy can be rescanned and
- ports directly be copied from entities by using the speedbar menu.
-
-- PROJECTS: Projects can be defined in variable `vhdl-project-alist' and a
- current project be selected using variable `vhdl-project' (permanently) or
- from the menu (temporarily). For each project, a title string (for the file
- headers) and source files/directories (for the hierarchy browser) can be
- specified.
-
-- SPECIAL MENUES: As an alternative to the speedbar, an index menu can
- be added (set variable `vhdl-index-menu' to non-nil) or made accessible
- as a mouse menu (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to
- your start-up file) for browsing the file contents. Also, a source file menu
- can be added (set variable `vhdl-source-file-menu' to non-nil) for browsing
- the current directory for VHDL source files.
-
-- SOURCE FILE COMPILATION: The syntax of the current buffer can be analyzed
- by calling a VHDL compiler (menu, `\\[vhdl-compile]'). The compiler to be used is
- specified by variable `vhdl-compiler'. The available compilers are listed
- in variable `vhdl-compiler-alist' including all required compilation command,
- destination directory, and error message syntax information. New compilers
- can be added. Additional compile command options can be set in variable
- `vhdl-compiler-options'.
- An entire hierarchy of source files can be compiled by the `make' command
- (menu, `\\[vhdl-make]'). This only works if an appropriate Makefile exists.
- The make command itself as well as a command to generate a Makefile can also
- be specified in variable `vhdl-compiler-alist'.
-
-- VHDL STANDARDS: The VHDL standards to be used are specified in variable
- `vhdl-standard'. Available standards are: VHDL'87/'93, VHDL-AMS,
- Math Packages.
-
-- KEYWORD CASE: Lower and upper case for keywords and standardized types,
- attributes, and enumeration values is supported. If the variable
- `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in lower
- case and are converted into upper case automatically (not for types,
- attributes, and enumeration values). The case of keywords, types,
- attributes,and enumeration values can be fixed for an entire region (menu)
- or buffer (`\\[vhdl-fix-case-buffer]') according to the variables
- `vhdl-upper-case-{keywords,types,attributes,enum-values}'.
-
-- HIGHLIGHTING (fontification): Keywords and standardized types, attributes,
- enumeration values, and function names (controlled by variable
- `vhdl-highlight-keywords'), as well as comments, strings, and template
- prompts are highlighted using different colors. Unit, subprogram, signal,
- variable, constant, parameter and generic/port names in declarations as well
- as labels are highlighted if variable `vhdl-highlight-names' is non-nil.
-
- Additional reserved words or words with a forbidden syntax (e.g. words that
- should be avoided) can be specified in variable `vhdl-forbidden-words' or
- `vhdl-forbidden-syntax' and be highlighted in a warning color (variable
- `vhdl-highlight-forbidden-words'). Verilog keywords are highlighted as
- forbidden words if variable `vhdl-highlight-verilog-keywords' is non-nil.
-
- Words with special syntax can be highlighted by specifying their syntax and
- color in variable `vhdl-special-syntax-alist' and by setting variable
- `vhdl-highlight-special-words' to non-nil. This allows to establish some
- naming conventions (e.g. to distinguish different kinds of signals or other
- objects by using name suffices) and to support them visually.
-
- Variable `vhdl-highlight-case-sensitive' can be set to non-nil in order to
- support case-sensitive highlighting. However, keywords are then only
- highlighted if written in lower case.
-
- Code between \"translate_off\" and \"translate_on\" pragmas is highlighted
- using a different background color if variable `vhdl-highlight-translate-off'
- is non-nil.
-
- All colors can be customized by command `\\[customize-face]'.
- For highlighting of matching parenthesis, see customization group
- `paren-showing' (`\\[customize-group]').
-
-- USER MODELS: VHDL models (templates) can be specified by the user and made
- accessible in the menu, through key bindings (`C-c C-m ...'), or by keyword
- electrification. See custom variable `vhdl-model-alist'.
-
-- HIDE/SHOW: The code of entire VHDL design units can be hidden using the
- `Hide/Show' menu or by pressing `S-mouse-2' within the code (variable
- `vhdl-hideshow-menu').
-
-- PRINTING: Postscript printing with different faces (an optimized set of
- faces is used if `vhdl-print-customize-faces' is non-nil) or colors
- (if `ps-print-color-p' is non-nil) is possible using the standard Emacs
- postscript printing commands. Variable `vhdl-print-two-column' defines
- appropriate default settings for nice landscape two-column printing. The
- paper format can be set by variable `ps-paper-type'. Do not forget to
- switch `ps-print-color-p' to nil for printing on black-and-white printers.
-
-- CUSTOMIZATION: All variables can easily be customized using the `Customize'
- menu entry or `\\[customize-option]' (`\\[customize-group]' for groups).
- Some customizations only take effect after some action (read the NOTE in
- the variable documentation). Customization can also be done globally (i.e.
- site-wide, read the INSTALL file).
-
-- FILE EXTENSIONS: As default, files with extensions \".vhd\" and \".vhdl\" are
- automatically recognized as VHDL source files. To add an extension \".xxx\",
- add the following line to your Emacs start-up file (`.emacs'):
- (setq auto-mode-alist (cons '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist))
-
-- HINTS:
- - Type `\\[keyboard-quit] \\[keyboard-quit]' to interrupt long operations or if Emacs hangs.
+ TEMPLATE INSERTION (electrification):
+ After typing a VHDL keyword and entering `SPC', you are prompted for
+ arguments while a template is generated for that VHDL construct. Typing
+ `RET' or `C-g' at the first (mandatory) prompt aborts the current
+ template generation. Optional arguments are indicated by square
+ brackets and removed if the queried string is left empty. Prompts for
+ mandatory arguments remain in the code if the queried string is left
+ empty. They can be queried again by `C-c C-t C-q'. Enabled
+ electrification is indicated by `/e' in the modeline.
+
+ Typing `M-SPC' after a keyword inserts a space without calling the
+ template generator. Automatic template generation (i.e.
+ electrification) can be disabled (enabled) by typing `C-c C-m C-e' or by
+ setting option `vhdl-electric-mode' (see OPTIONS).
+
+ Template generators can be invoked from the VHDL menu, by key
+ bindings, by typing `C-c C-i C-c' and choosing a construct, or by typing
+ the keyword (i.e. first word of menu entry not in parenthesis) and
+ `SPC'. The following abbreviations can also be used: arch, attr, cond,
+ conf, comp, cons, func, inst, pack, sig, var.
+
+ Template styles can be customized in customization group
+ `vhdl-template' (see OPTIONS).
+
+
+ HEADER INSERTION:
+ A file header can be inserted by `C-c C-t C-h'. A file footer
+ (template at the end of the file) can be inserted by `C-c C-t C-f'.
+ See customization group `vhdl-header'.
+
+
+ STUTTERING:
+ Double striking of some keys inserts cumbersome VHDL syntax elements.
+ Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by
+ option `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in
+ the modeline. The stuttering keys and their effects are:
+
+ ;; --> \" : \" [ --> ( -- --> comment
+ ;;; --> \" := \" [[ --> [ --CR --> comment-out code
+ .. --> \" => \" ] --> ) --- --> horizontal line
+ ,, --> \" <= \" ]] --> ] ---- --> display comment
+ == --> \" == \" '' --> \\\"
+
+
+ WORD COMPLETION:
+ Typing `TAB' after a (not completed) word looks for a VHDL keyword or a
+ word in the buffer that starts alike, inserts it and adjusts case.
+ Re-typing `TAB' toggles through alternative word completions. This also
+ works in the minibuffer (i.e. in template generator prompts).
+
+ Typing `TAB' after `(' looks for and inserts complete parenthesized
+ expressions (e.g. for array index ranges). All keywords as well as
+ standard types and subprograms of VHDL have predefined abbreviations
+ (e.g. type \"std\" and `TAB' will toggle through all standard types
+ beginning with \"std\").
+
+ Typing `TAB' after a non-word character indents the line if at the
+ beginning of a line (i.e. no preceding non-blank characters), and
+ inserts a tabulator stop otherwise. `M-TAB' always inserts a tabulator
+ stop.
+
+
+ COMMENTS:
+ `--' puts a single comment.
+ `---' draws a horizontal line for separating code segments.
+ `----' inserts a display comment, i.e. two horizontal lines
+ with a comment in between.
+ `--CR' comments out code on that line. Re-hitting CR comments
+ out following lines.
+ `C-c c' comments out a region if not commented out,
+ uncomments a region if already commented out.
+
+ You are prompted for comments after object definitions (i.e. signals,
+ variables, constants, ports) and after subprogram and process
+ specifications if option `vhdl-prompt-for-comments' is non-nil.
+ Comments are automatically inserted as additional labels (e.g. after
+ begin statements) and as help comments if `vhdl-self-insert-comments' is
+ non-nil.
+
+ Inline comments (i.e. comments after a piece of code on the same line)
+ are indented at least to `vhdl-inline-comment-column'. Comments go at
+ maximum to `vhdl-end-comment-column'. `RET' after a space in a comment
+ will open a new comment line. Typing beyond `vhdl-end-comment-column'
+ in a comment automatically opens a new comment line. `M-q' re-fills
+ multi-line comments.
+
+
+ INDENTATION:
+ `TAB' indents a line if at the beginning of the line. The amount of
+ indentation is specified by option `vhdl-basic-offset'. `C-c C-i C-l'
+ always indents the current line (is bound to `TAB' if option
+ `vhdl-intelligent-tab' is nil).
+
+ Indentation can be done for a group of lines (`C-c C-i C-g'), a region
+ (`M-C-\\') or the entire buffer (menu). Argument and port lists are
+ indented normally (nil) or relative to the opening parenthesis (non-nil)
+ according to option `vhdl-argument-list-indent'.
+
+ If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of
+ tabs. `M-x tabify' and `M-x untabify' allow to convert spaces to tabs
+ and vice versa.
+
+ Syntax-based indentation can be very slow in large files. Option
+ `vhdl-indent-syntax-based' allows to use faster but simpler indentation.
+
+
+ ALIGNMENT:
+ The alignment functions align operators, keywords, and inline comments
+ to beautify the code. `C-c C-a C-a' aligns a group of consecutive lines
+ separated by blank lines, `C-c C-a C-i' a block of lines with same
+ indent. `C-c C-a C-l' aligns all lines belonging to a list enclosed by
+ a pair of parentheses (e.g. port clause/map, argument list), and `C-c
+ C-a C-d' all lines within the declarative part of a design unit. `C-c
+ C-a M-a' aligns an entire region. `C-c C-a C-c' aligns inline comments
+ for a group of lines, and `C-c C-a M-c' for a region.
+
+ If option `vhdl-align-groups' is non-nil, groups of code lines
+ separated by special lines (see option `vhdl-align-group-separate') are
+ aligned individually. If option `vhdl-align-same-indent' is non-nil,
+ blocks of lines with same indent are aligned separately. Some templates
+ are automatically aligned after generation if option `vhdl-auto-align'
+ is non-nil.
+
+ Alignment tries to align inline comments at
+ `vhdl-inline-comment-column' and tries inline comment not to exceed
+ `vhdl-end-comment-column'.
+
+ `C-c C-x M-w' fixes up whitespace in a region. That is, operator
+ symbols are surrounded by one space, and multiple spaces are eliminated.
+
+
+| CODE FILLING:
+| Code filling allows to condens code (e.g. sensitivity lists or port
+| maps) by removing comments and newlines and re-wrapping so that all
+| lines are maximally filled (block filling). `C-c C-f C-f' fills a list
+| enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by
+| blank lines, `C-c C-f C-i' a block of lines with same indent, and
+| `C-c C-f M-f' an entire region.
+
+
+ CODE BEAUTIFICATION:
+ `C-c M-b' and `C-c C-b' beautify the code of a region or of the entire
+ buffer respectively. This inludes indentation, alignment, and case
+ fixing. Code beautification can also be run non-interactively using the
+ command:
+
+ emacs -batch -l ~/.emacs filename.vhd -f vhdl-beautify-buffer
+
+
+ PORT TRANSLATION:
+ Generic and port clauses from entity or component declarations can be
+ copied (`C-c C-p C-w') and pasted as entity and component declarations,
+ as component instantiations and corresponding internal constants and
+ signals, as a generic map with constants as actual generics, and as
+ internal signal initializations (menu).
+
+ To include formals in component instantiations, see option
+ `vhdl-association-list-with-formals'. To include comments in pasting,
+ see options `vhdl-include-...-comments'.
+
+ A clause with several generic/port names on the same line can be
+ flattened (`C-c C-p C-f') so that only one name per line exists. The
+| direction of ports can be reversed (`C-c C-p C-r'), i.e., inputs become
+| outputs and vice versa, which can be useful in testbenches. (This
+| reversion is done on the internal data structure and is only reflected
+| in subsequent paste operations.)
+
+ Names for actual ports, instances, testbenches, and
+ design-under-test instances can be derived from existing names according
+ to options `vhdl-...-name'. See customization group `vhdl-port'.
+
+
+| SUBPROGRAM TRANSLATION:
+| Similar functionality exists for copying/pasting the interface of
+| subprograms (function/procedure). A subprogram interface can be copied
+| and then pasted as a subprogram declaration, body or call (uses
+| association list with formals).
+
+
+ TESTBENCH GENERATION:
+ A copied port can also be pasted as a testbench. The generated
+ testbench includes an entity, an architecture, and an optional
+ configuration. The architecture contains the component declaration and
+ instantiation of the DUT as well as internal constant and signal
+ declarations. Additional user-defined templates can be inserted. The
+ names used for entity/architecture/configuration/DUT as well as the file
+ structure to be generated can be customized. See customization group
+ `vhdl-testbench'.
+
+
+ KEY BINDINGS:
+ Key bindings (`C-c ...') exist for most commands (see in menu).
+
+
+ VHDL MENU:
+ All commands can be found in the VHDL menu including their key bindings.
+
+
+ FILE BROWSER:
+ The speedbar allows browsing of directories and file contents. It can
+ be accessed from the VHDL menu and is automatically opened if option
+ `vhdl-speedbar-auto-open' is non-nil.
+
+ In speedbar, open files and directories with `mouse-2' on the name and
+ browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'.
+
+
+ DESIGN HIERARCHY BROWSER:
+ The speedbar can also be used for browsing the hierarchy of design units
+ contained in the source files of the current directory or the specified
+ projects (see option `vhdl-project-alist').
+
+ The speedbar can be switched between file, directory hierarchy and
+ project hierarchy browsing mode in the speedbar menu or by typing `f',
+ `h' or `H' in speedbar.
+
+ In speedbar, open design units with `mouse-2' on the name and browse
+ their hierarchy with `mouse-2' on the `+'. Ports can directly be copied
+ from entities and components (in packages). Individual design units and
+ complete designs can directly be compiled (\"Make\" menu entry).
+
+ The hierarchy is automatically updated upon saving a modified source
+ file when option `vhdl-speedbar-update-on-saving' is non-nil. The
+ hierarchy is only updated for projects that have been opened once in the
+ speedbar. The hierarchy is cached between Emacs sessions in a file (see
+ options in group `vhdl-speedbar').
+
+ Simple design consistency checks are done during scanning, such as
+ multiple declarations of the same unit or missing primary units that are
+ required by secondary units.
+
+
+| STRUCTURAL COMPOSITION:
+| Enables simple structural composition. `C-c C-c C-n' creates a skeleton
+| for a new component. Subcomponents (i.e. component declaration and
+| instantiation) can be automatically placed from a previously read port
+| (`C-c C-c C-p') or directly from the hierarchy browser (`P'). Finally,
+| all subcomponents can be automatically connected using internal signals
+| and ports (`C-c C-c C-w') following these rules:
+| - subcomponent actual ports with same name are considered to be
+| connected by a signal (internal signal or port)
+| - signals that are only inputs to subcomponents are considered as
+| inputs to this component -> input port created
+| - signals that are only outputs from subcomponents are considered as
+| outputs from this component -> output port created
+| - signals that are inputs to AND outputs from subcomponents are
+| considered as internal connections -> internal signal created
+|
+| Component declarations can be placed in a components package (option
+| `vhdl-use-components-package') which can be automatically generated for
+| an entire directory or project (`C-c C-c M-p'). The VHDL'93 direct
+| component instantiation is also supported (option
+| `vhdl-use-direct-instantiation').
+|
+| Purpose: With appropriate naming conventions it is possible to
+| create higher design levels with only a few mouse clicks or key
+| strokes. A new design level can be created by simply generating a new
+| component, placing the required subcomponents from the hierarchy
+| browser, and wiring everything automatically.
+|
+| Note: Automatic wiring only works reliably on templates of new
+| components and component instantiations that were created by VHDL mode.
+|
+| See the options group `vhdl-compose' for all relevant user options.
+
+
+ SOURCE FILE COMPILATION:
+ The syntax of the current buffer can be analyzed by calling a VHDL
+ compiler (menu, `C-c C-k'). The compiler to be used is specified by
+ option `vhdl-compiler'. The available compilers are listed in option
+ `vhdl-compiler-alist' including all required compilation command,
+ command options, compilation directory, and error message syntax
+ information. New compilers can be added.
+
+ All the source files of an entire design can be compiled by the `make'
+ command (menu, `C-c M-C-k') if an appropriate Makefile exists.
+
+
+ MAKEFILE GENERATION:
+ Makefiles can be generated automatically by an internal generation
+ routine (`C-c M-k'). The library unit dependency information is
+ obtained from the hierarchy browser. Makefile generation can be
+ customized for each compiler in option `vhdl-compiler-alist'.
+
+ Makefile generation can also be run non-interactively using the
+ command:
+
+ emacs -batch -l ~/.emacs -l vhdl-mode
+ [-compiler compilername] [-project projectname]
+ -f vhdl-generate-makefile
+
+ The Makefile's default target \"all\" compiles the entire design, the
+ target \"clean\" removes it and the target \"library\" creates the
+ library directory if not existent. The Makefile also includes a target
+ for each primary library unit which allows selective compilation of this
+ unit, its secondary units and its subhierarchy (example: compilation of
+ a design specified by a configuration). User specific parts can be
+ inserted into a Makefile with option `vhdl-makefile-generation-hook'.
+
+ Limitations:
+ - Only library units and dependencies within the current library are
+ considered. Makefiles for designs that span multiple libraries are
+ not (yet) supported.
+ - Only one-level configurations are supported (also hierarchical),
+ but configurations that go down several levels are not.
+ - The \"others\" keyword in configurations is not supported.
+
+
+ PROJECTS:
+ Projects can be defined in option `vhdl-project-alist' and a current
+ project be selected using option `vhdl-project' (permanently) or from
+ the menu or speedbar (temporarily). For each project, title and
+ description strings (for the file headers), source files/directories
+ (for the hierarchy browser and Makefile generation), library name, and
+ compiler-dependent options, exceptions and compilation directory can be
+ specified. Compilation settings overwrite the settings of option
+ `vhdl-compiler-alist'.
+
+ Project setups can be exported (i.e. written to a file) and imported.
+ Imported setups are not automatically saved in `vhdl-project-alist' but
+ can be saved afterwards in its customization buffer. When starting
+ Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l
+ vhdl-mode\") in a directory with an existing project setup file, it is
+ automatically loaded and its project activated if option
+ `vhdl-project-auto-load' is non-nil. Names/paths of the project setup
+ files can be specified in option `vhdl-project-file-name'. Multiple
+ project setups can be automatically loaded from global directories.
+ This is an alternative to specifying project setups with option
+ `vhdl-project-alist'.
+
+
+ SPECIAL MENUES:
+ As an alternative to the speedbar, an index menu can be added (set
+ option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu
+ (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up
+ file) for browsing the file contents (is not populated if buffer is
+ larger than `font-lock-maximum-size'). Also, a source file menu can be
+ added (set option `vhdl-source-file-menu' to non-nil) for browsing the
+ current directory for VHDL source files.
+
+
+ VHDL STANDARDS:
+ The VHDL standards to be used are specified in option `vhdl-standard'.
+ Available standards are: VHDL'87/'93, VHDL-AMS, and Math Packages.
+
+
+ KEYWORD CASE:
+ Lower and upper case for keywords and standardized types, attributes,
+ and enumeration values is supported. If the option
+ `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in
+ lower case and are converted into upper case automatically (not for
+ types, attributes, and enumeration values). The case of keywords,
+ types, attributes,and enumeration values can be fixed for an entire
+ region (menu) or buffer (`C-c C-x C-c') according to the options
+ `vhdl-upper-case-{keywords,types,attributes,enum-values}'.
+
+
+ HIGHLIGHTING (fontification):
+ Keywords and standardized types, attributes, enumeration values, and
+ function names (controlled by option `vhdl-highlight-keywords'), as well
+ as comments, strings, and template prompts are highlighted using
+ different colors. Unit, subprogram, signal, variable, constant,
+ parameter and generic/port names in declarations as well as labels are
+ highlighted if option `vhdl-highlight-names' is non-nil.
+
+ Additional reserved words or words with a forbidden syntax (e.g. words
+ that should be avoided) can be specified in option
+ `vhdl-forbidden-words' or `vhdl-forbidden-syntax' and be highlighted in
+ a warning color (option `vhdl-highlight-forbidden-words'). Verilog
+ keywords are highlighted as forbidden words if option
+ `vhdl-highlight-verilog-keywords' is non-nil.
+
+ Words with special syntax can be highlighted by specifying their
+ syntax and color in option `vhdl-special-syntax-alist' and by setting
+ option `vhdl-highlight-special-words' to non-nil. This allows to
+ establish some naming conventions (e.g. to distinguish different kinds
+ of signals or other objects by using name suffices) and to support them
+ visually.
+
+ Option `vhdl-highlight-case-sensitive' can be set to non-nil in order
+ to support case-sensitive highlighting. However, keywords are then only
+ highlighted if written in lower case.
+
+ Code between \"translate_off\" and \"translate_on\" pragmas is
+ highlighted using a different background color if option
+ `vhdl-highlight-translate-off' is non-nil.
+
+ For documentation and customization of the used colors see
+ customization group `vhdl-highlight-faces' (`M-x customize-group'). For
+ highlighting of matching parenthesis, see customization group
+ `paren-showing'. Automatic buffer highlighting is turned on/off by
+ option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs).
+
+
+ USER MODELS:
+ VHDL models (templates) can be specified by the user and made accessible
+ in the menu, through key bindings (`C-c C-m ...'), or by keyword
+ electrification. See option `vhdl-model-alist'.
+
+
+ HIDE/SHOW:
+ The code of blocks, processes, subprograms, component declarations and
+ instantiations, generic/port clauses, and configuration declarations can
+ be hidden using the `Hide/Show' menu or by pressing `S-mouse-2' within
+ the code (see customization group `vhdl-menu'). XEmacs: limited
+ functionality due to old `hideshow.el' package.
+
+
+ CODE UPDATING:
+ - Sensitivity List: `C-c C-u C-s' updates the sensitivity list of the
+ current process, `C-c C-u M-s' of all processes in the current buffer.
+ Limitations:
+ - Only declared local signals (ports, signals declared in
+ architecture and blocks) are automatically inserted.
+ - Global signals declared in packages are not automatically inserted.
+ Insert them once manually (will be kept afterwards).
+ - Out parameters of procedures are considered to be read.
+ Use option `vhdl-entity-file-name' to specify the entity file name
+ (used to obtain the port names).
+
+
+ CODE FIXING:
+ `C-c C-x C-p' fixes the closing parenthesis of a generic/port clause
+ (e.g. if the closing parenthesis is on the wrong line or is missing).
+
+
+ PRINTING:
+ Postscript printing with different faces (an optimized set of faces is
+ used if `vhdl-print-customize-faces' is non-nil) or colors (if
+ `ps-print-color-p' is non-nil) is possible using the standard Emacs
+ postscript printing commands. Option `vhdl-print-two-column' defines
+ appropriate default settings for nice landscape two-column printing.
+ The paper format can be set by option `ps-paper-type'. Do not forget to
+ switch `ps-print-color-p' to nil for printing on black-and-white
+ printers.
+
+
+ OPTIONS:
+ User options allow customization of VHDL Mode. All options are
+ accessible from the \"Options\" menu entry. Simple options (switches
+ and choices) can directly be changed, while for complex options a
+ customization buffer is opened. Changed options can be saved for future
+ sessions using the \"Save Options\" menu entry.
+
+ Options and their detailed descriptions can also be accessed by using
+ the \"Customize\" menu entry or the command `M-x customize-option' (`M-x
+ customize-group' for groups). Some customizations only take effect
+ after some action (read the NOTE in the option documentation).
+ Customization can also be done globally (i.e. site-wide, read the
+ INSTALL file).
+
+ Not all options are described in this documentation, so go and see
+ what other useful user options there are (`M-x vhdl-customize' or menu)!
+
+
+ FILE EXTENSIONS:
+ As default, files with extensions \".vhd\" and \".vhdl\" are
+ automatically recognized as VHDL source files. To add an extension
+ \".xxx\", add the following line to your Emacs start-up file (`.emacs'):
+
+ (setq auto-mode-alist (cons '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist))
+
+
+ HINTS:
+ - To start Emacs with open VHDL hierarchy browser without having to load
+ a VHDL file first, use the command:
+
+ emacs -l vhdl-mode -f speedbar-frame-mode
+
+ - Type `C-g C-g' to interrupt long operations or if Emacs hangs.
+
+ - Some features only work on properly indented code.
+
+
+ RELEASE NOTES:
+ See also the release notes (menu) for added features in new releases.
Maintenance:
------------
-To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode.
+To submit a bug report, enter `M-x vhdl-submit-bug-report' within VHDL Mode.
Add a description of the problem and include a reproducible test case.
-Questions and enhancement requests can be sent to <vhdl-mode@geocities.com>.
+Questions and enhancement requests can be sent to <reto@gnu.org>.
The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases.
-The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta releases.
-You are kindly invited to participate in beta testing. Subscribe to above
-mailing lists by sending an email to <vhdl-mode@geocities.com>.
+The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta
+releases. You are kindly invited to participate in beta testing. Subscribe
+to above mailing lists by sending an email to <reto@gnu.org>.
-VHDL Mode is officially distributed on the Emacs VHDL Mode Home Page
-<http://www.geocities.com/SiliconValley/Peaks/8287>, where the latest
-version and release notes can be found.
+VHDL Mode is officially distributed at
+http://opensource.ethz.ch/emacs/vhdl-mode.html
+where the latest version can be found.
-Bugs and Limitations:
----------------------
+Known problems:
+---------------
-- Re-indenting large regions or expressions can be slow.
- Indentation bug in simultaneous if- and case-statements (VHDL-AMS).
-- Hideshow does not work under XEmacs.
-- Index menu and file tagging in speedbar do not work under XEmacs.
-- Parsing compilation error messages for Ikos and Viewlogic VHDL compilers
- does not work under XEmacs.
+- XEmacs: Incorrect start-up when automatically opening speedbar.
+- XEmacs: Indentation in XEmacs 21.4 (and higher).
- The VHDL Mode Maintainers
- Reto Zimmermann and Rod Whitby
+ The VHDL Mode Authors
+ Reto Zimmermann and Rod Whitby
Key bindings:
-------------
-\\{vhdl-mode-map}" t nil)
+\\{vhdl-mode-map}
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (15371 46419))
+;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (15941 42958))
;;; Generated autoloads from emulation/vi.el
(autoload (quote vi-mode) "vi" "\
`vi-name-last-change-or-macro', `vi-verify-spelling', `vi-locate-def',
`vi-mark-region', and 'vi-quote-words'. Some of them are quite handy.
- Use \\[vi-switch-mode] to switch among different modes quickly.
-
-Syntax table and abbrevs while in vi mode remain as they were in Emacs." t nil)
+
+Syntax table and abbrevs while in vi mode remain as they were in Emacs.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (viqr-pre-write-conversion viqr-post-read-conversion
;;;;;; viet-encode-viqr-buffer viet-encode-viqr-region viet-decode-viqr-buffer
;;;;;; viet-decode-viqr-region viet-encode-viscii-char) "viet-util"
- ;;;;;; "language/viet-util.el" (16118 44435))
-;;;;;; "language/viet-util.el" (15371 46423))
++;;;;;; "language/viet-util.el" (16183 38637))
;;; Generated autoloads from language/viet-util.el
(autoload (quote viet-encode-viscii-char) "viet-util" "\
-Return VISCII character code of CHAR if appropriate." nil nil)
+Return VISCII character code of CHAR if appropriate.
+
+\(fn CHAR)" nil nil)
(autoload (quote viet-decode-viqr-region) "viet-util" "\
-Convert `VIQR' mnemonics of the current region to Vietnamese characaters.
+Convert `VIQR' mnemonics of the current region to Vietnamese characters.
When called from a program, expects two arguments,
-positions (integers or markers) specifying the stretch of the region." t nil)
+positions (integers or markers) specifying the stretch of the region.
+
+\(fn FROM TO)" t nil)
(autoload (quote viet-decode-viqr-buffer) "viet-util" "\
-Convert `VIQR' mnemonics of the current buffer to Vietnamese characaters." t nil)
+Convert `VIQR' mnemonics of the current buffer to Vietnamese characters.
+
+\(fn)" t nil)
(autoload (quote viet-encode-viqr-region) "viet-util" "\
-Convert Vietnamese characaters of the current region to `VIQR' mnemonics.
+Convert Vietnamese characters of the current region to `VIQR' mnemonics.
When called from a program, expects two arguments,
-positions (integers or markers) specifying the stretch of the region." t nil)
+positions (integers or markers) specifying the stretch of the region.
+
+\(fn FROM TO)" t nil)
(autoload (quote viet-encode-viqr-buffer) "viet-util" "\
-Convert Vietnamese characaters of the current buffer to `VIQR' mnemonics." t nil)
+Convert Vietnamese characters of the current buffer to `VIQR' mnemonics.
+
+\(fn)" t nil)
+
+(autoload (quote viqr-post-read-conversion) "viet-util" "\
+Not documented
+
+\(fn LEN)" nil nil)
-(autoload (quote viqr-post-read-conversion) "viet-util" nil nil nil)
+(autoload (quote viqr-pre-write-conversion) "viet-util" "\
+Not documented
-(autoload (quote viqr-pre-write-conversion) "viet-util" nil nil nil)
+\(fn FROM TO)" nil nil)
;;;***
\f
;;;### (autoloads (View-exit-and-edit view-mode-enter view-mode view-buffer-other-frame
;;;;;; view-buffer-other-window view-buffer view-file-other-frame
-;;;;;; view-file-other-window view-file) "view" "view.el" (15371
-;;;;;; 46418))
+;;;;;; view-file-other-window view-file) "view" "view.el" (16142
+;;;;;; 9350))
;;; Generated autoloads from view.el
(defvar view-mode nil "\
Space scrolls forward, Delete scrolls backward.
For list of all View commands, type H or h while viewing.
-This command runs the normal hook `view-mode-hook'." t nil)
+This command runs the normal hook `view-mode-hook'.
+
+\(fn FILE)" t nil)
(autoload (quote view-file-other-window) "view" "\
View FILE in View mode in another window.
Space scrolls forward, Delete scrolls backward.
For list of all View commands, type H or h while viewing.
-This command runs the normal hook `view-mode-hook'." t nil)
+This command runs the normal hook `view-mode-hook'.
+
+\(fn FILE)" t nil)
(autoload (quote view-file-other-frame) "view" "\
View FILE in View mode in another frame.
Space scrolls forward, Delete scrolls backward.
For list of all View commands, type H or h while viewing.
-This command runs the normal hook `view-mode-hook'." t nil)
+This command runs the normal hook `view-mode-hook'.
+
+\(fn FILE)" t nil)
(autoload (quote view-buffer) "view" "\
View BUFFER in View mode, returning to previous buffer when done.
Optional argument EXIT-ACTION is either nil or a function with buffer as
argument. This function is called when finished viewing buffer.
-Use this argument instead of explicitly setting `view-exit-action'." t nil)
+Use this argument instead of explicitly setting `view-exit-action'.
+
+\(fn BUFFER &optional EXIT-ACTION)" t nil)
(autoload (quote view-buffer-other-window) "view" "\
View BUFFER in View mode in another window.
Optional argument EXIT-ACTION is either nil or a function with buffer as
argument. This function is called when finished viewing buffer.
-Use this argument instead of explicitly setting `view-exit-action'." t nil)
+Use this argument instead of explicitly setting `view-exit-action'.
+
+\(fn BUFFER &optional NOT-RETURN EXIT-ACTION)" t nil)
(autoload (quote view-buffer-other-frame) "view" "\
View BUFFER in View mode in another frame.
Optional argument EXIT-ACTION is either nil or a function with buffer as
argument. This function is called when finished viewing buffer.
-Use this argument instead of explicitly setting `view-exit-action'." t nil)
+Use this argument instead of explicitly setting `view-exit-action'.
+
+\(fn BUFFER &optional NOT-RETURN EXIT-ACTION)" t nil)
(autoload (quote view-mode) "view" "\
Toggle View mode, a minor mode for viewing text but not editing it.
\\ searches backward for regular expression, starting before current page.
\\[View-search-last-regexp-forward] searches forward for last regular expression.
p searches backward for last regular expression.
-\\[View-quit] quit View mode, trying to restore window and buffer to previous state.
+\\[View-quit] quit View mode, restoring this window and buffer to previous state.
\\[View-quit] is the normal way to leave view mode.
\\[View-exit] exit View mode but stay in current buffer. Use this if you started
viewing a buffer (file) and find out you want to edit it.
-\\[View-exit-and-edit] exit View mode and make the current buffer editable.
-\\[View-quit-all] quit View mode, trying to restore windows and buffer to previous state.
+ This command restores the previous read-only status of the buffer.
+\\[View-exit-and-edit] exit View mode, and make the current buffer editable
+ even if it was not editable before entry to View mode.
+\\[View-quit-all] quit View mode, restoring all windows to previous state.
\\[View-leave] quit View mode and maybe switch buffers, but don't kill this buffer.
\\[View-kill-and-leave] quit View mode, kill current buffer and go back to other buffer.
View-file, View-file-other-window or View-file-other-frame then \\[View-leave] , \\[View-quit] and \\[View-kill-and-leave]
will return to that buffer.
-Entry to view-mode runs the normal hook `view-mode-hook'." t nil)
+Entry to view-mode runs the normal hook `view-mode-hook'.
+
+\(fn &optional ARG)" t nil)
(autoload (quote view-mode-enter) "view" "\
Enter View mode and set up exit from view mode depending on optional arguments.
For list of all View commands, type H or h while viewing.
-This function runs the normal hook `view-mode-hook'." nil nil)
+This function runs the normal hook `view-mode-hook'.
+
+\(fn &optional RETURN-TO EXIT-ACTION)" nil nil)
(autoload (quote View-exit-and-edit) "view" "\
-Exit View mode and make the current buffer editable." t nil)
+Exit View mode and make the current buffer editable.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (vip-mode) "vip" "emulation/vip.el" (15371 46419))
+;;;### (autoloads (vip-mode vip-setup) "vip" "emulation/vip.el" (16111
+;;;;;; 41830))
;;; Generated autoloads from emulation/vip.el
+(autoload (quote vip-setup) "vip" "\
+Set up bindings for C-x 7 and C-z that are useful for VIP users.
+
+\(fn)" nil nil)
+
(autoload (quote vip-mode) "vip" "\
-Turn on VIP emulation of VI." t nil)
+Turn on VIP emulation of VI.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (viper-mode toggle-viper-mode) "viper" "emulation/viper.el"
-;;;;;; (15464 26328))
+;;;;;; (15941 42958))
;;; Generated autoloads from emulation/viper.el
(autoload (quote toggle-viper-mode) "viper" "\
Toggle Viper on/off.
-If Viper is enabled, turn it off. Otherwise, turn it on." t nil)
+If Viper is enabled, turn it off. Otherwise, turn it on.
+
+\(fn)" t nil)
(autoload (quote viper-mode) "viper" "\
-Turn on Viper emulation of Vi." t nil)
+Turn on Viper emulation of Vi.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (warn lwarn display-warning) "warnings" "emacs-lisp/warnings.el"
+;;;;;; (16087 59607))
+;;; Generated autoloads from emacs-lisp/warnings.el
+
+(defvar warning-prefix-function nil "\
+Function to generate warning prefixes.
+This function, if non-nil, is called with two arguments,
+the severity level and its entry in `warning-levels',
+and should return the entry that should actually be used.
+The warnings buffer is current when this function is called
+and the function can insert text in it. This text becomes
+the beginning of the warning.")
+
+(defvar warning-series nil "\
+Non-nil means treat multiple `display-warning' calls as a series.
+A marker indicates a position in the warnings buffer
+which is the start of the current series; it means that
+additional warnings in the same buffer should not move point.
+t means the next warning begins a series (and stores a marker here).
+A symbol with a function definition is like t, except
+also call that function before the next warning.")
+
+(defvar warning-fill-prefix nil "\
+Non-nil means fill each warning text using this string as `fill-prefix'.")
+
+(defvar warning-group-format " (%s)" "\
+Format for displaying the warning group in the warning message.
+The result of formatting the group this way gets included in the
+message under the control of the string in `warning-levels'.")
+
+(autoload (quote display-warning) "warnings" "\
+Display a warning message, MESSAGE.
+GROUP should be a custom group name (a symbol),
+or else a list of symbols whose first element is a custom group name.
+\(The rest of the symbols represent subcategories, for warning purposes
+only, and you can use whatever symbols you like.)
+
+LEVEL should be either :warning, :error, or :emergency.
+:emergency -- a problem that will seriously impair Emacs operation soon
+ if you do not attend to it promptly.
+:error -- data or circumstances that are inherently wrong.
+:warning -- data or circumstances that are not inherently wrong,
+ but raise suspicion of a possible problem.
+:debug -- info for debugging only.
+
+BUFFER-NAME, if specified, is the name of the buffer for logging the
+warning. By default, it is `*Warnings*'.
+
+See the `warnings' custom group for user customization features.
+
+See also `warning-series', `warning-prefix-function' and
+`warning-fill-prefix' for additional programming features.
+
+\(fn GROUP MESSAGE &optional LEVEL BUFFER-NAME)" nil nil)
+
+(autoload (quote lwarn) "warnings" "\
+Display a warning message made from (format MESSAGE ARGS...).
+Aside from generating the message with `format',
+this is equivalent to `display-warning'.
+
+GROUP should be a custom group name (a symbol).
+or else a list of symbols whose first element is a custom group name.
+\(The rest of the symbols represent subcategories and
+can be whatever you like.)
+
+LEVEL should be either :warning, :error, or :emergency.
+:emergency -- a problem that will seriously impair Emacs operation soon
+ if you do not attend to it promptly.
+:error -- invalid data or circumstances.
+:warning -- suspicious data or circumstances.
+
+\(fn GROUP LEVEL MESSAGE &rest ARGS)" nil nil)
+
+(autoload (quote warn) "warnings" "\
+Display a warning message made from (format MESSAGE ARGS...).
+Aside from generating the message with `format',
+this is equivalent to `display-warning', using
+`emacs' as the group and `:warning' as the level.
+
+\(fn MESSAGE &rest ARGS)" nil nil)
;;;***
\f
-;;;### (autoloads (webjump) "webjump" "net/webjump.el" (15391 60705))
+;;;### (autoloads (webjump) "webjump" "net/webjump.el" (15941 42963))
;;; Generated autoloads from net/webjump.el
(autoload (quote webjump) "webjump" "\
hotlist.
Please submit bug reports and other feedback to the author, Neil W. Van Dyke
-<nwv@acm.org>." t nil)
+<nwv@acm.org>.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (which-function-mode) "which-func" "which-func.el"
-;;;;;; (15371 46418))
-;;; Generated autoloads from which-func.el
+;;;### (autoloads (which-function-mode) "which-func" "progmodes/which-func.el"
+;;;;;; (16087 59843))
+;;; Generated autoloads from progmodes/which-func.el
+ (put 'which-func-format 'risky-local-variable t)
+ (put 'which-func-current 'risky-local-variable t)
(defalias (quote which-func-mode) (quote which-function-mode))
Setting this variable directly does not take effect;
use either \\[customize] or the function `which-function-mode'.")
-(custom-add-to-group (quote which-func) (quote which-function-mode) (quote custom-variable))
-
-(custom-add-load (quote which-function-mode) (quote which-func))
+(custom-autoload (quote which-function-mode) "which-func")
(autoload (quote which-function-mode) "which-func" "\
Toggle Which Function mode, globally.
continuously displayed in the mode line, in certain major modes.
With prefix ARG, turn Which Function mode on iff arg is positive,
-and off otherwise." t nil)
+and off otherwise.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
-;;;### (autoloads (whitespace-describe whitespace-write-file-hook
-;;;;;; whitespace-global-mode whitespace-global-mode whitespace-cleanup-region
-;;;;;; whitespace-cleanup whitespace-region whitespace-buffer whitespace-toggle-ateol-check
-;;;;;; whitespace-toggle-spacetab-check whitespace-toggle-indent-check
-;;;;;; whitespace-toggle-trailing-check whitespace-toggle-leading-check)
-;;;;;; "whitespace" "whitespace.el" (15400 1474))
+;;;### (autoloads (whitespace-write-file-hook whitespace-global-mode
+;;;;;; whitespace-cleanup-region whitespace-cleanup whitespace-region
+;;;;;; whitespace-buffer whitespace-toggle-ateol-check whitespace-toggle-spacetab-check
+;;;;;; whitespace-toggle-indent-check whitespace-toggle-trailing-check
+;;;;;; whitespace-toggle-leading-check) "whitespace" "whitespace.el"
+;;;;;; (16111 41826))
;;; Generated autoloads from whitespace.el
(autoload (quote whitespace-toggle-leading-check) "whitespace" "\
-Toggle the check for leading space in the local buffer." t nil)
+Toggle the check for leading space in the local buffer.
+
+\(fn)" t nil)
(autoload (quote whitespace-toggle-trailing-check) "whitespace" "\
-Toggle the check for trailing space in the local buffer." t nil)
+Toggle the check for trailing space in the local buffer.
+
+\(fn)" t nil)
(autoload (quote whitespace-toggle-indent-check) "whitespace" "\
-Toggle the check for indentation space in the local buffer." t nil)
+Toggle the check for indentation space in the local buffer.
+
+\(fn)" t nil)
(autoload (quote whitespace-toggle-spacetab-check) "whitespace" "\
-Toggle the check for space-followed-by-TABs in the local buffer." t nil)
+Toggle the check for space-followed-by-TABs in the local buffer.
+
+\(fn)" t nil)
(autoload (quote whitespace-toggle-ateol-check) "whitespace" "\
-Toggle the check for end-of-line space in the local buffer." t nil)
+Toggle the check for end-of-line space in the local buffer.
+
+\(fn)" t nil)
(autoload (quote whitespace-buffer) "whitespace" "\
Find five different types of white spaces in buffer.
Check for whitespace only if this buffer really contains a non-empty file
and:
1. the major mode is one of the whitespace-modes, or
-2. `whitespace-buffer' was explicitly called with a prefix argument." t nil)
+2. `whitespace-buffer' was explicitly called with a prefix argument.
+
+\(fn &optional QUIET)" t nil)
(autoload (quote whitespace-region) "whitespace" "\
-Check the region for whitespace errors." t nil)
+Check the region for whitespace errors.
+
+\(fn S E)" t nil)
(autoload (quote whitespace-cleanup) "whitespace" "\
Cleanup the five different kinds of whitespace problems.
Use \\[describe-function] whitespace-describe to read a summary of the
-whitespace problems." t nil)
+whitespace problems.
+
+\(fn)" t nil)
(autoload (quote whitespace-cleanup-region) "whitespace" "\
-Whitespace cleanup on the region." t nil)
+Whitespace cleanup on the region.
-(defvar whitespace-global-mode nil "\
-Toggle global Whitespace mode.
+\(fn S E)" t nil)
+(defvar whitespace-global-mode nil "\
+Non-nil if Whitespace-Global mode is enabled.
+See the command `whitespace-global-mode' for a description of this minor-mode.
Setting this variable directly does not take effect;
-use either \\[customize] or the function `whitespace-global-mode'
-\(which see).")
-
-(custom-add-to-group (quote whitespace) (quote whitespace-global-mode) (quote custom-variable))
+use either \\[customize] or the function `whitespace-global-mode'.")
-(custom-add-load (quote whitespace-global-mode) (quote whitespace))
+(custom-autoload (quote whitespace-global-mode) "whitespace")
(autoload (quote whitespace-global-mode) "whitespace" "\
Toggle using Whitespace mode in new buffers.
With ARG, turn the mode on if and only iff ARG is positive.
When this mode is active, `whitespace-buffer' is added to
-`find-file-hooks' and `kill-buffer-hook'." t nil)
-
-(autoload (quote whitespace-write-file-hook) "whitespace" "\
-The local-write-file-hook to be called on the buffer when
-whitespace check is enabled." t nil)
-
-(autoload (quote whitespace-describe) "whitespace" "\
-A summary of whitespaces and what this library can do about them.
-
-The whitespace library is intended to find and help fix five different types
-of whitespace problems that commonly exist in source code.
-
-1. Leading space (empty lines at the top of a file).
-2. Trailing space (empty lines at the end of a file).
-3. Indentation space (8 or more spaces at beginning of line, that should be
- replaced with TABS).
-4. Spaces followed by a TAB. (Almost always, we never want that).
-5. Spaces or TABS at the end of a line.
-
-Whitespace errors are reported in a buffer, and on the modeline.
-
-Modeline will show a W:<x>!<y> to denote a particular type of whitespace,
-where `x' and `y' can be one (or more) of:
-
-e - End-of-Line whitespace.
-i - Indentation whitespace.
-l - Leading whitespace.
-s - Space followed by Tab.
-t - Trailing whitespace.
-
-If any of the whitespace checks is turned off, the modeline will display a
-!<y>.
-
- (since (3) is the most controversial one, here is the rationale: Most
- terminal drivers and printer drivers have TAB configured or even
- hardcoded to be 8 spaces. (Some of them allow configuration, but almost
- always they default to 8.)
-
- Changing `tab-width' to other than 8 and editing will cause your code to
- look different from within Emacs, and say, if you cat it or more it, or
- even print it.
+`find-file-hook' and `kill-buffer-hook'.
- Almost all the popular programming modes let you define an offset (like
- c-basic-offset or perl-indent-level) to configure the offset, so you
- should never have to set your `tab-width' to be other than 8 in all these
- modes. In fact, with an indent level of say, 4, 2 TABS will cause Emacs
- to replace your 8 spaces with one (try it). If vi users in your
- office complain, tell them to use vim, which distinguishes between
- tabstop and shiftwidth (vi equivalent of our offsets), and also ask them
- to set smarttab.)
+\(fn &optional ARG)" t nil)
-All the above have caused (and will cause) unwanted codeline integration and
-merge problems.
+(autoload (quote whitespace-write-file-hook) "whitespace" "\
+Hook function to be called on the buffer when whitespace check is enabled.
+This is meant to be added buffer-locally to `write-file-functions'.
-whitespace.el will complain if it detects whitespaces on opening a file, and
-warn you on closing a file also (in case you had inserted any
-whitespaces during the process of your editing)." t nil)
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (widget-minor-mode widget-browse-other-window widget-browse
-;;;;;; widget-browse-at) "wid-browse" "wid-browse.el" (15468 8218))
+;;;;;; widget-browse-at) "wid-browse" "wid-browse.el" (15941 42957))
;;; Generated autoloads from wid-browse.el
(autoload (quote widget-browse-at) "wid-browse" "\
-Browse the widget under point." t nil)
+Browse the widget under point.
+
+\(fn POS)" t nil)
(autoload (quote widget-browse) "wid-browse" "\
-Create a widget browser for WIDGET." t nil)
+Create a widget browser for WIDGET.
+
+\(fn WIDGET)" t nil)
(autoload (quote widget-browse-other-window) "wid-browse" "\
-Show widget browser for WIDGET in other window." t nil)
+Show widget browser for WIDGET in other window.
+
+\(fn &optional WIDGET)" t nil)
(autoload (quote widget-minor-mode) "wid-browse" "\
Togle minor mode for traversing widgets.
-With arg, turn widget mode on if and only if arg is positive." t nil)
+With arg, turn widget mode on if and only if arg is positive.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (widget-setup widget-insert widget-delete widget-create
- ;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (16111
- ;;;;;; 41826))
-;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (15468
-;;;;;; 49415))
++;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (16179
++;;;;;; 14095))
;;; Generated autoloads from wid-edit.el
(autoload (quote widgetp) "wid-edit" "\
-Return non-nil iff WIDGET is a widget." nil nil)
+Return non-nil iff WIDGET is a widget.
+
+\(fn WIDGET)" nil nil)
(autoload (quote widget-prompt-value) "wid-edit" "\
Prompt for a value matching WIDGET, using PROMPT.
-The current value is assumed to be VALUE, unless UNBOUND is non-nil." nil nil)
+The current value is assumed to be VALUE, unless UNBOUND is non-nil.
+
+\(fn WIDGET PROMPT &optional VALUE UNBOUND)" nil nil)
(autoload (quote widget-create) "wid-edit" "\
Create widget of TYPE.
-The optional ARGS are additional keyword arguments." nil nil)
+The optional ARGS are additional keyword arguments.
+
+\(fn TYPE &rest ARGS)" nil nil)
(autoload (quote widget-delete) "wid-edit" "\
-Delete WIDGET." nil nil)
+Delete WIDGET.
+
+\(fn WIDGET)" nil nil)
(autoload (quote widget-insert) "wid-edit" "\
-Call `insert' with ARGS even if surrounding text is read only." nil nil)
+Call `insert' with ARGS even if surrounding text is read only.
+
+\(fn &rest ARGS)" nil nil)
(defvar widget-keymap (let ((map (make-sparse-keymap))) (define-key map " " (quote widget-forward)) (define-key map [(shift tab)] (quote widget-backward)) (define-key map [backtab] (quote widget-backward)) (define-key map [down-mouse-2] (quote widget-button-click)) (define-key map "\r" (quote widget-button-press)) map) "\
Keymap containing useful binding for buffers containing widgets.
Recommended as a parent keymap for modes using widgets.")
(autoload (quote widget-setup) "wid-edit" "\
-Setup current buffer so editing string widgets works." nil nil)
+Setup current buffer so editing string widgets works.
+
+\(fn)" nil nil)
;;;***
\f
;;;### (autoloads (windmove-default-keybindings windmove-down windmove-right
-;;;;;; windmove-up windmove-left) "windmove" "windmove.el" (15371
-;;;;;; 46418))
+;;;;;; windmove-up windmove-left) "windmove" "windmove.el" (16111
+;;;;;; 41826))
;;; Generated autoloads from windmove.el
(autoload (quote windmove-left) "windmove" "\
\"left\" is relative to the position of point in the window; otherwise
it is relative to the top edge (for positive ARG) or the bottom edge
\(for negative ARG) of the current window.
-If no window is at the desired location, an error is signaled." t nil)
+If no window is at the desired location, an error is signaled.
+
+\(fn &optional ARG)" t nil)
(autoload (quote windmove-up) "windmove" "\
Select the window above the current one.
is relative to the position of point in the window; otherwise it is
relative to the left edge (for positive ARG) or the right edge (for
negative ARG) of the current window.
-If no window is at the desired location, an error is signaled." t nil)
+If no window is at the desired location, an error is signaled.
+
+\(fn &optional ARG)" t nil)
(autoload (quote windmove-right) "windmove" "\
Select the window to the right of the current one.
\"right\" is relative to the position of point in the window;
otherwise it is relative to the top edge (for positive ARG) or the
bottom edge (for negative ARG) of the current window.
-If no window is at the desired location, an error is signaled." t nil)
+If no window is at the desired location, an error is signaled.
+
+\(fn &optional ARG)" t nil)
(autoload (quote windmove-down) "windmove" "\
Select the window below the current one.
\"down\" is relative to the position of point in the window; otherwise
it is relative to the left edge (for positive ARG) or the right edge
\(for negative ARG) of the current window.
-If no window is at the desired location, an error is signaled." t nil)
+If no window is at the desired location, an error is signaled.
+
+\(fn &optional ARG)" t nil)
(autoload (quote windmove-default-keybindings) "windmove" "\
-Set up default keybindings for `windmove'." t nil)
+Set up keybindings for `windmove'.
+Keybindings are of the form MODIFIER-{left,right,up,down}.
+Default MODIFIER is 'shift.
+
+\(fn &optional MODIFIER)" t nil)
;;;***
\f
;;;### (autoloads (winner-mode winner-mode) "winner" "winner.el"
-;;;;;; (15483 45821))
+;;;;;; (15941 42957))
;;; Generated autoloads from winner.el
(defvar winner-mode nil "\
Setting this variable directly does not take effect;
use either \\[customize] or the function `winner-mode'.")
-(custom-add-to-group (quote winner) (quote winner-mode) (quote custom-variable))
-
-(custom-add-load (quote winner-mode) (quote winner))
+(custom-autoload (quote winner-mode) "winner")
(autoload (quote winner-mode) "winner" "\
Toggle Winner mode.
-With arg, turn Winner mode on if and only if arg is positive." t nil)
+With arg, turn Winner mode on if and only if arg is positive.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (woman-find-file woman-dired-find-file woman) "woman"
-;;;;;; "woman.el" (15417 7411))
+;;;;;; "woman.el" (16012 41365))
;;; Generated autoloads from woman.el
(autoload (quote woman) "woman" "\
updated (e.g. to re-interpret the current directory).
Used non-interactively, arguments are optional: if given then TOPIC
-should be a topic string and non-nil RE-CACHE forces re-caching." t nil)
+should be a topic string and non-nil RE-CACHE forces re-caching.
+
+\(fn &optional TOPIC RE-CACHE)" t nil)
(autoload (quote woman-dired-find-file) "woman" "\
-In dired, run the WoMan man-page browser on this file." t nil)
+In dired, run the WoMan man-page browser on this file.
+
+\(fn)" t nil)
(autoload (quote woman-find-file) "woman" "\
Find, decode and browse a specific UN*X man-page source file FILE-NAME.
of an existing WoMan buffer formatted earlier.
No external programs are used, except that `gunzip' will be used to
decompress the file if appropriate. See the documentation for the
-`woman' command for further details." t nil)
+`woman' command for further details.
+
+\(fn FILE-NAME &optional REFORMAT)" t nil)
;;;***
\f
;;;### (autoloads (wordstar-mode) "ws-mode" "emulation/ws-mode.el"
-;;;;;; (15400 1475))
+;;;;;; (15941 42958))
;;; Generated autoloads from emulation/ws-mode.el
(autoload (quote wordstar-mode) "ws-mode" "\
C-q w ws-last-error
C-q y ws-kill-eol
C-q DEL ws-kill-bol
-" t nil)
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (xml-parse-region xml-parse-file) "xml" "xml.el"
+;;;;;; (16148 4633))
+;;; Generated autoloads from xml.el
+
+(autoload (quote xml-parse-file) "xml" "\
+Parse the well-formed XML file FILE.
+If FILE is already visited, use its buffer and don't kill it.
+Returns the top node with all its children.
+If PARSE-DTD is non-nil, the DTD is parsed rather than skipped.
+If PARSE-NS is non-nil, then QNAMES are expanded.
+
+\(fn FILE &optional PARSE-DTD PARSE-NS)" nil nil)
+
+(autoload (quote xml-parse-region) "xml" "\
+Parse the region from BEG to END in BUFFER.
+If BUFFER is nil, it defaults to the current buffer.
+Returns the XML list for the region, or raises an error if the region
+is not well-formed XML.
+If PARSE-DTD is non-nil, the DTD is parsed rather than skipped,
+and returned as the first element of the list.
+If PARSE-NS is non-nil, then QNAMES are expanded.
+
+\(fn BEG END &optional BUFFER PARSE-DTD PARSE-NS)" nil nil)
;;;***
\f
-;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (15391
-;;;;;; 60521))
+;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (16025
+;;;;;; 36883))
;;; Generated autoloads from xt-mouse.el
+(defvar xterm-mouse-mode nil "\
+Non-nil if Xterm-Mouse mode is enabled.
+See the command `xterm-mouse-mode' for a description of this minor-mode.
+Setting this variable directly does not take effect;
+use either \\[customize] or the function `xterm-mouse-mode'.")
+
+(custom-autoload (quote xterm-mouse-mode) "xt-mouse")
+
(autoload (quote xterm-mouse-mode) "xt-mouse" "\
Toggle XTerm mouse mode.
With prefix arg, turn XTerm mouse mode on iff arg is positive.
-Turn it on to use emacs mouse commands, and off to use xterm mouse commands." t nil)
+Turn it on to use emacs mouse commands, and off to use xterm mouse commands.
+
+\(fn &optional ARG)" t nil)
;;;***
\f
;;;### (autoloads (psychoanalyze-pinhead apropos-zippy insert-zippyism
-;;;;;; yow) "yow" "play/yow.el" (15417 7434))
+;;;;;; yow) "yow" "play/yow.el" (15407 8860))
;;; Generated autoloads from play/yow.el
(autoload (quote yow) "yow" "\
-Return or display a random Zippy quotation. With prefix arg, insert it." t nil)
+Return or display a random Zippy quotation. With prefix arg, insert it.
+
+\(fn &optional INSERT DISPLAY)" t nil)
(autoload (quote insert-zippyism) "yow" "\
-Prompt with completion for a known Zippy quotation, and insert it at point." t nil)
+Prompt with completion for a known Zippy quotation, and insert it at point.
+
+\(fn &optional ZIPPYISM)" t nil)
(autoload (quote apropos-zippy) "yow" "\
Return a list of all Zippy quotes matching REGEXP.
-If called interactively, display a list of matches." t nil)
+If called interactively, display a list of matches.
+
+\(fn REGEXP)" t nil)
(autoload (quote psychoanalyze-pinhead) "yow" "\
-Zippy goes to the analyst." t nil)
+Zippy goes to the analyst.
+
+\(fn)" t nil)
;;;***
\f
-;;;### (autoloads (zone) "zone" "play/zone.el" (15425 28364))
+;;;### (autoloads (zone) "zone" "play/zone.el" (15678 51471))
;;; Generated autoloads from play/zone.el
(autoload (quote zone) "zone" "\
-Zone out, completely." t nil)
+Zone out, completely.
+
+\(fn)" t nil)
;;;***
\f
;;;### (autoloads (zone-mode zone-mode-update-serial-hook) "zone-mode"
-;;;;;; "net/zone-mode.el" (15391 60705))
+;;;;;; "net/zone-mode.el" (15941 42963))
;;; Generated autoloads from net/zone-mode.el
(autoload (quote zone-mode-update-serial-hook) "zone-mode" "\
-Update the serial number in a zone if the file was modified." t nil)
+Update the serial number in a zone if the file was modified.
+
+\(fn)" t nil)
(autoload (quote zone-mode) "zone-mode" "\
A mode for editing DNS zone files.
- automatically update the serial number for a zone
when saving the file
- - fontification" t nil)
-
-;;;***
-\f
-;;;### (autoloads nil nil ("language/vietnamese.el" "language/thai.el"
-;;;;;; "language/romanian.el" "language/hebrew.el" "language/greek.el"
-;;;;;; "language/chinese.el" "international/mule.el" "international/mule-cmds.el"
-;;;;;; "international/characters.el" "cus-start.el" "case-table.el"
-;;;;;; "language/japanese.el" "gnus/mm-util.el" "files.el" "language/utf-8-lang.el"
-;;;;;; "language/korean.el" "international/ja-dic-utl.el" "eshell/esh-groups.el"
-;;;;;; "textmodes/text-mode.el" "register.el" "term/xterm.el" "term/x-win.el"
-;;;;;; "term/tty-colors.el" "term/rxvt.el" "term/pc-win.el" "net/ldap.el"
-;;;;;; "net/eudcb-ph.el" "net/eudcb-ldap.el" "net/eudcb-bbdb.el"
-;;;;;; "net/eudc-vars.el" "emacs-lisp/cl-seq.el" "calendar/parse-time.el"
-;;;;;; "w32-fns.el" "scroll-bar.el" "mouse.el" "generic-x.el" "cus-load.el"
-;;;;;; "obsolete/mlsupport.el" "obsolete/hilit19.el" "obsolete/cplus-md.el"
-;;;;;; "mail/mh-pick.el" "language/georgian.el" "international/ogonek.el"
-;;;;;; "international/iso-insert.el" "calc/calc-mtx.el" "calc/calc-math.el"
-;;;;;; "calc/calc-forms.el" "gnus/nntp.el" "gnus/nnspool.el" "gnus/nnmail.el"
-;;;;;; "gnus/mailcap.el" "gnus/imap.el" "gnus/gnus-cite.el" "eshell/em-ls.el"
-;;;;;; "emulation/viper-mous.el" "emulation/viper-macs.el" "emulation/viper-keym.el"
-;;;;;; "emulation/viper-init.el" "emulation/viper-ex.el" "emulation/viper-cmd.el"
-;;;;;; "emulation/tpu-mapper.el" "emulation/edt-mapper.el" "emacs-lisp/lisp-mnt.el"
-;;;;;; "emacs-lisp/find-gc.el" "emacs-lisp/ewoc.el" "emacs-lisp/cl-macs.el"
-;;;;;; "emacs-lisp/authors.el" "textmodes/reftex-global.el" "textmodes/makeinfo.el"
-;;;;;; "textmodes/fill.el" "term/internal.el" "xscheme.el" "xml.el"
-;;;;;; "vt-control.el" "select.el" "pcvs-util.el" "pcvs-info.el"
-;;;;;; "foldout.el" "float-sup.el" "ediff-vers.el" "ediff-ptch.el"
-;;;;;; "ediff-merg.el" "ediff-diff.el" "custom.el" "buff-menu.el"
-;;;;;; "allout.el" "abbrevlist.el" "abbrev.el" "byte-run.el" "cdl.el"
-;;;;;; "cus-dep.el" "dos-fns.el" "dos-vars.el" "dos-w32.el" "electric.el"
-;;;;;; "emacs-lock.el" "env.el" "forms-d2.el" "forms-pass.el" "kermit.el"
-;;;;;; "map-ynp.el" "misc.el" "mouse-copy.el" "mouse-drag.el" "patcomp.el"
-;;;;;; "pcvs-parse.el" "regi.el" "s-region.el" "saveplace.el" "soundex.el"
-;;;;;; "tcp.el" "timezone.el" "uniquify.el" "unused.el" "vcursor.el"
-;;;;;; "vms-patch.el" "vmsproc.el" "vt100-led.el" "widget.el" "term/AT386.el"
-;;;;;; "term/apollo.el" "term/bg-mouse.el" "term/bobcat.el" "term/iris-ansi.el"
-;;;;;; "term/keyswap.el" "term/linux.el" "term/lk201.el" "term/news.el"
-;;;;;; "term/sun.el" "term/sup-mouse.el" "term/tvi970.el" "term/vt100.el"
-;;;;;; "term/vt102.el" "term/vt125.el" "term/vt200.el" "term/vt201.el"
-;;;;;; "term/vt220.el" "term/vt240.el" "term/vt300.el" "term/vt320.el"
-;;;;;; "term/vt400.el" "term/vt420.el" "term/wyse50.el" "textmodes/bib-mode.el"
-;;;;;; "textmodes/page-ext.el" "textmodes/page.el" "textmodes/refbib.el"
-;;;;;; "textmodes/refer.el" "textmodes/reftex-auc.el" "textmodes/reftex-dcr.el"
-;;;;;; "textmodes/reftex-parse.el" "textmodes/reftex-ref.el" "textmodes/reftex-toc.el"
-;;;;;; "textmodes/reftex-vars.el" "calendar/cal-china.el" "calendar/cal-coptic.el"
+ - fontification
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads nil nil ("abbrev.el" "abbrevlist.el" "bindings.el"
+;;;;;; "buff-menu.el" "calc/calc-aent.el" "calc/calc-alg.el" "calc/calc-arith.el"
+;;;;;; "calc/calc-bin.el" "calc/calc-comb.el" "calc/calc-cplx.el"
+;;;;;; "calc/calc-embed.el" "calc/calc-fin.el" "calc/calc-forms.el"
+;;;;;; "calc/calc-frac.el" "calc/calc-funcs.el" "calc/calc-graph.el"
+;;;;;; "calc/calc-help.el" "calc/calc-incom.el" "calc/calc-keypd.el"
+;;;;;; "calc/calc-lang.el" "calc/calc-macs.el" "calc/calc-maint.el"
+;;;;;; "calc/calc-map.el" "calc/calc-math.el" "calc/calc-misc.el"
+;;;;;; "calc/calc-mode.el" "calc/calc-mtx.el" "calc/calc-poly.el"
+;;;;;; "calc/calc-prog.el" "calc/calc-rewr.el" "calc/calc-rules.el"
+;;;;;; "calc/calc-sel.el" "calc/calc-stat.el" "calc/calc-store.el"
+;;;;;; "calc/calc-stuff.el" "calc/calc-trail.el" "calc/calc-undo.el"
+;;;;;; "calc/calc-units.el" "calc/calc-vec.el" "calc/calc-yank.el"
+;;;;;; "calc/calcalg2.el" "calc/calcalg3.el" "calc/calccomp.el"
+;;;;;; "calc/calcsel2.el" "calendar/cal-china.el" "calendar/cal-coptic.el"
;;;;;; "calendar/cal-french.el" "calendar/cal-islam.el" "calendar/cal-iso.el"
-;;;;;; "calendar/cal-julian.el" "calendar/cal-mayan.el" "calendar/cal-move.el"
-;;;;;; "calendar/cal-persia.el" "calendar/cal-tex.el" "calendar/cal-x.el"
-;;;;;; "emacs-lisp/assoc.el" "emacs-lisp/cl-compat.el" "emacs-lisp/cl-extra.el"
-;;;;;; "emacs-lisp/cl-specs.el" "emacs-lisp/cust-print.el" "emacs-lisp/float.el"
-;;;;;; "emacs-lisp/gulp.el" "emacs-lisp/levents.el" "emacs-lisp/lmenu.el"
-;;;;;; "emacs-lisp/lselect.el" "emacs-lisp/lucid.el" "emacs-lisp/sregex.el"
-;;;;;; "emulation/edt-lk201.el" "emulation/edt-pc.el" "emulation/edt-vt100.el"
-;;;;;; "eshell/em-banner.el" "eshell/em-basic.el" "eshell/em-script.el"
-;;;;;; "eshell/em-term.el" "eshell/em-xtra.el" "eshell/esh-arg.el"
-;;;;;; "eshell/esh-maint.el" "eshell/esh-module.el" "eshell/esh-opt.el"
-;;;;;; "eshell/esh-proc.el" "eshell/esh-util.el" "gnus/flow-fill.el"
-;;;;;; "gnus/format-spec.el" "gnus/gnus-async.el" "gnus/gnus-bcklg.el"
+;;;;;; "calendar/cal-julian.el" "calendar/cal-mayan.el" "calendar/cal-menu.el"
+;;;;;; "calendar/cal-move.el" "calendar/cal-persia.el" "calendar/cal-tex.el"
+;;;;;; "calendar/cal-x.el" "calendar/parse-time.el" "case-table.el"
- ;;;;;; "cdl.el" "cus-dep.el" "cus-load.el" "cus-start.el" "custom.el"
- ;;;;;; "dos-fns.el" "dos-vars.el" "dos-w32.el" "ediff-diff.el" "ediff-init.el"
- ;;;;;; "ediff-merg.el" "ediff-ptch.el" "ediff-vers.el" "ediff-wind.el"
- ;;;;;; "electric.el" "emacs-lisp/assoc.el" "emacs-lisp/authors.el"
++;;;;;; "cdl.el" "composite.el" "cus-dep.el" "cus-load.el" "cus-start.el"
++;;;;;; "custom.el" "dos-fns.el" "dos-vars.el" "dos-w32.el" "ediff-diff.el"
++;;;;;; "ediff-init.el" "ediff-merg.el" "ediff-ptch.el" "ediff-vers.el"
++;;;;;; "ediff-wind.el" "electric.el" "emacs-lisp/assoc.el" "emacs-lisp/authors.el"
+;;;;;; "emacs-lisp/bindat.el" "emacs-lisp/byte-opt.el" "emacs-lisp/byte-run.el"
+;;;;;; "emacs-lisp/cl-compat.el" "emacs-lisp/cl-extra.el" "emacs-lisp/cl-macs.el"
+;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/cl-specs.el" "emacs-lisp/cust-print.el"
+;;;;;; "emacs-lisp/ewoc.el" "emacs-lisp/find-gc.el" "emacs-lisp/float-sup.el"
+;;;;;; "emacs-lisp/gulp.el" "emacs-lisp/levents.el" "emacs-lisp/lisp-mnt.el"
+;;;;;; "emacs-lisp/lisp-mode.el" "emacs-lisp/lisp.el" "emacs-lisp/lmenu.el"
+;;;;;; "emacs-lisp/lselect.el" "emacs-lisp/lucid.el" "emacs-lisp/map-ynp.el"
+;;;;;; "emacs-lisp/regi.el" "emacs-lisp/sregex.el" "emacs-lisp/testcover-ses.el"
+;;;;;; "emacs-lisp/testcover-unsafep.el" "emacs-lock.el" "emulation/cua-gmrk.el"
+;;;;;; "emulation/cua-rect.el" "emulation/edt-lk201.el" "emulation/edt-mapper.el"
+;;;;;; "emulation/edt-pc.el" "emulation/edt-vt100.el" "emulation/tpu-mapper.el"
+;;;;;; "emulation/viper-cmd.el" "emulation/viper-ex.el" "emulation/viper-init.el"
+;;;;;; "emulation/viper-keym.el" "emulation/viper-macs.el" "emulation/viper-mous.el"
+;;;;;; "emulation/viper-util.el" "env.el" "eshell/em-alias.el" "eshell/em-banner.el"
+;;;;;; "eshell/em-basic.el" "eshell/em-cmpl.el" "eshell/em-dirs.el"
+;;;;;; "eshell/em-glob.el" "eshell/em-hist.el" "eshell/em-ls.el"
+;;;;;; "eshell/em-pred.el" "eshell/em-prompt.el" "eshell/em-rebind.el"
+;;;;;; "eshell/em-script.el" "eshell/em-smart.el" "eshell/em-term.el"
+;;;;;; "eshell/em-unix.el" "eshell/em-xtra.el" "eshell/esh-arg.el"
+;;;;;; "eshell/esh-cmd.el" "eshell/esh-ext.el" "eshell/esh-groups.el"
+;;;;;; "eshell/esh-io.el" "eshell/esh-maint.el" "eshell/esh-module.el"
+;;;;;; "eshell/esh-opt.el" "eshell/esh-proc.el" "eshell/esh-util.el"
+;;;;;; "eshell/esh-var.el" "faces.el" "files.el" "filesets.el" "finder-inf.el"
+;;;;;; "foldout.el" "font-core.el" "format.el" "forms-d2.el" "forms-pass.el"
+;;;;;; "frame.el" "generic-x.el" "gnus/flow-fill.el" "gnus/format-spec.el"
+;;;;;; "gnus/gnus-async.el" "gnus/gnus-bcklg.el" "gnus/gnus-cite.el"
;;;;;; "gnus/gnus-cus.el" "gnus/gnus-demon.el" "gnus/gnus-draft.el"
;;;;;; "gnus/gnus-dup.el" "gnus/gnus-eform.el" "gnus/gnus-ems.el"
;;;;;; "gnus/gnus-gl.el" "gnus/gnus-int.el" "gnus/gnus-logic.el"
;;;;;; "gnus/gnus-mh.el" "gnus/gnus-nocem.el" "gnus/gnus-range.el"
;;;;;; "gnus/gnus-salt.el" "gnus/gnus-score.el" "gnus/gnus-setup.el"
-;;;;;; "gnus/gnus-srvr.el" "gnus/gnus-topic.el" "gnus/gnus-undo.el"
-;;;;;; "gnus/gnus-util.el" "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/ietf-drums.el"
-;;;;;; "gnus/mail-parse.el" "gnus/mail-prsvr.el" "gnus/messcompat.el"
-;;;;;; "gnus/mm-bodies.el" "gnus/mm-decode.el" "gnus/nnagent.el"
-;;;;;; "gnus/nnbabyl.el" "gnus/nndir.el" "gnus/nndraft.el" "gnus/nneething.el"
-;;;;;; "gnus/nngateway.el" "gnus/nnheader.el" "gnus/nnimap.el" "gnus/nnlistserv.el"
-;;;;;; "gnus/nnmbox.el" "gnus/nnmh.el" "gnus/nnoo.el" "gnus/nnslashdot.el"
-;;;;;; "gnus/nnultimate.el" "gnus/nnvirtual.el" "gnus/nnwarchive.el"
+;;;;;; "gnus/gnus-srvr.el" "gnus/gnus-sum.el" "gnus/gnus-topic.el"
+;;;;;; "gnus/gnus-undo.el" "gnus/gnus-util.el" "gnus/gnus-uu.el"
+;;;;;; "gnus/gnus-vm.el" "gnus/ietf-drums.el" "gnus/imap.el" "gnus/mail-parse.el"
+;;;;;; "gnus/mail-prsvr.el" "gnus/mail-source.el" "gnus/mailcap.el"
+;;;;;; "gnus/messcompat.el" "gnus/mm-bodies.el" "gnus/mm-decode.el"
+;;;;;; "gnus/mm-encode.el" "gnus/mm-util.el" "gnus/mm-view.el" "gnus/mml.el"
+;;;;;; "gnus/nnagent.el" "gnus/nnbabyl.el" "gnus/nndir.el" "gnus/nndraft.el"
+;;;;;; "gnus/nneething.el" "gnus/nngateway.el" "gnus/nnheader.el"
+;;;;;; "gnus/nnimap.el" "gnus/nnlistserv.el" "gnus/nnmail.el" "gnus/nnmbox.el"
+;;;;;; "gnus/nnmh.el" "gnus/nnoo.el" "gnus/nnslashdot.el" "gnus/nnspool.el"
+;;;;;; "gnus/nntp.el" "gnus/nnultimate.el" "gnus/nnvirtual.el" "gnus/nnwarchive.el"
;;;;;; "gnus/nnweb.el" "gnus/pop3.el" "gnus/qp.el" "gnus/rfc1843.el"
;;;;;; "gnus/rfc2045.el" "gnus/rfc2047.el" "gnus/rfc2104.el" "gnus/rfc2231.el"
-;;;;;; "gnus/starttls.el" "gnus/utf7.el" "gnus/webmail.el" "calc/calc-aent.el"
-;;;;;; "calc/calc-alg.el" "calc/calc-arith.el" "calc/calc-bin.el"
-;;;;;; "calc/calc-comb.el" "calc/calc-cplx.el" "calc/calc-embed.el"
-;;;;;; "calc/calc-fin.el" "calc/calc-frac.el" "calc/calc-funcs.el"
-;;;;;; "calc/calc-graph.el" "calc/calc-help.el" "calc/calc-incom.el"
-;;;;;; "calc/calc-keypd.el" "calc/calc-lang.el" "calc/calc-map.el"
-;;;;;; "calc/calc-misc.el" "calc/calc-mode.el" "calc/calc-poly.el"
-;;;;;; "calc/calc-prog.el" "calc/calc-rewr.el" "calc/calc-rules.el"
-;;;;;; "calc/calc-sel.el" "calc/calc-stat.el" "calc/calc-store.el"
-;;;;;; "calc/calc-stuff.el" "calc/calc-trail.el" "calc/calc-undo.el"
-;;;;;; "calc/calc-units.el" "calc/calc-vec.el" "calc/calc-yank.el"
-;;;;;; "calc/calccomp.el" "calc/calcsel2.el" "international/iso-ascii.el"
-;;;;;; "international/iso-swed.el" "international/swedish.el" "language/devanagari.el"
-;;;;;; "language/ethiopic.el" "language/misc-lang.el" "mail/blessmail.el"
-;;;;;; "mail/mailheader.el" "mail/mailpost.el" "mail/mh-funcs.el"
-;;;;;; "mail/mh-seq.el" "mail/mspools.el" "mail/rfc2368.el" "mail/rfc822.el"
-;;;;;; "mail/vms-pmail.el" "obsolete/c-mode.el" "obsolete/ooutline.el"
-;;;;;; "obsolete/profile.el" "obsolete/rnews.el" "obsolete/sc.el"
-;;;;;; "obsolete/sun-curs.el" "obsolete/sun-fns.el" "obsolete/uncompress.el"
-;;;;;; "obsolete/x-apollo.el" "obsolete/x-menu.el" "play/gametree.el"
-;;;;;; "play/meese.el" "progmodes/ada-prj.el" "progmodes/ada-xref.el"
-;;;;;; "progmodes/cc-align.el" "progmodes/cc-bytecomp.el" "progmodes/cc-cmds.el"
-;;;;;; "progmodes/cc-compat.el" "progmodes/cc-defs.el" "progmodes/cc-engine.el"
-;;;;;; "progmodes/cc-menus.el" "progmodes/ebnf-bnf.el" "progmodes/ebnf-iso.el"
-;;;;;; "progmodes/ebnf-otz.el" "progmodes/ebnf-yac.el" "progmodes/idlw-rinfo.el"
-;;;;;; "progmodes/idlw-toolbar.el" "progmodes/mantemp.el" "emacs-lisp/lisp-mode.el"
-;;;;;; "term/sun-mouse.el" "ediff-hook.el" "ediff-init.el" "ediff-wind.el"
-;;;;;; "finder-inf.el" "indent.el" "startup.el" "window.el" "calendar/cal-menu.el"
-;;;;;; "gnus/mm-view.el" "gnus/mml.el" "emulation/viper-util.el"
-;;;;;; "play/gamegrid.el" "bindings.el" "faces.el" "frame.el" "help.el"
-;;;;;; "isearch.el" "loadup.el" "menu-bar.el" "paths.el" "replace.el"
-;;;;;; "simple.el" "subr.el" "tempo.el" "vc-hooks.el" "version.el"
-;;;;;; "w32-vars.el" "calc/calc-macs.el" "calc/calc-maint.el" "calc/calcalg2.el"
-;;;;;; "calc/calcalg3.el" "emacs-lisp/lisp.el" "eshell/em-alias.el"
-;;;;;; "eshell/em-cmpl.el" "eshell/em-dirs.el" "eshell/em-glob.el"
-;;;;;; "eshell/em-hist.el" "eshell/em-pred.el" "eshell/em-prompt.el"
-;;;;;; "eshell/em-rebind.el" "eshell/em-smart.el" "eshell/em-unix.el"
-;;;;;; "eshell/esh-cmd.el" "eshell/esh-ext.el" "eshell/esh-io.el"
-;;;;;; "eshell/esh-var.el" "gnus/gnus-sum.el" "gnus/mail-source.el"
-;;;;;; "gnus/mm-encode.el" "international/ja-dic-cnv.el" "international/latin-1.el"
-;;;;;; "international/latin-2.el" "international/latin-3.el" "international/latin-4.el"
-;;;;;; "international/latin-5.el" "international/latin-8.el" "international/latin-9.el"
-;;;;;; "language/czech.el" "language/indian.el" "language/lao.el"
-;;;;;; "language/slovak.el" "language/tibetan.el" "mail/uce.el"
-;;;;;; "term/mac-win.el" "term/w32-win.el" "textmodes/paragraphs.el"
-;;;;;; "textmodes/reftex-sel.el" "textmodes/texnfo-upd.el" "format.el"
-;;;;;; "emacs-lisp/byte-opt.el" "language/cyrillic.el" "language/english.el"
-;;;;;; "language/european.el" "subdirs.el" "international/mule-conf.el")
-;;;;;; (15615 27730 560182))
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; End:
-;;; loaddefs.elends here
+;;;;;; "gnus/starttls.el" "gnus/utf7.el" "gnus/webmail.el" "help.el"
+;;;;;; "indent.el" "international/characters.el" "international/fontset.el"
+;;;;;; "international/iso-ascii.el" "international/iso-insert.el"
+;;;;;; "international/iso-swed.el" "international/ja-dic-cnv.el"
- ;;;;;; "international/ja-dic-utl.el" "international/latin-1.el"
- ;;;;;; "international/latin-2.el" "international/latin-3.el" "international/latin-4.el"
- ;;;;;; "international/latin-5.el" "international/latin-8.el" "international/latin-9.el"
- ;;;;;; "international/mule-cmds.el" "international/mule-conf.el"
- ;;;;;; "international/mule.el" "international/ogonek.el" "international/subst-big5.el"
- ;;;;;; "international/subst-gb2312.el" "international/subst-jis.el"
- ;;;;;; "international/subst-ksc.el" "international/swedish.el" "international/ucs-tables.el"
- ;;;;;; "international/utf-16.el" "international/utf-7.el" "international/utf-8.el"
- ;;;;;; "isearch.el" "kermit.el" "language/chinese.el" "language/cyrillic.el"
++;;;;;; "international/ja-dic-utl.el" "international/mule-cmds.el"
++;;;;;; "international/mule-conf.el" "international/mule.el" "international/ogonek.el"
++;;;;;; "international/swedish.el" "international/utf-7.el" "isearch.el"
++;;;;;; "kermit.el" "language/chinese.el" "language/cyrillic.el"
+;;;;;; "language/czech.el" "language/devanagari.el" "language/english.el"
+;;;;;; "language/ethiopic.el" "language/european.el" "language/georgian.el"
+;;;;;; "language/greek.el" "language/hebrew.el" "language/indian.el"
+;;;;;; "language/japanese.el" "language/korean.el" "language/lao.el"
+;;;;;; "language/malayalam.el" "language/misc-lang.el" "language/romanian.el"
+;;;;;; "language/slovak.el" "language/tamil.el" "language/thai.el"
+;;;;;; "language/tibetan.el" "language/utf-8-lang.el" "language/vietnamese.el"
+;;;;;; "loadup.el" "mail/blessmail.el" "mail/mailheader.el" "mail/mailpost.el"
+;;;;;; "mail/mspools.el" "mail/rfc2368.el" "mail/rfc822.el" "mail/rmail-spam-filter.el"
+;;;;;; "mail/uce.el" "mail/vms-pmail.el" "mh-e/mh-alias.el" "mh-e/mh-customize.el"
+;;;;;; "mh-e/mh-funcs.el" "mh-e/mh-identity.el" "mh-e/mh-inc.el"
+;;;;;; "mh-e/mh-index.el" "mh-e/mh-junk.el" "mh-e/mh-loaddefs.el"
+;;;;;; "mh-e/mh-mime.el" "mh-e/mh-pick.el" "mh-e/mh-seq.el" "mh-e/mh-speed.el"
+;;;;;; "mh-e/mh-xemacs-compat.el" "mh-e/mh-xemacs-icons.el" "misc.el"
+;;;;;; "mouse-copy.el" "mouse-drag.el" "mouse.el" "net/eudc-vars.el"
+;;;;;; "net/eudcb-bbdb.el" "net/eudcb-ldap.el" "net/eudcb-ph.el"
+;;;;;; "net/ldap.el" "net/netrc.el" "net/tls.el" "net/tramp-ftp.el"
+;;;;;; "net/tramp-smb.el" "net/tramp-util.el" "net/tramp-uu.el"
+;;;;;; "net/tramp-vc.el" "net/trampver.el" "obsolete/awk-mode.el"
+;;;;;; "obsolete/float.el" "obsolete/hilit19.el" "obsolete/mlsupport.el"
+;;;;;; "obsolete/ooutline.el" "obsolete/profile.el" "obsolete/rnews.el"
+;;;;;; "obsolete/sc.el" "obsolete/sun-curs.el" "obsolete/sun-fns.el"
+;;;;;; "obsolete/uncompress.el" "obsolete/x-apollo.el" "obsolete/x-menu.el"
+;;;;;; "patcomp.el" "paths.el" "pcvs-info.el" "pcvs-parse.el" "pcvs-util.el"
+;;;;;; "play/gamegrid.el" "play/gametree.el" "play/meese.el" "progmodes/ada-prj.el"
- ;;;;;; "progmodes/cc-align.el" "progmodes/cc-awk.el" "progmodes/cc-bytecomp.el"
- ;;;;;; "progmodes/cc-cmds.el" "progmodes/cc-compat.el" "progmodes/cc-defs.el"
- ;;;;;; "progmodes/cc-engine.el" "progmodes/cc-fonts.el" "progmodes/cc-langs.el"
- ;;;;;; "progmodes/cc-menus.el" "progmodes/cc-vars.el" "progmodes/ebnf-bnf.el"
- ;;;;;; "progmodes/ebnf-iso.el" "progmodes/ebnf-otz.el" "progmodes/ebnf-yac.el"
- ;;;;;; "progmodes/idlw-rinfo.el" "progmodes/idlw-toolbar.el" "progmodes/mantemp.el"
- ;;;;;; "progmodes/xscheme.el" "register.el" "replace.el" "s-region.el"
- ;;;;;; "saveplace.el" "scroll-bar.el" "select.el" "simple.el" "soundex.el"
- ;;;;;; "startup.el" "subdirs.el" "subr.el" "tempo.el" "term/AT386.el"
- ;;;;;; "term/apollo.el" "term/bg-mouse.el" "term/bobcat.el" "term/internal.el"
- ;;;;;; "term/iris-ansi.el" "term/keyswap.el" "term/linux.el" "term/lk201.el"
- ;;;;;; "term/mac-win.el" "term/news.el" "term/pc-win.el" "term/rxvt.el"
- ;;;;;; "term/sun-mouse.el" "term/sun.el" "term/sup-mouse.el" "term/tty-colors.el"
- ;;;;;; "term/tvi970.el" "term/vt100.el" "term/vt102.el" "term/vt125.el"
- ;;;;;; "term/vt200.el" "term/vt201.el" "term/vt220.el" "term/vt240.el"
- ;;;;;; "term/vt300.el" "term/vt320.el" "term/vt400.el" "term/vt420.el"
- ;;;;;; "term/w32-win.el" "term/wyse50.el" "term/x-win.el" "term/xterm.el"
- ;;;;;; "textmodes/bib-mode.el" "textmodes/fill.el" "textmodes/makeinfo.el"
- ;;;;;; "textmodes/page-ext.el" "textmodes/page.el" "textmodes/paragraphs.el"
- ;;;;;; "textmodes/refbib.el" "textmodes/refer.el" "textmodes/reftex-auc.el"
- ;;;;;; "textmodes/reftex-dcr.el" "textmodes/reftex-global.el" "textmodes/reftex-ref.el"
- ;;;;;; "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" "textmodes/reftex-vars.el"
- ;;;;;; "textmodes/texnfo-upd.el" "textmodes/text-mode.el" "timezone.el"
- ;;;;;; "uniquify.el" "vc-hooks.el" "vcursor.el" "version.el" "vms-patch.el"
- ;;;;;; "vmsproc.el" "vt-control.el" "vt100-led.el" "w32-fns.el"
- ;;;;;; "w32-vars.el" "widget.el" "window.el") (16174 63124 427475))
++;;;;;; "progmodes/cap-words.el" "progmodes/cc-align.el" "progmodes/cc-awk.el"
++;;;;;; "progmodes/cc-bytecomp.el" "progmodes/cc-cmds.el" "progmodes/cc-compat.el"
++;;;;;; "progmodes/cc-defs.el" "progmodes/cc-engine.el" "progmodes/cc-fonts.el"
++;;;;;; "progmodes/cc-langs.el" "progmodes/cc-menus.el" "progmodes/cc-vars.el"
++;;;;;; "progmodes/ebnf-bnf.el" "progmodes/ebnf-iso.el" "progmodes/ebnf-otz.el"
++;;;;;; "progmodes/ebnf-yac.el" "progmodes/idlw-rinfo.el" "progmodes/idlw-toolbar.el"
++;;;;;; "progmodes/mantemp.el" "progmodes/xscheme.el" "register.el"
++;;;;;; "replace.el" "s-region.el" "saveplace.el" "scroll-bar.el"
++;;;;;; "select.el" "simple.el" "soundex.el" "startup.el" "subdirs.el"
++;;;;;; "subr.el" "tempo.el" "term/AT386.el" "term/apollo.el" "term/bg-mouse.el"
++;;;;;; "term/bobcat.el" "term/internal.el" "term/iris-ansi.el" "term/keyswap.el"
++;;;;;; "term/linux.el" "term/lk201.el" "term/mac-win.el" "term/news.el"
++;;;;;; "term/pc-win.el" "term/rxvt.el" "term/sun-mouse.el" "term/sun.el"
++;;;;;; "term/sup-mouse.el" "term/tty-colors.el" "term/tvi970.el"
++;;;;;; "term/vt100.el" "term/vt102.el" "term/vt125.el" "term/vt200.el"
++;;;;;; "term/vt201.el" "term/vt220.el" "term/vt240.el" "term/vt300.el"
++;;;;;; "term/vt320.el" "term/vt400.el" "term/vt420.el" "term/w32-win.el"
++;;;;;; "term/wyse50.el" "term/x-win.el" "term/xterm.el" "textmodes/bib-mode.el"
++;;;;;; "textmodes/fill.el" "textmodes/makeinfo.el" "textmodes/page-ext.el"
++;;;;;; "textmodes/page.el" "textmodes/paragraphs.el" "textmodes/refbib.el"
++;;;;;; "textmodes/refer.el" "textmodes/reftex-auc.el" "textmodes/reftex-dcr.el"
++;;;;;; "textmodes/reftex-global.el" "textmodes/reftex-ref.el" "textmodes/reftex-sel.el"
++;;;;;; "textmodes/reftex-toc.el" "textmodes/reftex-vars.el" "textmodes/texnfo-upd.el"
++;;;;;; "textmodes/text-mode.el" "timezone.el" "uniquify.el" "vc-hooks.el"
++;;;;;; "vcursor.el" "version.el" "vms-patch.el" "vmsproc.el" "vt-control.el"
++;;;;;; "vt100-led.el" "w32-fns.el" "w32-vars.el" "widget.el" "window.el")
++;;;;;; (16205 43209 430396))
+
+;;;***
+\f
+;;; Local Variables:
+;;; version-control: never
+;;; no-byte-compile: t
+;;; no-update-autoloads: t
+;;; End:
+;;; loaddefs.el ends here
(equal (nth 4 command-line-args) "bootstrap")
;; in case CANNOT_DUMP
(equal (nth 0 command-line-args) "../src/bootstrap-emacs"))
- (let ((path (car load-path)))
- (setq load-path (list path
- (expand-file-name "emacs-lisp" path)
- (expand-file-name "language" path)
- (expand-file-name "international" path)))))
+ (let ((dir (car load-path)))
+ ;; We'll probably overflow the pure space.
+ (setq purify-flag nil)
+ (setq load-path (list dir
+ (expand-file-name "emacs-lisp" dir)
+ (expand-file-name "language" dir)
+ (expand-file-name "international" dir)
+ (expand-file-name "textmodes" dir)))))
(message "Using load-path %s" load-path)
-;;; We don't want to have any undo records in the dumped Emacs.
+;; We don't want to have any undo records in the dumped Emacs.
(buffer-disable-undo "*scratch*")
-(load "byte-run")
+(load "emacs-lisp/byte-run")
+(load "emacs-lisp/backquote")
(load "subr")
;; We specify .el in case someone compiled version.el by mistake.
(load "widget")
(load "custom")
-(load "emacs-lisp/backquote")
-(load "map-ynp")
+(load "emacs-lisp/map-ynp")
(load "env")
(load "cus-start")
(load "international/mule")
(load "format")
(load "bindings")
(setq load-source-file-function 'load-with-code-conversion)
-(load "simple")
(load "files")
+(load "cus-face")
(load "faces") ; after here, `defface' may be used.
(message "Lists of integers (garbage collection statistics) are normal output")
(message "%s" (garbage-collect))
(load "loaddefs.el") ;Don't get confused if someone compiled this by mistake.
(message "%s" (garbage-collect))
+(load "simple")
(load "help")
;; multilingual text.
(load "international/mule-cmds")
(load "case-table")
- (load "international/utf-8")
- (load "international/utf-16")
+ (load "composite")
(load "international/characters")
- (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/indian")
-(load "language/devanagari") ; This should be loaded after indian.
+(load "language/devanagari") ; This should be loaded after indian.
+(load "language/malayalam") ; This should be loaded after indian.
+(load "language/tamil") ; This should be loaded after indian.
(load "language/english")
(load "language/ethiopic")
(load "language/european")
(load "language/utf-8-lang")
(load "language/georgian")
- (load "international/ucs-tables")
-
- (update-coding-systems-internal)
-
(load "indent")
(load "window")
(load "frame")
(load "term/tty-colors")
+(load "font-core")
(if (fboundp 'frame-face-alist)
(progn
(and (boundp 'x-toolkit-scroll-bars)
(load "scroll-bar"))
(load "select")))
+(load "emacs-lisp/timer")
(load "isearch")
(message "%s" (garbage-collect))
(load "ls-lisp")))
(if (fboundp 'atan) ; preload some constants and
(progn ; floating pt. functions if we have float support.
- (load "float-sup")))
+ (load "emacs-lisp/float-sup")))
(message "%s" (garbage-collect))
(load "vc-hooks")
(versions (mapcar (function (lambda (name)
(string-to-int (substring name (length base)))))
files)))
- (setq emacs-version (format "%s.%d"
- emacs-version
- (if versions
- (1+ (apply 'max versions))
- 1)))))
+ ;; `emacs-version' is a constant, so we shouldn't change it with `setq'.
+ (defconst emacs-version
+ (format "%s.%d"
+ emacs-version (if versions (1+ (apply 'max versions)) 1)))))
;; Note: all compiled Lisp files loaded above this point
;; must be among the ones parsed by make-docfile
;; Write the value of load-history into fns-VERSION.el,
;; then clear out load-history.
-(if (or (equal (nth 3 command-line-args) "dump")
- (equal (nth 4 command-line-args) "dump"))
- (let ((buffer-undo-list t)
- (coding-system-for-write 'utf-8))
- (princ "(setq load-history\n" (current-buffer))
- (princ " (nconc load-history\n" (current-buffer))
- (princ " '(" (current-buffer))
- (let ((tem load-history))
- (while tem
- (prin1 (car tem) (current-buffer))
- (terpri (current-buffer))
- (if (cdr tem)
- (princ " " (current-buffer)))
- (setq tem (cdr tem))))
- (princ ")))\n" (current-buffer))
- (write-region (point-min) (point-max)
- (expand-file-name
- (cond
- ((eq system-type 'ms-dos)
- "../lib-src/fns.el")
- ((eq system-type 'windows-nt)
- (format "../../../lib-src/fns-%s.el" emacs-version))
- (t
- (format "../lib-src/fns-%s.el" emacs-version)))
- invocation-directory))
- (erase-buffer)
- (setq load-history nil))
- (setq symbol-file-load-history-loaded t))
+;; (if (or (equal (nth 3 command-line-args) "dump")
+;; (equal (nth 4 command-line-args) "dump"))
+;; (let ((buffer-undo-list t))
+;; (princ "(setq load-history\n" (current-buffer))
+;; (princ " (nconc load-history\n" (current-buffer))
+;; (princ " '(" (current-buffer))
+;; (let ((tem load-history))
+;; (while tem
+;; (prin1 (car tem) (current-buffer))
+;; (terpri (current-buffer))
+;; (if (cdr tem)
+;; (princ " " (current-buffer)))
+;; (setq tem (cdr tem))))
+;; (princ ")))\n" (current-buffer))
+;; (write-region (point-min) (point-max)
+;; (expand-file-name
+;; (cond
+;; ((eq system-type 'ms-dos)
+;; "../lib-src/fns.el")
+;; ((eq system-type 'windows-nt)
+;; (format "../../../lib-src/fns-%s.el" emacs-version))
+;; (t
+;; (format "../lib-src/fns-%s.el" emacs-version)))
+;; invocation-directory))
+;; (erase-buffer)
+;; (setq load-history nil))
+;; (setq symbol-file-load-history-loaded t))
+;; We don't use this fns-*.el file. Instead we keep the data in PURE space.
+;; Make sure that the spine of the list is not in pure space because it can
+;; be destructively mutated in lread.c:build_load_history.
+(setq load-history (mapcar 'purecopy load-history))
+(setq symbol-file-load-history-loaded t)
+
(set-buffer-modified-p nil)
;; reset the load-path. See lread.c:init_lread why.
(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.
(buffer-enable-undo "*scratch*")
+(if (null (garbage-collect))
+ (setq pure-space-overflow t))
+
(if (or (member (nth 3 command-line-args) '("dump" "bootstrap"))
(member (nth 4 command-line-args) '("dump" "bootstrap")))
(if (eq system-type 'vax-vms)
(eval top-level)
+\f
+;;; Local Variables:
+;;; no-byte-compile: t
+;;; no-update-autoloads: t
+;;; End:
;;; loadup.el ends here
;;; sendmail.el --- mail sending commands for Emacs. -*- byte-compile-dynamic: t -*-
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 98, 2000, 2001
+;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 98, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Maintainer: FSF
The value used to specify it is whatever is found in
`mail-envelope-from', with `user-mail-address' as fallback.
-On most systems, specifying the envelope-from address
-is a privileged operation."
+On most systems, specifying the envelope-from address is a
+privileged operation. This variable is only used if
+`send-mail-function' is set to `sendmail-send-it'."
:version "21.1"
:type 'boolean
:group 'sendmail)
(defcustom mail-envelope-from nil
"*If non-nil, designate the envelope-from address when sending mail.
-If this is nil while `mail-specify-envelope-from' is non-nil, the
-content of `user-mail-address' is used."
+This only has an effect if `mail-specify-envelope-from' is non-nil.
+The value should be either a string, or the symbol `header' (in
+which case the contents of the \"From\" header of the message
+being sent is used), or nil (in which case the value of
+`user-mail-address' is used)."
:version "21.1"
:type '(choice (string :tag "From-name")
+ (const :tag "Use From: header from message" header)
(const :tag "Use `user-mail-address'" nil))
:group 'sendmail)
which is the standard way to delimit a signature in a message.)
Otherwise, it should be an expression; it is evaluated
and should insert whatever you want to insert."
- :type '(choice (const "None" nil)
+ :type '(choice (const :tag "None" nil)
(const :tag "Use `.signature' file" t)
(string :tag "String to insert")
(sexp :tag "Expression to evaluate"))
:type 'file
:group 'sendmail)
+;;;###autoload
+(defcustom mail-default-directory "~/"
+ "*Directory for mail buffers.
+Value of `default-directory' for mail buffers.
+This directory is used for auto-save files of mail buffers."
+ :type '(directory :tag "Directory")
+ :group 'sendmail
+ :version "21.4")
+
(defvar mail-reply-action nil)
(defvar mail-send-actions nil
"A list of actions to be performed upon successful sending of a message.")
:type '(choice (const t) (const nil) (const query) (const mime))
:group 'sendmail)
+(defcustom mail-use-dsn nil
+ "*Ask MTA for notification of failed, delayed or successful delivery.
+Note that only some MTAs (currently only recent versions of Sendmail)
+support Delivery Status Notification."
+ :group 'sendmail
+ :type '(repeat (radio (const :tag "Failure" failure)
+ (const :tag "Delay" delay)
+ (const :tag "Success" success)))
+ :version "21.4")
+
;; Note: could use /usr/ucb/mail instead of sendmail;
;; options -t, and -v if not interactive.
(defvar mail-mailer-swallows-blank-line
(beginning-of-line) (end-of-line)
(2 font-lock-constant-face nil t)
(4 font-lock-comment-face nil t)))
- '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*"
+ '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*\\(\n[ \t]+.*\\)*$"
. font-lock-string-face))))
"Additional expressions to highlight in Mail mode.")
:type 'hook
:options '(footnote-mode))
+(defvar mail-mode-abbrev-table text-mode-abbrev-table)
;;;###autoload
(define-derived-mode mail-mode text-mode "Mail"
"Major mode for editing mail to be sent.
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(mail-font-lock-keywords t t))
(make-local-variable 'paragraph-separate)
- (make-local-variable 'paragraph-start)
(make-local-variable 'normal-auto-fill-function)
(setq normal-auto-fill-function 'mail-mode-auto-fill)
(make-local-variable 'fill-paragraph-function)
;; lines that delimit forwarded messages.
;; Lines containing just >= 3 dashes, perhaps after whitespace,
;; are also sometimes used and should be separators.
- (setq paragraph-start (concat (regexp-quote mail-header-separator)
+ (setq paragraph-separate (concat (regexp-quote mail-header-separator)
"$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
"\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
- "-- $\\|---+$\\|"
- page-delimiter))
- (setq paragraph-separate paragraph-start))
+ "--\\( \\|-+\\)$\\|"
+ page-delimiter)))
(defun mail-header-end ()
(defun mail-mode-fill-paragraph (arg)
;; Do something special only if within the headers.
(if (< (point) (mail-header-end))
- (let (beg end fieldname)
+ (let (beg end fieldname)
(when (prog1 (re-search-backward "^[-a-zA-Z]+:" nil 'yes)
(setq beg (point)))
(setq fieldname
(define-key mail-mode-map "\C-c\C-t" 'mail-text)
(define-key mail-mode-map "\C-c\C-y" 'mail-yank-original)
(define-key mail-mode-map "\C-c\C-r" 'mail-yank-region)
+ (define-key mail-mode-map [remap split-line] 'mail-split-line)
(define-key mail-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
(define-key mail-mode-map "\C-c\C-w" 'mail-signature)
(define-key mail-mode-map "\C-c\C-v" 'mail-sent-via)
\f
;; User-level commands for sending.
-(defun mail-send-and-exit (arg)
+(defun mail-send-and-exit (&optional arg)
"Send message like `mail-send', then, if no errors, exit from mail buffer.
Prefix arg means don't delete this window."
(interactive "P")
(mail-send)
(mail-bury arg))
-(defun mail-dont-send (arg)
+(defun mail-dont-send (&optional arg)
"Don't send the message you have been editing.
Prefix arg means don't delete this window."
(interactive "P")
(mail-bury arg))
-(defun mail-bury (arg)
+(defun mail-bury (&optional arg)
"Bury this mail buffer."
(let ((newbuf (other-buffer (current-buffer))))
(bury-buffer (current-buffer))
(progn
(set-buffer-modified-p nil)
(delete-auto-save-file-if-necessary t))))))
+
+(defun mail-envelope-from ()
+ "Return the envelope mail address to use when sending mail.
+This function uses `mail-envelope-from'."
+ (if (eq mail-envelope-from 'header)
+ (nth 1 (mail-extract-address-components
+ (mail-fetch-field "From")))
+ mail-envelope-from))
\f
;; This does the real work of sending a message via sendmail.
;; It is called via the variable send-mail-function.
(generate-new-buffer " sendmail errors")
0))
(tembuf (generate-new-buffer " sendmail temp"))
+ (multibyte enable-multibyte-characters)
(case-fold-search nil)
- (coding (and (local-variable-p 'buffer-file-coding-system)
- buffer-file-coding-system))
- selected-coding
+ (selected-coding (select-message-coding-system))
;;; resend-to-addresses
delimline
fcc-was-found
;; local binding in the mail buffer will take effect.
(envelope-from
(and mail-specify-envelope-from
- (or mail-envelope-from user-mail-address))))
+ (or (mail-envelope-from) user-mail-address))))
(unwind-protect
(save-excursion
(set-buffer tembuf)
(erase-buffer)
+ (unless multibyte
+ (set-buffer-multibyte nil))
(insert-buffer-substring mailbuf)
- (set-buffer-file-coding-system coding)
(goto-char (point-max))
;; require one newline at the end.
(or (= (preceding-char) ?\n)
;; ... then undo escaping of matching parentheses,
;; including matching nested parentheses.
(goto-char fullname-start)
- (while (re-search-forward
+ (while (re-search-forward
"\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
fullname-end 1)
(replace-match "\\1(\\3)" t)
(not (re-search-forward "^MIME-version:" delimline t))
(progn (skip-chars-forward "\0-\177")
(/= (point) (point-max)))
- (setq selected-coding (select-message-coding-system))
+ 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="
\\|^resent-cc:\\|^resent-bcc:"
delimline t))
(let* ((default-directory "/")
- (coding-system-for-write
- (or selected-coding
- (select-message-coding-system)))
- (args
+ (coding-system-for-write selected-coding)
+ (args
(append (list (point-min) (point-max)
program
nil errbuf nil "-oi")
;;; (or resend-to-addresses
'("-t")
;;; )
+ (if mail-use-dsn
+ (list "-N" (mapconcat 'symbol-name
+ mail-use-dsn ",")))
)
)
(exit-value (apply 'call-process-region args)))
(mail-position-on-field "to"))
(insert "\nFCC: " folder))
-(defun mail-reply-to ()
+(defun mail-reply-to ()
"Move point to end of Reply-To-field. Create a Reply-To field if none."
(interactive)
(expand-abbrev)
(goto-char (mail-text-start)))
\f
(defun mail-signature (&optional atpoint)
- "Sign letter with contents of the file `mail-signature-file'.
+ "Sign letter with signature based on `mail-signature-file'.
Prefix arg means put contents at point."
(interactive "P")
(save-excursion
(end-of-line)
(or atpoint
(delete-region (point) (point-max)))
- (insert "\n\n-- \n")
- (insert-file-contents (expand-file-name mail-signature-file))))
+ (if (stringp mail-signature)
+ (insert mail-signature)
+ (insert "\n\n-- \n")
+ (insert-file-contents (expand-file-name mail-signature-file)))))
(defun mail-fill-yanked-message (&optional justifyp)
"Fill the paragraphs of a message yanked into this one.
(if mail-yank-hooks
(run-hooks 'mail-yank-hooks)
(mail-indent-citation))))))))
+
+(defun mail-split-line ()
+ "Split current line, moving portion beyond point vertically down.
+If the current line has `mail-yank-prefix', insert it on the new line."
+ (interactive "*")
+ (split-line mail-yank-prefix))
+
\f
(defun mail-attach-file (&optional file)
"Insert a file at the end of the buffer, with separator lines around it."
;;; (message "Auto save file for draft message exists; consider M-x mail-recover"))
;;; t))
(pop-to-buffer "*mail*")
- ;; Put the auto-save file in the home dir
- ;; to avoid any danger that it can't be written.
- (if (file-exists-p (expand-file-name "~/"))
- (setq default-directory (expand-file-name "~/")))
+ ;; Avoid danger that the auto-save file can't be written.
+ (let ((dir (expand-file-name
+ (file-name-as-directory mail-default-directory))))
+ (if (file-exists-p dir)
+ (setq default-directory dir)))
;; Only call auto-save-mode if necessary, to avoid changing auto-save file.
(if (or (and auto-save-default (not buffer-auto-save-file-name))
(and (not auto-save-default) buffer-auto-save-file-name))
(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
(switch-to-buffer "*mail*")
;; If *mail* didn't exist, set its directory, so that auto-saved
;; drafts will be found.
- (if (file-exists-p (expand-file-name "~/"))
- (setq default-directory "~/"))
+ (let ((dir (expand-file-name
+ (file-name-as-directory mail-default-directory))))
+ (if (file-exists-p dir)
+ (setq default-directory dir)))
(or (eq major-mode 'mail-mode)
(mail-mode))
(let ((file-name buffer-auto-save-file-name))
;; ls-lisp instead).
(dired-noselect file-name
(concat dired-listing-switches "t"))))
- (save-excursion
- (set-buffer dispbuf)
- (let ((buffer-read-only nil))
- (goto-char (point-min))
- (forward-line)
- (kill-line 2)
- (dired-move-to-filename)
- (setq dispbuf (rename-buffer "*Directory*" t))))
- (display-buffer dispbuf t)
+ (save-selected-window
+ (select-window (display-buffer dispbuf t))
+ (goto-char (point-min))
+ (forward-line 2)
+ (dired-move-to-filename)
+ (setq dispbuf (rename-buffer "*Directory*" t)))
(if (not (yes-or-no-p
(format "Recover mail draft from auto save file %s? "
file-name)))
(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)))))
;;; ruler-mode.el --- display a ruler in the header line
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
;; Created: 24 Mar 2001
-;; Version: 1.4
-;; Keywords: environment convenience
+;; Version: 1.6
+;; Keywords: convenience
;; This file is part of GNU Emacs.
;; This library provides a minor mode to display a ruler in the header
;; line. It works only on Emacs 21.
;;
-;; You can use the mouse to change the `fill-column', `window-margins'
-;; and `tab-stop-list' settings:
+;; You can use the mouse to change the `fill-column' `comment-column',
+;; `goal-column', `window-margins' and `tab-stop-list' settings:
;;
-;; [header-line (shift down-mouse-1)] set left margin to the ruler
+;; [header-line (shift down-mouse-1)] set left margin end to the ruler
;; graduation where the mouse pointer is on.
;;
-;; [header-line (shift down-mouse-3)] set right margin to the ruler
-;; graduation where the mouse pointer is on.
+;; [header-line (shift down-mouse-3)] set right margin beginning to
+;; the ruler graduation where the mouse pointer is on.
;;
-;; [header-line down-mouse-2] set `fill-column' to the ruler
-;; graduation where the mouse pointer is on.
+;; [header-line down-mouse-2] Drag the `fill-column', `comment-column'
+;; or `goal-column' to a ruler graduation.
;;
;; [header-line (control down-mouse-1)] add a tab stop to the ruler
;; graduation where the mouse pointer is on.
;;
;; In the ruler the character `ruler-mode-current-column-char' shows
;; the `current-column' location, `ruler-mode-fill-column-char' shows
-;; the `fill-column' location and `ruler-mode-tab-stop-char' shows tab
-;; stop locations. `window-margins' areas are shown with a different
-;; background color.
+;; the `fill-column' location, `ruler-mode-comment-column-char' shows
+;; the `comment-column' location, `ruler-mode-goal-column-char' shows
+;; the `goal-column' and `ruler-mode-tab-stop-char' shows tab stop
+;; locations. Graduations in `window-margins' and `window-fringes'
+;; areas are shown with a different foreground color.
;;
;; It is also possible to customize the following characters:
;;
-;; - `ruler-mode-margins-char' character used to pad margin areas
-;; (space by default).
;; - `ruler-mode-basic-graduation-char' character used for basic
;; graduations ('.' by default).
;; - `ruler-mode-inter-graduation-char' character used for
;; - `ruler-mode-default-face' the ruler default face.
;; - `ruler-mode-fill-column-face' the face used to highlight the
;; `fill-column' character.
+;; - `ruler-mode-comment-column-face' the face used to highlight the
+;; `comment-column' character.
+;; - `ruler-mode-goal-column-face' the face used to highlight the
+;; `goal-column' character.
;; - `ruler-mode-current-column-face' the face used to highlight the
;; `current-column' character.
;; - `ruler-mode-tab-stop-face' the face used to highlight tab stop
;; characters.
-;; - `ruler-mode-margins-face' the face used to highlight the
-;; `window-margins' areas.
+;; - `ruler-mode-margins-face' the face used to highlight graduations
+;; in the `window-margins' areas.
+;; - `ruler-mode-fringes-face' the face used to highlight graduations
+;; in the `window-fringes' areas.
;; - `ruler-mode-column-number-face' the face used to highlight the
-;; number graduations.
+;; numbered graduations.
;;
;; `ruler-mode-default-face' inherits from the built-in `default' face.
-;; All `ruler-mode' faces inerit from `ruler-mode-default-face'.
+;; All `ruler-mode' faces inherit from `ruler-mode-default-face'.
;;
;; WARNING: To keep ruler graduations aligned on text columns it is
;; important to use the same font family and size for ruler and text
(defgroup ruler-mode nil
"Display a ruler in the header line."
- :version "21.3"
- :group 'environment)
+ :version "21.4"
+ :group 'convenience)
(defcustom ruler-mode-show-tab-stops nil
"*If non-nil the ruler shows tab stop positions.
"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))))
-
+
(defcustom ruler-mode-fill-column-char (if window-system
?\¶
?\|)
(integer :tag "Integer char value"
:validate ruler-mode-character-validate)))
-(defcustom ruler-mode-current-column-char (if window-system
- ?\¦
- ?\@)
- "*Character used at the `current-column' location."
+(defcustom ruler-mode-comment-column-char ?\#
+ "*Character used at the `comment-column' location."
:group 'ruler-mode
:type '(choice
(character :tag "Character")
(integer :tag "Integer char value"
:validate ruler-mode-character-validate)))
-(defcustom ruler-mode-tab-stop-char ?\T
- "*Character used at `tab-stop-list' locations."
+(defcustom ruler-mode-goal-column-char ?G
+ "*Character used at the `goal-column' location."
:group 'ruler-mode
:type '(choice
(character :tag "Character")
(integer :tag "Integer char value"
:validate ruler-mode-character-validate)))
-(defcustom ruler-mode-margins-char ?\
- "*Character used in margin areas."
+(defcustom ruler-mode-current-column-char (if window-system
+ ?\¦
+ ?\@)
+ "*Character used at the `current-column' location."
+ :group 'ruler-mode
+ :type '(choice
+ (character :tag "Character")
+ (integer :tag "Integer char value"
+ :validate ruler-mode-character-validate)))
+
+(defcustom ruler-mode-tab-stop-char ?\T
+ "*Character used at `tab-stop-list' locations."
:group 'ruler-mode
:type '(choice
(character :tag "Character")
(character :tag "Character")
(integer :tag "Integer char value"
:validate ruler-mode-character-validate)))
+
+(defcustom ruler-mode-set-goal-column-ding-flag t
+ "*Non-nil means do `ding' when `goal-column' is set."
+ :group 'ruler-mode
+ :type 'boolean)
\f
(defface ruler-mode-default-face
'((((type tty))
"Default face used by the ruler."
:group 'ruler-mode)
+(defface ruler-mode-pad-face
+ '((((type tty))
+ (:inherit ruler-mode-default-face
+ :background "grey50"
+ ))
+ (t
+ (:inherit ruler-mode-default-face
+ :background "grey64"
+ )))
+ "Face used to pad inactive ruler areas."
+ :group 'ruler-mode)
+
+(defface ruler-mode-margins-face
+ '((t
+ (:inherit ruler-mode-default-face
+ :foreground "white"
+ )))
+ "Face used to highlight margin areas."
+ :group 'ruler-mode)
+
+(defface ruler-mode-fringes-face
+ '((t
+ (:inherit ruler-mode-default-face
+ :foreground "green"
+ )))
+ "Face used to highlight fringes areas."
+ :group 'ruler-mode)
+
(defface ruler-mode-column-number-face
'((t
(:inherit ruler-mode-default-face
"Face used to highlight the fill column character."
:group 'ruler-mode)
-(defface ruler-mode-tab-stop-face
+(defface ruler-mode-comment-column-face
'((t
(:inherit ruler-mode-default-face
- :foreground "steelblue"
+ :foreground "red"
)))
- "Face used to highlight tab stop characters."
+ "Face used to highlight the comment column character."
:group 'ruler-mode)
-(defface ruler-mode-margins-face
- '((((type tty))
+(defface ruler-mode-goal-column-face
+ '((t
(:inherit ruler-mode-default-face
- :background "grey50"
- ))
- (t
+ :foreground "red"
+ )))
+ "Face used to highlight the goal column character."
+ :group 'ruler-mode)
+
+(defface ruler-mode-tab-stop-face
+ '((t
(:inherit ruler-mode-default-face
- :background "grey64"
+ :foreground "steelblue"
)))
- "Face used to highlight the `window-margins' areas."
+ "Face used to highlight tab stop characters."
:group 'ruler-mode)
(defface ruler-mode-current-column-face
"Face used to highlight the `current-column' character."
:group 'ruler-mode)
\f
+(defmacro ruler-mode-left-fringe-cols ()
+ "Return the width, measured in columns, of the left fringe area."
+ '(ceiling (or (car (window-fringes)) 0)
+ (frame-char-width)))
+
+(defmacro ruler-mode-right-fringe-cols ()
+ "Return the width, measured in columns, of the right fringe area."
+ '(ceiling (or (nth 1 (window-fringes)) 0)
+ (frame-char-width)))
+
+(defun ruler-mode-left-scroll-bar-cols ()
+ "Return the width, measured in columns, of the right vertical scrollbar."
+ (let* ((wsb (window-scroll-bars))
+ (vtype (nth 2 wsb))
+ (cols (nth 1 wsb)))
+ (if (or (eq vtype 'left)
+ (and (eq vtype t)
+ (eq (frame-parameter nil 'vertical-scroll-bars) 'left)))
+ (or cols
+ (ceiling
+ ;; nil means it's a non-toolkit scroll bar,
+ ;; and its width in columns is 14 pixels rounded up.
+ (or (frame-parameter nil 'scroll-bar-width) 14)
+ ;; Always round up to multiple of columns.
+ (frame-char-width)))
+ 0)))
+
+(defun ruler-mode-right-scroll-bar-cols ()
+ "Return the width, measured in columns, of the right vertical scrollbar."
+ (let* ((wsb (window-scroll-bars))
+ (vtype (nth 2 wsb))
+ (cols (nth 1 wsb)))
+ (if (or (eq vtype 'right)
+ (and (eq vtype t)
+ (eq (frame-parameter nil 'vertical-scroll-bars) 'right)))
+ (or cols
+ (ceiling
+ ;; nil means it's a non-toolkit scroll bar,
+ ;; and its width in columns is 14 pixels rounded up.
+ (or (frame-parameter nil 'scroll-bar-width) 14)
+ ;; Always round up to multiple of columns.
+ (frame-char-width)))
+ 0)))
+
+(defsubst ruler-mode-full-window-width ()
+ "Return the full width of the selected window."
+ (let ((edges (window-edges)))
+ (- (nth 2 edges) (nth 0 edges))))
+
+(defsubst ruler-mode-window-col (n)
+ "Return a column number relative to the selected window.
+N is a column number relative to selected frame."
+ (- n
+ (car (window-edges))
+ (or (car (window-margins)) 0)
+ (ruler-mode-left-fringe-cols)
+ (ruler-mode-left-scroll-bar-cols)))
+\f
(defun ruler-mode-mouse-set-left-margin (start-event)
- "Set left margin to the graduation where the mouse pointer is on.
+ "Set left margin end to the graduation where the mouse pointer is on.
START-EVENT is the mouse click event."
(interactive "e")
(let* ((start (event-start start-event))
(end (event-end start-event))
- w col m lm0 lm rm)
- (if (eq start end) ;; mouse click
- (save-selected-window
- (select-window (posn-window start))
- (setq m (window-margins)
- lm0 (or (car m) 0)
- rm (or (cdr m) 0)
- w (window-width)
- col (car (posn-col-row start))
- lm (min (- w rm) col))
- (message "Left margin set to %d (was %d)" lm lm0)
- (set-window-margins nil lm rm)))))
+ col w lm rm)
+ (when (eq start end) ;; mouse click
+ (save-selected-window
+ (select-window (posn-window start))
+ (setq col (- (car (posn-col-row start)) (car (window-edges))
+ (ruler-mode-left-scroll-bar-cols))
+ w (- (ruler-mode-full-window-width)
+ (ruler-mode-left-scroll-bar-cols)
+ (ruler-mode-right-scroll-bar-cols)))
+ (when (and (>= col 0) (< col w))
+ (setq lm (window-margins)
+ rm (or (cdr lm) 0)
+ lm (or (car lm) 0))
+ (message "Left margin set to %d (was %d)" col lm)
+ (set-window-margins nil col rm))))))
(defun ruler-mode-mouse-set-right-margin (start-event)
- "Set right margin to the graduation where the mouse pointer is on.
+ "Set right margin beginning to the graduation where the mouse pointer is on.
START-EVENT is the mouse click event."
(interactive "e")
(let* ((start (event-start start-event))
(end (event-end start-event))
- m col w lm rm0 rm)
- (if (eq start end) ;; mouse click
- (save-selected-window
- (select-window (posn-window start))
- (setq m (window-margins)
- rm0 (or (cdr m) 0)
- lm (or (car m) 0)
- col (car (posn-col-row start))
- w (window-width)
- rm (max 0 (- w col)))
- (message "Right margin set to %d (was %d)" rm rm0)
- (set-window-margins nil lm rm)))))
-
-(defun ruler-mode-mouse-set-fill-column (start-event)
- "Set `fill-column' to the graduation where the mouse pointer is on.
-START-EVENT is the mouse click event."
+ col w lm rm)
+ (when (eq start end) ;; mouse click
+ (save-selected-window
+ (select-window (posn-window start))
+ (setq col (- (car (posn-col-row start)) (car (window-edges))
+ (ruler-mode-left-scroll-bar-cols))
+ w (- (ruler-mode-full-window-width)
+ (ruler-mode-left-scroll-bar-cols)
+ (ruler-mode-right-scroll-bar-cols)))
+ (when (and (>= col 0) (< col w))
+ (setq lm (window-margins)
+ rm (or (cdr lm) 0)
+ lm (or (car lm) 0)
+ col (- w col 1))
+ (message "Right margin set to %d (was %d)" col rm)
+ (set-window-margins nil lm col))))))
+
+(defvar ruler-mode-dragged-symbol nil
+ "Column symbol dragged in the ruler.
+That is `fill-column', `comment-column', `goal-column', or nil when
+nothing is dragged.")
+
+(defun ruler-mode-mouse-grab-any-column (start-event)
+ "Drag a column symbol on the ruler.
+Start dragging on mouse down event START-EVENT, and update the column
+symbol value with the current value of the ruler graduation while
+dragging. See also the variable `ruler-mode-dragged-symbol'."
(interactive "e")
+ (setq ruler-mode-dragged-symbol nil)
+ (let* ((start (event-start start-event))
+ col newc oldc)
+ (save-selected-window
+ (select-window (posn-window start))
+ (setq col (ruler-mode-window-col (car (posn-col-row start)))
+ newc (+ col (window-hscroll)))
+ (and
+ (>= col 0) (< col (window-width))
+ (cond
+
+ ;; Handle the fill column.
+ ((eq newc fill-column)
+ (setq oldc fill-column
+ ruler-mode-dragged-symbol 'fill-column)
+ t) ;; Start dragging
+
+ ;; Handle the comment column.
+ ((eq newc comment-column)
+ (setq oldc comment-column
+ ruler-mode-dragged-symbol 'comment-column)
+ t) ;; Start dragging
+
+ ;; Handle the goal column.
+ ;; A. On mouse down on the goal column character on the ruler,
+ ;; update the `goal-column' value while dragging.
+ ;; B. If `goal-column' is nil, set the goal column where the
+ ;; mouse is clicked.
+ ;; C. On mouse click on the goal column character on the
+ ;; ruler, unset the goal column.
+ ((eq newc goal-column) ; A. Drag the goal column.
+ (setq oldc goal-column
+ ruler-mode-dragged-symbol 'goal-column)
+ t) ;; Start dragging
+
+ ((null goal-column) ; B. Set the goal column.
+ (setq oldc goal-column
+ goal-column newc)
+ ;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'. This
+ ;; `ding' flushes the next messages about setting goal
+ ;; column. So here I force fetch the event(mouse-2) and
+ ;; throw away.
+ (read-event)
+ ;; Ding BEFORE `message' is OK.
+ (when ruler-mode-set-goal-column-ding-flag
+ (ding))
+ (message "Goal column set to %d (click on %s again to unset it)"
+ newc
+ (propertize (char-to-string ruler-mode-goal-column-char)
+ 'face 'ruler-mode-goal-column-face))
+ nil) ;; Don't start dragging.
+ )
+ (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration
+ (posn-window start)))
+ (when (eq 'goal-column ruler-mode-dragged-symbol)
+ ;; C. Unset the goal column.
+ (set-goal-column t))
+ ;; At end of dragging, report the updated column symbol.
+ (message "%s is set to %d (was %d)"
+ ruler-mode-dragged-symbol
+ (symbol-value ruler-mode-dragged-symbol)
+ oldc))))))
+
+(defun ruler-mode-mouse-drag-any-column-iteration (window)
+ "Update the ruler while dragging the mouse.
+WINDOW is the window where occurred the last down-mouse event.
+Return the symbol `drag' if the mouse has been dragged, or `click' if
+the mouse has been clicked."
+ (let ((drags 0)
+ event)
+ (track-mouse
+ (while (mouse-movement-p (setq event (read-event)))
+ (setq drags (1+ drags))
+ (when (eq window (posn-window (event-end event)))
+ (ruler-mode-mouse-drag-any-column event)
+ (force-mode-line-update))))
+ (if (and (zerop drags) (eq 'click (car (event-modifiers event))))
+ 'click
+ 'drag)))
+
+(defun ruler-mode-mouse-drag-any-column (start-event)
+ "Update the value of the symbol dragged on the ruler.
+Called on each mouse motion event START-EVENT."
(let* ((start (event-start start-event))
(end (event-end start-event))
- m col w lm rm hs fc)
- (if (eq start end) ;; mouse click
- (save-selected-window
- (select-window (posn-window start))
- (setq m (window-margins)
- lm (or (car m) 0)
- rm (or (cdr m) 0)
- col (- (car (posn-col-row start)) lm)
- w (window-width)
- hs (window-hscroll)
- fc (+ col hs))
- (and (>= col 0) (< (+ col lm rm) w)
- (progn
- (message "Fill column set to %d (was %d)" fc fill-column)
- (setq fill-column fc)))))))
+ col newc)
+ (save-selected-window
+ (select-window (posn-window start))
+ (setq col (ruler-mode-window-col (car (posn-col-row end)))
+ newc (+ col (window-hscroll)))
+ (when (and (>= col 0) (< col (window-width)))
+ (set ruler-mode-dragged-symbol newc)))))
\f
(defun ruler-mode-mouse-add-tab-stop (start-event)
"Add a tab stop to the graduation where the mouse pointer is on.
START-EVENT is the mouse click event."
(interactive "e")
- (if ruler-mode-show-tab-stops
- (let* ((start (event-start start-event))
- (end (event-end start-event))
- m col w lm rm hs ts)
- (if (eq start end) ;; mouse click
- (save-selected-window
- (select-window (posn-window start))
- (setq m (window-margins)
- lm (or (car m) 0)
- rm (or (cdr m) 0)
- col (- (car (posn-col-row start)) lm)
- w (window-width)
- hs (window-hscroll)
- ts (+ col hs))
- (and (>= col 0) (< (+ col lm rm) w)
- (not (member ts tab-stop-list))
- (progn
- (message "Tab stop set to %d" ts)
- (setq tab-stop-list
- (sort (cons ts tab-stop-list)
- #'<)))))))))
+ (when ruler-mode-show-tab-stops
+ (let* ((start (event-start start-event))
+ (end (event-end start-event))
+ col ts)
+ (when (eq start end) ;; mouse click
+ (save-selected-window
+ (select-window (posn-window start))
+ (setq col (ruler-mode-window-col (car (posn-col-row start)))
+ ts (+ col (window-hscroll)))
+ (and (>= col 0) (< col (window-width))
+ (not (member ts tab-stop-list))
+ (progn
+ (message "Tab stop set to %d" ts)
+ (setq tab-stop-list (sort (cons ts tab-stop-list)
+ #'<)))))))))
(defun ruler-mode-mouse-del-tab-stop (start-event)
"Delete tab stop at the graduation where the mouse pointer is on.
START-EVENT is the mouse click event."
(interactive "e")
- (if ruler-mode-show-tab-stops
- (let* ((start (event-start start-event))
- (end (event-end start-event))
- m col w lm rm hs ts)
- (if (eq start end) ;; mouse click
- (save-selected-window
- (select-window (posn-window start))
- (setq m (window-margins)
- lm (or (car m) 0)
- rm (or (cdr m) 0)
- col (- (car (posn-col-row start)) lm)
- w (window-width)
- hs (window-hscroll)
- ts (+ col hs))
- (and (>= col 0) (< (+ col lm rm) w)
- (member ts tab-stop-list)
- (progn
- (message "Tab stop at %d deleted" ts)
- (setq tab-stop-list
- (delete ts tab-stop-list)))))))))
+ (when ruler-mode-show-tab-stops
+ (let* ((start (event-start start-event))
+ (end (event-end start-event))
+ col ts)
+ (when (eq start end) ;; mouse click
+ (save-selected-window
+ (select-window (posn-window start))
+ (setq col (ruler-mode-window-col (car (posn-col-row start)))
+ ts (+ col (window-hscroll)))
+ (and (>= col 0) (< col (window-width))
+ (member ts tab-stop-list)
+ (progn
+ (message "Tab stop at %d deleted" ts)
+ (setq tab-stop-list (delete ts tab-stop-list)))))))))
(defun ruler-mode-toggle-show-tab-stops ()
"Toggle showing of tab stops on the ruler."
(define-key km [header-line down-mouse-3]
#'ignore)
(define-key km [header-line down-mouse-2]
- #'ruler-mode-mouse-set-fill-column)
+ #'ruler-mode-mouse-grab-any-column)
(define-key km [header-line (shift down-mouse-1)]
#'ruler-mode-mouse-set-left-margin)
(define-key km [header-line (shift down-mouse-3)]
(progn
;; When `ruler-mode' is on save previous header line format
;; and install the ruler header line format.
- (setq ruler-mode-header-line-format-old header-line-format
- header-line-format ruler-mode-header-line-format)
+ (when (local-variable-p 'header-line-format)
+ (setq ruler-mode-header-line-format-old header-line-format))
+ (setq header-line-format ruler-mode-header-line-format)
(add-hook 'post-command-hook ; add local hook
#'force-mode-line-update nil t))
;; When `ruler-mode' is off restore previous header line format if
;; the current one is the ruler header line format.
- (if (eq header-line-format ruler-mode-header-line-format)
- (setq header-line-format ruler-mode-header-line-format-old))
+ (when (eq header-line-format ruler-mode-header-line-format)
+ (kill-local-variable 'header-line-format)
+ (when (local-variable-p 'ruler-mode-header-line-format-old)
+ (setq header-line-format ruler-mode-header-line-format-old)))
(remove-hook 'post-command-hook ; remove local hook
#'force-mode-line-update t)))
\f
;; Add ruler-mode to the minor mode menu in the mode line
(define-key mode-line-mode-menu [ruler-mode]
`(menu-item "Ruler" ruler-mode
- :button (:toggle . ruler-mode)))
+ :button (:toggle . ruler-mode)))
(defconst ruler-mode-ruler-help-echo
"\
S-mouse-1/3: set L/R margin, \
-mouse-2: set fill col, \
+mouse-2: set goal column, \
C-mouse-2: show tabs"
- "Help string shown when mouse pointer is over the ruler.
+ "Help string shown when mouse is over the ruler.
`ruler-mode-show-tab-stops' is nil.")
-(defconst ruler-mode-ruler-help-echo-tab
+(defconst ruler-mode-ruler-help-echo-when-goal-column
+ "\
+S-mouse-1/3: set L/R margin, \
+C-mouse-2: show tabs"
+ "Help string shown when mouse is over the ruler.
+`goal-column' is set and `ruler-mode-show-tab-stops' is nil.")
+
+(defconst ruler-mode-ruler-help-echo-when-tab-stops
"\
C-mouse1/3: set/unset tab, \
C-mouse-2: hide tabs"
- "Help string shown when mouse pointer is over the ruler.
+ "Help string shown when mouse is over the ruler.
`ruler-mode-show-tab-stops' is non-nil.")
-(defconst ruler-mode-left-margin-help-echo
- "Left margin %S"
- "Help string shown when mouse is over the left margin area.")
-
-(defconst ruler-mode-right-margin-help-echo
- "Right margin %S"
- "Help string shown when mouse is over the right margin area.")
+(defconst ruler-mode-fill-column-help-echo
+ "drag-mouse-2: set fill column"
+ "Help string shown when mouse is on the fill column character.")
-(defmacro ruler-mode-left-fringe-cols ()
- "Return the width, measured in columns, of the left fringe area."
- '(round (or (frame-parameter nil 'left-fringe) 0)
- (frame-char-width)))
+(defconst ruler-mode-comment-column-help-echo
+ "drag-mouse-2: set comment column"
+ "Help string shown when mouse is on the comment column character.")
-(defmacro ruler-mode-right-fringe-cols ()
- "Return the width, measured in columns, of the right fringe area."
- '(round (or (frame-parameter nil 'right-fringe) 0)
- (frame-char-width)))
+(defconst ruler-mode-goal-column-help-echo
+ "\
+drag-mouse-2: set goal column, \
+mouse-2: unset goal column"
+ "Help string shown when mouse is on the goal column character.")
-(defmacro ruler-mode-left-scroll-bar-cols ()
- "Return the width, measured in columns, of the left vertical scrollbar."
- '(if (eq (frame-parameter nil 'vertical-scroll-bars) 'left)
- (round (or (frame-parameter nil 'scroll-bar-width) 0)
- (frame-char-width))
- 0))
+(defconst ruler-mode-margin-help-echo
+ "%s margin %S"
+ "Help string shown when mouse is over a margin area.")
-(defmacro ruler-mode-right-scroll-bar-cols ()
- "Return the width, measured in columns, of the right vertical scrollbar."
- '(if (eq (frame-parameter nil 'vertical-scroll-bars) 'right)
- (round (or (frame-parameter nil 'scroll-bar-width) 0)
- (frame-char-width))
- 0))
+(defconst ruler-mode-fringe-help-echo
+ "%s fringe %S"
+ "Help string shown when mouse is over a fringe area.")
\f
(defun ruler-mode-ruler ()
"Return a string ruler."
- (if ruler-mode
- (let* ((j (+ (ruler-mode-left-fringe-cols)
- (ruler-mode-left-scroll-bar-cols)))
- (w (+ (window-width) j))
- (m (window-margins))
- (l (or (car m) 0))
- (r (or (cdr m) 0))
- (o (- (window-hscroll) l j))
- (i 0)
- (ruler (concat
- ;; unit graduations
- (make-string w ruler-mode-basic-graduation-char)
- ;; extra space to fill the header line
- (make-string (+ (ruler-mode-right-fringe-cols)
- (ruler-mode-right-scroll-bar-cols))
- ?\ )))
- c k)
-
- ;; Setup default face and help echo.
- (put-text-property 0 (length ruler)
- 'face 'ruler-mode-default-face
- ruler)
- (put-text-property 0 (length ruler)
- 'help-echo
- (if ruler-mode-show-tab-stops
- ruler-mode-ruler-help-echo-tab
- ruler-mode-ruler-help-echo)
- ruler)
- ;; Setup the local map.
- (put-text-property 0 (length ruler)
- 'local-map ruler-mode-map
- ruler)
-
- (setq j (+ l j))
- ;; Setup the left margin area.
- (put-text-property
- i j 'face 'ruler-mode-margins-face
- ruler)
- (put-text-property
- i j 'help-echo (format ruler-mode-left-margin-help-echo l)
- ruler)
- (while (< i j)
- (aset ruler i ruler-mode-margins-char)
- (setq i (1+ i)))
-
- ;; Setup the ruler area.
- (setq r (- w r))
- (while (< i r)
- (setq j (+ i o))
- (cond
- ((= (mod j 10) 0)
- (setq c (number-to-string (/ j 10))
- m (length c)
- k i)
- (put-text-property
- i (1+ i) 'face 'ruler-mode-column-number-face
- ruler)
- (while (and (> m 0) (>= k 0))
- (aset ruler k (aref c (setq m (1- m))))
- (setq k (1- k)))
- )
- ((= (mod j 5) 0)
- (aset ruler i ruler-mode-inter-graduation-char)
- )
- )
- (setq i (1+ i)))
-
- ;; Setup the right margin area.
- (put-text-property
- i (length ruler) 'face 'ruler-mode-margins-face
- ruler)
- (put-text-property
- i (length ruler) 'help-echo
- (format ruler-mode-right-margin-help-echo (- w r))
- ruler)
- (while (< i (length ruler))
- (aset ruler i ruler-mode-margins-char)
- (setq i (1+ i)))
-
- ;; Show the `fill-column' marker.
- (setq i (- fill-column o))
- (and (>= i 0) (< i r)
- (aset ruler i ruler-mode-fill-column-char)
- (put-text-property
- i (1+ i) 'face 'ruler-mode-fill-column-face
- ruler))
-
- ;; Show the `tab-stop-list' markers.
- (if ruler-mode-show-tab-stops
- (let ((tsl tab-stop-list) ts)
- (while tsl
- (setq ts (car tsl)
- tsl (cdr tsl)
- i (- ts o))
- (and (>= i 0) (< i r)
- (aset ruler i ruler-mode-tab-stop-char)
- (put-text-property
- i (1+ i)
- 'face (cond
- ;; Don't override the fill-column face
- ((eq ts fill-column)
- 'ruler-mode-fill-column-face)
- (t
- 'ruler-mode-tab-stop-face))
- ruler)))))
-
- ;; Show the `current-column' marker.
- (setq i (- (current-column) o))
- (and (>= i 0) (< i r)
- (aset ruler i ruler-mode-current-column-char)
- (put-text-property
- i (1+ i) 'face 'ruler-mode-current-column-face
- ruler))
-
- ruler)))
+ (when ruler-mode
+ (let* ((fullw (ruler-mode-full-window-width))
+ (w (window-width))
+ (m (window-margins))
+ (lsb (ruler-mode-left-scroll-bar-cols))
+ (lf (ruler-mode-left-fringe-cols))
+ (lm (or (car m) 0))
+ (rsb (ruler-mode-right-scroll-bar-cols))
+ (rf (ruler-mode-right-fringe-cols))
+ (rm (or (cdr m) 0))
+ (ruler (make-string fullw ruler-mode-basic-graduation-char))
+ (o (+ lsb lf lm))
+ (x 0)
+ (i o)
+ (j (window-hscroll))
+ k c l1 l2 r2 r1 h1 h2 f1 f2)
+
+ ;; Setup the default properties.
+ (put-text-property 0 fullw 'face 'ruler-mode-default-face ruler)
+ (put-text-property 0 fullw
+ 'help-echo
+ (cond
+ (ruler-mode-show-tab-stops
+ ruler-mode-ruler-help-echo-when-tab-stops)
+ (goal-column
+ ruler-mode-ruler-help-echo-when-goal-column)
+ (t
+ ruler-mode-ruler-help-echo))
+ ruler)
+ ;; Setup the local map.
+ (put-text-property 0 fullw 'local-map ruler-mode-map ruler)
+
+ ;; Setup the active area.
+ (while (< x w)
+ ;; Graduations.
+ (cond
+ ;; Show a number graduation.
+ ((= (mod j 10) 0)
+ (setq c (number-to-string (/ j 10))
+ m (length c)
+ k i)
+ (put-text-property
+ i (1+ i) 'face 'ruler-mode-column-number-face
+ ruler)
+ (while (and (> m 0) (>= k 0))
+ (aset ruler k (aref c (setq m (1- m))))
+ (setq k (1- k))))
+ ;; Show an intermediate graduation.
+ ((= (mod j 5) 0)
+ (aset ruler i ruler-mode-inter-graduation-char)))
+ ;; Special columns.
+ (cond
+ ;; Show the `current-column' marker.
+ ((= j (current-column))
+ (aset ruler i ruler-mode-current-column-char)
+ (put-text-property
+ i (1+ i) 'face 'ruler-mode-current-column-face
+ ruler))
+ ;; Show the `goal-column' marker.
+ ((and goal-column (= j goal-column))
+ (aset ruler i ruler-mode-goal-column-char)
+ (put-text-property
+ i (1+ i) 'face 'ruler-mode-goal-column-face
+ ruler)
+ (put-text-property
+ i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
+ ruler))
+ ;; Show the `comment-column' marker.
+ ((= j comment-column)
+ (aset ruler i ruler-mode-comment-column-char)
+ (put-text-property
+ i (1+ i) 'face 'ruler-mode-comment-column-face
+ ruler)
+ (put-text-property
+ i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
+ ruler))
+ ;; Show the `fill-column' marker.
+ ((= j fill-column)
+ (aset ruler i ruler-mode-fill-column-char)
+ (put-text-property
+ i (1+ i) 'face 'ruler-mode-fill-column-face
+ ruler)
+ (put-text-property
+ i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
+ ruler))
+ ;; Show the `tab-stop-list' markers.
+ ((and ruler-mode-show-tab-stops (member j tab-stop-list))
+ (aset ruler i ruler-mode-tab-stop-char)
+ (put-text-property
+ i (1+ i) 'face 'ruler-mode-tab-stop-face
+ ruler)))
+ (setq i (1+ i)
+ j (1+ j)
+ x (1+ x)))
+
+ ;; Highlight the fringes and margins.
+ (if (nth 2 (window-fringes))
+ ;; fringes outside margins.
+ (setq l1 lf
+ l2 lm
+ r2 rm
+ r1 rf
+ h1 ruler-mode-fringe-help-echo
+ h2 ruler-mode-margin-help-echo
+ f1 'ruler-mode-fringes-face
+ f2 'ruler-mode-margins-face)
+ ;; fringes inside margins.
+ (setq l1 lm
+ l2 lf
+ r2 rf
+ r1 rm
+ h1 ruler-mode-margin-help-echo
+ h2 ruler-mode-fringe-help-echo
+ f1 'ruler-mode-margins-face
+ f2 'ruler-mode-fringes-face))
+ (setq i lsb j (+ i l1))
+ (put-text-property i j 'face f1 ruler)
+ (put-text-property i j 'help-echo (format h1 "Left" l1) ruler)
+ (setq i j j (+ i l2))
+ (put-text-property i j 'face f2 ruler)
+ (put-text-property i j 'help-echo (format h2 "Left" l2) ruler)
+ (setq i (+ o w) j (+ i r2))
+ (put-text-property i j 'face f2 ruler)
+ (put-text-property i j 'help-echo (format h2 "Right" r2) ruler)
+ (setq i j j (+ i r1))
+ (put-text-property i j 'face f1 ruler)
+ (put-text-property i j 'help-echo (format h1 "Right" r1) ruler)
+
+ ;; Show inactive areas.
+ (put-text-property 0 lsb 'face 'ruler-mode-pad-face ruler)
+ (put-text-property j fullw 'face 'ruler-mode-pad-face ruler)
+
+ ;; Return the ruler propertized string.
+ ruler)))
(provide 'ruler-mode)
;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000, 2001
+;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99,
+;; 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
+;; Maintainer: FSF
+;; Keywords: internal
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
"Highlight (un)matching of parens and expressions."
:group 'matching)
+(define-key global-map [?\C-x right] 'next-buffer)
+(define-key global-map [?\C-x left] 'prev-buffer)
+(defun next-buffer ()
+ "Switch to the next buffer in cyclic order."
+ (interactive)
+ (let ((buffer (current-buffer)))
+ (switch-to-buffer (other-buffer buffer))
+ (bury-buffer buffer)))
+
+(defun prev-buffer ()
+ "Switch to the previous buffer in cyclic order."
+ (interactive)
+ (let ((list (nreverse (buffer-list)))
+ found)
+ (while (and (not found) list)
+ (let ((buffer (car list)))
+ (if (and (not (get-buffer-window buffer))
+ (not (string-match "\\` " (buffer-name buffer))))
+ (setq found buffer)))
+ (setq list (cdr list)))
+ (switch-to-buffer found)))
(defun fundamental-mode ()
"Major mode not specialized for anything in particular.
text-property `hard'.
With ARG, insert that many newlines.
Call `auto-fill-function' if the current column number is greater
-than the value of `fill-column' and ARG is `nil'."
+than the value of `fill-column' and ARG is nil."
(interactive "*P")
(barf-if-buffer-read-only)
;; Inserting a newline at the end of a line produces better redisplay in
(goto-char loc)
(end-of-line)))
-(defun split-line ()
- "Split current line, moving portion beyond point vertically down."
- (interactive "*")
+(defun split-line (&optional arg)
+ "Split current line, moving portion beyond point vertically down.
+If the current line starts with `fill-prefix', insert it on the new
+line as well. With prefix arg, don't insert fill-prefix on new line.
+
+When called from Lisp code, the arg may be a prefix string to copy."
+ (interactive "*P")
(skip-chars-forward " \t")
- (let ((col (current-column))
- (pos (point)))
+ (let* ((col (current-column))
+ (pos (point))
+ ;; What prefix should we check for (nil means don't).
+ (prefix (cond ((stringp arg) arg)
+ (arg nil)
+ (t fill-prefix)))
+ ;; Does this line start with it?
+ (have-prfx (and prefix
+ (save-excursion
+ (beginning-of-line)
+ (looking-at (regexp-quote prefix))))))
(newline 1)
+ (if have-prfx (insert-and-inherit prefix))
(indent-to col 0)
(goto-char pos)))
digits are interpreted as a character code. This is intended to be
useful for editing binary files."
(interactive "*p")
- (let ((char (if (or (not overwrite-mode)
- (eq overwrite-mode 'overwrite-mode-binary))
- (read-quoted-char)
- (read-char))))
+ (let* ((char (let (translation-table-for-input)
+ (if (or (not overwrite-mode)
+ (eq overwrite-mode 'overwrite-mode-binary))
+ (read-quoted-char)
+ (read-char)))))
;; Assume character codes 0240 - 0377 stand for characters in some
;; single-byte character set, and convert them to Emacs
;; characters.
"Move point to the first non-whitespace character on this line."
(interactive)
(beginning-of-line 1)
- (skip-chars-forward " \t"))
+ (skip-syntax-forward " " (line-end-position))
+ ;; Move back over chars that have whitespace syntax but have the p flag.
+ (backward-prefix-chars))
(defun fixup-whitespace ()
"Fixup white space between objects around point.
(progn
(skip-chars-forward " \t")
(constrain-to-field nil orig-pos t)))))
-
+\f
(defun beginning-of-buffer (&optional arg)
"Move point to the beginning of the buffer; leave mark at previous position.
With arg N, put point N/10 of the way from the beginning.
(push-mark (point))
(push-mark (point-max) nil t)
(goto-char (point-min)))
-
+\f
;; Counting lines, one way or another.
(setq start (point))
(goto-char opoint)
(forward-line 0)
- (if (/= start 1)
+ (if (/= start (point-min))
(message "line %d (narrowed line %d)"
- (1+ (count-lines 1 (point)))
+ (1+ (count-lines (point-min) (point)))
(1+ (count-lines start (point))))
- (message "Line %d" (1+ (count-lines 1 (point)))))))))
+ (message "Line %d" (1+ (count-lines (point-min) (point)))))))))
(defun count-lines (start end)
"Return number of lines between START and END.
byte, just \"...\" is shown.
In addition, with prefix argument, show details about that character
-in *Help* buffer. See also the command `describe-char-after'."
+in *Help* buffer. See also the command `describe-char'."
(interactive "P")
(let* ((char (following-char))
(beg (point-min))
(if (or (not coding)
(eq (coding-system-type coding) t))
(setq coding default-buffer-file-coding-system))
- ;; Fixme: can we actually have invalid chars now?
-- (if (not (char-valid-p char))
++ (if (eq (char-charset char) 'eight-bit)
(setq encoding-msg
-- (format "(0%o, %d, 0x%x, invalid)" char char char))
++ (format "(0%o, %d, 0x%x, raw-byte)" char char char))
(setq encoded (and (>= char 128) (encode-coding-char char coding)))
(setq encoding-msg
(if encoded
(format "(0%o, %d, 0x%x)" char char char))))
(if detail
;; We show the detailed information about CHAR.
- (describe-char-after (point)))
+ (describe-char (point)))
(if (or (/= beg 1) (/= end (1+ total)))
(message "Char: %s %s point=%d of %d (%d%%) <%d - %d> column %d %s"
(if (< char 256)
(single-key-description char)
(buffer-substring-no-properties (point) (1+ (point))))
encoding-msg pos total percent col hscroll))))))
-
+\f
(defvar read-expression-map
(let ((m (make-sparse-keymap)))
(define-key m "\M-\t" 'lisp-complete-symbol)
"Prompting with PROMPT, let user edit COMMAND and eval result.
COMMAND is a Lisp expression. Let user edit that expression in
the minibuffer, then read and evaluate the result."
- (let ((command (read-from-minibuffer prompt
- (prin1-to-string command)
- read-expression-map t
- '(command-history . 1))))
- ;; If command was added to command-history as a string,
- ;; get rid of that. We want only evaluable expressions there.
- (if (stringp (car command-history))
- (setq command-history (cdr command-history)))
+ (let ((command
+ (unwind-protect
+ (read-from-minibuffer prompt
+ (prin1-to-string command)
+ read-expression-map t
+ '(command-history . 1))
+ ;; If command was added to command-history as a string,
+ ;; get rid of that. We want only evaluable expressions there.
+ (if (stringp (car command-history))
+ (setq command-history (cdr command-history))))))
;; If command to be redone does not match front of history,
;; add it to the history.
(let ((print-level nil)
(minibuffer-history-position arg)
(minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
- (read-from-minibuffer
- "Redo: " (prin1-to-string elt) read-expression-map t
- (cons 'command-history arg))))
+ (unwind-protect
+ (read-from-minibuffer
+ "Redo: " (prin1-to-string elt) read-expression-map t
+ (cons 'command-history arg))
- ;; If command was added to command-history as a string,
- ;; get rid of that. We want only evaluable expressions there.
- (if (stringp (car command-history))
- (setq command-history (cdr command-history)))
+ ;; If command was added to command-history as a
+ ;; string, get rid of that. We want only
+ ;; evaluable expressions there.
+ (if (stringp (car command-history))
+ (setq command-history (cdr command-history))))))
;; If command to be redone does not match front of history,
;; add it to the history.
(or (equal newcmd (car command-history))
(setq command-history (cons newcmd command-history)))
(eval newcmd))
- (ding))))
-
+ (if command-history
+ (error "Argument %d is beyond length of command history" arg)
+ (error "There are no previous complex commands to repeat")))))
+\f
(defvar minibuffer-history nil
"Default minibuffer history list.
This is used for all minibuffer input
;; Return the width of everything before the field at the end of
;; the buffer; this should be 0 for normal buffers.
(1- (minibuffer-prompt-end)))
-
+\f
;Put this on C-x u, so we can force that rather than C-_ into startup msg
(defalias 'advertised-undo 'undo)
+(defconst undo-equiv-table (make-hash-table :test 'eq :weakness t)
+ "Table mapping redo records to the corresponding undo one.")
+
+(defvar undo-in-region nil
+ "Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.")
+
+(defvar undo-no-redo nil
+ "If t, `undo' doesn't go through redo entries.")
+
(defun undo (&optional arg)
"Undo some previous changes.
Repeat this command to undo more changes.
A numeric argument serves as a repeat count.
In Transient Mark mode when the mark is active, only undo changes within
-the current region. Similarly, when not in Transient Mark mode, just C-u
+the current region. Similarly, when not in Transient Mark mode, just \\[universal-argument]
as an argument limits undo to changes within the current region."
(interactive "*P")
;; Make last-command indicate for the next command that this was an undo.
(setq this-command 'undo)
(let ((modified (buffer-modified-p))
(recent-save (recent-auto-save-p)))
- (or (eq (selected-window) (minibuffer-window))
- (message "Undo!"))
(unless (eq last-command 'undo)
- (if (if transient-mark-mode mark-active (and arg (not (numberp arg))))
+ (setq undo-in-region
+ (if transient-mark-mode mark-active (and arg (not (numberp arg)))))
+ (if undo-in-region
(undo-start (region-beginning) (region-end))
(undo-start))
;; get rid of initial undo boundary
(undo-more 1))
+ ;; Check to see whether we're hitting a redo record, and if
+ ;; so, ask the user whether she wants to skip the redo/undo pair.
+ (let ((equiv (gethash pending-undo-list undo-equiv-table)))
+ (or (eq (selected-window) (minibuffer-window))
+ (message (if undo-in-region
+ (if equiv "Redo in region!" "Undo in region!")
+ (if equiv "Redo!" "Undo!"))))
+ (when (and equiv undo-no-redo)
+ ;; The equiv entry might point to another redo record if we have done
+ ;; undo-redo-undo-redo-... so skip to the very last equiv.
+ (while (let ((next (gethash equiv undo-equiv-table)))
+ (if next (setq equiv next))))
+ (setq pending-undo-list equiv)))
(undo-more
(if (or transient-mark-mode (numberp arg))
(prefix-numeric-value arg)
1))
+ ;; Record the fact that the just-generated undo records come from an
+ ;; undo operation, so we can skip them later on.
+ ;; I don't know how to do that in the undo-in-region case.
+ (unless undo-in-region
+ (puthash buffer-undo-list pending-undo-list undo-equiv-table))
;; Don't specify a position in the undo record for the undo command.
;; Instead, undoing this should move point to where the change is.
(let ((tail buffer-undo-list)
(while (car tail)
(when (integerp (car tail))
(let ((pos (car tail)))
- (if (null prev)
- (setq buffer-undo-list (cdr tail))
- (setcdr prev (cdr tail)))
+ (if prev
+ (setcdr prev (cdr tail))
+ (setq buffer-undo-list (cdr tail)))
(setq tail (cdr tail))
(while (car tail)
(if (eq pos (car tail))
(and modified (not (buffer-modified-p))
(delete-auto-save-file-if-necessary recent-save))))
+(defun undo-only (&optional arg)
+ "Undo some previous changes.
+Repeat this command to undo more changes.
+A numeric argument serves as a repeat count.
+Contrary to `undo', this will not redo a previous undo."
+ (interactive "*p")
+ (let ((undo-no-redo t)) (undo arg)))
+;; Richard said that we should not use C-x <uppercase letter> and I have
+;; no idea whereas to bind it. Any suggestion welcome. -stef
+;; (define-key ctl-x-map "U" 'undo-only)
+
(defvar pending-undo-list nil
"Within a run of consecutive undo commands, list remaining to be undone.")
Call `undo-start' to get ready to undo recent changes,
then call `undo-more' one or more times to undo them."
(or pending-undo-list
- (error "No further undo information"))
+ (error (format "No further undo information%s"
+ (if (and transient-mark-mode mark-active)
+ " for region" ""))))
(let ((undo-in-progress t))
(setq pending-undo-list (primitive-undo count pending-undo-list))))
If it crosses the edge, we return nil."
(cond ((integerp undo-elt)
(and (>= undo-elt start)
- (< undo-elt end)))
+ (<= undo-elt end)))
((eq undo-elt nil)
t)
((atom undo-elt)
(cons alist-elt undo-adjusted-markers)))
(and (cdr alist-elt)
(>= (cdr alist-elt) start)
- (< (cdr alist-elt) end))))
+ (<= (cdr alist-elt) end))))
((null (car undo-elt))
;; (nil PROPERTY VALUE BEG . END)
(let ((tail (nthcdr 3 undo-elt)))
(and (>= (car tail) start)
- (< (cdr tail) end))))
+ (<= (cdr tail) end))))
((integerp (car undo-elt))
;; (BEGIN . END)
(and (>= (car undo-elt) start)
- (< (cdr undo-elt) end)))))
+ (<= (cdr undo-elt) end)))))
(defun undo-elt-crosses-region (undo-elt start end)
"Test whether UNDO-ELT crosses one edge of that region START ... END.
(defvar shell-command-default-error-buffer nil
"*Buffer name for `shell-command' and `shell-command-on-region' error output.
-This buffer is used when `shell-command' or 'shell-command-on-region'
+This buffer is used when `shell-command' or `shell-command-on-region'
is run interactively. A value of nil means that output to stderr and
stdout will be intermixed in the output stream.")
;; Output goes in a separate buffer.
;; Preserve the match data in case called from a program.
(save-match-data
- (if (string-match "[ \t]*&[ \t]*$" command)
+ (if (string-match "[ \t]*&[ \t]*\\'" command)
;; Command ending with ampersand means asynchronous.
(let ((buffer (get-buffer-create
(or output-buffer "*Async Shell Command*")))
(if (yes-or-no-p "A command is running. Kill it? ")
(kill-process proc)
(error "Shell command in progress")))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(setq buffer-read-only nil)
(erase-buffer)
(display-buffer buffer)
(if (= (buffer-size) 0)
0
(count-lines (point-min) (point-max)))))
- (cond ((or (<= lines 1)
- (<= lines
- (if resize-mini-windows
- (cond ((floatp max-mini-window-height)
- (* (frame-height)
- max-mini-window-height))
- ((integerp max-mini-window-height)
- max-mini-window-height)
- (t
- 1))
- 1)))
+ (cond ((= lines 0))
+ ((and (or (<= lines 1)
+ (<= lines
+ (if resize-mini-windows
+ (cond ((floatp max-mini-window-height)
+ (* (frame-height)
+ max-mini-window-height))
+ ((integerp max-mini-window-height)
+ max-mini-window-height)
+ (t
+ 1))
+ 1)))
+ ;; Don't use the echo area if the output buffer is
+ ;; already dispayed in the selected frame.
+ (not (get-buffer-window (current-buffer))))
;; Echo area
(goto-char (point-max))
(when (bolp)
(let ((swap (and replace (< start end))))
;; Don't muck with mark unless REPLACE says we should.
(goto-char start)
- (and replace (push-mark))
+ (and replace (push-mark (point) 'nomsg))
(setq exit-status
(call-process-region start end shell-file-name t
(if error-file
;; No prefix argument: put the output in a temp buffer,
;; replacing its entire contents.
(let ((buffer (get-buffer-create
- (or output-buffer "*Shell Command Output*")))
- (success nil))
+ (or output-buffer "*Shell Command Output*"))))
(unwind-protect
(if (eq buffer (current-buffer))
;; If the input is the same buffer as the output,
(list buffer error-file)
buffer)
nil shell-command-switch command)))
- (setq success (and exit-status (equal 0 exit-status)))
;; Report the output.
+ (with-current-buffer buffer
+ (setq mode-line-process
+ (cond ((null exit-status)
+ " - Error")
+ ((stringp exit-status)
+ (format " - Signal [%s]" exit-status))
+ ((not (equal 0 exit-status))
+ (format " - Exit [%d]" exit-status)))))
(if (with-current-buffer buffer (> (point-max) (point-min)))
;; There's some output, display it
- (progn
- (if (not success)
- (with-current-buffer buffer
- (save-excursion
- (goto-char (point-max))
- (insert (format "...Shell command failed with code %d"
- exit-status)))))
- (display-message-or-buffer buffer))
+ (display-message-or-buffer buffer)
;; No output; error?
(let ((output
(if (and error-file
(< 0 (nth 7 (file-attributes error-file))))
"some error output"
"no output")))
- (if (equal 0 exit-status)
- (message "(Shell command succeeded with %s)"
- output)
- (message "(Shell command failed with code %d and %s)"
- exit-status output)))
+ (cond ((null exit-status)
+ (message "(Shell command failed with error)"))
+ ((equal 0 exit-status)
+ (message "(Shell command succeeded with %s)"
+ output))
+ ((stringp exit-status)
+ (message "(Shell command killed by signal %s)"
+ exit-status))
+ (t
+ (message "(Shell command failed with code %d and %s)"
+ exit-status output))))
;; Don't kill: there might be useful info in the undo-log.
;; (kill-buffer buffer)
))))
(with-current-buffer
standard-output
(call-process shell-file-name nil t nil shell-command-switch command))))
-
+\f
(defvar universal-argument-map
(let ((map (make-sparse-keymap)))
(define-key map [t] 'universal-argument-other-key)
unread-command-events)))
(reset-this-command-lengths)
(setq overriding-terminal-local-map nil))
-
+\f
;;;; Window system cut and paste hooks.
(defvar interprogram-cut-function nil
difficult to tell whether Emacs or some other program provided the
current string, it is probably good enough to return nil if the string
is equal (according to `string=') to the last text Emacs provided.")
-
+\f
;;;; The kill ring data structure.
(defvar kill-ring-yank-pointer nil
"The tail of the kill ring whose car is the last thing yanked.")
-(defun kill-new (string &optional replace)
+(defun kill-new (string &optional replace yank-handler)
"Make STRING the latest kill in the kill ring.
-Set the kill-ring-yank pointer to point to it.
+Set `kill-ring-yank-pointer' to point to it.
If `interprogram-cut-function' is non-nil, apply it to STRING.
Optional second argument REPLACE non-nil means that STRING will replace
-the front of the kill ring, rather than being added to the list."
- (and (fboundp 'menu-bar-update-yank-menu)
- (menu-bar-update-yank-menu string (and replace (car kill-ring))))
+the front of the kill ring, rather than being added to the list.
+
+Optional third arguments YANK-HANDLER controls how the STRING is later
+inserted into a buffer; see `insert-for-yank' for details.
+When a yank handler is specified, STRING must be non-empty (the yank
+handler is stored as a `yank-handler'text property on STRING).
+
+When the yank handler has a non-nil PARAM element, the original STRING
+argument is not used by `insert-for-yank'. However, since Lisp code
+may access and use elements from the kill-ring directly, the STRING
+argument should still be a \"useful\" string for such uses."
+ (if (> (length string) 0)
+ (if yank-handler
+ (put-text-property 0 1 'yank-handler yank-handler string))
+ (if yank-handler
+ (signal 'args-out-of-range
+ (list string "yank-handler specified for empty string"))))
+ (if (fboundp 'menu-bar-update-yank-menu)
+ (menu-bar-update-yank-menu string (and replace (car kill-ring))))
(if (and replace kill-ring)
(setcar kill-ring string)
(setq kill-ring (cons string kill-ring))
(if interprogram-cut-function
(funcall interprogram-cut-function string (not replace))))
-(defun kill-append (string before-p)
+(defun kill-append (string before-p &optional yank-handler)
"Append STRING to the end of the latest kill in the kill ring.
If BEFORE-P is non-nil, prepend STRING to the kill.
-If `interprogram-cut-function' is set, pass the resulting kill to
-it."
- (kill-new (if before-p
- (concat string (car kill-ring))
- (concat (car kill-ring) string))
- t))
+Optional third argument YANK-HANDLER specifies the yank-handler text
+property to be set on the combined kill ring string. If the specified
+yank-handler arg differs from the yank-handler property of the latest
+kill string, STRING is added as a new kill ring element instead of
+being appending to the last kill.
+If `interprogram-cut-function' is set, pass the resulting kill to it."
+ (let* ((cur (car kill-ring)))
+ (kill-new (if before-p (concat string cur) (concat cur string))
+ (or (= (length cur) 0)
+ (equal yank-handler (get-text-property 0 'yank-handler cur)))
+ yank-handler)))
(defun current-kill (n &optional do-not-move)
"Rotate the yanking point by N places, and then return that kill.
'(text-read-only buffer-read-only error))
(put 'text-read-only 'error-message "Text is read-only")
-(defun kill-region (beg end)
+(defun kill-region (beg end &optional yank-handler)
"Kill between point and mark.
The text is deleted but saved in the kill ring.
The command \\[yank] can retrieve it from there.
Any command that calls this function is a \"kill command\".
If the previous command was also a kill command,
the text killed this time appends to the text killed last time
-to make one entry in the kill ring."
+to make one entry in the kill ring.
+
+In Lisp code, optional third arg YANK-HANDLER specifies the yank-handler
+text property to be set on the killed text. See `insert-for-yank'."
(interactive "r")
(condition-case nil
(let ((string (delete-and-extract-region beg end)))
(when string ;STRING is nil if BEG = END
;; Add that string to the kill ring, one way or another.
(if (eq last-command 'kill-region)
- (kill-append string (< end beg))
- (kill-new string)))
- (setq this-command 'kill-region))
+ (kill-append string (< end beg) yank-handler)
+ (kill-new string nil yank-handler)))
+ (when (or string (eq last-command 'kill-region))
+ (setq this-command 'kill-region)))
((buffer-read-only text-read-only)
;; The code above failed because the buffer, or some of the characters
;; in the region, are read-only.
(setq this-command 'kill-region)
(message "If the next command is a kill, it will append"))
(setq last-command 'kill-region)))
-
+\f
;; Yanking.
+;; This is actually used in subr.el but defcustom does not work there.
+(defcustom yank-excluded-properties
+ '(read-only invisible intangible field mouse-face help-echo local-map keymap
+ yank-handler)
+ "*Text properties to discard when yanking.
+The value should be a list of text properties to discard or t,
+which means to discard all text properties."
+ :type '(choice (const :tag "All" t) (repeat symbol))
+ :group 'editing
+ :version "21.4")
+
+(defvar yank-window-start nil)
+(defvar yank-undo-function nil
+ "If non-nil, function used by `yank-pop' to delete last stretch of yanked text.
+Function is called with two parameters, START and END corresponding to
+the value of the mark and point; it is guaranteed that START <= END.
+Normally set from the UNDO element of a yank-handler; see `insert-for-yank'.")
+
(defun yank-pop (arg)
"Replace just-yanked stretch of killed text with a different stretch.
This command is allowed only immediately after a `yank' or a `yank-pop'.
(setq this-command 'yank)
(let ((inhibit-read-only t)
(before (< (point) (mark t))))
- (delete-region (point) (mark t))
+ (if before
+ (funcall (or yank-undo-function 'delete-region) (point) (mark t))
+ (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
+ (setq yank-undo-function nil)
(set-marker (mark-marker) (point) (current-buffer))
- (let ((opoint (point)))
- (insert (current-kill arg))
- (let ((inhibit-read-only t))
- (remove-text-properties opoint (point) '(read-only nil))))
+ (insert-for-yank (current-kill arg))
+ ;; Set the window start back where it was in the yank command,
+ ;; if possible.
+ (set-window-start (selected-window) yank-window-start t)
(if before
;; This is like exchange-point-and-mark, but doesn't activate the mark.
;; It is cleaner to avoid activation, even though the command
"Reinsert the last stretch of killed text.
More precisely, reinsert the stretch of killed text most recently
killed OR yanked. Put point at end, and set mark at beginning.
-With just C-u as argument, same but put point at beginning (and mark at end).
+With just \\[universal-argument] as argument, same but put point at beginning (and mark at end).
With argument N, reinsert the Nth most recently killed stretch of killed
text.
See also the command \\[yank-pop]."
(interactive "*P")
+ (setq yank-window-start (window-start))
;; If we don't get all the way thru, make last-command indicate that
;; for the following command.
(setq this-command t)
(push-mark (point))
- (let ((opoint (point)))
- (insert (current-kill (cond
- ((listp arg) 0)
- ((eq arg '-) -1)
- (t (1- arg)))))
- (let ((inhibit-read-only t))
- ;; Clear `field' property for the sake of copying from the
- ;; minibuffer prompt or a *shell* prompt.
- (remove-text-properties opoint (point) '(read-only nil field nil))))
+ (insert-for-yank (current-kill (cond
+ ((listp arg) 0)
+ ((eq arg '-) -1)
+ (t (1- arg)))))
(if (consp arg)
;; This is like exchange-point-and-mark, but doesn't activate the mark.
;; It is cleaner to avoid activation, even though the command
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point) (current-buffer)))))
;; If we do get all the way thru, make this-command indicate that.
- (setq this-command 'yank)
+ (if (eq this-command t)
+ (setq this-command 'yank))
nil)
(defun rotate-yank-pointer (arg)
With argument, rotate that many kills forward (or backward, if negative)."
(interactive "p")
(current-kill arg))
-
+\f
;; Some kill commands.
;; Internal subroutine of delete-char
(let ((col (current-column)))
(forward-char -1)
(setq col (- col (current-column)))
- (insert-char ?\ col)
+ (insert-char ?\ col)
(delete-char 1)))
(forward-char -1)
(setq count (1- count))))))
If the buffer is read-only, Emacs will beep and refrain from deleting
the line, but put the line in the kill ring anyway. This means that
-you can use this command to copy text from a read-only buffer."
+you can use this command to copy text from a read-only buffer.
+\(If the variable `kill-read-only-ok' is non-nil, then this won't
+even beep.)"
(interactive "P")
(kill-region (point)
;; It is better to move point to the other end of the kill
(forward-visible-line (prefix-numeric-value arg))
(if (eobp)
(signal 'end-of-buffer nil))
- (if (or (looking-at "[ \t]*$") (and kill-whole-line (bolp)))
- (forward-visible-line 1)
- (end-of-visible-line)))
+ (let ((end
+ (save-excursion
+ (end-of-visible-line) (point))))
+ (if (or (save-excursion
+ (skip-chars-forward " \t" end)
+ (= (point) end))
+ (and kill-whole-line (bolp)))
+ (forward-visible-line 1)
+ (goto-char end))))
(point))))
+(defun kill-whole-line (&optional arg)
+ "Kill current line.
+With prefix arg, kill that many lines starting from the current line.
+If arg is negative, kill backward. Also kill the preceding newline.
+\(This is meant to make C-x z work well with negative arguments.\)
+If arg is zero, kill current line but exclude the trailing newline."
+ (interactive "P")
+ (setq arg (prefix-numeric-value arg))
+ (if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp)))
+ (signal 'end-of-buffer nil))
+ (if (and (< arg 0) (bobp) (save-excursion (end-of-visible-line) (bobp)))
+ (signal 'beginning-of-buffer nil))
+ (unless (eq last-command 'kill-region)
+ (kill-new "")
+ (setq last-command 'kill-region))
+ (cond ((zerop arg)
+ ;; We need to kill in two steps, because the previous command
+ ;; could have been a kill command, in which case the text
+ ;; before point needs to be prepended to the current kill
+ ;; ring entry and the text after point appended. Also, we
+ ;; need to use save-excursion to avoid copying the same text
+ ;; twice to the kill ring in read-only buffers.
+ (save-excursion
+ (kill-region (point) (progn (forward-visible-line 0) (point))))
+ (kill-region (point) (progn (end-of-visible-line) (point))))
+ ((< arg 0)
+ (save-excursion
+ (kill-region (point) (progn (end-of-visible-line) (point))))
+ (kill-region (point)
+ (progn (forward-visible-line (1+ arg))
+ (unless (bobp) (backward-char))
+ (point))))
+ (t
+ (save-excursion
+ (kill-region (point) (progn (forward-visible-line 0) (point))))
+ (kill-region (point)
+ (progn (forward-visible-line arg) (point))))))
+
(defun forward-visible-line (arg)
"Move forward by ARG lines, ignoring currently invisible newlines only.
If ARG is negative, move backward -ARG lines.
If ARG is zero, move to the beginning of the current line."
(condition-case nil
(if (> arg 0)
- (while (> arg 0)
- (or (zerop (forward-line 1))
- (signal 'end-of-buffer nil))
- ;; If the following character is currently invisible,
- ;; skip all characters with that same `invisible' property value,
- ;; then find the next newline.
- (while (and (not (eobp))
- (let ((prop
- (get-char-property (point) 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec)))))
- (goto-char
- (if (get-text-property (point) 'invisible)
- (or (next-single-property-change (point) 'invisible)
- (point-max))
- (next-overlay-change (point))))
+ (progn
+ (while (> arg 0)
(or (zerop (forward-line 1))
- (signal 'end-of-buffer nil)))
- (setq arg (1- arg)))
+ (signal 'end-of-buffer nil))
+ ;; If the newline we just skipped is invisible,
+ ;; don't count it.
+ (let ((prop
+ (get-char-property (1- (point)) 'invisible)))
+ (if (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))
+ (setq arg (1+ arg))))
+ (setq arg (1- arg)))
+ ;; If invisible text follows, and it is a number of complete lines,
+ ;; skip it.
+ (let ((opoint (point)))
+ (while (and (not (eobp))
+ (let ((prop
+ (get-char-property (point) 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))))
+ (goto-char
+ (if (get-text-property (point) 'invisible)
+ (or (next-single-property-change (point) 'invisible)
+ (point-max))
+ (next-overlay-change (point)))))
+ (unless (bolp)
+ (goto-char opoint))))
(let ((first t))
- (while (or first (< arg 0))
- (if (zerop arg)
+ (while (or first (<= arg 0))
+ (if first
(beginning-of-line)
(or (zerop (forward-line -1))
(signal 'beginning-of-buffer nil)))
+ ;; If the newline we just moved to is invisible,
+ ;; don't count it.
+ (unless (bobp)
+ (let ((prop
+ (get-char-property (1- (point)) 'invisible)))
+ (unless (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))
+ (setq arg (1+ arg)))))
+ (setq first nil))
+ ;; If invisible text follows, and it is a number of complete lines,
+ ;; skip it.
+ (let ((opoint (point)))
(while (and (not (bobp))
(let ((prop
(get-char-property (1- (point)) 'invisible)))
(if (get-text-property (1- (point)) 'invisible)
(or (previous-single-property-change (point) 'invisible)
(point-min))
- (previous-overlay-change (point))))
- (or (zerop (forward-line -1))
- (signal 'beginning-of-buffer nil)))
- (setq first nil)
- (setq arg (1+ arg)))))
+ (previous-overlay-change (point)))))
+ (unless (bolp)
+ (goto-char opoint)))))
((beginning-of-buffer end-of-buffer)
nil)))
;; skip all characters with that same `invisible' property value,
;; then find the next newline.
(while (and (not (eobp))
- (let ((prop
- (get-char-property (point) 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec)))))
+ (save-excursion
+ (skip-chars-forward "^\n")
+ (let ((prop
+ (get-char-property (point) 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec))))))
+ (skip-chars-forward "^\n")
(if (get-text-property (point) 'invisible)
(goto-char (next-single-property-change (point) 'invisible))
(goto-char (next-overlay-change (point))))
(end-of-line)))
-
+\f
(defun insert-buffer (buffer)
"Insert after point the contents of BUFFER.
Puts mark after the inserted text.
BUFFER may be a buffer or a buffer name.
This function is meant for the user to run interactively.
-Don't call it from programs!"
+Don't call it from programs: use `insert-buffer-substring' instead!"
(interactive
(list
(progn
(other-buffer (current-buffer))
(window-buffer (next-window (selected-window))))
t))))
- (or (bufferp buffer)
- (setq buffer (get-buffer buffer)))
- (let (start end newmark)
- (save-excursion
- (save-excursion
- (set-buffer buffer)
- (setq start (point-min) end (point-max)))
- (insert-buffer-substring buffer start end)
- (setq newmark (point)))
- (push-mark newmark))
+ (push-mark
+ (save-excursion
+ (insert-buffer-substring (get-buffer buffer))
+ (point)))
nil)
(defun append-to-buffer (buffer start end)
(erase-buffer)
(save-excursion
(insert-buffer-substring oldbuf start end)))))
-
+\f
(put 'mark-inactive 'error-conditions '(mark-inactive error))
(put 'mark-inactive 'error-message "The mark is not active now")
"Deactivate the mark by setting `mark-active' to nil.
\(That makes a difference only in Transient Mark mode.)
Also runs the hook `deactivate-mark-hook'."
- (if transient-mark-mode
- (progn
- (setq mark-active nil)
- (run-hooks 'deactivate-mark-hook))))
+ (cond
+ ((eq transient-mark-mode 'lambda)
+ (setq transient-mark-mode nil))
+ (transient-mark-mode
+ (setq mark-active nil)
+ (run-hooks 'deactivate-mark-hook))))
(defun set-mark (pos)
"Set this buffer's mark to POS. Don't use this function!
:type 'integer
:group 'editing-basics)
+(defun pop-to-mark-command ()
+ "Jump to mark, and pop a new position for mark off the ring
+\(does not affect global mark ring\)."
+ (interactive)
+ (if (null (mark t))
+ (error "No mark set in this buffer")
+ (goto-char (mark t))
+ (pop-mark)))
+
+(defun push-mark-command (arg &optional nomsg)
+ "Set mark at where point is.
+If no prefix arg and mark is already set there, just activate it.
+Display `Mark set' unless the optional second arg NOMSG is non-nil."
+ (interactive "P")
+ (let ((mark (marker-position (mark-marker))))
+ (if (or arg (null mark) (/= mark (point)))
+ (push-mark nil nomsg t)
+ (setq mark-active t)
+ (unless nomsg
+ (message "Mark activated")))))
+
(defun set-mark-command (arg)
"Set mark at where point is, or jump to mark.
-With no prefix argument, set mark, push old mark position on local mark
-ring, and push mark on global mark ring.
-With argument, jump to mark, and pop a new position for mark off the ring
-\(does not affect global mark ring\).
+With no prefix argument, set mark, and push old mark position on local
+mark ring; also push mark on global mark ring if last mark was set in
+another buffer. Immediately repeating the command activates
+`transient-mark-mode' temporarily.
+
+With argument, e.g. \\[universal-argument] \\[set-mark-command], \
+jump to mark, and pop a new position
+for mark off the local mark ring \(this does not affect the global
+mark ring\). Use \\[pop-global-mark] to jump to a mark off the global
+mark ring \(see `pop-global-mark'\).
+
+Repeating the \\[set-mark-command] command without the prefix jumps to
+the next position off the local (or global) mark ring.
+
+With a double \\[universal-argument] prefix argument, e.g. \\[universal-argument] \
+\\[universal-argument] \\[set-mark-command], unconditionally
+set mark where point is.
Novice Emacs Lisp programmers often try to use the mark for the wrong
purposes. See the documentation of `set-mark' for more information."
(interactive "P")
- (if (null arg)
- (progn
- (push-mark nil nil t))
- (if (null (mark t))
- (error "No mark set in this buffer")
- (goto-char (mark t))
- (pop-mark))))
+ (if (eq transient-mark-mode 'lambda)
+ (setq transient-mark-mode nil))
+ (cond
+ ((and (consp arg) (> (prefix-numeric-value arg) 4))
+ (push-mark-command nil))
+ ((not (eq this-command 'set-mark-command))
+ (if arg
+ (pop-to-mark-command)
+ (push-mark-command t)))
+ ((eq last-command 'pop-to-mark-command)
+ (setq this-command 'pop-to-mark-command)
+ (pop-to-mark-command))
+ ((and (eq last-command 'pop-global-mark) (not arg))
+ (setq this-command 'pop-global-mark)
+ (pop-global-mark))
+ (arg
+ (setq this-command 'pop-to-mark-command)
+ (pop-to-mark-command))
+ ((and (eq last-command 'set-mark-command)
+ mark-active (null transient-mark-mode))
+ (setq transient-mark-mode 'lambda)
+ (message "Transient-mark-mode temporarily enabled"))
+ (t
+ (push-mark-command nil))))
(defun push-mark (&optional location nomsg activate)
"Set mark at LOCATION (point, by default) and push old mark on mark ring.
purposes. See the documentation of `set-mark' for more information.
In Transient Mark mode, this does not activate the mark."
- (if (null (mark t))
- nil
+ (unless (null (mark t))
(setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
- (if (> (length mark-ring) mark-ring-max)
- (progn
- (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
- (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
+ (when (> (length mark-ring) mark-ring-max)
+ (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
+ (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))
(set-marker (mark-marker) (or location (point)) (current-buffer))
;; Now push the mark on the global mark ring.
(if (and global-mark-ring
;; Don't push another one.
nil
(setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring))
- (if (> (length global-mark-ring) global-mark-ring-max)
- (progn
- (move-marker (car (nthcdr global-mark-ring-max global-mark-ring))
- nil)
- (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))
+ (when (> (length global-mark-ring) global-mark-ring-max)
+ (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil)
+ (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))
(or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
(message "Mark set"))
(if (or activate (not transient-mark-mode))
(defun pop-mark ()
"Pop off mark ring into the buffer's actual mark.
Does not set point. Does nothing if mark ring is empty."
- (if mark-ring
- (progn
- (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
- (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
- (deactivate-mark)
- (move-marker (car mark-ring) nil)
- (if (null (mark t)) (ding))
- (setq mark-ring (cdr mark-ring)))))
+ (when mark-ring
+ (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
+ (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
+ (deactivate-mark)
+ (move-marker (car mark-ring) nil)
+ (if (null (mark t)) (ding))
+ (setq mark-ring (cdr mark-ring))))
(defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
-(defun exchange-point-and-mark ()
+(defun exchange-point-and-mark (&optional arg)
"Put the mark where point is now, and point where the mark is now.
This command works even when the mark is not active,
-and it reactivates the mark."
- (interactive nil)
- (let ((omark (mark t)))
- (if (null omark)
- (error "No mark set in this buffer"))
- (set-mark (point))
- (goto-char omark)
- nil))
-
-(defun transient-mark-mode (arg)
+and it reactivates the mark.
+With prefix arg, `transient-mark-mode' is enabled temporarily."
+ (interactive "P")
+ (if arg
+ (if mark-active
+ (if (null transient-mark-mode)
+ (setq transient-mark-mode 'lambda))
+ (setq arg nil)))
+ (unless arg
+ (let ((omark (mark t)))
+ (if (null omark)
+ (error "No mark set in this buffer"))
+ (set-mark (point))
+ (goto-char omark)
+ nil)))
+
+(define-minor-mode transient-mark-mode
"Toggle Transient Mark mode.
With arg, turn Transient Mark mode on if arg is positive, off otherwise.
\\[apropos-documentation] and type \"transient\" or \"mark.*active\" at
the prompt, to see the documentation of commands which are sensitive to
the Transient Mark mode."
- (interactive "P")
- (setq transient-mark-mode
- (if (null arg)
- (not transient-mark-mode)
- (> (prefix-numeric-value arg) 0)))
- (if (interactive-p)
- (if transient-mark-mode
- (message "Transient Mark mode enabled")
- (message "Transient Mark mode disabled"))))
+ :global t :group 'editing-basics :require nil)
(defun pop-global-mark ()
"Pop off global mark ring and jump to the top location."
(widen))
(goto-char position)
(switch-to-buffer buffer)))
-
+\f
(defcustom next-line-add-newlines nil
"*If non-nil, `next-line' inserts newline to avoid `end of buffer' error."
:type 'boolean
new line-end line-beg)
(unwind-protect
(progn
- (if (not (or (eq last-command 'next-line)
- (eq last-command 'previous-line)))
+ (if (not (memq last-command '(next-line previous-line)))
(setq temporary-goal-column
(if (and track-eol (eolp)
;; Don't count beg of empty line as end of line
;; Set REPEAT to t to repeat the whole thing.
(setq repeat nil)
- ;; Move to the desired column.
- (line-move-to-column column)
-
- (let ((new (point))
+ (let (new
(line-beg (save-excursion (beginning-of-line) (point)))
- (line-end (save-excursion (end-of-line) (point))))
+ (line-end
+ ;; Compute the end of the line
+ ;; ignoring effectively intangible newlines.
+ (let ((inhibit-point-motion-hooks nil)
+ (inhibit-field-text-motion t))
+ (save-excursion (end-of-line) (point)))))
+
+ ;; Move to the desired column.
+ (line-move-to-column column)
+ (setq new (point))
;; Process intangibility within a line.
;; Move to the chosen destination position from above,
;; If intangibility moves us to a different (later) place
;; in the same line, use that as the destination.
(if (<= (point) line-end)
- (setq new (point))))
+ (setq new (point))
+ ;; If that position is "too late",
+ ;; try the previous allowable position.
+ ;; See if it is ok.
+ (backward-char)
+ (if (<= (point) line-end)
+ (setq new (point))
+ ;; As a last resort, use the end of the line.
+ (setq new line-end))))
;; Now move to the updated destination, processing fields
;; as well as intangibility.
(constrain-to-field new opoint nil t
'inhibit-line-move-field-capture)))
- ;; If intangibility processing moved us to a different line,
+ ;; If all this moved us to a different line,
;; retry everything within that new line.
(when (or (< (point) line-beg) (> (point) line-end))
;; Repeat the intangibility and field processing.
This function works only in certain cases,
because what we really need is for `move-to-column'
and `current-column' to be able to ignore invisible text."
- (move-to-column col)
+ (if (zerop col)
+ (beginning-of-line)
+ (move-to-column col))
(when (and line-move-ignore-invisible
(not (bolp)) (line-move-invisible (1- (point))))
"Goal column %d (use \\[set-goal-column] with an arg to unset it)")
goal-column))
nil)
-
+\f
(defun scroll-other-window-down (lines)
"Scroll the \"other window\" down.
(end-of-buffer arg)
(recenter '(t)))
(select-window orig-window))))
-
+\f
(defun transpose-chars (arg)
"Interchange characters around point, moving forward one character.
With prefix arg ARG, effect is to take character before point
and drag it forward past ARG other words (backward if ARG negative).
If ARG is zero, the words around or after point and around or after mark
are interchanged."
+ ;; FIXME: `foo a!nd bar' should transpose into `bar and foo'.
(interactive "*p")
(transpose-subr 'forward-word arg))
Does not work on a sexp that point is in the middle of
if it is a list or string."
(interactive "*p")
- (transpose-subr 'forward-sexp arg))
+ (transpose-subr
+ (lambda (arg)
+ ;; Here we should try to simulate the behavior of
+ ;; (cons (progn (forward-sexp x) (point))
+ ;; (progn (forward-sexp (- x)) (point)))
+ ;; Except that we don't want to rely on the second forward-sexp
+ ;; putting us back to where we want to be, since forward-sexp-function
+ ;; might do funny things like infix-precedence.
+ (if (if (> arg 0)
+ (looking-at "\\sw\\|\\s_")
+ (and (not (bobp))
+ (save-excursion (forward-char -1) (looking-at "\\sw\\|\\s_"))))
+ ;; Jumping over a symbol. We might be inside it, mind you.
+ (progn (funcall (if (> arg 0)
+ 'skip-syntax-backward 'skip-syntax-forward)
+ "w_")
+ (cons (save-excursion (forward-sexp arg) (point)) (point)))
+ ;; Otherwise, we're between sexps. Take a step back before jumping
+ ;; to make sure we'll obey the same precedence no matter which direction
+ ;; we're going.
+ (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward) " .")
+ (cons (save-excursion (forward-sexp arg) (point))
+ (progn (while (or (forward-comment (if (> arg 0) 1 -1))
+ (not (zerop (funcall (if (> arg 0)
+ 'skip-syntax-forward
+ 'skip-syntax-backward)
+ ".")))))
+ (point)))))
+ arg 'special))
(defun transpose-lines (arg)
"Exchange current line and previous line, leaving point after both.
(if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose"))
(atomic-change-group
(let (word2)
+ ;; FIXME: We first delete the two pieces of text, so markers that
+ ;; used to point to after the text end up pointing to before it :-(
(setq word2 (delete-and-extract-region (car pos2) (cdr pos2)))
(goto-char (car pos2))
(insert (delete-and-extract-region (car pos1) (cdr pos1)))
(goto-char (car pos1))
(insert word2))))
-
+\f
(defun backward-word (arg)
"Move backward until encountering the beginning of a word.
With argument, do this that many times."
(interactive "p")
(kill-word (- arg)))
-(defun current-word (&optional strict)
- "Return the word point is on (or a nearby word) as a string.
+(defun current-word (&optional strict really-word)
+ "Return the symbol or word that point is on (or a nearby one) as a string.
+The return value includes no text properties.
If optional arg STRICT is non-nil, return nil unless point is within
-or adjacent to a word."
+or adjacent to a symbol or word.
+The function, belying its name, normally finds a symbol.
+If optional arg REALLY-WORD is non-nil, it finds just a word."
(save-excursion
- (let ((oldpoint (point)) (start (point)) (end (point)))
- (skip-syntax-backward "w_") (setq start (point))
+ (let* ((oldpoint (point)) (start (point)) (end (point))
+ (syntaxes (if really-word "w" "w_"))
+ (not-syntaxes (concat "^" syntaxes)))
+ (skip-syntax-backward syntaxes) (setq start (point))
(goto-char oldpoint)
- (skip-syntax-forward "w_") (setq end (point))
- (if (and (eq start oldpoint) (eq end oldpoint))
- ;; Point is neither within nor adjacent to a word.
- (and (not strict)
- (progn
- ;; Look for preceding word in same line.
- (skip-syntax-backward "^w_"
- (save-excursion (beginning-of-line)
- (point)))
- (if (bolp)
- ;; No preceding word in same line.
- ;; Look for following word in same line.
- (progn
- (skip-syntax-forward "^w_"
- (save-excursion (end-of-line)
- (point)))
- (setq start (point))
- (skip-syntax-forward "w_")
- (setq end (point)))
- (setq end (point))
- (skip-syntax-backward "w_")
- (setq start (point)))
- (buffer-substring-no-properties start end)))
+ (skip-syntax-forward syntaxes) (setq end (point))
+ (when (and (eq start oldpoint) (eq end oldpoint)
+ ;; Point is neither within nor adjacent to a word.
+ (not strict))
+ ;; Look for preceding word in same line.
+ (skip-syntax-backward not-syntaxes
+ (save-excursion (beginning-of-line)
+ (point)))
+ (if (bolp)
+ ;; No preceding word in same line.
+ ;; Look for following word in same line.
+ (progn
+ (skip-syntax-forward not-syntaxes
+ (save-excursion (end-of-line)
+ (point)))
+ (setq start (point))
+ (skip-syntax-forward syntaxes)
+ (setq end (point)))
+ (setq end (point))
+ (skip-syntax-backward syntaxes)
+ (setq start (point))))
+ ;; If we found something nonempty, return it as a string.
+ (unless (= start end)
(buffer-substring-no-properties start end)))))
-
+\f
(defcustom fill-prefix nil
"*String for filling to insert at front of new line, or nil for none."
:type '(choice (const :tag "None" nil)
(and prefix (not (equal prefix ""))
;; Use auto-indentation rather than a guessed empty prefix.
(not (and fill-indent-according-to-mode
- (string-match "[ \t]*" prefix)))
+ (string-match "\\`[ \t]*\\'" prefix)))
(setq fill-prefix prefix))))
-
+
(while (and (not give-up) (> (current-column) fc))
;; Determine where to split the line.
(let* (after-prefix
(fill-point
- (let ((opoint (point))
- bounce
- (first t))
+ (let ((opoint (point)))
(save-excursion
(beginning-of-line)
(setq after-prefix (point))
(looking-at (regexp-quote fill-prefix))
(setq after-prefix (match-end 0)))
(move-to-column (1+ fc))
- ;; Move back to the point where we can break the line.
- ;; We break the line between word or
- ;; after/before the character which has character
- ;; category `|'. We search space, \c| followed by
- ;; a character, or \c| following a character. If
- ;; not found, place the point at beginning of line.
- (while (or first
- (and (not (bobp))
- (not bounce)
- (fill-nobreak-p)))
- (setq first nil)
- (re-search-backward "[ \t]\\|\\c|.\\|.\\c|\\|^")
- ;; If we find nowhere on the line to break it,
- ;; break after one word. Set bounce to t
- ;; so we will not keep going in this while loop.
- (if (<= (point) after-prefix)
- (progn
- (goto-char after-prefix)
- (re-search-forward "[ \t]" opoint t)
- (setq bounce t))
- (if (looking-at "[ \t]")
- ;; Break the line at word boundary.
- (skip-chars-backward " \t")
- ;; Break the line after/before \c|.
- (forward-char 1))))
- (if enable-multibyte-characters
- ;; If we are going to break the line after or
- ;; before a non-ascii character, we may have
- ;; to run a special function for the charset
- ;; of the character to find the correct break
- ;; point.
- (if (not (and (eq (charset-after (1- (point))) 'ascii)
- (eq (charset-after (point)) 'ascii)))
- (fill-find-break-point after-prefix)))
-
- ;; Let fill-point be set to the place where we end up.
- ;; But move back before any whitespace here.
- (skip-chars-backward " \t")
+ (fill-move-to-break-point after-prefix)
(point)))))
;; See whether the place we found is any good.
(if (save-excursion
(goto-char fill-point)
- (and (not (bolp))
- ;; There is no use breaking at end of line.
- (not (save-excursion (skip-chars-forward " ") (eolp)))
- ;; It is futile to split at the end of the prefix
- ;; since we would just insert the prefix again.
- (not (and after-prefix (<= (point) after-prefix)))
- ;; Don't split right after a comment starter
- ;; since we would just make another comment starter.
- (not (and comment-start-skip
- (let ((limit (point)))
- (beginning-of-line)
- (and (re-search-forward comment-start-skip
- limit t)
- (eq (point) limit)))))))
- ;; Ok, we have a useful place to break the line. Do it.
- (let ((prev-column (current-column)))
- ;; If point is at the fill-point, do not `save-excursion'.
- ;; Otherwise, if a comment prefix or fill-prefix is inserted,
- ;; point will end up before it rather than after it.
- (if (save-excursion
- (skip-chars-backward " \t")
- (= (point) fill-point))
- (funcall comment-line-break-function t)
+ (or (bolp)
+ ;; There is no use breaking at end of line.
+ (save-excursion (skip-chars-forward " ") (eolp))
+ ;; It is futile to split at the end of the prefix
+ ;; since we would just insert the prefix again.
+ (and after-prefix (<= (point) after-prefix))
+ ;; Don't split right after a comment starter
+ ;; since we would just make another comment starter.
+ (and comment-start-skip
+ (let ((limit (point)))
+ (beginning-of-line)
+ (and (re-search-forward comment-start-skip
+ limit t)
+ (eq (point) limit))))))
+ ;; No good place to break => stop trying.
+ (setq give-up t)
+ ;; Ok, we have a useful place to break the line. Do it.
+ (let ((prev-column (current-column)))
+ ;; If point is at the fill-point, do not `save-excursion'.
+ ;; Otherwise, if a comment prefix or fill-prefix is inserted,
+ ;; point will end up before it rather than after it.
+ (if (save-excursion
+ (skip-chars-backward " \t")
+ (= (point) fill-point))
+ (funcall comment-line-break-function t)
+ (save-excursion
+ (goto-char fill-point)
+ (funcall comment-line-break-function t)))
+ ;; Now do justification, if required
+ (if (not (eq justify 'left))
(save-excursion
- (goto-char fill-point)
- (funcall comment-line-break-function t)))
- ;; Now do justification, if required
- (if (not (eq justify 'left))
- (save-excursion
(end-of-line 0)
(justify-current-line justify nil t)))
- ;; If making the new line didn't reduce the hpos of
- ;; the end of the line, then give up now;
- ;; trying again will not help.
- (if (>= (current-column) prev-column)
- (setq give-up t)))
- ;; No good place to break => stop trying.
- (setq give-up t))))
+ ;; If making the new line didn't reduce the hpos of
+ ;; the end of the line, then give up now;
+ ;; trying again will not help.
+ (if (>= (current-column) prev-column)
+ (setq give-up t))))))
;; Justify last line.
(justify-current-line justify t t)
t)))
"The function to use for `auto-fill-function' if Auto Fill mode is turned on.
Some major modes set this.")
+;; FIXME: turn into a proper minor mode.
+;; Add a global minor mode version of it.
(defun auto-fill-mode (&optional arg)
"Toggle Auto Fill mode.
With arg, turn Auto Fill mode on if and only if arg is positive.
(error "set-fill-column requires an explicit argument")
(message "Fill column set to %d (was %d)" arg fill-column)
(setq fill-column arg)))
-
+\f
(defun set-selective-display (arg)
"Set `selective-display' to ARG; clear it if no arg.
When the value of `selective-display' is a number > 0,
(prin1 selective-display t)
(princ "." t))
+(defvaralias 'indicate-unused-lines 'indicate-empty-lines)
+(defvaralias 'default-indicate-unused-lines 'default-indicate-empty-lines)
+
+(defun toggle-truncate-lines (arg)
+ "Toggle whether to fold or truncate long lines on the screen.
+With arg, truncate long lines iff arg is positive.
+Note that in side-by-side windows, truncation is always enabled."
+ (interactive "P")
+ (setq truncate-lines
+ (if (null arg)
+ (not truncate-lines)
+ (> (prefix-numeric-value arg) 0)))
+ (force-mode-line-update)
+ (unless truncate-lines
+ (let ((buffer (current-buffer)))
+ (walk-windows (lambda (window)
+ (if (eq buffer (window-buffer window))
+ (set-window-hscroll window 0)))
+ nil t)))
+ (message "Truncate long lines %s"
+ (if truncate-lines "enabled" "disabled")))
+
(defvar overwrite-mode-textual " Ovwrt"
"The string displayed in the mode line when in overwrite mode.")
(defvar overwrite-mode-binary " Bin Ovwrt"
'overwrite-mode-binary))
(force-mode-line-update))
-(defcustom line-number-mode t
- "*Non-nil means display line number in mode line."
- :type 'boolean
- :group 'editing-basics)
-
-(defun line-number-mode (arg)
+(define-minor-mode line-number-mode
"Toggle Line Number mode.
With arg, turn Line Number mode on iff arg is positive.
When Line Number mode is enabled, the line number appears
Line numbers do not appear for very large buffers and buffers
with very long lines; see variables `line-number-display-limit'
and `line-number-display-limit-width'."
- (interactive "P")
- (setq line-number-mode
- (if (null arg) (not line-number-mode)
- (> (prefix-numeric-value arg) 0)))
- (force-mode-line-update))
+ :init-value t :global t :group 'editing-basics :require nil)
-(defcustom column-number-mode nil
- "*Non-nil means display column number in mode line."
- :type 'boolean
- :group 'editing-basics)
-
-(defun column-number-mode (arg)
+(define-minor-mode column-number-mode
"Toggle Column Number mode.
With arg, turn Column Number mode on iff arg is positive.
When Column Number mode is enabled, the column number appears
in the mode line."
- (interactive "P")
- (setq column-number-mode
- (if (null arg) (not column-number-mode)
- (> (prefix-numeric-value arg) 0)))
- (force-mode-line-update))
-
+ :global t :group 'editing-basics :require nil)
+\f
(defgroup paren-blinking nil
"Blinking matching of parens and expressions."
:prefix "blink-matching-"
;Turned off because it makes dbx bomb out.
(setq blink-paren-function 'blink-matching-open)
-
+\f
;; This executes C-g typed while Emacs is waiting for a command.
;; Quitting out of a program does not go through here;
;; that happens in the QUIT macro at the C code level.
At top-level, as an editor command, this simply beeps."
(interactive)
(deactivate-mark)
+ (setq defining-kbd-macro nil)
(signal 'quit nil))
(define-key global-map "\C-g" 'keyboard-quit)
((string-match "^ \\*" (buffer-name (current-buffer)))
(bury-buffer))))
+(defun play-sound-file (file &optional volume device)
+ "Play sound stored in FILE.
+VOLUME and DEVICE correspond to the keywords of the sound
+specification for `play-sound'."
+ (interactive "fPlay sound file: ")
+ (let ((sound (list :file file)))
+ (if volume
+ (plist-put sound :volume volume))
+ (if device
+ (plist-put sound :device device))
+ (push 'sound sound)
+ (play-sound sound)))
+
(define-key global-map "\e\e\e" 'keyboard-escape-quit)
(defcustom read-mail-command 'rmail
(function :tag "Other"))
:group 'mail)
-(defun define-mail-user-agent (symbol composefunc sendfunc
- &optional abortfunc hookvar)
- "Define a symbol to identify a mail-sending package for `mail-user-agent'.
-
-SYMBOL can be any Lisp symbol. Its function definition and/or
-value as a variable do not matter for this usage; we use only certain
-properties on its property list, to encode the rest of the arguments.
-
-COMPOSEFUNC is program callable function that composes an outgoing
-mail message buffer. This function should set up the basics of the
-buffer without requiring user interaction. It should populate the
-standard mail headers, leaving the `to:' and `subject:' headers blank
-by default.
-
-COMPOSEFUNC should accept several optional arguments--the same
-arguments that `compose-mail' takes. See that function's documentation.
-
-SENDFUNC is the command a user would run to send the message.
-
-Optional ABORTFUNC is the command a user would run to abort the
-message. For mail packages that don't have a separate abort function,
-this can be `kill-buffer' (the equivalent of omitting this argument).
-
-Optional HOOKVAR is a hook variable that gets run before the message
-is actually sent. Callers that use the `mail-user-agent' may
-install a hook function temporarily on this hook variable.
-If HOOKVAR is nil, `mail-send-hook' is used.
-
-The properties used on SYMBOL are `composefunc', `sendfunc',
-`abortfunc', and `hookvar'."
- (put symbol 'composefunc composefunc)
- (put symbol 'sendfunc sendfunc)
- (put symbol 'abortfunc (or abortfunc 'kill-buffer))
- (put symbol 'hookvar (or hookvar 'mail-send-hook)))
-
(define-mail-user-agent 'sendmail-user-agent
'sendmail-user-agent-compose
'mail-send-and-exit)
(defvar set-variable-value-history nil
"History of values entered with `set-variable'.")
-(defun set-variable (var val)
+(defun set-variable (var val &optional make-local)
"Set VARIABLE to VALUE. VALUE is a Lisp object.
When using this interactively, enter a Lisp object for VALUE.
If you want VALUE to be a string, you must surround it with doublequotes.
it were the arg to `interactive' (which see) to interactively read VALUE.
If VARIABLE has been defined with `defcustom', then the type information
-in the definition is used to check that VALUE is valid."
+in the definition is used to check that VALUE is valid.
+
+With a prefix argument, set VARIABLE to VALUE buffer-locally."
(interactive
(let* ((default-var (variable-at-point))
(var (if (symbolp default-var)
(read-variable "Set variable: ")))
(minibuffer-help-form '(describe-variable var))
(prop (get var 'variable-interactive))
- (prompt (format "Set %s to value: " var))
+ (prompt (format "Set %s%s to value: " var
+ (cond ((local-variable-p var)
+ " (buffer-local)")
+ ((or current-prefix-arg
+ (local-variable-if-set-p var))
+ " buffer-locally")
+ (t " globally"))))
(val (if prop
;; Use VAR's `variable-interactive' property
;; as an interactive spec for prompting.
(read
(read-string prompt nil
'set-variable-value-history)))))
- (list var val)))
+ (list var val current-prefix-arg)))
+ (and (custom-variable-p var)
+ (not (get var 'custom-type))
+ (custom-load-symbol var))
(let ((type (get var 'custom-type)))
(when type
;; Match with custom type.
(unless (widget-apply type :match val)
(error "Value `%S' does not match type %S of %S"
val (car type) var))))
+
+ (if make-local
+ (make-local-variable var))
+
(set var val)
;; Force a thorough redisplay for the case that the variable
;; that can be found before POINT.
(defun choose-completion-delete-max-match (string)
(let ((opoint (point))
- (len (min (length string)
- (- (point) (point-min)))))
- (goto-char (- (point) (length string)))
+ len)
+ ;; Try moving back by the length of the string.
+ (goto-char (max (- (point) (length string))
+ (minibuffer-prompt-end)))
+ ;; See how far back we were actually able to move. That is the
+ ;; upper bound on how much we can match and delete.
+ (setq len (- opoint (point)))
(if completion-ignore-case
(setq string (downcase string)))
(while (and (> len 0)
- (let ((tail (buffer-substring (point)
- (+ (point) len))))
+ (let ((tail (buffer-substring (point) opoint)))
(if completion-ignore-case
(setq tail (downcase tail)))
(not (string= tail (substring string 0 len)))))
(forward-char 1))
(delete-char len)))
-;; Switch to BUFFER and insert the completion choice CHOICE.
-;; BASE-SIZE, if non-nil, says how many characters of BUFFER's text
-;; to keep. If it is nil, use choose-completion-delete-max-match instead.
+(defvar choose-completion-string-functions nil
+ "Functions that may override the normal insertion of a completion choice.
+These functions are called in order with four arguments:
+CHOICE - the string to insert in the buffer,
+BUFFER - the buffer in which the choice should be inserted,
+MINI-P - non-nil iff BUFFER is a minibuffer, and
+BASE-SIZE - the number of characters in BUFFER before
+the string being completed.
+
+If a function in the list returns non-nil, that function is supposed
+to have inserted the CHOICE in the BUFFER, and possibly exited
+the minibuffer; no further functions will be called.
+
+If all functions in the list return nil, that means to use
+the default method of inserting the completion in BUFFER.")
-;; If BUFFER is the minibuffer, exit the minibuffer
-;; unless it is reading a file name and CHOICE is a directory,
-;; or completion-no-auto-exit is non-nil.
(defun choose-completion-string (choice &optional buffer base-size)
- (let ((buffer (or buffer completion-reference-buffer))
- (mini-p (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))))
+ "Switch to BUFFER and insert the completion choice CHOICE.
+BASE-SIZE, if non-nil, says how many characters of BUFFER's text
+to keep. If it is nil, we call `choose-completion-delete-max-match'
+to decide what to delete."
+
+ ;; If BUFFER is the minibuffer, exit the minibuffer
+ ;; unless it is reading a file name and CHOICE is a directory,
+ ;; or completion-no-auto-exit is non-nil.
+
+ (let* ((buffer (or buffer completion-reference-buffer))
+ (mini-p (minibufferp buffer)))
;; If BUFFER is a minibuffer, barf unless it's the currently
;; active minibuffer.
(if (and mini-p
(not (equal buffer
(window-buffer (active-minibuffer-window))))))
(error "Minibuffer is not active for completion")
- ;; Insert the completion into the buffer where completion was requested.
- (set-buffer buffer)
- (if base-size
- (delete-region (+ base-size (if mini-p
- (minibuffer-prompt-end)
- (point-min)))
- (point))
- (choose-completion-delete-max-match choice))
- (insert choice)
- (remove-text-properties (- (point) (length choice)) (point)
- '(mouse-face nil))
- ;; Update point in the window that BUFFER is showing in.
- (let ((window (get-buffer-window buffer t)))
- (set-window-point window (point)))
- ;; If completing for the minibuffer, exit it with this choice.
- (and (not completion-no-auto-exit)
- (equal buffer (window-buffer (minibuffer-window)))
- minibuffer-completion-table
- ;; If this is reading a file name, and the file name chosen
- ;; is a directory, don't exit the minibuffer.
- (if (and (eq minibuffer-completion-table 'read-file-name-internal)
- (file-directory-p (field-string (point-max))))
- (let ((mini (active-minibuffer-window)))
- (select-window mini)
- (when minibuffer-auto-raise
- (raise-frame (window-frame mini))))
- (exit-minibuffer))))))
+ (unless (run-hook-with-args-until-success
+ 'choose-completion-string-functions
+ choice buffer mini-p base-size)
+ ;; Insert the completion into the buffer where it was requested.
+ (set-buffer buffer)
+ (if base-size
+ (delete-region (+ base-size (if mini-p
+ (minibuffer-prompt-end)
+ (point-min)))
+ (point))
+ (choose-completion-delete-max-match choice))
+ (insert choice)
+ (remove-text-properties (- (point) (length choice)) (point)
+ '(mouse-face nil))
+ ;; Update point in the window that BUFFER is showing in.
+ (let ((window (get-buffer-window buffer t)))
+ (set-window-point window (point)))
+ ;; If completing for the minibuffer, exit it with this choice.
+ (and (not completion-no-auto-exit)
+ (equal buffer (window-buffer (minibuffer-window)))
+ minibuffer-completion-table
+ ;; If this is reading a file name, and the file name chosen
+ ;; is a directory, don't exit the minibuffer.
+ (if (and (eq minibuffer-completion-table 'read-file-name-internal)
+ (file-directory-p (field-string (point-max))))
+ (let ((mini (active-minibuffer-window)))
+ (select-window mini)
+ (when minibuffer-auto-raise
+ (raise-frame (window-frame mini))))
+ (exit-minibuffer)))))))
(defun completion-list-mode ()
"Major mode for buffers showing lists of possible completions.
(defun completion-setup-function ()
(save-excursion
- (let ((mainbuf (current-buffer)))
+ (let ((mainbuf (current-buffer))
+ (mbuf-contents (minibuffer-contents)))
+ ;; When reading a file name in the minibuffer,
+ ;; set default-directory in the minibuffer
+ ;; so it will get copied into the completion list buffer.
+ (if minibuffer-completing-file-name
+ (with-current-buffer mainbuf
+ (setq default-directory (file-name-directory mbuf-contents))))
(set-buffer standard-output)
(completion-list-mode)
(make-local-variable 'completion-reference-buffer)
(setq completion-reference-buffer mainbuf)
- (if (eq minibuffer-completion-table 'read-file-name-internal)
+ (if minibuffer-completing-file-name
;; For file name completion,
;; use the number of chars before the start of the
;; last file name component.
(save-excursion
(set-buffer mainbuf)
(goto-char (point-max))
- (skip-chars-backward (format "^%c" directory-sep-char))
+ (skip-chars-backward "^/")
(- (point) (minibuffer-prompt-end))))
;; Otherwise, in minibuffer, the whole input is being completed.
(save-match-data
- (if (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
- (buffer-name mainbuf))
+ (if (minibufferp mainbuf)
(setq completion-base-size 0))))
(goto-char (point-min))
(if (display-mouse-p)
;; to the following event.
(defun event-apply-alt-modifier (ignore-prompt)
- "Add the Alt modifier to the following event.
+ "\\<function-key-map>Add the Alt modifier to the following event.
For example, type \\[event-apply-alt-modifier] & to enter Alt-&."
(vector (event-apply-modifier (read-event) 'alt 22 "A-")))
(defun event-apply-super-modifier (ignore-prompt)
- "Add the Super modifier to the following event.
+ "\\<function-key-map>Add the Super modifier to the following event.
For example, type \\[event-apply-super-modifier] & to enter Super-&."
(vector (event-apply-modifier (read-event) 'super 23 "s-")))
(defun event-apply-hyper-modifier (ignore-prompt)
- "Add the Hyper modifier to the following event.
+ "\\<function-key-map>Add the Hyper modifier to the following event.
For example, type \\[event-apply-hyper-modifier] & to enter Hyper-&."
(vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
(defun event-apply-shift-modifier (ignore-prompt)
- "Add the Shift modifier to the following event.
+ "\\<function-key-map>Add the Shift modifier to the following event.
For example, type \\[event-apply-shift-modifier] & to enter Shift-&."
(vector (event-apply-modifier (read-event) 'shift 25 "S-")))
(defun event-apply-control-modifier (ignore-prompt)
- "Add the Ctrl modifier to the following event.
+ "\\<function-key-map>Add the Ctrl modifier to the following event.
For example, type \\[event-apply-control-modifier] & to enter Ctrl-&."
(vector (event-apply-modifier (read-event) 'control 26 "C-")))
(defun event-apply-meta-modifier (ignore-prompt)
- "Add the Meta modifier to the following event.
+ "\\<function-key-map>Add the Meta modifier to the following event.
For example, type \\[event-apply-meta-modifier] & to enter Meta-&."
(vector (event-apply-modifier (read-event) 'meta 27 "M-")))
(kp-decimal ?.)
(kp-divide ?/)
(kp-equal ?=)))
-
+\f
;;;;
;;;; forking a twin copy of a buffer.
;;;;
(setq newname (substring newname 0 (match-beginning 0))))
(when (memq (process-status process) '(run stop open))
(let* ((process-connection-type (process-tty-name process))
- (old-kwoq (process-kill-without-query process nil))
(new-process
(if (memq (process-status process) '(open))
- (apply 'open-network-stream newname
- (if (process-buffer process) (current-buffer))
- (process-contact process))
+ (let ((args (process-contact process t)))
+ (setq args (plist-put args :name newname))
+ (setq args (plist-put args :buffer
+ (if (process-buffer process)
+ (current-buffer))))
+ (apply 'make-network-process args))
(apply 'start-process newname
(if (process-buffer process) (current-buffer))
(process-command process)))))
- (process-kill-without-query new-process old-kwoq)
- (process-kill-without-query process old-kwoq)
+ (set-process-query-on-exit-flag
+ new-process (process-query-on-exit-flag process))
(set-process-inherit-coding-system-flag
new-process (process-inherit-coding-system-flag process))
(set-process-filter new-process (process-filter process))
(set-process-sentinel new-process (process-sentinel process))
+ (set-process-plist new-process (copy-sequence (process-plist process)))
new-process)))
-;; things to maybe add (currently partly covered by `funcall mode':
+;; things to maybe add (currently partly covered by `funcall mode'):
;; - syntax-table
;; - overlays
(defun clone-buffer (&optional newname display-flag)
Optional second arg NORECORD non-nil means do not put this buffer at
the front of the list of recently selected ones."
(interactive "bClone buffer in other window: ")
- (let ((popup-windows t))
+ (let ((pop-up-windows t))
(set-buffer buffer)
(clone-indirect-buffer nil t norecord)))
(define-key ctl-x-4-map "c" 'clone-indirect-buffer-other-window)
-
-
-;;; Syntax stuff.
-
-(defconst syntax-code-table
- '((?\ 0 "whitespace")
- (?- 0 "whitespace")
- (?. 1 "punctuation")
- (?w 2 "word")
- (?_ 3 "symbol")
- (?\( 4 "open parenthesis")
- (?\) 5 "close parenthesis")
- (?\' 6 "expression prefix")
- (?\" 7 "string quote")
- (?$ 8 "paired delimiter")
- (?\\ 9 "escape")
- (?/ 10 "character quote")
- (?< 11 "comment start")
- (?> 12 "comment end")
- (?@ 13 "inherit")
- (nil 14 "comment fence")
- (nil 15 "string fence"))
- "Alist of forms (CHAR CODE DESCRIPTION) mapping characters to syntax info.
-CHAR is a character that is allowed as first char in the string
-specifying the syntax when calling `modify-syntax-entry'. CODE is the
-corresponing syntax code as it is stored in a syntax cell, and
-can be used as value of a `syntax-table' property.
-DESCRIPTION is the descriptive string for the syntax.")
-
-
+\f
;;; Handling of Backspace and Delete keys.
(defcustom normal-erase-is-backspace nil
(if (interactive-p)
(message "Delete key deletes %s"
(if normal-erase-is-backspace "forward" "backward"))))
-
-
-;;; Misc
-
-(defun byte-compiling-files-p ()
- "Return t if currently byte-compiling files."
- (and (boundp 'byte-compile-current-file)
- (stringp byte-compile-current-file)))
-
-
+\f
+(defcustom idle-update-delay 0.5
+ "*Idle time delay before updating various things on the screen.
+Various Emacs features that update auxiliary information when point moves
+wait this many seconds after Emacs becomes idle before doing an update."
+ :type 'number
+ :group 'display
+ :version "21.4")
+\f
+(defvar vis-mode-saved-buffer-invisibility-spec nil
+ "Saved value of `buffer-invisibility-spec' when Visible mode is on.")
+
+(define-minor-mode visible-mode
+ "Toggle Visible mode.
+With argument ARG turn Visible mode on iff ARG is positive.
+
+Enabling Visible mode makes all invisible text temporarily visible.
+Disabling Visible mode turns off that effect. Visible mode
+works by saving the value of `buffer-invisibility-spec' and setting it to nil."
+ :lighter " Vis"
+ (when (local-variable-p 'vis-mode-saved-buffer-invisibility-spec)
+ (setq buffer-invisibility-spec vis-mode-saved-buffer-invisibility-spec)
+ (kill-local-variable 'vis-mode-saved-buffer-invisibility-spec))
+ (when visible-mode
+ (set (make-local-variable 'vis-mode-saved-buffer-invisibility-spec)
+ buffer-invisibility-spec)
+ (setq buffer-invisibility-spec nil)))
+\f
;; Minibuffer prompt stuff.
;(defun minibuffer-prompt-modification (start end)
; (message "You cannot modify the prompt")))
;
;
-;(setq minibuffer-prompt-properties
+;(setq minibuffer-prompt-properties
; (list 'modification-hooks '(minibuffer-prompt-modification)
; 'insert-in-front-hooks '(minibuffer-prompt-insertion)))
-;
+;
+(provide 'simple)
;;; simple.el ends here
;;; startup.el --- process Emacs shell arguments
-;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 98, 99, 2000, 01, 02
+;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; -no-site-file Do not load "site-start.el". (This is the ONLY
;; --no-site-file way to prevent loading that file.)
;; -------------------------
+;; -no-splash Don't display a splash screen on startup.
+;; --no-splash
+;; -------------------------
;; -u USER Load USER's init file instead of the init
;; -user USER file belonging to the user starting Emacs.
;; --user USER
:type 'boolean
:group 'initialization)
+(defvaralias 'inhibit-splash-screen 'inhibit-startup-message)
+
(defcustom inhibit-startup-echo-area-message nil
"*Non-nil inhibits the initial startup echo area message.
Setting this variable takes effect
("--cursor-color" 1 x-handle-switch cursor-color)
("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
("--line-spacing" 1 x-handle-numeric-switch line-spacing)
- ("--border-color" 1 x-handle-switch border-width))
+ ("--border-color" 1 x-handle-switch border-color)
+ ("--smid" 1 x-handle-smid))
"Alist of X Windows options.
Each element has the form
(NAME NUMARGS HANDLER FRAME-PARAM VALUE)
so as to override the definitions made by the terminal-specific file.
Emacs never sets this variable itself.")
+(defvar inhibit-startup-hooks nil
+ "Non-nil means don't run `term-setup-hook' and `emacs-startup-hook'.
+This is because we already did so.")
+
(defvar keyboard-type nil
"The brand of keyboard you are using.
This variable is used to define
:type '(choice (const nil) string)
:group 'mail)
-(defcustom user-mail-address nil
+(defcustom user-mail-address (if command-line-processed
+ (concat (user-login-name) "@"
+ (or mail-host-address
+ (system-name)))
+ ;; Empty string means "not set yet".
+ "")
"*Full mailing address of this user.
This is initialized based on `mail-host-address',
after your init file is read, in case it sets `mail-host-address'."
(defvar normal-top-level-add-subdirs-inode-list nil)
+(defvar pure-space-overflow nil
+ "Non-nil if building Emacs overflowed pure space.")
+
(defun normal-top-level-add-subdirs-to-load-path ()
"Add all subdirectories of current directory to `load-path'.
More precisely, this uses only the subdirectories whose names
start with letters or digits; it excludes any subdirectory named `RCS'
or `CVS', and any subdirectory that contains a file named `.nosearch'."
- (let (dirs
+ (let (dirs
attrs
(pending (list default-directory)))
;; This loop does a breadth-first tree walk on DIR's subtree,
(save-excursion
(set-buffer (get-buffer "*Messages*"))
(setq default-directory dir)))
+ ;; `user-full-name' is now known; reset its standard-value here.
+ (put 'user-full-name 'standard-value
+ (list (default-value 'user-full-name)))
;; For root, preserve owner and group when editing files.
(if (equal (user-uid) 0)
(setq backup-by-copying-when-mismatch t))
(make-directory
(file-name-directory auto-save-list-file-prefix)
t)
- (concat
+ (concat
(make-temp-name
(expand-file-name
auto-save-list-file-prefix))
auto-save-list-file-prefix
(emacs-pid)
(system-name))))))))
- (run-hooks 'emacs-startup-hook)
- (and term-setup-hook
- (run-hooks 'term-setup-hook))
+ (unless inhibit-startup-hooks
+ (run-hooks 'emacs-startup-hook)
+ (and term-setup-hook
+ (run-hooks 'term-setup-hook)))
;; Don't do this if we failed to create the initial frame,
;; for instance due to a dense colormap.
(defvar tool-bar-originally-present nil
"Non-nil if tool-bars are present before user and site init files are read.")
-;; Handle the X-like command line parameters "-fg", "-bg", "-name", etc.
+;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc.
(defun tty-handle-args (args)
- (let ((rest nil))
+ (let (rest)
(message "%s" args)
(while (and args
(not (equal (car args) "--")))
- (let* ((this (car args))
- (orig-this this)
- completion argval)
- (setq args (cdr args))
+ (let* ((argi (pop args))
+ (orig-argi argi)
+ argval completion)
;; Check for long options with attached arguments
;; and separate out the attached option argument into argval.
- (if (string-match "^--[^=]*=" this)
- (setq argval (substring this (match-end 0))
- this (substring this 0 (1- (match-end 0)))))
- (when (string-match "^--" this)
- (setq completion (try-completion this tty-long-option-alist))
+ (when (string-match "^\\(--[^=]*\\)=" argi)
+ (setq argval (substring argi (match-end 0))
+ argi (match-string 1 argi)))
+ (when (string-match "^--" argi)
+ (setq completion (try-completion argi tty-long-option-alist))
(if (eq completion t)
;; Exact match for long option.
- (setq this (cdr (assoc this tty-long-option-alist)))
+ (setq argi (cdr (assoc argi tty-long-option-alist)))
(if (stringp completion)
(let ((elt (assoc completion tty-long-option-alist)))
;; Check for abbreviated long option.
(or elt
- (error "Option `%s' is ambiguous" this))
- (setq this (cdr elt)))
+ (error "Option `%s' is ambiguous" argi))
+ (setq argi (cdr elt)))
;; Check for a short option.
- (setq argval nil this orig-this))))
- (cond ((or (string= this "-fg") (string= this "-foreground"))
- (or argval (setq argval (car args) args (cdr args)))
- (setq default-frame-alist
- (cons (cons 'foreground-color argval)
- default-frame-alist)))
- ((or (string= this "-bg") (string= this "-background"))
- (or argval (setq argval (car args) args (cdr args)))
- (setq default-frame-alist
- (cons (cons 'background-color argval)
- default-frame-alist)))
- ((or (string= this "-T") (string= this "-name"))
- (or argval (setq argval (car args) args (cdr args)))
- (setq default-frame-alist
- (cons
- (cons 'title
- (if (stringp argval)
- argval
- (let ((case-fold-search t)
- i)
- (setq argval (invocation-name))
-
- ;; Change any . or * characters in name to
- ;; hyphens, so as to emulate behavior on X.
- (while
- (setq i (string-match "[.*]" argval))
- (aset argval i ?-))
- argval)))
- default-frame-alist)))
- ((or (string= this "-r")
- (string= this "-rv")
- (string= this "-reverse"))
- (setq default-frame-alist
- (cons '(reverse . t)
- default-frame-alist)))
- ((string= this "-color")
- (if (null argval)
- (setq argval 8)) ; default --color means 8 ANSI colors
- (setq default-frame-alist
- (cons (cons 'tty-color-mode
- (cond
- ((numberp argval) argval)
- ((string-match "-?[0-9]+" argval)
- (string-to-number argval))
- (t (intern argval))))
- default-frame-alist)))
- (t (setq rest (cons this rest))))))
- (nreverse rest)))
+ (setq argval nil
+ argi orig-argi))))
+ (cond ((member argi '("-fg" "-foreground"))
+ (push (cons 'foreground-color (or argval (pop args)))
+ default-frame-alist))
+ ((member argi '("-bg" "-background"))
+ (push (cons 'background-color (or argval (pop args)))
+ default-frame-alist))
+ ((member argi '("-T" "-name"))
+ (unless argval (setq argval (pop args)))
+ (push (cons 'title
+ (if (stringp argval)
+ argval
+ (let ((case-fold-search t)
+ i)
+ (setq argval (invocation-name))
+
+ ;; Change any . or * characters in name to
+ ;; hyphens, so as to emulate behavior on X.
+ (while
+ (setq i (string-match "[.*]" argval))
+ (aset argval i ?-))
+ argval)))
+ default-frame-alist))
+ ((member argi '("-r" "-rv" "-reverse"))
+ (push '(reverse . t)
+ default-frame-alist))
+ ((equal argi "-color")
+ (unless argval (setq argval 8)) ; default --color means 8 ANSI colors
+ (push (cons 'tty-color-mode
+ (cond
+ ((numberp argval) argval)
+ ((string-match "-?[0-9]+" argval)
+ (string-to-number argval))
+ (t (intern argval))))
+ default-frame-alist))
+ (t
+ (push argi rest)))))
+ (nreverse rest)))
(defun command-line ()
(setq command-line-default-directory default-directory)
(setq small-temporary-file-directory
(if (eq system-type 'ms-dos)
(getenv "TMPDIR")))
+ (setq auto-save-file-name-transforms
+ (list (list "\\`/[^/]*:\\(.+/\\)*\\(.*\\)"
+ ;; Don't put "\\2" inside expand-file-name, since
+ ;; it will be transformed to "/2" on DOS/Windows.
+ (concat temporary-file-directory "\\2") t)))
;; See if we should import version-control from the environment variable.
(let ((vc (getenv "VERSION_CONTROL")))
(cond ((eq vc nil)) ;don't do anything if not set
- ((or (string= vc "t")
- (string= vc "numbered"))
+ ((member vc '("t" "numbered"))
(setq version-control t))
- ((or (string= vc "nil")
- (string= vc "existing"))
+ ((member vc '("nil" "existing"))
(setq version-control nil))
- ((or (string= vc "never")
- (string= vc "simple"))
+ ((member vc '("never" "simple"))
(setq version-control 'never))))
;;! This has been commented out; I currently find the behavior when
;; end-of-line formats that aren't native to this platform.
(cond
((memq system-type '(ms-dos windows-nt emx))
- (setq eol-mnemonic-unix "(Unix)")
- (setq eol-mnemonic-mac "(Mac)"))
+ (setq eol-mnemonic-unix "(Unix)"
+ eol-mnemonic-mac "(Mac)"))
;; Both Mac and Unix EOLs are now "native" on Mac OS so keep the
;; abbreviated strings `/' and `:' set in coding.c for them.
((eq system-type 'macos)
(setq eol-mnemonic-dos "(DOS)"))
- (t ; this is for Unix/GNU/Linux systems
- (setq eol-mnemonic-dos "(DOS)")
- (setq eol-mnemonic-mac "(Mac)")))
+ (t ; this is for Unix/GNU/Linux systems
+ (setq eol-mnemonic-dos "(DOS)"
+ eol-mnemonic-mac "(Mac)")))
;; Read window system's init file if using a window system.
(condition-case error
(apply 'concat (cdr error))
(if (memq 'file-error (get (car error) 'error-conditions))
(format "%s: %s"
- (nth 1 error)
- (mapconcat (lambda (obj) (prin1-to-string obj t))
- (cdr (cdr error)) ", "))
+ (nth 1 error)
+ (mapconcat (lambda (obj) (prin1-to-string obj t))
+ (cdr (cdr error)) ", "))
(format "%s: %s"
- (get (car error) 'error-message)
- (mapconcat (lambda (obj) (prin1-to-string obj t))
- (cdr error) ", "))))
+ (get (car error) 'error-message)
+ (mapconcat (lambda (obj) (prin1-to-string obj t))
+ (cdr error) ", "))))
'external-debugging-output)
(terpri 'external-debugging-output)
(setq window-system nil)
(kill-emacs)))
;; Windowed displays do this inside their *-win.el.
- (when (and (not (display-graphic-p))
- (not noninteractive))
+ (unless (or (display-graphic-p) noninteractive)
(setq command-line-args (tty-handle-args command-line-args)))
(set-locale-environment nil)
(while args
(setcar args
(decode-coding-string (car args) locale-coding-system t))
- (setq args (cdr args))))
+ (pop args)))
(let ((done nil)
(args (cdr command-line-args)))
;; either from the environment or from the options.
(setq init-file-user (if noninteractive nil (user-login-name)))
;; If user has not done su, use current $HOME to find .emacs.
- (and init-file-user (string= init-file-user (user-real-login-name))
+ (and init-file-user
+ (equal init-file-user (user-real-login-name))
(setq init-file-user ""))
;; Process the command-line args, and delete the arguments
;; processed. This is consistent with the way main in emacs.c
;; does things.
(while (and (not done) args)
- (let ((longopts '(("--no-init-file") ("--no-site-file") ("--user")
- ("--debug-init") ("--iconic") ("--icon-type")))
- (argi (pop args))
- (argval nil))
+ (let* ((longopts '(("--no-init-file") ("--no-site-file") ("--user")
+ ("--debug-init") ("--iconic") ("--icon-type")))
+ (argi (pop args))
+ (orig-argi argi)
+ argval)
;; Handle --OPTION=VALUE format.
- (if (and (string-match "\\`--" argi)
- (string-match "=" argi))
- (setq argval (substring argi (match-end 0))
- argi (substring argi 0 (match-beginning 0))))
- (or (equal argi "--")
- (let ((completion (try-completion argi longopts)))
- (if (eq completion t)
- (setq argi (substring argi 1))
- (if (stringp completion)
- (let ((elt (assoc completion longopts)))
- (or elt
- (error "Option `%s' is ambiguous" argi))
- (setq argi (substring (car elt) 1)))
- (setq argval nil)))))
+ (when (string-match "^\\(--[^=]*\\)=" argi)
+ (setq argval (substring argi (match-end 0))
+ argi (match-string 1 argi)))
+ (unless (equal argi "--")
+ (let ((completion (try-completion argi longopts)))
+ (if (eq completion t)
+ (setq argi (substring argi 1))
+ (if (stringp completion)
+ (let ((elt (assoc completion longopts)))
+ (or elt
+ (error "Option `%s' is ambiguous" argi))
+ (setq argi (substring (car elt) 1)))
+ (setq argval nil
+ argi orig-argi)))))
(cond
((member argi '("-q" "-no-init-file"))
(setq init-file-user nil))
((member argi '("-u" "-user"))
- (or argval
- (setq argval (pop args)))
- (setq init-file-user argval
+ (setq init-file-user (or argval (pop args))
argval nil))
- ((string-equal argi "-no-site-file")
+ ((equal argi "-no-site-file")
(setq site-run-file nil))
- ((string-equal argi "-debug-init")
+ ((equal argi "-debug-init")
(setq init-file-debug t))
- ((string-equal argi "-iconic")
+ ((equal argi "-iconic")
(push '(visibility . icon) initial-frame-alist))
- ((or (string-equal argi "-icon-type")
- (string-equal argi "-i")
- (string-equal argi "-itype"))
+ ((member argi '("-icon-type" "-i" "-itype"))
(push '(icon-type . t) default-frame-alist))
;; Push the popped arg back on the list of arguments.
- (t (push argi args) (setq done t)))
+ (t
+ (push argi args)
+ (setq done t)))
;; Was argval set but not used?
(and argval
(error "Option `%s' doesn't allow an argument" argi))))
;; Re-attach the program name to the front of the arg list.
- (and command-line-args (setcdr command-line-args args)))
+ (and command-line-args
+ (setcdr command-line-args args)))
;; Under X Windows, this creates the X frame and deletes the terminal frame.
(when (fboundp 'frame-initialize)
(frame-initialize))
;; If frame was created with a menu bar, set menu-bar-mode on.
- (if (and (not noninteractive)
- (or (not (memq window-system '(x w32)))
- (> (frame-parameter nil 'menu-bar-lines) 0)))
- (menu-bar-mode t))
+ (unless (or noninteractive
+ (and (memq window-system '(x w32))
+ (<= (frame-parameter nil 'menu-bar-lines) 0)))
+ (menu-bar-mode 1))
;; If frame was created with a tool bar, switch tool-bar-mode on.
- (when (and (not noninteractive)
- (display-graphic-p)
- (> (frame-parameter nil 'tool-bar-lines) 0))
+ (unless (or noninteractive
+ (not (display-graphic-p))
+ (<= (frame-parameter nil 'tool-bar-lines) 0))
(tool-bar-mode 1))
;; Can't do this init in defcustom because window-system isn't set.
- (when (and (not noninteractive)
- (not (eq system-type 'ms-dos))
- (memq window-system '(x w32)))
+ (unless (or noninteractive
+ (eq system-type 'ms-dos)
+ (not (memq window-system '(x w32))))
(setq-default blink-cursor t)
(blink-cursor-mode 1))
(setq-default normal-erase-is-backspace t)
(normal-erase-is-backspace-mode 1)))
- (when (and (not noninteractive)
- (display-graphic-p)
- (fboundp 'x-show-tip))
+ (unless (or noninteractive
+ (not (display-graphic-p))
+ (not (fboundp 'x-show-tip)))
(setq-default tooltip-mode t)
(tooltip-mode 1))
;; Register default TTY colors for the case the terminal hasn't a
;; terminal init file.
- (or (memq window-system '(x w32))
- ;; We do this regardles of whether the terminal supports colors
- ;; or not, since they can switch that support on or off in
- ;; mid-session by setting the tty-color-mode frame parameter.
- (tty-register-default-colors))
+ (unless (memq window-system '(x w32))
+ ;; We do this regardles of whether the terminal supports colors
+ ;; or not, since they can switch that support on or off in
+ ;; mid-session by setting the tty-color-mode frame parameter.
+ (tty-register-default-colors))
;; Record whether the tool-bar is present before the user and site
;; init files are processed. frame-notice-user-settings uses this
(let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist)
(assq 'tool-bar-lines default-frame-alist))))
(setq tool-bar-originally-present
- (not (or (null tool-bar-lines)
- (null (cdr tool-bar-lines))
- (eq 0 (cdr tool-bar-lines)))))))
+ (and tool-bar-lines
+ (cdr tool-bar-lines)
+ (not (eq 0 (cdr tool-bar-lines)))))))
(let ((old-scalable-fonts-allowed scalable-fonts-allowed)
(old-font-list-limit font-list-limit)
;; Run the site-start library if it exists. The point of this file is
;; that it is run before .emacs. There is no point in doing this after
;; .emacs; that is useless.
- (if site-run-file
+ (if site-run-file
(load site-run-file t t))
;; Sites should not disable this. Only individuals should disable
(if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
"~/.emacs"
"~/_emacs"))
- ((eq system-type 'vax-vms)
+ ((eq system-type 'vax-vms)
"sys$login:.emacs")
(t
(concat "~" init-file-user "/.emacs")))))
;; into user-init-file.
(setq user-init-file t)
(load user-init-file-1 t t)
-
- ;; If we did not find the user's init file,
- ;; set user-init-file conclusively to nil;
- ;; don't let it be set from default.el.
- (if (eq user-init-file t)
- (setq user-init-file user-init-file-1))
-
+
+ (when (eq user-init-file t)
+ ;; If we did not find ~/.emacs, try
+ ;; ~/.emacs.d/.emacs.
+ (let ((otherfile
+ (expand-file-name
+ (file-name-nondirectory user-init-file-1)
+ (file-name-as-directory
+ (expand-file-name
+ ".emacs.d"
+ (file-name-directory user-init-file-1))))))
+ (load otherfile t t)
+
+ ;; If we did not find the user's init file,
+ ;; set user-init-file conclusively.
+ ;; Don't let it be set from default.el.
+ (when (eq user-init-file t)
+ (setq user-init-file user-init-file-1))))
+
;; If we loaded a compiled file, set
;; `user-init-file' to the source version if that
;; exists.
source user-init-file)
(sit-for 1))
(setq user-init-file source))))
-
- (or inhibit-default-init
- (let ((inhibit-startup-message nil))
- ;; Users are supposed to be told their rights.
- ;; (Plus how to get help and how to undo.)
- ;; Don't you dare turn this off for anyone
- ;; except yourself.
- (load "default" t t)))))))))
+
+ (when (stringp custom-file)
+ (unless (assoc custom-file load-history)
+ ;; If the .emacs file has set `custom-file' but hasn't
+ ;; loaded the file yet, let's load it.
+ (load custom-file t t)))
+
+ (unless inhibit-default-init
+ (let ((inhibit-startup-message nil))
+ ;; Users are supposed to be told their rights.
+ ;; (Plus how to get help and how to undo.)
+ ;; Don't you dare turn this off for anyone
+ ;; except yourself.
+ (load "default" t t)))))))))
(if init-file-debug
;; Do this without a condition-case if the user wants to debug.
(funcall inner)
(format "%s%s%s"
(get (car error) 'error-message)
(if (cdr error) ": " "")
- (mapconcat 'prin1-to-string (cdr error) ", "))
+ (mapconcat (lambda (s) (prin1-to-string s t)) (cdr error) ", "))
"\n\n"
- "To ensure normal operation, you should investigate the cause\n"
- "of the error in your initialization file and remove it. Start\n"
- "Emacs with the `--debug-init' option to view a complete error\n"
- "backtrace\n"))
+ "To ensure normal operation, you should investigate and remove the\n"
+ "cause of the error in your initialization file. Start Emacs with\n"
+ "the `--debug-init' option to view a complete error backtrace.\n\n"))
(message "Error in init file: %s%s%s"
(get (car error) 'error-message)
(if (cdr error) ": " "")
(mapconcat 'prin1-to-string (cdr error) ", "))
- (pop-to-buffer "*Messages*")
+ (let ((pop-up-windows nil))
+ (pop-to-buffer "*Messages*"))
(setq init-file-had-error t)))))
;; If the user has a file of abbrevs, read it.
;; originally done before unibyte was set and is sensitive to
;; unibyte (display table, terminal coding system &c).
(set-language-environment current-language-environment)))
-
+
;; Do this here in case the init file sets mail-host-address.
- (or user-mail-address
+ (if (equal user-mail-address "")
(setq user-mail-address (concat (user-login-name) "@"
(or mail-host-address
(system-name)))))
(eq font-list-limit old-font-list-limit)
(eq face-ignored-fonts old-face-ignored-fonts))
(clear-face-cache)))
-
+
(run-hooks 'after-init-hook)
;; If *scratch* exists and init file didn't change its mode, initialize it.
(if (get-buffer "*scratch*")
- (save-excursion
- (set-buffer "*scratch*")
+ (with-current-buffer "*scratch*"
(if (eq major-mode 'fundamental-mode)
(funcall initial-major-mode))))
-
+
;; Load library for our terminal type.
;; User init file can set term-file-prefix to nil to prevent this.
- (and term-file-prefix (not noninteractive) (not window-system)
- (let ((term (getenv "TERM"))
- hyphend)
- (while (and term
- (not (load (concat term-file-prefix term) t t)))
- ;; Strip off last hyphen and what follows, then try again
- (if (setq hyphend (string-match "[-_][^-_]+$" term))
- (setq term (substring term 0 hyphend))
- (setq term nil)))))
+ (unless (or noninteractive
+ window-system
+ (null term-file-prefix))
+ (let ((term (getenv "TERM"))
+ hyphend)
+ (while (and term
+ (not (load (concat term-file-prefix term) t t)))
+ ;; Strip off last hyphen and what follows, then try again
+ (setq term
+ (if (setq hyphend (string-match "[-_][^-_]+$" term))
+ (substring term 0 hyphend)
+ nil)))))
+
+ ;; Update the out-of-memory error message based on user's key bindings
+ ;; for save-some-buffers.
+ (setq memory-signal-data
+ (list 'error
+ (substitute-command-keys "Memory exhausted--use \\[save-some-buffers] then exit and restart Emacs")))
;; Process the remaining args.
(command-line-1 (cdr command-line-args))
;; If -batch, terminate after processing the command options.
- (if noninteractive (kill-emacs t)))
+ (if noninteractive (kill-emacs t))
+
+ ;; Run emacs-session-restore (session management) if started by
+ ;; the session manager and we have a session manager connection.
+ (if (and (boundp 'x-session-previous-id)
+ (stringp x-session-previous-id))
+ (emacs-session-restore x-session-previous-id)))
(defcustom initial-scratch-message (purecopy "\
;; This buffer is for notes you don't want to save, and for Lisp evaluation.
:face variable-pitch "\
Emacs Tutorial\tLearn-by-doing tutorial for using Emacs efficiently
Emacs FAQ\tFrequently asked questions and answers
+Read the Emacs Manual\tView the Emacs manual using Info
\(Non)Warranty\tGNU Emacs comes with "
:face (variable-pitch :slant oblique)
"ABSOLUTELY NO WARRANTY\n"
:face variable-pitch
"\
Copying Conditions\tConditions for redistributing and changing Emacs
-Ordering Manuals\tHow to order Emacs manuals from the Free Software Foundation\n")
+More Manuals / Ordering Manuals Buying printed manuals from the FSF\n")
(:face variable-pitch
"You can do basic editing with the menu bar and scroll bar \
using the mouse.\n\n"
+
"
))
"A list of texts to show in the middle part of splash screens.
(insert-image img (propertize "xxx" 'help-echo help-echo
'keymap map)))
(insert "\n"))))
- (if (eq system-type 'gnu/linux)
- (fancy-splash-insert
- :face '(variable-pitch :foreground "red")
- "GNU Emacs is one component of a Linux-based GNU system.")
- (fancy-splash-insert
- :face '(variable-pitch :foreground "red")
+ (fancy-splash-insert
+ :face '(variable-pitch :background "red")
+ "\n!! This version is ALPHA status. It may lose your data!!\n\n")
+ (fancy-splash-insert
+ :face '(variable-pitch :foreground "red")
+ (if (eq system-type 'gnu/linux)
+ "GNU Emacs is one component of the GNU/Linux operating system."
"GNU Emacs is one component of the GNU operating system."))
(insert "\n")
(unless (equal (buffer-name fancy-splash-outer-buffer) "*scratch*")
(let ((text (car fancy-current-text)))
(set-buffer buffer)
(erase-buffer)
+ (if pure-space-overflow
+ (insert "Warning Warning Pure space overflow Warning Warning\n"))
(fancy-splash-head)
(apply #'fancy-splash-insert text)
(fancy-splash-tail)
(defun fancy-splash-default-action ()
- "Default action for events in the splash screen buffer."
+ "Stop displaying the splash screen buffer.
+This is an internal function used to turn off the splash screen after
+the user caused an input event by hitting a key or clicking with the
+mouse."
(interactive)
(push last-command-event unread-command-events)
(throw 'exit nil))
(fancy-splash-outer-buffer (current-buffer))
splash-buffer
(old-minor-mode-map-alist minor-mode-map-alist)
+ (frame (fancy-splash-frame))
timer)
- (switch-to-buffer "GNU Emacs")
- (setq tab-width 20)
- (setq splash-buffer (current-buffer))
- (catch 'stop-splashing
- (unwind-protect
- (let ((map (make-sparse-keymap)))
- (use-local-map map)
- (define-key map [t] 'fancy-splash-default-action)
- (define-key map [mouse-movement] 'ignore)
- (define-key map [mode-line t] 'ignore)
- (setq cursor-type nil
- display-hourglass nil
- minor-mode-map-alist nil
- buffer-undo-list t
- mode-line-format (propertize "---- %b %-"
- 'face '(:weight bold))
- fancy-splash-stop-time (+ (float-time)
- (max 60 fancy-splash-max-time))
- timer (run-with-timer 0 fancy-splash-delay
- #'fancy-splash-screens-1
- splash-buffer))
- (recursive-edit))
+ (save-selected-window
+ (select-frame frame)
+ (switch-to-buffer "GNU Emacs")
+ (setq tab-width 20)
+ (setq splash-buffer (current-buffer))
+ (catch 'stop-splashing
+ (unwind-protect
+ (let ((map (make-sparse-keymap)))
+ (use-local-map map)
+ (define-key map [switch-frame] 'ignore)
+ (define-key map [t] 'fancy-splash-default-action)
+ (define-key map [mouse-movement] 'ignore)
+ (define-key map [mode-line t] 'ignore)
+ (setq cursor-type nil
+ display-hourglass nil
+ minor-mode-map-alist nil
+ buffer-undo-list t
+ mode-line-format (propertize "---- %b %-"
+ 'face '(:weight bold))
+ fancy-splash-stop-time (+ (float-time)
+ (max 60 fancy-splash-max-time))
+ timer (run-with-timer 0 fancy-splash-delay
+ #'fancy-splash-screens-1
+ splash-buffer))
+ (recursive-edit))
(cancel-timer timer)
(setq display-hourglass old-hourglass
minor-mode-map-alist old-minor-mode-map-alist)
- (kill-buffer splash-buffer)))))
-
+ (kill-buffer splash-buffer))))))
+
+(defun fancy-splash-frame ()
+ "Return the frame to use for the fancy splash screen.
+Returning non-nil does not mean we should necessarily
+use the fancy splash screen, but if we do use it,
+we put it on this frame."
+ (let (chosen-frame)
+ (dolist (frame (append (frame-list) (list (selected-frame))))
+ (if (and (frame-visible-p frame)
+ (not (window-minibuffer-p (frame-selected-window frame))))
+ (setq chosen-frame frame)))
+ chosen-frame))
(defun use-fancy-splash-screens-p ()
"Return t if fancy splash screens should be used."
(when (or (and (display-color-p)
(image-type-available-p 'xpm))
(image-type-available-p 'pbm))
- (let* ((img (create-image (or fancy-splash-image
- (if (and (display-color-p)
- (image-type-available-p 'xpm))
- "splash.xpm" "splash.pbm"))))
- (image-height (and img (cdr (image-size img))))
- (window-height (1- (window-height (selected-window)))))
- (> window-height (+ image-height 19)))))
+ (let ((frame (fancy-splash-frame)))
+ (when frame
+ (let* ((img (create-image (or fancy-splash-image
+ (if (and (display-color-p)
+ (image-type-available-p 'xpm))
+ "splash.xpm" "splash.pbm"))))
+ (image-height (and img (cdr (image-size img))))
+ (window-height (1- (window-height (frame-selected-window frame)))))
+ (> window-height (+ image-height 19)))))))
(defun normal-splash-screen ()
"Display splash screen when Emacs starts."
- (with-current-buffer (get-buffer-create "GNU Emacs")
- (let ((tab-width 8)
- (mode-line-format (propertize "---- %b %-"
- 'face '(:weight bold))))
-
- ;; The convention for this piece of code is that
- ;; each piece of output starts with one or two newlines
- ;; and does not end with any newlines.
- (insert "Welcome to GNU Emacs")
- (if (eq system-type 'gnu/linux)
- (insert ", one component of a Linux-based GNU system."))
- (insert "\n")
-
- (unless (equal (buffer-name (current-buffer)) "*scratch*")
- (insert (substitute-command-keys
- "\nType \\[recenter] to begin editing your file.\n")))
-
- (if (display-mouse-p)
- ;; The user can use the mouse to activate menus
- ;; so give help in terms of menu items.
- (progn
- (insert "\
+ (let ((prev-buffer (current-buffer)))
+ (unwind-protect
+ (with-current-buffer (get-buffer-create "GNU Emacs")
+ (let ((tab-width 8)
+ (mode-line-format (propertize "---- %b %-"
+ 'face '(:weight bold))))
+
+ (if pure-space-overflow
+ (insert "Warning Warning Pure space overflow Warning Warning\n"))
+
+ ;; The convention for this piece of code is that
+ ;; each piece of output starts with one or two newlines
+ ;; and does not end with any newlines.
+ (insert "Welcome to GNU Emacs")
+ (insert
+ (if (eq system-type 'gnu/linux)
+ ", one component of the GNU/Linux operating system.\n"
+ ", a part of the GNU operating system.\n"))
+
+ (unless (equal (buffer-name prev-buffer) "*scratch*")
+ (insert (substitute-command-keys
+ "\nType \\[recenter] to begin editing your file.\n")))
+
+ (if (display-mouse-p)
+ ;; The user can use the mouse to activate menus
+ ;; so give help in terms of menu items.
+ (progn
+ (insert "\
You can do basic editing with the menu bar and scroll bar using the mouse.
Useful File menu items:
Important Help menu items:
Emacs Tutorial Learn-by-doing tutorial for using Emacs efficiently.
Emacs FAQ Frequently asked questions and answers
+Read the Emacs Manual View the Emacs manual using Info
\(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY
Copying Conditions Conditions for redistributing and changing Emacs.
Getting New Versions How to obtain the latest version of Emacs.
-Ordering Manuals How to order manuals from the FSF.
+More Manuals / Ordering Manuals How to order printed manuals from the FSF.
")
- (insert "\n\n" (emacs-version)
- "
-Copyright (C) 2001 Free Software Foundation, Inc."))
-
- ;; No mouse menus, so give help using kbd commands.
-
- ;; If keys have their default meanings,
- ;; use precomputed string to save lots of time.
- (if (and (eq (key-binding "\C-h") 'help-command)
- (eq (key-binding "\C-xu") 'advertised-undo)
- (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)
- (eq (key-binding "\C-ht") 'help-with-tutorial)
- (eq (key-binding "\C-hi") 'info)
- (eq (key-binding "\C-h\C-n") 'view-emacs-news))
- (insert "
+ (insert "\n\n" (emacs-version)
+ "
+Copyright (C) 2002 Free Software Foundation, Inc."))
+
+ ;; No mouse menus, so give help using kbd commands.
+
+ ;; If keys have their default meanings,
+ ;; use precomputed string to save lots of time.
+ (if (and (eq (key-binding "\C-h") 'help-command)
+ (eq (key-binding "\C-xu") 'advertised-undo)
+ (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)
+ (eq (key-binding "\C-ht") 'help-with-tutorial)
+ (eq (key-binding "\C-hi") 'info)
+ (eq (key-binding "\C-hr") 'info-emacs-manual)
+ (eq (key-binding "\C-h\C-n") 'view-emacs-news))
+ (insert "
Get help C-h (Hold down CTRL and press h)
-Undo changes C-x u Exit Emacs C-x C-c
-Get a tutorial C-h t Use Info to read docs C-h i
-Ordering manuals C-h RET")
- (insert (substitute-command-keys
- (format "\n
+Emacs manual C-h r
+Emacs tutorial C-h t Undo changes C-x u
+Buy manuals C-h C-m Exit Emacs C-x C-c
+Browse manuals C-h i")
+
+ (insert (substitute-command-keys
+ (format "\n
Get help %s
-Undo changes \\[advertised-undo]
-Exit Emacs \\[save-buffers-kill-emacs]
-Get a tutorial \\[help-with-tutorial]
-Use Info to read docs \\[info]
-Ordering manuals \\[view-order-manuals]"
- (let ((where (where-is-internal
- 'help-command nil t)))
- (if where
- (key-description where)
- "M-x help"))))))
-
- ;; Say how to use the menu bar with the keyboard.
- (if (and (eq (key-binding "\M-`") 'tmm-menubar)
- (eq (key-binding [f10]) 'tmm-menubar))
- (insert "
+Emacs manual \\[info-emacs-manual]
+Emacs tutorial \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo]
+Buy manuals \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-emacs]
+Browse manuals \\[info]"
+ (let ((where (where-is-internal
+ 'help-command nil t)))
+ (if where
+ (key-description where)
+ "M-x help"))))))
+
+ ;; Say how to use the menu bar with the keyboard.
+ (if (and (eq (key-binding "\M-`") 'tmm-menubar)
+ (eq (key-binding [f10]) 'tmm-menubar))
+ (insert "
Activate menubar F10 or ESC ` or M-`")
- (insert (substitute-command-keys "
+ (insert (substitute-command-keys "
Activate menubar \\[tmm-menubar]")))
- ;; Many users seem to have problems with these.
- (insert "
+ ;; Many users seem to have problems with these.
+ (insert "
\(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key.
If you have no Meta key, you may instead type ESC followed by the character.)")
- (insert "\n\n" (emacs-version)
- "
-Copyright (C) 2001 Free Software Foundation, Inc.")
+ (insert "\n\n" (emacs-version)
+ "
+Copyright (C) 2002 Free Software Foundation, Inc.")
- (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
- (eq (key-binding "\C-h\C-d") 'describe-distribution)
- (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
- (insert
- "\n
+ (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
+ (eq (key-binding "\C-h\C-d") 'describe-distribution)
+ (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
+ (insert
+ "\n
GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
Emacs is Free Software--Free as in Freedom--so you can redistribute copies
of Emacs and modify it; type C-h C-c to see the conditions.
Type C-h C-d for information on getting the latest version.")
- (insert (substitute-command-keys
- "\n
+ (insert (substitute-command-keys
+ "\n
GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
Emacs is Free Software--Free as in Freedom--so you can redistribute copies
of Emacs and modify it; type \\[describe-copying] to see the conditions.
Type \\[describe-distribution] for information on getting the latest version."))))
- ;; The rest of the startup screen is the same on all
- ;; kinds of terminals.
-
- ;; Give information on recovering, if there was a crash.
- (and auto-save-list-file-prefix
- ;; Don't signal an error if the
- ;; directory for auto-save-list files
- ;; does not yet exist.
- (file-directory-p (file-name-directory
- auto-save-list-file-prefix))
- (directory-files
- (file-name-directory auto-save-list-file-prefix)
- nil
- (concat "\\`"
- (regexp-quote (file-name-nondirectory
- auto-save-list-file-prefix)))
- t)
- (insert "\n\nIf an Emacs session crashed recently, "
- "type M-x recover-session RET\nto recover"
- " the files you were editing."))
-
- ;; Display the input that we set up in the buffer.
- (set-buffer-modified-p nil)
- (goto-char (point-min))
- (save-window-excursion
- (switch-to-buffer (current-buffer))
- (sit-for 120))))
- (kill-buffer "GNU Emacs"))
+ ;; The rest of the startup screen is the same on all
+ ;; kinds of terminals.
+
+ ;; Give information on recovering, if there was a crash.
+ (and auto-save-list-file-prefix
+ ;; Don't signal an error if the
+ ;; directory for auto-save-list files
+ ;; does not yet exist.
+ (file-directory-p (file-name-directory
+ auto-save-list-file-prefix))
+ (directory-files
+ (file-name-directory auto-save-list-file-prefix)
+ nil
+ (concat "\\`"
+ (regexp-quote (file-name-nondirectory
+ auto-save-list-file-prefix)))
+ t)
+ (insert "\n\nIf an Emacs session crashed recently, "
+ "type M-x recover-session RET\nto recover"
+ " the files you were editing."))
+
+ ;; Display the input that we set up in the buffer.
+ (set-buffer-modified-p nil)
+ (goto-char (point-min))
+ (save-window-excursion
+ (switch-to-buffer (current-buffer))
+ (sit-for 120))))
+ ;; Unwind ... ensure splash buffer is killed
+ (kill-buffer "GNU Emacs"))))
+
(defun startup-echo-area-message ()
(if (eq (key-binding "\C-h\C-p") 'describe-project)
user-init-file
(or (and (get 'inhibit-startup-echo-area-message 'saved-value)
(equal inhibit-startup-echo-area-message
- (if (string= init-file-user "")
+ (if (equal init-file-user "")
(user-login-name)
init-file-user)))
;; Wasn't set with custom; see if .emacs has a setq.
"inhibit-startup-echo-area-message[ \t\n]+"
(regexp-quote
(prin1-to-string
- (if (string= init-file-user "")
+ (if (equal init-file-user "")
(user-login-name)
init-file-user)))
"[ \t\n]*)")
;; Delay 2 seconds after an init file error message
;; was displayed, so user can read it.
- (if init-file-had-error
- (sit-for 2))
-
- (if command-line-args-left
- ;; We have command args; process them.
- (let ((dir command-line-default-directory)
- (file-count 0)
- first-file-buffer
- tem
- just-files ;; t if this follows the magic -- option.
- ;; This includes our standard options' long versions
- ;; and long versions of what's on command-switch-alist.
- (longopts
- (append '(("--funcall") ("--load") ("--insert") ("--kill")
- ("--directory") ("--eval") ("--execute")
- ("--find-file") ("--visit") ("--file"))
- (mapcar (lambda (elt)
- (list (concat "-" (car elt))))
- command-switch-alist)))
- (line 0)
- (column 0))
-
- ;; Add the long X options to longopts.
- (dolist (tem command-line-x-option-alist)
- (if (string-match "^--" (car tem))
- (push (list (car tem)) longopts)))
-
- ;; Loop, processing options.
- (while (and command-line-args-left)
- (let* ((argi (car command-line-args-left))
- (orig-argi argi)
- argval completion
- ;; List of directories specified in -L/--directory,
- ;; in reverse of the order specified.
- extra-load-path
- (initial-load-path load-path))
- (setq command-line-args-left (cdr command-line-args-left))
-
- ;; Do preliminary decoding of the option.
- (if just-files
- ;; After --, don't look for options; treat all args as files.
- (setq argi "")
- ;; Convert long options to ordinary options
- ;; and separate out an attached option argument into argval.
- (if (string-match "^--[^=]*=" argi)
- (setq argval (substring argi (match-end 0))
- argi (substring argi 0 (1- (match-end 0)))))
- (if (equal argi "--")
- (setq completion nil)
- (setq completion (try-completion argi longopts)))
- (if (eq completion t)
- (setq argi (substring argi 1))
- (if (stringp completion)
- (let ((elt (assoc completion longopts)))
- (or elt
- (error "Option `%s' is ambiguous" argi))
- (setq argi (substring (car elt) 1)))
- (setq argval nil argi orig-argi))))
-
- ;; Execute the option.
- (cond ((setq tem (assoc argi command-switch-alist))
- (if argval
- (let ((command-line-args-left
- (cons argval command-line-args-left)))
- (funcall (cdr tem) argi))
- (funcall (cdr tem) argi)))
-
- ((member argi '("-f" ;what the manual claims
- "-funcall"
- "-e")) ; what the source used to say
- (if argval
- (setq tem (intern argval))
- (setq tem (intern (car command-line-args-left)))
- (setq command-line-args-left (cdr command-line-args-left)))
- (if (arrayp (symbol-function tem))
- (command-execute tem)
- (funcall tem)))
-
- ((member argi '("-eval" "-execute"))
- (if argval
- (setq tem argval)
- (setq tem (car command-line-args-left))
- (setq command-line-args-left (cdr command-line-args-left)))
- (eval (read tem)))
- ;; Set the default directory as specified in -L.
-
- ((member argi '("-L" "-directory"))
- (if argval
- (setq tem argval)
- (setq tem (car command-line-args-left)
- command-line-args-left (cdr command-line-args-left)))
- (setq tem (command-line-normalize-file-name tem))
- (setq extra-load-path
- (cons (expand-file-name tem) extra-load-path))
- (setq load-path (append (nreverse extra-load-path)
- initial-load-path)))
-
- ((member argi '("-l" "-load"))
- (if argval
- (setq tem argval)
- (setq tem (car command-line-args-left)
- command-line-args-left (cdr command-line-args-left)))
- (let ((file (command-line-normalize-file-name tem)))
- ;; Take file from default dir if it exists there;
- ;; otherwise let `load' search for it.
- (if (file-exists-p (expand-file-name file))
- (setq file (expand-file-name file)))
- (load file nil t)))
-
- ((string-equal argi "-insert")
- (if argval
- (setq tem argval)
- (setq tem (car command-line-args-left)
- command-line-args-left (cdr command-line-args-left)))
- (or (stringp tem)
- (error "File name omitted from `-insert' option"))
- (insert-file-contents (command-line-normalize-file-name tem)))
-
- ((string-equal argi "-kill")
- (kill-emacs t))
-
- ((string-match "^\\+[0-9]+\\'" argi)
- (setq line (string-to-int argi)))
-
- ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi)
- (setq line (string-to-int (match-string 1 argi))
- column (string-to-int (match-string 2 argi))))
-
- ((setq tem (assoc argi command-line-x-option-alist))
- ;; Ignore X-windows options and their args if not using X.
- (setq command-line-args-left
- (nthcdr (nth 1 tem) command-line-args-left)))
-
- ((member argi '("-find-file" "-file" "-visit"))
- ;; An explicit option to specify visiting a file.
- (if argval
- (setq tem argval)
- (setq tem (car command-line-args-left)
- command-line-args-left (cdr command-line-args-left)))
- (unless (stringp tem)
- (error "File name omitted from `%s' option" argi))
- (setq file-count (1+ file-count))
- (let ((file (expand-file-name
- (command-line-normalize-file-name tem) dir)))
- (if (= file-count 1)
- (setq first-file-buffer (find-file file))
- (find-file-other-window file)))
- (or (zerop line)
- (goto-line line))
- (setq line 0)
- (unless (< column 1)
- (move-to-column (1- column)))
- (setq column 0))
-
- ((equal argi "--")
- (setq just-files t))
- (t
- ;; We have almost exhausted our options. See if the
- ;; user has made any other command-line options available
- (let ((hooks command-line-functions) ;; lrs 7/31/89
- (did-hook nil))
- (while (and hooks
- (not (setq did-hook (funcall (car hooks)))))
- (setq hooks (cdr hooks)))
- (if (not did-hook)
- ;; Ok, presume that the argument is a file name
- (progn
- (if (string-match "\\`-" argi)
- (error "Unknown option `%s'" argi))
- (setq file-count (1+ file-count))
- (let ((file
- (expand-file-name
- (command-line-normalize-file-name orig-argi)
- dir)))
- (if (= file-count 1)
- (setq first-file-buffer (find-file file))
- (find-file-other-window file)))
- (or (zerop line)
- (goto-line line))
- (setq line 0)
- (unless (< column 1)
- (move-to-column (1- column)))
- (setq column 0))))))))
- ;; If 3 or more files visited, and not all visible,
- ;; show user what they all are. But leave the last one current.
- (and (> file-count 2)
- (not noninteractive)
- (not inhibit-startup-buffer-menu)
- (or (get-buffer-window first-file-buffer)
- (list-buffers)))))
+ (when init-file-had-error
+ (sit-for 2))
+
+ (when command-line-args-left
+ ;; We have command args; process them.
+ (let ((dir command-line-default-directory)
+ (file-count 0)
+ first-file-buffer
+ tem
+ ;; The directories listed in --directory/-L options will *appear*
+ ;; at the front of `load-path' in the order they appear on the
+ ;; command-line. We cannot do this by *placing* them at the front
+ ;; in the order they appear, so we need this variable to hold them,
+ ;; temporarily.
+ extra-load-path
+ just-files ;; t if this follows the magic -- option.
+ ;; This includes our standard options' long versions
+ ;; and long versions of what's on command-switch-alist.
+ (longopts
+ (append '(("--funcall") ("--load") ("--insert") ("--kill")
+ ("--directory") ("--eval") ("--execute") ("--no-splash")
+ ("--find-file") ("--visit") ("--file"))
+ (mapcar (lambda (elt)
+ (list (concat "-" (car elt))))
+ command-switch-alist)))
+ (line 0)
+ (column 0))
+
+ ;; Add the long X options to longopts.
+ (dolist (tem command-line-x-option-alist)
+ (if (string-match "^--" (car tem))
+ (push (list (car tem)) longopts)))
+
+ ;; Loop, processing options.
+ (while command-line-args-left
+ (let* ((argi (car command-line-args-left))
+ (orig-argi argi)
+ argval completion)
+ (setq command-line-args-left (cdr command-line-args-left))
+
+ ;; Do preliminary decoding of the option.
+ (if just-files
+ ;; After --, don't look for options; treat all args as files.
+ (setq argi "")
+ ;; Convert long options to ordinary options
+ ;; and separate out an attached option argument into argval.
+ (when (string-match "^\\(--[^=]*\\)=" argi)
+ (setq argval (substring argi (match-end 0))
+ argi (match-string 1 argi)))
+ (if (equal argi "--")
+ (setq completion nil)
+ (setq completion (try-completion argi longopts)))
+ (if (eq completion t)
+ (setq argi (substring argi 1))
+ (if (stringp completion)
+ (let ((elt (assoc completion longopts)))
+ (or elt
+ (error "Option `%s' is ambiguous" argi))
+ (setq argi (substring (car elt) 1)))
+ (setq argval nil
+ argi orig-argi))))
+
+ ;; Execute the option.
+ (cond ((setq tem (assoc argi command-switch-alist))
+ (if argval
+ (let ((command-line-args-left
+ (cons argval command-line-args-left)))
+ (funcall (cdr tem) argi))
+ (funcall (cdr tem) argi)))
+
+ ((equal argi "-no-splash")
+ (setq inhibit-startup-message t))
+
+ ((member argi '("-f" ; what the manual claims
+ "-funcall"
+ "-e")) ; what the source used to say
+ (setq tem (intern (or argval (pop command-line-args-left))))
+ (if (commandp tem)
+ (command-execute tem)
+ (funcall tem)))
+
+ ((member argi '("-eval" "-execute"))
+ (eval (read (or argval (pop command-line-args-left)))))
+ ;; Set the default directory as specified in -L.
+
+ ((member argi '("-L" "-directory"))
+ (setq tem (or argval (pop command-line-args-left)))
+ ;; We will reverse `extra-load-path' and prepend it to
+ ;; `load-path' after all the arguments have been processed.
+ (push
+ (expand-file-name (command-line-normalize-file-name tem))
+ extra-load-path))
+
+ ((member argi '("-l" "-load"))
+ (let* ((file (command-line-normalize-file-name
+ (or argval (pop command-line-args-left))))
+ ;; Take file from default dir if it exists there;
+ ;; otherwise let `load' search for it.
+ (file-ex (expand-file-name file)))
+ (when (file-exists-p file-ex)
+ (setq file file-ex))
+ (load file nil t)))
+
+ ((equal argi "-insert")
+ (setq tem (or argval (pop command-line-args-left)))
+ (or (stringp tem)
+ (error "File name omitted from `-insert' option"))
+ (insert-file-contents (command-line-normalize-file-name tem)))
+
+ ((equal argi "-kill")
+ (kill-emacs t))
+
+ ((string-match "^\\+[0-9]+\\'" argi)
+ (setq line (string-to-int argi)))
+
+ ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi)
+ (setq line (string-to-int (match-string 1 argi))
+ column (string-to-int (match-string 2 argi))))
+
+ ((setq tem (assoc argi command-line-x-option-alist))
+ ;; Ignore X-windows options and their args if not using X.
+ (setq command-line-args-left
+ (nthcdr (nth 1 tem) command-line-args-left)))
+
+ ((member argi '("-find-file" "-file" "-visit"))
+ ;; An explicit option to specify visiting a file.
+ (setq tem (or argval (pop command-line-args-left)))
+ (unless (stringp tem)
+ (error "File name omitted from `%s' option" argi))
+ (setq file-count (1+ file-count))
+ (let ((file (expand-file-name
+ (command-line-normalize-file-name tem) dir)))
+ (if (= file-count 1)
+ (setq first-file-buffer (find-file file))
+ (find-file-other-window file)))
+ (or (zerop line)
+ (goto-line line))
+ (setq line 0)
+ (unless (< column 1)
+ (move-to-column (1- column)))
+ (setq column 0))
+
+ ((equal argi "--")
+ (setq just-files t))
+ (t
+ ;; We have almost exhausted our options. See if the
+ ;; user has made any other command-line options available
+ (let ((hooks command-line-functions) ;; lrs 7/31/89
+ (did-hook nil))
+ (while (and hooks
+ (not (setq did-hook (funcall (car hooks)))))
+ (setq hooks (cdr hooks)))
+ (if (not did-hook)
+ ;; Presume that the argument is a file name.
+ (progn
+ (if (string-match "\\`-" argi)
+ (error "Unknown option `%s'" argi))
+ (setq file-count (1+ file-count))
+ (let ((file
+ (expand-file-name
+ (command-line-normalize-file-name orig-argi)
+ dir)))
+ (if (= file-count 1)
+ (setq first-file-buffer (find-file file))
+ (find-file-other-window file)))
+ (or (zerop line)
+ (goto-line line))
+ (setq line 0)
+ (unless (< column 1)
+ (move-to-column (1- column)))
+ (setq column 0))))))))
+
+ ;; See --directory/-L option above.
+ (when extra-load-path
+ (setq load-path (append (nreverse extra-load-path) load-path)))
+
+ ;; If 3 or more files visited, and not all visible,
+ ;; show user what they all are. But leave the last one current.
+ (and (> file-count 2)
+ (not noninteractive)
+ (not inhibit-startup-buffer-menu)
+ (or (get-buffer-window first-file-buffer)
+ (list-buffers)))))
;; Maybe display a startup screen.
(when (and (not inhibit-startup-message) (not noninteractive)
;; If there are no switches to process, we might as well
;; run this hook now, and there may be some need to do it
;; before doing any output.
+ (run-hooks 'emacs-startup-hook)
(and term-setup-hook
(run-hooks 'term-setup-hook))
- ;; Don't let the hook be run twice.
- (setq term-setup-hook nil)
+ (setq inhibit-startup-hooks t)
;; It's important to notice the user settings before we
;; display the startup message; otherwise, the settings
;; clicks the menu bar during the sit-for.
(when (display-popup-menus-p)
(precompute-menubar-bindings))
- (setq menubar-bindings-done t)
+ (with-no-warnings
+ (setq menubar-bindings-done t))
;; If *scratch* is selected and it is empty, insert an
;; initial message saying not to create a file there.
(when (and initial-scratch-message
- (string= (buffer-name) "*scratch*")
+ (equal (buffer-name) "*scratch*")
(= 0 (buffer-size)))
(insert initial-scratch-message)
(set-buffer-modified-p nil))
;; This code now understands the extra fields that GNU tar adds to tar files.
;; This interacts correctly with "uncompress.el" in the Emacs library,
-;; which you get with
+;; which you get with
;;
;; (autoload 'uncompress-while-visiting "uncompress")
;; (setq auto-mode-alist (cons '("\\.Z$" . uncompress-while-visiting)
;;
;; Do not attempt to use tar-mode.el with crypt.el, you will lose.
-;; *************** TO DO ***************
+;; *************** TO DO ***************
;;
;; o chmod should understand "a+x,og-w".
;;
-;; o It's not possible to add a NEW file to a tar archive; not that
+;; o It's not possible to add a NEW file to a tar archive; not that
;; important, but still...
;;
;; o The code is less efficient that it could be - in a lot of places, I
;; of an archive, where <esc> would leave you in a subfile-edit buffer.
;; (Like the Meta-R command of the Zmacs mail reader.)
;;
-;; o Sometimes (but not always) reverting the tar-file buffer does not
+;; o Sometimes (but not always) reverting the tar-file buffer does not
;; re-grind the listing, and you are staring at the binary tar data.
;; Typing 'g' again immediately after that will always revert and re-grind
;; it, though. I have no idea why this happens.
;; might be a problem if the tar write-file-hook does not come *first* on
;; the list.
;;
-;; o Block files, sparse files, continuation files, and the various header
+;; o Block files, sparse files, continuation files, and the various header
;; types aren't editable. Actually I don't know that they work at all.
;; Rationale:
(defcustom tar-anal-blocksize 20
"*The blocksize of tar files written by Emacs, or nil, meaning don't care.
The blocksize of a tar file is not really the size of the blocks; rather, it is
-the number of blocks written with one system call. When tarring to a tape,
+the number of blocks written with one system call. When tarring to a tape,
this is the size of the *tape* blocks, but when writing to a file, it doesn't
matter much. The only noticeable difference is that if a tar file does not
have a blocksize of 20, tar will tell you that; all this really controls is
tar file will update its datestamp. If false, the datestamp is unchanged.
You may or may not want this - it is good in that you can tell when a file
in a tar archive has been changed, but it is bad for the same reason that
-editing a file in the tar archive at all is bad - the changed version of
+editing a file in the tar archive at all is bad - the changed version of
the file never exists on disk."
:type 'boolean
:group 'tar)
: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."
(defun tar-header-block-tokenize (string)
"Return a `tar-header' structure.
-This is a list of name, mode, uid, gid, size,
+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
- 'undecided))
+ (decode-coding-string name tar-file-name-coding-system)
linkname
- (decode-coding-string linkname (or file-name-coding-system
- 'undecided))))
+ (decode-coding-string linkname
+ 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)
;; Add up all of the characters except the ones in the checksum field.
;; Add that field as if it were filled with spaces.
(while (< i chk-field-start)
- (setq sum (+ sum (multibyte-char-to-unibyte (aref string i)))
+ (setq sum (+ sum (aref string i))
i (1+ i)))
(setq i chk-field-end)
(while (< i 512)
- (setq sum (+ sum (multibyte-char-to-unibyte (aref string i)))
+ (setq sum (+ sum (aref string i))
i (1+ i)))
(+ sum (* 32 8))))
(format "%c%c%s%8s/%-8s%7s%s %s%s"
(if mod-p ?* ? )
(cond ((or (eq type nil) (eq type 0)) ?-)
- ((eq type 1) ?l) ; link
- ((eq type 2) ?s) ; symlink
+ ((eq type 1) ?h) ; link
+ ((eq type 2) ?l) ; symlink
((eq type 3) ?c) ; char special
((eq type 4) ?b) ; block special
((eq type 5) ?d) ; directory
((eq type 6) ?p) ; FIFO/pipe
((eq type 20) ?*) ; directory listing
+ ((eq type 28) ?L) ; next has longname
((eq type 29) ?M) ; multivolume continuation
((eq type 35) ?S) ; sparse
((eq type 38) ?V) ; volume header
(concat (if (= type 1) " ==> " " --> ") link-name)
""))))
+(defun tar-untar-buffer ()
+ "Extract all archive members in the tar-file into the current directory."
+ (interactive)
+ (let ((multibyte enable-multibyte-characters))
+ (unwind-protect
+ (save-restriction
+ (widen)
+ (set-buffer-multibyte nil)
+ (dolist (descriptor tar-parse-info)
+ (let* ((tokens (tar-desc-tokens descriptor))
+ (name (tar-header-name tokens))
+ (dir (file-name-directory name))
+ (start (+ (tar-desc-data-start descriptor)
+ (- tar-header-offset (point-min))))
+ (end (+ start (tar-header-size tokens))))
+ (unless (file-directory-p name)
+ (message "Extracting %s" name)
+ (if (and dir (not (file-exists-p dir)))
+ (make-directory dir t))
+ (unless (file-directory-p name)
+ (write-region start end name))
+ (set-file-modes name (tar-header-mode tokens))))))
+ (set-buffer-multibyte multibyte))))
+
(defun tar-summarize-buffer ()
"Parse the contents of the tar file in the current buffer.
Place a dired-like listing on the front;
then narrow to it, so that only that listing
is visible (and the real data of the buffer is hidden)."
-- (set-buffer-multibyte nil)
(message "Parsing tar file...")
(let* ((result '())
- (pos 1)
+ (pos (point-min))
(bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end.
(bs100 (max 1 (/ bs 100)))
tokens)
(cons (tar-header-block-summarize (tar-desc-tokens tar-desc))
(cons "\n"
summaries))))
- (if default-enable-multibyte-characters
- (set-buffer-multibyte t 'to))
(let ((total-summaries (apply 'concat summaries)))
- (if (multibyte-string-p total-summaries)
- (set-buffer-multibyte t))
(insert total-summaries))
(make-local-variable 'tar-header-offset)
(setq tar-header-offset (point))
- (narrow-to-region 1 tar-header-offset)
+ (narrow-to-region (point-min) tar-header-offset)
- (if enable-multibyte-characters
- (setq tar-header-offset (position-bytes tar-header-offset)))
(set-buffer-modified-p nil))))
\f
(defvar tar-mode-map nil "*Local keymap for Tar mode listings.")
;;;###autoload
(define-derived-mode tar-mode nil "Tar"
"Major mode for viewing a tar file as a dired-like listing of its contents.
-You can move around using the usual cursor motion commands.
+You can move around using the usual cursor motion commands.
Letters no longer insert themselves.
Type `e' to pull a file out of the tar file and into its own buffer;
or click mouse-2 on the file's line in the Tar mode buffer.
Type `c' to copy an entry from the tar file into another file on disk.
-If you edit a sub-file of this archive (as with the `e' command) and
-save it with Control-x Control-s, the contents of that buffer will be
-saved back into the tar-file buffer; in this way you can edit a file
+If you edit a sub-file of this archive (as with the `e' command) and
+save it with Control-x Control-s, the contents of that buffer will be
+saved back into the tar-file buffer; in this way you can edit a file
inside of a tar archive without extracting it and re-archiving it.
See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
(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)
(set (make-local-variable 'write-contents-hooks) '(tar-mode-write-file))
(widen)
(if (and (boundp 'tar-header-offset) tar-header-offset)
- (narrow-to-region (point-min) (byte-to-position tar-header-offset))
- (narrow-to-region 1 tar-header-offset)
++ (narrow-to-region (point-min) tar-header-offset)
(tar-summarize-buffer)
(tar-next-line 0)))
(interactive "P")
(or (and (boundp 'tar-superior-buffer) tar-superior-buffer)
(error "This buffer is not an element of a tar file"))
-;;; Don't do this, because it is redundant and wastes mode line space.
-;;; (or (assq 'tar-subfile-mode minor-mode-alist)
-;;; (setq minor-mode-alist (append minor-mode-alist
-;;; (list '(tar-subfile-mode " TarFile")))))
+ ;; Don't do this, because it is redundant and wastes mode line space.
+ ;; (or (assq 'tar-subfile-mode minor-mode-alist)
+ ;; (setq minor-mode-alist (append minor-mode-alist
+ ;; (list '(tar-subfile-mode " TarFile")))))
(make-local-variable 'tar-subfile-mode)
(setq tar-subfile-mode
(if (null p)
(not tar-subfile-mode)
(> (prefix-numeric-value p) 0)))
(cond (tar-subfile-mode
- (make-local-variable 'local-write-file-hooks)
- (setq local-write-file-hooks '(tar-subfile-save-buffer))
+ (add-hook 'write-file-functions 'tar-subfile-save-buffer nil t)
;; turn off auto-save.
(auto-save-mode -1)
(setq buffer-auto-save-file-name nil)
(run-hooks 'tar-subfile-mode-hook))
(t
- (kill-local-variable 'local-write-file-hooks))))
+ (remove-hook 'write-file-functions 'tar-subfile-save-buffer t))))
;; Revert the buffer and recompute the dired-like listing.
(error "This is a %s, not a real file"
(cond ((eq link-p 5) "directory")
((eq link-p 20) "tar directory header")
+ ((eq link-p 28) "next has longname")
((eq link-p 29) "multivolume-continuation")
((eq link-p 35) "sparse entry")
((eq link-p 38) "volume header")
(tokens (tar-desc-tokens descriptor))
(name (tar-header-name tokens))
(size (tar-header-size tokens))
- (start (+ (tar-desc-data-start descriptor) tar-header-offset -1))
+ (start (+ (tar-desc-data-start descriptor)
+ (- 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)))
(unless buffer
(setq buffer (generate-new-buffer bufname))
(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)))))
+ (if (or (not coding)
+ (eq (coding-system-type coding) 'undecided))
+ (setq coding (detect-coding-region start end t)))
- (if (eq (coding-system-type coding) 'undecided)
- (setq coding
- (coding-system-change-text-conversion coding
- 'us-ascii)))
++ (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)
- (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))
- (if (and enable-multibyte-characters
- (eq (coding-system-type 'raw-text) coding))
- (set-buffer-multibyte nil))
(goto-char (point-min))
(setq buffer-file-name new-buffer-file-name)
(setq buffer-file-truename
- (abbreviate-file-name buffer-file-name)))
- (decode-coding-region start end coding buffer)
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-min))
+ (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)))))))
- (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))
- (setq coding (coding-system-change-eol-conversion
- coding
- (coding-system-eol-type detected))))
- (setq coding
- (or (find-new-buffer-file-coding-system detected)
- (let ((file-coding
- (find-operation-coding-system
- 'insert-file-contents buffer-file-name)))
- (if (consp file-coding)
- (setq file-coding (car file-coding))
- file-coding)))))
- (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)
- (set-buffer-file-coding-system coding))
++ (set-buffer-file-coding-system coding)
;; Set the default-directory to the dir of the
- ;; superior buffer.
+ ;; superior buffer.
(setq default-directory
(save-excursion
(set-buffer tar-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)
+ (setq buffer-read-only read-only-p)
(set-buffer-modified-p nil)
(tar-subfile-mode 1))
(set-buffer tar-buffer))
- (narrow-to-region 1 tar-header-offset)
+ (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)
(tokens (tar-desc-tokens descriptor))
(name (tar-header-name tokens))
(size (tar-header-size tokens))
- (start (+ (tar-desc-data-start descriptor) tar-header-offset -1))
+ (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))
(tar-setf (tar-desc-data-start desc)
(- (tar-desc-data-start desc) data-length))))
))
- (narrow-to-region 1 tar-header-offset))
+ (narrow-to-region (point-min) tar-header-offset))
(defun tar-expunge (&optional noconfirm)
(interactive)
(if (or noconfirm
(y-or-n-p "Expunge files marked for deletion? "))
- (let ((n 0)
- (multibyte enable-multibyte-characters))
- (set-buffer-multibyte nil)
+ (let ((n 0))
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(forward-line 1)))
;; after doing the deletions, add any padding that may be necessary.
(tar-pad-to-blocksize)
- (narrow-to-region 1 tar-header-offset))
+ (narrow-to-region (point-min) tar-header-offset))
- (set-buffer-multibyte multibyte)
(if (zerop n)
(message "Nothing to expunge.")
(message "%s files expunged. Be sure to save this buffer." n)))))
(interactive)
(save-excursion
(goto-char (point-min))
- (while (< (position-bytes (point)) tar-header-offset)
+ (while (< (point) tar-header-offset)
(if (not (eq (following-char) ?\ ))
(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)
- (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 -513)))
;;
;; 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
(buffer-substring start (+ start 512))
chk (tar-header-name tokens))
)))
- (narrow-to-region 1 tar-header-offset)
+ (narrow-to-region (point-min) tar-header-offset)
- (set-buffer-multibyte multibyte)
(tar-next-line 0))))
(defun tar-octal-time (timeval)
;; Format a timestamp as 11 octal digits. Ghod, I hope this works...
(let ((hibits (car timeval)) (lobits (car (cdr timeval))))
- (insert (format "%05o%01o%05o"
- (lsh hibits -2)
- (logior (lsh (logand 3 hibits) 1) (> (logand lobits 32768) 0))
- (logand 32767 lobits)
- ))))
+ (format "%05o%01o%05o"
+ (lsh hibits -2)
+ (logior (lsh (logand 3 hibits) 1)
+ (if (> (logand lobits 32768) 0) 1 0))
+ (logand 32767 lobits)
+ )))
(defun tar-subfile-save-buffer ()
"In tar subfile mode, save this buffer into its parent tar-file buffer.
(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'.
- (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 -1))
+ (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 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)))
- (if (multibyte-string-p line)
- (insert-before-markers (string-as-unibyte line) "\n")
- (insert-before-markers 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 1 tar-header-offset)))
++ (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 1 tar-header-offset))
++ (narrow-to-region (point-min) tar-header-offset))
;; Return t because we've written the file.
t)
\f
(defvar term-ansi-at-save-anon nil)
(defvar term-ansi-current-bold 0)
(defvar term-ansi-current-color 0)
-(defvar term-ansi-face-alredy-done 0)
+(defvar term-ansi-face-already-done 0)
(defvar term-ansi-current-bg-color 0)
(defvar term-ansi-current-underline 0)
(defvar term-ansi-current-highlight 0)
(defvar term-ansi-default-fg 0)
(defvar term-ansi-default-bg 0)
(defvar term-ansi-current-temp 0)
-(defvar term-ansi-fg-faces-vector nil)
-(defvar term-ansi-bg-faces-vector nil)
-(defvar term-ansi-inv-fg-faces-vector nil)
-(defvar term-ansi-inv-bg-faces-vector nil)
-(defvar term-ansi-reverse-faces-vector nil)
;;; Four should be enough, if you want more, just add. -mm
(defvar term-terminal-more-parameters 0)
;;; faces -mm
-(defmacro term-ignore-error (&rest body)
- `(condition-case nil
- (progn ,@body)
- (error nil)))
-
-(defvar term-default-fg-color nil)
-(defvar term-default-bg-color nil)
-
-(when (fboundp 'make-face)
-;;; --- Simple faces ---
- (copy-face 'default 'term-default)
- (make-face 'term-default-fg)
- (make-face 'term-default-bg)
- (make-face 'term-default-fg-inv)
- (make-face 'term-default-bg-inv)
- (make-face 'term-bold)
- (make-face 'term-underline)
- (make-face 'term-invisible)
- (make-face 'term-invisible-inv)
-
- (term-ignore-error
- (set-face-foreground 'term-default-fg term-default-fg-color))
- (term-ignore-error
- (set-face-background 'term-default-bg term-default-bg-color))
-
- (term-ignore-error
- (set-face-foreground 'term-default-fg-inv term-default-bg-color))
- (term-ignore-error
- (set-face-background 'term-default-bg-inv term-default-fg-color))
-
- (term-ignore-error
- (set-face-background 'term-invisible term-default-bg-color))
-
- (term-ignore-error
- (set-face-background 'term-invisible-inv term-default-fg-color))
-
- ;; Set the colors of the new faces.
- (term-ignore-error
- (make-face-bold 'term-bold))
-
- (term-ignore-error
- (set-face-underline-p 'term-underline t))
-
-;;; --- Fg faces ---
- (make-face 'term-black)
- (make-face 'term-red)
- (make-face 'term-green)
- (make-face 'term-yellow)
- (make-face 'term-blue)
- (make-face 'term-magenta)
- (make-face 'term-cyan)
- (make-face 'term-white)
-
- (term-ignore-error
- (set-face-foreground 'term-black "black"))
- (term-ignore-error
- (set-face-foreground 'term-red "red"))
- (term-ignore-error
- (set-face-foreground 'term-green "green"))
- (term-ignore-error
- (set-face-foreground 'term-yellow "yellow"))
- (term-ignore-error
- (set-face-foreground 'term-blue "blue"))
- (term-ignore-error
- (set-face-foreground 'term-magenta "magenta"))
- (term-ignore-error
- (set-face-foreground 'term-cyan "cyan"))
- (term-ignore-error
- (set-face-foreground 'term-white "white"))
-
-;;; --- Bg faces ---
- (make-face 'term-blackbg)
- (make-face 'term-redbg)
- (make-face 'term-greenbg)
- (make-face 'term-yellowbg)
- (make-face 'term-bluebg)
- (make-face 'term-magentabg)
- (make-face 'term-cyanbg)
- (make-face 'term-whitebg)
-
- (term-ignore-error
- (set-face-background 'term-blackbg "black"))
- (term-ignore-error
- (set-face-background 'term-redbg "red"))
- (term-ignore-error
- (set-face-background 'term-greenbg "green"))
- (term-ignore-error
- (set-face-background 'term-yellowbg "yellow"))
- (term-ignore-error
- (set-face-background 'term-bluebg "blue"))
- (term-ignore-error
- (set-face-background 'term-magentabg "magenta"))
- (term-ignore-error
- (set-face-background 'term-cyanbg "cyan"))
- (term-ignore-error
- (set-face-background 'term-whitebg "white")))
-
-(defvar ansi-term-fg-faces-vector
- [term-default-fg term-black term-red term-green term-yellow term-blue
- term-magenta term-cyan term-white])
-
-(defvar ansi-term-bg-faces-vector
- [term-default-bg term-blackbg term-redbg term-greenbg term-yellowbg
- term-bluebg term-magentabg term-cyanbg term-whitebg])
-
-(defvar ansi-term-inv-bg-faces-vector
- [term-default-fg-inv term-black term-red term-green term-yellow term-blue
- term-magenta term-cyan term-white])
-
-(defvar ansi-term-inv-fg-faces-vector
- [term-default-bg-inv term-blackbg term-redbg term-greenbg term-yellowbg
- term-bluebg term-magentabg term-cyanbg term-whitebg])
+(defcustom term-default-fg-color nil
+ "Default color for foreground in `term'."
+ :group 'term
+ :type 'string)
+
+(defcustom term-default-bg-color nil
+ "Default color for background in `term'."
+ :group 'term
+ :type 'string)
+
+(defvar ansi-term-color-vector
+ [nil "black" "red" "green" "yellow" "blue"
+ "magenta" "cyan" "white"])
;;; Inspiration came from comint.el -mm
(defvar term-buffer-maximum-size 2048
Notice that a setting of 0 means 'don't truncate anything'. This variable
is buffer-local.")
;;;
-
+\f
(term-if-xemacs
(defvar term-terminal-menu
'("Terminal"
[ "Enable paging" term-pager-toggle (not term-pager-count)]
[ "Disable paging" term-pager-toggle term-pager-count])))
-(put 'term-mode 'mode-class 'special)
-
-(defun term-mode ()
- "Major mode for interacting with an inferior interpreter.
-Interpreter name is same as buffer name, sans the asterisks.
-In line sub-mode, return at end of buffer sends line as input,
-while return not at end copies rest of line to end and sends it.
-In char sub-mode, each character (except `term-escape-char`) is
-set immediately.
-
-This mode is typically customised to create inferior-lisp-mode,
-shell-mode, etc.. This can be done by setting the hooks
-term-input-filter-functions, term-input-filter, term-input-sender and
-term-get-old-input to appropriate functions, and the variable
-term-prompt-regexp to the appropriate regular expression.
-
-An input history is maintained of size `term-input-ring-size', and
-can be accessed with the commands \\[term-next-input],
-\\[term-previous-input], and \\[term-dynamic-list-input-ring].
-Input ring history expansion can be achieved with the commands
-\\[term-replace-by-expanded-history] or \\[term-magic-space].
-Input ring expansion is controlled by the variable `term-input-autoexpand',
-and addition is controlled by the variable `term-input-ignoredups'.
-
-Input to, and output from, the subprocess can cause the window to scroll to
-the end of the buffer. See variables `term-scroll-to-bottom-on-input',
-and `term-scroll-to-bottom-on-output'.
-
-If you accidentally suspend your process, use \\[term-continue-subjob]
-to continue it.
-
-\\{term-mode-map}
-
-Entry to this mode runs the hooks on term-mode-hook"
- (interactive)
- ;; Do not remove this. All major modes must do this.
- (kill-all-local-variables)
- (setq major-mode 'term-mode)
- (setq mode-name "Term")
- (use-local-map term-mode-map)
- (make-local-variable 'term-home-marker)
- (setq term-home-marker (copy-marker 0))
- (make-local-variable 'term-saved-home-marker)
- (make-local-variable 'term-height)
- (make-local-variable 'term-width)
- (setq term-width (1- (window-width)))
- (setq term-height (1- (window-height)))
- (make-local-variable 'term-terminal-parameter)
- (make-local-variable 'term-saved-cursor)
- (make-local-variable 'term-last-input-start)
- (setq term-last-input-start (make-marker))
- (make-local-variable 'term-last-input-end)
- (setq term-last-input-end (make-marker))
- (make-local-variable 'term-last-input-match)
- (setq term-last-input-match "")
- (make-local-variable 'term-prompt-regexp) ; Don't set; default
- (make-local-variable 'term-input-ring-size) ; ...to global val.
- (make-local-variable 'term-input-ring)
- (make-local-variable 'term-input-ring-file-name)
- (or (and (boundp 'term-input-ring) term-input-ring)
- (setq term-input-ring (make-ring term-input-ring-size)))
- (make-local-variable 'term-input-ring-index)
- (or (and (boundp 'term-input-ring-index) term-input-ring-index)
- (setq term-input-ring-index nil))
-
- (make-local-variable 'term-command-hook)
- (setq term-command-hook (symbol-function 'term-command-hook))
-
-;;; I'm not sure these saves are necessary but, since I
-;;; haven't tested the whole thing on a net connected machine with
-;;; a properly configured ange-ftp, I've decided to be conservative
-;;; and put them in. -mm
-
- (make-local-variable 'term-ansi-at-host)
- (setq term-ansi-at-host (system-name))
-
- (make-local-variable 'term-ansi-at-dir)
- (setq term-ansi-at-dir default-directory)
-
- (make-local-variable 'term-ansi-at-message)
- (setq term-ansi-at-message nil)
-
-;;; For user tracking purposes -mm
- (make-local-variable 'ange-ftp-default-user)
- (make-local-variable 'ange-ftp-default-password)
- (make-local-variable 'ange-ftp-generate-anonymous-password)
-
-;;; You may want to have different scroll-back sizes -mm
- (make-local-variable 'term-buffer-maximum-size)
-
-;;; Of course these have to be buffer-local -mm
- (make-local-variable 'term-ansi-current-bold)
- (make-local-variable 'term-ansi-current-color)
- (make-local-variable 'term-ansi-face-alredy-done)
- (make-local-variable 'term-ansi-current-bg-color)
- (make-local-variable 'term-ansi-current-underline)
- (make-local-variable 'term-ansi-current-highlight)
- (make-local-variable 'term-ansi-current-reverse)
- (make-local-variable 'term-ansi-current-invisible)
-
- (make-local-variable 'term-terminal-state)
- (make-local-variable 'term-kill-echo-list)
- (make-local-variable 'term-start-line-column)
- (make-local-variable 'term-current-column)
- (make-local-variable 'term-current-row)
- (make-local-variable 'term-log-buffer)
- (make-local-variable 'term-scroll-start)
- (make-local-variable 'term-scroll-end)
- (setq term-scroll-end term-height)
- (make-local-variable 'term-scroll-with-delete)
- (make-local-variable 'term-pager-count)
- (make-local-variable 'term-pager-old-local-map)
- (make-local-variable 'term-old-mode-map)
- (make-local-variable 'term-insert-mode)
- (make-local-variable 'term-dynamic-complete-functions)
- (make-local-variable 'term-completion-fignore)
- (make-local-variable 'term-get-old-input)
- (make-local-variable 'term-matching-input-from-input-string)
- (make-local-variable 'term-input-autoexpand)
- (make-local-variable 'term-input-ignoredups)
- (make-local-variable 'term-delimiter-argument-list)
- (make-local-variable 'term-input-filter-functions)
- (make-local-variable 'term-input-filter)
- (make-local-variable 'term-input-sender)
- (make-local-variable 'term-eol-on-send)
- (make-local-variable 'term-scroll-to-bottom-on-output)
- (make-local-variable 'term-scroll-show-maximum-output)
- (make-local-variable 'term-ptyp)
- (make-local-variable 'term-exec-hook)
- (make-local-variable 'term-vertical-motion)
- (make-local-variable 'term-pending-delete-marker)
- (setq term-pending-delete-marker (make-marker))
- (make-local-variable 'term-current-face)
- (make-local-variable 'term-pending-frame)
- (setq term-pending-frame nil)
- (run-hooks 'term-mode-hook)
- (term-if-xemacs
- (set-buffer-menubar
- (append current-menubar (list term-terminal-menu))))
- (or term-input-ring
- (setq term-input-ring (make-ring term-input-ring-size)))
- (term-update-mode-line))
-
(if term-mode-map
nil
(setq term-mode-map (make-sparse-keymap))
(define-key term-mode-map "\C-c\C-j" 'term-line-mode)
(define-key term-mode-map "\C-c\C-q" 'term-pager-toggle)
-
; ;; completion:
; (define-key term-mode-map [menu-bar completion]
; (cons "Complete" (make-sparse-keymap "Complete")))
(define-key term-mode-map [menu-bar signals]
(setq term-signals-menu (cons "Signals" newmap)))
)))
- (dolist (elm (generic-character-list))
- (define-key map (vector elm) 'term-send-raw))
+\f
+;; Set up term-raw-map, etc.
+
+(defun term-set-escape-char (c)
+ "Change term-escape-char and keymaps that depend on it."
+ (if term-escape-char
+ (define-key term-raw-map term-escape-char 'term-send-raw))
+ (setq c (make-string 1 c))
+ (define-key term-raw-map c term-raw-escape-map)
+ ;; Define standard bindings in term-raw-escape-map
+ (define-key term-raw-escape-map "\C-v"
+ (lookup-key (current-global-map) "\C-v"))
+ (define-key term-raw-escape-map "\C-u"
+ (lookup-key (current-global-map) "\C-u"))
+ (define-key term-raw-escape-map c 'term-send-raw)
+ (define-key term-raw-escape-map "\C-q" 'term-pager-toggle)
+ ;; The keybinding for term-char-mode is needed by the menubar code.
+ (define-key term-raw-escape-map "\C-k" 'term-char-mode)
+ (define-key term-raw-escape-map "\C-j" 'term-line-mode)
+ ;; It's convenient to have execute-extended-command here.
+ (define-key term-raw-escape-map [?\M-x] 'execute-extended-command))
+
+(let* ((map (make-keymap))
+ (esc-map (make-keymap))
+ (i 0))
+ (while (< i 128)
+ (define-key map (make-string 1 i) 'term-send-raw)
+ (define-key esc-map (make-string 1 i) 'term-send-raw-meta)
+ (setq i (1+ i)))
+ (define-key map "\e" esc-map)
+ (setq term-raw-map map)
+ (setq term-raw-escape-map
+ (copy-keymap (lookup-key (current-global-map) "\C-x")))
+
+;;; Added nearly all the 'grey keys' -mm
+
+ (progn
+ (term-if-xemacs
+ (define-key term-raw-map [button2] 'term-mouse-paste))
+ (term-ifnot-xemacs
+ (define-key term-raw-map [mouse-2] 'term-mouse-paste)
+ (define-key term-raw-map [menu-bar terminal] term-terminal-menu)
+ (define-key term-raw-map [menu-bar signals] term-signals-menu))
+ (define-key term-raw-map [up] 'term-send-up)
+ (define-key term-raw-map [down] 'term-send-down)
+ (define-key term-raw-map [right] 'term-send-right)
+ (define-key term-raw-map [left] 'term-send-left)
+ (define-key term-raw-map [delete] 'term-send-del)
+ (define-key term-raw-map [backspace] 'term-send-backspace)
+ (define-key term-raw-map [home] 'term-send-home)
+ (define-key term-raw-map [end] 'term-send-end)
+ (define-key term-raw-map [prior] 'term-send-prior)
+ (define-key term-raw-map [next] 'term-send-next)))
+
+(term-set-escape-char ?\C-c)
+\f
+(put 'term-mode 'mode-class 'special)
+
+(defun term-mode ()
+ "Major mode for interacting with an inferior interpreter.
+The interpreter name is same as buffer name, sans the asterisks.
+
+There are two submodes: line mode and char mode. By default, you are
+in char mode. In char sub-mode, each character (except
+`term-escape-char') is set immediately.
+In line mode, you send a line of input at a time; use
+\\[term-send-input] to send.
+
+In line mode, this maintains an input history of size
+`term-input-ring-size', and you can access it with the commands
+\\[term-next-input], \\[term-previous-input], and
+\\[term-dynamic-list-input-ring]. Input ring history expansion can be
+achieved with the commands \\[term-replace-by-expanded-history] or
+\\[term-magic-space]. Input ring expansion is controlled by the
+variable `term-input-autoexpand', and addition is controlled by the
+variable `term-input-ignoredups'.
+
+Input to, and output from, the subprocess can cause the window to scroll to
+the end of the buffer. See variables `term-scroll-to-bottom-on-input',
+and `term-scroll-to-bottom-on-output'.
+
+If you accidentally suspend your process, use \\[term-continue-subjob]
+to continue it.
+
+This mode can be customised to create specific modes for running
+particular subprocesses. This can be done by setting the hooks
+`term-input-filter-functions', `term-input-filter',
+`term-input-sender' and `term-get-old-input' to appropriate functions,
+and the variable `term-prompt-regexp' to the appropriate regular
+expression.
+
+Commands in raw mode:
+
+\\{term-raw-map}
+
+Commands in line mode:
+
+\\{term-mode-map}
+
+Entry to this mode runs the hooks on `term-mode-hook'."
+ (interactive)
+ ;; Do not remove this. All major modes must do this.
+ (kill-all-local-variables)
+ (setq major-mode 'term-mode)
+ (setq mode-name "Term")
+ (use-local-map term-mode-map)
+ (make-local-variable 'term-home-marker)
+ (setq term-home-marker (copy-marker 0))
+ (make-local-variable 'term-saved-home-marker)
+ (make-local-variable 'term-height)
+ (make-local-variable 'term-width)
+ (setq term-width (1- (window-width)))
+ (setq term-height (1- (window-height)))
+ (make-local-variable 'term-terminal-parameter)
+ (make-local-variable 'term-saved-cursor)
+ (make-local-variable 'term-last-input-start)
+ (setq term-last-input-start (make-marker))
+ (make-local-variable 'term-last-input-end)
+ (setq term-last-input-end (make-marker))
+ (make-local-variable 'term-last-input-match)
+ (setq term-last-input-match "")
+ (make-local-variable 'term-prompt-regexp) ; Don't set; default
+ (make-local-variable 'term-input-ring-size) ; ...to global val.
+ (make-local-variable 'term-input-ring)
+ (make-local-variable 'term-input-ring-file-name)
+ (or (and (boundp 'term-input-ring) term-input-ring)
+ (setq term-input-ring (make-ring term-input-ring-size)))
+ (make-local-variable 'term-input-ring-index)
+ (or (and (boundp 'term-input-ring-index) term-input-ring-index)
+ (setq term-input-ring-index nil))
+
+ (make-local-variable 'term-command-hook)
+ (setq term-command-hook (symbol-function 'term-command-hook))
+
+;;; I'm not sure these saves are necessary but, since I
+;;; haven't tested the whole thing on a net connected machine with
+;;; a properly configured ange-ftp, I've decided to be conservative
+;;; and put them in. -mm
+
+ (make-local-variable 'term-ansi-at-host)
+ (setq term-ansi-at-host (system-name))
+
+ (make-local-variable 'term-ansi-at-dir)
+ (setq term-ansi-at-dir default-directory)
+
+ (make-local-variable 'term-ansi-at-message)
+ (setq term-ansi-at-message nil)
+
+;;; For user tracking purposes -mm
+ (make-local-variable 'ange-ftp-default-user)
+ (make-local-variable 'ange-ftp-default-password)
+ (make-local-variable 'ange-ftp-generate-anonymous-password)
+
+;;; You may want to have different scroll-back sizes -mm
+ (make-local-variable 'term-buffer-maximum-size)
+
+;;; Of course these have to be buffer-local -mm
+ (make-local-variable 'term-ansi-current-bold)
+ (make-local-variable 'term-ansi-current-color)
+ (make-local-variable 'term-ansi-face-already-done)
+ (make-local-variable 'term-ansi-current-bg-color)
+ (make-local-variable 'term-ansi-current-underline)
+ (make-local-variable 'term-ansi-current-highlight)
+ (make-local-variable 'term-ansi-current-reverse)
+ (make-local-variable 'term-ansi-current-invisible)
+
+ (make-local-variable 'term-terminal-state)
+ (make-local-variable 'term-kill-echo-list)
+ (make-local-variable 'term-start-line-column)
+ (make-local-variable 'term-current-column)
+ (make-local-variable 'term-current-row)
+ (make-local-variable 'term-log-buffer)
+ (make-local-variable 'term-scroll-start)
+ (make-local-variable 'term-scroll-end)
+ (setq term-scroll-end term-height)
+ (make-local-variable 'term-scroll-with-delete)
+ (make-local-variable 'term-pager-count)
+ (make-local-variable 'term-pager-old-local-map)
+ (make-local-variable 'term-old-mode-map)
+ (make-local-variable 'term-insert-mode)
+ (make-local-variable 'term-dynamic-complete-functions)
+ (make-local-variable 'term-completion-fignore)
+ (make-local-variable 'term-get-old-input)
+ (make-local-variable 'term-matching-input-from-input-string)
+ (make-local-variable 'term-input-autoexpand)
+ (make-local-variable 'term-input-ignoredups)
+ (make-local-variable 'term-delimiter-argument-list)
+ (make-local-variable 'term-input-filter-functions)
+ (make-local-variable 'term-input-filter)
+ (make-local-variable 'term-input-sender)
+ (make-local-variable 'term-eol-on-send)
+ (make-local-variable 'term-scroll-to-bottom-on-output)
+ (make-local-variable 'term-scroll-show-maximum-output)
+ (make-local-variable 'term-ptyp)
+ (make-local-variable 'term-exec-hook)
+ (make-local-variable 'term-vertical-motion)
+ (make-local-variable 'term-pending-delete-marker)
+ (setq term-pending-delete-marker (make-marker))
+ (make-local-variable 'term-current-face)
+ (make-local-variable 'term-pending-frame)
+ (setq term-pending-frame nil)
+ (run-hooks 'term-mode-hook)
+ (term-if-xemacs
+ (set-buffer-menubar
+ (append current-menubar (list term-terminal-menu))))
+ (or term-input-ring
+ (setq term-input-ring (make-ring term-input-ring-size)))
+ (term-update-mode-line))
+\f
(defun term-reset-size (height width)
(setq term-height height)
(setq term-width width)
(defun term-send-next () (interactive) (term-send-raw-string "\e[6~"))
(defun term-send-del () (interactive) (term-send-raw-string "\C-?"))
(defun term-send-backspace () (interactive) (term-send-raw-string "\C-H"))
-
-(defun term-set-escape-char (c)
- "Change term-escape-char and keymaps that depend on it."
- (if term-escape-char
- (define-key term-raw-map term-escape-char 'term-send-raw))
- (setq c (make-string 1 c))
- (define-key term-raw-map c term-raw-escape-map)
- ;; Define standard bindings in term-raw-escape-map
- (define-key term-raw-escape-map "\C-x"
- (lookup-key (current-global-map) "\C-x"))
- (define-key term-raw-escape-map "\C-v"
- (lookup-key (current-global-map) "\C-v"))
- (define-key term-raw-escape-map "\C-u"
- (lookup-key (current-global-map) "\C-u"))
- (define-key term-raw-escape-map c 'term-send-raw)
- (define-key term-raw-escape-map "\C-q" 'term-pager-toggle)
- ;; The keybinding for term-char-mode is needed by the menubar code.
- (define-key term-raw-escape-map "\C-k" 'term-char-mode)
- (define-key term-raw-escape-map "\C-j" 'term-line-mode)
- ;; It's convenient to have execute-extended-command here.
- (define-key term-raw-escape-map [?\M-x] 'execute-extended-command))
-
+\f
(defun term-char-mode ()
"Switch to char (\"raw\") sub-mode of term mode.
Each character you type is sent directly to the inferior without
intervention from Emacs, except for the escape character (usually C-c)."
(interactive)
- (if (not term-raw-map)
- (let* ((map (make-keymap))
- (esc-map (make-keymap))
- (i 0))
- (while (< i 128)
- (define-key map (make-string 1 i) 'term-send-raw)
- (define-key esc-map (make-string 1 i) 'term-send-raw-meta)
- (setq i (1+ i)))
- (define-key map "\e" esc-map)
- (setq term-raw-map map)
- (setq term-raw-escape-map
- (copy-keymap (lookup-key (current-global-map) "\C-x")))
-
-;;; Added nearly all the 'grey keys' -mm
-
- (progn
- (term-if-xemacs
- (define-key term-raw-map [button2] 'term-mouse-paste))
- (term-ifnot-xemacs
- (define-key term-raw-map [mouse-2] 'term-mouse-paste)
- (define-key term-raw-map [menu-bar terminal] term-terminal-menu)
- (define-key term-raw-map [menu-bar signals] term-signals-menu))
- (define-key term-raw-map [up] 'term-send-up)
- (define-key term-raw-map [down] 'term-send-down)
- (define-key term-raw-map [right] 'term-send-right)
- (define-key term-raw-map [left] 'term-send-left)
- (define-key term-raw-map [delete] 'term-send-del)
- (define-key term-raw-map [backspace] 'term-send-backspace)
- (define-key term-raw-map [home] 'term-send-home)
- (define-key term-raw-map [end] 'term-send-end)
- (define-key term-raw-map [prior] 'term-send-prior)
- (define-key term-raw-map [next] 'term-send-next))
-
-
- (term-set-escape-char ?\C-c)))
;; FIXME: Emit message? Cfr ilisp-raw-message
(if (term-in-line-mode)
(progn
;;;###autoload
(defun term (program)
- "Start a terminal-emulator in a new buffer."
+ "Start a terminal-emulator in a new buffer.
+The buffer is in Term mode; see `term-mode' for the
+commands to use in that buffer.
+
+\\<term-raw-map>Type \\[switch-to-buffer] to switch to another buffer."
(interactive (list (read-from-minibuffer "Run program: "
(or explicit-shell-file-name
(getenv "ESHELL")
(term-move-columns columns)
(delete-region pos (point))))
(setq term-current-column nil)
-
+
(put-text-property old-point (point)
'face term-current-face)
;; If the last char was written in last column,
((eq char ?\032)
(let ((end (string-match "\r?$" str i)))
(if end
- (progn (funcall term-command-hook
- (substring str (1+ i) end))
- (setq i (match-end 0)))
+ (funcall term-command-hook
+ (prog1 (substring str (1+ i) end)
+ (setq i (match-end 0))))
(setq term-terminal-parameter
(substring str i))
(setq term-terminal-state 4)
;;; 0 (Reset) or unknown (reset anyway)
(t
- (setq term-current-face
- (list 'term-default-fg 'term-default-bg))
+ (setq term-current-face nil)
(setq term-ansi-current-underline 0)
(setq term-ansi-current-bold 0)
(setq term-ansi-current-reverse 0)
(setq term-ansi-current-color 0)
(setq term-ansi-current-invisible 0)
- (setq term-ansi-face-alredy-done 1)
+ (setq term-ansi-face-already-done 1)
(setq term-ansi-current-bg-color 0)))
; (message "Debug: U-%d R-%d B-%d I-%d D-%d F-%d B-%d"
; term-ansi-current-reverse
; term-ansi-current-bold
; term-ansi-current-invisible
-; term-ansi-face-alredy-done
+; term-ansi-face-already-done
; term-ansi-current-color
; term-ansi-current-bg-color)
- (if (= term-ansi-face-alredy-done 0)
+ (if (= term-ansi-face-already-done 0)
(if (= term-ansi-current-reverse 1)
- (progn
- (if (= term-ansi-current-invisible 1)
- (if (= term-ansi-current-color 0)
- (setq term-current-face
- '(term-default-bg-inv term-default-fg))
- (setq term-current-face
- (list (elt ansi-term-inv-fg-faces-vector term-ansi-current-color)
- (elt ansi-term-inv-bg-faces-vector term-ansi-current-color))))
- ;; No need to bother with anything else if it's invisible
- (progn
+ (if (= term-ansi-current-invisible 1)
+ (setq term-current-face
+ (if (= term-ansi-current-color 0)
+ (list :background
+ term-default-fg-color
+ :foreground
+ term-default-fg-color)
+ (list :background
+ (elt ansi-term-color-vector term-ansi-current-color)
+ :foreground
+ (elt ansi-term-color-vector term-ansi-current-color)))
+ ;; No need to bother with anything else if it's invisible
+ )
+ (setq term-current-face
+ (list :background
+ (elt ansi-term-color-vector term-ansi-current-color)
+ :foreground
+ (elt ansi-term-color-vector term-ansi-current-bg-color)))
+ (if (= term-ansi-current-bold 1)
(setq term-current-face
- (list (elt ansi-term-inv-fg-faces-vector term-ansi-current-color)
- (elt ansi-term-inv-bg-faces-vector term-ansi-current-bg-color)))
- (if (= term-ansi-current-bold 1)
- (setq term-current-face
- (append '(term-bold) term-current-face)))
- (if (= term-ansi-current-underline 1)
- (setq term-current-face
- (append '(term-underline) term-current-face))))))
- (if (= term-ansi-current-invisible 1)
- (if (= term-ansi-current-bg-color 0)
+ (append '(:weight bold) term-current-face)))
+ (if (= term-ansi-current-underline 1)
(setq term-current-face
- '(term-default-fg-inv term-default-bg))
- (setq term-current-face
- (list (elt ansi-term-fg-faces-vector term-ansi-current-bg-color)
- (elt ansi-term-bg-faces-vector term-ansi-current-bg-color))))
- ;; No need to bother with anything else if it's invisible
+ (append '(:underline t) term-current-face))))
+ (if (= term-ansi-current-invisible 1)
+ (setq term-current-face
+ (if (= term-ansi-current-bg-color 0)
+ (list :background
+ term-default-bg-color
+ :foreground
+ term-default-bg-color)
+ (list :foreground
+ (elt ansi-term-color-vector term-ansi-current-bg-color)
+ :background
+ (elt ansi-term-color-vector term-ansi-current-bg-color)))
+ ;; No need to bother with anything else if it's invisible
+ )
(setq term-current-face
- (list (elt ansi-term-fg-faces-vector term-ansi-current-color)
- (elt ansi-term-bg-faces-vector term-ansi-current-bg-color)))
+ (list :foreground
+ (elt ansi-term-color-vector term-ansi-current-color)
+ :background
+ (elt ansi-term-color-vector term-ansi-current-bg-color)))
(if (= term-ansi-current-bold 1)
(setq term-current-face
- (append '(term-bold) term-current-face)))
+ (append '(:weight bold) term-current-face)))
(if (= term-ansi-current-underline 1)
(setq term-current-face
- (append '(term-underline) term-current-face))))))
+ (append '(:underline t) term-current-face))))))
; (message "Debug %S" term-current-face)
- (setq term-ansi-face-alredy-done 0))
+ (setq term-ansi-face-already-done 0))
;;; Handle a character assuming (eq terminal-state 2) -
;; Default value for the symbol term-command-hook.
(defun term-command-hook (string)
- (cond ((= (aref string 0) ?\032)
+ (cond ((equal string "")
+ t)
+ ((= (aref string 0) ?\032)
;; gdb (when invoked with -fullname) prints:
;; \032\032FULLFILENAME:LINENUMBER:CHARPOS:BEG_OR_MIDDLE:PC\n
(let* ((first-colon (string-match ":" string 1))
(t (car term-completion-addsuffix))))
(filesuffix (cond ((not term-completion-addsuffix) "")
((not (consp term-completion-addsuffix)) " ")
- (t (cdr term-completion-addsuffix))))
+ (t (cdr term-completion-addsuffix))))
(filename (or (term-match-partial-filename) ""))
(pathdir (file-name-directory filename))
(pathnondir (file-name-nondirectory filename))
;;; mac-win.el --- support for "Macintosh windows"
-;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2002, 2003 Free Software Foundation, Inc.
-;; Author: Andrew Choi <akochoi@i-cable.com>
+;; Author: Andrew Choi <akochoi@mac.com>
;; This file is part of GNU Emacs.
;; Don't have this yet.
(fset 'x-get-resource 'ignore)
-;; This variable specifies the Unix program to call (as a process) to
-;; deteremine the amount of free space on a file system (defaults to
-;; df). If it is not set to nil, ls-lisp will not work correctly
-;; unless an external application df is implemented on the Mac.
-(require 'dired)
+(unless (eq system-type 'darwin)
+ ;; This variable specifies the Unix program to call (as a process) to
+ ;; deteremine the amount of free space on a file system (defaults to
+ ;; df). If it is not set to nil, ls-lisp will not work correctly
+ ;; unless an external application df is implemented on the Mac.
+ (setq directory-free-space-program nil)
-(setq dired-free-space-program nil)
-
-;; Set this so that Emacs calls subprocesses with "sh" as shell to
-;; expand filenames Note no subprocess for the shell is actually
-;; started (see run_mac_command in sysdep.c).
-(setq shell-file-name "sh")
+ ;; Set this so that Emacs calls subprocesses with "sh" as shell to
+ ;; expand filenames Note no subprocess for the shell is actually
+ ;; started (see run_mac_command in sysdep.c).
+ (setq shell-file-name "sh"))
;; X Window emulation in macterm.c is not complete enough to start a
;; frame without a minibuffer properly. Call this to tell ediff
;; library to use a single frame.
-(ediff-toggle-multiframe)
+; (ediff-toggle-multiframe)
;; Setup to use the Mac clipboard. The functions mac-cut-function and
;; mac-paste-function are defined in mac.c.
(set-selection-coding-system 'compound-text-mac)
-(setq interprogram-cut-function
- '(lambda (str push)
+(setq interprogram-cut-function
+ '(lambda (str push)
(mac-cut-function
- (encode-coding-string str selection-coding-system t) push)))
+ (encode-coding-string str selection-coding-system t) push)))
-(setq interprogram-paste-function
- '(lambda ()
- (decode-coding-string
- (mac-paste-function) selection-coding-system t)))
+(setq interprogram-paste-function
+ '(lambda ()
+ (let ((clipboard (mac-paste-function)))
+ (if clipboard
+ (decode-coding-string clipboard selection-coding-system t)))))
(defun mac-drag-n-drop (event)
"Edit the files listed in the drag-n-drop event.\n\
(defconst kTextEncodingISOLatin2 514 "0x202")
- (define-ccl-program ccl-encode-mac-roman-font
- `(0
- (if (r0 != ,(charset-id 'ascii))
- (if (r0 == ,(charset-id 'latin-iso8859-1))
- (translate-character mac-roman-encoder r0 r1)
- ((r1 <<= 7)
- (r1 |= r2)
- (translate-character mac-roman-encoder r0 r1)))))
- "CCL program for Mac Roman font")
-
- (setq font-ccl-encoder-alist
- (cons '("mac-roman" . ccl-encode-mac-roman-font)
- font-ccl-encoder-alist))
-
;; 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.
(if (fboundp 'new-fontset)
- (progn
- (require 'fontset)
- (setup-default-fontset)
- (create-fontset-from-fontset-spec
- "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac,
- ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
- (let ((monaco-font '("monaco" . "mac-roman")))
- (map-char-table
- (function
- (lambda (key val)
- (or (generic-char-p key)
- (memq (char-charset val)
- '(ascii eight-bit-control eight-bit-graphic))
- (set-fontset-font "fontset-mac" val monaco-font))))
- (get 'mac-roman-decoder 'translation-table)))))
+ (create-fontset-from-fontset-spec
+ "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-mac,
+ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman
+ mac-roman:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman"))
+
-;; To display filenames in Chinese or Japanese, replace mac-roman with
-;; big5 or sjis
-(setq file-name-coding-system 'mac-roman)
+
+(if (eq system-type 'darwin)
+ ;; On Darwin filenames are encoded in UTF-8
+ (setq file-name-coding-system 'utf-8)
+ ;; To display filenames in Chinese or Japanese, replace mac-roman with
+ ;; big5 or sjis
+ (setq file-name-coding-system 'mac-roman))
+
+;; If Emacs is started from the Finder, change the default directory
+;; to the user's home directory.
+(if (string= default-directory "/")
+ (cd "~"))
+
+;; Tell Emacs to use pipes instead of pty's for processes because the
+;; latter sometimes lose characters. Pty support is compiled in since
+;; ange-ftp will not work without it.
+(setq process-connection-type nil)
+
+;; Assume that fonts are always scalable on the Mac. This sometimes
+;; results in characters with jagged edges. However, without it,
+;; fonts with both truetype and bitmap representations but no italic
+;; or bold bitmap versions will not display these variants correctly.
+(setq scalable-fonts-allowed t)
+
+;; Make suspend-emacs [C-z] collapse the current frame
+(substitute-key-definition 'suspend-emacs 'iconify-frame
+ global-map)
+
+;; Support mouse-wheel scrolling
+(mouse-wheel-mode 1)
;; (prefer-coding-system 'mac-roman)
+;; Map certain keypad keys into ASCII characters that people usually expect
+(define-key function-key-map [return] [?\C-m])
+(define-key function-key-map [M-return] [?\M-\C-m])
+(define-key function-key-map [tab] [?\t])
+(define-key function-key-map [M-tab] [?\M-\t])
+(define-key function-key-map [backspace] [127])
+(define-key function-key-map [M-backspace] [?\M-\d])
+(define-key function-key-map [escape] [?\e])
+(define-key function-key-map [M-escape] [?\M-\e])
+
+;; Tell read-char how to convert special chars to ASCII
+(put 'return 'ascii-character 13)
+
;;
;; Available colors
;;
-;;; x-win.el --- parse relevant switches and set up for X -*-coding: utf-8-emacs;-*-
+;;; x-win.el --- parse relevant switches and set up for X -*-coding: iso-2022-7bit;-*-
;; Copyright (C) 1993, 1994, 2001, 2002 Free Software Foundation, Inc.
(if (not (eq window-system 'x))
(error "%s: Loading x-win.el but not compiled for X" (invocation-name)))
-
+
(require 'frame)
(require 'mouse)
(require 'scroll-bar)
(funcall handler this-switch))
(setq args (cons orig-this-switch args)))))
(nconc (nreverse args) x-invocation-args))
+
+;; Handle the --smid switch. This is used by the session manager
+;; to give us back our session id we had on the previous run.
+(defun x-handle-smid (switch)
+ (or (consp x-invocation-args)
+ (error "%s: missing argument to `%s' option" (invocation-name) switch))
+ (setq x-session-previous-id (car x-invocation-args)
+ x-invocation-args (cdr x-invocation-args)))
+
+(defvar emacs-save-session-functions nil
+ "Special hook run when a save-session event occurs.
+The functions do not get any argument.
+Functions can return non-nil to inform the session manager that the
+window system shutdown should be aborted.
+
+See also `emacs-session-save'.")
+
+(defun emacs-session-filename (session-id)
+ "Construct a filename to save the session in based on SESSION-ID.
+If the directory ~/.emacs.d exists, we make a filename in there, otherwise
+a file in the home directory."
+ (let ((basename (concat "session." session-id))
+ (emacs-dir "~/.emacs.d/"))
+ (expand-file-name (if (file-directory-p emacs-dir)
+ (concat emacs-dir basename)
+ (concat "~/.emacs-" basename)))))
+
+(defun emacs-session-save ()
+ "This function is called when the window system is shutting down.
+If this function returns non-nil, the window system shutdown is cancelled.
+
+When a session manager tells Emacs that the window system is shutting
+down, this function is called. It calls the functions in the hook
+`emacs-save-session-functions'. Functions are called with the current
+buffer set to a temporary buffer. Functions should use `insert' to insert
+lisp code to save the session state. The buffer is saved
+in a file in the home directory of the user running Emacs. The file
+is evaluated when Emacs is restarted by the session manager.
+
+If any of the functions returns non-nil, no more functions are called
+and this function returns non-nil. This will inform the session manager
+that it should abort the window system shutdown."
+ (let ((filename (emacs-session-filename x-session-id))
+ (buf (get-buffer-create (concat " *SES " x-session-id))))
+ (when (file-exists-p filename)
+ (delete-file filename))
+ (with-current-buffer buf
+ (let ((cancel-shutdown (condition-case nil
+ ;; A return of t means cancel the shutdown.
+ (run-hook-with-args-until-success
+ 'emacs-save-session-functions)
+ (error t))))
+ (unless cancel-shutdown
+ (write-file filename))
+ (kill-buffer buf)
+ cancel-shutdown))))
+
+(defun emacs-session-restore (previous-session-id)
+ "Restore the Emacs session if started by a session manager.
+The file saved by `emacs-session-save' is evaluated and deleted if it
+exists."
+ (let ((filename (emacs-session-filename previous-session-id)))
+ (when (file-exists-p filename)
+ (load-file filename)
+ (delete-file filename)
+ (message "Restored session data"))))
+
+
+
\f
;;
;; Standard X cursor shapes, courtesy of Mr. Fox, who wanted ALL of them.
\f
;;;; Function keys
-(defun iconify-or-deiconify-frame ()
- "Iconify the selected frame, or deiconify if it's currently an icon."
- (interactive)
- (if (eq (cdr (assq 'visibility (frame-parameters))) t)
- (iconify-frame)
- (make-frame-visible)))
-
(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
global-map)
(define-key function-key-map [M-return] [?\M-\C-m])
(define-key function-key-map [M-escape] [?\M-\e])
(define-key function-key-map [iso-lefttab] [backtab])
+(define-key function-key-map [S-iso-lefttab] [backtab])
;; These tell read-char how to convert
;; these special chars to ASCII.
;;;; Keysyms
(defun vendor-specific-keysyms (vendor)
- "Return the appropriate value of system-key-alist for VENDOR.
+ "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)."
+as returned by `x-server-vendor'."
+ ;; Fixme: Drop Apollo now?
(cond ((string-equal vendor "Apollo Computer Inc.")
'((65280 . linedel)
(65281 . chardel)
(65395 . deletechar)
(65396 . backtab)
(65397 . kp-backtab)))
+ ;; Fixme: What about non-X11/NeWS sun server?
((or (string-equal vendor "X11/NeWS - Sun Microsystems Inc.")
(string-equal vendor "X Consortium"))
'((392976 . f36)
;; 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'
;; appendix to the X protocol definition.
(dolist
(pair
- '((#x1a1 . ?Ä„)
- (#x1a2 . ?˘)
- (#x1a3 . ?Å)
- (#x1a5 . ?Ľ)
- (#x1a6 . ?Åš)
- (#x1a9 . ?Å )
- (#x1aa . ?Åž)
- (#x1ab . ?Ť)
- (#x1ac . ?Ź)
- (#x1ae . ?Ž)
- (#x1af . ?Å»)
- (#x1b1 . ?Ä…)
- (#x1b2 . ?Ë›)
- (#x1b3 . ?Å‚)
- (#x1b5 . ?ľ)
- (#x1b6 . ?Å›)
- (#x1b7 . ?ˇ)
- (#x1b9 . ?Å¡)
- (#x1ba . ?ÅŸ)
- (#x1bb . ?Å¥)
- (#x1bc . ?ź)
- (#x1bd . ?Ë)
- (#x1be . ?ž)
- (#x1bf . ?ż)
- (#x1c0 . ?Å”)
- (#x1c3 . ?Ä‚)
- (#x1c5 . ?Ĺ)
- (#x1c6 . ?Ć)
- (#x1c8 . ?Č)
- (#x1ca . ?Ę)
- (#x1cc . ?Äš)
- (#x1cf . ?ÄŽ)
- (#x1d0 . ?Ä)
- (#x1d1 . ?Ń)
- (#x1d2 . ?Ň)
- (#x1d5 . ?Å)
- (#x1d8 . ?Ř)
- (#x1d9 . ?Å®)
- (#x1db . ?Å°)
- (#x1de . ?Å¢)
- (#x1e0 . ?Å•)
- (#x1e3 . ?ă)
- (#x1e5 . ?ĺ)
- (#x1e6 . ?ć)
- (#x1e8 . ?Ä)
- (#x1ea . ?Ä™)
- (#x1ec . ?Ä›)
- (#x1ef . ?Ä)
- (#x1f0 . ?Ä‘)
- (#x1f1 . ?Å„)
- (#x1f2 . ?ň)
- (#x1f5 . ?Å‘)
- (#x1f8 . ?Å™)
- (#x1f9 . ?ů)
- (#x1fb . ?ű)
- (#x1fe . ?Å£)
- (#x1ff . ?Ë™)
- (#x2a1 . ?Ħ)
- (#x2a6 . ?Ĥ)
- (#x2a9 . ?Ä°)
- (#x2ab . ?Äž)
- (#x2ac . ?Ä´)
- (#x2b1 . ?ħ)
- (#x2b6 . ?Ä¥)
- (#x2b9 . ?ı)
- (#x2bb . ?ÄŸ)
- (#x2bc . ?ĵ)
- (#x2c5 . ?ÄŠ)
- (#x2c6 . ?Ĉ)
- (#x2d5 . ?Ä )
- (#x2d8 . ?Ĝ)
- (#x2dd . ?Ŭ)
- (#x2de . ?Ŝ)
- (#x2e5 . ?Ä‹)
- (#x2e6 . ?ĉ)
- (#x2f5 . ?Ä¡)
- (#x2f8 . ?Ä)
- (#x2fd . ?Å)
- (#x2fe . ?Å)
- (#x3a2 . ?ĸ)
- (#x3a3 . ?Å–)
- (#x3a5 . ?Ĩ)
- (#x3a6 . ?Ä»)
- (#x3aa . ?Ä’)
- (#x3ab . ?Ä¢)
- (#x3ac . ?Ŧ)
- (#x3b3 . ?Å—)
- (#x3b5 . ?Ä©)
- (#x3b6 . ?ļ)
- (#x3ba . ?Ä“)
- (#x3bb . ?Ä£)
- (#x3bc . ?ŧ)
- (#x3bd . ?ÅŠ)
- (#x3bf . ?Å‹)
- (#x3c0 . ?Ä€)
- (#x3c7 . ?Ä®)
- (#x3cc . ?Ä–)
- (#x3cf . ?Ī)
- (#x3d1 . ?Å…)
- (#x3d2 . ?Ō)
- (#x3d3 . ?Ķ)
- (#x3d9 . ?Ų)
- (#x3dd . ?Ũ)
- (#x3de . ?Ū)
- (#x3e0 . ?Ä)
- (#x3e7 . ?į)
- (#x3ec . ?Ä—)
- (#x3ef . ?Ä«)
- (#x3f1 . ?ņ)
- (#x3f2 . ?Å)
- (#x3f3 . ?Ä·)
- (#x3f9 . ?ų)
- (#x3fd . ?Å©)
- (#x3fe . ?Å«)
- (#x47e . ?‾)
- (#x4a1 . ?。)
- (#x4a2 . ?\「)
- (#x4a3 . ?\ã€)
- (#x4a4 . ?ã€)
- (#x4a5 . ?・)
- (#x4a6 . ?ヲ)
- (#x4a7 . ?ã‚¡)
- (#x4a8 . ?ã‚£)
- (#x4a9 . ?ã‚¥)
- (#x4aa . ?ェ)
- (#x4ab . ?ã‚©)
- (#x4ac . ?ャ)
- (#x4ad . ?ュ)
- (#x4ae . ?ョ)
- (#x4af . ?ッ)
- (#x4b0 . ?ー)
- (#x4b1 . ?ã‚¢)
- (#x4b2 . ?イ)
- (#x4b3 . ?ウ)
- (#x4b4 . ?エ)
- (#x4b5 . ?オ)
- (#x4b6 . ?ã‚«)
- (#x4b7 . ?ã‚)
- (#x4b8 . ?ク)
- (#x4b9 . ?ケ)
- (#x4ba . ?コ)
- (#x4bb . ?サ)
- (#x4bc . ?ã‚·)
- (#x4bd . ?ス)
- (#x4be . ?ã‚»)
- (#x4bf . ?ソ)
- (#x4c0 . ?ã‚¿)
- (#x4c1 . ?ãƒ)
- (#x4c2 . ?ツ)
- (#x4c3 . ?テ)
- (#x4c4 . ?ト)
- (#x4c5 . ?ナ)
- (#x4c6 . ?ニ)
- (#x4c7 . ?ヌ)
- (#x4c8 . ?ãƒ)
- (#x4c9 . ?ノ)
- (#x4ca . ?ãƒ)
- (#x4cb . ?ヒ)
- (#x4cc . ?フ)
- (#x4cd . ?ヘ)
- (#x4ce . ?ホ)
- (#x4cf . ?マ)
- (#x4d0 . ?ミ)
- (#x4d1 . ?ム)
- (#x4d2 . ?メ)
- (#x4d3 . ?モ)
- (#x4d4 . ?ヤ)
- (#x4d5 . ?ユ)
- (#x4d6 . ?ヨ)
- (#x4d7 . ?ラ)
- (#x4d8 . ?リ)
- (#x4d9 . ?ル)
- (#x4da . ?レ)
- (#x4db . ?ãƒ)
- (#x4dc . ?ワ)
- (#x4dd . ?ン)
- (#x4de . ?ã‚›)
- (#x4df . ?゜)
- (#x5ac . ?،)
- (#x5bb . ?Ø›)
- (#x5bf . ?ØŸ)
- (#x5c1 . ?Ø¡)
- (#x5c2 . ?Ø¢)
- (#x5c3 . ?Ø£)
- (#x5c4 . ?ؤ)
- (#x5c5 . ?Ø¥)
- (#x5c6 . ?ئ)
- (#x5c7 . ?ا)
- (#x5c8 . ?ب)
- (#x5c9 . ?Ø©)
- (#x5ca . ?ت)
- (#x5cb . ?Ø«)
- (#x5cc . ?ج)
- (#x5cd . ?Ø)
- (#x5ce . ?Ø®)
- (#x5cf . ?د)
- (#x5d0 . ?Ø°)
- (#x5d1 . ?ر)
- (#x5d2 . ?ز)
- (#x5d3 . ?س)
- (#x5d4 . ?Ø´)
- (#x5d5 . ?ص)
- (#x5d6 . ?ض)
- (#x5d7 . ?Ø·)
- (#x5d8 . ?ظ)
- (#x5d9 . ?ع)
- (#x5da . ?غ)
- (#x5e0 . ?Ù€)
- (#x5e1 . ?Ù)
- (#x5e2 . ?Ù‚)
- (#x5e3 . ?Ùƒ)
- (#x5e4 . ?Ù„)
- (#x5e5 . ?Ù…)
- (#x5e6 . ?Ù†)
- (#x5e7 . ?Ù‡)
- (#x5e8 . ?Ùˆ)
- (#x5e9 . ?Ù‰)
- (#x5ea . ?ÙŠ)
- (#x5eb . ?Ù‹)
- (#x5ec . ?ٌ)
- (#x5ed . ?Ù)
- (#x5ee . ?ÙŽ)
- (#x5ef . ?Ù)
- (#x5f0 . ?Ù)
- (#x5f1 . ?Ù‘)
- (#x5f2 . ?Ù’)
- (#x6a1 . ?Ñ’)
- (#x6a2 . ?Ñ“)
- (#x6a3 . ?Ñ‘)
- (#x6a4 . ?Ñ”)
- (#x6a5 . ?Ñ•)
- (#x6a6 . ?Ñ–)
- (#x6a7 . ?Ñ—)
- (#x6a8 . ?ј)
- (#x6a9 . ?Ñ™)
- (#x6aa . ?Ñš)
- (#x6ab . ?Ñ›)
- (#x6ac . ?ќ)
- (#x6ae . ?Ñž)
- (#x6af . ?ÑŸ)
- (#x6b0 . ?â„–)
- (#x6b1 . ?Ђ)
- (#x6b2 . ?Ѓ)
- (#x6b3 . ?Ð)
- (#x6b4 . ?Є)
- (#x6b5 . ?Ð…)
- (#x6b6 . ?І)
- (#x6b7 . ?Ї)
- (#x6b8 . ?Ј)
- (#x6b9 . ?Љ)
- (#x6ba . ?Њ)
- (#x6bb . ?Ћ)
- (#x6bc . ?Ќ)
- (#x6be . ?ÐŽ)
- (#x6bf . ?Ð)
- (#x6c0 . ?ÑŽ)
- (#x6c1 . ?а)
- (#x6c2 . ?б)
- (#x6c3 . ?ц)
- (#x6c4 . ?д)
- (#x6c5 . ?е)
- (#x6c6 . ?Ñ„)
- (#x6c7 . ?г)
- (#x6c8 . ?Ñ…)
- (#x6c9 . ?и)
- (#x6ca . ?й)
- (#x6cb . ?к)
- (#x6cc . ?л)
- (#x6cd . ?м)
- (#x6ce . ?н)
- (#x6cf . ?о)
- (#x6d0 . ?п)
- (#x6d1 . ?Ñ)
- (#x6d2 . ?Ñ€)
- (#x6d3 . ?Ñ)
- (#x6d4 . ?Ñ‚)
- (#x6d5 . ?у)
- (#x6d6 . ?ж)
- (#x6d7 . ?в)
- (#x6d8 . ?ь)
- (#x6d9 . ?Ñ‹)
- (#x6da . ?з)
- (#x6db . ?ш)
- (#x6dc . ?Ñ)
- (#x6dd . ?щ)
- (#x6de . ?ч)
- (#x6df . ?ÑŠ)
- (#x6e0 . ?Ю)
- (#x6e1 . ?Ð)
- (#x6e2 . ?Б)
- (#x6e3 . ?Ц)
- (#x6e4 . ?Д)
- (#x6e5 . ?Е)
- (#x6e6 . ?Ф)
- (#x6e7 . ?Г)
- (#x6e8 . ?Ð¥)
- (#x6e9 . ?И)
- (#x6ea . ?Й)
- (#x6eb . ?К)
- (#x6ec . ?Л)
- (#x6ed . ?М)
- (#x6ee . ?Ð)
- (#x6ef . ?О)
- (#x6f0 . ?П)
- (#x6f1 . ?Я)
- (#x6f2 . ?Ð )
- (#x6f3 . ?С)
- (#x6f4 . ?Т)
- (#x6f5 . ?У)
- (#x6f6 . ?Ж)
- (#x6f7 . ?Ð’)
- (#x6f8 . ?Ь)
- (#x6f9 . ?Ы)
- (#x6fa . ?З)
- (#x6fb . ?Ш)
- (#x6fc . ?Ð)
- (#x6fd . ?Щ)
- (#x6fe . ?Ч)
- (#x6ff . ?Ъ)
- (#x7a1 . ?Ά)
- (#x7a2 . ?Έ)
- (#x7a3 . ?Ή)
- (#x7a4 . ?Ί)
- (#x7a5 . ?Ϊ)
- (#x7a7 . ?Ό)
- (#x7a8 . ?ÎŽ)
- (#x7a9 . ?Ϋ)
- (#x7ab . ?Î)
- (#x7ae . ?Î…)
- (#x7af . ?―)
- (#x7b1 . ?ά)
- (#x7b2 . ?Î)
- (#x7b3 . ?ή)
- (#x7b4 . ?ί)
- (#x7b5 . ?ÏŠ)
- (#x7b6 . ?Î)
- (#x7b7 . ?ό)
- (#x7b8 . ?Ï)
- (#x7b9 . ?Ï‹)
- (#x7ba . ?ΰ)
- (#x7bb . ?ÏŽ)
- (#x7c1 . ?Α)
- (#x7c2 . ?Î’)
- (#x7c3 . ?Γ)
- (#x7c4 . ?Δ)
- (#x7c5 . ?Ε)
- (#x7c6 . ?Ζ)
- (#x7c7 . ?Η)
- (#x7c8 . ?Θ)
- (#x7c9 . ?Ι)
- (#x7ca . ?Κ)
- (#x7cb . ?Λ)
- (#x7cc . ?Μ)
- (#x7cd . ?Î)
- (#x7ce . ?Ξ)
- (#x7cf . ?Ο)
- (#x7d0 . ?Î )
- (#x7d1 . ?Ρ)
- (#x7d2 . ?Σ)
- (#x7d4 . ?Τ)
- (#x7d5 . ?Î¥)
- (#x7d6 . ?Φ)
- (#x7d7 . ?Χ)
- (#x7d8 . ?Ψ)
- (#x7d9 . ?Ω)
- (#x7e1 . ?α)
- (#x7e2 . ?β)
- (#x7e3 . ?γ)
- (#x7e4 . ?δ)
- (#x7e5 . ?ε)
- (#x7e6 . ?ζ)
- (#x7e7 . ?η)
- (#x7e8 . ?θ)
- (#x7e9 . ?ι)
- (#x7ea . ?κ)
- (#x7eb . ?λ)
- (#x7ec . ?μ)
- (#x7ed . ?ν)
- (#x7ee . ?ξ)
- (#x7ef . ?ο)
- (#x7f0 . ?Ï€)
- (#x7f1 . ?Ï)
- (#x7f2 . ?σ)
- (#x7f3 . ?Ï‚)
- (#x7f4 . ?Ï„)
- (#x7f5 . ?Ï…)
- (#x7f6 . ?φ)
- (#x7f7 . ?χ)
- (#x7f8 . ?ψ)
- (#x7f9 . ?ω)
- (#x8a1 . ?⎷)
- (#x8a2 . ?┌)
- (#x8a3 . ?─)
- (#x8a4 . ?⌠)
- (#x8a5 . ?⌡)
- (#x8a6 . ?│)
- (#x8a7 . ?⎡)
- (#x8a8 . ?⎣)
- (#x8a9 . ?⎤)
- (#x8aa . ?⎦)
- (#x8ab . ?⎛)
- (#x8ac . ?âŽ)
- (#x8ad . ?⎞)
- (#x8ae . ?⎠)
- (#x8af . ?⎨)
- (#x8b0 . ?⎬)
- (#x8bc . ?≤)
- (#x8bd . ?≠)
- (#x8be . ?≥)
- (#x8bf . ?∫)
- (#x8c0 . ?∴)
- (#x8c1 . ?âˆ)
- (#x8c2 . ?∞)
- (#x8c5 . ?∇)
- (#x8c8 . ?∼)
- (#x8c9 . ?≃)
- (#x8cd . ?⇔)
- (#x8ce . ?⇒)
- (#x8cf . ?≡)
- (#x8d6 . ?√)
- (#x8da . ?⊂)
- (#x8db . ?⊃)
- (#x8dc . ?∩)
- (#x8dd . ?∪)
- (#x8de . ?∧)
- (#x8df . ?∨)
- (#x8ef . ?∂)
- (#x8f6 . ?Æ’)
- (#x8fb . ?â†)
- (#x8fc . ?↑)
- (#x8fd . ?→)
- (#x8fe . ?↓)
- (#x9e0 . ?â—†)
- (#x9e1 . ?â–’)
- (#x9e2 . ?â‰)
- (#x9e3 . ?âŒ)
- (#x9e4 . ?â)
- (#x9e5 . ?âŠ)
- (#x9e8 . ?â¤)
- (#x9e9 . ?â‹)
- (#x9ea . ?┘)
- (#x9eb . ?â”)
- (#x9ec . ?┌)
- (#x9ed . ?â””)
- (#x9ee . ?┼)
- (#x9ef . ?⎺)
- (#x9f0 . ?⎻)
- (#x9f1 . ?─)
- (#x9f2 . ?⎼)
- (#x9f3 . ?⎽)
- (#x9f4 . ?├)
- (#x9f5 . ?┤)
- (#x9f6 . ?â”´)
- (#x9f7 . ?┬)
- (#x9f8 . ?│)
- (#xaa1 . ? )
- (#xaa2 . ? )
- (#xaa3 . ? )
- (#xaa4 . ? )
- (#xaa5 . ? )
- (#xaa6 . ? )
- (#xaa7 . ? )
- (#xaa8 . ? )
- (#xaa9 . ?—)
- (#xaaa . ?–)
- (#xaae . ?…)
- (#xaaf . ?‥)
- (#xab0 . ?â…“)
- (#xab1 . ?â…”)
- (#xab2 . ?â…•)
- (#xab3 . ?â…–)
- (#xab4 . ?â…—)
- (#xab5 . ?â…˜)
- (#xab6 . ?â…™)
- (#xab7 . ?â…š)
- (#xab8 . ?â„…)
- (#xabb . ?‒)
- (#xabc . ?〈)
- (#xabe . ?〉)
- (#xac3 . ?â…›)
- (#xac4 . ?⅜)
- (#xac5 . ?â…)
- (#xac6 . ?â…ž)
- (#xac9 . ?â„¢)
- (#xaca . ?☓)
- (#xacc . ?â—)
- (#xacd . ?â–·)
- (#xace . ?â—‹)
- (#xacf . ?â–¯)
- (#xad0 . ?‘)
- (#xad1 . ?’)
- (#xad2 . ?“)
- (#xad3 . ?â€)
- (#xad4 . ?â„ž)
- (#xad6 . ?′)
- (#xad7 . ?″)
- (#xad9 . ?âœ)
- (#xadb . ?â–¬)
- (#xadc . ?â—€)
- (#xadd . ?â–¶)
- (#xade . ?â—)
- (#xadf . ?â–®)
- (#xae0 . ?â—¦)
- (#xae1 . ?â–«)
- (#xae2 . ?â–)
- (#xae3 . ?â–³)
- (#xae4 . ?â–½)
- (#xae5 . ?☆)
- (#xae6 . ?•)
- (#xae7 . ?â–ª)
- (#xae8 . ?â–²)
- (#xae9 . ?â–¼)
- (#xaea . ?☜)
- (#xaeb . ?☞)
- (#xaec . ?♣)
- (#xaed . ?♦)
- (#xaee . ?♥)
- (#xaf0 . ?✠)
- (#xaf1 . ?†)
- (#xaf2 . ?‡)
- (#xaf3 . ?✓)
- (#xaf4 . ?✗)
- (#xaf5 . ?♯)
- (#xaf6 . ?â™)
- (#xaf7 . ?♂)
- (#xaf8 . ?♀)
- (#xaf9 . ?☎)
- (#xafa . ?⌕)
- (#xafb . ?â„—)
- (#xafc . ?‸)
- (#xafd . ?‚)
- (#xafe . ?„)
+ '(
+ ;; Latin-2
+ (#x1a1 . ?\e,B!\e(B)
+ (#x1a2 . ?\e,B"\e(B)
+ (#x1a3 . ?\e,B#\e(B)
+ (#x1a5 . ?\e,B%\e(B)
+ (#x1a6 . ?\e,B&\e(B)
+ (#x1a9 . ?\e,B)\e(B)
+ (#x1aa . ?\e,B*\e(B)
+ (#x1ab . ?\e,B+\e(B)
+ (#x1ac . ?\e,B,\e(B)
+ (#x1ae . ?\e,B.\e(B)
+ (#x1af . ?\e,B/\e(B)
+ (#x1b1 . ?\e,B1\e(B)
+ (#x1b2 . ?\e,B2\e(B)
+ (#x1b3 . ?\e,B3\e(B)
+ (#x1b5 . ?\e,B5\e(B)
+ (#x1b6 . ?\e,B6\e(B)
+ (#x1b7 . ?\e,B7\e(B)
+ (#x1b9 . ?\e,B9\e(B)
+ (#x1ba . ?\e,B:\e(B)
+ (#x1bb . ?\e,B;\e(B)
+ (#x1bc . ?\e,B<\e(B)
+ (#x1bd . ?\e,B=\e(B)
+ (#x1be . ?\e,B>\e(B)
+ (#x1bf . ?\e,B?\e(B)
+ (#x1c0 . ?\e,B@\e(B)
+ (#x1c3 . ?\e,BC\e(B)
+ (#x1c5 . ?\e,BE\e(B)
+ (#x1c6 . ?\e,BF\e(B)
+ (#x1c8 . ?\e,BH\e(B)
+ (#x1ca . ?\e,BJ\e(B)
+ (#x1cc . ?\e,BL\e(B)
+ (#x1cf . ?\e,BO\e(B)
+ (#x1d0 . ?\e,BP\e(B)
+ (#x1d1 . ?\e,BQ\e(B)
+ (#x1d2 . ?\e,BR\e(B)
+ (#x1d5 . ?\e,BU\e(B)
+ (#x1d8 . ?\e,BX\e(B)
+ (#x1d9 . ?\e,BY\e(B)
+ (#x1db . ?\e,B[\e(B)
+ (#x1de . ?\e,B^\e(B)
+ (#x1e0 . ?\e,B`\e(B)
+ (#x1e3 . ?\e,Bc\e(B)
+ (#x1e5 . ?\e,Be\e(B)
+ (#x1e6 . ?\e,Bf\e(B)
+ (#x1e8 . ?\e,Bh\e(B)
+ (#x1ea . ?\e,Bj\e(B)
+ (#x1ec . ?\e,Bl\e(B)
+ (#x1ef . ?\e,Bo\e(B)
+ (#x1f0 . ?\e,Bp\e(B)
+ (#x1f1 . ?\e,Bq\e(B)
+ (#x1f2 . ?\e,Br\e(B)
+ (#x1f5 . ?\e,Bu\e(B)
+ (#x1f8 . ?\e,Bx\e(B)
+ (#x1f9 . ?\e,By\e(B)
+ (#x1fb . ?\e,B{\e(B)
+ (#x1fe . ?\e,B~\e(B)
+ (#x1ff . ?\e,B\7f\e(B)
+ ;; Latin-3
+ (#x2a1 . ?\e,C!\e(B)
+ (#x2a6 . ?\e,C&\e(B)
+ (#x2a9 . ?\e,C)\e(B)
+ (#x2ab . ?\e,C+\e(B)
+ (#x2ac . ?\e,C,\e(B)
+ (#x2b1 . ?\e,C1\e(B)
+ (#x2b6 . ?\e,C6\e(B)
+ (#x2b9 . ?\e,C9\e(B)
+ (#x2bb . ?\e,C;\e(B)
+ (#x2bc . ?\e,C<\e(B)
+ (#x2c5 . ?\e,CE\e(B)
+ (#x2c6 . ?\e,CF\e(B)
+ (#x2d5 . ?\e,CU\e(B)
+ (#x2d8 . ?\e,CX\e(B)
+ (#x2dd . ?\e,C]\e(B)
+ (#x2de . ?\e,C^\e(B)
+ (#x2e5 . ?\e,Ce\e(B)
+ (#x2e6 . ?\e,Cf\e(B)
+ (#x2f5 . ?\e,Cu\e(B)
+ (#x2f8 . ?\e,Cx\e(B)
+ (#x2fd . ?\e,C}\e(B)
+ (#x2fe . ?\e,C~\e(B)
+ ;; Latin-4
+ (#x3a2 . ?\e,D"\e(B)
+ (#x3a3 . ?\e,D#\e(B)
+ (#x3a5 . ?\e,D%\e(B)
+ (#x3a6 . ?\e,D&\e(B)
+ (#x3aa . ?\e,D*\e(B)
+ (#x3ab . ?\e,D+\e(B)
+ (#x3ac . ?\e,D,\e(B)
+ (#x3b3 . ?\e,D3\e(B)
+ (#x3b5 . ?\e,D5\e(B)
+ (#x3b6 . ?\e,D6\e(B)
+ (#x3ba . ?\e,D:\e(B)
+ (#x3bb . ?\e,D;\e(B)
+ (#x3bc . ?\e,D<\e(B)
+ (#x3bd . ?\e,D=\e(B)
+ (#x3bf . ?\e,D?\e(B)
+ (#x3c0 . ?\e,D@\e(B)
+ (#x3c7 . ?\e,DG\e(B)
+ (#x3cc . ?\e,DL\e(B)
+ (#x3cf . ?\e,DO\e(B)
+ (#x3d1 . ?\e,DQ\e(B)
+ (#x3d2 . ?\e,DR\e(B)
+ (#x3d3 . ?\e,DS\e(B)
+ (#x3d9 . ?\e,DY\e(B)
+ (#x3dd . ?\e,D]\e(B)
+ (#x3de . ?\e,D^\e(B)
+ (#x3e0 . ?\e,D`\e(B)
+ (#x3e7 . ?\e,Dg\e(B)
+ (#x3ec . ?\e,Dl\e(B)
+ (#x3ef . ?\e,Do\e(B)
+ (#x3f1 . ?\e,Dq\e(B)
+ (#x3f2 . ?\e,Dr\e(B)
+ (#x3f3 . ?\e,Ds\e(B)
+ (#x3f9 . ?\e,Dy\e(B)
+ (#x3fd . ?\e,D}\e(B)
+ (#x3fe . ?\e,D~\e(B)
+ ;; 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)
+ ;; Arabic
+ (#x5ac . ?\e,G,\e(B)
+ (#x5bb . ?\e,G;\e(B)
+ (#x5bf . ?\e,G?\e(B)
+ (#x5c1 . ?\e,GA\e(B)
+ (#x5c2 . ?\e,GB\e(B)
+ (#x5c3 . ?\e,GC\e(B)
+ (#x5c4 . ?\e,GD\e(B)
+ (#x5c5 . ?\e,GE\e(B)
+ (#x5c6 . ?\e,GF\e(B)
+ (#x5c7 . ?\e,GG\e(B)
+ (#x5c8 . ?\e,GH\e(B)
+ (#x5c9 . ?\e,GI\e(B)
+ (#x5ca . ?\e,GJ\e(B)
+ (#x5cb . ?\e,GK\e(B)
+ (#x5cc . ?\e,GL\e(B)
+ (#x5cd . ?\e,GM\e(B)
+ (#x5ce . ?\e,GN\e(B)
+ (#x5cf . ?\e,GO\e(B)
+ (#x5d0 . ?\e,GP\e(B)
+ (#x5d1 . ?\e,GQ\e(B)
+ (#x5d2 . ?\e,GR\e(B)
+ (#x5d3 . ?\e,GS\e(B)
+ (#x5d4 . ?\e,GT\e(B)
+ (#x5d5 . ?\e,GU\e(B)
+ (#x5d6 . ?\e,GV\e(B)
+ (#x5d7 . ?\e,GW\e(B)
+ (#x5d8 . ?\e,GX\e(B)
+ (#x5d9 . ?\e,GY\e(B)
+ (#x5da . ?\e,GZ\e(B)
+ (#x5e0 . ?\e,G`\e(B)
+ (#x5e1 . ?\e,Ga\e(B)
+ (#x5e2 . ?\e,Gb\e(B)
+ (#x5e3 . ?\e,Gc\e(B)
+ (#x5e4 . ?\e,Gd\e(B)
+ (#x5e5 . ?\e,Ge\e(B)
+ (#x5e6 . ?\e,Gf\e(B)
+ (#x5e7 . ?\e,Gg\e(B)
+ (#x5e8 . ?\e,Gh\e(B)
+ (#x5e9 . ?\e,Gi\e(B)
+ (#x5ea . ?\e,Gj\e(B)
+ (#x5eb . ?\e,Gk\e(B)
+ (#x5ec . ?\e,Gl\e(B)
+ (#x5ed . ?\e,Gm\e(B)
+ (#x5ee . ?\e,Gn\e(B)
+ (#x5ef . ?\e,Go\e(B)
+ (#x5f0 . ?\e,Gp\e(B)
+ (#x5f1 . ?\e,Gq\e(B)
+ (#x5f2 . ?\e,Gr\e(B)
+ ;; Cyrillic
+ (#x6a1 . ?\e,Lr\e(B)
+ (#x6a2 . ?\e,Ls\e(B)
+ (#x6a3 . ?\e,Lq\e(B)
+ (#x6a4 . ?\e,Lt\e(B)
+ (#x6a5 . ?\e,Lu\e(B)
+ (#x6a6 . ?\e,Lv\e(B)
+ (#x6a7 . ?\e,Lw\e(B)
+ (#x6a8 . ?\e,Lx\e(B)
+ (#x6a9 . ?\e,Ly\e(B)
+ (#x6aa . ?\e,Lz\e(B)
+ (#x6ab . ?\e,L{\e(B)
+ (#x6ac . ?\e,L|\e(B)
+ (#x6ae . ?\e,L~\e(B)
+ (#x6af . ?\e,L\7f\e(B)
+ (#x6b0 . ?\e,Lp\e(B)
+ (#x6b1 . ?\e,L"\e(B)
+ (#x6b2 . ?\e,L#\e(B)
+ (#x6b3 . ?\e,L!\e(B)
+ (#x6b4 . ?\e,L$\e(B)
+ (#x6b5 . ?\e,L%\e(B)
+ (#x6b6 . ?\e,L&\e(B)
+ (#x6b7 . ?\e,L'\e(B)
+ (#x6b8 . ?\e,L(\e(B)
+ (#x6b9 . ?\e,L)\e(B)
+ (#x6ba . ?\e,L*\e(B)
+ (#x6bb . ?\e,L+\e(B)
+ (#x6bc . ?\e,L,\e(B)
+ (#x6be . ?\e,L.\e(B)
+ (#x6bf . ?\e,L/\e(B)
+ (#x6c0 . ?\e,Ln\e(B)
+ (#x6c1 . ?\e,LP\e(B)
+ (#x6c2 . ?\e,LQ\e(B)
+ (#x6c3 . ?\e,Lf\e(B)
+ (#x6c4 . ?\e,LT\e(B)
+ (#x6c5 . ?\e,LU\e(B)
+ (#x6c6 . ?\e,Ld\e(B)
+ (#x6c7 . ?\e,LS\e(B)
+ (#x6c8 . ?\e,Le\e(B)
+ (#x6c9 . ?\e,LX\e(B)
+ (#x6ca . ?\e,LY\e(B)
+ (#x6cb . ?\e,LZ\e(B)
+ (#x6cc . ?\e,L[\e(B)
+ (#x6cd . ?\e,L\\e(B)
+ (#x6ce . ?\e,L]\e(B)
+ (#x6cf . ?\e,L^\e(B)
+ (#x6d0 . ?\e,L_\e(B)
+ (#x6d1 . ?\e,Lo\e(B)
+ (#x6d2 . ?\e,L`\e(B)
+ (#x6d3 . ?\e,La\e(B)
+ (#x6d4 . ?\e,Lb\e(B)
+ (#x6d5 . ?\e,Lc\e(B)
+ (#x6d6 . ?\e,LV\e(B)
+ (#x6d7 . ?\e,LR\e(B)
+ (#x6d8 . ?\e,Ll\e(B)
+ (#x6d9 . ?\e,Lk\e(B)
+ (#x6da . ?\e,LW\e(B)
+ (#x6db . ?\e,Lh\e(B)
+ (#x6dc . ?\e,Lm\e(B)
+ (#x6dd . ?\e,Li\e(B)
+ (#x6de . ?\e,Lg\e(B)
+ (#x6df . ?\e,Lj\e(B)
+ (#x6e0 . ?\e,LN\e(B)
+ (#x6e1 . ?\e,L0\e(B)
+ (#x6e2 . ?\e,L1\e(B)
+ (#x6e3 . ?\e,LF\e(B)
+ (#x6e4 . ?\e,L4\e(B)
+ (#x6e5 . ?\e,L5\e(B)
+ (#x6e6 . ?\e,LD\e(B)
+ (#x6e7 . ?\e,L3\e(B)
+ (#x6e8 . ?\e,LE\e(B)
+ (#x6e9 . ?\e,L8\e(B)
+ (#x6ea . ?\e,L9\e(B)
+ (#x6eb . ?\e,L:\e(B)
+ (#x6ec . ?\e,L;\e(B)
+ (#x6ed . ?\e,L<\e(B)
+ (#x6ee . ?\e,L=\e(B)
+ (#x6ef . ?\e,L>\e(B)
+ (#x6f0 . ?\e,L?\e(B)
+ (#x6f1 . ?\e,LO\e(B)
+ (#x6f2 . ?\e,L@\e(B)
+ (#x6f3 . ?\e,LA\e(B)
+ (#x6f4 . ?\e,LB\e(B)
+ (#x6f5 . ?\e,LC\e(B)
+ (#x6f6 . ?\e,L6\e(B)
+ (#x6f7 . ?\e,L2\e(B)
+ (#x6f8 . ?\e,LL\e(B)
+ (#x6f9 . ?\e,LK\e(B)
+ (#x6fa . ?\e,L7\e(B)
+ (#x6fb . ?\e,LH\e(B)
+ (#x6fc . ?\e,LM\e(B)
+ (#x6fd . ?\e,LI\e(B)
+ (#x6fe . ?\e,LG\e(B)
+ (#x6ff . ?\e,LJ\e(B)
+ ;; Greek
+ (#x7a1 . ?\e,F6\e(B)
+ (#x7a2 . ?\e,F8\e(B)
+ (#x7a3 . ?\e,F9\e(B)
+ (#x7a4 . ?\e,F:\e(B)
+ (#x7a5 . ?\e,FZ\e(B)
+ (#x7a7 . ?\e,F<\e(B)
+ (#x7a8 . ?\e,F>\e(B)
+ (#x7a9 . ?\e,F[\e(B)
+ (#x7ab . ?\e,F?\e(B)
+ (#x7ae . ?\e,F5\e(B)
+ (#x7af . ?\e,F/\e(B)
+ (#x7b1 . ?\e,F\\e(B)
+ (#x7b2 . ?\e,F]\e(B)
+ (#x7b3 . ?\e,F^\e(B)
+ (#x7b4 . ?\e,F_\e(B)
+ (#x7b5 . ?\e,Fz\e(B)
+ (#x7b6 . ?\e,F@\e(B)
+ (#x7b7 . ?\e,F|\e(B)
+ (#x7b8 . ?\e,F}\e(B)
+ (#x7b9 . ?\e,F{\e(B)
+ (#x7ba . ?\e,F`\e(B)
+ (#x7bb . ?\e,F~\e(B)
+ (#x7c1 . ?\e,FA\e(B)
+ (#x7c2 . ?\e,FB\e(B)
+ (#x7c3 . ?\e,FC\e(B)
+ (#x7c4 . ?\e,FD\e(B)
+ (#x7c5 . ?\e,FE\e(B)
+ (#x7c6 . ?\e,FF\e(B)
+ (#x7c7 . ?\e,FG\e(B)
+ (#x7c8 . ?\e,FH\e(B)
+ (#x7c9 . ?\e,FI\e(B)
+ (#x7ca . ?\e,FJ\e(B)
+ (#x7cb . ?\e,FK\e(B)
+ (#x7cc . ?\e,FL\e(B)
+ (#x7cd . ?\e,FM\e(B)
+ (#x7ce . ?\e,FN\e(B)
+ (#x7cf . ?\e,FO\e(B)
+ (#x7d0 . ?\e,FP\e(B)
+ (#x7d1 . ?\e,FQ\e(B)
+ (#x7d2 . ?\e,FS\e(B)
+ (#x7d4 . ?\e,FT\e(B)
+ (#x7d5 . ?\e,FU\e(B)
+ (#x7d6 . ?\e,FV\e(B)
+ (#x7d7 . ?\e,FW\e(B)
+ (#x7d8 . ?\e,FX\e(B)
+ (#x7d9 . ?\e,FY\e(B)
+ (#x7e1 . ?\e,Fa\e(B)
+ (#x7e2 . ?\e,Fb\e(B)
+ (#x7e3 . ?\e,Fc\e(B)
+ (#x7e4 . ?\e,Fd\e(B)
+ (#x7e5 . ?\e,Fe\e(B)
+ (#x7e6 . ?\e,Ff\e(B)
+ (#x7e7 . ?\e,Fg\e(B)
+ (#x7e8 . ?\e,Fh\e(B)
+ (#x7e9 . ?\e,Fi\e(B)
+ (#x7ea . ?\e,Fj\e(B)
+ (#x7eb . ?\e,Fk\e(B)
+ (#x7ec . ?\e,Fl\e(B)
+ (#x7ed . ?\e,Fm\e(B)
+ (#x7ee . ?\e,Fn\e(B)
+ (#x7ef . ?\e,Fo\e(B)
+ (#x7f0 . ?\e,Fp\e(B)
+ (#x7f1 . ?\e,Fq\e(B)
+ (#x7f2 . ?\e,Fs\e(B)
+ (#x7f3 . ?\e,Fr\e(B)
+ (#x7f4 . ?\e,Ft\e(B)
+ (#x7f5 . ?\e,Fu\e(B)
+ (#x7f6 . ?\e,Fv\e(B)
+ (#x7f7 . ?\e,Fw\e(B)
+ (#x7f8 . ?\e,Fx\e(B)
+ (#x7f9 . ?\e,Fy\e(B)
+ ;; Technical
+ (#x8a1 . ?\e$,1|W\e(B)
+ (#x8a2 . ?\e$,2 ,\e(B)
+ (#x8a3 . ?\e$,2 \e(B)
+ (#x8a4 . ?\e$,1{ \e(B)
+ (#x8a5 . ?\e$,1{!\e(B)
+ (#x8a6 . ?\e$,2 "\e(B)
+ (#x8a7 . ?\e$,1|A\e(B)
+ (#x8a8 . ?\e$,1|C\e(B)
+ (#x8a9 . ?\e$,1|D\e(B)
+ (#x8aa . ?\e$,1|F\e(B)
+ (#x8ab . ?\e$,1|;\e(B)
+ (#x8ac . ?\e$,1|=\e(B)
+ (#x8ad . ?\e$,1|>\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)
+ (#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)
+ ;; 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)
+ (#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)
+ (#x9ef . ?\e$,1|Z\e(B)
+ (#x9f0 . ?\e$,1|[\e(B)
+ (#x9f1 . ?\e$,2 \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)
+ ;; Publishing
+ (#xaa1 . ?\e$,1rc\e(B)
+ (#xaa2 . ?\e$,1rb\e(B)
+ (#xaa3 . ?\e$,1rd\e(B)
+ (#xaa4 . ?\e$,1re\e(B)
+ (#xaa5 . ?\e$,1rg\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)
+ (#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)
+ (#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)
+ (#xaca . ?\e$,2"s\e(B)
+ (#xacc . ?\e$,2"!\e(B)
+ (#xacd . ?\e$,2!w\e(B)
+ (#xace . ?\e$,2"+\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)
+ (#xad4 . ?\e$,1u^\e(B)
+ (#xad6 . ?\e$,1s2\e(B)
+ (#xad7 . ?\e$,1s3\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)
+ (#xadf . ?\e$,2!n\e(B)
+ (#xae0 . ?\e$,2"F\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)
+ (#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)
+ (#xaf0 . ?\e$,2%`\e(B)
+ (#xaf1 . ?\e$,1s \e(B)
+ (#xaf2 . ?\e$,1s!\e(B)
+ (#xaf3 . ?\e$,2%S\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)
+ (#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)
+ ;; APL
(#xba3 . ?<)
(#xba6 . ?>)
- (#xba8 . ?∨)
- (#xba9 . ?∧)
- (#xbc0 . ?¯)
- (#xbc2 . ?⊥)
- (#xbc3 . ?∩)
- (#xbc4 . ?⌊)
+ (#xba8 . ?\e$,1xH\e(B)
+ (#xba9 . ?\e$,1xG\e(B)
+ (#xbc0 . ?\e,A/\e(B)
+ (#xbc2 . ?\e$,1ye\e(B)
+ (#xbc3 . ?\e$,1xI\e(B)
+ (#xbc4 . ?\e$,1zj\e(B)
(#xbc6 . ?_)
- (#xbca . ?∘)
- (#xbcc . ?⎕)
- (#xbce . ?⊤)
- (#xbcf . ?â—‹)
- (#xbd3 . ?⌈)
- (#xbd6 . ?∪)
- (#xbd8 . ?⊃)
- (#xbda . ?⊂)
- (#xbdc . ?⊢)
- (#xbfc . ?⊣)
- (#xcdf . ?‗)
- (#xce0 . ?×)
- (#xce1 . ?ב)
- (#xce2 . ?×’)
- (#xce3 . ?ד)
- (#xce4 . ?×”)
- (#xce5 . ?ו)
- (#xce6 . ?×–)
- (#xce7 . ?×—)
- (#xce8 . ?ט)
- (#xce9 . ?×™)
- (#xcea . ?ך)
- (#xceb . ?×›)
- (#xcec . ?ל)
- (#xced . ?×)
- (#xcee . ?מ)
- (#xcef . ?ן)
- (#xcf0 . ?× )
- (#xcf1 . ?ס)
- (#xcf2 . ?×¢)
- (#xcf3 . ?×£)
- (#xcf4 . ?פ)
- (#xcf5 . ?×¥)
- (#xcf6 . ?צ)
- (#xcf7 . ?ק)
- (#xcf8 . ?ר)
- (#xcf9 . ?ש)
- (#xcfa . ?ת)
- (#xda1 . ?à¸)
- (#xda2 . ?ข)
- (#xda3 . ?ฃ)
- (#xda4 . ?ค)
- (#xda5 . ?ฅ)
- (#xda6 . ?ฆ)
- (#xda7 . ?ง)
- (#xda8 . ?จ)
- (#xda9 . ?ฉ)
- (#xdaa . ?ช)
- (#xdab . ?ซ)
- (#xdac . ?ฌ)
- (#xdad . ?à¸)
- (#xdae . ?ฎ)
- (#xdaf . ?à¸)
- (#xdb0 . ?à¸)
- (#xdb1 . ?ฑ)
- (#xdb2 . ?ฒ)
- (#xdb3 . ?ณ)
- (#xdb4 . ?ด)
- (#xdb5 . ?ต)
- (#xdb6 . ?ถ)
- (#xdb7 . ?ท)
- (#xdb8 . ?ธ)
- (#xdb9 . ?น)
- (#xdba . ?บ)
- (#xdbb . ?ป)
- (#xdbc . ?ผ)
- (#xdbd . ?à¸)
- (#xdbe . ?พ)
- (#xdbf . ?ฟ)
- (#xdc0 . ?ภ)
- (#xdc1 . ?ม)
- (#xdc2 . ?ย)
- (#xdc3 . ?ร)
- (#xdc4 . ?ฤ)
- (#xdc5 . ?ล)
- (#xdc6 . ?ฦ)
- (#xdc7 . ?ว)
- (#xdc8 . ?ศ)
- (#xdc9 . ?ษ)
- (#xdca . ?ส)
- (#xdcb . ?ห)
- (#xdcc . ?ฬ)
- (#xdcd . ?à¸)
- (#xdce . ?ฮ)
- (#xdcf . ?ฯ)
- (#xdd0 . ?ะ)
- (#xdd1 . ?ั)
- (#xdd2 . ?า)
- (#xdd3 . ?ำ)
- (#xdd4 . ?ิ)
- (#xdd5 . ?ี)
- (#xdd6 . ?ึ)
- (#xdd7 . ?ื)
- (#xdd8 . ?ุ)
- (#xdd9 . ?ู)
- (#xdda . ?ฺ)
- (#xddf . ?฿)
- (#xde0 . ?เ)
- (#xde1 . ?à¹)
- (#xde2 . ?โ)
- (#xde3 . ?ใ)
- (#xde4 . ?ไ)
- (#xde5 . ?ๅ)
- (#xde6 . ?ๆ)
- (#xde7 . ?็)
- (#xde8 . ?่)
- (#xde9 . ?้)
- (#xdea . ?๊)
- (#xdeb . ?๋)
- (#xdec . ?์)
- (#xded . ?à¹)
- (#xdf0 . ?à¹)
- (#xdf1 . ?๑)
- (#xdf2 . ?๒)
- (#xdf3 . ?๓)
- (#xdf4 . ?๔)
- (#xdf5 . ?๕)
- (#xdf6 . ?๖)
- (#xdf7 . ?๗)
- (#xdf8 . ?๘)
- (#xdf9 . ?๙)
- (#xea1 . ?ㄱ)
- (#xea2 . ?ㄲ)
- (#xea3 . ?ㄳ)
- (#xea4 . ?ã„´)
- (#xea5 . ?ㄵ)
- (#xea6 . ?ㄶ)
- (#xea7 . ?ã„·)
- (#xea8 . ?ㄸ)
- (#xea9 . ?ㄹ)
- (#xeaa . ?ㄺ)
- (#xeab . ?ã„»)
- (#xeac . ?ㄼ)
- (#xead . ?ㄽ)
- (#xeae . ?ㄾ)
- (#xeaf . ?ã„¿)
- (#xeb0 . ?ã…€)
- (#xeb1 . ?ã…)
- (#xeb2 . ?ã…‚)
- (#xeb3 . ?ã…ƒ)
- (#xeb4 . ?ã…„)
- (#xeb5 . ?ã……)
- (#xeb6 . ?ã…†)
- (#xeb7 . ?ã…‡)
- (#xeb8 . ?ã…ˆ)
- (#xeb9 . ?ã…‰)
- (#xeba . ?ã…Š)
- (#xebb . ?ã…‹)
- (#xebc . ?ㅌ)
- (#xebd . ?ã…)
- (#xebe . ?ã…Ž)
- (#xebf . ?ã…)
- (#xec0 . ?ã…)
- (#xec1 . ?ã…‘)
- (#xec2 . ?ã…’)
- (#xec3 . ?ã…“)
- (#xec4 . ?ã…”)
- (#xec5 . ?ã…•)
- (#xec6 . ?ã…–)
- (#xec7 . ?ã…—)
- (#xec8 . ?ã…˜)
- (#xec9 . ?ã…™)
- (#xeca . ?ã…š)
- (#xecb . ?ã…›)
- (#xecc . ?ㅜ)
- (#xecd . ?ã…)
- (#xece . ?ã…ž)
- (#xecf . ?ã…Ÿ)
- (#xed0 . ?ã… )
- (#xed1 . ?ã…¡)
- (#xed2 . ?ã…¢)
- (#xed3 . ?ã…£)
- (#xed4 . ?ᆨ)
- (#xed5 . ?ᆩ)
- (#xed6 . ?ᆪ)
- (#xed7 . ?ᆫ)
- (#xed8 . ?ᆬ)
- (#xed9 . ?á†)
- (#xeda . ?ᆮ)
- (#xedb . ?ᆯ)
- (#xedc . ?ᆰ)
- (#xedd . ?ᆱ)
- (#xede . ?ᆲ)
- (#xedf . ?ᆳ)
- (#xee0 . ?ᆴ)
- (#xee1 . ?ᆵ)
- (#xee2 . ?ᆶ)
- (#xee3 . ?ᆷ)
- (#xee4 . ?ᆸ)
- (#xee5 . ?ᆹ)
- (#xee6 . ?ᆺ)
- (#xee7 . ?ᆻ)
- (#xee8 . ?ᆼ)
- (#xee9 . ?ᆽ)
- (#xeea . ?ᆾ)
- (#xeeb . ?ᆿ)
- (#xeec . ?ᇀ)
- (#xeed . ?á‡)
- (#xeee . ?ᇂ)
- (#xeef . ?ã…)
- (#xef0 . ?ã…±)
- (#xef1 . ?ã…¸)
- (#xef2 . ?ã…¿)
- (#xef3 . ?ã†)
- (#xef4 . ?ㆄ)
- (#xef5 . ?ㆆ)
- (#xef6 . ?ã†)
- (#xef7 . ?ㆎ)
- (#xef8 . ?ᇫ)
- (#xef9 . ?ᇰ)
- (#xefa . ?ᇹ)
- (#xeff . ?â‚©)
- (#x13bc . ?Å’)
- (#x13bd . ?Å“)
- (#x13be . ?Ÿ)
- (#x20a0 . ?â‚ )
- (#x20a1 . ?â‚¡)
- (#x20a2 . ?â‚¢)
- (#x20a3 . ?â‚£)
- (#x20a4 . ?₤)
- (#x20a5 . ?â‚¥)
- (#x20a6 . ?₦)
- (#x20a7 . ?₧)
- (#x20a8 . ?₨)
- (#x20aa . ?₪)
- (#x20ab . ?â‚«)
- (#x20ac . ?€)))
+ (#xbca . ?\e$,1x8\e(B)
+ (#xbcc . ?\e$,1|5\e(B)
+ (#xbce . ?\e$,1yd\e(B)
+ (#xbcf . ?\e$,2"+\e(B)
+ (#xbd3 . ?\e$,1zh\e(B)
+ (#xbd6 . ?\e$,1xJ\e(B)
+ (#xbd8 . ?\e$,1yC\e(B)
+ (#xbda . ?\e$,1yB\e(B)
+ (#xbdc . ?\e$,1yb\e(B)
+ (#xbfc . ?\e$,1yc\e(B)
+ ;; Hebrew
+ (#xcdf . ?\e,H_\e(B)
+ (#xce0 . ?\e,H`\e(B)
+ (#xce1 . ?\e,Ha\e(B)
+ (#xce2 . ?\e,Hb\e(B)
+ (#xce3 . ?\e,Hc\e(B)
+ (#xce4 . ?\e,Hd\e(B)
+ (#xce5 . ?\e,He\e(B)
+ (#xce6 . ?\e,Hf\e(B)
+ (#xce7 . ?\e,Hg\e(B)
+ (#xce8 . ?\e,Hh\e(B)
+ (#xce9 . ?\e,Hi\e(B)
+ (#xcea . ?\e,Hj\e(B)
+ (#xceb . ?\e,Hk\e(B)
+ (#xcec . ?\e,Hl\e(B)
+ (#xced . ?\e,Hm\e(B)
+ (#xcee . ?\e,Hn\e(B)
+ (#xcef . ?\e,Ho\e(B)
+ (#xcf0 . ?\e,Hp\e(B)
+ (#xcf1 . ?\e,Hq\e(B)
+ (#xcf2 . ?\e,Hr\e(B)
+ (#xcf3 . ?\e,Hs\e(B)
+ (#xcf4 . ?\e,Ht\e(B)
+ (#xcf5 . ?\e,Hu\e(B)
+ (#xcf6 . ?\e,Hv\e(B)
+ (#xcf7 . ?\e,Hw\e(B)
+ (#xcf8 . ?\e,Hx\e(B)
+ (#xcf9 . ?\e,Hy\e(B)
+ (#xcfa . ?\e,Hz\e(B)
+ ;; Thai
+ (#xda1 . ?\e,T!\e(B)
+ (#xda2 . ?\e,T"\e(B)
+ (#xda3 . ?\e,T#\e(B)
+ (#xda4 . ?\e,T$\e(B)
+ (#xda5 . ?\e,T%\e(B)
+ (#xda6 . ?\e,T&\e(B)
+ (#xda7 . ?\e,T'\e(B)
+ (#xda8 . ?\e,T(\e(B)
+ (#xda9 . ?\e,T)\e(B)
+ (#xdaa . ?\e,T*\e(B)
+ (#xdab . ?\e,T+\e(B)
+ (#xdac . ?\e,T,\e(B)
+ (#xdad . ?\e,T-\e(B)
+ (#xdae . ?\e,T.\e(B)
+ (#xdaf . ?\e,T/\e(B)
+ (#xdb0 . ?\e,T0\e(B)
+ (#xdb1 . ?\e,T1\e(B)
+ (#xdb2 . ?\e,T2\e(B)
+ (#xdb3 . ?\e,T3\e(B)
+ (#xdb4 . ?\e,T4\e(B)
+ (#xdb5 . ?\e,T5\e(B)
+ (#xdb6 . ?\e,T6\e(B)
+ (#xdb7 . ?\e,T7\e(B)
+ (#xdb8 . ?\e,T8\e(B)
+ (#xdb9 . ?\e,T9\e(B)
+ (#xdba . ?\e,T:\e(B)
+ (#xdbb . ?\e,T;\e(B)
+ (#xdbc . ?\e,T<\e(B)
+ (#xdbd . ?\e,T=\e(B)
+ (#xdbe . ?\e,T>\e(B)
+ (#xdbf . ?\e,T?\e(B)
+ (#xdc0 . ?\e,T@\e(B)
+ (#xdc1 . ?\e,TA\e(B)
+ (#xdc2 . ?\e,TB\e(B)
+ (#xdc3 . ?\e,TC\e(B)
+ (#xdc4 . ?\e,TD\e(B)
+ (#xdc5 . ?\e,TE\e(B)
+ (#xdc6 . ?\e,TF\e(B)
+ (#xdc7 . ?\e,TG\e(B)
+ (#xdc8 . ?\e,TH\e(B)
+ (#xdc9 . ?\e,TI\e(B)
+ (#xdca . ?\e,TJ\e(B)
+ (#xdcb . ?\e,TK\e(B)
+ (#xdcc . ?\e,TL\e(B)
+ (#xdcd . ?\e,TM\e(B)
+ (#xdce . ?\e,TN\e(B)
+ (#xdcf . ?\e,TO\e(B)
+ (#xdd0 . ?\e,TP\e(B)
+ (#xdd1 . ?\e,TQ\e(B)
+ (#xdd2 . ?\e,TR\e(B)
+ (#xdd3 . ?\e,TS\e(B)
+ (#xdd4 . ?\e,TT\e(B)
+ (#xdd5 . ?\e,TU\e(B)
+ (#xdd6 . ?\e,TV\e(B)
+ (#xdd7 . ?\e,TW\e(B)
+ (#xdd8 . ?\e,TX\e(B)
+ (#xdd9 . ?\e,TY\e(B)
+ (#xdda . ?\e,TZ\e(B)
+ (#xddf . ?\e,T_\e(B)
+ (#xde0 . ?\e,T`\e(B)
+ (#xde1 . ?\e,Ta\e(B)
+ (#xde2 . ?\e,Tb\e(B)
+ (#xde3 . ?\e,Tc\e(B)
+ (#xde4 . ?\e,Td\e(B)
+ (#xde5 . ?\e,Te\e(B)
+ (#xde6 . ?\e,Tf\e(B)
+ (#xde7 . ?\e,Tg\e(B)
+ (#xde8 . ?\e,Th\e(B)
+ (#xde9 . ?\e,Ti\e(B)
+ (#xdea . ?\e,Tj\e(B)
+ (#xdeb . ?\e,Tk\e(B)
+ (#xdec . ?\e,Tl\e(B)
+ (#xded . ?\e,Tm\e(B)
+ (#xdf0 . ?\e,Tp\e(B)
+ (#xdf1 . ?\e,Tq\e(B)
+ (#xdf2 . ?\e,Tr\e(B)
+ (#xdf3 . ?\e,Ts\e(B)
+ (#xdf4 . ?\e,Tt\e(B)
+ (#xdf5 . ?\e,Tu\e(B)
+ (#xdf6 . ?\e,Tv\e(B)
+ (#xdf7 . ?\e,Tw\e(B)
+ (#xdf8 . ?\e,Tx\e(B)
+ (#xdf9 . ?\e,Ty\e(B)
+ ;; Korean
+ (#xea1 . ?\e$(C$!\e(B)
+ (#xea2 . ?\e$(C$"\e(B)
+ (#xea3 . ?\e$(C$#\e(B)
+ (#xea4 . ?\e$(C$$\e(B)
+ (#xea5 . ?\e$(C$%\e(B)
+ (#xea6 . ?\e$(C$&\e(B)
+ (#xea7 . ?\e$(C$'\e(B)
+ (#xea8 . ?\e$(C$(\e(B)
+ (#xea9 . ?\e$(C$)\e(B)
+ (#xeaa . ?\e$(C$*\e(B)
+ (#xeab . ?\e$(C$+\e(B)
+ (#xeac . ?\e$(C$,\e(B)
+ (#xead . ?\e$(C$-\e(B)
+ (#xeae . ?\e$(C$.\e(B)
+ (#xeaf . ?\e$(C$/\e(B)
+ (#xeb0 . ?\e$(C$0\e(B)
+ (#xeb1 . ?\e$(C$1\e(B)
+ (#xeb2 . ?\e$(C$2\e(B)
+ (#xeb3 . ?\e$(C$3\e(B)
+ (#xeb4 . ?\e$(C$4\e(B)
+ (#xeb5 . ?\e$(C$5\e(B)
+ (#xeb6 . ?\e$(C$6\e(B)
+ (#xeb7 . ?\e$(C$7\e(B)
+ (#xeb8 . ?\e$(C$8\e(B)
+ (#xeb9 . ?\e$(C$9\e(B)
+ (#xeba . ?\e$(C$:\e(B)
+ (#xebb . ?\e$(C$;\e(B)
+ (#xebc . ?\e$(C$<\e(B)
+ (#xebd . ?\e$(C$=\e(B)
+ (#xebe . ?\e$(C$>\e(B)
+ (#xebf . ?\e$(C$?\e(B)
+ (#xec0 . ?\e$(C$@\e(B)
+ (#xec1 . ?\e$(C$A\e(B)
+ (#xec2 . ?\e$(C$B\e(B)
+ (#xec3 . ?\e$(C$C\e(B)
+ (#xec4 . ?\e$(C$D\e(B)
+ (#xec5 . ?\e$(C$E\e(B)
+ (#xec6 . ?\e$(C$F\e(B)
+ (#xec7 . ?\e$(C$G\e(B)
+ (#xec8 . ?\e$(C$H\e(B)
+ (#xec9 . ?\e$(C$I\e(B)
+ (#xeca . ?\e$(C$J\e(B)
+ (#xecb . ?\e$(C$K\e(B)
+ (#xecc . ?\e$(C$L\e(B)
+ (#xecd . ?\e$(C$M\e(B)
+ (#xece . ?\e$(C$N\e(B)
+ (#xecf . ?\e$(C$O\e(B)
+ (#xed0 . ?\e$(C$P\e(B)
+ (#xed1 . ?\e$(C$Q\e(B)
+ (#xed2 . ?\e$(C$R\e(B)
+ (#xed3 . ?\e$(C$S\e(B)
+ (#xed4 . ?\e$,1LH\e(B)
+ (#xed5 . ?\e$,1LI\e(B)
+ (#xed6 . ?\e$,1LJ\e(B)
+ (#xed7 . ?\e$,1LK\e(B)
+ (#xed8 . ?\e$,1LL\e(B)
+ (#xed9 . ?\e$,1LM\e(B)
+ (#xeda . ?\e$,1LN\e(B)
+ (#xedb . ?\e$,1LO\e(B)
+ (#xedc . ?\e$,1LP\e(B)
+ (#xedd . ?\e$,1LQ\e(B)
+ (#xede . ?\e$,1LR\e(B)
+ (#xedf . ?\e$,1LS\e(B)
+ (#xee0 . ?\e$,1LT\e(B)
+ (#xee1 . ?\e$,1LU\e(B)
+ (#xee2 . ?\e$,1LV\e(B)
+ (#xee3 . ?\e$,1LW\e(B)
+ (#xee4 . ?\e$,1LX\e(B)
+ (#xee5 . ?\e$,1LY\e(B)
+ (#xee6 . ?\e$,1LZ\e(B)
+ (#xee7 . ?\e$,1L[\e(B)
+ (#xee8 . ?\e$,1L\\e(B)
+ (#xee9 . ?\e$,1L]\e(B)
+ (#xeea . ?\e$,1L^\e(B)
+ (#xeeb . ?\e$,1L_\e(B)
+ (#xeec . ?\e$,1L`\e(B)
+ (#xeed . ?\e$,1La\e(B)
+ (#xeee . ?\e$,1Lb\e(B)
+ (#xeef . ?\e$(C$]\e(B)
+ (#xef0 . ?\e$(C$a\e(B)
+ (#xef1 . ?\e$(C$h\e(B)
+ (#xef2 . ?\e$(C$o\e(B)
+ (#xef3 . ?\e$(C$q\e(B)
+ (#xef4 . ?\e$(C$t\e(B)
+ (#xef5 . ?\e$(C$v\e(B)
+ (#xef6 . ?\e$(C$}\e(B)
+ (#xef7 . ?\e$(C$~\e(B)
+ (#xef8 . ?\e$,1M+\e(B)
+ (#xef9 . ?\e$,1M0\e(B)
+ (#xefa . ?\e$,1M9\e(B)
+ (#xeff . ?\e$,1tI\e(B)
+ ;; Latin-5
+ ;; Latin-6
+ ;; Latin-7
+ ;; Latin-8
+ ;; Latin-9
+ (#x13bc . ?\e,b<\e(B)
+ (#x13bd . ?\e,b=\e(B)
+ (#x13be . ?\e,b>\e(B)
+ ;; Currency
+ (#x20a0 . ?\e$,1t@\e(B)
+ (#x20a1 . ?\e$,1tA\e(B)
+ (#x20a2 . ?\e$,1tB\e(B)
+ (#x20a3 . ?\e$,1tC\e(B)
+ (#x20a4 . ?\e$,1tD\e(B)
+ (#x20a5 . ?\e$,1tE\e(B)
+ (#x20a6 . ?\e$,1tF\e(B)
+ (#x20a7 . ?\e$,1tG\e(B)
+ (#x20a8 . ?\e$,1tH\e(B)
+ (#x20aa . ?\e$,1tJ\e(B)
+ (#x20ab . ?\e$,1tK\e(B)
+ (#x20ac . ?\e,b$\e(B)))
(puthash (car pair) (cdr pair) x-keysym-table))
;; The following keysym codes for graphics are listed in the document
;;; We keep track of the last text selected here, so we can check the
;;; current selection against it, and avoid passing back our own text
-;;; from x-cut-buffer-or-selection-value.
-(defvar x-last-selected-text nil)
+;;; from x-cut-buffer-or-selection-value. We track all three
+;;; seperately in case another X application only sets one of them
+;;; (say the cut buffer) we aren't fooled by the PRIMARY or
+;;; CLIPBOARD selection staying the same.
+(defvar x-last-selected-text-clipboard nil
+ "The value of the CLIPBOARD X selection last time we selected or
+pasted text.")
+(defvar x-last-selected-text-primary nil
+ "The value of the PRIMARY X selection last time we selected or
+pasted text.")
+(defvar x-last-selected-text-cut nil
+ "The value of the X cut buffer last time we selected or pasted text.")
;;; It is said that overlarge strings are slow to put into the cut buffer.
;;; Note this value is overridden below.
(defun x-select-text (text &optional push)
;; Don't send the cut buffer too much text.
;; It becomes slow, and if really big it causes errors.
- (if (< (length text) x-cut-buffer-max)
- (x-set-cut-buffer text push)
- (x-set-cut-buffer "" push))
+ (cond ((>= (length text) x-cut-buffer-max)
+ (x-set-cut-buffer "" push)
+ (setq x-last-selected-text-cut ""))
+ ;; Don't store a multibyte string that contains
+ ;; eight-bit-control/graphic chars because they can't be
+ ;; restored correctly by x-get-cut-buffer.
+ ((and (multibyte-string-p text)
+ (let ((charsets (find-charset-string text)))
+ (or (memq 'eight-bit-control charsets)
+ (memq 'eight-bit-graphic charsets))))
+ (x-set-cut-buffer "" push)
+ (setq x-last-selected-text-cut ""))
+ (t
+ (x-set-cut-buffer text push)
+ (setq x-last-selected-text-cut text)))
(x-set-selection 'PRIMARY text)
- (if x-select-enable-clipboard
- (x-set-selection 'CLIPBOARD text))
- (setq x-last-selected-text text))
+ (setq x-last-selected-text-primary text)
+ (when x-select-enable-clipboard
+ (x-set-selection 'CLIPBOARD text)
+ (setq x-last-selected-text-clipboard text))
+ )
+
+(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:
+ `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.")
+
+;; 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 the Nth character of CTEXT is an ASCII
+;; character that is different from the Nth character of UTF8,
+;; select UTF8. 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)
+ (while (< i len-utf8)
+ (setq char (aref ctext i))
+ (if (and (< char 128) (/= char (aref utf8 i)))
+ (setq selected utf8
+ i len-utf8)
+ (setq i (1+ i))))
+ selected)))
+
+(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 locale selection, choose it.
+ (or (get-text-property 0 'foreign-selection 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))))
+ ;; 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))))
+
+ (if text
+ (remove-text-properties 0 (length text) '(foreign-selection nil) text))
+ text))
+
;;; Return the value of the current X selection.
-;;; Consult the selection, then the cut buffer. Treat empty strings
+;;; Consult the selection, and the cut buffer. Treat empty strings
;;; as if they were unset.
;;; If this function is called twice and finds the same text,
;;; it returns nil the second time. This is so that a single
;;; selection won't be added to the kill ring over and over.
(defun x-cut-buffer-or-selection-value ()
- (let (text)
+ (let (clip-text primary-text cut-text)
(when x-select-enable-clipboard
- (if (null text)
- (condition-case c
- (setq text (x-get-selection 'CLIPBOARD 'COMPOUND_TEXT))
- (error nil)))
- (if (null text)
- (condition-case c
- (setq text (x-get-selection 'CLIPBOARD 'STRING))
- (error nil)))
- (if (string= text "") (setq text nil)))
-
- ;; Don't die if x-get-selection signals an error.
- (if (null text)
- (condition-case c
- (setq text (x-get-selection 'PRIMARY 'COMPOUND_TEXT))
- (error nil)))
- (if (null text)
- (condition-case c
- (setq text (x-get-selection 'PRIMARY 'STRING))
- (error nil)))
- (if (string= text "") (setq text nil))
-
- (or text (setq text (x-get-cut-buffer 0)))
- (if (string= text "") (setq text nil))
-
- (cond
- ((not text) nil)
- ((eq text x-last-selected-text) nil)
- ((string= text x-last-selected-text)
- ;; Record the newer string, so subsequent calls can use the `eq' test.
- (setq x-last-selected-text text)
+ (setq clip-text (x-selection-value 'CLIPBOARD))
+ (if (string= clip-text "") (setq clip-text nil))
+
+ ;; Check the CLIPBOARD selection for 'newness', is it different
+ ;; from what we remebered them to be last time we did a
+ ;; cut/paste operation.
+ (setq clip-text
+ (cond;; check clipboard
+ ((or (not clip-text) (string= clip-text ""))
+ (setq x-last-selected-text-clipboard nil))
+ ((eq clip-text x-last-selected-text-clipboard) nil)
+ ((string= clip-text x-last-selected-text-clipboard)
+ ;; Record the newer string,
+ ;; so subsequent calls can use the `eq' test.
+ (setq x-last-selected-text-clipboard clip-text)
+ nil)
+ (t
+ (setq x-last-selected-text-clipboard clip-text))))
+ )
+
+ (setq primary-text (x-selection-value 'PRIMARY))
+ ;; Check the PRIMARY selection for 'newness', is it different
+ ;; from what we remebered them to be last time we did a
+ ;; cut/paste operation.
+ (setq primary-text
+ (cond;; check primary selection
+ ((or (not primary-text) (string= primary-text ""))
+ (setq x-last-selected-text-primary nil))
+ ((eq primary-text x-last-selected-text-primary) nil)
+ ((string= primary-text x-last-selected-text-primary)
+ ;; Record the newer string,
+ ;; so subsequent calls can use the `eq' test.
+ (setq x-last-selected-text-primary primary-text)
+ nil)
+ (t
+ (setq x-last-selected-text-primary primary-text))))
+
+ (setq cut-text (x-get-cut-buffer 0))
+
+ ;; Check the x cut buffer for 'newness', is it different
+ ;; from what we remebered them to be last time we did a
+ ;; cut/paste operation.
+ (setq cut-text
+ (cond;; check primary selection
+ ((or (not cut-text) (string= cut-text ""))
+ (setq x-last-selected-text-cut nil))
+ ((eq cut-text x-last-selected-text-cut) nil)
+ ((string= cut-text x-last-selected-text-cut)
+ ;; Record the newer string,
+ ;; so subsequent calls can use the `eq' test.
+ (setq x-last-selected-text-cut cut-text)
nil)
(t
- (setq x-last-selected-text text)))))
+ (setq x-last-selected-text-cut cut-text))))
+
+ ;; As we have done one selection, clear this now.
+ (setq next-selection-coding-system nil)
+
+ ;; At this point we have recorded the current values for the
+ ;; selection from clipboard (if we are supposed to) primary,
+ ;; and cut buffer. So return the first one that has changed
+ ;; (which is the first non-null one).
+ ;;
+ ;; NOTE: There will be cases where more than one of these has
+ ;; changed and the new values differ. This indicates that
+ ;; something like the following has happened since the last time
+ ;; we looked at the selections: Application X set all the
+ ;; selections, then Application Y set only one or two of them (say
+ ;; just the cut-buffer). In this case since we don't have
+ ;; timestamps there is no way to know what the 'correct' value to
+ ;; return is. The nice thing to do would be to tell the user we
+ ;; saw multiple possible selections and ask the user which was the
+ ;; one they wanted.
+ ;; This code is still a big improvement because now the user can
+ ;; futz with the current selection and get emacs to pay attention
+ ;; to the cut buffer again (previously as soon as clipboard or
+ ;; primary had been set the cut buffer would essentially never be
+ ;; checked again).
+ (or clip-text primary-text cut-text)
+ ))
\f
;;; Do the actual X Windows setup here; the above code just defines
(setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100)
x-cut-buffer-max))
+;; Setup the default fontset.
+(setup-default-fontset)
+
;; Create the standard fontset.
(create-fontset-from-fontset-spec 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"))))
-
;; Sun expects the menu bar cut and paste commands to use the clipboard.
;; This has ,? to match both on Sunos and on Solaris.
(if (string-match "Sun Microsystems,? Inc\\."
(setq x-selection-timeout (string-to-number res-selection-timeout))))
(defun x-win-suspend-error ()
- (error "Suspending an emacs running under X makes no sense"))
+ (error "Suspending an Emacs running under X makes no sense"))
(add-hook 'suspend-hook 'x-win-suspend-error)
;;; Arrange for the kill and yank functions to set and check the clipboard.
;; Don't show the frame name; that's redundant with X.
(setq-default mode-line-frame-identification " ")
-;;; Motif direct handling of f10 wasn't working right,
-;;; So temporarily we've turned it off in lwlib-Xm.c
-;;; and turned the Emacs f10 back on.
-;;; ;; Motif normally handles f10 itself, so don't try to handle it a second time.
-;;; (if (featurep 'motif)
-;;; (global-set-key [f10] 'ignore))
+;; Motif direct handling of f10 wasn't working right,
+;; So temporarily we've turned it off in lwlib-Xm.c
+;; and turned the Emacs f10 back on.
+;; ;; Motif normally handles f10 itself, so don't try to handle it a second time.
+;; (if (featurep 'motif)
+;; (global-set-key [f10] 'ignore))
+
+;; Turn on support for mouse wheels.
+(mouse-wheel-mode 1)
;;; x-win.el ends here
;;; sgml-mode.el --- SGML- and HTML-editing modes
-;; Copyright (C) 1992,95,96,98,2001 Free Software Foundation, Inc.
+;; Copyright (C) 1992,95,96,98,2001,2002, 2003 Free Software Foundation, Inc.
;; Author: James Clark <jjc@jclark.com>
+;; Maintainer: FSF
;; Adapted-By: ESR, Daniel Pfeiffer <occitan@esperanto.org>,
;; F.Potorti@cnuce.cnr.it
;; Keywords: wp, hypermedia, comm, languages
(eval-when-compile
(require 'skeleton)
- (require 'outline))
+ (require 'outline)
+ (require 'cl))
(defgroup sgml nil
"SGML editing mode"
:group 'languages)
+(defcustom sgml-basic-offset 2
+ "*Specifies the basic indentation level for `sgml-indent-line'."
+ :type 'integer
+ :group 'sgml)
+
(defcustom sgml-transformation 'identity
"*Default value for `skeleton-transformation' (which see) in SGML mode."
:type 'function
;; kludgy kind of tradeoff.
(defvar sgml-specials '(?\")
"List of characters that have a special meaning for SGML mode.
-This list is used when first loading the sgml-mode library.
+This list is used when first loading the `sgml-mode' library.
The supported characters and potential disadvantages are:
?\\\" Makes \" in text start a string.
with comments, so we normally turn it off.")
(defvar sgml-quick-keys nil
- "Use <, >, &, SPC and `sgml-specials' keys \"electrically\" when non-nil.
-This takes effect when first loading the sgml-mode library.")
-
+ "Use <, >, &, /, SPC and `sgml-specials' keys \"electrically\" when non-nil.
+This takes effect when first loading the `sgml-mode' library.")
(defvar sgml-mode-map
(let ((map (make-keymap)) ;`sparse' doesn't allow binding to charsets.
(define-key map "\C-c\C-d" 'sgml-delete-tag)
(define-key map "\C-c\^?" 'sgml-delete-tag)
(define-key map "\C-c?" 'sgml-tag-help)
+ (define-key map "\C-c/" 'sgml-close-tag)
(define-key map "\C-c8" 'sgml-name-8bit-mode)
(define-key map "\C-c\C-v" 'sgml-validate)
(when sgml-quick-keys
(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)
- (dotimes (i 96)
- (define-key map (vector (encode-char (+ i 32) 'latin-iso8859-1))
- 'sgml-maybe-name-self))
(let ((c 127)
(map (nth 1 map)))
(while (< (setq c (1+ c)) 256)
map)
"Keymap for SGML mode. See also `sgml-specials'.")
-
-(defvar sgml-mode-syntax-table
- (let ((table (copy-syntax-table text-mode-syntax-table)))
+(defun sgml-make-syntax-table (specials)
+ (let ((table (make-syntax-table text-mode-syntax-table)))
(modify-syntax-entry ?< "(>" table)
(modify-syntax-entry ?> ")<" table)
- (if (memq ?- sgml-specials)
+ (modify-syntax-entry ?: "_" table)
+ (modify-syntax-entry ?_ "_" table)
+ (modify-syntax-entry ?. "_" table)
+ (if (memq ?- specials)
(modify-syntax-entry ?- "_ 1234" table))
- (if (memq ?\" sgml-specials)
+ (if (memq ?\" specials)
(modify-syntax-entry ?\" "\"\"" table))
- (if (memq ?' sgml-specials)
+ (if (memq ?' specials)
(modify-syntax-entry ?\' "\"'" table))
- table)
+ table))
+
+(defvar sgml-mode-syntax-table (sgml-make-syntax-table sgml-specials)
"Syntax table used in SGML mode. See also `sgml-specials'.")
+(defconst sgml-tag-syntax-table
+ (let ((table (sgml-make-syntax-table '(?- ?\" ?\'))))
+ (dolist (char '(?\( ?\) ?\{ ?\} ?\[ ?\] ?$ ?% ?& ?* ?+ ?/))
+ (modify-syntax-entry char "." table))
+ table)
+ "Syntax table used to parse SGML tags.")
(defcustom sgml-name-8bit-mode nil
"*When non-nil, insert non-ASCII characters as named entities."
(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)))
"A table for mapping non-ASCII characters into SGML entity names.
Currently, only Latin-1 characters are supported.")
-
;; nsgmls is a free SGML parser in the SP suite available from
;; ftp.jclark.com and otherwise packaged for GNU systems.
;; Its error messages can be parsed by next-error.
(defvar sgml-saved-validate-command nil
"The command last used to validate in this buffer.")
-
;; I doubt that null end tags are used much for large elements,
;; so use a small distance here.
(defcustom sgml-slash-distance 1000
:type '(choice (const nil) integer)
:group 'sgml)
-(defconst sgml-start-tag-regex
- "<[A-Za-z]\\([-.A-Za-z0-9= \n\t]\\|\"[^\"]*\"\\|'[^']*'\\)*"
+(defconst sgml-namespace-re "[_[:alpha:]][-_.[:alnum:]]*")
+(defconst sgml-name-re "[_:[:alpha:]][-_.:[:alnum:]]*")
+(defconst sgml-tag-name-re (concat "<\\([!/?]?" sgml-name-re "\\)"))
+(defconst sgml-attrs-re "\\(?:[^\"'/><]\\|\"[^\"]*\"\\|'[^']*'\\)*")
+(defconst sgml-start-tag-regex (concat "<" sgml-name-re sgml-attrs-re)
"Regular expression that matches a non-empty start tag.
Any terminating `>' or `/' is not matched.")
+(defface sgml-namespace-face
+ '((t (:inherit font-lock-builtin-face)))
+ "`sgml-mode' face used to highlight the namespace part of identifiers.")
+(defvar sgml-namespace-face 'sgml-namespace-face)
;; internal
(defconst sgml-font-lock-keywords-1
- '(("<\\([!?][a-z][-.a-z0-9]*\\)" 1 font-lock-keyword-face)
- ("<\\(/?[a-z][-.a-z0-9]*\\)" 1 font-lock-function-name-face)
- ("[&%][a-z][-.a-z0-9]*;?" . font-lock-variable-name-face)))
+ `((,(concat "<\\([!?]" sgml-name-re "\\)") 1 font-lock-keyword-face)
+ ;; We could use the simpler "\\(" sgml-namespace-re ":\\)?" instead,
+ ;; but it would cause a bit more backtracking in the re-matcher.
+ (,(concat "</?\\(" sgml-namespace-re "\\)\\(?::\\(" sgml-name-re "\\)\\)?")
+ (1 (if (match-end 2) sgml-namespace-face font-lock-function-name-face))
+ (2 font-lock-function-name-face nil t))
+ ;; FIXME: this doesn't cover the variables using a default value.
+ (,(concat "\\(" sgml-namespace-re "\\)\\(?::\\("
+ sgml-name-re "\\)\\)?=[\"']")
+ (1 (if (match-end 2) sgml-namespace-face font-lock-variable-name-face))
+ (2 font-lock-variable-name-face nil t))
+ (,(concat "[&%]" sgml-name-re ";?") . font-lock-variable-name-face)))
(defconst sgml-font-lock-keywords-2
(append
(regexp-opt (mapcar 'car sgml-tag-face-alist) t)
"\\([ \t][^>]*\\)?>\\([^<]+\\)</\\1>")
'(3 (cdr (assoc (downcase (match-string 1))
- sgml-tag-face-alist))))))))
+ sgml-tag-face-alist)) prepend))))))
;; for font-lock, but must be defvar'ed after
;; sgml-font-lock-keywords-1 and sgml-font-lock-keywords-2 above
When `font-lock-maximum-decoration' is 1 this is always used for fontifying.
When more these are fontified together with `sgml-font-lock-keywords'.")
-
(defvar sgml-display-text ()
"Tag names as lowercase symbols, and display string when invisible.")
;; internal
(defvar sgml-tags-invisible nil)
-
(defcustom sgml-tag-alist
'(("![" ("ignore" t) ("include" t))
("!attlist")
((\"tag\" . TAGRULE)
...)
-TAGRULE is a list of optionally `t' (no endtag) or `\\n' (separate endtag by
-newlines) or a skeleton with `nil', `t' or `\\n' in place of the interactor
+TAGRULE is a list of optionally t (no endtag) or `\\n' (separate endtag by
+newlines) or a skeleton with nil, t or `\\n' in place of the interactor
followed by an ATTRIBUTERULE (for an always present attribute) or an
attribute alist.
((\"attribute\" . ATTRIBUTERULE)
...)
-ATTRIBUTERULE is a list of optionally `t' (no value when no input) followed by
+ATTRIBUTERULE is a list of optionally t (no value when no input) followed by
an optional alist of possible values."
:type '(repeat (cons (string :tag "Tag Name")
(repeat :tag "Tag Rule" sexp)))
(string :tag "Description")))
:group 'sgml)
-(defcustom sgml-xml nil
+(defcustom sgml-xml-mode nil
"*When non-nil, tag insertion functions will be XML-compliant.
If this variable is customized, the custom value is used always.
Otherwise, it is set to be buffer-local when the file has
a DOCTYPE or an XML declaration."
:type 'boolean
- :version "21.2"
+ :version "21.4"
:group 'sgml)
(defvar sgml-empty-tags nil
"List of tags whose !ELEMENT definition says EMPTY.")
+(defvar sgml-unclosed-tags nil
+ "List of tags whose !ELEMENT definition says the end-tag is optional.")
+
(defun sgml-xml-guess ()
"Guess whether the current buffer is XML."
(save-excursion
(goto-char (point-min))
- (cond ((or (string= "xml" (file-name-extension (or buffer-file-name "")))
- (looking-at "\\s-*<\\?xml"))
- (set (make-local-variable 'sgml-xml) t))
- ((re-search-forward
- (eval-when-compile
- (mapconcat 'identity
- '("<!DOCTYPE" "\\(\\w+\\)" "\\(\\w+\\)"
- "\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"")
- "\\s-+"))
- nil t)
- (let ((name (match-string 1))
- (pub (match-string 2))
- (id (match-string 3))
- (url (match-string 4)))
- (cond ((string= name "html")
- (set (make-local-variable 'sgml-xml)
- (not (null (string-match "XHTML" id)))))
- ((string-match "XML" id)
- (set (make-local-variable 'sgml-xml) t))))))))
+ (when (or (string= "xml" (file-name-extension (or buffer-file-name "")))
+ (looking-at "\\s-*<\\?xml")
+ (when (re-search-forward
+ (eval-when-compile
+ (mapconcat 'identity
+ '("<!DOCTYPE" "\\(\\w+\\)" "\\(\\w+\\)"
+ "\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"")
+ "\\s-+"))
+ nil t)
+ (string-match "X\\(HT\\)?ML" (match-string 3))))
+ (set (make-local-variable 'sgml-xml-mode) t))))
(defvar v2) ; free for skeleton
-(defun sgml-mode-common ()
- "Common code for setting up `sgml-mode' and derived modes."
+(defun sgml-comment-indent-new-line (&optional soft)
+ (let ((comment-start "-- ")
+ (comment-start-skip "\\(<!\\)?--[ \t]*")
+ (comment-end " --")
+ (comment-style 'plain))
+ (comment-indent-new-line soft)))
+
+(defun sgml-mode-facemenu-add-face-function (face end)
+ (if (setq face (cdr (assq face sgml-face-tag-alist)))
+ (progn
+ (setq face (funcall skeleton-transformation face))
+ (setq facemenu-end-add-face (concat "</" face ">"))
+ (concat "<" face ">"))
+ (error "Face not configured for %s mode" mode-name)))
+
+;;;###autoload
+(define-derived-mode sgml-mode text-mode "SGML"
+ "Major mode for editing SGML documents.
+Makes > match <.
+Keys <, &, SPC within <>, \", / and ' can be electric depending on
+`sgml-quick-keys'.
+
+An argument of N to a tag-inserting command means to wrap it around
+the next N words. In Transient Mark mode, when the mark is active,
+N defaults to -1, which means to wrap it around the current region.
+
+If you like upcased tags, put (setq sgml-transformation 'upcase) in
+your `.emacs' file.
+
+Use \\[sgml-validate] to validate your document with an SGML parser.
+
+Do \\[describe-variable] sgml- SPC to see available variables.
+Do \\[describe-key] on the following bindings to discover what they do.
+\\{sgml-mode-map}"
(make-local-variable 'sgml-saved-validate-command)
(make-local-variable 'facemenu-end-add-face)
;;(make-local-variable 'facemenu-remove-face-function)
- (set (make-local-variable 'indent-line-function) 'indent-relative-maybe)
;; A start or end tag by itself on a line separates a paragraph.
;; This is desirable because SGML discards a newline that appears
;; immediately after a start tag or immediately before an end tag.
- (set (make-local-variable 'paragraph-separate) "[ \t]*$\\|\
-\[ \t]*</?\\([A-Za-z]\\([-.A-Za-z0-9= \t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>$")
- (set (make-local-variable 'paragraph-start) "[ \t]*$\\|\
-\[ \t]*</?\\([A-Za-z]\\([-.A-Za-z0-9= \t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>")
+ (set (make-local-variable 'paragraph-start) (concat "[ \t]*$\\|\
+\[ \t]*</?\\(" sgml-name-re sgml-attrs-re "\\)?>"))
+ (set (make-local-variable 'paragraph-separate)
+ (concat paragraph-start "$"))
(set (make-local-variable 'adaptive-fill-regexp) "[ \t]*")
+ (set (make-local-variable 'indent-line-function) 'sgml-indent-line)
(set (make-local-variable 'comment-start) "<!-- ")
(set (make-local-variable 'comment-end) " -->")
(set (make-local-variable 'comment-indent-function) 'sgml-comment-indent)
- (set (make-local-variable 'skeleton-transformation) sgml-transformation)
+ (set (make-local-variable 'comment-line-break-function)
+ 'sgml-comment-indent-new-line)
(set (make-local-variable 'skeleton-further-elements)
'((completion-ignore-case t)))
(set (make-local-variable 'skeleton-end-hook)
. sgml-font-lock-syntactic-keywords)))
(set (make-local-variable 'facemenu-add-face-function)
'sgml-mode-facemenu-add-face-function)
- ;; `sgml-xml' not customized -- guess
- (unless (get 'sgml-xml 'saved-value) (sgml-xml-guess))
+ (sgml-xml-guess)
+ (if sgml-xml-mode
+ (setq mode-name "XML")
+ (set (make-local-variable 'skeleton-transformation) sgml-transformation))
;; This will allow existing comments within declarations to be
;; recognized.
(set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*")
- (set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?"))
-
-
-(defun sgml-mode-facemenu-add-face-function (face end)
- (if (setq face (cdr (assq face sgml-face-tag-alist)))
- (progn
- (setq face (funcall skeleton-transformation face))
- (setq facemenu-end-add-face (concat "</" face ">"))
- (concat "<" face ">"))
- (error "Face not configured for %s mode" mode-name)))
-
-
-;;;###autoload
-(define-derived-mode sgml-mode text-mode "SGML"
- "Major mode for editing SGML documents.
-Makes > match <. Makes / blink matching /.
-Keys <, &, SPC within <>, \" and ' can be electric depending on
-`sgml-quick-keys'.
-
-An argument of N to a tag-inserting command means to wrap it around
-the next N words. In Transient Mark mode, when the mark is active,
-N defaults to -1, which means to wrap it around the current region.
-
-If you like upcased tags, put (setq sgml-transformation 'upcase) in
-your `.emacs' file.
-
-Use \\[sgml-validate] to validate your document with an SGML parser.
-
-Do \\[describe-variable] sgml- SPC to see available variables.
-Do \\[describe-key] on the following bindings to discover what they do.
-\\{sgml-mode-map}"
- (sgml-mode-common)
- (when sgml-xml (setq mode-name "XML"))
- ;; Set `imenu-generic-expression' here, rather than in `sgml-mode-common',
- ;; because this definition probably is not useful in HTML mode.
+ (set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?")
+ ;; This definition probably is not useful in derived modes.
(set (make-local-variable 'imenu-generic-expression)
- "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\([A-Za-z][-A-Za-z.0-9]*\\)"))
+ (concat "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\("
+ sgml-name-re "\\)")))
+;; Some programs (such as Glade 2) generate XML which has
+;; -*- mode: xml -*-.
+;;;###autoload
+(defalias 'xml-mode 'sgml-mode)
(defun sgml-comment-indent ()
(if (looking-at "--") comment-column 0))
-
-
(defun sgml-slash (arg)
+ "Insert ARG slash characters.
+Behaves electrically if `sgml-quick-keys' is non-nil."
+ (interactive "p")
+ (cond
+ ((not (and (eq (char-before) ?<) (= arg 1)))
+ (sgml-slash-matching arg))
+ ((eq sgml-quick-keys 'indent)
+ (insert-char ?/ 1)
+ (indent-according-to-mode))
+ ((eq sgml-quick-keys 'close)
+ (delete-backward-char 1)
+ (sgml-close-tag))
+ (t
+ (sgml-slash-matching arg))))
+
+(defun sgml-slash-matching (arg)
"Insert `/' and display any previous matching `/'.
Two `/'s are treated as matching if the first `/' ends a net-enabling
start tag, and the second `/' is the corresponding null end tag."
(buffer-substring (line-beginning-position)
(1+ blinkpos)))))))))
-
+;; Why doesn't this use the iso-cvt table or, preferably, generate the
+;; inverse of the extensive table in the SGML Quail input method? -- fx
+;; I guess that's moot since it only works with Latin-1 anyhow.
(defun sgml-name-char (&optional char)
"Insert a symbolic character name according to `sgml-char-names'.
Non-ASCII chars may be inserted either with the meta key, as in M-SPC for
(delete-backward-char 1)
(insert char)
(undo-boundary)
- (delete-backward-char 1)
- (cond
- ((< char 256)
- (insert ?&
- (or (aref sgml-char-names char)
- (format "#%d" char))
- ?\;))
- ((aref sgml-char-names-table char)
- (insert ?& (aref sgml-char-names-table char) ?\;))
- ((memq (char-charset char) '(mule-unicode-0100-24ff
- mule-unicode-2500-33ff
- mule-unicode-e000-ffff))
- (insert (format "&#%d;" (encode-char char 'ucs))))
- (t
- (insert char))))
+ (sgml-namify-char))
+
+(defun sgml-namify-char ()
+ "Change the char before point into its `&name;' equivalent.
+Uses `sgml-char-names'."
+ (interactive)
+ (let* ((char (char-before))
+ (name
+ (cond
+ ((null char) (error "No char before point"))
+ ((< char 256) (or (aref sgml-char-names char) char))
+ ((aref sgml-char-names-table char))
+ ((encode-char char 'ucs)))))
+ (if (not name)
+ (error "Don't know the name of `%c'" char)
+ (delete-backward-char 1)
+ (insert (format (if (numberp name) "&#%d;" "&%s;") name)))))
(defun sgml-name-self ()
"Insert a symbolic character name according to `sgml-char-names'."
(self-insert-command 1)))
(defun sgml-name-8bit-mode ()
- "Toggle whether to insert named entities instead of non-ASCII characters."
+ "Toggle whether to insert named entities instead of non-ASCII characters.
+This only works for Latin-1 input."
(interactive)
(setq sgml-name-8bit-mode (not sgml-name-8bit-mode))
(message "sgml name entity mode is now %s"
;; inserted literally, one should obtain it as the return value of a
;; function, e.g. (identity "str").
+(defvar sgml-tag-last nil)
+(defvar sgml-tag-history nil)
(define-skeleton sgml-tag
"Prompt for a tag and insert it, optionally with attributes.
Completion and configuration are done according to `sgml-tag-alist'.
If you like tags and attributes in uppercase do \\[set-variable]
skeleton-transformation RET upcase RET, or put this in your `.emacs':
(setq sgml-transformation 'upcase)"
- (funcall skeleton-transformation
- (completing-read "Tag: " sgml-tag-alist))
+ (funcall (or skeleton-transformation 'identity)
+ (setq sgml-tag-last
+ (completing-read
+ (if (> (length sgml-tag-last) 0)
+ (format "Tag (default %s): " sgml-tag-last)
+ "Tag: ")
+ sgml-tag-alist nil nil nil 'sgml-tag-history sgml-tag-last)))
?< str |
(("") -1 '(undo-boundary) (identity "<")) | ; see comment above
`(("") '(setq v2 (sgml-attributes ,str t)) ?>
((string= "![" ,str)
(backward-char)
'(("") " [ " _ " ]]"))
- ((and (eq v2 t) sgml-xml (member ,str sgml-empty-tags))
+ ((and (eq v2 t) sgml-xml-mode (member ,str sgml-empty-tags))
'(("") -1 "/>"))
- ((or (and (eq v2 t) (not sgml-xml)) (string-match "^[/!?]" ,str))
+ ((or (and (eq v2 t) (not sgml-xml-mode)) (string-match "^[/!?]" ,str))
nil)
((symbolp v2)
;; Make sure we don't fall into an infinite loop.
(or (> (point) point)
(self-insert-command 1)))))
-
(defun sgml-tag-help (&optional tag)
"Display description of tag TAG. If TAG is omitted, use the tag at point."
(interactive)
(cdr (assoc (downcase (substring tag 1)) sgml-tag-help)))
"No description available")))
-
-(defun sgml-maybe-end-tag ()
- "Name self unless in position to end a tag."
- (interactive)
- (or (condition-case nil
- (save-excursion (up-list -1))
- (error
- (sgml-name-self)
- t))
- (condition-case nil
- (progn
- (save-excursion (up-list 1))
- (sgml-name-self))
- (error (self-insert-command 1)))))
-
+(defun sgml-maybe-end-tag (&optional arg)
+ "Name self unless in position to end a tag or a prefix ARG is given."
+ (interactive "P")
+ (if (or arg (eq (car (sgml-lexical-context)) 'tag))
+ (self-insert-command (prefix-numeric-value arg))
+ (sgml-name-self)))
(defun sgml-skip-tag-backward (arg)
"Skip to beginning of tag or matching opening tag if present.
With prefix argument ARG, repeat this ARG times."
(interactive "p")
+ ;; FIXME: use sgml-get-context or something similar.
(while (>= arg 1)
(search-backward "<" nil t)
(if (looking-at "</\\([^ \n\t>]+\\)")
;; end tag, skip any nested pairs
(let ((case-fold-search t)
- (re (concat "</?" (regexp-quote (match-string 1)))))
+ (re (concat "</?" (regexp-quote (match-string 1))
+ ;; Ignore empty tags like <foo/>.
+ "\\([^>]*[^/>]\\)?>")))
(while (and (re-search-backward re nil t)
(eq (char-after (1+ (point))) ?/))
(forward-char 1)
(sgml-skip-tag-backward 1))))
(setq arg (1- arg))))
-(defun sgml-skip-tag-forward (arg &optional return)
+(defun sgml-skip-tag-forward (arg)
"Skip to end of tag or matching closing tag if present.
With prefix argument ARG, repeat this ARG times.
Return t iff after a closing tag."
(interactive "p")
- (setq return t)
- (while (>= arg 1)
- (skip-chars-forward "^<>")
- (if (eq (following-char) ?>)
- (up-list -1))
- (if (looking-at "<\\([^/ \n\t>]+\\)")
- ;; start tag, skip any nested same pairs _and_ closing tag
- (let ((case-fold-search t)
- (re (concat "</?" (regexp-quote (match-string 1))))
- point close)
- (forward-list 1)
- (setq point (point))
- (while (and (re-search-forward re nil t)
- (not (setq close
- (eq (char-after (1+ (match-beginning 0))) ?/)))
- (not (up-list -1))
- (sgml-skip-tag-forward 1))
- (setq close nil))
- (if close
- (up-list 1)
- (goto-char point)
- (setq return)))
- (forward-list 1))
- (setq arg (1- arg)))
- return)
+ ;; FIXME: Use sgml-get-context or something similar.
+ ;; It currently might jump to an unrelated </P> if the <P>
+ ;; we're skipping has no matching </P>.
+ (let ((return t))
+ (with-syntax-table sgml-tag-syntax-table
+ (while (>= arg 1)
+ (skip-chars-forward "^<>")
+ (if (eq (following-char) ?>)
+ (up-list -1))
+ (if (looking-at "<\\([^/ \n\t>]+\\)\\([^>]*[^/>]\\)?>")
+ ;; start tag, skip any nested same pairs _and_ closing tag
+ (let ((case-fold-search t)
+ (re (concat "</?" (regexp-quote (match-string 1))
+ ;; Ignore empty tags like <foo/>.
+ "\\([^>]*[^/>]\\)?>"))
+ point close)
+ (forward-list 1)
+ (setq point (point))
+ ;; FIXME: This re-search-forward will mistakenly match
+ ;; tag-like text inside attributes.
+ (while (and (re-search-forward re nil t)
+ (not (setq close
+ (eq (char-after (1+ (match-beginning 0))) ?/)))
+ (goto-char (match-beginning 0))
+ (sgml-skip-tag-forward 1))
+ (setq close nil))
+ (unless close
+ (goto-char point)
+ (setq return nil)))
+ (forward-list 1))
+ (setq arg (1- arg)))
+ return)))
(defun sgml-delete-tag (arg)
+ ;; FIXME: Should be called sgml-kill-tag or should not touch the kill-ring.
"Delete tag on or after cursor, and matching closing or opening tag.
With prefix argument ARG, repeat this ARG times."
(interactive "p")
(goto-char close)
(kill-sexp 1))
(setq open (point))
- (sgml-skip-tag-forward 1)
- (backward-list)
- (forward-char)
- (if (eq (aref (sgml-beginning-of-tag) 0) ?/)
- (kill-sexp 1)))
+ (when (sgml-skip-tag-forward 1)
+ (kill-sexp -1)))
+ ;; Delete any resulting empty line. If we didn't kill-sexp,
+ ;; this *should* do nothing, because we're right after the tag.
+ (if (progn (forward-line 0) (looking-at "\\(?:[ \t]*$\\)\n?"))
+ (delete-region (match-beginning 0) (match-end 0)))
(goto-char open)
- (kill-sexp 1)))
+ (kill-sexp 1)
+ (if (progn (forward-line 0) (looking-at "\\(?:[ \t]*$\\)\n?"))
+ (delete-region (match-beginning 0) (match-end 0)))))
(setq arg (1- arg))))
+
\f
;; Put read-only last to enable setting this even when read-only enabled.
(or (get 'sgml-tag 'invisible)
(setplist 'sgml-tag
(append '(invisible t
- intangible t
point-entered sgml-point-entered
rear-nonsticky t
read-only t)
(if arg
(>= (prefix-numeric-value arg) 0)
(not sgml-tags-invisible)))
- (while (re-search-forward "<\\([!/?A-Za-z][-A-Za-z0-9]*\\)"
- nil t)
+ (while (re-search-forward sgml-tag-name-re nil t)
(setq string
(cdr (assq (intern-soft (downcase (match-string 1)))
sgml-display-text)))
(eq (preceding-char) ?>)))
(backward-list)
(forward-list)))))))
+
\f
(autoload 'compile-internal "compile")
(save-some-buffers (not compilation-ask-about-save) nil)
(compile-internal command "No more errors"))
+(defsubst sgml-at-indentation-p ()
+ "Return true if point is at the first non-whitespace character on the line."
+ (save-excursion
+ (skip-chars-backward " \t")
+ (bolp)))
+
+(defun sgml-lexical-context (&optional limit)
+ "Return the lexical context at point as (TYPE . START).
+START is the location of the start of the lexical element.
+TYPE is one of `string', `comment', `tag', `cdata', or `text'.
+
+Optional argument LIMIT is the position to start parsing from.
+If nil, start from a preceding tag at indentation."
+ (save-excursion
+ (let ((pos (point))
+ text-start state)
+ (if limit
+ (goto-char limit)
+ ;; Skip tags backwards until we find one at indentation
+ (while (and (ignore-errors (sgml-parse-tag-backward))
+ (not (sgml-at-indentation-p)))))
+ (with-syntax-table sgml-tag-syntax-table
+ (while (< (point) pos)
+ ;; When entering this loop we're inside text.
+ (setq text-start (point))
+ (skip-chars-forward "^<" pos)
+ (setq state
+ (cond
+ ((= (point) pos)
+ ;; We got to the end without seeing a tag.
+ nil)
+ ((looking-at "<!\\[[A-Z]+\\[")
+ ;; We've found a CDATA section or similar.
+ (let ((cdata-start (point)))
+ (unless (search-forward "]]>" pos 'move)
+ (list 0 nil nil 'cdata nil nil nil nil cdata-start))))
+ (t
+ ;; We've reached a tag. Parse it.
+ ;; FIXME: Handle net-enabling start-tags
+ (parse-partial-sexp (point) pos 0))))))
+ (cond
+ ((eq (nth 3 state) 'cdata) (cons 'cdata (nth 8 state)))
+ ((nth 3 state) (cons 'string (nth 8 state)))
+ ((nth 4 state) (cons 'comment (nth 8 state)))
+ ((and state (> (nth 0 state) 0)) (cons 'tag (nth 1 state)))
+ (t (cons 'text text-start))))))
(defun sgml-beginning-of-tag (&optional top-level)
"Skip to beginning of tag and return its name.
-If this can't be done, return t."
- (or (if top-level
- (condition-case nil
- (up-list -1)
- (error t))
- (>= (point)
- (if (search-backward "<" nil t)
- (save-excursion
- (forward-list)
- (point))
- 0)))
- (if (looking-at "<[!?/]?[[A-Za-z][A-Za-z0-9]*")
- (buffer-substring-no-properties
- (1+ (point))
- (match-end 0))
- t)))
+If this can't be done, return nil."
+ (let ((context (sgml-lexical-context)))
+ (if (eq (car context) 'tag)
+ (progn
+ (goto-char (cdr context))
+ (when (looking-at sgml-tag-name-re)
+ (match-string-no-properties 1)))
+ (if top-level nil
+ (when (not (eq (car context) 'text))
+ (goto-char (cdr context))
+ (sgml-beginning-of-tag t))))))
(defun sgml-value (alist)
- "Interactively insert value taken from attributerule ALIST.
+ "Interactively insert value taken from attribute-rule ALIST.
See `sgml-tag-alist' for info about attribute rules."
(setq alist (cdr alist))
(if (stringp (car alist))
(insert "=\"" (car alist) ?\")
- (if (and (eq (car alist) t) (not sgml-xml))
+ (if (and (eq (car alist) t) (not sgml-xml-mode))
(when (cdr alist)
(insert "=\"")
(setq alist (skeleton-read '(completing-read "Value: " (cdr alist))))
(insert ?\"))))
(defun sgml-quote (start end &optional unquotep)
- "Quote SGML text in region.
-With prefix argument, unquote the region."
- (interactive "r\np")
- (if (< start end)
- (goto-char start)
- (goto-char end)
- (setq end start))
- (if unquotep
- (while (re-search-forward "&\\(amp\\|\\(l\\|\\(g\\)\\)t\\);" end t)
- (replace-match (if (match-end 3) ">" (if (match-end 2) "<" "&"))))
- (while (re-search-forward "[&<>]" end t)
- (replace-match (cdr (assq (char-before) '((?& . "&")
- (?< . "<")
- (?> . ">"))))))))
+ "Quote SGML text in region START ... END.
+Only &, < and > are quoted, the rest is left untouched.
+With prefix argument UNQUOTEP, unquote the region."
+ (interactive "r\nP")
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (if unquotep
+ ;; FIXME: We should unquote other named character references as well.
+ (while (re-search-forward
+ "\\(&\\(amp\\|\\(l\\|\\(g\\)\\)t\\)\\)[][<>&;\n\t \"%!'(),/=?]"
+ nil t)
+ (replace-match (if (match-end 4) ">" (if (match-end 3) "<" "&")) t t
+ nil (if (eq (char-before (match-end 0)) ?\;) 0 1)))
+ (while (re-search-forward "[&<>]" nil t)
+ (replace-match (cdr (assq (char-before) '((?& . "&")
+ (?< . "<")
+ (?> . ">"))))
+ t t)))))
+
+(defun sgml-pretty-print (beg end)
+ "Simple-minded pretty printer for SGML.
+Re-indents the code and inserts newlines between BEG and END.
+You might want to turn on `auto-fill-mode' to get better results."
+ ;; TODO:
+ ;; - insert newline between some start-tag and text.
+ ;; - don't insert newline in front of some end-tags.
+ (interactive "r")
+ (save-excursion
+ (if (< beg end)
+ (goto-char beg)
+ (goto-char end)
+ (setq end beg)
+ (setq beg (point)))
+ ;; Don't use narrowing because it screws up auto-indent.
+ (setq end (copy-marker end t))
+ (with-syntax-table sgml-tag-syntax-table
+ (while (re-search-forward "<" end t)
+ (goto-char (match-beginning 0))
+ (unless (or ;;(looking-at "</")
+ (progn (skip-chars-backward " \t") (bolp)))
+ (reindent-then-newline-and-indent))
+ (forward-sexp 1)))
+ ;; (indent-region beg end)
+ ))
+
\f
+;; Parsing
+
+(defstruct (sgml-tag
+ (:constructor sgml-make-tag (type start end name)))
+ type start end name)
+
+(defsubst sgml-parse-tag-name ()
+ "Skip past a tag-name, and return the name."
+ (buffer-substring-no-properties
+ (point) (progn (skip-syntax-forward "w_") (point))))
+
+(defsubst sgml-looking-back-at (str)
+ "Return t if the test before point matches STR."
+ (let ((start (- (point) (length str))))
+ (and (>= start (point-min))
+ (equal str (buffer-substring-no-properties start (point))))))
+
+(defun sgml-parse-tag-backward (&optional limit)
+ "Parse an SGML tag backward, and return information about the tag.
+Assume that parsing starts from within a textual context.
+Leave point at the beginning of the tag."
+ (let (tag-type tag-start tag-end name)
+ (or (re-search-backward "[<>]" limit 'move)
+ (error "No tag found"))
+ (when (eq (char-after) ?<)
+ ;; Oops!! Looks like we were not in a textual context after all!.
+ ;; Let's try to recover.
+ (with-syntax-table sgml-tag-syntax-table
+ (forward-sexp)
+ (forward-char -1)))
+ (setq tag-end (1+ (point)))
+ (cond
+ ((sgml-looking-back-at "--") ; comment
+ (setq tag-type 'comment
+ tag-start (search-backward "<!--" nil t)))
+ ((sgml-looking-back-at "]]") ; cdata
+ (setq tag-type 'cdata
+ tag-start (re-search-backward "<!\\[[A-Z]+\\[" nil t)))
+ (t
+ (setq tag-start
+ (with-syntax-table sgml-tag-syntax-table
+ (goto-char tag-end)
+ (backward-sexp)
+ (point)))
+ (goto-char (1+ tag-start))
+ (case (char-after)
+ (?! ; declaration
+ (setq tag-type 'decl))
+ (?? ; processing-instruction
+ (setq tag-type 'pi))
+ (?/ ; close-tag
+ (forward-char 1)
+ (setq tag-type 'close
+ name (sgml-parse-tag-name)))
+ (?% ; JSP tags
+ (setq tag-type 'jsp))
+ (t ; open or empty tag
+ (setq tag-type 'open
+ name (sgml-parse-tag-name))
+ (if (or (eq ?/ (char-before (- tag-end 1)))
+ (sgml-empty-tag-p name))
+ (setq tag-type 'empty))))))
+ (goto-char tag-start)
+ (sgml-make-tag tag-type tag-start tag-end name)))
+
+(defun sgml-get-context (&optional until)
+ "Determine the context of the current position.
+By default, parse until we find a start-tag as the first thing on a line.
+If UNTIL is `empty', return even if the context is empty (i.e.
+we just skipped over some element and got to a beginning of line).
+
+The context is a list of tag-info structures. The last one is the tag
+immediately enclosing the current position.
+
+Point is assumed to be outside of any tag. If we discover that it's
+not the case, the first tag returned is the one inside which we are."
+ (let ((here (point))
+ (ignore nil)
+ (context nil)
+ tag-info)
+ ;; CONTEXT keeps track of the tag-stack
+ ;; IGNORE keeps track of the nesting level of point relative to the
+ ;; first (outermost) tag on the context. This is the list of
+ ;; enclosing start-tags we'll have to ignore.
+ (skip-chars-backward " \t\n") ; Make sure we're not at indentation.
+ (while
+ (and (not (eq until 'now))
+ (or ignore
+ (not (if until (eq until 'empty) context))
+ (not (sgml-at-indentation-p))
+ (and context
+ (/= (point) (sgml-tag-start (car context)))
+ (sgml-unclosed-tag-p (sgml-tag-name (car context)))))
+ (setq tag-info (ignore-errors (sgml-parse-tag-backward))))
+
+ ;; This tag may enclose things we thought were tags. If so,
+ ;; discard them.
+ (while (and context
+ (> (sgml-tag-end tag-info)
+ (sgml-tag-end (car context))))
+ (setq context (cdr context)))
+
+ (cond
+ ((> (sgml-tag-end tag-info) here)
+ ;; Oops!! Looks like we were not outside of any tag, after all.
+ (push tag-info context)
+ (setq until 'now))
+
+ ;; start-tag
+ ((eq (sgml-tag-type tag-info) 'open)
+ (cond
+ ((null ignore)
+ (if (and context
+ (sgml-unclosed-tag-p (sgml-tag-name tag-info))
+ (eq t (compare-strings
+ (sgml-tag-name tag-info) nil nil
+ (sgml-tag-name (car context)) nil nil t)))
+ ;; There was an implicit end-tag.
+ nil
+ (push tag-info context)))
+ ((eq t (compare-strings (sgml-tag-name tag-info) nil nil
+ (car ignore) nil nil t))
+ (setq ignore (cdr ignore)))
+ (t
+ ;; The open and close tags don't match.
+ (if (not sgml-xml-mode)
+ (unless (sgml-unclosed-tag-p (sgml-tag-name tag-info))
+ (message "Unclosed tag <%s>" (sgml-tag-name tag-info))
+ (let ((tmp ignore))
+ ;; We could just assume that the tag is simply not closed
+ ;; but it's a bad assumption when tags *are* closed but
+ ;; not properly nested.
+ (while (and (cdr tmp)
+ (not (eq t (compare-strings
+ (sgml-tag-name tag-info) nil nil
+ (cadr tmp) nil nil t))))
+ (setq tmp (cdr tmp)))
+ (if (cdr tmp) (setcdr tmp (cddr tmp)))))
+ (message "Unmatched tags <%s> and </%s>"
+ (sgml-tag-name tag-info) (pop ignore))))))
+
+ ;; end-tag
+ ((eq (sgml-tag-type tag-info) 'close)
+ (if (sgml-empty-tag-p (sgml-tag-name tag-info))
+ (message "Spurious </%s>: empty tag" (sgml-tag-name tag-info))
+ (push (sgml-tag-name tag-info) ignore)))
+ ))
+
+ ;; return context
+ context))
+
+(defun sgml-show-context (&optional full)
+ "Display the current context.
+If FULL is non-nil, parse back to the beginning of the buffer."
+ (interactive "P")
+ (with-output-to-temp-buffer "*XML Context*"
+ (save-excursion
+ (let ((context (sgml-get-context)))
+ (when full
+ (let ((more nil))
+ (while (setq more (sgml-get-context))
+ (setq context (nconc more context)))))
+ (pp context)))))
+
+\f
+;; Editing shortcuts
+
+(defun sgml-close-tag ()
+ "Close current element.
+Depending on context, inserts a matching close-tag, or closes
+the current start-tag or the current comment or the current cdata, ..."
+ (interactive)
+ (case (car (sgml-lexical-context))
+ (comment (insert " -->"))
+ (cdata (insert "]]>"))
+ (pi (insert " ?>"))
+ (jsp (insert " %>"))
+ (tag (insert " />"))
+ (text
+ (let ((context (save-excursion (sgml-get-context))))
+ (if context
+ (progn
+ (insert "</" (sgml-tag-name (car (last context))) ">")
+ (indent-according-to-mode)))))
+ (otherwise
+ (error "Nothing to close"))))
+
+(defun sgml-empty-tag-p (tag-name)
+ "Return non-nil if TAG-NAME is an implicitly empty tag."
+ (and (not sgml-xml-mode)
+ (member-ignore-case tag-name sgml-empty-tags)))
+
+(defun sgml-unclosed-tag-p (tag-name)
+ "Return non-nil if TAG-NAME is a tag for which an end-tag is optional."
+ (and (not sgml-xml-mode)
+ (member-ignore-case tag-name sgml-unclosed-tags)))
+
+(defun sgml-calculate-indent (&optional lcon)
+ "Calculate the column to which this line should be indented.
+LCON is the lexical context, if any."
+ (unless lcon (setq lcon (sgml-lexical-context)))
+
+ ;; Indent comment-start markers inside <!-- just like comment-end markers.
+ (if (and (eq (car lcon) 'tag)
+ (looking-at "--")
+ (save-excursion (goto-char (cdr lcon)) (looking-at "<!--")))
+ (setq lcon (cons 'comment (+ (cdr lcon) 2))))
+
+ (case (car lcon)
+
+ (string
+ ;; Go back to previous non-empty line.
+ (while (and (> (point) (cdr lcon))
+ (zerop (forward-line -1))
+ (looking-at "[ \t]*$")))
+ (if (> (point) (cdr lcon))
+ ;; Previous line is inside the string.
+ (current-indentation)
+ (goto-char (cdr lcon))
+ (1+ (current-column))))
+
+ (comment
+ (let ((mark (looking-at "--")))
+ ;; Go back to previous non-empty line.
+ (while (and (> (point) (cdr lcon))
+ (zerop (forward-line -1))
+ (or (looking-at "[ \t]*$")
+ (if mark (not (looking-at "[ \t]*--"))))))
+ (if (> (point) (cdr lcon))
+ ;; Previous line is inside the comment.
+ (skip-chars-forward " \t")
+ (goto-char (cdr lcon))
+ ;; Skip `<!' to get to the `--' with which we want to align.
+ (search-forward "--")
+ (goto-char (match-beginning 0)))
+ (when (and (not mark) (looking-at "--"))
+ (forward-char 2) (skip-chars-forward " \t"))
+ (current-column)))
+
+ ;; We don't know how to indent it. Let's be honest about it.
+ (cdata nil)
+
+ (tag
+ (goto-char (1+ (cdr lcon)))
+ (skip-chars-forward "^ \t\n") ;Skip tag name.
+ (skip-chars-forward " \t")
+ (if (not (eolp))
+ (current-column)
+ ;; This is the first attribute: indent.
+ (goto-char (1+ (cdr lcon)))
+ (+ (current-column) sgml-basic-offset)))
+
+ (text
+ (while (looking-at "</")
+ (forward-sexp 1)
+ (skip-chars-forward " \t"))
+ (let* ((here (point))
+ (unclosed (and ;; (not sgml-xml-mode)
+ (looking-at sgml-tag-name-re)
+ (member-ignore-case (match-string 1)
+ sgml-unclosed-tags)
+ (match-string 1)))
+ (context
+ ;; If possible, align on the previous non-empty text line.
+ ;; Otherwise, do a more serious parsing to find the
+ ;; tag(s) relative to which we should be indenting.
+ (if (and (not unclosed) (skip-chars-backward " \t")
+ (< (skip-chars-backward " \t\n") 0)
+ (back-to-indentation)
+ (> (point) (cdr lcon)))
+ nil
+ (goto-char here)
+ (nreverse (sgml-get-context (if unclosed nil 'empty)))))
+ (there (point)))
+ ;; Ignore previous unclosed start-tag in context.
+ (while (and context unclosed
+ (eq t (compare-strings
+ (sgml-tag-name (car context)) nil nil
+ unclosed nil nil t)))
+ (setq context (cdr context)))
+ ;; Indent to reflect nesting.
+ (cond
+ ;; If we were not in a text context after all, let's try again.
+ ((and context (> (sgml-tag-end (car context)) here))
+ (goto-char here)
+ (sgml-calculate-indent
+ (cons (if (memq (sgml-tag-type (car context)) '(comment cdata))
+ (sgml-tag-type (car context)) 'tag)
+ (sgml-tag-start (car context)))))
+ ;; Align on the first element after the nearest open-tag, if any.
+ ((and context
+ (goto-char (sgml-tag-end (car context)))
+ (skip-chars-forward " \t\n")
+ (< (point) here) (sgml-at-indentation-p))
+ (current-column))
+ (t
+ (goto-char there)
+ (+ (current-column)
+ (* sgml-basic-offset (length context)))))))
+
+ (otherwise
+ (error "Unrecognised context %s" (car lcon)))
+
+ ))
+
+(defun sgml-indent-line ()
+ "Indent the current line as SGML."
+ (interactive)
+ (let* ((savep (point))
+ (indent-col
+ (save-excursion
+ (back-to-indentation)
+ (if (>= (point) savep) (setq savep nil))
+ (sgml-calculate-indent))))
+ (if (null indent-col)
+ 'noindent
+ (if savep
+ (save-excursion (indent-line-to indent-col))
+ (indent-line-to indent-col)))))
+
+(defun sgml-guess-indent ()
+ "Guess an appropriate value for `sgml-basic-offset'.
+Base the guessed identation level on the first indented tag in the buffer.
+Add this to `sgml-mode-hook' for convenience."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward "^\\([ \t]+\\)<" 500 'noerror)
+ (progn
+ (set (make-local-variable 'sgml-basic-offset)
+ (1- (current-column)))
+ (message "Guessed sgml-basic-offset = %d"
+ sgml-basic-offset)
+ ))))
+
+(defun sgml-parse-dtd ()
+ "Simplistic parse of the current buffer as a DTD.
+Currently just returns (EMPTY-TAGS UNCLOSED-TAGS)."
+ (goto-char (point-min))
+ (let ((empty nil)
+ (unclosed nil))
+ (while (re-search-forward "<!ELEMENT[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+[-O][ \t\n]+\\([-O]\\)[ \t\n]+\\([^ \t\n]+\\)" nil t)
+ (cond
+ ((string= (match-string 3) "EMPTY")
+ (push (match-string-no-properties 1) empty))
+ ((string= (match-string 2) "O")
+ (push (match-string-no-properties 1) unclosed))))
+ (setq empty (sort (mapcar 'downcase empty) 'string<))
+ (setq unclosed (sort (mapcar 'downcase unclosed) 'string<))
+ (list empty unclosed)))
;;; HTML mode
map)
"Keymap for commands for use in HTML mode.")
-
(defvar html-face-tag-alist
'((bold . "b")
(italic . "i")
("var" . italic))
"Value of `sgml-tag-face-alist' for HTML mode.")
-
(defvar html-display-text
'((img . "[/]")
(hr . "----------")
(li . "o "))
"Value of `sgml-display-text' for HTML mode.")
-\f
+\f
;; should code exactly HTML 3 here when that is finished
(defvar html-tag-alist
(let* ((1-7 '(("1") ("2") ("3") ("4") ("5") ("6") ("7")))
("rev" ,@rel)
("title")))
(list '((nil \n ("List item: " "<li>" str
- (if sgml-xml "</li>") \n))))
+ (if sgml-xml-mode "</li>") \n))))
(cell `(t
,@align
("valign" ,@valign)
("dir" ,@list)
("font" nil "size" ("-1") ("+1") ("-2") ("+2") ,@1-7)
("form" (\n _ \n "<input type=\"submit\" value=\"\""
- (if sgml-xml "/>" ">"))
+ (if sgml-xml-mode "/>" ">"))
("action" ,@(cdr href)) ("method" ("get") ("post")))
("h1" ,@align)
("h2" ,@align)
("p" t ,@align)
("select" (nil \n
("Text: "
- "<option>" str (if sgml-xml "</option>") \n))
+ "<option>" str (if sgml-xml-mode "</option>") \n))
,name ("size" ,@1-9) ("multiple" t))
("table" (nil \n
((completing-read "Cell kind: " '(("td") ("th"))
nil t "t")
"<tr><" str ?> _
- (if sgml-xml (concat "<" str "></tr>")) \n))
+ (if sgml-xml-mode (concat "<" str "></tr>")) \n))
("border" t ,@1-9) ("width" "10") ("cellpadding"))
("td" ,@cell)
("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9))
("acronym")
("address")
("array" (nil \n
- ("Item: " "<item>" str (if sgml-xml "</item>") \n))
+ ("Item: " "<item>" str (if sgml-xml-mode "</item>") \n))
"align")
("au")
("b")
("blockquote" \n)
("body" \n ("background" ".gif") ("bgcolor" "#") ("text" "#")
("link" "#") ("alink" "#") ("vlink" "#"))
- ("box" (nil _ "<over>" _ (if sgml-xml "</over>")))
+ ("box" (nil _ "<over>" _ (if sgml-xml-mode "</over>")))
("br" t ("clear" ("left") ("right")))
("caption" ("valign" ("top") ("bottom")))
("center" \n)
("cite")
("code" \n)
- ("dd" ,(not sgml-xml))
+ ("dd" ,(not sgml-xml-mode))
("del")
("dfn")
("div")
("dl" (nil \n
( "Term: "
- "<dt>" str (if sgml-xml "</dt>")
- "<dd>" _ (if sgml-xml "</dd>") \n)))
- ("dt" (t _ (if sgml-xml "</dt>")
- "<dd>" (if sgml-xml "</dd>") \n))
+ "<dt>" str (if sgml-xml-mode "</dt>")
+ "<dd>" _ (if sgml-xml-mode "</dd>") \n)))
+ ("dt" (t _ (if sgml-xml-mode "</dt>")
+ "<dd>" (if sgml-xml-mode "</dd>") \n))
("em")
;("fn" "id" "fn") ; ???
("head" \n)
("isindex" t ("action") ("prompt"))
("kbd")
("lang")
- ("li" ,(not sgml-xml))
+ ("li" ,(not sgml-xml-mode))
("math" \n)
("nobr")
("option" t ("value") ("label") ("selected" t))
("var" . "Math variable face")
("wbr" . "Enable <br> within <nobr>"))
"*Value of `sgml-tag-help' for HTML mode.")
+
\f
;;;###autoload
(define-derived-mode html-mode sgml-mode "HTML"
outline-regexp "^.*<[Hh][1-6]\\>"
outline-heading-end-regexp "</[Hh][1-6]>"
outline-level (lambda ()
- (char-after (1- (match-end 0)))))
+ (char-before (match-end 0))))
(setq imenu-create-index-function 'html-imenu-index)
- (when sgml-xml (setq mode-name "XHTML"))
+ (when sgml-xml-mode (setq mode-name "XHTML"))
(set (make-local-variable 'sgml-empty-tags)
- '("br" "hr" "img" "input" "area" "link" "param" "col"
- "base" "meta" "basefont" "frame" "isindex" "wbr"))
+ ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd',
+ ;; plus manual addition of "wbr".
+ '("area" "base" "basefont" "br" "col" "frame" "hr" "img" "input"
+ "isindex" "link" "meta" "param" "wbr"))
+ (set (make-local-variable 'sgml-unclosed-tags)
+ ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd'.
+ '("body" "colgroup" "dd" "dt" "head" "html" "li" "option"
+ "p" "tbody" "td" "tfoot" "th" "thead" "tr"))
;; It's for the user to decide if it defeats it or not -stef
;; (make-local-variable 'imenu-sort-function)
;; (setq imenu-sort-function nil) ; sorting the menu defeats the purpose
)
-\f
+
(defvar html-imenu-regexp
"\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
"*A regular expression matching a head line to be added to the menu.
The third `match-string' will be the used in the menu.")
(defun html-imenu-index ()
- "Return an table of contents for an HTML buffer for use with Imenu."
+ "Return a table of contents for an HTML buffer for use with Imenu."
(let (toc-index)
(save-excursion
(goto-char (point-min))
toc-index))))
(nreverse toc-index)))
-(defun html-autoview-mode (&optional arg)
+(define-minor-mode html-autoview-mode
"Toggle automatic viewing via `browse-url-of-buffer' upon saving buffer.
With positive prefix ARG always turns viewing on, with negative ARG always off.
Can be used as a value for `html-mode-hook'."
- (interactive "P")
- (if (setq arg (if arg
- (< (prefix-numeric-value arg) 0)
- (and (boundp 'after-save-hook)
- (memq 'browse-url-of-buffer after-save-hook))))
- (setq after-save-hook (delq 'browse-url-of-buffer after-save-hook))
- (add-hook 'after-save-hook 'browse-url-of-buffer nil t))
- (message "Autoviewing turned %s."
- (if arg "off" "on")))
+ nil nil nil
+ :group 'sgml
+ (if html-autoview-mode
+ (add-hook 'after-save-hook 'browse-url-of-buffer nil t)
+ (remove-hook 'after-save-hook 'browse-url-of-buffer t)))
+
\f
(define-skeleton html-href-anchor
"HTML anchor tag with href attribute."
(define-skeleton html-horizontal-rule
"HTML horizontal rule tag."
nil
- (if sgml-xml "<hr/>" "<hr>") \n)
+ (if sgml-xml-mode "<hr/>" "<hr>") \n)
(define-skeleton html-image
"HTML image tag."
nil
"<img src=\"" _ "\""
- (if sgml-xml "/>" ">"))
+ (if sgml-xml-mode "/>" ">"))
(define-skeleton html-line
"HTML line break tag."
nil
- (if sgml-xml "<br/>" "<br>") \n)
+ (if sgml-xml-mode "<br/>" "<br>") \n)
(define-skeleton html-ordered-list
"HTML ordered list tags."
nil
"<ol>" \n
- "<li>" _ (if sgml-xml "</li>") \n
+ "<li>" _ (if sgml-xml-mode "</li>") \n
"</ol>")
(define-skeleton html-unordered-list
"HTML unordered list tags."
nil
"<ul>" \n
- "<li>" _ (if sgml-xml "</li>") \n
+ "<li>" _ (if sgml-xml-mode "</li>") \n
"</ul>")
(define-skeleton html-list-item
"HTML list item tag."
nil
(if (bolp) nil '\n)
- "<li>" _ (if sgml-xml "</li>"))
+ "<li>" _ (if sgml-xml-mode "</li>"))
(define-skeleton html-paragraph
"HTML paragraph tag."
nil
(if (bolp) nil ?\n)
- \n "<p>" _ (if sgml-xml "</p>"))
+ \n "<p>" _ (if sgml-xml-mode "</p>"))
(define-skeleton html-checkboxes
"Group of connected checkbox inputs."
"\" value=\"" str ?\"
(when (y-or-n-p "Set \"checked\" attribute? ")
(funcall skeleton-transformation " checked"))
- (if sgml-xml "/>" ">")
+ (if sgml-xml-mode "/>" ">")
(skeleton-read "Text: " (capitalize str))
(or v2 (setq v2 (if (y-or-n-p "Newline after text? ")
(funcall skeleton-transformation
- (if sgml-xml "<br/>" "<br>"))
+ (if sgml-xml-mode "<br/>" "<br>"))
"")))
\n))
"\" value=\"" str ?\"
(when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
(funcall skeleton-transformation " checked"))
- (if sgml-xml "/>" ">")
+ (if sgml-xml-mode "/>" ">")
(skeleton-read "Text: " (capitalize str))
(or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")
(funcall skeleton-transformation
- (if sgml-xml "<br/>" "<br>"))
+ (if sgml-xml-mode "<br/>" "<br>"))
"")))
\n))
-;;; version.el --- record version number of Emacs
+;;; version.el --- record version number of Emacs -*- no-byte-compile: t -*-
;;; Copyright (C) 1985, 1992, 1994, 1995, 1999, 2000, 2001
;;; Free Software Foundation, Inc.
;;; Code:
- (defconst emacs-version "21.3.50" "\
+ (defconst emacs-version "22.0.0" "\
Version numbers of this version of Emacs.")
(defconst emacs-major-version
Don't use this function in programs to choose actions according
to the system configuration; look at `system-configuration' instead."
(interactive "P")
- (let ((version-string
+ (let ((version-string
(format (if (not (interactive-p))
"GNU Emacs %s (%s%s%s)\n of %s on %s"
"GNU Emacs %s (%s%s%s) of %s on %s")
emacs-version
system-configuration
- (cond ((featurep 'motif)
+ (cond ((featurep 'motif)
(concat ", " (substring motif-version-string 4)))
((featurep 'x-toolkit) ", X toolkit")
(t ""))
"")
(format-time-string "%Y-%m-%d" emacs-build-time)
emacs-build-system)))
- (if here
+ (if here
(insert version-string)
(if (interactive-p)
(message "%s" version-string)
;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t;-*-
;;
-;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,1999,2000,01,02,2003 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
"Character position of the end of event if that exists, or nil."
(posn-point (event-end event)))
-(autoload 'pp-to-string "pp")
-(autoload 'Info-goto-node "info")
-
(defun widget-button-release-event-p (event)
"Non-nil if EVENT is a mouse-button-release event object."
(and (eventp event)
;; the gray colors defined for other displays cause black text on a black
;; background, at least on light-background TTYs.
(defface widget-field-face '((((type tty))
- (:background "yellow3"))
+ :background "yellow3"
+ :foreground "black")
(((class grayscale color)
(background light))
- (:background "gray85"))
+ :background "gray85")
(((class grayscale color)
(background dark))
- (:background "dim gray"))
+ :background "dim gray")
(t
- (:slant italic)))
+ :slant italic))
"Face used for editable fields."
:group 'widget-faces)
(defface widget-single-line-field-face '((((type tty))
- (:background "green3"))
+ :background "green3"
+ :foreground "black")
(((class grayscale color)
(background light))
- (:background "gray85"))
+ :background "gray85")
(((class grayscale color)
(background dark))
- (:background "dim gray"))
+ :background "dim gray")
(t
- (:slant italic)))
+ :slant italic))
"Face used for editable fields spanning only a single line."
:group 'widget-faces)
"Choose an item from a list.
First argument TITLE is the name of the list.
-Second argument ITEMS is an list whose members are either
+Second argument ITEMS is a list whose members are either
(NAME . VALUE), to indicate selectable items, or just strings to
indicate unselectable items.
Optional third argument EVENT is an input event.
;; Define SPC as a prefix char to get to this menu.
(define-key overriding-terminal-local-map " "
(setq map (make-sparse-keymap title)))
- (save-excursion
- (set-buffer (get-buffer-create " widget-choose"))
+ (with-current-buffer (get-buffer-create " widget-choose")
(erase-buffer)
(insert "Available choices:\n\n")
(while items
(while (not (or (and (>= char ?0) (< char next-digit))
(eq value 'keyboard-quit)))
;; Unread a SPC to lead to our new menu.
- (setq unread-command-events (cons ?\ unread-command-events))
+ (setq unread-command-events (cons ?\ unread-command-events))
(setq keys (read-key-sequence title))
(setq value
(lookup-key overriding-terminal-local-map keys t)
(nreverse result)))
;;; Widget text specifications.
-;;
+;;
;; These functions are for specifying text properties.
-(defvar widget-field-add-space t
+;; We can set it to nil now that get_local_map uses get_pos_property.
+(defconst widget-field-add-space nil
"Non-nil means add extra space at the end of editable text fields.
If you don't add the space, it will become impossible to edit a zero
size field.")
(rear-sticky
(or (not widget-field-add-space) (widget-get widget :size))))
(if (functionp help-echo)
- (setq help-echo 'widget-mouse-help))
+ (setq help-echo 'widget-mouse-help))
(when (= (char-before to) ?\n)
;; When the last character in the field is a newline, we want to
;; give it a `field' char-property of `boundary', which helps the
"Execute FORM without inheriting any text properties."
`(save-restriction
(let ((inhibit-read-only t)
- (inhibit-modification-hooks t)
- result)
- (insert "<>")
- (narrow-to-region (- (point) 2) (point))
- (goto-char (1+ (point-min)))
- (setq result (progn ,@form))
- (delete-region (point-min) (1+ (point-min)))
- (delete-region (1- (point-max)) (point-max))
- (goto-char (point-max))
- result)))
+ (inhibit-modification-hooks t))
+ (narrow-to-region (point) (point))
+ (prog1 (progn ,@form)
+ (goto-char (point-max))))))
(defface widget-inactive-face '((((class grayscale color)
(background dark))
:value-to-internal value)))
(defun widget-default-get (widget)
- "Extract the default value of WIDGET."
- (or (widget-get widget :value)
- (widget-apply widget :default-get)))
+ "Extract the default external value of WIDGET."
+ (widget-apply widget :value-to-external
+ (or (widget-get widget :value)
+ (widget-apply widget :default-get))))
(defun widget-match-inline (widget vals)
"In WIDGET, match the start of VALS."
respectively."
(let ((cur (point-min))
(widget nil)
- (parent nil)
(overlays (if buffer
- (save-excursion (set-buffer buffer) (overlay-lists))
+ (with-current-buffer buffer (overlay-lists))
(overlay-lists))))
(setq overlays (append (car overlays) (cdr overlays)))
(while (setq cur (pop overlays))
(defun widget-create-child (parent type)
"Create widget of TYPE."
- (let ((widget (copy-sequence type)))
+ (let ((widget (widget-copy type)))
(widget-put widget :parent parent)
(unless (widget-get widget :indent)
(widget-put widget :indent (+ (or (widget-get parent :indent) 0)
(defun widget-create-child-value (parent type value)
"Create widget of TYPE with value VALUE."
- (let ((widget (copy-sequence type)))
+ (let ((widget (widget-copy type)))
(widget-put widget :value (widget-apply widget :value-to-internal value))
(widget-put widget :parent parent)
(unless (widget-get widget :indent)
"Delete WIDGET."
(widget-apply widget :delete))
+(defun widget-copy (widget)
+ "Make a deep copy of WIDGET."
+ (widget-apply (copy-sequence widget) :copy))
+
(defun widget-convert (type &rest args)
"Convert TYPE to a widget without inserting it in the buffer.
The optional ARGS are additional keyword arguments."
(list type)
(copy-sequence type)))
(current widget)
+ done
(keys args))
;; First set the :args keyword.
(while (cdr current) ;Look in the type.
- (if (keywordp (car (cdr current)))
- (setq current (cdr (cdr current)))
+ (if (and (keywordp (cadr current))
+ ;; If the last element is a keyword,
+ ;; it is still the :args element,
+ ;; even though it is a keyword.
+ (cddr current))
+ (if (eq (cadr current) :args)
+ ;; If :args is explicitly specified, obey it.
+ (setq current nil)
+ ;; Some other irrelevant keyword.
+ (setq current (cdr (cdr current))))
(setcdr current (list :args (cdr current)))
(setq current nil)))
- (while args ;Look in the args.
- (if (keywordp (nth 0 args))
- (setq args (nthcdr 2 args))
- (widget-put widget :args args)
- (setq args nil)))
+ (while (and args (not done)) ;Look in ARGS.
+ (cond ((eq (car args) :args)
+ ;; Handle explicit specification of :args.
+ (setq args (cadr args)
+ done t))
+ ((keywordp (car args))
+ (setq args (cddr args)))
+ (t (setq done t))))
+ (when done
+ (widget-put widget :args args))
;; Then Convert the widget.
(setq type widget)
(while type
(if (widget-event-point event)
(let* ((pos (widget-event-point event))
(start (event-start event))
- (button (get-char-property
+ (button (get-char-property
pos 'button (and (windowp (posn-window start))
(window-buffer (posn-window start))))))
(if button
"Move point to the ARG next field or button.
ARG may be negative to move backward."
(or (bobp) (> arg 0) (backward-char))
- (let ((pos (point))
+ (let ((wrapped 0)
(number arg)
- (old (widget-tabable-at))
- new)
+ (old (widget-tabable-at)))
;; Forward.
(while (> arg 0)
(cond ((eobp)
- (goto-char (point-min)))
+ (goto-char (point-min))
+ (setq wrapped (1+ wrapped)))
(widget-use-overlay-change
(goto-char (next-overlay-change (point))))
(t
(forward-char 1)))
- (and (eq pos (point))
+ (and (= wrapped 2)
(eq arg number)
(error "No buttons or fields found"))
(let ((new (widget-tabable-at)))
;; Backward.
(while (< arg 0)
(cond ((bobp)
- (goto-char (point-max)))
+ (goto-char (point-max))
+ (setq wrapped (1+ wrapped)))
(widget-use-overlay-change
(goto-char (previous-overlay-change (point))))
(t
(backward-char 1)))
- (and (eq pos (point))
+ (and (= wrapped 2)
(eq arg number)
(error "No buttons or fields found"))
(let ((new (widget-tabable-at)))
;;; Setting up the buffer.
-(defvar widget-field-new nil)
-;; List of all newly created editable fields in the buffer.
+(defvar widget-field-new nil
+ "List of all newly created editable fields in the buffer.")
(make-variable-buffer-local 'widget-field-new)
-(defvar widget-field-list nil)
-;; List of all editable fields in the buffer.
+(defvar widget-field-list nil
+ "List of all editable fields in the buffer.")
(make-variable-buffer-local 'widget-field-list)
(defun widget-at (&optional pos)
found (widget-apply child :validate)))
found))
+(defun widget-types-copy (widget)
+ "Copy :args as widget types in WIDGET."
+ (widget-put widget :args (mapcar 'widget-copy (widget-get widget :args)))
+ widget)
+
;; Made defsubst to speed up face editor creation.
(defsubst widget-types-convert-widget (widget)
"Convert :args as widget types in WIDGET."
:indent nil
:offset 0
:format-handler 'widget-default-format-handler
- :button-face-get 'widget-default-button-face-get
- :sample-face-get 'widget-default-sample-face-get
+ :button-face-get 'widget-default-button-face-get
+ :sample-face-get 'widget-default-sample-face-get
:delete 'widget-default-delete
+ :copy 'identity
:value-set 'widget-default-value-set
:value-inline 'widget-default-value-inline
:default-get 'widget-default-default-get
(or (widget-get widget :always-active)
(and (not (widget-get widget :inactive))
(let ((parent (widget-get widget :parent)))
- (or (null parent)
+ (or (null parent)
(widget-apply parent :active))))))
(defun widget-default-deactivate (widget)
(defun widget-info-link-action (widget &optional event)
"Open the info node specified by WIDGET."
- (Info-goto-node (widget-value widget)))
+ (info (widget-value widget)))
;;; The `url-link' Widget.
(find-file (locate-library (widget-value widget))))
;;; The `emacs-commentary-link' Widget.
-
+
(define-widget 'emacs-commentary-link 'link
"A link to Commentary in an Emacs Lisp library file."
:action 'widget-emacs-commentary-link-action)
-
+
(defun widget-emacs-commentary-link-action (widget &optional event)
"Find the Commentary section of the Emacs file specified by WIDGET."
(finder-commentary (widget-value widget)))
(define-widget 'menu-choice 'default
"A menu of options."
:convert-widget 'widget-types-convert-widget
+ :copy 'widget-types-copy
:format "%[%t%]: %v"
:case-fold t
:tag "choice"
(when this-explicit
(widget-put widget :explicit-choice current)
(widget-put widget :explicit-choice-value (widget-get widget :value)))
- (widget-value-set
- widget (widget-apply current
- :value-to-external (widget-default-get current)))
+ (widget-value-set widget (widget-default-get current))
(widget-setup)
(widget-apply widget :notify widget event)))
(run-hook-with-args 'widget-edit-functions widget))
;; We could probably do the same job as the images using single
;; space characters in a boxed face with a stretch specification to
;; make them square.
- :on-glyph '(create-image "\000\066\076\034\076\066\000"
- 'xbm t :width 7 :height 7
+ :on-glyph '(create-image "\300\300\141\143\067\076\034\030"
+ 'xbm t :width 8 :height 8
:background "grey75" ; like default mode line
:foreground "black"
- :relief -3
+ :relief -2
:ascent 'center)
:off "[ ]"
- :off-glyph '(create-image (make-string 7 0)
- 'xbm t :width 7 :height 7
+ :off-glyph '(create-image (make-string 8 0)
+ 'xbm t :width 8 :height 8
:background "grey75"
:foreground "black"
- :relief 3
+ :relief -2
:ascent 'center)
:help-echo "Toggle this item."
:action 'widget-checkbox-action)
(define-widget 'checklist 'default
"A multiple choice widget."
:convert-widget 'widget-types-convert-widget
+ :copy 'widget-types-copy
:format "%v"
:offset 4
:entry-format "%b %v"
(define-widget 'radio-button-choice 'default
"Select one of multiple options."
:convert-widget 'widget-types-convert-widget
+ :copy 'widget-types-copy
:offset 4
:format "%v"
:entry-format "%b %v"
(define-widget 'editable-list 'default
"A variable list of widgets of the same type."
:convert-widget 'widget-types-convert-widget
+ :copy 'widget-types-copy
:offset 12
:format "%v%i\n"
:format-handler 'widget-editable-list-format-handler
(defun widget-editable-list-format-handler (widget escape)
;; We recognize the insert button.
-;;; (let ((widget-push-button-gui widget-editable-list-gui))
+ ;; (let ((widget-push-button-gui widget-editable-list-gui))
(cond ((eq escape ?i)
(and (widget-get widget :indent)
(insert-char ?\ (widget-get widget :indent)))
(widget-get widget :append-button-args)))
(t
(widget-default-format-handler widget escape)))
-;;; )
+ ;; )
)
(defun widget-editable-list-value-create (widget)
(defun widget-editable-list-entry-create (widget value conv)
;; Create a new entry to the list.
(let ((type (nth 0 (widget-get widget :args)))
-;;; (widget-push-button-gui widget-editable-list-gui)
+ ;; (widget-push-button-gui widget-editable-list-gui)
child delete insert)
(widget-specify-insert
(save-excursion
(setq child (widget-create-child-value
widget type value))
(setq child (widget-create-child-value
- widget type
- (widget-apply type :value-to-external
- (widget-default-get type))))))
+ widget type (widget-default-get type)))))
(t
(error "Unknown escape `%c'" escape)))))
- (widget-put widget
- :buttons (cons delete
- (cons insert
- (widget-get widget :buttons))))
+ (let ((buttons (widget-get widget :buttons)))
+ (if insert (push insert buttons))
+ (if delete (push delete buttons))
+ (widget-put widget :buttons buttons))
(let ((entry-from (point-min-marker))
(entry-to (point-max-marker)))
(set-marker-insertion-type entry-from t)
(set-marker-insertion-type entry-to nil)
(widget-put child :entry-from entry-from)
(widget-put child :entry-to entry-to)))
- (widget-put insert :widget child)
- (widget-put delete :widget child)
+ (if insert (widget-put insert :widget child))
+ (if delete (widget-put delete :widget child))
child))
;;; The `group' Widget.
(define-widget 'group 'default
"A widget which groups other widgets inside."
:convert-widget 'widget-types-convert-widget
+ :copy 'widget-types-copy
:format "%v"
:value-create 'widget-group-value-create
:value-delete 'widget-children-value-delete
(widget-create-child-and-convert
widget 'visibility
:help-echo "Show or hide rest of the documentation."
+ :on "Hide Rest"
:off "More"
:always-active t
:action 'widget-parent-action
: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")
-
+
- (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 ()
:match-alternatives '(integerp))
(define-widget 'number 'restricted-sexp
- "A floating point number."
+ "A number (floating point or integer)."
:tag "Number"
:value 0.0
- :type-error "This field should contain a number"
+ :type-error "This field should contain a number (floating point or integer)"
:match-alternatives '(numberp))
+(define-widget 'float 'restricted-sexp
+ "A floating point number."
+ :tag "Floating point number"
+ :value 0.0
+ :type-error "This field should contain a floating point number"
+ :match-alternatives '(floatp))
+
(define-widget 'character 'editable-field
"A character."
:tag "Character"
(aref value 0)
value))
:match (lambda (widget value)
- (char-valid-p value)))
+ (characterp value)))
(define-widget 'list 'group
"A Lisp list."
:value-to-internal (lambda (widget value)
(list (car value) (cdr value)))
:value-to-external (lambda (widget value)
- (cons (nth 0 value) (nth 1 value))))
+ (apply 'cons value)))
(defun widget-cons-match (widget value)
(and (consp value)
\f
;;; The `color' Widget.
-;; Fixme: match
+;; Fixme: match
(define-widget 'color 'editable-field
"Choose a color name (with sample)."
:format "%t: %v (%{sample%})\n"
(require 'facemenu) ; for facemenu-color-alist
(let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
(point)))
- (list (or facemenu-color-alist
- (mapcar 'list (defined-colors))))
+ (list (or facemenu-color-alist (defined-colors)))
(completion (try-completion prefix list)))
(cond ((eq completion t)
(message "Exact match."))
(prompt (concat tag ": "))
(value (widget-value widget))
(start (widget-field-start widget))
- (pos (cond ((< (point) start)
- 0)
- ((> (point) (+ start (length value)))
- (length value))
- (t
- (- (point) start))))
(answer (facemenu-read-color prompt)))
(unless (zerop (length answer))
(widget-value-set widget answer)
--# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001
++# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2003
# Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
define xsymbol
print (struct Lisp_Symbol *) ((((int) $) & $valmask) | gdb_data_seg_bits)
-output (char*)$->name->data
-echo \n
+xprintsym $
end
document xsymbol
Print the name and address of the symbol $.
define xchartable
print (struct Lisp_Char_Table *) (($ & $valmask) | gdb_data_seg_bits)
--printf "Purpose: "
- output (char*)&((struct Lisp_Symbol *) ((((int) $->purpose) & $valmask) | gdb_data_seg_bits))->name->data
- printf " %d extra slots", ($->size & 0x1ff) - 388
-output (char*)((struct Lisp_Symbol *) ((((int) $->purpose) & $valmask) | gdb_data_seg_bits))->name->data
+ printf " %d extra slots", ($->size & 0x1ff) - 68
echo \n
++printf "Purpose: "
++xprintsym $->purpose
end
document xchartable
Print the address of the char-table $, and its purpose.
This command assumes that $ is an Emacs Lisp char-table value.
end
-define xsubchartable
-print (struct Lisp_Sub_Char_Table *) (($ & $valmask) | gdb_data_seg_bits)
-end
-document xsubchartable
-Print the address of the sub-char-table $.
-This command assumes that $ is an Emacs Lisp sub-char-table value.
-end
-
define xboolvector
print (struct Lisp_Bool_Vector *) (($ & $valmask) | gdb_data_seg_bits)
output ($->size > 256) ? 0 : ($->data[0])@(($->size + 7)/ 8)
define xprintsym
set $sym = (struct Lisp_Symbol *) ((((int) $arg0) & $valmask) | gdb_data_seg_bits)
- output (char*)$sym->name->data
+ set $sym_name = ((struct Lisp_String *)(($sym->xname & $valmask) | gdb_data_seg_bits))
+ output ($sym_name->data[0])@($sym_name->size_byte < 0 ? $sym_name->size : $sym_name->size_byte)
echo \n
end
document xprintsym
Print argument as a symbol.
end
- Print a coding system whose id is the argument.
+ define xcoding
+ set $tmp = (struct Lisp_Hash_Table *) ((Vcoding_system_hash_table & $valmask) | gdb_data_seg_bits)
+ set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & $valmask) | gdb_data_seg_bits)
+ set $name = $tmp->contents[$arg0 * 2]
+ print $name
+ pr
+ print $tmp->contents[$arg0 * 2 + 1]
+ pr
+ end
+ document xcoding
- Print a charset name whose id is the argument.
-end
-
-define xcurbuf
- echo GAPSIZE:
- output current_buffer->text->gap_size
- echo \nGPT:
- output current_buffer->text->gpt
- echo /
- output current_buffer->text->gpt_byte
- echo \nZ:
- output current_buffer->text->z
- echo /
- output current_buffer->text->z_byte
- echo \nTEXT:
- if current_buffer->text->gpt > 1
- print current_buffer->text->beg[0]@80
- else
- print current_buffer->text->beg[current_buffer->text->gpt_byte-1]@80
- end
++ Print the name and attributes of coding system that has ID (argument).
+ end
+
+ define xcharset
+ set $tmp = (struct Lisp_Hash_Table *) ((Vcharset_hash_table & $valmask) | gdb_data_seg_bits)
+ set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & $valmask) | gdb_data_seg_bits)
+ p $tmp->contents[$arg0->hash_index * 2]
+ pr
+ end
+ document xcharset
++ Print the name of charset that has ID (argument).
+ end
+
define xbacktrace
set $bt = backtrace_list
- while $bt
+ while $bt
set $type = (enum Lisp_Type) ((*$bt->function >> gdb_valbits) & 0x7)
if $type == Lisp_Symbol
xprintsym *$bt->function
end
document xbacktrace
Print a backtrace of Lisp function calls from backtrace_list.
- Set a breakpoint at Fsignal and call this to see from where
+ Set a breakpoint at Fsignal and call this to see from where
an error was signaled.
end
--- /dev/null
--- /dev/null
++2003-07-09 Kenichi Handa <handa@m17n.org>
++
++ * coding.c (decode_coding_sjis): Check bytes more rigidly.
++
++2003-06-26 Kenichi Handa <handa@m17n.org>
++
++ * fileio.c (choose_write_coding_system): Return a decided coding
++ system.
++ (Fwrite_region): Set Vlast_coding_system_used to the return value
++ of choose_write_coding_system.
++
++2003-06-06 Kenichi Handa <handa@m17n.org>
++
++ * charset.c (Fset_charset_priority): Pay attention to duplicated
++ arguments.
++
++ * coding.c (QCcategory): New variable.
++ (syms_of_coding): Defsym it. Set all elements of
++ Vcoding_category_table and their symbol values.
++ (Fset_coding_system_priority): Doc fix. Update symbol qvalues of
++ coding-category-XXX, and coding-category-list.
++ (Fdefine_coding_system_internal): Add category in the plist.
++
++2003-06-05 Kenichi Handa <handa@m17n.org>
++
++ * callproc.c (Fcall_process): Handle carryover correctly.
++
++ * coding.c (decode_coding_iso_2022): Fix handling of invalid
++ bytes.
++ (raw_text_coding_system): Check NILP (coding_system).
++ (coding_inherit_eol_type): Check NILP (coding_system) and
++ NILP (parent).
++ (consume_chars): Fix for the case of raw-text.
++
++ * process.c (read_process_output): Handle carryover correctly.
++
++2003-06-02 Dave Love <fx@gnu.org>
++
++ * regex.c (re_search_2): Fix last change.
++
++2003-05-30 Kenichi Handa <handa@m17n.org>
++
++ * regex.c (GET_CHAR_BEFORE_2): Check multibyte, not
++ target_multibyte. Even in a unibyte case, return a converted
++ multibyte char.
++ (GET_CHAR_AFTER): New macro.
++ (PATFETCH): Translate via multibyte char.
++ (HANDLE_UNIBYTE_RANGE): Delete this macro.
++ (SETUP_MULTIBYTE_RANGE): New macro.
++ (regex_compile): Setup compiled code so that its multibyteness
++ matches that of a target. Fix the handling of "[X-YZ]" using
++ SETUP_MULTIBYTE_RANGE.
++ (analyse_first) <charset>: For filling fastmap for all multibyte
++ characters, don't check by BASE_LEADING_CODE_P.
++ (re_search_2): Don't check RE_TARGET_MULTIBYTE_P (bufp). It is
++ the same as RE_MULTIBYTE_P (bufp) now.
++ (mutually_exclusive_p): Check by (! multibyte ||
++ IS_REAL_ASCII (c)).
++ (TARGET_CHAR_AND_LENGTH): Delete this macro.
++ (TRANSLATE_VIA_MULTIBYTE): New macro.
++ (re_match_2_internal): Don't check RE_TARGET_MULTIBYTE_P (bufp).
++ It is the same as RE_MULTIBYTE_P (bufp) now.
++ <exactn>: Translate via multibyte.
++ <anychar>: Fetch a character by RE_STRING_CHAR_AND_LENGTH. Don't
++ translate it.
++ <charset, charset_not>: Fetch a character by
++ RE_STRING_CHAR_AND_LENGTH. Translate via multibyte.
++ <duplicate>: Call bcmp_translate with the last arg `multibyte'.
++ <wordbound, notwordbound, wordbeg, wordend, syntaxspec,
++ notsyntaxspec, categoryspec, notcategoryspec> Fetch a character
++ by GET_CHAR_AFTER.
++ (bcmp_translate): Likewise.
++
++ * search.c (compile_pattern): Check the member target_multibyte,
++ not the member multibyte of buf.
++
++ * lread.c (read1): While reading a string, set force_singlebyte
++ and force_multibyte correctly.
++
++ * charset.c (Fset_unibyte_charset): Fix setting up of
++ unibyte_to_multibyte_table.
++ (init_charset_once): Likewise.
++
++2003-05-29 Kenichi Handa <handa@m17n.org>
++
++ * coding.c (setup_coding_system): If coding has
++ post-read-conversion or pre-write-conversion, set
++ CODING_REQUIRE_DECODING_MASK and CODING_REQUIRE_ENCODING_MASK
++ respectively.
++ (decode_coding_gap): Run post-read-conversion if any.
++
++ * fileio.c (Finsert_file_contents): Even if we read into a
++ unibyte buffer, check if we must decode the result or not.
++
++2003-05-29 Kenichi Handa <handa@m17n.org>
++
++ * coding.c (make_conversion_work_buffer): Change the work buffer
++ name to the same one as that of Emacs 21.
++
++2003-05-28 Kenichi Handa <handa@m17n.org>
++
++ * coding.h (make_conversion_work_buffer): Prototype adjusted.
++ (code_conversion_restore): Don't extern it.
++
++ * coding.c (detected_mask): Delete unused variable.
++ (decode_coding_iso_2022): Pay attention to the byte sequence of
++ CTEXT extended segment, and retain those bytes as is.
++ (decode_coding_ccl): Delete unused variable `valids'.
++ (setup_coding_system): Delete unused variable `category'.
++ (consume_chars): Delete unused variable `category'. Make it work
++ for non-multibyte case.
++ (make_conversion_work_buffer): Argument changed.
++ (saved_coding): Delete unused variable.
++ (code_conversion_restore): Don't check saved_coding->destination.
++ (code_conversion_save): New function.
++ (decode_coding_gap, encode_coding_gap): Call code_conversion_save
++ instead of record_unwind_protect.
++ (decode_coding_object, encode_coding_object): Likewise. Recover
++ PT.
++ (detect_coding_system): Delete unused variable `mask'.
++ (Fdefine_coding_system_internal): Delete unsed vaiable id;
++
++ * fileio.c (kill_workbuf_unwind): New function.
++ (Finsert_file_contents): On replacing, call
++ make_conversion_work_buffer with correct args, and call
++ record_unwind_protect with the first arg kill_workbuf_unwind.
++
++ * lisp.h (Fgenerate_new_buffer_name): EXFUN it.
++
++2003-05-20 Kenichi Handa <handa@m17n.org>
++
++ * fontset.c (BASE_FONTSET_P): Check FONTSET_BASE, not
++ FONTSET_NAME.
++ (fontset_add): Fix for the case that TO is less than TO1.
++ (Ffontset_info): Don't use fallback fontset on checking the
++ default fontset.
++ (dump_fontset): New function for debugging.
++
++ * coding.c (Fdefine_coding_system_internal): Fix for the case that
++ coding_type is Qcharset.
++
++2003-05-07 Kenichi Handa <handa@m17n.org>
++
++ * chartab.c (map_sub_char_table): New argument DEFAULT_VAL.
++ (map_char_table): Don't inherit the value from the parent on
++ initializing VAL. Adjusted for the above change.
++
++2003-05-06 Kenichi Handa <handa@m17n.org>
++
++ * coding.c (Qsignature, Qendian): Delete these variables.
++ (syms_of_coding): Don't initialize them.
++ (CATEGORY_MASK_UTF_16_AUTO): New macro.
++ (detect_coding_utf_16): Add CATEGORY_MASK_UTF_16_AUTO in
++ detect_info->found.
++ (decode_coding_utf_16): Don't detect BOM here.
++ (encode_coding_utf_16): Produce BOM if CODING_UTF_16_BOM (coding)
++ is NOT utf_16_without_bom.
++ (setup_coding_system): For a coding system of type utf-16, check
++ if the attribute :endian is Qbig or not (not nil or not), and set
++ CODING_REQUIRE_DETECTION_MASK if BOM detection is required.
++ (detect_coding): If coding type is utf-16 and BOM detection is
++ required, detect it.
++ (Fdefine_coding_system_internal): For a coding system of type
++ utf-16, check if the attribute :endian is Qbig or not (not nil or
++ not).
++
++2003-05-06 Kenichi Handa <handa@m17n.org>
++
++ * coding.c (coding_set_source): Fix for the case that the current
++ buffer is different from coding->src_object.
++ (decode_coding_object): Don't use the conversion work buffer if
++ DST_OBJECT is a buffer.
++
++2003-05-04 Dave Love <fx@gnu.org>
++
++ * lread.c (read_emacs_mule_char) [len==2]: Index
++ emacs_mule_charset correctly.
++
++2003-02-16 Dave Love <fx@gnu.org>
++
++ * coding.c (Qbig5, Vbig5_coding_system, CATEGORY_MASK_BIG5)
++ (detect_coding_big5, decode_coding_big5, encode_coding_big5)
++ (Fdecode_big5_char, Fencode_big5_char): Deleted. (Big5 no longer
++ treated specially.)
++ (setup_coding_system, coding_category, CATEGORY_MASK_ANY)
++ (detected_mask): Remove Big5 bits.
++
++2003-04-09 Kenichi Handa <handa@m17n.org>
++
++ The following changes are to make the font rescaling facility
++ compatible with Emacs 21.
++
++ * xfaces.c (Vface_font_rescale_alist): Renamed from
++ Vface_resizing_fonts.
++ (struct font_name): Rename member resizing_ratio to rescale_ratio.
++ (font_rescale_ratio): Renamed from font_resizing_ratio.
++ (split_font_name): Set font->rescale_ratio.
++ (better_font_p): Pay attention to font->rescale_ratio.
++ (build_scalable_font_name): Likewise. Change RESX, and RESY
++ fields.
++ (syms_of_xfaces): Declare Vface_font_rescale_alist as a Lisp
++ variable.
++
++2003-03-28 Kenichi Handa <handa@m17n.org>
++
++ * coding.c (Qutf_16_be_nosig, Qutf_16_be, Qutf_16_le_nosig)
++ (Qutf_16_le): Remove these variables.
++ (syms_of_coding): Don't DEFSYM them.
++ (decode_coding_utf_16): Fix handling of BOM.
++ (encode_coding_utf_16): Fix handling of BOM.
++
++2003-03-14 Kenichi Handa <handa@m17n.org>
++
++ * fileio.c (Finsert_file_contents): On replacing, before decoding
++ the file into the work buffer, set point of the work buffer to the
++ end.
++
++2003-02-13 Dave Love <fx@gnu.org>
++
++ * coding.c (Fcheck_coding_systems_region): Fix type errors.
++
++2003-02-04 Dave Love <fx@gnu.org>
++
++ * xterm.c (XTread_socket): Check Lisp types for Vx_keysym_table
++ and fix C types.
++
++2003-01-31 Kenichi Handa <handa@m17n.org>
++
++ * xdisp.c (SKIP_GLYPHS): New macro.
++ (set_cursor_from_row): Pay attention to string display properties.
++
++ * category.c (copy_category_entry): Fix for the case that RANGE
++ is an integer.
++
++ * xterm.c (x_encode_char): Call ccl_driver with the last arg Qnil.
++
++ * w32term.c (w32_encode_char): Call ccl_driver with the last arg
++ Qnil.
++
++2003-01-30 Kenichi Handa <handa@m17n.org>
++
++ * charset.c (Fcharset_id_internal): New function.
++ (syms_of_charset): Defsubr it.
++
++ * coding.c (decode_coding_ccl, encode_coding_ccl): Call ccl_driver
++ with the last arg charset_list acquired from coding.
++ (Fdefine_coding_system_internal): For ccl-based coding system, fix
++ the attribute coding_attr_ccl_valids.
++
++ * coding.h (enum define_coding_ccl_arg_index): Set the first
++ member coding_arg_ccl_decoder to coding_arg_max.
++
++ * ccl.h (ccl_driver): Prototype adjusted.
++
++ * ccl.c (CCL_DECODE_CHAR, CCL_ENCODE_CHAR): New macros.
++ (ccl_driver): New arg CHARSET_LIST. Use the above macros instead
++ of DECODE_CAHR, ENCODE_CHAR, CHAR_CHARSET.
++ (Fccl_execute): Call ccl_driver with the last arg Qnil.
++ (Fccl_execute_on_string): Likewise.
++
++2003-01-11 Kenichi Handa <handa@m17n.org>
++
++ * charset.h (ENCODE_CHAR): If the method is SUBSET or SUPERSET,
++ call encode_char.
++
++ * charset.c (encode_char): Fix handling of methods SUBSET and
++ SUPERSET.
++
++ * xterm.c (x_new_fontset): Fix previous change.
++
++2003-01-10 Dave Love <fx@gnu.org>
++
++ * composite.c (syms_of_composite): Make composition_hash_table
++ weak.
++
++2003-01-10 Kenichi Handa <handa@m17n.org>
++
++ * dispextern.h (check_face_attributes, generate_ascii_font_name)
++ (font_name_registry): Don't extern them.
++ (split_font_name_into_vector, build_font_name_from_vector): Extern
++ them.
++
++ * fontset.h (Qfontset): Don't extern it.
++ (new_fontset_from_font_name): Extern it.
++
++ * fontset.c: Give 8 extra slots to fontset objects.
++ (Qfontset_info): New variable.
++ (syms_of_fontset): Defsym it.
++ (FONTSET_FALLBACK): New macro.
++ (fontset_face): Try also the default fontset.
++ (make_fontset): Realize a fallback fontset from the default
++ fontset.
++ (generate_ascii_font_name): Moved from xfaces.c. Rewritten by
++ using split_font_name_into_vector and build_font_name_from_vector.
++ (Fset_fontset_font): Access the elements of font_spec by enum
++ FONT_SPEC_INDEX. If font_spec is a string, extract the registry
++ name by using split_font_name_into_vector.
++ (Fnew_fontset): If no ASCII font is specified in FONTLIST,
++ generate a proper font name from the fontset name. Update
++ Vfontset_alias_alist.
++ (n_auto_fontsets): New variable.
++ (new_fontset_from_font_name): New function.
++ (Ffont_info): Store the information about fonts generated from the
++ default fontset in the first extra slot of the returned
++ char-table.
++
++ * xfaces.c (generate_ascii_font_name): Moved to fontset.c.
++ (font_name_registry): Function deleted.
++ (split_font_name_into_vector): New function.
++ (build_font_name_from_vector): New function.
++ (font_list): The argument REGISTRY is now a list of registry
++ names.
++ (choose_face_font): If we are choosing an ASCII font, and ATTRS
++ specifies an explicit font name, return the name as is. Make a
++ list of registy names.
++
++ * xfns.c (x_set_font, x_create_tip_frame): Adjusted to the change
++ of x_new_fontset.
++ (Fx_create_frame): Don't call x_new_fontset here. Just use
++ x_list_fonts to check the existence of fonts.
++
++ * xterm.h (x_new_fontset): Prototype adjusted.
++
++ * xterm.c (x_new_fontset): Change the arg FONTSETNAME to Lisp
++ string. Use new_fontset_from_font_name to create a fontset from a
++ font name.
++
++2003-01-07 Dave Love <fx@gnu.org>
++
++ * Makefile.in: Fix some dependencies.
++
++ * keymap.c (Fapropos_internal): Don't gcpro apropos_predicate but
++ set it to nil before returning.
++
++ * composite.c (update_compositions): Fix type error.
++
++ * syntax.c (skip_chars, skip_syntaxes): Fix type errors.
++
++2003-01-07 Kenichi Handa <handa@etl.go.jp>
++
++ * xterm.c (x_new_font): Optimize for the case that the font is
++ already set for the frame.
++
++2003-01-06 Kenichi Handa <handa@m17n.org>
++
++ * chartab.c (char_table_ascii): Check if the char table contents
++ is sub-char-table or not.
++ (char_table_set): Fix argument to char_table_ascii.
++ (char_table_set_range): Likewise.
++
++ * coding.c (CATEGORY_MASK_RAW_TEXT): New macro.
++ (detect_coding_utf_8, detect_coding_utf_16)
++ (detect_coding_emacs_mule, detect_coding_iso_2022)
++ (detect_coding_sjis, detect_coding_big5)
++ (detect_coding_ccl, detect_coding_charset): Change argument MASK
++ to DETECT_INFO. Update DETECT_INFO and return 1 if the byte
++ sequence is valid in this coding system. Callers changed.
++ (MAX_ANNOTATION_LENGTH): New macro.
++ (ADD_ANNOTATION_DATA): New macro.
++ (ADD_COMPOSITION_DATA): Argument changed. Callers changed. Call
++ ADD_ANNOTATION_DATA. The format of annotation data changed.
++ (ADD_CHARSET_DATA): New macro.
++ (emacs_mule_char): New argument ID. Callers changed.
++ (decode_coding_emacs_mule, decode_coding_iso_2022)
++ (decode_coding_sjis, decode_coding_big5, decode_coding_charset):
++ Produce charset annotation data in coding->charbuf.
++ (encode_coding_emacs_mule, encode_coding_iso_2022): Pay attention
++ to charset annotation data in coding->charbuf.
++ (setup_coding_system): Add CODING_ANNOTATE_CHARSET_MASK
++ coding->common_flags if the coding system is iso-2022 based and
++ uses designation.
++ (produce_composition): Adjusted for the new annotation data
++ format.
++ (produce_charset): New function.
++ (produce_annotation): Handle charset annotation.
++ (handle_composition_annotation, handle_charset_annotation): New
++ functions.
++ (consume_chars): Handle charset annotation. Utilize the above two
++ functions.
++ (encode_coding_object): If SRC_OBJECT and DST_OBJECT are the same
++ buffer, get the deleted text as a string and set
++ coding->src_object to that string.
++ (detect_coding, detect_coding_system): Use the new struct
++ coding_detection_info.
++
++ * coding.h (struct coding_detection_info): New structure.
++ (struct coding_system): Prototype of the member `detector'
++ adjusted.
++ (CODING_ANNOTATE_CHARSET_MASK): New macro.
++
++2003-01-06 Kenichi Handa <handa@etl.go.jp>
++
++ * insdel.c (insert_from_gap): Fix argument to offset_intervals.
++
++2003-01-03 Dave Love <fx@gnu.org>
++
++ * keymap.c (apropos_predicate, apropos_accumulate): Declare
++ static.
++ (Fapropos_internal): Don't gcpro apropos_accumulate. Set result
++ to new local and nullify apropos_accumulate before returning.
++ (syms_of_keymap): Staticpro and initialize apropos_accumulate.
++
++2002-12-05 Kenichi Handa <handa@m17n.org>
++
++ * charset.c (Fdefine_charset_internal): Setup charset.fast_map
++ correctly.
++
++2002-11-26 Dave Love <fx@gnu.org>
++
++ * fns.c (Flanginfo): Call synchronize_system_time_locale.
++
++2002-11-07 Kenichi Handa <handa@m17n.org>
++
++ The following changes are to make character composition happen
++ automatically on displaying.
++
++ * Makefile.in (lisp, shortlisp): Add composite.elc
++
++ * composite.h (Qauto_composed, Vauto_composition_function,
++ Qauto_composition_function): Extern them.
++
++ * composite.c (Vcomposition_function_table,
++ Qcomposition_function_table): Delete variables.
++ (Qauto_composed, Vauto_composition_function,
++ Qauto_composition_function): New variables.
++ (run_composition_function): Don't call
++ compose-chars-after-function.
++ (update_compositions): Clear `auto-composed' text property.
++ (compose_chars_in_text): Delete this function.
++ (syms_of_composite): Staticpro Qauto_composed and
++ Qauto_composition_function. Declare Vauto_composition_function as
++ a Lisp variable.
++
++ * dispextern.h (enum prop_idx): Add member AUTO_COMPOSED_PROP_IDX.
++
++ * xdisp.c (it_props): Add an entry for Qauto_composed.
++ (handle_auto_composed_prop): New function.
++
++ * xselect.c (selection_data_to_lisp_data): Don't call
++ compose_chars_in_text.
++
++2002-11-06 Dave Love <fx@gnu.org>
++
++ * keyboard.c (read_char): Modify checking around use of
++ Vkeyboard_translate_table.
++
++ * xterm.c (XTread_socket): Check Lisp types for Vx_keysym_table
++ and fix C types.
++
++2002-11-06 Kenichi Handa <handa@m17n.org>
++
++ * coding.c (decode_coding_utf_8): When eol_type is Qdos, handle
++ the case that the last byte is '\r' correctly.
++ (decode_coding_emacs_mule): Likewise.
++ (decode_coding_iso_2022): Likewise.
++ (decode_coding_sjis): Likewise.
++ (decode_coding_big5): Likewise.
++ (decode_coding_charset): Likewise.
++ (produce_chars): Likewise.
++ (decode_coding): Flushing out the unprocessed data correctly.
++ (decode_coding_gap): Set CODING_MODE_LAST_BLOCK bit of
++ coding->mode.
++
++2002-10-31 Dave Love <fx@gnu.org>
++
++ * xterm.c (XTread_socket): Fix changes for defined keysyms. Add
++ XK_ISO... case.
++ (xaw_scroll_callback): Revert last change.
++
++2002-10-30 Kenichi Handa <handa@m17n.org>
++
++ * charset.c (Fset_charset_priority): Update
++ Viso_2022_charset_list.
++
++2002-10-29 Kenichi Handa <handa@m17n.org>
++
++ * xfaces.c (Vface_resizing_fonts): New variable.
++ (struct font_name): New member `resizing_ratio'.
++ (font_resizing_ratio): New function.
++ (split_font_name): Set font->resizing_ratio.
++ (better_font_p): Pay attention to font->resizing_ratio.
++ (build_scalable_font_name): Likewise. Don't change POINT_SIZE,
++ RESX, and RESY fields.
++ (try_alternative_families): Try scalable fonts if
++ Vscalable_fonts_allowed is not Qt.
++ (syms_of_xfaces): Declare Vface_resizing_fonts as a Lisp variable.
++
++2002-10-29 Dave Love <fx@gnu.org>
++
++ * xterm.c (xaw_scroll_callback): Cast correctly.
++
++2002-10-28 Dave Love <fx@gnu.org>
++
++ * keyboard.c (lispy_accent_codes, lispy_accent_keys): Extend.
++ (lispy_kana_keys): Comment out.
++ (make_lispy_event) [XK_kana_A]: Comment out.
++
++ * xterm.c (xaw_scroll_callback): Cast call_data.
++ (XTread_socket): Deal with ASCII keysyms.
++ (syms_of_xterm) <Vx_keysym_table>: Fix args of make_hash_table.
++
++2002-10-27 Dave Love <fx@gnu.org>
++
++ * xterm.c (Vx_keysym_table): New.
++ (syms_of_xterm): Initialize it.
++ (XTread_socket): Use it.
++ From head: Eliminate incorrect optimization that tried to avoid
++ decoding the output of X*LookupString.
++ (x_get_font_repertory): Delete charset declaration.
++
++2002-10-16 Kenichi Handa <handa@m17n.org>
++
++ * coding.c (detect_coding): Fix previous change.
++ (detect_coding_charset): If only ASCII bytes are found, return 0.
++ (detect_coding_system): Fix previous change.
++ (Fdefine_coding_system_internal): Setup CODING_ATTR_ASCII_COMPAT
++ (attrs) correctly.
++
++2002-10-15 Dave Love <fx@gnu.org>
++
++ * coding.c (Fcheck_coding_system): Doc fix.
++
++ * editfns.c (Finsert_byte): Return a proper value.
++
++2002-10-14 Kenichi Handa <handa@etl.go.jp>
++
++ * coding.c (decode_coding): Fix args to translate_chars. Pay
++ attention to Vstandard_translation_table_for_decode.
++ (encode_coding): Fix args to translate_chars. Pay attention to
++ Vstandard_translation_table_for_encode.
++
++ * data.c (Faset): Check NEWELT by ASCII_CHAR_P, not by
++ SINGLE_BYTE_CHAR_P.
++
++ * editfns.c (general_insert_function): Check VAL by ASCII_CHAR_P,
++ not by SINGLE_BYTE_CHAR_P.
++
++ * fns.c (concat): Check CH by ASCII_CHAR_P, not by
++ SINGLE_BYTE_CHAR_P.
++
++ * insdel.c (copy_text): Check C by ASCII_CHAR_P, not by
++ SINGLE_BYTE_CHAR_P.
++
++ * keymap.c (Ftext_char_description): Check C by ASCII_CHAR_P, not
++ by SINGLE_BYTE_CHAR_P.
++
++ * search.c (Freplace_match): Check C by ASCII_CHAR_P, not by
++ SINGLE_BYTE_CHAR_P.
++
++2002-10-14 Dave Love <fx@gnu.org>
++
++ * fns.c (Fstring_as_multibyte, Fstring_to_multibyte): Doc fix.
++
++2002-10-10 Dave Love <fx@gnu.org>
++
++ * fns.c (Flanginfo): Fix typo.
++
++ * unexelf.c (unexec): Make last change conditional on Irix 6.5.
++
++2002-10-10 Kenichi Handa <handa@m17n.org>
++
++ * coding.c (detect_coding_utf_8): Check incomplete byte sequence.
++ Don't update *mask when correctly detected.
++ (detect_coding_utf_16): Likewise.
++ (detect_coding_emacs_mule): Likewise.
++ (detect_coding_iso_2022): Likewise.
++ (detect_coding_sjis): Likewise.
++ (detect_coding_big5): Likewise.
++ (detect_coding_ccl): Likewise.
++ (decode_coding_sjis): Fix decoding of katakana-jisx0201.
++ (detect_eol): Delete the argument CODING, and add the argument
++ CATEGORY.
++ (detect_coding): Adjusted for the changes above.
++ (detect_coding_system): Likewise.
++
++2002-10-09 Kenichi Handa <handa@m17n.org>
++
++ * character.c (char_string): Renamed from
++ char_string_with_unification. Pay attention to
++ CHAR_MODIFIER_MASK.
++ (string_char): Renamed from string_char.
++
++ * character.h (CHAR_STRING): Call char_string if C is greater than
++ MAX_3_BYTE_CHAR.
++ (CHAR_STRING_ADVANCE): Likewise.
++ (STRING_CHAR): Call string_char instead of
++ string_char_with_unification.
++ (STRING_CHAR_AND_LENGTH): Likewise.
++ (STRING_CHAR_ADVANCE): Likewise.
++
++2002-10-09 Dave Love <fx@gnu.org>
++
++ * coding.c (decode_coding_utf_8): Treat surrogates as invalid.
++
++2002-10-07 Kenichi Handa <handa@m17n.org>
++
++ * keymap.c (push_key_description): Pay attention to
++ force_multibyte.
++
++ * regex.c (re_search_2): Fix for the case of unibyte buffer.
++
++2002-10-06 Dave Love <fx@gnu.org>
++
++ * charset.c (define_charset_internal): Rename `supprementary'.
++
++ * Makefile.in (lisp, shortlisp): Remove latin-N.
++
++2002-10-05 Dave Love <fx@gnu.org>
++
++ * xfns.c (x_window, x_window): Use use_xim.
++
++ * xterm.c (use_xim): Initialize.
++ (xim_open_dpy, xim_initialize, xim_close_dpy): Use use_xim.
++ (x_term_init): Maybe set use_xim.
++
++ * xterm.h (use_xim) [HAVE_X_I18N]: Declare.
++
++2002-10-01 Kenichi Handa <handa@m17n.org>
++
++ * search.c (search_buffer): Fix case-fold-search of multibyte
++ characters.
++ (boyer_moore): Rename the last argument to char_high_bits.
++
++2002-09-27 Kenichi Handa <handa@etl.go.jp>
++
++ * xdisp.c (display_string): Fix for the case of zero width glyph.
++
++ * xfns.c (x_set_font): Change the error message of the case that
++ x_new_fontset returns Qt.
++
++ * xfaces.c (set_lface_from_font_name): Reject the default fontset.
++ (Finternal_set_lisp_face_attribute): Use signal_error for the
++ error of invalid fontset.
++
++ * xterm.c (x_new_fontset): If FONTSETNAME specifies the default
++ fontset, return Qt.
++
++2002-09-19 Kenichi Handa <handa@etl.go.jp>
++
++ * regex.c (re_search_2): Fix previous change.
++
++2002-09-18 Kenichi Handa <handa@etl.go.jp>
++
++ * syntax.c (skip_syntaxes): Fix previous change.
++
++2002-09-13 Kenichi Handa <handa@etl.go.jp>
++
++ * syntax.c (skip_chars): Fix previous change.
++ (skip_syntaxes): Fix previous change.
++
++2002-09-06 Dave Love <fx@gnu.org>
++
++ * config.in: Restore it.
++
++2002-09-05 Dave Love <fx@gnu.org>
++
++ * config.in: Removed (now auto-generated).
++
++ * s/usg5-4.h: Fix last change.
++
++ * unexelf.c (unexec): Make .got handling not SGI-specific.
++
++ * syntax.c (syms_of_syntax) <multibyte-syntax-as-symbol>: Doc fix.
++
++ * regex.c: Use `ifdef HAVE_ALLOCA_H', not `if HAVE_ALLOCA_H'.
++
++ * keyboard.c (read_key_sequence): Fix type error.
++
++ * buffer.c (Fset_buffer_multibyte, Fset_buffer_multibyte): Fix
++ type error.
++
++ * fontset.c (fontset_add): Return Lisp_Object.
++
++2002-09-03 Dave Love <fx@gnu.org>
++
++ * charset.h (charset_ordered_list_tick): Declare extern.
++
++2002-09-03 Kenichi Handa <handa@etl.go.jp>
++
++ The following changes (and some of 2002-08-20 changes of mine) are
++ for handling syntax, category, and case conversion for unibyte
++ characters by converting them to multibyte on the fly. With these
++ changes, we don't have to setup syntax and case tables for unibyte
++ characters in each language environment.
++
++ * abbrev.c (Fexpand_abbrev): Convert a unibyte character to
++ multibyte if necessary.
++
++ * bytecode.c (Fbyte_code): Likewise.
++
++ * character.h (LEADING_CODE_LATIN_1_MIN)
++ (LEADING_CODE_LATIN_1_MAX): New macros.
++ (unibyte_to_multibyte_table): Extern it.
++ (unibyte_char_to_multibyte): New macro.
++ (MAKE_CHAR_MULTIBYTE): Use unibyte_to_multibyte_table.
++ (CHAR_LEADING_CODE): New macro.
++ (FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE): New macro.
++
++ * character.c (unibyte_to_multibyte_table): New variable.
++ (unibyte_char_to_multibyte): Move to character.h and defined as
++ macro.
++ (multibyte_char_to_unibyte): If C is an eight-bit character,
++ convert it to the corresponding byte value.
++
++ * charset.c (Fset_unibyte_charset): If the dimension of CHARSET is
++ not 1, singals an error. Update the elements of
++ unibyte_to_multibyte_table.
++ (init_charset_once): Initialize unibyte_to_multibyte_table.
++ (syms_of_charset): Define the charset `iso-8859-1'.
++
++ * casefiddle.c (casify_object): Fix previous change.
++
++ * cmds.c (internal_self_insert): In a multibyte buffer, insert C
++ as is without converting it to unibyte. In a unibyte buffer,
++ convert C to multibyte before checking the syntax.
++
++ * lisp.h (unibyte_char_to_multibyte): Extern deleted.
++
++ * minibuf.c (Fminibuffer_complete_word): Use the macro
++ FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE.
++
++ * regex.h (struct re_pattern_buffer): New member target_multibyte.
++
++ * regex.c (RE_TARGET_MULTIBYTE_P): New macro.
++ (GET_CHAR_BEFORE_2): Check target_multibyte, not multibyte. If
++ that is zero, convert an eight-bit char to multibyte.
++ (MAKE_CHAR_MULTIBYTE, CHAR_LEADING_CODE): New dummy new macros for
++ non-emacs case.
++ (PATFETCH): Convert an eight-bit char to multibyte.
++ (HANDLE_UNIBYTE_RANGE): New macro.
++ (regex_compile): Setup the compiled pattern for multibyte chars
++ even if the given regex string is unibyte. Use PATFETCH_RAW
++ instead of PATFETCH in many places. To handle `charset'
++ specification of unibyte, call HANDLE_UNIBYTE_RANGE. Use bitmap
++ only for ASCII chars.
++ (analyse_first) <exactn>: Simplified because the compiled pattern
++ is multibyte.
++ <charset_not>: Setup fastmap from bitmap only for ASCII chars.
++ <charset>: Use CHAR_LEADING_CODE to get leading codes.
++ <categoryspec>: If multibyte, setup fastmap only for ASCII chars
++ here.
++ (re_compile_fastmap) [emacs]: Call analyse_first with the arg
++ multibyte always 1.
++ (re_search_2) In emacs, set the locale variable multibyte to 1,
++ otherwise to 0. New local variable target_multibyte. Check it
++ to decide the multibyteness of STR1 and STR2. If
++ target_multibyte is zero, convert unibyte chars to multibyte
++ before translating and checking fastmap.
++ (TARGET_CHAR_AND_LENGTH): New macro.
++ (re_match_2_internal): In emacs, set the locale variable multibyte
++ to 1, otherwise to 0. New local variable target_multibyte. Check
++ it to decide the multibyteness of STR1 and STR2. Use
++ TARGET_CHAR_AND_LENGTH to fetch a character from D.
++ <charset, charset_not>: If multibyte is nonzero, check fastmap
++ only for ASCII chars. Call bcmp_translate with
++ target_multibyte, not with multibyte.
++ <begline>: Declare the local variable C as `unsigned'.
++ (bcmp_translate): Change the last arg name to target_multibyte.
++
++ * search.c (compile_pattern_1): Don't adjust the multibyteness of
++ the regexp pattern and the matching target. Set cp->buf.multibyte
++ to the multibyteness of the regexp pattern. Set
++ cp->but.target_multibyte to the multibyteness of the matching
++ target.
++ (wordify): Use FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE instead of
++ FETCH_STRING_CHAR_ADVANCE.
++ (Freplace_match): Convert unibyte chars to multibyte.
++
++ * syntax.c (char_quoted): Use FETCH_CHAR_AS_MULTIBYTE to convert
++ unibyte chars to multibyte.
++ (back_comment): Likewise.
++ (scan_words): Likewise.
++ (skip_chars): The arg syntaxp is deleted, and the code for
++ handling syntaxes is moved to skip_syntaxes. Callers changed.
++ Fix the case that the multibyteness of STRING and the current
++ buffer doesn't match.
++ (skip_syntaxes): New function.
++ (SYNTAX_WITH_MULTIBYTE_CHECK): Check C by ASCII_CHAR_P, not by
++ SINGLE_BYTE_CHAR_P.
++ (Fforward_comment): Use FETCH_CHAR_AS_MULTIBYTE to convert unibyte
++ chars to multibyte.
++ (scan_lists): Likewise.
++ (Fbackward_prefix_chars): Likewise.
++ (scan_sexps_forward): Likewise.
++
++2002-08-23 Kenichi Handa <handa@etl.go.jp>
++
++ * xfaces.c (QCfontset): New variable.
++ (LFACE_FONTSET): New macro.
++ (check_lface_attrs): Check also LFACE_FONTSET_INDEX.
++ (set_lface_from_font_name): Setup LFACE_FONTSET (lface).
++ (Finternal_set_lisp_face_attribute): Handle QCfontset.
++ (Finternal_get_lisp_face_attribute): Likewise.
++ (lface_same_font_attributes_p): Fix checking of LFACE_FONT_INDEX,
++ check also LFACE_FONTSET_INDEX.
++ (face_fontset): Check attrs[LFACE_FONTSET_INDEX], not
++ attrs[LFACE_FONT_INDEX].
++ (syms_of_xfaces): Intern and staticpro QCfontset.
++
++ * dispextern.h (enum lface_attribute_index): New member
++ LFACE_FONTSET_INDEX.
++
++ * fns.c (base64_encode_1): Handle eight-bit chars correctly.
++
++2002-08-21 Kenichi Handa <handa@etl.go.jp>
++
++ * coding.c (coding_set_destination): Fix coding->destination for
++ the case converting a region.
++ (encode_coding_utf_8): Encode eight-bit chars as single byte.
++ (encode_coding_object): Fix coding->dst_pos and
++ coding->dst_pos_byte for the case converting a region.
++
++ * insdel.c (insert_from_gap): Make it work even if PT != GTP.
++
++ * character.h (BYTE8_STRING): New macro.
++
++ * fns.c (base64_decode_1): Insert eight-bit chars correctly.
++
++2002-08-20 Kenichi Handa <handa@etl.go.jp>
++
++ * xdisp.c (get_next_display_element): Don't display unibyte 8-bit
++ characters by octal form.
++
++ * abbrev.c (Fexpand_abbrev): Fix for the multibyte case.
++
++ * buffer.h (_fetch_multibyte_char_len): Extern deleted.
++ (FETCH_MULTIBYTE_CHAR): Don't use _fetch_multibyte_char_len.
++ (BUF_FETCH_MULTIBYTE_CHAR): Likewise.
++ (FETCH_CHAR_AS_MULTIBYTE): New macro.
++
++ * casetab.c (set_canon, set_identity, shuffle): Simplified.
++
++ * casefiddle.c (casify_object): Simplified. Handle the case that
++ the case conversion change the byte length.
++ (casify_region): Likewise
++
++ * character.h (MAKE_CHAR_UNIBYTE, MAKE_CHAR_MULTIBYTE): New
++ macros.
++
++ * character.c (_fetch_multibyte_char_len): This variable deleted.
++ (syms_of_character): Setup Vprintable_chars.
++
++ * editfns.c (Fchar_equal): Fix for the unibyte case.
++ (Finsert_byte): New function.
++ (syms_of_editfns): Defsubr it.
++
++ * keyboard.c (read_key_sequence): Use ~CHAR_MODIFIER_MASK instead
++ of direct code 0x3ffff.
++
++ * search.c (Freplace_match): Fix for the unibyte case.
++
++2002-08-19 Kenichi Handa <handa@etl.go.jp>
++
++ * lread.c (safe_to_load_p): Fix the logic.
++
++ * syntax.c (scan_words): Don't treat characters belonging to
++ different scripts as constituting a word.
++
++ * editfns.c (Fformat): Use ASCII_CHAR_P, not SINGLE_BYTE_CHAR_P.
++
++ * fontset.c (Fset_fontset_font): Treat `ascii' as charset, not
++ script.
++
++ * emacs.c (main): In the case of --unibyte, instead of aborting on
++ finding non-empty buffer, make it unibyte.
++
++2002-08-18 Kenichi Handa <handa@etl.go.jp>
++
++ * xterm.c (x_new_fontset): Call `create-fontset-from-ascii-font'
++ to create a fontset.
++
++2002-08-18 Dave Love <fx@gnu.org>
++
++ * character.c (Funibyte_char_to_multibyte): Doc fix.
++
++ * xfns.c [HAVE_STDLIB_H]: Fix last change.
++
++2002-08-15 Kenichi Handa <handa@etl.go.jp>
++
++ * fontset.c (fontset_add): Make the type `int'.
++ (fontset_id_valid_p): Define it if FONTSET_DEBUG is defined.
++
++ * character.c (unibyte_char_to_multibyte): Refer to
++ charset_unibyte, not charset_primary.
++ (multibyte_char_to_unibyte): Likewise.
++ (Funibyte_char_to_multibyte): Likewise.
++
++ * charset.h: (charset_unibyte): Extern it instead of
++ charset_primary.
++
++ * charset.c (charset_unibyte): Renamed from charset_primary.
++ (Funibyte_charset): Renamed from Fprimary_charset.
++ (Fset_unibyte_charset): Renamed from Fset_primary_charset.
++ (syms_of_charset): Adjusted for the above changes.
++
++ * w32term.c (x_produce_glyphs): Use ASCII_CHAR_P, not
++ SINGLE_BYTE_CHAR_P. Fix the logic of handling non-ASCII char when
++ it->multibyte_p is zero.
++
++ * lisp.h (nonascii_insert_offset, Vnonascii_translation_table):
++ Extern deleted.
++
++2002-08-08 Kenichi Handa <handa@etl.go.jp>
++
++ * coding.c (Fdefine_coding_system_internal): Fix category setting
++ for a coding system of type iso-2022.
++
++2002-08-02 Kenichi Handa <handa@etl.go.jp>
++
++ * fontset.h (FS_LOAD_FONT): Call fs_load_font with the arg CHARSET
++ -1.
++
++2002-08-01 Kenichi Handa <handa@etl.go.jp>
++
++ * syntax.c (Vnext_word_boundary_function_table): New variable.
++ (syms_of_syntax): Declare it as a Lisp variable.
++ (scan_words): Call functions in Vnext_word_boundary_function_table
++ if any.
++
++ * xterm.c (x_load_font): Initialize fontp->fontset to -1.
++
++ * fontset.c (fs_load_font): If fontp->charset is not negative,
++ return fontp without setting its members.
++
++2002-07-31 Dave Love <fx@gnu.org>
++
++ * config.in: Generated with autoheader.
++
++ * xfns.c [HAVE_STDLIB_H]: Change logic (instead of fixing typo).
++
++ * m/sparc.h (HAVE_ALLOCA): Delete.
++
++ * s/irix6-5.h: Don't include strings.h.
++ (bcopy, bzero, bcmp): Don't undef.
++
++ * s/irix6-0.h (bcopy, bzero, bcmp): Don't undef.
++
++ * s/usg5-4.h (NO_SIOCTL_H): Don't define.
++ (TIOCSIGSEND): Don't test IRIX6.
++ (bcopy, bzero, bcmp): Define conditionally.
++
++2002-07-31 Kenichi Handa <handa@etl.go.jp>
++
++ * buffer.c (Qas, Qmake, Qto): New variables.
++ (Fset_buffer_multibyte): New optional arg METHOD. Caller changed.
++ (syms_of_buffer): Intern and staticpro Qas, Qmake, and Qto.
++
++ * callproc.c (Fcall_process): Don't call insert_1_both directly if
++ we are inserting a process output into a multibyte buffer.
++
++ * character.h (CHAR_TO_BYTE8): If C is not eight-bit char, call
++ multibyte_char_to_unibyte.
++
++ * character.c (Funibyte_char_to_multibyte): If C can't be decoded
++ by the primary charset, make it eight-bit char.
++ (Fmultibyte_char_to_unibyte): Call CHAR_TO_BYTE8.
++
++ * charset.c: (charset_eight_bit, Qeight_bit_control): New
++ variables.
++ (charset_8_bit__control, charset_8_bit_graphic,
++ Qeight_bit_control, Qeight_bit_graphic): These variables deleted.
++ (define_charset_internal): New function.
++ (syms_of_charset): Call define_charset_internal for pre-defined
++ charsets.
++
++ * charset.h (charset_8_bit): Extern it.
++
++ * coding.c (make_conversion_work_buffer): Adjusted for the change
++ of Fset_buffer_multibyte.
++ (encode_coding_raw_text): Increment p0 in the loop.
++
++ * lisp.h (Fset_buffer_multibyte): Prototype adjusted.
++
++ * xdisp.c (setup_echo_area_for_printing, set_message_1): Adjusted
++ for the change of Fset_buffer_multibyte.
++
++ * fns.c (Fstring_to_multibyte): New function.
++ (syms_of_fns): Declare Fstring_to_multibyte as Lisp subroutine.
++
++2002-07-30 Dave Love <fx@gnu.org>
++
++ * xfns.c (x_put_x_image): Declare args.
++
++ * xfaces.c (font_name_registry, choose_face_font): Delete unused
++ vars.
++ (try_font_list): Declare an arg.
++
++ * xdisp.c (message2_nolog, set_message): Declare an arg.
++
++ * terminfo.c (tparam): Declare an arg. Use P_ to declare tparm.
++
++ * syntax.c (scan_sexps_forward): Declare an arg.
++
++ * scroll.c (calculate_scrolling, calculate_direct_scrolling):
++ Declare an arg.
++
++ * lisp.h (Fnew_fontset): Declare.
++
++ * keymap.c (push_key_description): Call CHARACTERP correctly.
++
++ * fontset.c (fontset_add): Declare args. Call make_number
++ correctly.
++ (face_for_char): Delete unused vars.
++ (Fset_fontset_font): Doc fix. Delete unused vars.
++
++ * doc.c (Fsubstitute_command_keys): Delete unused vars.
++
++ * composite.c (update_compositions): Declare arg.
++
++ * cm.c (calccost, cmgoto): Declare args.
++
++ * charset.c: Remove `emacs' conditional. Doc fixes.
++ (map_char_table_for_charset): Declare.
++
++ * character.c (syms_of_character) <translation-table-vector>: Doc
++ fix.
++
++ * ccl.c: Remove `emacs' conditional. Include hash table stuff
++ from trunk.
++
++2002-07-26 Kenichi Handa <handa@etl.go.jp>
++
++ The following changes are to allow specifying multiple font
++ patterns for a character range (specified by script or charset).
++
++ * Makefile.in (abbrev.o): Depend on syntax.h.
++ (xfaces.o): Depend on charset.h.
++
++ * alloc.c (Fmake_string): Use ASCII_CHAR_P, not
++ SINGLE_BYTE_CHAR_P.
++
++ * ccl.c (Fccl_execute_on_string): Add `const' to local variables.
++
++ * character.h (Vchar_script_table): Extern it.
++
++ * character.c (Vscript_alist): This variable deleted.
++ (Vchar_script_table, Qchar_script_table): New variable.
++ (syms_of_character): Declare Vchar_script_table as a lisp variable
++ and initialize it.
++
++ * chartab.c (Fmake_char_table): Doc fixed. If PURPOSE doesn't
++ have property char-table-extra-slots, make no extra slot.
++
++ * dispextern.h (struct face): Member `charset' deleted.
++ (FACE_SUITABLE_FOR_CHAR_P): Use ASCII_CHAR_P, not
++ SINGLE_BYTE_CHAR_P.
++ (FACE_FOR_CHAR): Likewise.
++ (choose_face_font, lookup_non_ascii_face, font_name_registry): Add
++ prototypes
++ (lookup_face, lookup_named_face, lookup_derived_face): Prototype
++ fixed.
++ (generate_ascii_font_name): Renamed from generate_ascii_font.
++
++ * fontset.h (get_font_repertory_func): New prototype.
++ (make_fontset_for_ascii_face, fs_load_font): Prototypes fixed.
++ (FS_LOAD_FONT): Call fs_load_font with the 3rd arg charset_ascii.
++
++ * fontset.c (Qprepend, Qappend): New variables.
++ (FONTSET_CHARSET_ALIST, FONTSET_FACE_ALIST): These macros deleted.
++ (FONTSET_NOFONT_FACE, FONTSET_REPERTORY): New macros.
++ (FONTSET_REF): Optimize if FONTSET is Vdefault_fontset.
++ (FONTSET_REF_AND_RANGE, FONTSET_ADD): New macros.
++ (fontset_ref_and_range, fontset_add, reorder_font_vector)
++ (load_font_get_repertory): New functions.
++ (fontset_set): This function deleted.
++ (fontset_face): New arg FACE. Return face ID, not face.
++ Completely re-written to handle new fontset structure. Caller
++ changed.
++ (free_face_fontset): Use ASET istead of AREF (X) = Y.
++ (face_for_char): Don't call lookup_face.
++ (make_fontset_for_ascii_face): New arg FACE.
++ (fs_load_font): New arg CHARSET_ID. Don't check
++ Vfont_encoding_alist here.
++ (find_font_encoding): New function.
++ (list_fontsets): Use STRINGP, not ! NILP.
++ (accumulate_script_ranges): New function.
++ (Fset_fontset_font, Fnew_fontset, Ffontset_info): Completely
++ re-written to handle new fontset structure.
++ (Ffontset_font): Return a copy of element.
++ (syms_of_fontset): Define symbols Qprepend and Qappend. Fix
++ docstring of font-encoding-alist.
++
++ * lisp.h (CHAR_TABLE_REF): Remove unnecessary check (IDX >= 0).
++ (Fset_fotset_font): Fix arguments to 5.
++
++ * msdos.c (XMenuActivate): Adjuted for the change of
++ lookup_derived_face.
++
++ * xdisp.c (message_dolog, set_message_1, extend_face_to_end_of_line):
++ Use ASCII_CHAR_P, not SINGLE_BYTE_CHAR_P.
++ (highlight_trailing_whitespace): Adjusted for the change of
++ lookup_named_face.
++
++ * xfaces.c: Include charset.h.
++ (load_face_font): Argument C deleted. Caller changed.
++ (generate_ascii_font_name): Renamed from generate_ascii_font.
++ (font_name_registry): New function.
++ (cache_face): Store ascii faces before non-ascii faces in buckets.
++ (lookup_face): Arguments C and BASE_FACE deleted. Caller changed.
++ Lookup only ascii faces.
++ (lookup_non_ascii_face): New function.
++ (lookup_named_face): Argument C deleted. Caller changed.
++ (lookup_derived_face): Argument C deleted. Caller changed.
++ (try_font_list): New arg PATTERN. Caller changed. If PATTERN is
++ a string, just call font_list with it.
++ (choose_face_font): Arguments FACE and C deleted. New arg
++ FONT_SPEC. Caller changed.
++ (realize_face): Arguments C and BASE_FACE deleted. Caller
++ (realize_x_face): Likewise.
++ (realize_non_ascii_face): New function.
++ (realize_x_face): Call load_face_font here.
++ (realize_tty_face): Argument C deleted. Caller changed.
++ (compute_char_face): If CH is not ascii, call FACE_FOR_CHAR to
++ get a face ID.
++ (dump_realized_face): Don't print charset of FACE.
++
++ * xfns.c (x_set_font): Always call x_new_fontset and
++ store_frame_parameter.
++ (Fx_create_frame): Call x_new_fontset, not x_new_font.
++ (syms_of_xfns): Set get_font_repertory_func to
++ x_get_font_repertory.
++
++ * xterm.h (x_get_font_repertory): Extern it.
++
++ * xterm.c (x_produce_glyphs): Use ASCII_CHAR_P, not
++ SINGLE_BYTE_CHAR_P. Fix the logic of handling non-ASCII char when
++ it->multibyte_p is zero.
++ (XTread_socket): Use ASCII_CHAR_P, not SINGLE_BYTE_CHAR_P.
++ (x_new_fontset): If FONTSETNAME doesn't match any existing
++ fontsets, create a new one.
++ (x_get_font_repertory): New function.
++
++2002-07-25 Kenichi Handa <handa@etl.go.jp>
++
++ * coding.c (Ffind_coding_systems_region_internal): Detect an
++ ASCII only string correctly.
++
++ * lread.c (Fload): Don't load with Qload_force_doc_strings t if
++ version is 0.
++
++2002-07-24 Kenichi Handa <handa@etl.go.jp>
++
++ * lread.c: Include "coding.h".
++ (Qget_emacs_mule_file_char, Qload_force_doc_strings,
++ load_each_byte, unread_char): New variables.
++ (readchar_backlog): This variable deleted.
++ (readchar): Return a character unless load_each_byte is nonzero.
++ Handle the case that readcharfun is Qget_emacs_mule_file_char or a
++ cons. If unread_char is not -1, simply return it.
++ (unreadchar): Handle the case that readcharfun is
++ Qget_emacs_mule_file_char or a cons. Set unread_char if
++ necessary.
++ (read_multibyte): This function deleted.
++ (readbyte_for_lambda, readbyte_from_file, readbyte_from_string)
++ (read_emacs_mule_char): New functions.
++ (Fload): Even if the file doesn't have the extention ".elc", if
++ safe_to_load_p returns a positive version number, assume that the
++ file contains bytecompiled code. If the version is less than 22,
++ load the file while decoding multibyte sequences by emacs-mule.
++ (readevalloop): Don't use readchar_backlog.
++ (Fread): Likewise. Pay attention to the case that STREAM is a
++ cons.
++ (Fread_from_string): Pay attention to the case that STREAM is a
++ cons.
++ (read_escape): The arg BYTEREP deleted.
++ (read1): Set load_each_byte to 1 temporarily while handling
++ #@NUMBER. Don't call read_multibyte.
++ (read_vector): Call Fread with a cons. If readcharfun is
++ Qget_emacs_mule_file_char, decode the read string by emacs-mule.
++ (read_list): If doc_reference is 2, make the cdr part string as
++ unibyte.
++ (syms_of_lread): Intern and staticpro Qget_emacs_mule_file_char
++ and Qload_force_doc_strings.
++
++2002-07-23 Kenichi Handa <handa@etl.go.jp>
++
++ * xdisp.c (face_before_or_after_it_pos): Call
++ FETCH_MULTIBYTE_CHAR with byte postion, not char position.
++
++2002-07-22 Kenichi Handa <handa@etl.go.jp>
++
++ * character.h (TRAILING_CODE_P): New macro.
++ (MAYBE_UNIFY_CHAR): Adjusted for the change of Funify_charset.
++ (string_char_with_unification): Fix prototype.
++ (Vscript_alist): Extern it.
++
++ * character.c (Vscript_alist): New variable.
++ (string_char_with_unification): Add `const' to local variables.
++ (str_as_unibyte): Likewise.
++ (string_escape_byte8): Likewise.
++ (syms_of_character): Declare script-alist as a Lisp variable.
++
++ * charset.h (Vcharset_ordered_list): Extern it.
++ (charset_ordered_list_tick): Extern it.
++ (EMACS_MULE_LEADING_CODE_PRIVATE_11)
++ (EMACS_MULE_LEADING_CODE_PRIVATE_12)
++ (EMACS_MULE_LEADING_CODE_PRIVATE_21)
++ (EMACS_MULE_LEADING_CODE_PRIVATE_22): New macros
++ (Funify_charset): Adjusted for the change of Funify_charset.
++
++ * charset.c (charset_ordered_list_tick): New variable.
++ (Fdefine_charset_internal): Increment charset_ordered_list_tick.
++ (Funify_charset): New optional arg DEUNIFY. If it is non-nil,
++ deunify intead of unify a charset.
++ (string_xstring_p): Add `const' to local variables.
++ (find_charsets_in_text): Add `const' to arguemnts and local
++ variables.
++ (encode_char): Adjusted for the change of Funify_charset. Fix
++ detecting of invalid code.
++ (Fset_charset_priority): Increment charset_ordered_list_tick.
++ (Fmap_charset_chars): Fix handling of default value for FROM_CODE
++ and TO_CODE.
++
++ * coding.c (LEADING_CODE_PRIVATE_11, LEADING_CODE_PRIVATE_12)
++ (LEADING_CODE_PRIVATE_21, LEADING_CODE_PRIVATE_22): Macros
++ deleted. Callers changed to use
++ EMACS_MULE_LEADING_CODE_PRIVATE_11, etc.
++ (decode_coding_ccl): Add `const' to local variables.
++ (consume_chars): Likewise.
++ (Ffind_coding_systems_region_internal): Likewise.
++ (Fcheck_coding_systems_region): Likewise.
++
++ * print.c (print_object): Use octal form for printing the
++ contents of a bool vector.
++
++2002-07-18 Dave Love <fx@gnu.org>
++
++ * lread.c (Fload) <!load_dangerous_libraries>: Don't leak fd.
++ <version == 20>: Refuse to load.
++
++2002-07-17 Dave Love <fx@gnu.org>
++
++ * fns.c: Move coding.h.
++ (Qcodeset, Qdays, Qmonths): New.
++ (concat): Use CHARACTERP instead of INTERGERP.
++ (Flocale_codeset): Deleted.
++ (Flanginfo): New function.
++ (syms_of_fns): Changed accordingly.
++
++ * coding.c (adjust_coding_eol_type): Fix eol_type/eol_seen mixup.
++
++2002-07-16 Dave Love <fx@gnu.org>
++
++ * casetab.c (init_casetab_once, init_casetab_once): Fix
++ CHAR_TABLE_SET call.
++
++ * category.c (Fmodify_category_entry): Fix CATEGORY_MEMBER call.
++
++ * character.c (syms_of_character): Fix CHAR_TABLE_SET call.
++
++ * charset.c (Fmap_charset_chars): Check args. Convert Lisp types.
++ (load_charset_map, Fdeclare_equiv_charset, Fencode_char)
++ (Fset_charset_priority, syms_of_charset): Convert Lisp types.
++
++ * charset.h (CHECK_CHARSET_GET_ID): Use XINT on AREF result.
++
++ * coding.c (ENCODE_DESIGNATION, decode_eol)
++ (make_conversion_work_buffer, code_conversion_restore)
++ (Fdefine_coding_system_internal): Convert Lisp types.
++ (code_conversion_restore): Use EQ, not ==.
++ (Fencode_coding_string): Fix code_convert_string call.
++
++ * coding.h (code_convert_region): Fix prototype.
++
++ * dispextern.h (redraw_frame, redraw_garbaged_frames): Removed.
++
++ * fontset.c (fontset_ref, fontset_set, fs_load_font)
++ (Ffontset_info): Convert Lisp types.
++
++ * syntax.h (SYNTAX_ENTRY_INT): Don't use make_number.
++
++ * xterm.c (note_mouse_movement): Fix call of window_from_coordinates.
++
++ * xdisp.c (display_mode_element): Fix call of Fset_text_properties.
++
++ * chartab.c: Include "...h", not <...h> in some cases.
++
++ * callproc.c (Fcall_process): Remove unused variables.
++
++2002-07-12 Dave Love <fx@gnu.org>
++
++ * coding.c (Fset_coding_system_priority): Allow null arg list.
++
++2002-07-03 Dave Love <fx@gnu.org>
++
++ * minibuf.c (Fminibuffer_complete_word): Remove unused var.
++ (Fself_insert_and_exit): Use CHARACTERP.
++
++ * callproc.c (Fcall_process): Remove unused vars.
++
++ * xterm.c (XTread_socket): Add extra dead keysyms.
++
++ * xdisp.c (decode_mode_spec_coding): Use CHARACTERP.
++
++ * dispextern.h: Remove prototypes for redraw_frame,
++ redraw_garbaged_frames.
++
++ * cmds.c (Fself_insert_command): Use CHARACTERP.
++
++ * chartab.c (make_sub_char_table): Remove unused var.
++ (Fset_char_table_default, Fmap_char_table): Doc fix.
++
++ * keymap.c (access_keymap): Remove generic char code.
++ (push_key_description): Use CHARACTERP.
++
++2002-07-01 Dave Love <fx@gnu.org>
++
++ * charset.c: Doc fixes.
++ (Funify_charset): Extra checking.
++
++2002-06-24 Dave Love <fx@gnu.org>
++
++ * lread.c: Remove some unused variables.
++ (safe_to_load_p): If safe, return the magic number version byte.
++ (Fload): Maybe use load-with-code-conversion.
++
++2002-06-12 Kenichi Handa <handa@etl.go.jp>
++
++ * category.c (Fmodify_category_entry): Don't modify the contents
++ of category_set for characters out of the range. Avoid
++ unnecessary modification.
++
++ * character.h (MAYBE_UNIFY_CHAR): Adjusted for the change of
++ Vchar_unify_table. The default value of the table is now nil.
++
++ * character.c (syms_of_character): Setup Vchar_width_table for
++ eight-bit-control and raw-byte chars.
++
++ * charset.h (enum define_charset_arg_index): Delete
++ charset_arg_parents and add charset_arg_subset and
++ charset_arg_superset.
++ (enum charset_attr_index): Delete charset_parents and add
++ charset_subset and charset_superset.
++ (enum charset_method): Delete CHARSET_METHOD_INHERIT and add
++ CHARSET_METHOD_SUBSET and CHARSET_METHOD_SUPERSET.
++ (CHARSET_ATTR_PARENTS, CHARSET_PARENTS): Macros deleted.
++ (CHARSET_ATTR_SUBSET, CHARSET_ATTR_SUPERSET, CHARSET_SUBSET)
++ (CHARSET_SUPERSET): New macros.
++ (charset_work): Extern it.
++ (ENCODE_CHAR): Use charset_work.
++ (CHAR_CHARSET_P): Adjusted for the change of encoder format.
++ (map_charset_chars): Extern it.
++
++ * charset.c (load_charset_map): Set the default value of encoder
++ and deunifier char-tables to nil.
++ (map_charset_chars): Argument changed. Callers changed. Use
++ map_char_table_for_charset instead of map_char_table.
++ (Fmap_charset_chars): New optional args from_code and to_code.
++ (Fdefine_charset_internal): Adjusted for the change of
++ `define-charset' (:parents -> :subset or :superset).
++ (charset_work): New variable.
++ (encode_char): Adjusted for the change of
++ Fdefine_charset_internal.
++ (syms_of_charset): Likewise.
++ (Ffind_charset_string): Setup the vector `charsets' correctly.
++
++ * chartab.c (sub_char_table_ref_and_range): New arg defalt. Fix
++ the previous change.
++ (char_table_ref_and_range): Adjusted for the above change.
++ (map_sub_char_table_for_charset): New function.
++ (map_char_table_for_charset): New function.
++
++ * keymap.c (describe_vector): Handle a char-table directly here.
++ (describe_char_table): Deleted.
++
++ * lisp.h (map_charset_chars): Deleted.
++
++2002-06-11 Dave Love <fx@gnu.org>
++
++ * fns.c (count_combining): Comment out (unused).
++ (Flocale_codeset): New.
++ (syms_of_fns): Defsubr it.
++
++ * config.in (HAVE_PTY_H, HAVE_SIZE_T, HAVE_LANGINFO_CODESET): New.
++ (size_t): Removed.
++
++2002-06-06 Dave Love <fx@gnu.org>
++
++ * Makefile.in (chartab.o): Depend on charset.h
++
++2002-06-03 Kenichi Handa <handa@etl.go.jp>
++
++ * character.c (syms_of_character): Set the default value of
++ Vprintable_chars to Qnil.
++
++2002-05-31 Dave Love <fx@gnu.org>
++
++ * Makefile.in (lisp, shortlisp): Change indian.elc to indian.el.
++
++2002-05-31 Kenichi Handa <handa@etl.go.jp>
++
++ * charset.c (load_charset_map): Handle the case that from < to
++ correctly.
++
++ * coding.c (encode_coding_emacs_mule): Pay attention to raw-8-bit
++ chars.
++ (encode_coding_iso_2022): Likewise.
++ (encode_coding_sjis): Likewise.
++ (encode_coding_big5): Likewise.
++ (encode_coding_charset): Likewise.
++
++2002-05-30 Kenichi Handa <handa@etl.go.jp>
++
++ * Makefile.in (lisp): Change chinese.elc to chinese.el. They are
++ not bytecompiled now.
++ (shortlisp): Likewise.
++
++ * charset.c (charset_jisx0201_roman, charset_jisx0208_1978)
++ (charset_jisx0208): New variables.
++ (Fdefine_charset_internal): Setup them if appropriate.
++ (init_charset_once): Initialize them to -1.
++
++ * charset.h (charset_jisx0201_roman, charset_jisx0208_1978,
++ charset_jisx0208): Extern them.
++
++ * coding.c (CODING_ISO_FLAG_USE_ROMAN): New macro
++ (CODING_ISO_FLAG_USE_OLDJIS): New macro.
++ (CODING_ISO_FLAG_FULL_SUPPORT): Macro definition changed.
++ (setup_iso_safe_charsets): Fix arguemtns to Fassq.
++ (DECODE_DESIGNATION): Pay attention to CODING_ISO_FLAG_USE_ROMAN
++ and CODING_ISO_FLAG_USE_OLDJIS.
++ (ENCODE_ISO_CHARACTER_DIMENSION1): Likewise.
++ (ENCODE_ISO_CHARACTER_DIMENSION2): Likewise.
++ (encode_coding_iso_2022): Change the 1st arg to
++ ENCODE_ISO_CHARACTER to a variable.
++
++2002-05-29 Kenichi Handa <handa@etl.go.jp>
++
++ * charset.h (enum define_charset_arg_index): New enums
++ charset_arg_min_code and charset_arg_max_code.
++ (struct charset): New member char_index_offset.
++
++ * charset.c (CODE_POINT_TO_INDEX): Take charset->char_index_offset
++ into account.
++ (INDEX_TO_CODE_POINT): Likewise.
++ (Fdefine_charset_internal): Handle args[charset_arg_min_code] and
++ args[charset_arg_max_code]. Setup charset.char_index_offset.
++ (syms_of_charset): Fix args to Fdefine_charset_internal.
++
++2002-05-27 Dave Love <fx@gnu.org>
++
++ * coding.c (decode_coding_utf_8): Reject overlong sequences.
++
++2002-05-26 Dave Love <fx@gnu.org>
++
++ * coding.c: Doc fixes.
++ (Fcoding_system_aliases): Fix return value.
++ (Qmac): Remove (duplicated) definition.
++
++2002-05-25 Dave Love <fx@gnu.org>
++
++ * charset.c (Fcharset_priority_list, Fset_charset_priority): New
++ functions.
++
++ * character.c (Fstring): Doc fix.
++
++ * charset.c (Fdefine_charset_alias): Update Vcharset_list.
++
++ * fontset.c (Ffontset_info): Doc fix. Return charset names, not
++ ids.
++ (font-encoding-alist): Doc fix.
++
++2002-05-24 Dave Love <fx@gnu.org>
++
++ * term.c (costs_set): Declare static, non-initialized for pcc.
++ (encode_terminal_code): Remove ensued var.
++
++ * keyboard.c (kbd_buffer_store_event): Fix interrupt_signal decl
++ for K&R.
++
++ * xterm.c (xlwmenu_window_p): Fix prototype for K&R.
++
++ * coding.c (setup_iso_safe_charsets): Fix arg decl for K&R.
++ (suffixes): Moved out of make_subsidiaries for K&R.
++
++ * charset.c (map_charset_chars): Fix c_function declaration for
++ K&R.
++
++ * lisp.h (DEFUN) [!PROTOTYPES]: Remove spurious `args'.
++
++2002-05-23 Dave Love <fx@gnu.org>
++
++ * data.c (Fchar_or_string_p): Doc fix. Use CHARACTERP.
++
++ * category.c (Fmodify_category_entry): Doc fix. Remove unused
++ vars.
++
++2002-05-23 Yong Lu <lyongu@asia-infonet.com>
++
++ * charset.c (Fdefine_charset_internal): Fix argument to bzero.
++
++ * coding.c (Fdefine_coding_system_internal): Fix previous change.
++ (decode_coding_charset): Workaround for the bug of GCC 2.96.
++
++2002-05-23 Kenichi Handa <handa@etl.go.jp>
++
++ * Makefile.in (lisp): Change cyrillic.elc to cyrillic.el,
++ vietnamese.elc to vietnamese.el. They are not bytecompiled now.
++ (shortlisp): Likewise.
++
++2002-05-22 Kenichi Handa <handa@etl.go.jp>
++
++ * coding.c (decode_coding_charset): Adjusted for the change of
++ Fdefine_coding_system_internal.
++ (Fdefine_coding_system_internal): For a coding system of
++ `charset' type, store a list of charset IDs in
++ `charset_attr_charset_valids' element of coding attributes.
++
++ * charset.c (Fmake_char): Fix previous change.
++
++2002-05-21 Kenichi Handa <handa@etl.go.jp>
++
++ * coding.c (ONE_MORE_BYTE_NO_CHECK): Increment consumed_chars.
++ (emacs_mule_char): New arg src. Delete arg `composition'. Caller
++ changed. Handle 2-byte and 3-byte charsets correctly.
++ (DECODE_EMACS_MULE_COMPOSITION_RULE_20): Renamed from
++ DECODE_EMACS_MULE_COMPOSITION_RULE. Caller changed.
++ (DECODE_EMACS_MULE_COMPOSITION_RULE_21): New macro.
++ (DECODE_EMACS_MULE_21_COMPOSITION): Call
++ DECODE_EMACS_MULE_COMPOSITION_RULE_21. Produce correct annotation
++ sequence.
++ (decode_coding_emacs_mule): Handle composition correctly. Rewind
++ `src' and `consumed_chars' correctly before calling
++ emacs_mule_char.
++ (DECODE_COMPOSITION_START): Correctly handle the case of altchar
++ and alt&rule composition.
++ (decode_coding_iso_2022): Handle composition correctly.
++ (init_coding_once): Setup emacs_mule_bytes for private charsets.
++
++ * charset.c (Fdefine_charset_internal): Fix bug for the case of
++ re-defining a charset. If the charset has :emacs-mule-id, setup
++ emacs_mule_bytes.
++ (Fmake_char): If CODE1 is nil, use the minimum code of the
++ charset.
++
++2002-05-20 Kenichi Handa <handa@etl.go.jp>
++
++ * coding.c (encode_coding_iso_2022): If coding requires safe
++ encoding, produce a character specified by
++ CODING_INHIBIT_CHARACTER_SUBSTITUTION.
++ (encode_coding_sjis): Likewise.
++ (encode_coding_big5): Likewise.
++ (encode_coding_charset): Likewise.
++
++2002-05-17 Dave Love <fx@gnu.org>
++
++ * xterm.c (XSetIMValues): Declare.
++
++ * process.c: Conditionally include sys/wait.h, pty.h.
++
++ * print.c (print_object): Fix print format for 64-bit
++ systems.
++
++ * keyboard.c (modify_event_symbol): Fix print format for 64-bit
++ systems.
++
++ * buffer.c (emacs_strerror): Declare.
++ (MMAP_ALLOCATED_P, mmap_enlarge, syms_of_buffer): Import changes
++ from trunk.
++
++ * fontset.c (Fclear_face_cache): Declare.
++ (accumulate_font_info): Commented-out (unused).
++ (face_for_char, Fset_fontset_font, Ffontset_info): Remove unused
++ variables.
++
++ * character.h (string_escape_byte8): Declare.
++
++ * charset.c (load_charset_map, load_charset_map_from_file): Remove
++ unused vars.
++ (Fdefine_charset_internal, Fsplit_char, syms_of_charset)
++ (Fmap_charset_chars): Doc fix.
++
++ * coding.c (Vchar_coding_system_table, Qchar_coding_system):
++ Removed.
++ (Fset_coding_system_priority, Fset_coding_system_priority)
++ (Fdefine_coding_system_internal): Doc fix.
++
++2002-05-16 Dave Love <fx@gnu.org>
++
++ * s/osf5-0.h (C_SWITCH_SYSTEM) [!__GNUC__]: Remove -nointrinsics.
++
++2002-05-16 Kenichi Handa <handa@etl.go.jp>
++
++ * character.c (string_escape_byte8): Make multibyte string with
++ correct size.
++
++ * charset.c (Fmake_char): Delete unnecessary code.
++
++2002-05-14 Kenichi Handa <handa@etl.go.jp>
++
++ * xfns.c (x_encode_text): Allocate coding.destination here, and
++ call encode_coding_object with dst_object Qnil.
++
++ * buffer.c (Fset_buffer_multibyte): Convert 8-bit bytes to
++ multibyte form correctly.
++
++ * fontset.c (fs_load_font): Check fontp->full_name (not fontname)
++ against Vfont_encoding_alist.
++
++ * coding.c (Fdecode_sjis_char): Fix typo (0x7F->0xFF). Fix the
++ handling of charset list.
++ (encode_coding_iso_2022): Setup coding->safe_charsets in advance.
++ (decode_coding_object): Move point to coding->dst_pos before
++ calling post-read-conversion function.
++ (encode_coding_object): Give correct arguments to
++ pre-write-conversion. Ignore the return value of
++ pre-write-conversion function. Pay attention to the case that
++ pre-write-conversion changes the current buffer. If dst_object is
++ Qt, even if coding->src_bytes is zero, allocate at least one byte
++ to coding->destination.
++
++ * coding.h (JIS_TO_SJIS): Fix typo (j1->s1, j2->s2).
++
++ * charset.c (Fmake_char): Make it more backward compatible.
++ (Fmap_charset_chars): Fix docstring.
++
++2002-05-13 Dave Love <fx@gnu.org>
++
++ * coding.c: Doc fixes.
++ (Fdefine_coding_system_alias): Use names, not symbols, in
++ coding-system-alist.
++
++2002-05-13 Kenichi Handa <handa@etl.go.jp>
++
++ * fontset.c (free_realized_fontsets): Call Fclear_face_cache instead
++ of calling free_realized_face.
++
++2002-05-10 Yong Lu <lyongu@asia-infonet.com>
++
++ * charset.c (load_charset_map): Fix previous change.
++ (read_hex): Don't treat SPC as a comment starter.
++ (decode_char): If CODE_POINT_TO_INDEX retruns -1, always return
++ -1.
++ (Fdecode_char): Fix typo.
++
++2002-05-10 Kenichi Handa <handa@etl.go.jp>
++
++ * charset.h (struct charset): New member `code_space_mask'.
++
++ * coding.c (coding_set_source): Delete the local variable
++ beg_byte.
++ (encode_coding_charset): Delete the local variable charset.
++ (Fdefine_coding_system_internal): Likewise.
++ (Fdefine_coding_system_internal): Setup
++ attrs[coding_attr_charset_valids] correctly.
++
++ * charset.c (CODE_POINT_TO_INDEX): Utilize `code_space_mask'
++ member to check if CODE is valid or not.
++ (Fdefine_charset_internal): Initialize `code_space_mask' member.
++ (encode_char): Before calling CODE_POINT_TO_INDEX, check if CODE
++ is within the range of charset->min_code and carset->max_code.
++
++2002-05-09 Dave Love <fx@gnu.org>
++
++ * syntax.h (syntax_temp) [!__GNUC__]: Declare.
++
++ * dispextern.h (generate_ascii_font): Fix return type.
++
++ * xfaces.c (generate_ascii_font): Fix arg declaration.
++
++ * coding.c (coding_inherit_eol_type)
++ (Fset_terminal_coding_system_internal)
++ (Fset_safe_terminal_coding_system_internal): Fix arg declarations.
++
++2002-05-08 Kenichi Handa <handa@etl.go.jp>
++
++ * coding.c (decode_coding_charset, encode_coding_charset): Handle
++ multiple charsets correctly.
++
++2002-05-07 Kenichi Handa <handa@etl.go.jp>
++
++ * search.c (boyer_moore): Fix handling of mulitbyte character
++ translation.
++
++ * xdisp.c (display_mode_element): When the variable `elt' is
++ changed, update `this' and `lisp_string'.
++
++2002-05-07 Kenichi Handa <handa@etl.go.jp>
++
++ * buffer.c (Fset_buffer_multibyte): Fix 8-bit char handling.
++
++ * callproc.c (Fcall_process): Be sure to give the current buffer
++ to decode_coding_c_string. Update PT and PT_BYTE after the
++ insertion.
++
++ * charset.c (struct charset_map_entries): New struct.
++ (load_charset_map): Renamed from parse_charset_map. New args
++ entries and n_entries. Caller changed.
++ (load_charset_map_from_file): Renamed from load_charset_map.
++ Caller changed. New arg control_flag. Call load_charset_map at
++ the tail.
++ (load_charset_map_from_vector): New function.
++ (Fdefine_charset_internal): Setup charset.compact_codes_p.
++ (encode_char): If the charset is compact, change a character index
++ to a code point.
++
++ * coding.c (coding_alloc_by_making_gap): Check the case that the
++ source and destination are the same correctly.
++ (decode_coding_raw_text): Set coding->consumed_char and
++ coding->consumed to 0.
++ (produce_chars): If coding->chars_at_source is nonzero, update
++ coding->consumed_char and coding->consumed before calling
++ alloc_destination.
++ (Fdefine_coding_system_alias): Register ALIAS in
++ Vcoding_system_alist.
++ (syms_of_coding): Define `no-convesion' coding system at the tail.
++
++ * fileio.c (Finsert_file_contents): Set coding_system instead of
++ val. If the current buffer is multibyte, always call
++ decode_coding_gap.
++
++ * xfaces.c (try_font_list): Give higher priority to fontset's
++ family than face's family.
++
++2002-04-18 Kenichi Handa <handa@etl.go.jp>
++
++ * callproc.c (Fcall_process): Be sure to give the current buffer
++ to decode_coding_c_string.
++
++ * xfaces.c (try_font_list): Give a family specified in a fontset
++ higher priority than a family specified in a face.
++
++2002-04-09 Kenichi Handa <handa@etl.go.jp>
++
++ * fileio.c (Finsert_file_contents): Fix calculation of `inserted'.
++ Fix arguments to insert_from_buffer.
++
++ * xdisp.c (display_mode_element): Fix calculation of `bytepos'.
++
++2002-03-11 Kenichi Handa <handa@etl.go.jp>
++
++ * coding.c (produce_chars): Set the variable `multibytep' correctly.
++ (decode_coding_gap): Set coding->dst_multibyte correctly.
++
++2002-03-07 Kenichi Handa <handa@etl.go.jp>
++
++ * coding.c (encode_coding_utf_8): Initialize produced_chars to 0.
++ (decode_coding_utf_16): Fix converting high and low bytes to
++ code-point.
++ (encode_coding_utf_16): Substitute coding->default_char for
++ non-Unicode characters.
++ (decode_coding): Don't call record_insert here.
++ (setup_coding_system): Initialize `surrogate' of
++ coding->spec.utf_16 to 0.
++ (EMIT_ONE_BYTE): Fix for multibyte case.
++
++ * insdel.c (insert_from_gap): Call record_insert.
++
++2002-03-04 Kenichi Handa <handa@etl.go.jp>
++
++ * casefiddle.c (casify_region): Fix multibyte case.
++
++ * character.c (c_string_width): Add return type `int'.
++ (char_string_with_unification): Arg ADVANCED deleted.
++
++ * character.h (CHAR_VALID_P): Don't call CHARACTERP.
++ (CHAR_STRING): Adjusted for the change of
++ char_string_with_unification.
++ (CHAR_STRING_ADVANCE): Make it do-while statement.
++
++ * chartab.c (sub_char_table_set_range): Optimized for the case
++ DEPTH == 3. Add workaround code for a GCC optimization bug.
++
++ * charset.c (parse_charset_map): Remove an unused variable.
++
++ * coding.c: Delete unused variables.
++
++ * fileio.c (Finsert_file_contents): Set coding_system to Qnil
++ earlier. If inserted is zero and the coding system doesn't
++ require flushing, don't call decode_coding_gap.
++
++ * syntax.h (SET_RAW_SYNTAX_ENTRY): Don't call make_number.
++
++2002-03-01 Kenichi Handa <handa@etl.go.jp>
++
++ The following changes are for using Unicode as an internal
++ character model, and use UTF-8 format for buffer/string
++ representation.
++
++ * .gdbinit (xchartable): Adjusted for the change of char table
++ structure.
++ (xsubchartable, xcoding, xcharset, xcurbuf): New commands.
++
++ * Makefile.in (obj): Add character.o and chartab.o.
++ (lisp, shortlisp): Remove utf-8.elc:
++ (*.o): For many files, change dependency on charset.h to
++ character.h, and add dependency on character.h.
++ (character.o, chartab.o): New targets.
++
++ * abbrev.c, bytecode.c, casefiddle.c, cmds.c, dispnew.c, doc.c,
++ doprnt.c, dosfns.c, frame.c, marker.c, minibuf.c, msdos.c,
++ w16select.c, w32bdf.c, w32console.c: Include "character.h" instead
++ of "charset.h".
++
++ * dired.c, filelock.c: Include "character.h".
++
++ * alloc.c: Include "character.h" instead of "charset.h".
++ (Fmake_char_table): Moved to chartab.c.
++ (make_sub_char_table): Likewise.
++ (syms_of_alloc): Remove defsubr for Smake_char_table.
++
++ * buffer.c: Include "character.h" instead of "charset.h", don't
++ include "coding.h".
++ (Fset_buffer_multibyte): Adjuted for UTF-8.
++
++ * buffer.h: EXFUN Fbuffer_live_p.
++
++ * callproc.c: Include "character.h" instead of "charset.h".
++ (Fcall_process): Big change for the new code-conversion APIs.
++
++ * casetab.c: Include "character.h" instead of "charset.h".
++ (set_canon, set_identity, shuffle): Adjusted for the new
++ map_char_table spec.
++ (init_casetab_once): Call CHAR_TABLE_SET instead of directly
++ accessing the char table structure.
++
++ * chartab.c: New file that implements char table.
++
++ * category.c: Include "character.h".
++ (copy_category_entry): New function.
++ (copy_category_table): Call map_char_table and copy_category_entry.
++ (Fmake_category_table): Initialize all top-vel slots.
++ (char_category_set): New function.
++ (modify_lower_category_set): Deleted.
++ (Fmodify_category_entry): Call char_table_ref_and_range.
++
++ * category.h (CATEGORY_SET): Just call char_category_set.
++
++ * ccl.c: Include "character.h".
++ (Qccl, Qcclp): New variables.
++ (CCL_WRITE_CHAR): Alway treat the arg CH as a character even if
++ it's less than 256.
++ (CCL_WRITE_MULTIBYTE_CHAR): Deleted.
++ (CCL_WRITE_STRING, CCL_READ_CHAR): Adjusted for the change of SRC
++ and DST type.
++ (ccl_driver): Types of arguments changed. Code adjusted for that.
++ (Fccl_execute, Fccl_execute_on_string): Adjusted for the change of
++ ccl_driver.
++ (syms_of_ccl): Intern and staticpro Qccl and Qcclp.
++
++ * ccl.h (struct ccl_program): Members eol_type and multibyte
++ deleted. New members src_multibyte, dst_multibyte, consumed, and
++ produced.
++ (struct ccl_spec): Members decoder and encoder deleted. New
++ memeber ccl.
++ (CODING_SPEC_CCL_PROGRAM): New macro.
++ (ccl_driver): Prototype updated.
++ (Qccl, Qcclp, Fccl_program_p): Extern them.
++ (CHECK_CCL_PROGRAM): New macro.
++
++ * character.c, character.h, chartab.c: New files.
++
++ * charset.c: Mostly re-written. Character and multibyte sequence
++ handling codes are moved to character.c.
++
++ * charset.h: Mostly re-written. Character and multibyte sequence
++ handling codes are moved to character.h.
++
++ * coding.c, coding.h: Mostly re-written.
++
++ * composite.c: Include "character.h" instead of "charset.h".
++ (CHAR_WIDTH): Moved to character.h.
++ (HASH_KEY, HASH_VALUE): Deleted.
++
++ * composite.h (enum composition_method): Order of enumeration
++ symbols changed.
++
++ * data.c: Include "character.h" instead of "charset.h".
++ (Faref): Call CHAR_TABLE_REF for a char table.
++ (Faset): Call CHAR_TABLE_SET for a char table.
++
++ * dispextern.h (free_realized_face, check_face_attribytes,
++ generate_ascii_font): Extern them.
++ (free_realized_multibyte_face): Extern deleted.
++
++ * disptab.h (DISP_CHAR_VECTOR): Adjusted for the change of char
++ table structure.
++
++ * editfns.c: Include "character.h" instead of "charset.h".
++ (Fchar_to_string): Always call CHAR_STRING.
++
++ * emacs.c (main): Call init_charset_once, init_charset,
++ syms_of_chartab, and syms_of_character.
++
++ * fileio.c: Include "character.h" instead of "charset.h".
++ (Finsert_file_contents): Big change for the new code-conversion
++ API.
++ (choose_write_coding_system): Likewise.
++ (Fwrite_region): Likewise.
++ (build_annotations_2): Deleted.
++ (e_write): Big change for the new code-conversion API.
++
++ * fns.c: Include "character.h" instead of "charset.h".
++ (copy_sub_char_table): Moved to chartab.c.
++ (Fcopy_sequence): Call copy_char_table for a char table.
++ (concat): Delete codes calling count_multibyte.
++ (string_char_to_byte): Adjusted for the new multibyte form.
++ (string_byte_to_char): Likewise.
++ (internal_equal): Adjusted for the change of char table structure.
++ (Fchar_table_subtype, Fchar_table_parent, Fset_char_table_parent,
++ Fchar_table_extra_slot, Fset_char_table_extra_slot,
++ Fchar_table_range, Fset_char_table_range, Fset_char_table_default,
++ char_table_translate, optimize_sub_char_table,
++ Foptimize_char_table, map_char_table, Fmap_char_table): Moved to
++ chartab.c.
++ (char_table_ref_and_index): Deleted.
++ (HASH_KEY, HASH_VALUE): Moved to lisp.h.
++ (Fmd5): Call preferred_coding_system instead of accessing
++ Vcoding_category_list. Adjusted for the new code-conversion API.
++ (syms_of_fns): Defsubr for char table related functions moved to
++ chartab.c.
++
++ * fontset.c: Mostly re-written.
++
++ * fontset.h (struct font_info): Type of the member encoding_type
++ changed.
++ (enum FONT_SPEC_INDEX): New enum.
++ (fontset_font_pattern, fs_load_font): Prototype updated.
++ (FS_LOAD_FONT): Adjusted for the change of fs_load_font.
++
++ * indent.c: Include "character.h" instead of "charset.h".
++ (MULTIBYTE_BYTES_WIDTH): Call CHAR_WIDTH instead of
++ WIDTH_BY_CHAR_HEAD.
++
++ * insdel.c: Include "character.h" instead of "charset.h".
++ (copy_text): Don't refer to Vnonascii_translation_table.
++ (insert_from_gap): New function.
++
++ * keyboard.c: Include "character.h" instead of "charset.h".
++ (command_loop_1): Never call direct_output_forward_char before
++ a non-ASCII character.
++ (read_char): If Vkeyboard_translate_table is a char table, always
++ translated a character.
++
++ * keymap.c: Include "character.h".
++ (store_in_keymap): Handle the case that IDX is a cons.
++ (Fdefine_key): Handle the case that KEY is a cons and the car part
++ is also a cons (range).
++ (push_key_description): Adjusted for the new character code.
++ (describe_vector): Call describe_char_table for a char table.
++ (describe_char_table): New function.
++
++ * keymap.h (describe_char_table): Extern it.
++
++ * lisp.h (enum pvec_type): New member PVEC_SUB_CHAR_TABLE.
++ (XSUB_CHAR_TABLE, XSETSUB_CHAR_TABLE): New macros.
++ (CHAR_TABLE_ORDINARY_SLOTS, CHAR_TABLE_SINGLE_BYTE_SLOTS,
++ SUB_CHAR_TABLE_ORDINARY_SLOTS, SUB_CHAR_TABLE_STANDARD_SLOTS):
++ Deleted.
++ (CHAR_TABLE_REF, CHAR_TABLE_SET): Adjusted for the new char table
++ structure.
++ (CHAR_TABLE_TRANSLATE): Just call char_table_translate.
++ (CHARTAB_SIZE_BITS_0, CHARTAB_SIZE_BITS_1, CHARTAB_SIZE_BITS_2,
++ CHARTAB_SIZE_BITS_3): New macros.
++ (chartab_size): Extern it.
++ (struct Lisp_Char_Table): Re-designed.
++ (struct Lisp_Sub_Char_Table): New structure.
++ (HASH_KEY, HASH_VALUE): Moved from fns.c.
++ (CHARACTERBITS): Defined as 22.
++ (GLYPH_MASK_FACE, GLYPH_MASK_CHAR): Adjusted for the above change.
++ (SUB_CHAR_TABLE_P): Check PVEC_CHAR_TABLE.
++ (GC_SUB_CHAR_TABLE_P): New macro.
++ (Fencode_coding_string, Fdecode_coding_string): EXFUN Updated.
++ (code_convert_string_norecord): Extern deleted.
++ (init_character_once, syms_of_character, init_charset,
++ syms_of_composite, Qeq, Fmakehash, insert_from_gap): Extern them.
++
++ * lread.c: Include "character.h".
++ (read_multibyte): New arg NBYTES.
++ (read_escape): The meaning of returned *BYTEREP changed.
++ (to_multibyte): Deleted.
++ (read1): Adjuted the handling of char table and string.
++
++ * print.c: Include "character.h" instead of "charset.h".
++ (print_string): Convert 8-bit raw bytes to octal form by
++ string_escape_byte8.
++ (print_object): Adjusted for the new multibyte form. Print 8-bit
++ raw bytes always in octal form. Handle sub char table correctly.
++
++ * process.c: Include "character.h" instead of "charset.h".
++ (read_process_output): Adjusted for the new code-conversion API.
++ (send_process): Likewise.
++
++ * puresize.h (BASE_PURESIZE): Increased.
++
++ * regex.c: Include "character.h" instead of "charset.h".
++ (BYTE8_TO_CHAR, CHAR_BYTE8_P) [not emacs]: New dummy macros.
++ (regex_compile): Accept a range whose starting and ending
++ character have different leading bytes.
++ (analyse_first): Adjusted for the above change.
++
++ * search.c: Include "character.h" instead of "charset.h".
++ (search_buffer, boyer_moore): Adjusted for the new multibyte form.
++ (Freplace_match): Adjusted for the change of
++ multibyte_char_to_unibyte.
++
++ * syntax.c: Include "character.h" instead of "charset.h".
++ (syntax_parent_lookup): Deleted.
++ (Fmodify_syntax_entry): Accept a cons as CHAR.
++ (skip_chars): Adjusted for the new multibyte form.
++ (init_syntax_once): Call char_table_set_range instead of directly
++ accessing the structure of a char table.
++
++ * syntax.h (SET_RAW_SYNTAX_ENTRY): Call CHAR_TABLE_SET.
++ (SYNTAX_ENTRY_FOLLOW_PARENT): Macro deleted.
++ (SET_RAW_SYNTAX_ENTRY_RANGE): New macro.
++ (SYNTAX_ENTRY_INT): Call CHAR_TABLE_REF.
++
++ * term.c: Include "buffer.h" and "character.h".
++ (encode_terminal_code): Adjusted for the new code-conversion API.
++ (write_glyphs): Likewise.
++ (produce_glyphs): Call CHAR_WIDTH instead of CHARSET_WIDTH.
++
++ * w32term.c (x_new_font): Adjusted for the change of FS_LOAD_FONT.
++
++ * xdisp.c: Include "character.h".
++ (get_next_display_element): Adjusted for the new multibyte form.
++ (disp_char_vector): Adjusted for the new char table structure.
++ (decode_mode_spec_coding): Adjusted for the new structure of
++ coding system.
++ (decode_mode_spec): Adjusted for the new code-conversion API.
++
++ * xfaces.c: Include "character.h" instead of "charset.h".
++ (load_face_font): Adjusted for the change of choose_face_font and
++ FS_LOAD_FONT.
++ (generate_ascii_font): New function.
++ (set_lface_from_font_name): Adjusted for the change of
++ FS_LOAD_FONT.
++ (set_font_frame_param): Adjusted for the change of
++ choose_face_font.
++ (free_realized_face): Make it public.
++ (free_realized_faces_for_fontset): Renamed from
++ free_realized_multibyte_face. Free also faces realized for ASCII.
++ (choose_face_font): Argments changed. Adjusted for the change of
++ fontset_font_pattern and FS_LOAD_FONT.
++
++ * xfns.c: Include "character.h".
++ (x_encode_text): Adjusted for the new code-conversion API.
++
++ * xselect.c: Don't include "charset.h".
++ (selection_data_to_lisp_data): Adjusted for the new code
++ covnersion API.
++
++ * xterm.c: Include "character.h".
++ (x_encode_char): New argument CHARSET. Caller changed.
++ (x_get_char_face_and_encoding): Call ENCODE_CHAR instead of
++ SPLIT_CHAR.
++ (x_get_glyph_face_and_encoding): Likewise.
++ (x_produce_glyphs): Don't check Vnonascii_translation_table Call
++ CHAR_WIDTH instead of CHARSET_WIDTH.
++ (XTread_socket): Adjusted for the new code-conversion API.
++ (x_new_font): Adjusted for the change of FS_LOAD_FONT.
++ (x_load_font): Adjusted for the change of struct font.
++
++;; Local Variables:
++;; coding: iso-2022-7bit
++;; End:
++
++ Copyright (C) 2002 Free Software Foundation, Inc.
++ Copying and distribution of this file, with or without modification,
++ are permitted provided the copyright notice and this notice are preserved.
# Makefile for GNU Emacs.
-# Copyright (C) 1985, 87, 88, 93, 94, 95, 99, 2000, 2001, 2002, 2003
+# Copyright (C) 1985, 87, 88, 93, 94, 95, 99, 2000, 2001, 2003
# Free Software Foundation, Inc.
# This file is part of GNU Emacs.
CPPFLAGS=@CPPFLAGS@
LDFLAGS=@LDFLAGS@
LN_S=@LN_S@
+EXEEXT=@EXEEXT@
# Substitute an assignment for the MAKE variable, because
# BSD doesn't have it as a default.
@SET_MAKE@
#endif
/* GNU libc requires ORDINARY_LINK so that its own crt0 is used.
- Linux is an exception because it uses a funny variant of GNU libc. */
+ GNU/Linux is an exception because it uses a funny variant of GNU libc. */
#ifdef __GNU_LIBRARY__
#ifndef GNU_LINUX
#define ORDINARY_LINK
#define LD_SWITCH_SYSTEM_TEMACS
#endif
+/* Some s/SYSTEM.h files define this to request special switches
+ for compiling temacs. */
+#ifndef C_SWITCH_SYSTEM_TEMACS
+#define C_SWITCH_SYSTEM_TEMACS
+#endif
+
/* Some m/MACHINE.h files define this to request special switches in ld. */
#ifndef LD_SWITCH_MACHINE
#define LD_SWITCH_MACHINE
#define C_SWITCH_ASM
#endif
+#if HAVE_GTK
+#define USE_GTK
+TOOLKIT_DEFINES = -DUSE_GTK
+#endif
+
#ifdef USE_X_TOOLKIT
#define USE_@X_TOOLKIT_TYPE@
TOOLKIT_DEFINES = -DUSE_@X_TOOLKIT_TYPE@
#else
+#ifndef USE_GTK
TOOLKIT_DEFINES =
#endif
+#endif
/* DO NOT use -R. There is a special hack described in lastfile.c
which is used instead. Some initialized data areas are modified
/* 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) $(MYCPPFLAG) -I. -I${srcdir} C_SWITCH_MACHINE C_SWITCH_SYSTEM C_SWITCH_SITE C_SWITCH_X_SITE C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM ${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}
.c.o:
$(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $<
#ifdef HAVE_MENUS
/* Include xmenu.o in the list of X object files. */
-XOBJ= xterm.o xfns.o xselect.o xrdb.o fontset.o
+
+#ifdef USE_GTK
+XOBJ= xterm.o xfns.o xselect.o xrdb.o fontset.o xsmfns.o gtkutil.o
+#else
+XOBJ= xterm.o xfns.o xselect.o xrdb.o fontset.o xsmfns.o
+#endif
/* The X Menu stuff is present in the X10 distribution, but missing
from X11. If we have X10, just use the installed library;
/* Otherwise, omit xmenu.o from the list of X object files, and
don't worry about the menu library at all. */
-XOBJ= xterm.o xfns.o xselect.o xrdb.o fontset.o
+XOBJ= xterm.o xfns.o xselect.o xrdb.o fontset.o xsmfns.o
LIBXMENU=
#endif /* not HAVE_MENUS */
#endif /* not LIBXT_STATIC */
#else /* not USE_X_TOOLKIT */
-LIBXT=
+
+#ifdef USE_GTK
+LIBW=@GTK_LIBS@
+OLDXMENU=
+LIBXMENU=
+#endif /* USE_GTK */
+
+#ifdef HAVE_X_SM
+LIBXT=$(LIBW) -lSM -lICE
+#else
+LIBXT=$(LIBW)
+#endif
#endif /* not USE_X_TOOLKIT */
#if HAVE_XPM
#endif /* not COFF_ENCAPSULATE */
#endif /* not ORDINARY_LINK */
-ALL_LDFLAGS = LD_SWITCH_SYSTEM LD_SWITCH_SYSTEM_TEMACS LD_SWITCH_MACHINE \
- LD_SWITCH_MACHINE_TEMACS LD_SWITCH_SITE $(LDFLAGS)
+/* Flags to pass to LD only for temacs. */
+/* Don't split this line with a backslash. That can cause trouble with
+ some cpps. */
+TEMACS_LDFLAGS = LD_SWITCH_SYSTEM LD_SWITCH_SYSTEM_TEMACS LD_SWITCH_MACHINE LD_SWITCH_MACHINE_TEMACS LD_SWITCH_SITE
/* A macro which other sections of Makefile can redefine to munge the
flags before they're passed to LD. This is helpful if you have
#endif
#endif
+#ifdef HAVE_CARBON
+mac = $(dot)$(dot)/mac/
+XMENU_OBJ =
+MAC_OBJ = mac.o macterm.o macfns.o macmenu.o fontset.o
+emacsapp = $(PWD)/$(mac)Emacs.app/
+emacsappsrc = ${srcdir}/../mac/Emacs.app/
+#else
+XMENU_OBJ = xmenu.o
+#endif
/* 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.o window.o \
- charset.o coding.o category.o ccl.o\
- character.o chartab.o\
+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 xfaces.o $(XOBJ) \
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)
+ $(MSDOS_OBJ) $(MAC_OBJ)
/* Object files used on some machine or other.
These go in the DOC file on all machines
in case they are needed there. */
SOME_MACHINE_OBJECTS = sunfns.o dosfns.o msdos.o \
- xterm.o xfns.o xmenu.o xselect.o xrdb.o
+ xterm.o xfns.o xmenu.o xselect.o xrdb.o \
+ mac.o macterm.o macfns.o macmenu.o fontset.o
#ifdef TERMINFO
${lispsource}abbrev.elc \
${lispsource}buff-menu.elc \
${lispsource}button.elc \
- ${lispsource}byte-run.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}format.elc \
${lispsource}facemenu.elc \
MOUSE_SUPPORT \
- ${lispsource}float-sup.elc \
- ${lispsource}frame.elc\
+ ${lispsource}emacs-lisp/float-sup.elc \
+ ${lispsource}frame.elc \
${lispsource}help.elc \
${lispsource}indent.elc \
${lispsource}isearch.elc \
${lispsource}loadup.el \
${lispsource}loaddefs.el \
${lispsource}bindings.elc \
- ${lispsource}map-ynp.elc \
+ ${lispsource}emacs-lisp/map-ynp.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}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/malayalam.el \
+ ${lispsource}language/tamil.el \
${lispsource}language/english.el \
${lispsource}language/ethiopic.elc \
${lispsource}language/european.elc \
${lispsource}language/lao.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}startup.elc \
${lispsource}subr.elc \
${lispsource}term/tty-colors.elc \
+ ${lispsource}font-core.elc \
${lispsource}textmodes/fill.elc \
${lispsource}textmodes/page.elc \
${lispsource}textmodes/paragraphs.elc \
${lispsource}textmodes/text-mode.elc \
+ ${lispsource}emacs-lisp/timer.elc \
${lispsource}vc-hooks.elc \
${lispsource}ediff-hook.elc \
VMS_SUPPORT \
../lisp/abbrev.elc \
../lisp/buff-menu.elc \
../lisp/button.elc \
- ../lisp/byte-run.elc \
+ ../lisp/emacs-lisp/byte-run.elc \
+ ../lisp/composite.elc \
+ ../lisp/cus-face.elc \
../lisp/cus-start.elc \
../lisp/custom.elc \
../lisp/emacs-lisp/backquote.elc \
../lisp/facemenu.elc \
../lisp/faces.elc \
../lisp/files.elc \
- ../lisp/float-sup.elc \
+ ../lisp/emacs-lisp/float-sup.elc \
../lisp/format.elc \
../lisp/frame.elc \
../lisp/help.elc \
../lisp/loadup.el \
../lisp/loaddefs.el \
../lisp/bindings.elc \
- ../lisp/map-ynp.elc \
+ ../lisp/emacs-lisp/map-ynp.elc \
../lisp/env.elc \
../lisp/international/mule.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/malayalam.el \
+ ../lisp/language/tamil.el \
../lisp/language/english.el \
../lisp/language/ethiopic.elc \
../lisp/language/european.elc \
../lisp/language/lao.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/startup.elc \
../lisp/subr.elc \
../lisp/term/tty-colors.elc \
+ ../lisp/font-core.elc \
../lisp/textmodes/fill.elc \
../lisp/textmodes/page.elc \
../lisp/textmodes/paragraphs.elc \
../lisp/textmodes/text-mode.elc \
+ ../lisp/emacs-lisp/timer.elc \
../lisp/vc-hooks.elc \
../lisp/ediff-hook.elc \
../lisp/widget.elc \
We must unconditionally put them in the DOC file.
We use ../lisp/ to start the file names
to reduce the size of the argument list for make-docfile
- for the sake of systems which can't handle large ones. */
+ for the sake of systems which can\'t handle large ones. */
SOME_MACHINE_LISP = ${dotdot}/lisp/mouse.elc \
${dotdot}/lisp/select.elc ${dotdot}/lisp/scroll-bar.elc \
${dotdot}/lisp/vmsproc.elc ${dotdot}/lisp/vms-patch.elc \
#define OBJECTS_MACHINE
#endif
-all: emacs OTHER_FILES
+all: emacs${EXEEXT} OTHER_FILES
-emacs: temacs ${etc}DOC ${lisp}
+emacs${EXEEXT}: temacs${EXEEXT} ${etc}DOC ${lisp}
#ifdef CANNOT_DUMP
- rm -f emacs
- ln temacs emacs
+ rm -f emacs${EXEEXT}
+ ln temacs${EXEEXT} emacs${EXEEXT}
#else
#ifdef HAVE_SHM
LC_ALL=C ./temacs -nl -batch -l loadup dump
${libsrc}make-docfile -d ${srcdir} ${SOME_MACHINE_OBJECTS} ${obj} > ${etc}DOC
${libsrc}make-docfile -a ${etc}DOC -d ${srcdir} ${SOME_MACHINE_LISP} ${shortlisp}
-${libsrc}make-docfile:
- cd ${libsrc}; ${MAKE} ${MFLAGS} make-docfile
+${libsrc}make-docfile${EXEEXT}:
+ cd ${libsrc}; ${MAKE} ${MFLAGS} make-docfile${EXEEXT}
/* Some systems define this to cause parallel Make-ing. */
#ifndef MAKE_PARALLEL
#define MAKE_PARALLEL
#endif
-temacs: MAKE_PARALLEL $(LOCALCPP) $(STARTFILES) stamp-oldxmenu ${obj} ${otherobj} OBJECTS_MACHINE prefix-args
- $(LD) YMF_PASS_LDFLAGS (${STARTFLAGS} ${ALL_LDFLAGS}) \
+temacs${EXEEXT}: MAKE_PARALLEL $(LOCALCPP) $(STARTFILES) stamp-oldxmenu ${obj} ${otherobj} OBJECTS_MACHINE prefix-args${EXEEXT}
+ $(LD) YMF_PASS_LDFLAGS (${STARTFLAGS} ${TEMACS_LDFLAGS}) $(LDFLAGS) \
-o temacs ${STARTFILES} ${obj} ${otherobj} \
OBJECTS_MACHINE ${LIBES}
/* We don't use ALL_LDFLAGS because LD_SWITCH_SYSTEM and LD_SWITCH_MACHINE
often contain options that have to do with using Emacs's crt0,
which are only good with temacs. */
-prefix-args: prefix-args.c $(config_h)
+prefix-args${EXEEXT}: prefix-args.c $(config_h)
$(CC) $(ALL_CFLAGS) $(LDFLAGS) ${srcdir}/prefix-args.c -o prefix-args
/* Don't lose if this was not defined. */
to both ensure that lwlib gets remade based on its dependencies
in its own makefile,
and remake temacs if lwlib gets changed by this. */
-stamp-oldxmenu: ${OLDXMENU} ../src/$(OLDXMENU)
+stamp-oldxmenu: ${OLDXMENU} ../src/$(OLDXMENU)
touch stamp-oldxmenu
/* Supply an ordering for parallel make. */
../src/$(OLDXMENU): ${OLDXMENU}
#endif /* not USE_X_TOOLKIT */
#else /* not (HAVE_X_WINDOWS && HAVE_X11 && HAVE_MENUS) */
-/* We don't really need this, but satisfy the dependency. */
+/* We don\'t really need this, but satisfy the dependency. */
stamp-oldxmenu:
touch stamp-oldxmenu
#endif /* not (HAVE_X_WINDOWS && HAVE_X11 && HAVE_MENUS) */
whenever emacs was #defined, but that's not appropriate for all
users of alloca in Emacs. Check out ../lib-src/getopt.c. */
alloca.o : alloca.c
- $(CC) -c $(CPPFLAGS) -DEMACS_FREE=xfree \
+ $(CC) -c $(CPPFLAGS) -DEMACS_FREE=xfree -DDO_BLOCK_INPUT \
$(ALL_CFLAGS) ${srcdir}/alloca.c
#else
#ifndef HAVE_ALLOCA
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 charset.h \
+ abbrev.o: abbrev.c buffer.h window.h dispextern.h commands.h character.h \
- syntax.h $(config_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 \
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
++ process.h systty.h syssignal.h character.h coding.h ccl.h msdos.h \
+ composite.h
- casefiddle.o: casefiddle.c syntax.h commands.h buffer.h composite.h $(config_h)
+ casefiddle.o: casefiddle.c syntax.h commands.h buffer.h character.h \
+ composite.h $(config_h)
casetab.o: casetab.c buffer.h $(config_h)
- category.o: category.c category.h buffer.h charset.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 $(config_h)
+ category.o: category.c category.h buffer.h charset.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 composite.h \
+ $(config_h)
cm.o: cm.c cm.h termhooks.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
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
+ dired.o: dired.c commands.h buffer.h $(config_h) character.h charset.h \
+ coding.h regex.h systime.h
-dispnew.o: dispnew.c commands.h frame.h window.h buffer.h dispextern.h \
- termchar.h termopts.h termhooks.h cm.h disptab.h systty.h systime.h \
+dispnew.o: dispnew.c systty.h systime.h commands.h process.h frame.h \
+ window.h buffer.h dispextern.h termchar.h termopts.h termhooks.h cm.h \
+ disptab.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 charset.h
- doprnt.o: doprnt.c charset.h $(config_h)
+ doc.o: doc.c $(config_h) epaths.h buffer.h keyboard.h character.h
+ doprnt.o: doprnt.c character.h $(config_h)
dosfns.o: buffer.h termchar.h termhooks.h frame.h msdos.h dosfns.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 $(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)
- 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 ccl.h msdos.h dispextern.h $(config_h)
- filelock.o: filelock.c buffer.h systime.h epaths.h $(config_h)
-filelock.o: filelock.c buffer.h charset.h coding.h systime.h epaths.h \
- $(config_h) character.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 \
- buffer.h character.h fontset.h msdos.h dosfns.h dispextern.h $(config_h)
++ blockinput.h atimer.h systime.h buffer.h character.h fontset.h \
+ msdos.h dosfns.h dispextern.h $(config_h)
- fontset.o: dispextern.h fontset.h fontset.c ccl.h buffer.h charset.h frame.h \
- keyboard.h $(config_h)
+ fontset.o: dispextern.h fontset.h fontset.c ccl.h buffer.h character.h \
+ charset.h frame.h keyboard.h $(config_h)
getloadavg.o: getloadavg.c $(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 $(config_h) region-cache.h
+ dispextern.h atimer.h systime.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 \
systty.h systime.h dispextern.h syntax.h $(INTERVAL_SRC) blockinput.h \
atimer.h xterm.h puresize.h msdos.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 $(config_h)
- atimer.h systime.h puresize.h character.h charset.h $(INTERVAL_SRC) $(config_h)
++ atimer.h systime.h puresize.h character.h intervals.h $(config_h)
lastfile.o: lastfile.c $(config_h)
macros.o: macros.c window.h buffer.h commands.h macros.h keyboard.h \
dispextern.h $(config_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 $(config_h)
+ buffer.h commands.h character.h msdos.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 $(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 character.h coding.h ccl.h msdos.h composite.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
scroll.o: scroll.c termchar.h dispextern.h frame.h msdos.h keyboard.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 $(config_h)
+ blockinput.h atimer.h systime.h category.h character.h composite.h \
+ $(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 $(config_h)
-sysdep.o: sysdep.c $(config_h) dispextern.h termhooks.h termchar.h termopts.h \
- frame.h syssignal.h systty.h systime.h syswait.h blockinput.h atimer.h \
- window.h msdos.h dosfns.h keyboard.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 $(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
+ disptab.h dispextern.h keyboard.h character.h charset.h coding.h ccl.h \
+ msdos.h keymap.h
termcap.o: termcap.c $(config_h)
terminfo.o: terminfo.c $(config_h)
tparam.o: tparam.c $(config_h)
window.o: window.c indent.h commands.h frame.h window.h buffer.h termchar.h \
termhooks.h disptab.h keyboard.h dispextern.h msdos.h composite.h \
$(config_h)
-xdisp.o: xdisp.c macros.h commands.h indent.h buffer.h dispextern.h coding.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) \
- msdos.h composite.h fontset.h blockinput.h atimer.h systime.h keymap.h
+ termchar.h frame.h window.h disptab.h termhooks.h character.h charset.h \
- $(config_h) msdos.h composite.h fontset.h region-cache.h
++ $(config_h) msdos.h composite.h fontset.h blockinput.h atimer.h systime.h \
++ keymap.h region-cache.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 $(config_h)
+ window.h character.h charset.h msdos.h dosfns.h composite.h atimer.h \
+ systime.h fontset.h $(config_h) $(INTERVAL_SRC)
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 $(config_h)
- character.h charset.h coding.h $(config_h) termhooks.h coding.h
++ character.h charset.h coding.h gtkutil.h $(config_h) termhooks.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 $(config_h)
+ charset.h keyboard.h $(srcdir)/../lwlib/lwlib.h blockinput.h atimer.h \
- systime.h msdos.h $(config_h) coding.h
++ systime.h gtkutil.h msdos.h $(config_h) coding.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 $(config_h) $(INTERVAL_SRC)
-xselect.o: xselect.c dispextern.h frame.h xterm.h blockinput.h character.h \
- coding.h composite.h ccl.h buffer.h atimer.h systime.h $(config_h)
++ coding.h process.h gtkutil.h $(config_h)
+xselect.o: xselect.c process.h dispextern.h frame.h xterm.h blockinput.h \
+ buffer.h atimer.h systime.h $(config_h)
xrdb.o: xrdb.c $(config_h) epaths.h
+xsmfns.o: xsmfns.c $(config_h) systime.h sysselect.h termhooks.h
+gtkutil.o: gtkutil.c gtkutil.h xterm.h lisp.h frame.h $(config_h) \
+ blockinput.h window.h atimer.h termhooks.h
+
hftctl.o: hftctl.c $(config_h)
sound.o: sound.c dispextern.h $(config_h)
atimer.o: atimer.c atimer.h systime.h $(config_h)
/* The files of Lisp proper */
-alloc.o: alloc.c frame.h window.h buffer.h puresize.h syssignal.h keyboard.h \
+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 $(config_h)
- data.o: data.c buffer.h puresize.h charset.h syssignal.h keyboard.h $(config_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 $(config_h)
+ data.o: data.c buffer.h puresize.h character.h syssignal.h keyboard.h \
+ $(config_h)
eval.o: eval.c commands.h keyboard.h blockinput.h atimer.h systime.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 \
- frame.h window.h dispextern.h coding.h $(INTERVAL_SRC)
+ frame.h window.h dispextern.h $(INTERVAL_SRC) coding.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 msdos.h composite.h
- lread.o: lread.c commands.h keyboard.h buffer.h epaths.h charset.h $(config_h) \
- termhooks.h coding.h msdos.h
+ lread.o: lread.c commands.h keyboard.h buffer.h epaths.h character.h \
- charset.h $(config_h) termhooks.h msdos.h coding.h
++ charset.h $(config_h) 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 $(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
sunfns.o: sunfns.c buffer.h window.h dispextern.h $(config_h)
-${libsrc}emacstool: ${libsrc}emacstool.c
- cd ${libsrc}; ${MAKE} ${MFLAGS} emacstool
+#ifdef HAVE_CARBON
+abbrev.o buffer.o callint.o cmds.o dispnew.o editfns.o fileio.o frame.o \
+ fontset.o indent.o insdel.o keyboard.o macros.o minibuf.o msdos.o process.o \
+ scroll.o sysdep.o term.o widget.o window.o xdisp.o xfaces.o xfns.o xmenu.o \
+ xterm.o xselect.o sound.o: macgui.h
+mac.o: mac.c process.h sysselect.h systime.h $(config_h)
+macfns.o: macfns.c charset.h macterm.h macgui.h frame.h window.h buffer.h \
+ dispextern.h macgui.h fontset.h $(INTERVAL_SRC) keyboard.h blockinput.h \
+ atimer.h systime.h epaths.h termhooks.h coding.h ccl.h systime.h $(config_h)
+macmenu.o: macmenu.c termhooks.h frame.h window.h dispextern.h macgui.h \
+ keyboard.h blockinput.h atimer.h systime.h buffer.h macterm.h $(config_h)
+macterm.o: blockinput.h atimer.h systime.h syssignal.h macterm.h macgui.h \
+ frame.h charset.h ccl.h dispextern.h fontset.h termhooks.h termopts.h \
+ termchar.h gnu.h disptab.h buffer.h window.h keyboard.h $(INTERVAL_SRC) \
+ process.h coding.h $(config_h)
+
+${emacsapp}Contents/Resources/English.lproj:
+ mkdir -p $@
+
+ifneq (${emacsapp},${emacsappsrc})
+${emacsapp}Contents/Info.plist: ${emacsappsrc}Contents/Info.plist
+ cp $< $@
+${emacsapp}Contents/PkgInfo: ${emacsappsrc}Contents/PkgInfo
+ cp $< $@
+${emacsapp}Contents/Resources/Emacs.icns: ${emacsappsrc}Contents/Resources/Emacs.icns
+ mkdir -p ${emacsapp}Contents/Resources
+ cp $< $@
+${emacsapp}Contents/Resources/English.lproj/InfoPlist.strings: ${emacsappsrc}Contents/Resources/English.lproj/InfoPlist.strings
+ cp $< $@
+endif
+
+macosx-bundle: ${emacsapp}Contents/Resources/English.lproj \
+ ${emacsapp}Contents/Info.plist ${emacsapp}Contents/PkgInfo \
+ ${emacsapp}Contents/Resources/Emacs.icns \
+ ${emacsapp}Contents/Resources/English.lproj/InfoPlist.strings
+macosx-app: macosx-bundle ${emacsapp}Contents/MacOS/Emacs \
+ ${emacsapp}Contents/Resources/Emacs.rsrc
+${emacsapp}Contents/MacOS/Emacs: emacs${EXEEXT}
+ mkdir -p ${emacsapp}Contents/MacOS/;
+ cd ${emacsapp}Contents/MacOS/; cp ../../../../src/emacs${EXEEXT} Emacs${EXEEXT}
+${emacsapp}Contents/Resources/Emacs.rsrc: ../mac/src/Emacs.r
+ /Developer/Tools/Rez -useDF \
+ -o ${emacsapp}Contents/Resources/Emacs.rsrc \
+ /System/Library/Frameworks/Carbon.framework/Headers/Carbon.r $<
+#endif
+
+${libsrc}emacstool${EXEEXT}: ${libsrc}emacstool.c
+ cd ${libsrc}; ${MAKE} ${MFLAGS} emacstool${EXEEXT}
+bootstrapclean:
+ rm -f bootstrap-emacs${EXEEXT}
mostlyclean:
- rm -f temacs prefix-args core *.core \#* *.o libXMenu11.a liblw.a
+ rm -f temacs${EXEEXT} prefix-args${EXEEXT} core *.core \#* *.o libXMenu11.a liblw.a
rm -f ../etc/DOC
- rm -f bootstrap-emacs
+ rm -f bootstrap-emacs${EXEEXT}
clean: mostlyclean
- rm -f emacs-* emacs
+ rm -f emacs-*${EXEEXT} emacs${EXEEXT}
/**/# This is used in making a distribution.
/**/# Do not use it on development directories!
distclean: clean
@echo "it deletes files that may require special tools to rebuild."
rm -f TAGS
versionclean:
- -rm -f emacs emacs-* ../etc/DOC*
+ -rm -f emacs${EXEEXT} emacs-* ../etc/DOC*
extraclean: distclean
-rm -f *~ \#* m/?*~ s/?*~
/* Arrange to make a tags table TAGS-LISP for ../lisp,
plus TAGS for the C files, which includes ../lisp/TAGS by reference. */
-ctagsfiles1 = [xyzXYZ]*.[hc]
+ctagsfiles1 = [xyzXYZ]*.[hc]
ctagsfiles2 = [a-wA-W]*.[hc]
TAGS: $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2)
/* Bootstrapping. */
-bootstrap: bootstrap-emacs
-
-/* Build a temacs with a sufficiently large PURESIZE to load the
- Lisp files from loadup.el in source form. */
-
-bootstrap-temacs:
- LC_ALL=C $(MAKE) $(MFLAGS) temacs ALL_CFLAGS="$(ALL_CFLAGS) -DPURESIZE=5000000 -I../src"
-
-/* Build a DOC file. */
-
-bootstrap-doc: ${libsrc}make-docfile
- -rm -f ${etc}DOC
- els=`echo ${shortlisp} ${SOME_MACHINE_LISP} \
- | sed -e "s/\\.elc/.el/g"`; \
- ${libsrc}make-docfile -d ${srcdir} $$els ${obj} > ${etc}DOC
+bootstrap: bootstrap-emacs${EXEEXT}
-/* Dump an Emacs executable named bootstrap-emacs containing the
+/* Dump an Emacs executable named bootstrap-emacs containing the
files from loadup.el in source form. */
-bootstrap-emacs: bootstrap-temacs bootstrap-doc
+bootstrap-emacs${EXEEXT}: temacs${EXEEXT}
#ifdef CANNOT_DUMP
- ln temacs bootstrap-emacs
+ ln temacs${EXEEXT} bootstrap-emacs${EXEEXT}
#else
#ifdef HAVE_SHM
./temacs -nl -batch -l loadup bootstrap
#else /* ! defined (HAVE_SHM) */
./temacs --batch --load loadup bootstrap
#endif /* ! defined (HAVE_SHM) */
+ mv -f emacs${EXEEXT} bootstrap-emacs${EXEEXT}
#endif /* ! defined (CANNOT_DUMP) */
- mv -f emacs bootstrap-emacs
- rm -f temacs
#include "commands.h"
#include "buffer.h"
#include "window.h"
- #include "charset.h"
+ #include "character.h"
#include "syntax.h"
/* An abbrev table is an obarray.
/* Character address of start of last abbrev expanded */
-int last_abbrev_point;
+EMACS_INT last_abbrev_point;
/* Hook to run before expanding any abbrev. */
doc: /* Create a new, empty abbrev table object. */)
()
{
+ /* The value 59 is arbitrary chosen prime number. */
return Fmake_vector (make_number (59), make_number (0));
}
p = buffer = (char *) alloca (wordend_byte - wordstart_byte);
- for (idx = wordstart, idx_byte = wordstart_byte; idx < wordend;)
+ for (idx = wordstart, idx_byte = wordstart_byte; idx < wordend; )
{
register int c;
- FETCH_CHAR_ADVANCE (c, idx, idx_byte);
- if (! multibyte)
- MAKE_CHAR_MULTIBYTE (c);
+ if (multibyte)
+ {
+ FETCH_CHAR_ADVANCE (c, idx, idx_byte);
+ }
+ else
+ {
+ c = FETCH_BYTE (idx_byte);
+ idx++, idx_byte++;
+ }
if (UPPERCASEP (c))
c = DOWNCASE (c), uccount++;
else if (! NOCASEP (c))
lccount++;
if (multibyte)
- CHAR_STRING_ADVANCE (c, p);
+ p += CHAR_STRING (c, p);
else
- {
- MAKE_CHAR_UNIBYTE (c);
- *p++ = c;
- }
+ *p++ = c;
}
if (VECTORP (current_buffer->abbrev_table))
if (INTEGERP (XSYMBOL (sym)->plist))
XSETINT (XSYMBOL (sym)->plist,
XINT (XSYMBOL (sym)->plist) + 1);
- else if (!NILP (tem = Fget (sym, Qcount)))
+ else if (INTEGERP (tem = Fget (sym, Qcount)))
Fput (sym, Qcount, make_number (XINT (tem) + 1));
/* If this abbrev has an expansion, delete the abbrev
del_range_both (wordstart, wordstart_byte, wordend, wordend_byte, 1);
- insert_from_string (expansion, 0, 0, XSTRING (expansion)->size,
- STRING_BYTES (XSTRING (expansion)), 1);
+ insert_from_string (expansion, 0, 0, SCHARS (expansion),
+ SBYTES (expansion), 1);
SET_PT (PT + whitecnt);
if (uccount && !lccount)
int pos = wordstart_byte;
/* Find the initial. */
-- while (pos < PT_BYTE
- && SYNTAX (*BUF_BYTE_ADDRESS (current_buffer, pos)) != Sword)
- && SYNTAX (FETCH_CHAR_AS_MULTIBYTE (pos)) != Sword)
-- pos++;
++ if (multibyte)
++ while (pos < PT_BYTE
++ && SYNTAX (FETCH_MULTIBYTE_CHAR (pos)) != Sword)
++ INC_POS (pos);
++ else
++ while (pos < PT_BYTE
++ && (SYNTAX (*BUF_BYTE_ADDRESS (current_buffer, pos))
++ != Sword))
++ pos++;
/* Change just that. */
pos = BYTE_TO_CHAR (pos);
/* If the abbrev has a hook function, run it. */
expanded = call0 (hook);
- /* In addition, if the hook function is a symbol with a a
- non-nil `no-self-insert' property, let the value it returned
+ /* In addition, if the hook function is a symbol with
+ a non-nil `no-self-insert' property, let the value it returned
specify whether we consider that an expansion took place. If
it returns nil, no expansion has been done. */
if (!STRINGP (val))
error ("value of abbrev-symbol must be a string");
zv_before = ZV;
- del_range_byte (PT_BYTE, PT_BYTE + STRING_BYTES (XSTRING (val)), 1);
+ del_range_byte (PT_BYTE, PT_BYTE + SBYTES (val), 1);
/* Don't inherit properties here; just copy from old contents. */
insert_from_string (Vlast_abbrev_text, 0, 0,
- XSTRING (Vlast_abbrev_text)->size,
- STRING_BYTES (XSTRING (Vlast_abbrev_text)), 0);
+ SCHARS (Vlast_abbrev_text),
+ SBYTES (Vlast_abbrev_text), 0);
Vlast_abbrev_text = Qnil;
/* Total number of characters deleted. */
adjust = ZV - zv_before;
return;
insert (" (", 5);
- XSETSTRING (name, XSYMBOL (sym)->name);
+ name = SYMBOL_NAME (sym);
Fprin1 (name, stream);
insert (" ", 1);
Fprin1 (SYMBOL_VALUE (sym), stream);
}
CHECK_VECTOR (table);
- for (; !NILP (definitions); definitions = Fcdr (definitions))
+ for (; CONSP (definitions); definitions = XCDR (definitions))
{
- elt = Fcar (definitions);
+ elt = XCAR (definitions);
name = Fcar (elt); elt = Fcdr (elt);
exp = Fcar (elt); elt = Fcdr (elt);
hook = Fcar (elt); elt = Fcdr (elt);
DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location,
doc: /* Buffer position for `expand-abbrev' to use as the start of the abbrev.
-nil means use the word before point as the abbrev.
+When nil, use the word before point as the abbrev.
Calling `expand-abbrev' sets this to nil. */);
Vabbrev_start_location = Qnil;
/* Storage allocation and gc for GNU Emacs Lisp interpreter.
- Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001, 2002
+ Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001, 2002, 2003
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <config.h>
#include <stdio.h>
+#include <limits.h> /* For CHAR_BIT. */
+
+#ifdef ALLOC_DEBUG
+#undef INLINE
+#endif
/* Note that this declares bzero on OSF/1. How dumb. */
#include "keyboard.h"
#include "frame.h"
#include "blockinput.h"
- #include "charset.h"
+ #include "character.h"
#include "syssignal.h"
#include <setjmp.h>
#endif /* not DOUG_LEA_MALLOC */
-/* Macro to verify that storage intended for Lisp objects is not
- out of range to fit in the space for a pointer.
- ADDRESS is the start of the block, and SIZE
- is the amount of space within which objects can start. */
-
-#define VALIDATE_LISP_STORAGE(address, size) \
-do \
- { \
- Lisp_Object val; \
- XSETCONS (val, (char *) address + size); \
- if ((char *) XCONS (val) != (char *) address + size) \
- { \
- xfree (address); \
- memory_full (); \
- } \
- } while (0)
-
/* Value of _bytes_used, when spare_memory was freed. */
static __malloc_size_t bytes_used_when_full;
/* Mark, unmark, query mark bit of a Lisp string. S must be a pointer
to a struct Lisp_String. */
-#define MARK_STRING(S) ((S)->size |= MARKBIT)
-#define UNMARK_STRING(S) ((S)->size &= ~MARKBIT)
-#define STRING_MARKED_P(S) ((S)->size & MARKBIT)
+#define MARK_STRING(S) ((S)->size |= ARRAY_MARK_FLAG)
+#define UNMARK_STRING(S) ((S)->size &= ~ARRAY_MARK_FLAG)
+#define STRING_MARKED_P(S) ((S)->size & ARRAY_MARK_FLAG)
+
+#define VECTOR_MARK(V) ((V)->size |= ARRAY_MARK_FLAG)
+#define VECTOR_UNMARK(V) ((V)->size &= ~ARRAY_MARK_FLAG)
+#define VECTOR_MARKED_P(V) ((V)->size & ARRAY_MARK_FLAG)
/* Value is the number of bytes/chars of S, a pointer to a struct
Lisp_String. This must be used instead of STRING_BYTES (S) or
S->size during GC, because S->size contains the mark bit for
strings. */
-#define GC_STRING_BYTES(S) (STRING_BYTES (S) & ~MARKBIT)
-#define GC_STRING_CHARS(S) ((S)->size & ~MARKBIT)
+#define GC_STRING_BYTES(S) (STRING_BYTES (S))
+#define GC_STRING_CHARS(S) ((S)->size & ~ARRAY_MARK_FLAG)
/* Number of bytes of consing done since the last gc. */
/* Count the amount of consing of various sorts of space. */
-int cons_cells_consed;
-int floats_consed;
-int vector_cells_consed;
-int symbols_consed;
-int string_chars_consed;
-int misc_objects_consed;
-int intervals_consed;
-int strings_consed;
+EMACS_INT cons_cells_consed;
+EMACS_INT floats_consed;
+EMACS_INT vector_cells_consed;
+EMACS_INT symbols_consed;
+EMACS_INT string_chars_consed;
+EMACS_INT misc_objects_consed;
+EMACS_INT intervals_consed;
+EMACS_INT strings_consed;
/* Number of bytes of consing since GC before another GC should be done. */
-int gc_cons_threshold;
+EMACS_INT gc_cons_threshold;
/* Nonzero during GC. */
int gc_in_progress;
+/* Nonzero means abort if try to GC.
+ This is for code which is written on the assumption that
+ no GC will happen, so as to verify that assumption. */
+
+int abort_on_gc;
+
/* Nonzero means display messages at beginning and end of GC. */
int garbage_collection_messages;
/* Two limits controlling how much undo information to keep. */
-int undo_limit;
-int undo_strong_limit;
+EMACS_INT undo_limit;
+EMACS_INT undo_strong_limit;
/* Number of live and free conses etc. */
Lisp_Object Vpurify_flag;
+/* Non-nil means we are handling a memory-full error. */
+
+Lisp_Object Vmemory_full;
+
#ifndef HAVE_SHM
-/* Force it into data space! */
+/* Force it into data space! Initialize it to a nonzero value;
+ otherwise some compilers put it into BSS. */
-EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,};
+EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {1,};
#define PUREBEG (char *) pure
#else /* HAVE_SHM */
/* Index in pure at which next pure object will be allocated.. */
-int pure_bytes_used;
+EMACS_INT pure_bytes_used;
/* If nonzero, this is a warning delivered by malloc and not yet
displayed. */
/* Pre-computed signal argument for use when memory is exhausted. */
-Lisp_Object memory_signal_data;
+Lisp_Object Vmemory_signal_data;
/* Maximum amount of C stack to save when a GC happens. */
Lisp_Object Vpost_gc_hook, Qpost_gc_hook;
+Lisp_Object Vgc_elapsed; /* accumulated elapsed time in GC */
+EMACS_INT gcs_done; /* accumulated GCs */
+
static void mark_buffer P_ ((Lisp_Object));
-static void mark_kboards P_ ((void));
+extern void mark_kboards P_ ((void));
static void gc_sweep P_ ((void));
static void mark_glyph_matrix P_ ((struct glyph_matrix *));
static void mark_face_cache P_ ((struct face_cache *));
struct mem_node
{
- struct mem_node *left, *right, *parent;
+ /* Children of this node. These pointers are never NULL. When there
+ is no child, the value is MEM_NIL, which points to a dummy node. */
+ struct mem_node *left, *right;
+
+ /* The parent of this node. In the root node, this is NULL. */
+ struct mem_node *parent;
/* Start and end of allocated region. */
void *start, *end;
/* Node color. */
enum {MEM_BLACK, MEM_RED} color;
-
+
/* Memory type. */
enum mem_type type;
};
struct gcpro *gcprolist;
-/* Addresses of staticpro'd variables. */
+/* Addresses of staticpro'd variables. Initialize it to a nonzero
+ value; otherwise some compilers put it into BSS. */
#define NSTATICS 1280
-Lisp_Object *staticvec[NSTATICS] = {0};
+Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
/* Index of next unused slot in staticvec. */
/* Value is SZ rounded up to the next multiple of ALIGNMENT.
ALIGNMENT must be a power of 2. */
-#define ALIGN(SZ, ALIGNMENT) \
- (((SZ) + (ALIGNMENT) - 1) & ~((ALIGNMENT) - 1))
+#define ALIGN(ptr, ALIGNMENT) \
+ ((POINTER_TYPE *) ((((EMACS_UINT)(ptr)) + (ALIGNMENT) - 1) \
+ & ~((ALIGNMENT) - 1)))
\f
Malloc
************************************************************************/
-/* Write STR to Vstandard_output plus some advice on how to free some
- memory. Called when memory gets low. */
-
-Lisp_Object
-malloc_warning_1 (str)
- Lisp_Object str;
-{
- Fprinc (str, Vstandard_output);
- write_string ("\nKilling some buffers may delay running out of memory.\n", -1);
- write_string ("However, certainly by the time you receive the 95% warning,\n", -1);
- write_string ("you should clean up, kill this Emacs, and start a new one.", -1);
- return Qnil;
-}
-
-
-/* Function malloc calls this if it finds we are near exhausting
- storage. */
+/* Function malloc calls this if it finds we are near exhausting storage. */
void
malloc_warning (str)
}
-/* Display a malloc warning in buffer *Danger*. */
+/* Display an already-pending malloc warning. */
void
display_malloc_warning ()
{
- register Lisp_Object val;
-
- val = build_string (pending_malloc_warning);
+ call3 (intern ("display-warning"),
+ intern ("alloc"),
+ build_string (pending_malloc_warning),
+ intern ("emergency"));
pending_malloc_warning = 0;
- internal_with_output_to_temp_buffer (" *Danger*", malloc_warning_1, val);
}
void
memory_full ()
{
+ Vmemory_full = Qt;
+
#ifndef SYSTEM_MALLOC
bytes_used_when_full = BYTES_USED;
#endif
/* This used to call error, but if we've run out of memory, we could
get infinite recursion trying to build the string. */
while (1)
- Fsignal (Qnil, memory_signal_data);
+ Fsignal (Qnil, Vmemory_signal_data);
}
memory_full ();
#endif
+ Vmemory_full = Qt;
+
/* This used to call error, but if we've run out of memory, we could
get infinite recursion trying to build the string. */
while (1)
- Fsignal (Qerror, memory_signal_data);
+ Fsignal (Qnil, Vmemory_signal_data);
}
char *
xstrdup (s)
- char *s;
+ const char *s;
{
size_t len = strlen (s) + 1;
char *p = (char *) xmalloc (len);
number of bytes to allocate, TYPE describes the intended use of the
allcated memory block (for strings, for conses, ...). */
+static void *lisp_malloc_loser;
+
static POINTER_TYPE *
lisp_malloc (nbytes, type)
size_t nbytes;
#ifdef GC_MALLOC_CHECK
allocated_mem_type = type;
#endif
-
+
val = (void *) malloc (nbytes);
+ /* If the memory just allocated cannot be addressed thru a Lisp
+ object's pointer, and it needs to be,
+ that's equivalent to running out of memory. */
+ if (val && type != MEM_TYPE_NON_LISP)
+ {
+ Lisp_Object tem;
+ XSETCONS (tem, (char *) val + nbytes - 1);
+ if ((char *) XCONS (tem) != (char *) val + nbytes - 1)
+ {
+ lisp_malloc_loser = val;
+ free (val);
+ val = 0;
+ }
+ }
+
#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
if (val && type != MEM_TYPE_NON_LISP)
mem_insert (val, (char *) val + nbytes, type);
#endif
-
+
UNBLOCK_INPUT;
if (!val && nbytes)
memory_full ();
return val;
}
+/* Free BLOCK. This must be called to free memory allocated with a
+ call to lisp_malloc. */
-/* Return a new buffer structure allocated from the heap with
- a call to lisp_malloc. */
-
-struct buffer *
-allocate_buffer ()
+static void
+lisp_free (block)
+ POINTER_TYPE *block;
{
- struct buffer *b
- = (struct buffer *) lisp_malloc (sizeof (struct buffer),
- MEM_TYPE_BUFFER);
- VALIDATE_LISP_STORAGE (b, sizeof *b);
- return b;
+ BLOCK_INPUT;
+ free (block);
+#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+ mem_delete (mem_find (block));
+#endif
+ UNBLOCK_INPUT;
}
+/* Allocation of aligned blocks of memory to store Lisp data. */
+/* The entry point is lisp_align_malloc which returns blocks of at most */
+/* BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */
-/* Free BLOCK. This must be called to free memory allocated with a
- call to lisp_malloc. */
+
+/* BLOCK_ALIGN has to be a power of 2. */
+#define BLOCK_ALIGN (1 << 10)
+
+/* Padding to leave at the end of a malloc'd block. This is to give
+ malloc a chance to minimize the amount of memory wasted to alignment.
+ It should be tuned to the particular malloc library used.
+ On glibc-2.3.2, malloc never tries to align, so a padding of 0 is best.
+ posix_memalign on the other hand would ideally prefer a value of 4
+ because otherwise, there's 1020 bytes wasted between each ablocks.
+ But testing shows that those 1020 will most of the time be efficiently
+ used by malloc to place other objects, so a value of 0 is still preferable
+ unless you have a lot of cons&floats and virtually nothing else. */
+#define BLOCK_PADDING 0
+#define BLOCK_BYTES \
+ (BLOCK_ALIGN - sizeof (struct aligned_block *) - BLOCK_PADDING)
+
+/* Internal data structures and constants. */
+
+#define ABLOCKS_SIZE 16
+
+/* An aligned block of memory. */
+struct ablock
+{
+ union
+ {
+ char payload[BLOCK_BYTES];
+ struct ablock *next_free;
+ } x;
+ /* `abase' is the aligned base of the ablocks. */
+ /* It is overloaded to hold the virtual `busy' field that counts
+ the number of used ablock in the parent ablocks.
+ The first ablock has the `busy' field, the others have the `abase'
+ field. To tell the difference, we assume that pointers will have
+ integer values larger than 2 * ABLOCKS_SIZE. The lowest bit of `busy'
+ is used to tell whether the real base of the parent ablocks is `abase'
+ (if not, the word before the first ablock holds a pointer to the
+ real base). */
+ struct ablocks *abase;
+ /* The padding of all but the last ablock is unused. The padding of
+ the last ablock in an ablocks is not allocated. */
+#if BLOCK_PADDING
+ char padding[BLOCK_PADDING];
+#endif
+};
+
+/* A bunch of consecutive aligned blocks. */
+struct ablocks
+{
+ struct ablock blocks[ABLOCKS_SIZE];
+};
+
+/* Size of the block requested from malloc or memalign. */
+#define ABLOCKS_BYTES (sizeof (struct ablocks) - BLOCK_PADDING)
+
+#define ABLOCK_ABASE(block) \
+ (((unsigned long) (block)->abase) <= (1 + 2 * ABLOCKS_SIZE) \
+ ? (struct ablocks *)(block) \
+ : (block)->abase)
+
+/* Virtual `busy' field. */
+#define ABLOCKS_BUSY(abase) ((abase)->blocks[0].abase)
+
+/* Pointer to the (not necessarily aligned) malloc block. */
+#ifdef HAVE_POSIX_MEMALIGN
+#define ABLOCKS_BASE(abase) (abase)
+#else
+#define ABLOCKS_BASE(abase) \
+ (1 & (int) ABLOCKS_BUSY (abase) ? abase : ((void**)abase)[-1])
+#endif
+
+/* The list of free ablock. */
+static struct ablock *free_ablock;
+
+/* Allocate an aligned block of nbytes.
+ Alignment is on a multiple of BLOCK_ALIGN and `nbytes' has to be
+ smaller or equal to BLOCK_BYTES. */
+static POINTER_TYPE *
+lisp_align_malloc (nbytes, type)
+ size_t nbytes;
+ enum mem_type type;
+{
+ void *base, *val;
+ struct ablocks *abase;
+
+ eassert (nbytes <= BLOCK_BYTES);
+
+ BLOCK_INPUT;
+
+#ifdef GC_MALLOC_CHECK
+ allocated_mem_type = type;
+#endif
+
+ if (!free_ablock)
+ {
+ int i, aligned;
+
+#ifdef DOUG_LEA_MALLOC
+ /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
+ because mapped region contents are not preserved in
+ a dumped Emacs. */
+ mallopt (M_MMAP_MAX, 0);
+#endif
+
+#ifdef HAVE_POSIX_MEMALIGN
+ {
+ int err = posix_memalign (&base, BLOCK_ALIGN, ABLOCKS_BYTES);
+ abase = err ? (base = NULL) : base;
+ }
+#else
+ base = malloc (ABLOCKS_BYTES);
+ abase = ALIGN (base, BLOCK_ALIGN);
+#endif
+
+ aligned = (base == abase);
+ if (!aligned)
+ ((void**)abase)[-1] = base;
+
+#ifdef DOUG_LEA_MALLOC
+ /* Back to a reasonable maximum of mmap'ed areas. */
+ mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
+#endif
+
++ /* If the memory just allocated cannot be addressed thru a Lisp
++ object's pointer, and it needs to be, that's equivalent to
++ running out of memory. */
++ if (type != MEM_TYPE_NON_LISP)
++ {
++ Lisp_Object tem;
++ char *end = (char *) base + ABLOCKS_BYTES - 1;
++ XSETCONS (tem, end);
++ if ((char *) XCONS (tem) != end)
++ {
++ lisp_malloc_loser = base;
++ free (base);
++ UNBLOCK_INPUT;
++ memory_full ();
++ }
++ }
++
+ /* Initialize the blocks and put them on the free list.
+ Is `base' was not properly aligned, we can't use the last block. */
+ for (i = 0; i < (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1); i++)
+ {
+ abase->blocks[i].abase = abase;
+ abase->blocks[i].x.next_free = free_ablock;
+ free_ablock = &abase->blocks[i];
+ }
+ ABLOCKS_BUSY (abase) = (struct ablocks *) aligned;
+
+ eassert (0 == ((EMACS_UINT)abase) % BLOCK_ALIGN);
+ eassert (ABLOCK_ABASE (&abase->blocks[3]) == abase); /* 3 is arbitrary */
+ eassert (ABLOCK_ABASE (&abase->blocks[0]) == abase);
+ eassert (ABLOCKS_BASE (abase) == base);
+ eassert (aligned == (int)ABLOCKS_BUSY (abase));
+ }
+
+ abase = ABLOCK_ABASE (free_ablock);
+ ABLOCKS_BUSY (abase) = (struct ablocks *) (2 + (int) ABLOCKS_BUSY (abase));
+ val = free_ablock;
+ free_ablock = free_ablock->x.next_free;
+
- /* If the memory just allocated cannot be addressed thru a Lisp
- object's pointer, and it needs to be,
- that's equivalent to running out of memory. */
- if (val && type != MEM_TYPE_NON_LISP)
- {
- Lisp_Object tem;
- XSETCONS (tem, (char *) val + nbytes - 1);
- if ((char *) XCONS (tem) != (char *) val + nbytes - 1)
- {
- lisp_malloc_loser = val;
- free (val);
- val = 0;
- }
- }
-
+#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+ if (val && type != MEM_TYPE_NON_LISP)
+ mem_insert (val, (char *) val + nbytes, type);
+#endif
+
+ UNBLOCK_INPUT;
+ if (!val && nbytes)
+ memory_full ();
+
+ eassert (0 == ((EMACS_UINT)val) % BLOCK_ALIGN);
+ return val;
+}
static void
-lisp_free (block)
+lisp_align_free (block)
POINTER_TYPE *block;
{
+ struct ablock *ablock = block;
+ struct ablocks *abase = ABLOCK_ABASE (ablock);
+
BLOCK_INPUT;
- free (block);
#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
mem_delete (mem_find (block));
#endif
+ /* Put on free list. */
+ ablock->x.next_free = free_ablock;
+ free_ablock = ablock;
+ /* Update busy count. */
+ ABLOCKS_BUSY (abase) = (struct ablocks *) (-2 + (int) ABLOCKS_BUSY (abase));
+
+ if (2 > (int) ABLOCKS_BUSY (abase))
+ { /* All the blocks are free. */
+ int i = 0, aligned = (int) ABLOCKS_BUSY (abase);
+ struct ablock **tem = &free_ablock;
+ struct ablock *atop = &abase->blocks[aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1];
+
+ while (*tem)
+ {
+ if (*tem >= (struct ablock *) abase && *tem < atop)
+ {
+ i++;
+ *tem = (*tem)->x.next_free;
+ }
+ else
+ tem = &(*tem)->x.next_free;
+ }
+ eassert ((aligned & 1) == aligned);
+ eassert (i == (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1));
+ free (ABLOCKS_BASE (abase));
+ }
UNBLOCK_INPUT;
}
+/* Return a new buffer structure allocated from the heap with
+ a call to lisp_malloc. */
+
+struct buffer *
+allocate_buffer ()
+{
+ struct buffer *b
+ = (struct buffer *) lisp_malloc (sizeof (struct buffer),
+ MEM_TYPE_BUFFER);
+ return b;
+}
+
\f
/* Arranging to disable input signals while we're in malloc.
elsewhere in the code should be inside a BLOCK_INPUT/UNBLOCK_INPUT
pairs; unfortunately, we have no idea what C library functions
might call malloc, so we can't really protect them unless you're
- using GNU malloc. Fortunately, most of the major operating can use
- GNU malloc. */
+ using GNU malloc. Fortunately, most of the major operating systems
+ can use GNU malloc. */
#ifndef SYSTEM_MALLOC
#ifndef DOUG_LEA_MALLOC
if (ptr)
{
struct mem_node *m;
-
+
m = mem_find (ptr);
if (m == MEM_NIL || m->start != ptr)
{
}
}
#endif /* GC_MALLOC_CHECK */
-
+
__free_hook = old_free_hook;
free (ptr);
-
+
/* If we released our reserve (due to running out of memory),
and we have a fair amount free once again,
try to set aside another reserve in case we run out once more. */
}
}
#endif /* GC_MALLOC_CHECK */
-
+
__malloc_hook = emacs_blocked_malloc;
UNBLOCK_INPUT;
mem_delete (m);
}
-
+
/* fprintf (stderr, "%p -> realloc\n", ptr); */
-
+
/* Prevent malloc from registering blocks. */
dont_register_blocks = 1;
#endif /* GC_MALLOC_CHECK */
/* Can't handle zero size regions in the red-black tree. */
mem_insert (value, (char *) value + max (size, 1), MEM_TYPE_NON_LISP);
}
-
+
/* fprintf (stderr, "%p <- realloc\n", value); */
#endif /* GC_MALLOC_CHECK */
-
+
__realloc_hook = emacs_blocked_realloc;
UNBLOCK_INPUT;
newi = (struct interval_block *) lisp_malloc (sizeof *newi,
MEM_TYPE_NON_LISP);
- VALIDATE_LISP_STORAGE (newi, sizeof *newi);
newi->next = interval_block;
interval_block = newi;
interval_block_index = 0;
consing_since_gc += sizeof (struct interval);
intervals_consed++;
RESET_INTERVAL (val);
+ val->gcmarkbit = 0;
return val;
}
register INTERVAL i;
Lisp_Object dummy;
{
- if (XMARKBIT (i->plist))
- abort ();
- mark_object (&i->plist);
- XMARK (i->plist);
+ eassert (!i->gcmarkbit); /* Intervals are never shared. */
+ i->gcmarkbit = 1;
+ mark_object (i->plist);
}
function is always called through the MARK_INTERVAL_TREE macro,
which takes care of that. */
- /* XMARK expands to an assignment; the LHS of an assignment can't be
- a cast. */
- XMARK (tree->up.obj);
-
traverse_intervals_noorder (tree, mark_interval, Qnil);
}
#define MARK_INTERVAL_TREE(i) \
do { \
- if (!NULL_INTERVAL_P (i) \
- && ! XMARKBIT (i->up.obj)) \
+ if (!NULL_INTERVAL_P (i) && !i->gcmarkbit) \
mark_interval_tree (i); \
} while (0)
-/* The oddity in the call to XUNMARK is necessary because XUNMARK
- expands to an assignment to its argument, and most C compilers
- don't support casts on the left operand of `='. */
-
#define UNMARK_BALANCE_INTERVALS(i) \
do { \
if (! NULL_INTERVAL_P (i)) \
- { \
- XUNMARK ((i)->up.obj); \
- (i) = balance_intervals (i); \
- } \
+ (i) = balance_intervals (i); \
} while (0)
\f
struct Lisp_String *string;
#ifdef GC_CHECK_STRING_BYTES
-
+
EMACS_INT nbytes;
unsigned char data[1];
-
+
#define SDATA_NBYTES(S) (S)->nbytes
#define SDATA_DATA(S) (S)->data
-
+
#else /* not GC_CHECK_STRING_BYTES */
union
/* When STRING is null. */
EMACS_INT nbytes;
} u;
-
+
#define SDATA_NBYTES(S) (S)->u.nbytes
#define SDATA_DATA(S) (S)->u.data
/* Number of Lisp strings in a string_block structure. The 1020 is
1024 minus malloc overhead. */
-#define STRINGS_IN_STRING_BLOCK \
+#define STRING_BLOCK_SIZE \
((1020 - sizeof (struct string_block *)) / sizeof (struct Lisp_String))
/* Structure describing a block from which Lisp_String structures
struct string_block
{
struct string_block *next;
- struct Lisp_String strings[STRINGS_IN_STRING_BLOCK];
+ struct Lisp_String strings[STRING_BLOCK_SIZE];
};
/* Head and tail of the list of sblock structures holding Lisp string
S must be live, i.e. S->data must not be null. S->data is actually
a pointer to the `u.data' member of its sdata structure; the
structure starts at a constant offset in front of that. */
-
+
#ifdef GC_CHECK_STRING_BYTES
#define SDATA_OF_STRING(S) \
string_bytes (s)
struct Lisp_String *s;
{
- int nbytes = (s->size_byte < 0 ? s->size : s->size_byte) & ~MARKBIT;
+ int nbytes = (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
if (!PURE_POINTER_P (s)
&& s->data
&& nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
abort ();
return nbytes;
}
-
-/* Check validity Lisp strings' string_bytes member in B. */
+
+/* Check validity of Lisp strings' string_bytes member in B. */
void
check_sblock (b)
struct sblock *b;
{
struct sdata *from, *end, *from_end;
-
+
end = b->next_free;
-
+
for (from = &b->first_data; from < end; from = from_end)
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
int nbytes;
-
+
/* Check that the string size recorded in the string is the
same as the one recorded in the sdata structure. */
if (from->string)
CHECK_STRING_BYTES (from->string);
-
+
if (from->string)
nbytes = GC_STRING_BYTES (from->string);
else
nbytes = SDATA_NBYTES (from);
-
+
nbytes = SDATA_SIZE (nbytes);
from_end = (struct sdata *) ((char *) from + nbytes);
}
if (s)
CHECK_STRING_BYTES (s);
}
-
+
for (b = oldest_sblock; b; b = b->next)
check_sblock (b);
}
int i;
b = (struct string_block *) lisp_malloc (sizeof *b, MEM_TYPE_STRING);
- VALIDATE_LISP_STORAGE (b, sizeof *b);
bzero (b, sizeof *b);
b->next = string_blocks;
string_blocks = b;
++n_string_blocks;
- for (i = STRINGS_IN_STRING_BLOCK - 1; i >= 0; --i)
+ for (i = STRING_BLOCK_SIZE - 1; i >= 0; --i)
{
s = b->strings + i;
NEXT_FREE_LISP_STRING (s) = string_free_list;
string_free_list = s;
}
- total_free_strings += STRINGS_IN_STRING_BLOCK;
+ total_free_strings += STRING_BLOCK_SIZE;
}
/* Pop a Lisp_String off the free-list. */
#ifdef GC_CHECK_STRING_BYTES
if (!noninteractive
-#ifdef macintosh
+#ifdef MAC_OS8
&& current_sblock
#endif
)
#ifdef DOUG_LEA_MALLOC
/* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
because mapped region contents are not preserved in
- a dumped Emacs. */
+ a dumped Emacs.
+
+ In case you think of allowing it in a dumped Emacs at the
+ cost of not being able to re-dump, there's another reason:
+ mmap'ed data typically have an address towards the top of the
+ address space, which won't fit into an EMACS_INT (at least on
+ 32-bit systems with the current tagging scheme). --fx */
mallopt (M_MMAP_MAX, 0);
#endif
b = (struct sblock *) lisp_malloc (size, MEM_TYPE_NON_LISP);
-
+
#ifdef DOUG_LEA_MALLOC
/* Back to a reasonable maximum of mmap'ed areas. */
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif
-
+
b->next_free = &b->first_data;
b->first_data.string = NULL;
b->next = large_sblocks;
old_data = s->data ? SDATA_OF_STRING (s) : NULL;
old_nbytes = GC_STRING_BYTES (s);
-
+
data = b->next_free;
data->string = s;
s->data = SDATA_DATA (data);
s->size_byte = nbytes;
s->data[nbytes] = '\0';
b->next_free = (struct sdata *) ((char *) data + needed);
-
+
/* If S had already data assigned, mark that as free by setting its
string back-pointer to null, and recording the size of the data
in it. */
{
struct string_block *b, *next;
struct string_block *live_blocks = NULL;
-
+
string_free_list = NULL;
total_strings = total_free_strings = 0;
total_string_size = 0;
next = b->next;
- for (i = 0; i < STRINGS_IN_STRING_BLOCK; ++i)
+ for (i = 0; i < STRING_BLOCK_SIZE; ++i)
{
struct Lisp_String *s = b->strings + i;
{
/* String is live; unmark it and its intervals. */
UNMARK_STRING (s);
-
+
if (!NULL_INTERVAL_P (s->intervals))
UNMARK_BALANCE_INTERVALS (s->intervals);
/* Free blocks that contain free Lisp_Strings only, except
the first two of them. */
- if (nfree == STRINGS_IN_STRING_BLOCK
- && total_free_strings > STRINGS_IN_STRING_BLOCK)
+ if (nfree == STRING_BLOCK_SIZE
+ && total_free_strings > STRING_BLOCK_SIZE)
{
lisp_free (b);
--n_string_blocks;
{
struct sblock *b, *next;
struct sblock *live_blocks = NULL;
-
+
for (b = large_sblocks; b; b = next)
{
next = b->next;
{
end = b->next_free;
xassert ((char *) end <= (char *) b + SBLOCK_SIZE);
-
+
for (from = &b->first_data; from < end; from = from_end)
{
/* Compute the next FROM here because copying below may
&& GC_STRING_BYTES (from->string) != SDATA_NBYTES (from))
abort ();
#endif /* GC_CHECK_STRING_BYTES */
-
+
if (from->string)
nbytes = GC_STRING_BYTES (from->string);
else
nbytes = SDATA_NBYTES (from);
-
+
nbytes = SDATA_SIZE (nbytes);
from_end = (struct sdata *) ((char *) from + nbytes);
-
+
/* FROM->string non-null means it's alive. Copy its data. */
if (from->string)
{
to = &tb->first_data;
to_end = (struct sdata *) ((char *) to + nbytes);
}
-
+
/* Copy, and update the string's `data' pointer. */
if (from != to)
{
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);
- p = XSTRING (val)->data;
- end = p + XSTRING (val)->size;
+ p = SDATA (val);
+ end = p + SCHARS (val);
while (p != end)
*p++ = c;
}
nbytes = len * XINT (length);
val = make_uninit_multibyte_string (XINT (length), nbytes);
- p = XSTRING (val)->data;
+ p = SDATA (val);
end = p + nbytes;
while (p != end)
{
p += len;
}
}
-
+
*p = 0;
return val;
}
slot `size' of the struct Lisp_Bool_Vector. */
val = Fmake_vector (make_number (length_in_elts + 1), Qnil);
p = XBOOL_VECTOR (val);
-
+
/* Get rid of any bits that would cause confusion. */
p->vector_size = 0;
XSETBOOL_VECTOR (val, p);
p->size = XFASTINT (length);
-
+
real_init = (NILP (init) ? 0 : -1);
for (i = 0; i < length_in_chars ; i++)
p->data[i] = real_init;
-
+
/* Clear the extraneous bits in the last byte. */
if (XINT (length) != length_in_chars * BITS_PER_CHAR)
XBOOL_VECTOR (val)->data[length_in_chars - 1]
Lisp_Object
make_string (contents, nbytes)
- char *contents;
+ const char *contents;
int nbytes;
{
register Lisp_Object val;
Lisp_Object
make_unibyte_string (contents, length)
- char *contents;
+ const char *contents;
int length;
{
register Lisp_Object val;
val = make_uninit_string (length);
- bcopy (contents, XSTRING (val)->data, length);
- SET_STRING_BYTES (XSTRING (val), -1);
+ bcopy (contents, SDATA (val), length);
+ STRING_SET_UNIBYTE (val);
return val;
}
Lisp_Object
make_multibyte_string (contents, nchars, nbytes)
- char *contents;
+ const char *contents;
int nchars, nbytes;
{
register Lisp_Object val;
val = make_uninit_multibyte_string (nchars, nbytes);
- bcopy (contents, XSTRING (val)->data, nbytes);
+ bcopy (contents, SDATA (val), nbytes);
return val;
}
Lisp_Object
make_string_from_bytes (contents, nchars, nbytes)
- char *contents;
+ const char *contents;
int nchars, nbytes;
{
register Lisp_Object val;
val = make_uninit_multibyte_string (nchars, nbytes);
- bcopy (contents, XSTRING (val)->data, nbytes);
- if (STRING_BYTES (XSTRING (val)) == XSTRING (val)->size)
- SET_STRING_BYTES (XSTRING (val), -1);
+ bcopy (contents, SDATA (val), nbytes);
+ if (SBYTES (val) == SCHARS (val))
+ STRING_SET_UNIBYTE (val);
return val;
}
/* Make a string from NCHARS characters occupying NBYTES bytes at
CONTENTS. The argument MULTIBYTE controls whether to label the
- string as multibyte. */
+ string as multibyte. If NCHARS is negative, it counts the number of
+ characters by itself. */
Lisp_Object
make_specified_string (contents, nchars, nbytes, multibyte)
- char *contents;
+ const char *contents;
int nchars, nbytes;
int multibyte;
{
register Lisp_Object val;
+
+ if (nchars < 0)
+ {
+ if (multibyte)
+ nchars = multibyte_chars_in_text (contents, nbytes);
+ else
+ nchars = nbytes;
+ }
val = make_uninit_multibyte_string (nchars, nbytes);
- bcopy (contents, XSTRING (val)->data, nbytes);
+ bcopy (contents, SDATA (val), nbytes);
if (!multibyte)
- SET_STRING_BYTES (XSTRING (val), -1);
+ STRING_SET_UNIBYTE (val);
return val;
}
Lisp_Object
build_string (str)
- char *str;
+ const char *str;
{
return make_string (str, strlen (str));
}
{
Lisp_Object val;
val = make_uninit_multibyte_string (length, length);
- SET_STRING_BYTES (XSTRING (val), -1);
+ STRING_SET_UNIBYTE (val);
return val;
}
/* We store float cells inside of float_blocks, allocating a new
float_block with malloc whenever necessary. Float cells reclaimed
by GC are put on a free list to be reallocated before allocating
- any new float cells from the latest float_block.
-
- Each float_block is just under 1020 bytes long, since malloc really
- allocates in units of powers of two and uses 4 bytes for its own
- overhead. */
+ any new float cells from the latest float_block. */
#define FLOAT_BLOCK_SIZE \
- ((1020 - sizeof (struct float_block *)) / sizeof (struct Lisp_Float))
+ (((BLOCK_BYTES - sizeof (struct float_block *)) * CHAR_BIT) \
+ / (sizeof (struct Lisp_Float) * CHAR_BIT + 1))
+
+#define GETMARKBIT(block,n) \
+ (((block)->gcmarkbits[(n) / (sizeof(int) * CHAR_BIT)] \
+ >> ((n) % (sizeof(int) * CHAR_BIT))) \
+ & 1)
+
+#define SETMARKBIT(block,n) \
+ (block)->gcmarkbits[(n) / (sizeof(int) * CHAR_BIT)] \
+ |= 1 << ((n) % (sizeof(int) * CHAR_BIT))
+
+#define UNSETMARKBIT(block,n) \
+ (block)->gcmarkbits[(n) / (sizeof(int) * CHAR_BIT)] \
+ &= ~(1 << ((n) % (sizeof(int) * CHAR_BIT)))
+
+#define FLOAT_BLOCK(fptr) \
+ ((struct float_block *)(((EMACS_UINT)(fptr)) & ~(BLOCK_ALIGN - 1)))
+
+#define FLOAT_INDEX(fptr) \
+ ((((EMACS_UINT)(fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Float))
struct float_block
{
- struct float_block *next;
+ /* Place `floats' at the beginning, to ease up FLOAT_INDEX's job. */
struct Lisp_Float floats[FLOAT_BLOCK_SIZE];
+ int gcmarkbits[1 + FLOAT_BLOCK_SIZE / (sizeof(int) * CHAR_BIT)];
+ struct float_block *next;
};
+#define FLOAT_MARKED_P(fptr) \
+ GETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr)))
+
+#define FLOAT_MARK(fptr) \
+ SETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr)))
+
+#define FLOAT_UNMARK(fptr) \
+ UNSETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr)))
+
/* Current float_block. */
struct float_block *float_block;
void
init_float ()
{
- float_block = (struct float_block *) lisp_malloc (sizeof *float_block,
- MEM_TYPE_FLOAT);
- float_block->next = 0;
- bzero ((char *) float_block->floats, sizeof float_block->floats);
- float_block_index = 0;
+ float_block = NULL;
+ float_block_index = FLOAT_BLOCK_SIZE; /* Force alloc of new float_block. */
float_free_list = 0;
- n_float_blocks = 1;
+ n_float_blocks = 0;
}
struct Lisp_Float *ptr;
{
*(struct Lisp_Float **)&ptr->data = float_free_list;
-#if GC_MARK_STACK
- ptr->type = Vdead;
-#endif
float_free_list = ptr;
}
{
register struct float_block *new;
- new = (struct float_block *) lisp_malloc (sizeof *new,
- MEM_TYPE_FLOAT);
- VALIDATE_LISP_STORAGE (new, sizeof *new);
+ new = (struct float_block *) lisp_align_malloc (sizeof *new,
+ MEM_TYPE_FLOAT);
new->next = float_block;
float_block = new;
float_block_index = 0;
}
XSETFLOAT (val, &float_block->floats[float_block_index++]);
}
-
+
XFLOAT_DATA (val) = float_value;
- XSETFASTINT (XFLOAT (val)->type, 0); /* bug chasing -wsr */
+ FLOAT_UNMARK (XFLOAT (val));
consing_since_gc += sizeof (struct Lisp_Float);
floats_consed++;
return val;
/* We store cons cells inside of cons_blocks, allocating a new
cons_block with malloc whenever necessary. Cons cells reclaimed by
GC are put on a free list to be reallocated before allocating
- any new cons cells from the latest cons_block.
-
- Each cons_block is just under 1020 bytes long,
- since malloc really allocates in units of powers of two
- and uses 4 bytes for its own overhead. */
+ any new cons cells from the latest cons_block. */
#define CONS_BLOCK_SIZE \
- ((1020 - sizeof (struct cons_block *)) / sizeof (struct Lisp_Cons))
+ (((BLOCK_BYTES - sizeof (struct cons_block *)) * CHAR_BIT) \
+ / (sizeof (struct Lisp_Cons) * CHAR_BIT + 1))
+
+#define CONS_BLOCK(fptr) \
+ ((struct cons_block *)(((EMACS_UINT)(fptr)) & ~(BLOCK_ALIGN - 1)))
+
+#define CONS_INDEX(fptr) \
+ ((((EMACS_UINT)(fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Cons))
struct cons_block
{
- struct cons_block *next;
+ /* Place `conses' at the beginning, to ease up CONS_INDEX's job. */
struct Lisp_Cons conses[CONS_BLOCK_SIZE];
+ int gcmarkbits[1 + CONS_BLOCK_SIZE / (sizeof(int) * CHAR_BIT)];
+ struct cons_block *next;
};
+#define CONS_MARKED_P(fptr) \
+ GETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr)))
+
+#define CONS_MARK(fptr) \
+ SETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr)))
+
+#define CONS_UNMARK(fptr) \
+ UNSETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr)))
+
/* Current cons_block. */
struct cons_block *cons_block;
void
init_cons ()
{
- cons_block = (struct cons_block *) lisp_malloc (sizeof *cons_block,
- MEM_TYPE_CONS);
- cons_block->next = 0;
- bzero ((char *) cons_block->conses, sizeof cons_block->conses);
- cons_block_index = 0;
+ cons_block = NULL;
+ cons_block_index = CONS_BLOCK_SIZE; /* Force alloc of new cons_block. */
cons_free_list = 0;
- n_cons_blocks = 1;
+ n_cons_blocks = 0;
}
if (cons_block_index == CONS_BLOCK_SIZE)
{
register struct cons_block *new;
- new = (struct cons_block *) lisp_malloc (sizeof *new,
- MEM_TYPE_CONS);
- VALIDATE_LISP_STORAGE (new, sizeof *new);
+ new = (struct cons_block *) lisp_align_malloc (sizeof *new,
+ MEM_TYPE_CONS);
new->next = cons_block;
cons_block = new;
cons_block_index = 0;
}
XSETCONS (val, &cons_block->conses[cons_block_index++]);
}
-
+
XSETCAR (val, car);
XSETCDR (val, cdr);
+ CONS_UNMARK (XCONS (val));
consing_since_gc += sizeof (struct Lisp_Cons);
cons_cells_consed++;
return val;
{
val = Fcons (init, val);
--size;
-
+
if (size > 0)
{
val = Fcons (init, val);
--size;
-
+
if (size > 0)
{
val = Fcons (init, val);
--size;
-
+
if (size > 0)
{
val = Fcons (init, val);
QUIT;
}
-
+
return val;
}
a dumped Emacs. */
mallopt (M_MMAP_MAX, 0);
#endif
-
+
nbytes = sizeof *p + (len - 1) * sizeof p->contents[0];
p = (struct Lisp_Vector *) lisp_malloc (nbytes, type);
-
+
#ifdef DOUG_LEA_MALLOC
/* Back to a reasonable maximum of mmap'ed areas. */
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif
-
- VALIDATE_LISP_STORAGE (p, 0);
+
consing_since_gc += nbytes;
vector_cells_consed += len;
EMACS_INT len = VECSIZE (struct Lisp_Hash_Table);
struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_HASH_TABLE);
EMACS_INT i;
-
+
v->size = len;
for (i = 0; i < len; ++i)
v->contents[i] = Qnil;
-
+
return (struct Lisp_Hash_Table *) v;
}
EMACS_INT len = VECSIZE (struct window);
struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_WINDOW);
EMACS_INT i;
-
+
for (i = 0; i < len; ++i)
v->contents[i] = Qnil;
v->size = len;
-
+
return (struct window *) v;
}
EMACS_INT len = VECSIZE (struct frame);
struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_FRAME);
EMACS_INT i;
-
+
for (i = 0; i < len; ++i)
v->contents[i] = make_number (0);
v->size = len;
EMACS_INT len = VECSIZE (struct Lisp_Process);
struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_PROCESS);
EMACS_INT i;
-
+
for (i = 0; i < len; ++i)
v->contents[i] = Qnil;
v->size = len;
-
+
return (struct Lisp_Process *) v;
}
{
struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_VECTOR);
EMACS_INT i;
-
+
for (i = 0; i < len; ++i)
v->contents[i] = Qnil;
v->size = len;
-
+
return v;
}
}
- 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);
- 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 default value DEFALT.
- 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 (defalt)
- Lisp_Object defalt;
- {
- Lisp_Object vector
- = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), Qnil);
- XCHAR_TABLE (vector)->top = Qnil;
- XCHAR_TABLE (vector)->defalt = defalt;
- 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.
stack size, (optional) doc string, and (optional) interactive spec.
The first four arguments are required; at most six have any
significance.
-usage: (make-byte-code &rest ELEMENTS) */)
+usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */)
(nargs, args)
register int nargs;
Lisp_Object *args;
struct symbol_block *new;
new = (struct symbol_block *) lisp_malloc (sizeof *new,
MEM_TYPE_SYMBOL);
- VALIDATE_LISP_STORAGE (new, sizeof *new);
new->next = symbol_block;
symbol_block = new;
symbol_block_index = 0;
}
XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index++]);
}
-
+
p = XSYMBOL (val);
- p->name = XSTRING (name);
+ p->xname = name;
p->plist = Qnil;
p->value = Qunbound;
p->function = Qunbound;
p->next = NULL;
+ p->gcmarkbit = 0;
p->interned = SYMBOL_UNINTERNED;
p->constant = 0;
p->indirect_variable = 0;
struct marker_block *new;
new = (struct marker_block *) lisp_malloc (sizeof *new,
MEM_TYPE_MISC);
- VALIDATE_LISP_STORAGE (new, sizeof *new);
new->next = marker_block;
marker_block = new;
marker_block_index = 0;
}
XSETMISC (val, &marker_block->markers[marker_block_index++]);
}
-
+
consing_since_gc += sizeof (union Lisp_Misc);
misc_objects_consed++;
+ XMARKER (val)->gcmarkbit = 0;
+ return val;
+}
+
+/* Return a Lisp_Misc_Save_Value object containing POINTER and
+ INTEGER. This is used to package C values to call record_unwind_protect.
+ The unwind function can get the C values back using XSAVE_VALUE. */
+
+Lisp_Object
+make_save_value (pointer, integer)
+ void *pointer;
+ int integer;
+{
+ register Lisp_Object val;
+ register struct Lisp_Save_Value *p;
+
+ val = allocate_misc ();
+ XMISCTYPE (val) = Lisp_Misc_Save_Value;
+ p = XSAVE_VALUE (val);
+ p->pointer = pointer;
+ p->integer = integer;
return val;
}
p->buffer = 0;
p->bytepos = 0;
p->charpos = 0;
- p->chain = Qnil;
+ p->next = NULL;
p->insertion_type = 0;
return val;
}
free_marker (marker)
Lisp_Object marker;
{
- unchain_marker (marker);
+ unchain_marker (XMARKER (marker));
XMISC (marker)->u_marker.type = Lisp_Misc_Free;
XMISC (marker)->u_free.chain = marker_free_list;
characters, so we can make a string. */
{
Lisp_Object result;
-
+
result = Fmake_string (make_number (nargs), make_number (0));
for (i = 0; i < nargs; i++)
{
- XSTRING (result)->data[i] = XINT (args[i]);
+ SSET (result, i, XINT (args[i]));
/* Move the meta bit to the right place for a string char. */
if (XINT (args[i]) & CHAR_META)
- XSTRING (result)->data[i] |= 0x80;
+ SSET (result, i, SREF (result, i) | 0x80);
}
-
+
return result;
}
}
parent = NULL;
#if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS
-
+
while (c != MEM_NIL)
{
if (start >= c->start && start < c->end)
parent = c;
c = start < c->start ? c->left : c->right;
}
-
+
#else /* GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS */
-
+
while (c != MEM_NIL)
{
parent = c;
c = start < c->start ? c->left : c->right;
}
-
+
#endif /* GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS */
/* Create a new node. */
else
parent->right = x;
}
- else
+ else
mem_root = x;
/* Re-establish red-black tree properties. */
{
/* X is red and its parent is red. This is a violation of
red-black tree property #3. */
-
+
if (x->parent == x->parent->parent->left)
{
/* We're on the left side of our grandparent, and Y is our
"uncle". */
struct mem_node *y = x->parent->parent->right;
-
+
if (y->color == MEM_RED)
{
/* Uncle and parent are red but should be black because
{
/* This is the symmetrical case of above. */
struct mem_node *y = x->parent->parent->left;
-
+
if (y->color == MEM_RED)
{
x->parent->color = MEM_BLACK;
x = x->parent;
mem_rotate_right (x);
}
-
+
x->parent->color = MEM_BLACK;
x->parent->parent->color = MEM_RED;
mem_rotate_left (x->parent->parent);
}
-/* (x) (y)
- / \ / \
+/* (x) (y)
+ / \ / \
a (y) ===> (x) c
/ \ / \
b c a b */
}
-/* (x) (Y)
- / \ / \
- (y) c ===> a (x)
- / \ / \
+/* (x) (Y)
+ / \ / \
+ (y) c ===> a (x)
+ / \ / \
a b b c */
static void
x->left = y->right;
if (y->right != MEM_NIL)
y->right->parent = x;
-
+
if (y != MEM_NIL)
y->parent = x->parent;
if (x->parent)
}
else
mem_root = y;
-
+
y->right = x;
if (x != MEM_NIL)
x->parent = y;
z->end = y->end;
z->type = y->type;
}
-
+
if (y->color == MEM_BLACK)
mem_delete_fixup (x);
if (x == x->parent->left)
{
struct mem_node *w = x->parent->right;
-
+
if (w->color == MEM_RED)
{
w->color = MEM_BLACK;
mem_rotate_left (x->parent);
w = x->parent->right;
}
-
+
if (w->left->color == MEM_BLACK && w->right->color == MEM_BLACK)
{
w->color = MEM_RED;
else
{
struct mem_node *w = x->parent->left;
-
+
if (w->color == MEM_RED)
{
w->color = MEM_BLACK;
mem_rotate_right (x->parent);
w = x->parent->left;
}
-
+
if (w->right->color == MEM_BLACK && w->left->color == MEM_BLACK)
{
w->color = MEM_RED;
mem_rotate_left (w);
w = x->parent->left;
}
-
+
w->color = x->parent->color;
x->parent->color = MEM_BLACK;
w->left->color = MEM_BLACK;
}
}
}
-
+
x->color = MEM_BLACK;
}
one of the unused cells in the current cons block,
and not be on the free-list. */
return (offset >= 0
+ && offset < (CONS_BLOCK_SIZE * sizeof b->conses[0])
&& offset % sizeof b->conses[0] == 0
&& (b != cons_block
|| offset / sizeof b->conses[0] < cons_block_index)
{
struct symbol_block *b = (struct symbol_block *) m->start;
int offset = (char *) p - (char *) &b->symbols[0];
-
+
/* P must point to the start of a Lisp_Symbol, not be
one of the unused cells in the current symbol block,
and not be on the free-list. */
{
struct float_block *b = (struct float_block *) m->start;
int offset = (char *) p - (char *) &b->floats[0];
-
- /* P must point to the start of a Lisp_Float, not be
- one of the unused cells in the current float block,
- and not be on the free-list. */
+
+ /* P must point to the start of a Lisp_Float and not be
+ one of the unused cells in the current float block. */
return (offset >= 0
+ && offset < (FLOAT_BLOCK_SIZE * sizeof b->floats[0])
&& offset % sizeof b->floats[0] == 0
&& (b != float_block
- || offset / sizeof b->floats[0] < float_block_index)
- && !EQ (((struct Lisp_Float *) p)->type, Vdead));
+ || offset / sizeof b->floats[0] < float_block_index));
}
else
return 0;
{
struct marker_block *b = (struct marker_block *) m->start;
int offset = (char *) p - (char *) &b->markers[0];
-
+
/* P must point to the start of a Lisp_Misc, not be
one of the unused cells in the current misc block,
and not be on the free-list. */
}
-/* Value is non-zero of P is a pointer to a live buffer. M is a
+/* Value is non-zero if P is a pointer to a live buffer. M is a
pointer to the mem_block for P. */
static INLINE int
doc: /* Show information about live and zombie objects. */)
()
{
- Lisp_Object args[7];
- args[0] = build_string ("%d GCs, avg live/zombies = %.2f/%.2f (%f%%), max %d/%d");
+ Lisp_Object args[8], zombie_list = Qnil;
+ int i;
+ for (i = 0; i < nzombies; i++)
+ zombie_list = Fcons (zombies[i], zombie_list);
+ args[0] = build_string ("%d GCs, avg live/zombies = %.2f/%.2f (%f%%), max %d/%d\nzombies: %S");
args[1] = make_number (ngcs);
args[2] = make_float (avg_live);
args[3] = make_float (avg_zombies);
args[4] = make_float (avg_zombies / avg_live / 100);
args[5] = make_number (max_live);
args[6] = make_number (max_zombies);
- return Fmessage (7, args);
+ args[7] = zombie_list;
+ return Fmessage (8, args);
}
#endif /* GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES */
{
void *po = (void *) XPNTR (obj);
struct mem_node *m = mem_find (po);
-
+
if (m != MEM_NIL)
{
int mark_p = 0;
break;
case Lisp_Cons:
- mark_p = (live_cons_p (m, po)
- && !XMARKBIT (XCONS (obj)->car));
+ mark_p = (live_cons_p (m, po) && !CONS_MARKED_P (XCONS (obj)));
break;
case Lisp_Symbol:
- mark_p = (live_symbol_p (m, po)
- && !XMARKBIT (XSYMBOL (obj)->plist));
+ mark_p = (live_symbol_p (m, po) && !XSYMBOL (obj)->gcmarkbit);
break;
case Lisp_Float:
- mark_p = (live_float_p (m, po)
- && !XMARKBIT (XFLOAT (obj)->type));
+ mark_p = (live_float_p (m, po) && !FLOAT_MARKED_P (XFLOAT (obj)));
break;
case Lisp_Vectorlike:
buffer because checking that dereferences the pointer
PO which might point anywhere. */
if (live_vector_p (m, po))
- mark_p = (!GC_SUBRP (obj)
- && !(XVECTOR (obj)->size & ARRAY_MARK_FLAG));
+ mark_p = !GC_SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj));
else if (live_buffer_p (m, po))
- mark_p = GC_BUFFERP (obj) && !XMARKBIT (XBUFFER (obj)->name);
+ mark_p = GC_BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj));
break;
case Lisp_Misc:
- if (live_misc_p (m, po))
- {
- switch (XMISCTYPE (obj))
- {
- case Lisp_Misc_Marker:
- mark_p = !XMARKBIT (XMARKER (obj)->chain);
- break;
-
- case Lisp_Misc_Buffer_Local_Value:
- case Lisp_Misc_Some_Buffer_Local_Value:
- mark_p = !XMARKBIT (XBUFFER_LOCAL_VALUE (obj)->realvalue);
- break;
-
- case Lisp_Misc_Overlay:
- mark_p = !XMARKBIT (XOVERLAY (obj)->plist);
- break;
- }
- }
+ mark_p = (live_misc_p (m, po) && !XMARKER (obj)->gcmarkbit);
break;
case Lisp_Int:
{
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
if (nzombies < MAX_ZOMBIES)
- zombies[nzombies] = *p;
+ zombies[nzombies] = obj;
++nzombies;
#endif
- mark_object (&obj);
+ mark_object (obj);
}
}
}
assume that Lisp data is aligned on even addresses. */
if ((EMACS_INT) p & 1)
return;
-
+
m = mem_find (p);
if (m != MEM_NIL)
{
Lisp_Object obj = Qnil;
-
+
switch (m->type)
{
case MEM_TYPE_NON_LISP:
/* Nothing to do; not a pointer to Lisp memory. */
break;
-
+
case MEM_TYPE_BUFFER:
- if (live_buffer_p (m, p)
- && !XMARKBIT (((struct buffer *) p)->name))
+ if (live_buffer_p (m, p) && !VECTOR_MARKED_P((struct buffer *)p))
XSETVECTOR (obj, p);
break;
-
+
case MEM_TYPE_CONS:
- if (live_cons_p (m, p)
- && !XMARKBIT (((struct Lisp_Cons *) p)->car))
+ if (live_cons_p (m, p) && !CONS_MARKED_P ((struct Lisp_Cons *) p))
XSETCONS (obj, p);
break;
-
+
case MEM_TYPE_STRING:
if (live_string_p (m, p)
&& !STRING_MARKED_P ((struct Lisp_String *) p))
break;
case MEM_TYPE_MISC:
- if (live_misc_p (m, p))
- {
- Lisp_Object tem;
- XSETMISC (tem, p);
-
- switch (XMISCTYPE (tem))
- {
- case Lisp_Misc_Marker:
- if (!XMARKBIT (XMARKER (tem)->chain))
- obj = tem;
- break;
-
- case Lisp_Misc_Buffer_Local_Value:
- case Lisp_Misc_Some_Buffer_Local_Value:
- if (!XMARKBIT (XBUFFER_LOCAL_VALUE (tem)->realvalue))
- obj = tem;
- break;
-
- case Lisp_Misc_Overlay:
- if (!XMARKBIT (XOVERLAY (tem)->plist))
- obj = tem;
- break;
- }
- }
+ if (live_misc_p (m, p) && !((struct Lisp_Free *) p)->gcmarkbit)
+ XSETMISC (obj, p);
break;
-
+
case MEM_TYPE_SYMBOL:
- if (live_symbol_p (m, p)
- && !XMARKBIT (((struct Lisp_Symbol *) p)->plist))
+ if (live_symbol_p (m, p) && !((struct Lisp_Symbol *) p)->gcmarkbit)
XSETSYMBOL (obj, p);
break;
-
+
case MEM_TYPE_FLOAT:
- if (live_float_p (m, p)
- && !XMARKBIT (((struct Lisp_Float *) p)->type))
+ if (live_float_p (m, p) && !FLOAT_MARKED_P (p))
XSETFLOAT (obj, p);
break;
-
+
case MEM_TYPE_VECTOR:
case MEM_TYPE_PROCESS:
case MEM_TYPE_HASH_TABLE:
{
Lisp_Object tem;
XSETVECTOR (tem, p);
- if (!GC_SUBRP (tem)
- && !(XVECTOR (tem)->size & ARRAY_MARK_FLAG))
+ if (!GC_SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem)))
obj = tem;
}
break;
}
if (!GC_NILP (obj))
- mark_object (&obj);
+ mark_object (obj);
}
}
/* Mark Lisp objects referenced from the address range START..END. */
-static void
+static void
mark_memory (start, end)
void *start, *end;
{
Here, `obj' isn't really used, and the compiler optimizes it
away. The only reference to the life string is through the
pointer `s'. */
-
+
for (pp = (void **) start; (void *) pp < end; ++pp)
mark_maybe_pointer (*pp);
}
+/* setjmp will work with GCC unless NON_SAVING_SETJMP is defined in
+ the GCC system configuration. In gcc 3.2, the only systems for
+ which this is so are i386-sco5 non-ELF, i386-sysv3 (maybe included
+ by others?) and ns32k-pc532-min. */
#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
\n\
Please take a look at the function mark_stack in alloc.c, and\n\
try to find a way to make it work on your system.\n\
+\n\
+Note that you may get false negatives, depending on the compiler.\n\
+In particular, you need to use -O with GCC for this test.\n\
+\n\
Please mail the result to <emacs-devel@gnu.org>.\n\
"
for (p = gcprolist; p; p = p->next)
for (i = 0; i < p->nvars; ++i)
if (!survives_gc_p (p->var[i]))
+ /* FIXME: It's not necessarily a bug. It might just be that the
+ GCPRO is unnecessary or should release the object sooner. */
abort ();
}
/* This trick flushes the register windows so that all the state of
the process is contained in the stack. */
+ /* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is
+ needed on ia64 too. See mach_dep.c, where it also says inline
+ assembler doesn't work with relevant proprietary compilers. */
#ifdef sparc
asm ("ta 3");
#endif
-
+
/* Save registers that we need to see on the stack. We need to see
registers used to hold register variables and registers used to
pass parameters. */
#ifdef GC_SAVE_REGISTERS_ON_STACK
GC_SAVE_REGISTERS_ON_STACK (end);
#else /* not GC_SAVE_REGISTERS_ON_STACK */
-
+
#ifndef GC_SETJMP_WORKS /* If it hasn't been checked yet that
setjmp will definitely work, test it
and print a message with the result
test_setjmp ();
}
#endif /* GC_SETJMP_WORKS */
-
+
setjmp (j);
end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j;
#endif /* not GC_SAVE_REGISTERS_ON_STACK */
that's not the case, something has to be done here to iterate
over the stack segments. */
#ifndef GC_LISP_OBJECT_ALIGNMENT
+#ifdef __GNUC__
+#define GC_LISP_OBJECT_ALIGNMENT __alignof__ (Lisp_Object)
+#else
#define GC_LISP_OBJECT_ALIGNMENT sizeof (Lisp_Object)
+#endif
#endif
for (i = 0; i < sizeof (Lisp_Object); i += GC_LISP_OBJECT_ALIGNMENT)
mark_memory ((char *) stack_base + i, end);
size_t size;
int type;
{
- size_t nbytes;
POINTER_TYPE *result;
- char *beg = purebeg;
+ size_t alignment = sizeof (EMACS_INT);
/* Give Lisp_Floats an extra alignment. */
if (type == Lisp_Float)
{
- size_t alignment;
#if defined __GNUC__ && __GNUC__ >= 2
alignment = __alignof (struct Lisp_Float);
#else
alignment = sizeof (struct Lisp_Float);
#endif
- pure_bytes_used = ALIGN (pure_bytes_used, alignment);
- }
-
- nbytes = ALIGN (size, sizeof (EMACS_INT));
-
- if (pure_bytes_used + nbytes > pure_size)
- {
- /* Don't allocate a large amount here,
- because it might get mmap'd and then its address
- might not be usable. */
- beg = purebeg = (char *) xmalloc (10000);
- pure_size = 10000;
- pure_bytes_used_before_overflow += pure_bytes_used;
- pure_bytes_used = 0;
}
- result = (POINTER_TYPE *) (beg + pure_bytes_used);
- pure_bytes_used += nbytes;
- return result;
+ again:
+ result = ALIGN (purebeg + pure_bytes_used, alignment);
+ pure_bytes_used = ((char *)result - (char *)purebeg) + size;
+
+ if (pure_bytes_used <= pure_size)
+ return result;
+
+ /* Don't allocate a large amount here,
+ because it might get mmap'd and then its address
+ might not be usable. */
+ purebeg = (char *) xmalloc (10000);
+ pure_size = 10000;
+ pure_bytes_used_before_overflow += pure_bytes_used - size;
+ pure_bytes_used = 0;
+ goto again;
}
-/* Signal an error if PURESIZE is too small. */
+/* Print a warning if PURESIZE is too small. */
void
check_pure_size ()
{
if (pure_bytes_used_before_overflow)
- error ("Pure Lisp storage overflow (approx. %d bytes needed)",
- (int) (pure_bytes_used + pure_bytes_used_before_overflow));
+ message ("Pure Lisp storage overflow (approx. %d bytes needed)",
+ (int) (pure_bytes_used + pure_bytes_used_before_overflow));
}
else if (FLOATP (obj))
return make_pure_float (XFLOAT_DATA (obj));
else if (STRINGP (obj))
- return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size,
- STRING_BYTES (XSTRING (obj)),
+ return make_pure_string (SDATA (obj), SCHARS (obj),
+ SBYTES (obj),
STRING_MULTIBYTE (obj));
else if (COMPILEDP (obj) || VECTORP (obj))
{
int
inhibit_garbage_collection ()
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int nbits = min (VALBITS, BITS_PER_INT);
specbind (Qgc_cons_threshold, make_number (((EMACS_INT) 1 << (nbits - 1)) - 1));
DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
doc: /* Reclaim storage for Lisp objects no longer needed.
-Returns info on amount of space in use:
+Garbage collection happens automatically if you cons more than
+`gc-cons-threshold' bytes of Lisp data since previous garbage collection.
+`garbage-collect' normally returns a list with info on amount of space in use:
((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
(USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS
(USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS)
(USED-STRINGS . FREE-STRINGS))
-Garbage collection happens automatically if you cons more than
-`gc-cons-threshold' bytes of Lisp data since previous garbage collection. */)
+However, if there was overflow in pure space, `garbage-collect'
+returns nil, because real GC can't be done. */)
()
{
- register struct gcpro *tail;
register struct specbinding *bind;
struct catchtag *catch;
struct handler *handler;
register int i;
int message_p;
Lisp_Object total[8];
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
+ EMACS_TIME t1, t2, t3;
+
+ if (abort_on_gc)
+ abort ();
+
+ EMACS_GET_TIME (t1);
/* Can't GC if pure storage overflowed because we can't determine
if something is a pure object or not. */
/* Save what's currently displayed in the echo area. */
message_p = push_message ();
- record_unwind_protect (push_message_unwind, Qnil);
+ record_unwind_protect (pop_message_unwind, Qnil);
/* Save a copy of the contents of the stack, for debugging. */
#if MAX_SAVE_STACK > 0
Qt tends to return NULL, which effectively turns undo back on.
So don't call truncate_undo_list if undo_list is Qt. */
if (! EQ (nextb->undo_list, Qt))
- nextb->undo_list
+ nextb->undo_list
= truncate_undo_list (nextb->undo_list, undo_limit,
undo_strong_limit);
For these, we use MARKBIT to avoid double marking of the slot. */
for (i = 0; i < staticidx; i++)
- mark_object (staticvec[i]);
+ mark_object (*staticvec[i]);
#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
|| GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
mark_stack ();
#else
- for (tail = gcprolist; tail; tail = tail->next)
- for (i = 0; i < tail->nvars; i++)
- if (!XMARKBIT (tail->var[i]))
- {
- /* Explicit casting prevents compiler warning about
- discarding the `volatile' qualifier. */
- mark_object ((Lisp_Object *)&tail->var[i]);
- XMARK (tail->var[i]);
- }
+ {
+ register struct gcpro *tail;
+ for (tail = gcprolist; tail; tail = tail->next)
+ for (i = 0; i < tail->nvars; i++)
+ if (!XMARKBIT (tail->var[i]))
+ {
+ mark_object (tail->var[i]);
+ XMARK (tail->var[i]);
+ }
+ }
#endif
-
+
mark_byte_stack ();
for (bind = specpdl; bind != specpdl_ptr; bind++)
{
- mark_object (&bind->symbol);
- mark_object (&bind->old_value);
+ mark_object (bind->symbol);
+ mark_object (bind->old_value);
}
for (catch = catchlist; catch; catch = catch->next)
{
- mark_object (&catch->tag);
- mark_object (&catch->val);
- }
+ mark_object (catch->tag);
+ mark_object (catch->val);
+ }
for (handler = handlerlist; handler; handler = handler->next)
{
- mark_object (&handler->handler);
- mark_object (&handler->var);
- }
+ mark_object (handler->handler);
+ mark_object (handler->var);
+ }
for (backlist = backtrace_list; backlist; backlist = backlist->next)
{
if (!XMARKBIT (*backlist->function))
{
- mark_object (backlist->function);
+ mark_object (*backlist->function);
XMARK (*backlist->function);
}
if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
for (; i >= 0; i--)
if (!XMARKBIT (backlist->args[i]))
{
- mark_object (&backlist->args[i]);
+ mark_object (backlist->args[i]);
XMARK (backlist->args[i]);
}
- }
+ }
mark_kboards ();
/* Look thru every buffer's undo list
{
if (GC_CONSP (XCAR (tail))
&& GC_MARKERP (XCAR (XCAR (tail)))
- && ! XMARKBIT (XMARKER (XCAR (XCAR (tail)))->chain))
+ && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
{
if (NILP (prev))
nextb->undo_list = tail = XCDR (tail);
mark_stack ();
#endif
+#ifdef USE_GTK
+ {
+ extern void xg_mark_data ();
+ xg_mark_data ();
+ }
+#endif
+
gc_sweep ();
/* Clear the mark bits that we set in certain root slots. */
#if (GC_MARK_STACK == GC_USE_GCPROS_AS_BEFORE \
|| GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES)
- for (tail = gcprolist; tail; tail = tail->next)
- for (i = 0; i < tail->nvars; i++)
- XUNMARK (tail->var[i]);
+ {
+ register struct gcpro *tail;
+
+ for (tail = gcprolist; tail; tail = tail->next)
+ for (i = 0; i < tail->nvars; i++)
+ XUNMARK (tail->var[i]);
+ }
#endif
-
+
unmark_byte_stack ();
for (backlist = backtrace_list; backlist; backlist = backlist->next)
{
i = backlist->nargs - 1;
for (; i >= 0; i--)
XUNMARK (backlist->args[i]);
- }
- XUNMARK (buffer_defaults.name);
- XUNMARK (buffer_local_symbols.name);
+ }
+ VECTOR_UNMARK (&buffer_defaults);
+ VECTOR_UNMARK (&buffer_local_symbols);
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES && 0
dump_zombies ();
{
/* Compute average percentage of zombies. */
double nlive = 0;
-
+
for (i = 0; i < 7; ++i)
- nlive += XFASTINT (XCAR (total[i]));
+ if (CONSP (total[i]))
+ nlive += XFASTINT (XCAR (total[i]));
avg_live = (avg_live * ngcs + nlive) / (ngcs + 1);
max_live = max (nlive, max_live);
safe_run_hooks (Qpost_gc_hook);
unbind_to (count, Qnil);
}
-
+
+ /* Accumulate statistics. */
+ EMACS_GET_TIME (t2);
+ EMACS_SUB_TIME (t3, t2, t1);
+ if (FLOATP (Vgc_elapsed))
+ Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed) +
+ EMACS_SECS (t3) +
+ EMACS_USECS (t3) * 1.0e-6);
+ gcs_done++;
+
return Flist (sizeof total / sizeof *total, total);
}
{
struct glyph *glyph = row->glyphs[area];
struct glyph *end_glyph = glyph + row->used[area];
-
+
for (; glyph < end_glyph; ++glyph)
if (GC_STRINGP (glyph->object)
&& !STRING_MARKED_P (XSTRING (glyph->object)))
- mark_object (&glyph->object);
+ mark_object (glyph->object);
}
}
}
if (face)
{
for (j = 0; j < LFACE_VECTOR_SIZE; ++j)
- mark_object (&face->lface[j]);
+ mark_object (face->lface[j]);
}
}
}
mark_image (img)
struct image *img;
{
- mark_object (&img->spec);
-
+ mark_object (img->spec);
+
if (!NILP (img->data.lisp_val))
- mark_object (&img->data.lisp_val);
+ mark_object (img->data.lisp_val);
}
all the references contained in it. */
#define LAST_MARKED_SIZE 500
-Lisp_Object *last_marked[LAST_MARKED_SIZE];
+Lisp_Object last_marked[LAST_MARKED_SIZE];
int last_marked_index;
+/* For debugging--call abort when we cdr down this many
+ links of a list, in mark_object. In debugging,
+ the call to abort will hit a breakpoint.
+ Normally this is zero and the check never goes off. */
+int mark_object_loop_halt;
+
void
-mark_object (argptr)
- Lisp_Object *argptr;
+mark_object (arg)
+ Lisp_Object arg;
{
- Lisp_Object *objptr = argptr;
- register Lisp_Object obj;
+ register Lisp_Object obj = arg;
#ifdef GC_CHECK_MARKED_OBJECTS
void *po;
struct mem_node *m;
#endif
+ int cdr_count = 0;
loop:
- obj = *objptr;
- loop2:
XUNMARK (obj);
if (PURE_POINTER_P (XPNTR (obj)))
return;
- last_marked[last_marked_index++] = objptr;
+ last_marked[last_marked_index++] = obj;
if (last_marked_index == LAST_MARKED_SIZE)
last_marked_index = 0;
CHECK_ALLOCATED (); \
CHECK_LIVE (LIVEP); \
} while (0) \
-
+
#else /* not GC_CHECK_MARKED_OBJECTS */
-
+
#define CHECK_ALLOCATED() (void) 0
#define CHECK_LIVE(LIVEP) (void) 0
#define CHECK_ALLOCATED_AND_LIVE(LIVEP) (void) 0
-
+
#endif /* not GC_CHECK_MARKED_OBJECTS */
switch (SWITCH_ENUM_CAST (XGCTYPE (obj)))
&& po != &buffer_local_symbols)
abort ();
#endif /* GC_CHECK_MARKED_OBJECTS */
-
+
if (GC_BUFFERP (obj))
{
- if (!XMARKBIT (XBUFFER (obj)->name))
+ if (!VECTOR_MARKED_P (XBUFFER (obj)))
{
#ifdef GC_CHECK_MARKED_OBJECTS
if (po != &buffer_defaults && po != &buffer_local_symbols)
register EMACS_INT size = ptr->size;
register int i;
- if (size & ARRAY_MARK_FLAG)
+ if (VECTOR_MARKED_P (ptr))
break; /* Already marked */
-
+
CHECK_LIVE (live_vector_p);
- ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
+ VECTOR_MARK (ptr); /* Else mark it */
size &= PSEUDOVECTOR_SIZE_MASK;
for (i = 0; i < size; i++) /* and then mark its elements */
{
if (i != COMPILED_CONSTANTS)
- mark_object (&ptr->contents[i]);
+ mark_object (ptr->contents[i]);
}
- /* This cast should be unnecessary, but some Mips compiler complains
- (MIPS-ABI + SysVR4, DC/OSx, etc). */
- objptr = (Lisp_Object *) &ptr->contents[COMPILED_CONSTANTS];
+ obj = ptr->contents[COMPILED_CONSTANTS];
goto loop;
}
else if (GC_FRAMEP (obj))
{
register struct frame *ptr = XFRAME (obj);
- register EMACS_INT size = ptr->size;
- if (size & ARRAY_MARK_FLAG) break; /* Already marked */
- ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
+ if (VECTOR_MARKED_P (ptr)) break; /* Already marked */
+ VECTOR_MARK (ptr); /* Else mark it */
CHECK_LIVE (live_vector_p);
- mark_object (&ptr->name);
- mark_object (&ptr->icon_name);
- mark_object (&ptr->title);
- mark_object (&ptr->focus_frame);
- mark_object (&ptr->selected_window);
- mark_object (&ptr->minibuffer_window);
- mark_object (&ptr->param_alist);
- mark_object (&ptr->scroll_bars);
- mark_object (&ptr->condemned_scroll_bars);
- mark_object (&ptr->menu_bar_items);
- mark_object (&ptr->face_alist);
- mark_object (&ptr->menu_bar_vector);
- mark_object (&ptr->buffer_predicate);
- mark_object (&ptr->buffer_list);
- mark_object (&ptr->menu_bar_window);
- mark_object (&ptr->tool_bar_window);
+ mark_object (ptr->name);
+ mark_object (ptr->icon_name);
+ mark_object (ptr->title);
+ mark_object (ptr->focus_frame);
+ mark_object (ptr->selected_window);
+ mark_object (ptr->minibuffer_window);
+ mark_object (ptr->param_alist);
+ mark_object (ptr->scroll_bars);
+ mark_object (ptr->condemned_scroll_bars);
+ mark_object (ptr->menu_bar_items);
+ mark_object (ptr->face_alist);
+ mark_object (ptr->menu_bar_vector);
+ mark_object (ptr->buffer_predicate);
+ mark_object (ptr->buffer_list);
+ mark_object (ptr->menu_bar_window);
+ mark_object (ptr->tool_bar_window);
mark_face_cache (ptr->face_cache);
#ifdef HAVE_WINDOW_SYSTEM
mark_image_cache (ptr);
- mark_object (&ptr->tool_bar_items);
- mark_object (&ptr->desired_tool_bar_string);
- mark_object (&ptr->current_tool_bar_string);
+ mark_object (ptr->tool_bar_items);
+ mark_object (ptr->desired_tool_bar_string);
+ mark_object (ptr->current_tool_bar_string);
#endif /* HAVE_WINDOW_SYSTEM */
}
else if (GC_BOOL_VECTOR_P (obj))
{
register struct Lisp_Vector *ptr = XVECTOR (obj);
- if (ptr->size & ARRAY_MARK_FLAG)
+ if (VECTOR_MARKED_P (ptr))
break; /* Already marked */
CHECK_LIVE (live_vector_p);
- ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
+ VECTOR_MARK (ptr); /* Else mark it */
}
else if (GC_WINDOWP (obj))
{
register struct Lisp_Vector *ptr = XVECTOR (obj);
struct window *w = XWINDOW (obj);
- register EMACS_INT size = ptr->size;
register int i;
/* Stop if already marked. */
- if (size & ARRAY_MARK_FLAG)
+ if (VECTOR_MARKED_P (ptr))
break;
/* Mark it. */
CHECK_LIVE (live_vector_p);
- ptr->size |= ARRAY_MARK_FLAG;
+ VECTOR_MARK (ptr);
/* There is no Lisp data above The member CURRENT_MATRIX in
struct WINDOW. Stop marking when that slot is reached. */
for (i = 0;
(char *) &ptr->contents[i] < (char *) &w->current_matrix;
i++)
- mark_object (&ptr->contents[i]);
+ mark_object (ptr->contents[i]);
/* Mark glyphs for leaf windows. Marking window matrices is
sufficient because frame matrices use the same glyph
else if (GC_HASH_TABLE_P (obj))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
- EMACS_INT size = h->size;
-
+
/* Stop if already marked. */
- if (size & ARRAY_MARK_FLAG)
+ if (VECTOR_MARKED_P (h))
break;
-
+
/* Mark it. */
CHECK_LIVE (live_vector_p);
- h->size |= ARRAY_MARK_FLAG;
+ VECTOR_MARK (h);
/* Mark contents. */
/* Do not mark next_free or next_weak.
- Being in the next_weak chain
+ Being in the next_weak chain
should not keep the hash table alive.
No need to mark `count' since it is an integer. */
- mark_object (&h->test);
- mark_object (&h->weak);
- mark_object (&h->rehash_size);
- mark_object (&h->rehash_threshold);
- mark_object (&h->hash);
- mark_object (&h->next);
- mark_object (&h->index);
- mark_object (&h->user_hash_function);
- mark_object (&h->user_cmp_function);
+ mark_object (h->test);
+ mark_object (h->weak);
+ mark_object (h->rehash_size);
+ mark_object (h->rehash_threshold);
+ mark_object (h->hash);
+ mark_object (h->next);
+ mark_object (h->index);
+ mark_object (h->user_hash_function);
+ mark_object (h->user_cmp_function);
/* If hash table is not weak, mark all keys and values.
For weak tables, mark only the vector. */
if (GC_NILP (h->weak))
- mark_object (&h->key_and_value);
+ mark_object (h->key_and_value);
else
- XVECTOR (h->key_and_value)->size |= ARRAY_MARK_FLAG;
-
+ VECTOR_MARK (XVECTOR (h->key_and_value));
}
else
{
register EMACS_INT size = ptr->size;
register int i;
- if (size & ARRAY_MARK_FLAG) break; /* Already marked */
+ if (VECTOR_MARKED_P (ptr)) break; /* Already marked */
CHECK_LIVE (live_vector_p);
- ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
+ VECTOR_MARK (ptr); /* Else mark it */
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
for (i = 0; i < size; i++) /* and then mark its elements */
- mark_object (&ptr->contents[i]);
+ mark_object (ptr->contents[i]);
}
break;
register struct Lisp_Symbol *ptr = XSYMBOL (obj);
struct Lisp_Symbol *ptrx;
- if (XMARKBIT (ptr->plist)) break;
+ if (ptr->gcmarkbit) break;
CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
- XMARK (ptr->plist);
- mark_object ((Lisp_Object *) &ptr->value);
- mark_object (&ptr->function);
- mark_object (&ptr->plist);
-
- if (!PURE_POINTER_P (ptr->name))
- MARK_STRING (ptr->name);
- MARK_INTERVAL_TREE (ptr->name->intervals);
-
+ ptr->gcmarkbit = 1;
+ mark_object (ptr->value);
+ mark_object (ptr->function);
+ mark_object (ptr->plist);
+
+ if (!PURE_POINTER_P (XSTRING (ptr->xname)))
+ MARK_STRING (XSTRING (ptr->xname));
+ MARK_INTERVAL_TREE (STRING_INTERVALS (ptr->xname));
+
/* Note that we do not mark the obarray of the symbol.
It is safe not to do so because nothing accesses that
slot except to check whether it is nil. */
ptr = ptr->next;
if (ptr)
{
- /* For the benefit of the last_marked log. */
- objptr = (Lisp_Object *)&XSYMBOL (obj)->next;
ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun */
XSETSYMBOL (obj, ptrx);
- /* We can't goto loop here because *objptr doesn't contain an
- actual Lisp_Object with valid datatype field. */
- goto loop2;
+ goto loop;
}
}
break;
case Lisp_Misc:
CHECK_ALLOCATED_AND_LIVE (live_misc_p);
+ if (XMARKER (obj)->gcmarkbit)
+ break;
+ XMARKER (obj)->gcmarkbit = 1;
switch (XMISCTYPE (obj))
{
- case Lisp_Misc_Marker:
- XMARK (XMARKER (obj)->chain);
- /* DO NOT mark thru the marker's chain.
- The buffer's markers chain does not preserve markers from gc;
- instead, markers are removed from the chain when freed by gc. */
- break;
-
case Lisp_Misc_Buffer_Local_Value:
case Lisp_Misc_Some_Buffer_Local_Value:
{
register struct Lisp_Buffer_Local_Value *ptr
= XBUFFER_LOCAL_VALUE (obj);
- if (XMARKBIT (ptr->realvalue)) break;
- XMARK (ptr->realvalue);
/* If the cdr is nil, avoid recursion for the car. */
if (EQ (ptr->cdr, Qnil))
{
- objptr = &ptr->realvalue;
+ obj = ptr->realvalue;
goto loop;
}
- mark_object (&ptr->realvalue);
- mark_object (&ptr->buffer);
- mark_object (&ptr->frame);
- objptr = &ptr->cdr;
+ mark_object (ptr->realvalue);
+ mark_object (ptr->buffer);
+ mark_object (ptr->frame);
+ obj = ptr->cdr;
goto loop;
}
+ case Lisp_Misc_Marker:
+ /* DO NOT mark thru the marker's chain.
+ The buffer's markers chain does not preserve markers from gc;
+ instead, markers are removed from the chain when freed by gc. */
case Lisp_Misc_Intfwd:
case Lisp_Misc_Boolfwd:
case Lisp_Misc_Objfwd:
since all markable slots in current buffer marked anyway. */
/* Don't need to do Lisp_Objfwd, since the places they point
are protected with staticpro. */
++ case Lisp_Misc_Save_Value:
break;
case Lisp_Misc_Overlay:
{
struct Lisp_Overlay *ptr = XOVERLAY (obj);
- if (!XMARKBIT (ptr->plist))
+ mark_object (ptr->start);
+ mark_object (ptr->end);
+ mark_object (ptr->plist);
+ if (ptr->next)
{
- XMARK (ptr->plist);
- mark_object (&ptr->start);
- mark_object (&ptr->end);
- objptr = &ptr->plist;
+ XSETMISC (obj, ptr->next);
goto loop;
}
}
case Lisp_Cons:
{
register struct Lisp_Cons *ptr = XCONS (obj);
- if (XMARKBIT (ptr->car)) break;
+ if (CONS_MARKED_P (ptr)) break;
CHECK_ALLOCATED_AND_LIVE (live_cons_p);
- XMARK (ptr->car);
+ CONS_MARK (ptr);
/* If the cdr is nil, avoid recursion for the car. */
if (EQ (ptr->cdr, Qnil))
{
- objptr = &ptr->car;
+ obj = ptr->car;
+ cdr_count = 0;
goto loop;
}
- mark_object (&ptr->car);
- objptr = &ptr->cdr;
+ mark_object (ptr->car);
+ obj = ptr->cdr;
+ cdr_count++;
+ if (cdr_count == mark_object_loop_halt)
+ abort ();
goto loop;
}
case Lisp_Float:
CHECK_ALLOCATED_AND_LIVE (live_float_p);
- XMARK (XFLOAT (obj)->type);
+ FLOAT_MARK (XFLOAT (obj));
break;
case Lisp_Int:
Lisp_Object buf;
{
register struct buffer *buffer = XBUFFER (buf);
- register Lisp_Object *ptr;
+ register Lisp_Object *ptr, tmp;
Lisp_Object base_buffer;
- /* This is the buffer's markbit */
- mark_object (&buffer->name);
- XMARK (buffer->name);
+ VECTOR_MARK (buffer);
MARK_INTERVAL_TREE (BUF_INTERVALS (buffer));
Lisp_Object tail;
tail = buffer->undo_list;
+ /* We mark the undo list specially because
+ its pointers to markers should be weak. */
+
while (CONSP (tail))
{
register struct Lisp_Cons *ptr = XCONS (tail);
- if (XMARKBIT (ptr->car))
+ if (CONS_MARKED_P (ptr))
break;
- XMARK (ptr->car);
+ CONS_MARK (ptr);
if (GC_CONSP (ptr->car)
- && ! XMARKBIT (XCAR (ptr->car))
+ && !CONS_MARKED_P (XCONS (ptr->car))
&& GC_MARKERP (XCAR (ptr->car)))
{
- XMARK (XCAR_AS_LVALUE (ptr->car));
- mark_object (&XCDR_AS_LVALUE (ptr->car));
+ CONS_MARK (XCONS (ptr->car));
+ mark_object (XCDR (ptr->car));
}
else
- mark_object (&ptr->car);
+ mark_object (ptr->car);
if (CONSP (ptr->cdr))
tail = ptr->cdr;
break;
}
- mark_object (&XCDR_AS_LVALUE (tail));
+ mark_object (XCDR (tail));
}
else
- mark_object (&buffer->undo_list);
+ mark_object (buffer->undo_list);
- for (ptr = &buffer->name + 1;
+ if (buffer->overlays_before)
+ {
+ XSETMISC (tmp, buffer->overlays_before);
+ mark_object (tmp);
+ }
+ if (buffer->overlays_after)
+ {
+ XSETMISC (tmp, buffer->overlays_after);
+ mark_object (tmp);
+ }
+
+ for (ptr = &buffer->name;
(char *)ptr < (char *)buffer + sizeof (struct buffer);
ptr++)
- mark_object (ptr);
+ mark_object (*ptr);
/* If this is an indirect buffer, mark its base buffer. */
- if (buffer->base_buffer && !XMARKBIT (buffer->base_buffer->name))
+ if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer))
{
- XSETBUFFER (base_buffer, buffer->base_buffer);
+ XSETBUFFER (base_buffer, buffer->base_buffer);
mark_buffer (base_buffer);
}
}
-/* Mark the pointers in the kboard objects. */
-
-static void
-mark_kboards ()
-{
- KBOARD *kb;
- Lisp_Object *p;
- for (kb = all_kboards; kb; kb = kb->next_kboard)
- {
- if (kb->kbd_macro_buffer)
- for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
- mark_object (p);
- mark_object (&kb->Voverriding_terminal_local_map);
- mark_object (&kb->Vlast_command);
- mark_object (&kb->Vreal_last_command);
- mark_object (&kb->Vprefix_arg);
- mark_object (&kb->Vlast_prefix_arg);
- mark_object (&kb->kbd_queue);
- mark_object (&kb->defining_kbd_macro);
- mark_object (&kb->Vlast_kbd_macro);
- mark_object (&kb->Vsystem_key_alist);
- mark_object (&kb->system_key_syms);
- mark_object (&kb->Vdefault_minibuffer_frame);
- }
-}
-
-
/* Value is non-zero if OBJ will survive the current GC because it's
either marked or does not need to be marked to survive. */
Lisp_Object obj;
{
int survives_p;
-
+
switch (XGCTYPE (obj))
{
case Lisp_Int:
break;
case Lisp_Symbol:
- survives_p = XMARKBIT (XSYMBOL (obj)->plist);
+ survives_p = XSYMBOL (obj)->gcmarkbit;
break;
case Lisp_Misc:
- switch (XMISCTYPE (obj))
- {
- case Lisp_Misc_Marker:
- survives_p = XMARKBIT (obj);
- break;
-
- case Lisp_Misc_Buffer_Local_Value:
- case Lisp_Misc_Some_Buffer_Local_Value:
- survives_p = XMARKBIT (XBUFFER_LOCAL_VALUE (obj)->realvalue);
- break;
-
- case Lisp_Misc_Intfwd:
- case Lisp_Misc_Boolfwd:
- case Lisp_Misc_Objfwd:
- case Lisp_Misc_Buffer_Objfwd:
- case Lisp_Misc_Kboard_Objfwd:
- survives_p = 1;
- break;
-
- case Lisp_Misc_Overlay:
- survives_p = XMARKBIT (XOVERLAY (obj)->plist);
- break;
-
- default:
- abort ();
- }
+ survives_p = XMARKER (obj)->gcmarkbit;
break;
case Lisp_String:
- {
- struct Lisp_String *s = XSTRING (obj);
- survives_p = STRING_MARKED_P (s);
- }
+ survives_p = STRING_MARKED_P (XSTRING (obj));
break;
case Lisp_Vectorlike:
- if (GC_BUFFERP (obj))
- survives_p = XMARKBIT (XBUFFER (obj)->name);
- else if (GC_SUBRP (obj))
- survives_p = 1;
- else
- survives_p = XVECTOR (obj)->size & ARRAY_MARK_FLAG;
+ survives_p = GC_SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj));
break;
case Lisp_Cons:
- survives_p = XMARKBIT (XCAR (obj));
+ survives_p = CONS_MARKED_P (XCONS (obj));
break;
case Lisp_Float:
- survives_p = XMARKBIT (XFLOAT (obj)->type);
+ survives_p = FLOAT_MARKED_P (XFLOAT (obj));
break;
default:
register int num_free = 0, num_used = 0;
cons_free_list = 0;
-
+
for (cblk = cons_block; cblk; cblk = *cprev)
{
register int i;
int this_free = 0;
for (i = 0; i < lim; i++)
- if (!XMARKBIT (cblk->conses[i].car))
+ if (!CONS_MARKED_P (&cblk->conses[i]))
{
this_free++;
*(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list;
else
{
num_used++;
- XUNMARK (cblk->conses[i].car);
+ CONS_UNMARK (&cblk->conses[i]);
}
lim = CONS_BLOCK_SIZE;
/* If this block contains only free conses and we have already
*cprev = cblk->next;
/* Unhook from the free list. */
cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr;
- lisp_free (cblk);
+ lisp_align_free (cblk);
n_cons_blocks--;
}
else
register int num_free = 0, num_used = 0;
float_free_list = 0;
-
+
for (fblk = float_block; fblk; fblk = *fprev)
{
register int i;
int this_free = 0;
for (i = 0; i < lim; i++)
- if (!XMARKBIT (fblk->floats[i].type))
+ if (!FLOAT_MARKED_P (&fblk->floats[i]))
{
this_free++;
*(struct Lisp_Float **)&fblk->floats[i].data = float_free_list;
float_free_list = &fblk->floats[i];
-#if GC_MARK_STACK
- float_free_list->type = Vdead;
-#endif
}
else
{
num_used++;
- XUNMARK (fblk->floats[i].type);
+ FLOAT_UNMARK (&fblk->floats[i]);
}
lim = FLOAT_BLOCK_SIZE;
/* If this block contains only free floats and we have already
*fprev = fblk->next;
/* Unhook from the free list. */
float_free_list = *(struct Lisp_Float **) &fblk->floats[0].data;
- lisp_free (fblk);
+ lisp_align_free (fblk);
n_float_blocks--;
}
else
for (i = 0; i < lim; i++)
{
- if (! XMARKBIT (iblk->intervals[i].plist))
+ if (!iblk->intervals[i].gcmarkbit)
{
SET_INTERVAL_PARENT (&iblk->intervals[i], interval_free_list);
interval_free_list = &iblk->intervals[i];
else
{
num_used++;
- XUNMARK (iblk->intervals[i].plist);
+ iblk->intervals[i].gcmarkbit = 0;
}
}
lim = INTERVAL_BLOCK_SIZE;
register int num_free = 0, num_used = 0;
symbol_free_list = NULL;
-
+
for (sblk = symbol_block; sblk; sblk = *sprev)
{
int this_free = 0;
/* Check if the symbol was created during loadup. In such a case
it might be pointed to by pure bytecode which we don't trace,
so we conservatively assume that it is live. */
- int pure_p = PURE_POINTER_P (sym->name);
-
- if (!XMARKBIT (sym->plist) && !pure_p)
+ int pure_p = PURE_POINTER_P (XSTRING (sym->xname));
+
+ if (!sym->gcmarkbit && !pure_p)
{
*(struct Lisp_Symbol **) &sym->value = symbol_free_list;
symbol_free_list = sym;
{
++num_used;
if (!pure_p)
- UNMARK_STRING (sym->name);
- XUNMARK (sym->plist);
+ UNMARK_STRING (XSTRING (sym->xname));
+ sym->gcmarkbit = 0;
}
}
-
+
lim = SYMBOL_BLOCK_SIZE;
/* If this block contains only free symbols and we have already
seen more than two blocks worth of free symbols then deallocate
register int num_free = 0, num_used = 0;
marker_free_list = 0;
-
+
for (mblk = marker_block; mblk; mblk = *mprev)
{
register int i;
int this_free = 0;
- EMACS_INT already_free = -1;
for (i = 0; i < lim; i++)
{
- Lisp_Object *markword;
- switch (mblk->markers[i].u_marker.type)
- {
- case Lisp_Misc_Marker:
- markword = &mblk->markers[i].u_marker.chain;
- break;
- case Lisp_Misc_Buffer_Local_Value:
- case Lisp_Misc_Some_Buffer_Local_Value:
- markword = &mblk->markers[i].u_buffer_local_value.realvalue;
- break;
- case Lisp_Misc_Overlay:
- markword = &mblk->markers[i].u_overlay.plist;
- break;
- case Lisp_Misc_Free:
- /* If the object was already free, keep it
- on the free list. */
- markword = (Lisp_Object *) &already_free;
- break;
- default:
- markword = 0;
- break;
- }
- if (markword && !XMARKBIT (*markword))
+ if (!mblk->markers[i].u_marker.gcmarkbit)
{
- Lisp_Object tem;
if (mblk->markers[i].u_marker.type == Lisp_Misc_Marker)
- {
- /* tem1 avoids Sun compiler bug */
- struct Lisp_Marker *tem1 = &mblk->markers[i].u_marker;
- XSETMARKER (tem, tem1);
- unchain_marker (tem);
- }
+ unchain_marker (&mblk->markers[i].u_marker);
/* Set the type of the freed object to Lisp_Misc_Free.
We could leave the type alone, since nobody checks it,
but this might catch bugs faster. */
else
{
num_used++;
- if (markword)
- XUNMARK (*markword);
+ mblk->markers[i].u_marker.gcmarkbit = 0;
}
}
lim = MARKER_BLOCK_SIZE;
register struct buffer *buffer = all_buffers, *prev = 0, *next;
while (buffer)
- if (!XMARKBIT (buffer->name))
+ if (!VECTOR_MARKED_P (buffer))
{
if (prev)
prev->next = buffer->next;
}
else
{
- XUNMARK (buffer->name);
+ VECTOR_UNMARK (buffer);
UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer));
prev = buffer, buffer = buffer->next;
}
total_vector_size = 0;
while (vector)
- if (!(vector->size & ARRAY_MARK_FLAG))
+ if (!VECTOR_MARKED_P (vector))
{
if (prev)
prev->next = vector->next;
}
else
{
- vector->size &= ~ARRAY_MARK_FLAG;
+ VECTOR_UNMARK (vector);
if (vector->size & PSEUDOVECTOR_FLAG)
total_vector_size += (PSEUDOVECTOR_SIZE_MASK & vector->size);
else
prev = vector, vector = vector->next;
}
}
-
+
#ifdef GC_CHECK_STRING_BYTES
if (!noninteractive)
check_string_bytes (1);
pure_bytes_used = 0;
pure_bytes_used_before_overflow = 0;
+ /* Initialize the list of free aligned blocks. */
+ free_ablock = NULL;
+
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
mem_init ();
Vdead = make_pure_string ("DEAD", 4, 4, 0);
setjmp_tested_p = longjmps_done = 0;
#endif
#endif
+ Vgc_elapsed = make_float (0.0);
+ gcs_done = 0;
}
void
Qpost_gc_hook = intern ("post-gc-hook");
staticpro (&Qpost_gc_hook);
+ DEFVAR_LISP ("memory-signal-data", &Vmemory_signal_data,
+ doc: /* Precomputed `signal' argument for memory-full error. */);
/* We build this in advance because if we wait until we need it, we might
not be able to allocate the memory to hold it. */
- memory_signal_data
- = Fcons (Qerror, Fcons (build_string ("Memory exhausted--use M-x save-some-buffers RET"), Qnil));
- staticpro (&memory_signal_data);
+ Vmemory_signal_data
+ = list2 (Qerror,
+ build_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"));
+
+ DEFVAR_LISP ("memory-full", &Vmemory_full,
+ doc: /* Non-nil means we are handling a memory-full error. */);
+ Vmemory_full = Qnil;
staticpro (&Qgc_cons_threshold);
Qgc_cons_threshold = intern ("gc-cons-threshold");
staticpro (&Qchar_table_extra_slots);
Qchar_table_extra_slots = intern ("char-table-extra-slots");
+ DEFVAR_LISP ("gc-elapsed", &Vgc_elapsed,
+ doc: /* Accumulated time elapsed in garbage collections.
+The time is in seconds as a floating point value. */);
+ DEFVAR_INT ("gcs-done", &gcs_done,
+ doc: /* Accumulated number of garbage collections done. */);
+
defsubr (&Scons);
defsubr (&Slist);
defsubr (&Svector);
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,86,87,88,89,93,94,95,97,98, 1999, 2000, 2001, 2002
+ Copyright (C) 1985,86,87,88,89,93,94,95,97,98, 1999, 2000, 2001, 02, 2003
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#endif
#ifndef MAXPATHLEN
-/* in 4.1, param.h fails to define this. */
+/* in 4.1 [probably SunOS? -stef] , param.h fails to define this. */
#define MAXPATHLEN 1024
#endif /* not MAXPATHLEN */
#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"
/* List of functions to call that can query about killing a buffer.
If any of these functions returns nil, we don't kill it. */
Lisp_Object Vkill_buffer_query_functions;
+Lisp_Object Qkill_buffer_query_functions;
/* List of functions to call before changing an unmodified buffer. */
Lisp_Object Vfirst_change_hook;
Lisp_Object Qfirst_change_hook;
Lisp_Object Qbefore_change_functions;
Lisp_Object Qafter_change_functions;
+Lisp_Object Qucs_set_table_for_input;
/* If nonzero, all modification hooks are suppressed. */
int inhibit_modification_hooks;
static void alloc_buffer_text P_ ((struct buffer *, size_t));
static void free_buffer_text P_ ((struct buffer *b));
-static Lisp_Object copy_overlays P_ ((struct buffer *, Lisp_Object));
-static void modify_overlay P_ ((struct buffer *, int, int));
+static struct Lisp_Overlay * copy_overlays P_ ((struct buffer *, struct Lisp_Overlay *));
+static void modify_overlay P_ ((struct buffer *, EMACS_INT, EMACS_INT));
+ extern char * emacs_strerror P_ ((int));
/* For debugging; temporary. See set_buffer_internal. */
/* Lisp_Object Qlisp_mode, Vcheck_symbol; */
Lisp_Object spec;
{
if (STRINGP (spec))
- error ("No buffer named %s", XSTRING (spec)->data);
+ error ("No buffer named %s", SDATA (spec));
error ("Invalid buffer argument");
}
\f
DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
doc: /* Return a list of all existing live buffers.
-If the optional arg FRAME is a frame, we return that frame's buffer list. */)
+If the optional arg FRAME is a frame, we return the buffer list
+in the proper order for that frame: the buffers in FRAME's `buffer-list'
+frame parameter come first, followed by the rest of the buffers. */)
(frame)
Lisp_Object frame;
{
Lisp_Object list;
{
register Lisp_Object tail;
- for (tail = list; !NILP (tail); tail = Fcdr (tail))
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
{
register Lisp_Object elt, tem;
- elt = Fcar (tail);
+ elt = XCAR (tail);
tem = Fstring_equal (Fcar (elt), key);
if (!NILP (tem))
return elt;
if (!NILP (buf))
return buf;
- if (XSTRING (name)->size == 0)
+ if (SCHARS (name) == 0)
error ("Empty string for buffer name is not allowed");
b = (struct buffer *) allocate_buffer ();
if (! BUF_BEG_ADDR (b))
buffer_memory_full ();
- BUF_PT (b) = 1;
- BUF_GPT (b) = 1;
- BUF_BEGV (b) = 1;
- BUF_ZV (b) = 1;
- BUF_Z (b) = 1;
- BUF_PT_BYTE (b) = 1;
- BUF_GPT_BYTE (b) = 1;
- BUF_BEGV_BYTE (b) = 1;
- BUF_ZV_BYTE (b) = 1;
- BUF_Z_BYTE (b) = 1;
+ BUF_PT (b) = BEG;
+ BUF_GPT (b) = BEG;
+ BUF_BEGV (b) = BEG;
+ BUF_ZV (b) = BEG;
+ BUF_Z (b) = BEG;
+ BUF_PT_BYTE (b) = BEG_BYTE;
+ BUF_GPT_BYTE (b) = BEG_BYTE;
+ BUF_BEGV_BYTE (b) = BEG_BYTE;
+ BUF_ZV_BYTE (b) = BEG_BYTE;
+ BUF_Z_BYTE (b) = BEG_BYTE;
BUF_MODIFF (b) = 1;
BUF_OVERLAY_MODIFF (b) = 1;
BUF_SAVE_MODIFF (b) = 1;
b->zv_marker = Qnil;
name = Fcopy_sequence (name);
- XSTRING (name)->intervals = NULL_INTERVAL;
+ STRING_SET_INTERVALS (name, NULL_INTERVAL);
b->name = name;
- if (XSTRING (name)->data[0] != ' ')
+ if (SREF (name, 0) != ' ')
b->undo_list = Qnil;
else
b->undo_list = Qt;
reset_buffer (b);
reset_buffer_local_variables (b, 1);
+ b->mark = Fmake_marker ();
+ BUF_MARKERS (b) = NULL;
+ b->name = name;
+
/* Put this in the alist of all live buffers. */
XSETBUFFER (buf, b);
Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
- b->mark = Fmake_marker ();
- BUF_MARKERS (b) = Qnil;
- b->name = name;
+ /* An error in calling the function here (should someone redfine it)
+ can lead to infinite regress until you run out of stack. rms
+ says that's not worth protecting against. */
+ if (!NILP (Ffboundp (Qucs_set_table_for_input)))
+ /* buf is on buffer-alist, so no gcpro. */
+ call1 (Qucs_set_table_for_input, buf);
+
return buf;
}
/* Return a list of overlays which is a copy of the overlay list
LIST, but for buffer B. */
-static Lisp_Object
+static struct Lisp_Overlay *
copy_overlays (b, list)
struct buffer *b;
- Lisp_Object list;
+ struct Lisp_Overlay *list;
{
- Lisp_Object result, buffer;
+ Lisp_Object buffer;
+ struct Lisp_Overlay *result = NULL, *tail = NULL;
XSETBUFFER (buffer, b);
- for (result = Qnil; CONSP (list); list = XCDR (list))
+ for (; list; list = list->next)
{
Lisp_Object overlay, start, end, old_overlay;
- int charpos;
+ EMACS_INT charpos;
- old_overlay = XCAR (list);
+ XSETMISC (old_overlay, list);
charpos = marker_position (OVERLAY_START (old_overlay));
start = Fmake_marker ();
Fset_marker (start, make_number (charpos), buffer);
OVERLAY_START (overlay) = start;
OVERLAY_END (overlay) = end;
OVERLAY_PLIST (overlay) = Fcopy_sequence (OVERLAY_PLIST (old_overlay));
-
- result = Fcons (overlay, result);
+ XOVERLAY (overlay)->next = NULL;
+
+ if (tail)
+ tail = tail->next = XOVERLAY (overlay);
+ else
+ result = tail = XOVERLAY (overlay);
}
- return Fnreverse (result);
+ return result;
}
-
+
/* Clone per-buffer values of buffer FROM.
int offset;
XSETBUFFER (to_buffer, to);
-
+
for (offset = PER_BUFFER_VAR_OFFSET (name) + sizeof (Lisp_Object);
offset < sizeof *to;
offset += sizeof (Lisp_Object))
}
bcopy (from->local_flags, to->local_flags, sizeof to->local_flags);
-
+
to->overlays_before = copy_overlays (to, from->overlays_before);
to->overlays_after = copy_overlays (to, from->overlays_after);
}
buf = Fget_buffer (name);
if (!NILP (buf))
- error ("Buffer name `%s' is in use", XSTRING (name)->data);
+ error ("Buffer name `%s' is in use", SDATA (name));
base_buffer = Fget_buffer (base_buffer);
if (NILP (base_buffer))
- error ("No such buffer: `%s'", XSTRING (name)->data);
+ error ("No such buffer: `%s'", SDATA (name));
- if (XSTRING (name)->size == 0)
+ if (SCHARS (name) == 0)
error ("Empty string for buffer name is not allowed");
b = (struct buffer *) allocate_buffer ();
all_buffers = b;
name = Fcopy_sequence (name);
- XSTRING (name)->intervals = NULL_INTERVAL;
+ STRING_SET_INTERVALS (name, NULL_INTERVAL);
b->name = name;
reset_buffer (b);
return buf;
}
+void
+delete_all_overlays (b)
+ struct buffer *b;
+{
+ Lisp_Object overlay;
+
+ /* `reset_buffer' blindly sets the list of overlays to NULL, so we
+ have to empty the list, otherwise we end up with overlays that
+ think they belong to this buffer while the buffer doesn't know about
+ them any more. */
+ while (b->overlays_before)
+ {
+ XSETMISC (overlay, b->overlays_before);
+ Fdelete_overlay (overlay);
+ }
+ while (b->overlays_after)
+ {
+ XSETMISC (overlay, b->overlays_after);
+ Fdelete_overlay (overlay);
+ }
+ eassert (b->overlays_before == NULL);
+ eassert (b->overlays_after == NULL);
+}
+
/* Reinitialize everything about a buffer except its name and contents
- and local variables. */
+ and local variables.
+ If called on an already-initialized buffer, the list of overlays
+ should be deleted before calling this function, otherwise we end up
+ with overlays that claim to belong to the buffer but the buffer
+ claims it doesn't belong to it. */
void
reset_buffer (b)
b->auto_save_failure_time = -1;
b->auto_save_file_name = Qnil;
b->read_only = Qnil;
- b->overlays_before = Qnil;
- b->overlays_after = Qnil;
- XSETFASTINT (b->overlay_center, 1);
+ b->overlays_before = NULL;
+ b->overlays_after = NULL;
+ b->overlay_center = BEG;
b->mark_active = Qnil;
b->point_before_scroll = Qnil;
b->file_format = Qnil;
We ignore it here. */
b->major_mode = Qfundamental_mode;
b->keymap = Qnil;
- b->abbrev_table = Vfundamental_mode_abbrev_table;
b->mode_name = QSFundamental;
b->minor_modes = Qnil;
b->buffer_file_type = Qnil;
#endif
-#if 0
- b->sort_table = XSTRING (Vascii_sort_table);
- b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
-#endif /* 0 */
-
/* Reset all (or most) per-buffer variables to their defaults. */
b->local_var_alist = Qnil;
for (i = 0; i < last_per_buffer_idx; ++i)
}
DEFUN ("buffer-local-value", Fbuffer_local_value,
- Sbuffer_local_value, 2, 2, 0,
+ Sbuffer_local_value, 2, 2, 0,
doc: /* Return the value of VARIABLE in BUFFER.
If VARIABLE does not have a buffer-local binding in BUFFER, the value
is the default binding of variable. */)
/* Look in local_var_list */
result = Fassoc (symbol, buf->local_var_alist);
- if (NILP (result))
+ if (NILP (result))
{
int offset, idx;
int found = 0;
{
idx = PER_BUFFER_IDX (offset);
if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
- && SYMBOLP (PER_BUFFER_SYMBOL (offset))
- && EQ (PER_BUFFER_SYMBOL (offset), symbol))
+ && SYMBOLP (PER_BUFFER_SYMBOL (offset))
+ && EQ (PER_BUFFER_SYMBOL (offset), symbol))
{
result = PER_BUFFER_VALUE (buf, offset);
found = 1;
result = Fdefault_value (symbol);
}
else
- result = XCDR (result);
+ {
+ Lisp_Object valcontents;
+ Lisp_Object current_alist_element;
+
+ /* What binding is loaded right now? */
+ valcontents = SYMBOL_VALUE (symbol);
+ current_alist_element
+ = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
+
+ /* The value of the currently loaded binding is not
+ stored in it, but rather in the realvalue slot.
+ Store that value into the binding it belongs to
+ in case that is the one we are about to use. */
+
+ Fsetcdr (current_alist_element,
+ do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
+
+ /* Now get the (perhaps updated) value out of the binding. */
+ result = XCDR (result);
+ }
if (EQ (result, Qunbound))
return Fsignal (Qvoid_variable, Fcons (symbol, Qnil));
#endif /* CLASH_DETECTION */
SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
-
+
/* Set update_mode_lines only if buffer is displayed in some window.
Packages like jit-lock or lazy-lock preserve a buffer's modified
state by recording/restoring the state around blocks of code.
++update_mode_lines;
current_buffer->prevent_redisplay_optimizations_p = 1;
}
-
+
return flag;
}
{
#ifdef CLASH_DETECTION
Lisp_Object fn;
-
+
/* If buffer becoming modified, lock the file.
If buffer becoming unmodified, unlock the file. */
unlock_file (fn);
}
#endif /* CLASH_DETECTION */
-
+
SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
return flag;
}
CHECK_STRING (newname);
- if (XSTRING (newname)->size == 0)
+ if (SCHARS (newname) == 0)
error ("Empty string is invalid as a buffer name");
tem = Fget_buffer (newname);
if (!NILP (unique))
newname = Fgenerate_new_buffer_name (newname, current_buffer->name);
else
- error ("Buffer name `%s' is in use", XSTRING (newname)->data);
+ error ("Buffer name `%s' is in use", SDATA (newname));
}
current_buffer->name = newname;
/* Consider buffers that have been seen in the selected frame
before other buffers. */
-
+
tem = frame_buffer_list (frame);
add_ons = Qnil;
while (CONSP (tem))
}
tail = nconc2 (Fnreverse (add_ons), tail);
- for (; !NILP (tail); tail = Fcdr (tail))
+ for (; CONSP (tail); tail = XCDR (tail))
{
- buf = Fcdr (Fcar (tail));
+ buf = Fcdr (XCAR (tail));
if (EQ (buf, buffer))
continue;
- if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
+ if (SREF (XBUFFER (buf)->name, 0) == ' ')
continue;
/* If the selected frame has a buffer_predicate,
disregard buffers that don't fit the predicate. */
&& BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
{
GCPRO1 (buf);
- tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
- XSTRING (b->name)->data));
+ tem = do_yes_or_no_p (format2 ("Buffer %s modified; kill anyway? ",
+ b->name, make_number (0)));
UNGCPRO;
if (NILP (tem))
return Qnil;
/* Run hooks with the buffer to be killed the current buffer. */
{
- int count = specpdl_ptr - specpdl;
- Lisp_Object list;
+ int count = SPECPDL_INDEX ();
+ Lisp_Object arglist[1];
record_unwind_protect (save_excursion_restore, save_excursion_save ());
set_buffer_internal (b);
/* First run the query functions; if any query is answered no,
don't kill the buffer. */
- for (list = Vkill_buffer_query_functions; !NILP (list); list = Fcdr (list))
- {
- tem = call0 (Fcar (list));
- if (NILP (tem))
- return unbind_to (count, Qnil);
- }
+ arglist[0] = Qkill_buffer_query_functions;
+ if (NILP (Frun_hook_with_args_until_failure (1, arglist)))
+ return unbind_to (count, Qnil);
/* Then run the hooks. */
Frun_hooks (1, &Qkill_buffer_hook);
UNGCPRO;
}
-
+
/* Make this buffer not be current.
In the process, notice if this is the sole visible buffer
and give up if so. */
#endif /* CLASH_DETECTION */
kill_buffer_processes (buf);
+ clear_charpos_cache (b);
tem = Vinhibit_quit;
Vinhibit_quit = Qt;
/* Unchain all markers that belong to this indirect buffer.
Don't unchain the markers that belong to the base buffer
or its other indirect buffers. */
- for (tem = BUF_MARKERS (b); !NILP (tem); )
+ for (m = BUF_MARKERS (b); m; )
{
- Lisp_Object next;
- m = XMARKER (tem);
- next = m->chain;
+ struct Lisp_Marker *next = m->next;
if (m->buffer == b)
- unchain_marker (tem);
- tem = next;
+ unchain_marker (m);
+ m = next;
}
}
else
{
/* Unchain all markers of this buffer and its indirect buffers.
and leave them pointing nowhere. */
- for (tem = BUF_MARKERS (b); !NILP (tem); )
+ for (m = BUF_MARKERS (b); m; )
{
- m = XMARKER (tem);
+ struct Lisp_Marker *next = m->next;
m->buffer = 0;
- tem = m->chain;
- m->chain = Qnil;
+ m->next = NULL;
+ m = next;
}
- BUF_MARKERS (b) = Qnil;
+ BUF_MARKERS (b) = NULL;
BUF_INTERVALS (b) = NULL_INTERVAL;
/* Perhaps we should explicitly free the interval tree here... */
Vbuffer_alist = XCDR (Vbuffer_alist);
else
XSETCDR (prev, XCDR (XCDR (prev)));
-
+
XSETCDR (link, Vbuffer_alist);
Vbuffer_alist = link;
XCDR (frame_buffer_list (frame)));
else
XSETCDR (prev, XCDR (XCDR (prev)));
-
+
XSETCDR (link, frame_buffer_list (frame));
set_frame_buffer_list (frame, link);
}
Lisp_Object function;
if (STRINGP (XBUFFER (buffer)->name)
- && strcmp (XSTRING (XBUFFER (buffer)->name)->data, "*scratch*") == 0)
+ && strcmp (SDATA (XBUFFER (buffer)->name), "*scratch*") == 0)
function = find_symbol_value (intern ("initial-major-mode"));
else
{
&& NILP (Fget (current_buffer->major_mode, Qmode_class)))
function = current_buffer->major_mode;
}
-
+
if (NILP (function) || EQ (function, Qfundamental_mode))
return Qnil;
- count = specpdl_ptr - specpdl;
+ count = SPECPDL_INDEX ();
/* To select a nonfundamental mode,
select the buffer temporarily and then call the mode function. */
if (EQ (minibuf_window, window))
return "Cannot switch buffers in minibuffer window";
tem = Fwindow_dedicated_p (window);
- if (!NILP (tem))
+ if (EQ (tem, Qt))
return "Cannot switch buffers in a dedicated window";
return NULL;
}
Fset_window_buffer (EQ (selected_window, minibuf_window)
? Fnext_window (minibuf_window, Qnil, Qnil)
: selected_window,
- buf);
+ buf, Qnil);
return buf;
}
{
char *err;
+ if (EQ (buffer, Fwindow_buffer (selected_window)))
+ /* Basically a NOP. Avoid signalling an error if the selected window
+ is dedicated, or a minibuffer, ... */
+ return Fset_buffer (buffer);
+
err = no_switch_window (selected_window);
if (err) error (err);
}
Fset_buffer (buf);
if (NILP (norecord))
- /* This seems bogus since Fselect_window will call record_buffer anyway. */
+ /* Why bother ? Fselect_window will do it for us anyway. -stef */
record_buffer (buf);
- Fselect_window (Fdisplay_buffer (buf, other_window, Qnil));
+ Fselect_window (Fdisplay_buffer (buf, other_window, Qnil), norecord);
return buf;
}
if (b->text->beg == NULL)
enlarge_buffer_text (b, 0);
#endif /* USE_MMAP_FOR_BUFFERS */
-
+
if (current_buffer == b)
return;
/* Look down buffer's list of local Lisp variables
to find and update any that forward into C variables. */
- for (tail = b->local_var_alist; !NILP (tail); tail = XCDR (tail))
+ for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail))
{
valcontents = SYMBOL_VALUE (XCAR (XCAR (tail)));
if ((BUFFER_LOCAL_VALUEP (valcontents)
/* Do the same with any others that were local to the previous buffer */
if (old_buf)
- for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCDR (tail))
+ for (tail = old_buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
{
valcontents = SYMBOL_VALUE (XCAR (XCAR (tail)));
if ((BUFFER_LOCAL_VALUEP (valcontents)
else
{
Lisp_Object buf1;
-
+
buf1 = Fget_buffer (buffer);
if (NILP (buf1))
nsberror (buffer);
XSETCDR (link, Qnil);
Vbuffer_alist = nconc2 (Vbuffer_alist, link);
- frames_bury_buffer (buffer);
+ /* Removing BUFFER from frame-specific lists
+ has the effect of putting BUFFER at the end
+ of the combined list in each frame. */
+ frames_discard_buffer (buffer);
}
return Qnil;
if (byte_pos == BEG)
/* Beginning of buffer is always a character boundary. */
- return 1;
+ return BEG;
c = FETCH_BYTE (byte_pos);
if (! CHAR_HEAD_P (c))
return byte_pos;
}
-
-/* Symbols used as the 2nd arg of Fset_buffer_multibyte. */
-static Lisp_Object Qas, Qmake, Qto;
-
-
DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
- 1, 2, 0,
+ 1, 1, 0,
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 unibyte buffer.
-
-Optional second arg METHOD specifies how to convert the byte sequence
-of the buffer.
-
-If it is nil or `as', the buffer contents remain unchanged as a
-sequence of bytes but the contents viewed as characters do change.
-
-If it is `make', convert each character by unibyte-char-to-multibyte
-or multibyte-char-to-unibyte.
-
-If it is `to', convert each character by byte-to-char or
-char-to-byte. */)
- (flag, method)
- Lisp_Object flag, method;
+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. */)
+ (flag)
+ Lisp_Object flag;
{
- Lisp_Object tail, markers;
+ struct Lisp_Marker *tail, *markers;
struct buffer *other;
int undo_enabled_p = !EQ (current_buffer->undo_list, Qt);
- int begv = BEGV, zv = ZV;
- int narrowed = (BEG != begv || Z != zv);
+ int begv, zv;
+ int narrowed = (BEG != BEGV || Z != ZV);
int modified_p = !NILP (Fbuffer_modified_p (Qnil));
- CHECK_SYMBOL (method);
- if (NILP (method))
- method = Qas;
- else if (! EQ (method, Qas) && ! EQ (method, Qmake) && ! EQ (method, Qto))
- error ("Invalid unibyte<->multibyte conversion method: %s",
- XSYMBOL (method)->name->data);
-
if (current_buffer->base_buffer)
error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
/* If the cached position is for this buffer, clear it out. */
clear_charpos_cache (current_buffer);
+ if (NILP (flag))
+ begv = BEGV_BYTE, zv = ZV_BYTE;
+ else
+ begv = BEGV, zv = ZV;
+
if (narrowed)
Fwiden ();
GPT = GPT_BYTE;
TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
- tail = BUF_MARKERS (current_buffer);
- while (! NILP (tail))
- {
- XMARKER (tail)->charpos = XMARKER (tail)->bytepos;
- tail = XMARKER (tail)->chain;
- }
+
+ for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
+ tail->charpos = tail->bytepos;
/* Convert multibyte form of 8-bit characters to unibyte. */
pos = BEG;
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 if (EQ (method, Qas))
++ else
+ {
+ bytes = BYTES_BY_CHAR_HEAD (*p);
+ p += bytes, pos += bytes;
+ }
- else
- {
- /* Delete all bytes for this character but the last one,
- and change the last one to the unibyte code. */
- c = STRING_CHAR_AND_LENGTH (p, stop - pos, bytes);
- bytes--;
- del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
- p = GAP_END_ADDR;
- *p++ = CHAR_TO_BYTE (c);
- pos++;
- if (begv > pos)
- begv -= bytes;
- if (zv > pos)
- zv -= bytes;
- stop = Z;
- }
}
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 (method, Qas)
++ 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 (method, Qas)
- && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0)
++ 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);
- if (EQ (method, Qmake))
- c = unibyte_char_to_multibyte (*p);
- else
- c = BYTE8_TO_CHAR (*p);
-
++ 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;
}
}
/* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
getting confused by the markers that have not yet been updated.
It is also a signal that it should never create a marker. */
- BUF_MARKERS (current_buffer) = Qnil;
+ BUF_MARKERS (current_buffer) = NULL;
- while (! NILP (tail))
+ for (; tail; tail = tail->next)
{
- XMARKER (tail)->bytepos
- = advance_to_char_boundary (XMARKER (tail)->bytepos);
- XMARKER (tail)->charpos = BYTE_TO_CHAR (XMARKER (tail)->bytepos);
-
- tail = XMARKER (tail)->chain;
+ tail->bytepos = advance_to_char_boundary (tail->bytepos);
+ tail->charpos = BYTE_TO_CHAR (tail->bytepos);
}
/* Make sure no markers were put on the chain
while the chain value was incorrect. */
- if (! EQ (BUF_MARKERS (current_buffer), Qnil))
+ if (BUF_MARKERS (current_buffer))
abort ();
BUF_MARKERS (current_buffer) = markers;
if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
Fset_buffer_modified_p (Qnil);
+#ifdef subprocesses
+ /* Update coding systems of this buffer's process (if any). */
+ {
+ Lisp_Object process;
+
+ process = Fget_buffer_process (Fcurrent_buffer ());
+ if (PROCESSP (process))
+ setup_process_coding_systems (process);
+ }
+#endif /* subprocesses */
+
return flag;
}
\f
/* Any which are supposed to be permanent,
make local again, with the same values they had. */
-
+
for (alist = oalist; !NILP (alist); alist = XCDR (alist))
{
sym = XCAR (XCAR (alist));
}
\f
/* Find all the overlays in the current buffer that contain position POS.
- Return the number found, and store them in a vector in *VEC_PTR.
+ Return the number found, and store them in a vector in *VEC_PTR.
Store in *LEN_PTR the size allocated for the vector.
Store in *NEXT_PTR the next position after POS where an overlay starts,
or ZV if there are no more overlays.
int
overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr, change_req)
- int pos;
+ EMACS_INT pos;
int extend;
Lisp_Object **vec_ptr;
int *len_ptr;
int *prev_ptr;
int change_req;
{
- Lisp_Object tail, overlay, start, end;
+ Lisp_Object overlay, start, end;
+ struct Lisp_Overlay *tail;
int idx = 0;
int len = *len_ptr;
Lisp_Object *vec = *vec_ptr;
int prev = BEGV;
int inhibit_storing = 0;
- for (tail = current_buffer->overlays_before;
- GC_CONSP (tail);
- tail = XCDR (tail))
+ for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
int startpos, endpos;
- overlay = XCAR (tail);
+ XSETMISC (overlay, tail);
start = OVERLAY_START (overlay);
end = OVERLAY_END (overlay);
next = startpos;
}
- for (tail = current_buffer->overlays_after;
- GC_CONSP (tail);
- tail = XCDR (tail))
+ for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
int startpos, endpos;
- overlay = XCAR (tail);
+ XSETMISC (overlay, tail);
start = OVERLAY_START (overlay);
end = OVERLAY_END (overlay);
{
if (extend)
{
- *len_ptr = len *= 2;
+ /* Make it work with an initial len == 0. */
+ len *= 2;
if (len == 0)
- len = *len_ptr = 4;
+ len = 4;
+ *len_ptr = len;
vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
*vec_ptr = vec;
}
/* Find all the overlays in the current buffer that overlap the range BEG-END
or are empty at BEG.
- Return the number found, and store them in a vector in *VEC_PTR.
+ Return the number found, and store them in a vector in *VEC_PTR.
Store in *LEN_PTR the size allocated for the vector.
Store in *NEXT_PTR the next position after POS where an overlay starts,
or ZV if there are no more overlays.
and we store only as many overlays as will fit.
But we still return the total number of overlays. */
-int
+static int
overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
int beg, end;
int extend;
int *next_ptr;
int *prev_ptr;
{
- Lisp_Object tail, overlay, ostart, oend;
+ Lisp_Object overlay, ostart, oend;
+ struct Lisp_Overlay *tail;
int idx = 0;
int len = *len_ptr;
Lisp_Object *vec = *vec_ptr;
int prev = BEGV;
int inhibit_storing = 0;
- for (tail = current_buffer->overlays_before;
- GC_CONSP (tail);
- tail = XCDR (tail))
+ for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
int startpos, endpos;
- overlay = XCAR (tail);
+ XSETMISC (overlay, tail);
ostart = OVERLAY_START (overlay);
oend = OVERLAY_END (overlay);
Either make it bigger, or don't store any more in it. */
if (extend)
{
- *len_ptr = len *= 2;
+ /* Make it work with an initial len == 0. */
+ len *= 2;
+ if (len == 0)
+ len = 4;
+ *len_ptr = len;
vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
*vec_ptr = vec;
}
next = startpos;
}
- for (tail = current_buffer->overlays_after;
- GC_CONSP (tail);
- tail = XCDR (tail))
+ for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
int startpos, endpos;
- overlay = XCAR (tail);
+ XSETMISC (overlay, tail);
ostart = OVERLAY_START (overlay);
oend = OVERLAY_END (overlay);
{
if (extend)
{
- *len_ptr = len *= 2;
+ /* Make it work with an initial len == 0. */
+ len *= 2;
+ if (len == 0)
+ len = 4;
+ *len_ptr = len;
vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
*vec_ptr = vec;
}
int end = OVERLAY_POSITION (OVERLAY_END (overlay));
int n, i, size;
Lisp_Object *v, tem;
-
+
size = 10;
v = (Lisp_Object *) alloca (size * sizeof *v);
n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
overlay_touches_p (pos)
int pos;
{
- Lisp_Object tail, overlay;
+ Lisp_Object overlay;
+ struct Lisp_Overlay *tail;
- for (tail = current_buffer->overlays_before; GC_CONSP (tail);
- tail = XCDR (tail))
+ for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
int endpos;
- overlay = XCAR (tail);
+ XSETMISC (overlay ,tail);
if (!GC_OVERLAYP (overlay))
abort ();
return 1;
}
- for (tail = current_buffer->overlays_after; GC_CONSP (tail);
- tail = XCDR (tail))
+ for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
int startpos;
- overlay = XCAR (tail);
+ XSETMISC (overlay, tail);
if (!GC_OVERLAYP (overlay))
abort ();
ssl->used++;
if (NILP (current_buffer->enable_multibyte_characters))
- nbytes = XSTRING (str)->size;
+ nbytes = SCHARS (str);
else if (! STRING_MULTIBYTE (str))
- nbytes = count_size_as_multibyte (XSTRING (str)->data,
- STRING_BYTES (XSTRING (str)));
+ nbytes = count_size_as_multibyte (SDATA (str),
+ SBYTES (str));
else
- nbytes = STRING_BYTES (XSTRING (str));
+ nbytes = SBYTES (str);
ssl->bytes += nbytes;
if (STRINGP (str2))
{
if (NILP (current_buffer->enable_multibyte_characters))
- nbytes = XSTRING (str2)->size;
+ nbytes = SCHARS (str2);
else if (! STRING_MULTIBYTE (str2))
- nbytes = count_size_as_multibyte (XSTRING (str2)->data,
- STRING_BYTES (XSTRING (str2)));
+ nbytes = count_size_as_multibyte (SDATA (str2),
+ SBYTES (str2));
else
- nbytes = STRING_BYTES (XSTRING (str2));
+ nbytes = SBYTES (str2);
ssl->bytes += nbytes;
}
int
overlay_strings (pos, w, pstr)
- int pos;
+ EMACS_INT pos;
struct window *w;
unsigned char **pstr;
{
- Lisp_Object ov, overlay, window, str;
+ Lisp_Object overlay, window, str;
+ struct Lisp_Overlay *ov;
int startpos, endpos;
int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
overlay_heads.used = overlay_heads.bytes = 0;
overlay_tails.used = overlay_tails.bytes = 0;
- for (ov = current_buffer->overlays_before; CONSP (ov); ov = XCDR (ov))
+ for (ov = current_buffer->overlays_before; ov; ov = ov->next)
{
- overlay = XCAR (ov);
- if (!OVERLAYP (overlay))
- abort ();
+ XSETMISC (overlay, ov);
+ eassert (OVERLAYP (overlay));
startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
Foverlay_get (overlay, Qpriority),
endpos - startpos);
}
- for (ov = current_buffer->overlays_after; CONSP (ov); ov = XCDR (ov))
+ for (ov = current_buffer->overlays_after; ov; ov = ov->next)
{
- overlay = XCAR (ov);
- if (!OVERLAYP (overlay))
- abort ();
+ XSETMISC (overlay, ov);
+ eassert (OVERLAYP (overlay));
startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
{
int nbytes;
tem = overlay_tails.buf[i].string;
- nbytes = copy_text (XSTRING (tem)->data, p,
- STRING_BYTES (XSTRING (tem)),
+ nbytes = copy_text (SDATA (tem), p,
+ SBYTES (tem),
STRING_MULTIBYTE (tem), multibyte);
p += nbytes;
}
{
int nbytes;
tem = overlay_heads.buf[i].string;
- nbytes = copy_text (XSTRING (tem)->data, p,
- STRING_BYTES (XSTRING (tem)),
+ nbytes = copy_text (SDATA (tem), p,
+ SBYTES (tem),
STRING_MULTIBYTE (tem), multibyte);
p += nbytes;
tem = overlay_heads.buf[i].string2;
if (STRINGP (tem))
{
- nbytes = copy_text (XSTRING (tem)->data, p,
- STRING_BYTES (XSTRING (tem)),
+ nbytes = copy_text (SDATA (tem), p,
+ SBYTES (tem),
STRING_MULTIBYTE (tem), multibyte);
p += nbytes;
}
void
recenter_overlay_lists (buf, pos)
struct buffer *buf;
- int pos;
+ EMACS_INT pos;
{
- Lisp_Object overlay, tail, next, prev, beg, end;
+ Lisp_Object overlay, beg, end;
+ struct Lisp_Overlay *prev, *tail, *next;
/* See if anything in overlays_before should move to overlays_after. */
/* We don't strictly need prev in this loop; it should always be nil.
But we use it for symmetry and in case that should cease to be true
with some future change. */
- prev = Qnil;
- for (tail = buf->overlays_before;
- CONSP (tail);
- prev = tail, tail = next)
+ prev = NULL;
+ for (tail = buf->overlays_before; tail; prev = tail, tail = next)
{
- next = XCDR (tail);
- overlay = XCAR (tail);
+ next = tail->next;
+ XSETMISC (overlay, tail);
/* If the overlay is not valid, get rid of it. */
if (!OVERLAY_VALID (overlay))
{
/* OVERLAY needs to be moved. */
int where = OVERLAY_POSITION (beg);
- Lisp_Object other, other_prev;
+ struct Lisp_Overlay *other, *other_prev;
/* Splice the cons cell TAIL out of overlays_before. */
- if (!NILP (prev))
- XSETCDR (prev, next);
+ if (prev)
+ prev->next = next;
else
buf->overlays_before = next;
/* Search thru overlays_after for where to put it. */
- other_prev = Qnil;
- for (other = buf->overlays_after;
- CONSP (other);
- other_prev = other, other = XCDR (other))
+ other_prev = NULL;
+ for (other = buf->overlays_after; other;
+ other_prev = other, other = other->next)
{
Lisp_Object otherbeg, otheroverlay;
- otheroverlay = XCAR (other);
- if (! OVERLAY_VALID (otheroverlay))
- abort ();
+ XSETMISC (otheroverlay, other);
+ eassert (OVERLAY_VALID (otheroverlay));
otherbeg = OVERLAY_START (otheroverlay);
if (OVERLAY_POSITION (otherbeg) >= where)
}
/* Add TAIL to overlays_after before OTHER. */
- XSETCDR (tail, other);
- if (!NILP (other_prev))
- XSETCDR (other_prev, tail);
+ tail->next = other;
+ if (other_prev)
+ other_prev->next = tail;
else
buf->overlays_after = tail;
tail = prev;
}
/* See if anything in overlays_after should be in overlays_before. */
- prev = Qnil;
- for (tail = buf->overlays_after;
- CONSP (tail);
- prev = tail, tail = next)
+ prev = NULL;
+ for (tail = buf->overlays_after; tail; prev = tail, tail = next)
{
- next = XCDR (tail);
- overlay = XCAR (tail);
+ next = tail->next;
+ XSETMISC (overlay, tail);
/* If the overlay is not valid, get rid of it. */
if (!OVERLAY_VALID (overlay))
{
/* OVERLAY needs to be moved. */
int where = OVERLAY_POSITION (end);
- Lisp_Object other, other_prev;
+ struct Lisp_Overlay *other, *other_prev;
/* Splice the cons cell TAIL out of overlays_after. */
- if (!NILP (prev))
- XSETCDR (prev, next);
+ if (prev)
+ prev->next = next;
else
buf->overlays_after = next;
/* Search thru overlays_before for where to put it. */
- other_prev = Qnil;
- for (other = buf->overlays_before;
- CONSP (other);
- other_prev = other, other = XCDR (other))
+ other_prev = NULL;
+ for (other = buf->overlays_before; other;
+ other_prev = other, other = other->next)
{
Lisp_Object otherend, otheroverlay;
- otheroverlay = XCAR (other);
- if (! OVERLAY_VALID (otheroverlay))
- abort ();
+ XSETMISC (otheroverlay, other);
+ eassert (OVERLAY_VALID (otheroverlay));
otherend = OVERLAY_END (otheroverlay);
if (OVERLAY_POSITION (otherend) <= where)
}
/* Add TAIL to overlays_before before OTHER. */
- XSETCDR (tail, other);
- if (!NILP (other_prev))
- XSETCDR (other_prev, tail);
+ tail->next = other;
+ if (other_prev)
+ other_prev->next = tail;
else
buf->overlays_before = tail;
tail = prev;
}
}
- XSETFASTINT (buf->overlay_center, pos);
+ buf->overlay_center = pos;
}
void
adjust_overlays_for_insert (pos, length)
- int pos;
- int length;
+ EMACS_INT pos;
+ EMACS_INT length;
{
/* After an insertion, the lists are still sorted properly,
but we may need to update the value of the overlay center. */
- if (XFASTINT (current_buffer->overlay_center) >= pos)
- XSETFASTINT (current_buffer->overlay_center,
- XFASTINT (current_buffer->overlay_center) + length);
+ if (current_buffer->overlay_center >= pos)
+ current_buffer->overlay_center += length;
}
void
adjust_overlays_for_delete (pos, length)
- int pos;
- int length;
+ EMACS_INT pos;
+ EMACS_INT length;
{
- if (XFASTINT (current_buffer->overlay_center) < pos)
+ if (current_buffer->overlay_center < pos)
/* The deletion was to our right. No change needed; the before- and
after-lists are still consistent. */
;
- else if (XFASTINT (current_buffer->overlay_center) > pos + length)
+ else if (current_buffer->overlay_center > pos + length)
/* The deletion was to our left. We need to adjust the center value
to account for the change in position, but the lists are consistent
given the new value. */
- XSETFASTINT (current_buffer->overlay_center,
- XFASTINT (current_buffer->overlay_center) - length);
+ current_buffer->overlay_center -= length;
else
/* We're right in the middle. There might be things on the after-list
that now belong on the before-list. Recentering will move them,
register int start, end;
{
Lisp_Object overlay;
- Lisp_Object before_list, after_list;
- Lisp_Object *ptail, *pbefore = &before_list, *pafter = &after_list;
+ struct Lisp_Overlay *before_list, *after_list;
+ /* These are either nil, indicating that before_list or after_list
+ should be assigned, or the cons cell the cdr of which should be
+ assigned. */
+ struct Lisp_Overlay *beforep = NULL, *afterp = NULL;
+ /* 'Parent', likewise, indicates a cons cell or
+ current_buffer->overlays_before or overlays_after, depending
+ which loop we're in. */
+ struct Lisp_Overlay *tail, *parent;
int startpos, endpos;
/* This algorithm shifts links around instead of consing and GCing.
The loop invariant is that before_list (resp. after_list) is a
- well-formed list except that its last element, the one that
- *pbefore (resp. *pafter) points to, is still uninitialized.
- So it's not a bug that before_list isn't initialized, although
- it may look strange. */
- for (ptail = ¤t_buffer->overlays_before; CONSP (*ptail);)
+ well-formed list except that its last element, the CDR of beforep
+ (resp. afterp) if beforep (afterp) isn't nil or before_list
+ (after_list) if it is, is still uninitialized. So it's not a bug
+ that before_list isn't initialized, although it may look
+ strange. */
+ for (parent = NULL, tail = current_buffer->overlays_before; tail;)
{
- overlay = XCAR (*ptail);
+ XSETMISC (overlay, tail);
endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
if (endpos < start)
break;
}
/* Add it to the end of the wrong list. Later on,
recenter_overlay_lists will move it to the right place. */
- if (endpos < XINT (current_buffer->overlay_center))
+ if (endpos < current_buffer->overlay_center)
{
- *pafter = *ptail;
- pafter = &XCDR (*ptail);
+ if (!afterp)
+ after_list = tail;
+ else
+ afterp->next = tail;
+ afterp = tail;
}
else
{
- *pbefore = *ptail;
- pbefore = &XCDR (*ptail);
+ if (!beforep)
+ before_list = tail;
+ else
+ beforep->next = tail;
+ beforep = tail;
}
- *ptail = XCDR (*ptail);
+ if (!parent)
+ current_buffer->overlays_before = tail->next;
+ else
+ parent->next = tail->next;
+ tail = tail->next;
}
else
- ptail = &XCDR (*ptail);
+ parent = tail, tail = parent->next;
}
- for (ptail = ¤t_buffer->overlays_after; CONSP (*ptail);)
+ for (parent = NULL, tail = current_buffer->overlays_after; tail;)
{
- overlay = XCAR (*ptail);
+ XSETMISC (overlay, tail);
startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
if (startpos >= end)
break;
Qnil);
tem = startpos; startpos = endpos; endpos = tem;
}
- if (endpos < XINT (current_buffer->overlay_center))
+ if (endpos < current_buffer->overlay_center)
{
- *pafter = *ptail;
- pafter = &XCDR (*ptail);
+ if (!afterp)
+ after_list = tail;
+ else
+ afterp->next = tail;
+ afterp = tail;
}
else
{
- *pbefore = *ptail;
- pbefore = &XCDR (*ptail);
+ if (!beforep)
+ before_list = tail;
+ else
+ beforep->next = tail;
+ beforep = tail;
}
- *ptail = XCDR (*ptail);
+ if (!parent)
+ current_buffer->overlays_after = tail->next;
+ else
+ parent->next = tail->next;
+ tail = tail->next;
}
else
- ptail = &XCDR (*ptail);
+ parent = tail, tail = parent->next;
}
/* Splice the constructed (wrong) lists into the buffer's lists,
and let the recenter function make it sane again. */
- *pbefore = current_buffer->overlays_before;
- current_buffer->overlays_before = before_list;
- recenter_overlay_lists (current_buffer,
- XINT (current_buffer->overlay_center));
-
- *pafter = current_buffer->overlays_after;
- current_buffer->overlays_after = after_list;
- recenter_overlay_lists (current_buffer,
- XINT (current_buffer->overlay_center));
+ if (beforep)
+ {
+ beforep->next = current_buffer->overlays_before;
+ current_buffer->overlays_before = before_list;
+ }
+ recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
+
+ if (afterp)
+ {
+ afterp->next = current_buffer->overlays_after;
+ current_buffer->overlays_after = after_list;
+ }
+ recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
}
/* We have two types of overlay: the one whose ending marker is
void
fix_overlays_before (bp, prev, pos)
struct buffer *bp;
- int prev, pos;
+ EMACS_INT prev, pos;
{
- Lisp_Object *tailp = &bp->overlays_before;
- Lisp_Object *right_place;
- int end;
+ /* If parent is nil, replace overlays_before; otherwise, parent->next. */
+ struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
+ Lisp_Object tem;
+ EMACS_INT end;
/* After the insertion, the several overlays may be in incorrect
order. The possibility is that, in the list `overlays_before',
in. It is where an overlay which end before POS exists. (i.e. an
overlay whose ending marker is after-insertion-marker if disorder
exists). */
- while (!NILP (*tailp)
- && ((end = OVERLAY_POSITION (OVERLAY_END (XCAR (*tailp))))
- >= pos))
- tailp = &XCDR (*tailp);
+ while (tail
+ && (XSETMISC (tem, tail),
+ (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos))
+ {
+ parent = tail;
+ tail = tail->next;
+ }
/* If we don't find such an overlay,
or the found one ends before PREV,
or the found one is the last one in the list,
we don't have to fix anything. */
- if (NILP (*tailp)
- || end < prev
- || NILP (XCDR (*tailp)))
+ if (!tail || end < prev || !tail->next)
return;
- right_place = tailp;
- tailp = &XCDR (*tailp);
+ right_pair = parent;
+ parent = tail;
+ tail = tail->next;
- /* Now, end position of overlays in the list *TAILP should be before
+ /* Now, end position of overlays in the list TAIL should be before
or equal to PREV. In the loop, an overlay which ends at POS is
- moved ahead to the place pointed by RIGHT_PLACE. If we found an
- overlay which ends before PREV, the remaining overlays are in
- correct order. */
- while (!NILP (*tailp))
+ moved ahead to the place indicated by the CDR of RIGHT_PAIR. If
+ we found an overlay which ends before PREV, the remaining
+ overlays are in correct order. */
+ while (tail)
{
- end = OVERLAY_POSITION (OVERLAY_END (XCAR (*tailp)));
+ XSETMISC (tem, tail);
+ end = OVERLAY_POSITION (OVERLAY_END (tem));
if (end == pos)
{ /* This overlay is disordered. */
- Lisp_Object found = *tailp;
+ struct Lisp_Overlay *found = tail;
/* Unlink the found overlay. */
- *tailp = XCDR (found);
- /* Move an overlay at RIGHT_PLACE to the next of the found one. */
- XCDR (found) = *right_place;
- /* Link it into the right place. */
- *right_place = found;
+ tail = found->next;
+ parent->next = tail;
+ /* Move an overlay at RIGHT_PLACE to the next of the found one,
+ and link it into the right place. */
+ if (!right_pair)
+ {
+ found->next = bp->overlays_before;
+ bp->overlays_before = found;
+ }
+ else
+ {
+ found->next = right_pair->next;
+ right_pair->next = found;
+ }
}
else if (end == prev)
- tailp = &XCDR (*tailp);
+ {
+ parent = tail;
+ tail = tail->next;
+ }
else /* No more disordered overlay. */
break;
}
XOVERLAY (overlay)->start = beg;
XOVERLAY (overlay)->end = end;
XOVERLAY (overlay)->plist = Qnil;
+ XOVERLAY (overlay)->next = NULL;
- /* Put the new overlay on the wrong list. */
+ /* Put the new overlay on the wrong list. */
end = OVERLAY_END (overlay);
- if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
- b->overlays_after = Fcons (overlay, b->overlays_after);
+ if (OVERLAY_POSITION (end) < b->overlay_center)
+ {
+ if (b->overlays_after)
+ XOVERLAY (overlay)->next = b->overlays_after;
+ b->overlays_after = XOVERLAY (overlay);
+ }
else
- b->overlays_before = Fcons (overlay, b->overlays_before);
+ {
+ if (b->overlays_before)
+ XOVERLAY (overlay)->next = b->overlays_before;
+ b->overlays_before = XOVERLAY (overlay);
+ }
/* This puts it in the right list, and in the right order. */
- recenter_overlay_lists (b, XINT (b->overlay_center));
+ recenter_overlay_lists (b, b->overlay_center);
/* We don't need to redisplay the region covered by the overlay, because
the overlay has no properties at the moment. */
static void
modify_overlay (buf, start, end)
struct buffer *buf;
- int start, end;
+ EMACS_INT start, end;
{
if (start > end)
{
}
BUF_COMPUTE_UNCHANGED (buf, start, end);
-
+
/* If this is a buffer not in the selected window,
we must do other windows. */
if (buf != XBUFFER (XWINDOW (selected_window)->buffer))
\f
Lisp_Object Fdelete_overlay ();
+static struct Lisp_Overlay *
+unchain_overlay (list, overlay)
+ struct Lisp_Overlay *list, *overlay;
+{
+ struct Lisp_Overlay *tmp, *prev;
+ for (tmp = list, prev = NULL; tmp; prev = tmp, tmp = tmp->next)
+ if (tmp == overlay)
+ {
+ if (prev)
+ prev->next = tmp->next;
+ else
+ list = tmp->next;
+ overlay->next = NULL;
+ break;
+ }
+ return list;
+}
+
DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
{
struct buffer *b, *ob;
Lisp_Object obuffer;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
CHECK_OVERLAY (overlay);
if (NILP (buffer))
if (!NILP (obuffer))
{
- ob->overlays_before = Fdelq (overlay, ob->overlays_before);
- ob->overlays_after = Fdelq (overlay, ob->overlays_after);
+ ob->overlays_before
+ = unchain_overlay (ob->overlays_before, XOVERLAY (overlay));
+ ob->overlays_after
+ = unchain_overlay (ob->overlays_after, XOVERLAY (overlay));
+ eassert (XOVERLAY (overlay)->next == NULL);
}
Fset_marker (OVERLAY_START (overlay), beg, buffer);
Fset_marker (OVERLAY_END (overlay), end, buffer);
- /* Put the overlay on the wrong list. */
+ /* Put the overlay on the wrong list. */
end = OVERLAY_END (overlay);
- if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
- b->overlays_after = Fcons (overlay, b->overlays_after);
+ if (OVERLAY_POSITION (end) < b->overlay_center)
+ {
- if (b->overlays_after)
- XOVERLAY (overlay)->next = b->overlays_after;
- b->overlays_after = XOVERLAY (overlay);
++ XOVERLAY (overlay)->next = b->overlays_after;
++ b->overlays_after = XOVERLAY (overlay);
+ }
else
- b->overlays_before = Fcons (overlay, b->overlays_before);
+ {
- if (b->overlays_before)
- XOVERLAY (overlay)->next = b->overlays_before;
- b->overlays_before = XOVERLAY (overlay);
++ XOVERLAY (overlay)->next = b->overlays_before;
++ b->overlays_before = XOVERLAY (overlay);
+ }
/* This puts it in the right list, and in the right order. */
- recenter_overlay_lists (b, XINT (b->overlay_center));
+ recenter_overlay_lists (b, b->overlay_center);
return unbind_to (count, overlay);
}
{
Lisp_Object buffer;
struct buffer *b;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
CHECK_OVERLAY (overlay);
b = XBUFFER (buffer);
specbind (Qinhibit_quit, Qt);
-
- b->overlays_before = Fdelq (overlay, b->overlays_before);
- b->overlays_after = Fdelq (overlay, b->overlays_after);
+
+ b->overlays_before = unchain_overlay (b->overlays_before,XOVERLAY (overlay));
+ b->overlays_after = unchain_overlay (b->overlays_after, XOVERLAY (overlay));
+ eassert (XOVERLAY (overlay)->next == NULL);
modify_overlay (b,
marker_position (OVERLAY_START (overlay)),
marker_position (OVERLAY_END (overlay)));
However, the overlays you get are the real objects that the buffer uses. */)
()
{
- Lisp_Object before, after;
- before = current_buffer->overlays_before;
- if (CONSP (before))
- before = Fcopy_sequence (before);
- after = current_buffer->overlays_after;
- if (CONSP (after))
- after = Fcopy_sequence (after);
-
- return Fcons (before, after);
+ struct Lisp_Overlay *ol;
+ Lisp_Object before = Qnil, after = Qnil, tmp;
+ for (ol = current_buffer->overlays_before; ol; ol = ol->next)
+ {
+ XSETMISC (tmp, ol);
+ before = Fcons (tmp, before);
+ }
+ for (ol = current_buffer->overlays_after; ol; ol = ol->next)
+ {
+ XSETMISC (tmp, ol);
+ after = Fcons (tmp, after);
+ }
+ return Fcons (Fnreverse (before), Fnreverse (after));
}
DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
- doc: /* Recenter the overlays of the current buffer around position POS. */)
+ doc: /* Recenter the overlays of the current buffer around position POS.
+That makes overlay lookup faster for positions near POS (but perhaps slower
+for positions far away from POS). */)
(pos)
Lisp_Object pos;
{
(overlay, prop)
Lisp_Object overlay, prop;
{
- Lisp_Object plist, fallback;
-
CHECK_OVERLAY (overlay);
-
- fallback = Qnil;
-
- for (plist = XOVERLAY (overlay)->plist;
- CONSP (plist) && CONSP (XCDR (plist));
- plist = XCDR (XCDR (plist)))
- {
- if (EQ (XCAR (plist), prop))
- return XCAR (XCDR (plist));
- else if (EQ (XCAR (plist), Qcategory))
- {
- Lisp_Object tem;
- tem = Fcar (Fcdr (plist));
- if (SYMBOLP (tem))
- fallback = Fget (tem, prop);
- }
- }
-
- return fallback;
+ return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0);
}
DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
XVECTOR (last_overlay_modification_hooks)->contents,
sizeof (Lisp_Object) * oldsize);
}
- XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = functionlist;
- XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = overlay;
+ AREF (last_overlay_modification_hooks, last_overlay_modification_hooks_used++) = functionlist;
+ AREF (last_overlay_modification_hooks, last_overlay_modification_hooks_used++) = overlay;
}
\f
/* Run the modification-hooks of overlays that include
int after;
Lisp_Object arg1, arg2, arg3;
{
- Lisp_Object prop, overlay, tail;
+ Lisp_Object prop, overlay;
+ struct Lisp_Overlay *tail;
/* 1 if this change is an insertion. */
int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
- int tail_copied;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
overlay = Qnil;
- tail = Qnil;
- GCPRO5 (overlay, tail, arg1, arg2, arg3);
-
- if (after)
- {
- /* Call the functions recorded in last_overlay_modification_hooks
- rather than scanning the overlays again.
- First copy the vector contents, in case some of these hooks
- do subsequent modification of the buffer. */
- int size = last_overlay_modification_hooks_used;
- Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
- int i;
+ tail = NULL;
- bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
- copy, size * sizeof (Lisp_Object));
- gcpro1.var = copy;
- gcpro1.nvars = size;
+ /* We used to run the functions as soon as we found them and only register
+ them in last_overlay_modification_hooks for the purpose of the `after'
+ case. But running elisp code as we traverse the list of overlays is
+ painful because the list can be modified by the elisp code so we had to
+ copy at several places. We now simply do a read-only traversal that
+ only collects the functions to run and we run them afterwards. It's
+ simpler, especially since all the code was already there. -stef */
- for (i = 0; i < size;)
- {
- Lisp_Object prop, overlay;
- prop = copy[i++];
- overlay = copy[i++];
- call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
- }
- UNGCPRO;
- return;
- }
-
- /* We are being called before a change.
- Scan the overlays to find the functions to call. */
- last_overlay_modification_hooks_used = 0;
- tail_copied = 0;
- for (tail = current_buffer->overlays_before;
- CONSP (tail);
- tail = XCDR (tail))
+ if (!after)
{
- int startpos, endpos;
- Lisp_Object ostart, oend;
-
- overlay = XCAR (tail);
-
- ostart = OVERLAY_START (overlay);
- oend = OVERLAY_END (overlay);
- endpos = OVERLAY_POSITION (oend);
- if (XFASTINT (start) > endpos)
- break;
- startpos = OVERLAY_POSITION (ostart);
- if (insertion && (XFASTINT (start) == startpos
- || XFASTINT (end) == startpos))
+ /* We are being called before a change.
+ Scan the overlays to find the functions to call. */
+ last_overlay_modification_hooks_used = 0;
+ for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
- prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
- if (!NILP (prop))
+ int startpos, endpos;
+ Lisp_Object ostart, oend;
+
+ XSETMISC (overlay, tail);
+
+ ostart = OVERLAY_START (overlay);
+ oend = OVERLAY_END (overlay);
+ endpos = OVERLAY_POSITION (oend);
+ if (XFASTINT (start) > endpos)
+ break;
+ startpos = OVERLAY_POSITION (ostart);
+ if (insertion && (XFASTINT (start) == startpos
+ || XFASTINT (end) == startpos))
{
- /* Copy TAIL in case the hook recenters the overlay lists. */
- if (!tail_copied)
- tail = Fcopy_sequence (tail);
- tail_copied = 1;
- call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
+ prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
+ if (!NILP (prop))
+ add_overlay_mod_hooklist (prop, overlay);
}
- }
- if (insertion && (XFASTINT (start) == endpos
- || XFASTINT (end) == endpos))
- {
- prop = Foverlay_get (overlay, Qinsert_behind_hooks);
- if (!NILP (prop))
+ if (insertion && (XFASTINT (start) == endpos
+ || XFASTINT (end) == endpos))
{
- if (!tail_copied)
- tail = Fcopy_sequence (tail);
- tail_copied = 1;
- call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
+ prop = Foverlay_get (overlay, Qinsert_behind_hooks);
+ if (!NILP (prop))
+ add_overlay_mod_hooklist (prop, overlay);
}
- }
- /* Test for intersecting intervals. This does the right thing
- for both insertion and deletion. */
- if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
- {
- prop = Foverlay_get (overlay, Qmodification_hooks);
- if (!NILP (prop))
+ /* Test for intersecting intervals. This does the right thing
+ for both insertion and deletion. */
+ if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
{
- if (!tail_copied)
- tail = Fcopy_sequence (tail);
- tail_copied = 1;
- call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
+ prop = Foverlay_get (overlay, Qmodification_hooks);
+ if (!NILP (prop))
+ add_overlay_mod_hooklist (prop, overlay);
}
}
- }
-
- tail_copied = 0;
- for (tail = current_buffer->overlays_after;
- CONSP (tail);
- tail = XCDR (tail))
- {
- int startpos, endpos;
- Lisp_Object ostart, oend;
-
- overlay = XCAR (tail);
-
- ostart = OVERLAY_START (overlay);
- oend = OVERLAY_END (overlay);
- startpos = OVERLAY_POSITION (ostart);
- endpos = OVERLAY_POSITION (oend);
- if (XFASTINT (end) < startpos)
- break;
- if (insertion && (XFASTINT (start) == startpos
- || XFASTINT (end) == startpos))
+
+ for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
- prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
- if (!NILP (prop))
+ int startpos, endpos;
+ Lisp_Object ostart, oend;
+
+ XSETMISC (overlay, tail);
+
+ ostart = OVERLAY_START (overlay);
+ oend = OVERLAY_END (overlay);
+ startpos = OVERLAY_POSITION (ostart);
+ endpos = OVERLAY_POSITION (oend);
+ if (XFASTINT (end) < startpos)
+ break;
+ if (insertion && (XFASTINT (start) == startpos
+ || XFASTINT (end) == startpos))
{
- if (!tail_copied)
- tail = Fcopy_sequence (tail);
- tail_copied = 1;
- call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
+ prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
+ if (!NILP (prop))
+ add_overlay_mod_hooklist (prop, overlay);
}
- }
- if (insertion && (XFASTINT (start) == endpos
- || XFASTINT (end) == endpos))
- {
- prop = Foverlay_get (overlay, Qinsert_behind_hooks);
- if (!NILP (prop))
+ if (insertion && (XFASTINT (start) == endpos
+ || XFASTINT (end) == endpos))
{
- if (!tail_copied)
- tail = Fcopy_sequence (tail);
- tail_copied = 1;
- call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
+ prop = Foverlay_get (overlay, Qinsert_behind_hooks);
+ if (!NILP (prop))
+ add_overlay_mod_hooklist (prop, overlay);
}
- }
- /* Test for intersecting intervals. This does the right thing
- for both insertion and deletion. */
- if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
- {
- prop = Foverlay_get (overlay, Qmodification_hooks);
- if (!NILP (prop))
+ /* Test for intersecting intervals. This does the right thing
+ for both insertion and deletion. */
+ if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
{
- if (!tail_copied)
- tail = Fcopy_sequence (tail);
- tail_copied = 1;
- call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
+ prop = Foverlay_get (overlay, Qmodification_hooks);
+ if (!NILP (prop))
+ add_overlay_mod_hooklist (prop, overlay);
}
}
}
+ GCPRO4 (overlay, arg1, arg2, arg3);
+ {
+ /* Call the functions recorded in last_overlay_modification_hooks.
+ First copy the vector contents, in case some of these hooks
+ do subsequent modification of the buffer. */
+ int size = last_overlay_modification_hooks_used;
+ Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
+ int i;
+
+ bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
+ copy, size * sizeof (Lisp_Object));
+ gcpro1.var = copy;
+ gcpro1.nvars = size;
+
+ for (i = 0; i < size;)
+ {
+ Lisp_Object prop, overlay;
+ prop = copy[i++];
+ overlay = copy[i++];
+ call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
+ }
+ }
UNGCPRO;
}
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
GCPRO4 (list, arg1, arg2, arg3);
- if (! after)
- add_overlay_mod_hooklist (list, overlay);
- while (!NILP (list))
+ while (CONSP (list))
{
if (NILP (arg3))
- call4 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2);
+ call4 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2);
else
- call5 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
- list = Fcdr (list);
+ call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
+ list = XCDR (list);
}
UNGCPRO;
}
property is set. */
void
evaporate_overlays (pos)
- int pos;
+ EMACS_INT pos;
{
- Lisp_Object tail, overlay, hit_list;
+ Lisp_Object overlay, hit_list;
+ struct Lisp_Overlay *tail;
hit_list = Qnil;
- if (pos <= XFASTINT (current_buffer->overlay_center))
- for (tail = current_buffer->overlays_before; CONSP (tail);
- tail = XCDR (tail))
+ if (pos <= current_buffer->overlay_center)
+ for (tail = current_buffer->overlays_before; tail; tail = tail->next)
{
int endpos;
- overlay = XCAR (tail);
+ XSETMISC (overlay, tail);
endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
if (endpos < pos)
break;
hit_list = Fcons (overlay, hit_list);
}
else
- for (tail = current_buffer->overlays_after; CONSP (tail);
- tail = XCDR (tail))
+ for (tail = current_buffer->overlays_after; tail; tail = tail->next)
{
int startpos;
- overlay = XCAR (tail);
+ XSETMISC (overlay, tail);
startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
if (startpos > pos)
break;
{
Lisp_Object sym;
char *type_name;
-
+
switch (XINT (PER_BUFFER_TYPE (offset)))
{
case Lisp_Int:
type_name = "integers";
break;
-
+
case Lisp_String:
type_name = "strings";
break;
-
+
case Lisp_Symbol:
type_name = "symbols";
break;
-
+
default:
abort ();
}
sym = PER_BUFFER_SYMBOL (offset);
error ("Only %s should be stored in the buffer-local variable %s",
- type_name, XSYMBOL (sym)->name->data);
+ type_name, SDATA (SYMBOL_NAME (sym)));
}
\f
#include <fcntl.h>
#endif
+#include "coding.h"
+
/* Memory is allocated in regions which are mapped using mmap(2).
The current implementation lets the system select mapped
{
/* User-specified size. */
size_t nbytes_specified;
-
+
/* Number of bytes mapped */
size_t nbytes_mapped;
#define MEM_ALIGN sizeof (double)
-/* Predicate returning true if part of the address range [START ..
- END[ is currently mapped. Used to prevent overwriting an existing
+/* Predicate returning true if part of the address range [START .. END]
+ is currently mapped. Used to prevent overwriting an existing
memory mapping.
Default is to conservativly assume the address range is occupied by
{
struct mmap_region *r;
char *s = (char *) start, *e = (char *) end;
-
+
for (r = mmap_regions; r; r = r->next)
{
char *rstart = (char *) r;
r->prev->next = r->next;
else
mmap_regions = r->next;
-
+
if (munmap ((POINTER_TYPE *) r, r->nbytes_mapped) == -1)
{
fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
else if (npages > 0)
{
nbytes = npages * mmap_page_size;
-
+
/* Try to map additional pages at the end of the region. We
cannot do this if the address range is already occupied by
something else because mmap deletes any previous mapping.
if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
{
POINTER_TYPE *p;
-
+
p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
if (p == MAP_FAILED)
map = ROUND (nbytes + MMAP_REGION_STRUCT_SIZE, mmap_page_size);
p = mmap (NULL, map, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE,
mmap_fd, 0);
-
+
if (p == MAP_FAILED)
{
if (errno != ENOMEM)
else
{
struct mmap_region *r = (struct mmap_region *) p;
-
+
r->nbytes_specified = nbytes;
r->nbytes_mapped = map;
r->var = var;
if (r->next)
r->next->prev = r;
mmap_regions = r;
-
+
p = MMAP_USER_AREA (p);
}
-
+
return *var = p;
}
size_t nbytes;
{
POINTER_TYPE *result;
-
+
mmap_init ();
if (*var == NULL)
result = mmap_alloc (var, nbytes);
- else if (nbytes == 0)
+ else if (nbytes == 0)
{
mmap_free (var);
result = mmap_alloc (var, nbytes);
{
struct mmap_region *r = MMAP_REGION (*var);
size_t room = r->nbytes_mapped - MMAP_REGION_STRUCT_SIZE;
-
+
if (room < nbytes)
{
/* Must enlarge. */
else if (room - nbytes >= mmap_page_size)
{
/* Shrinking by at least a page. Let's give some
- memory back to the system. */
- mmap_enlarge (r, - (room - nbytes) / mmap_page_size);
+ memory back to the system.
+
+ The extra parens are to make the division happens first,
+ on positive values, so we know it will round towards
+ zero. */
+ mmap_enlarge (r, - ((room - nbytes) / mmap_page_size));
result = *var;
r->nbytes_specified = nbytes;
}
POINTER_TYPE **var;
{
mmap_init ();
-
+
if (*var)
{
mmap_free_1 (MMAP_REGION (*var));
if (mmap_initialized_p)
return;
mmap_initialized_p = 1;
-
+
#if MAP_ANON != 0
mmap_fd = -1;
#endif
-
+
mmap_page_size = getpagesize ();
}
size_t nbytes;
{
POINTER_TYPE *p;
-
+
BLOCK_INPUT;
#if defined USE_MMAP_FOR_BUFFERS
p = mmap_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
#else
p = xmalloc (nbytes);
#endif
-
+
if (p == NULL)
{
UNBLOCK_INPUT;
#else
p = xrealloc (b->text->beg, nbytes);
#endif
-
+
if (p == NULL)
{
UNBLOCK_INPUT;
#else
xfree (b->text->beg);
#endif
-
+
BUF_BEG_ADDR (b) = NULL;
UNBLOCK_INPUT;
}
buffer_defaults.undo_list = Qnil;
buffer_defaults.mark_active = Qnil;
buffer_defaults.file_format = Qnil;
- buffer_defaults.overlays_before = Qnil;
- buffer_defaults.overlays_after = Qnil;
- XSETFASTINT (buffer_defaults.overlay_center, BEG);
+ buffer_defaults.overlays_before = NULL;
+ buffer_defaults.overlays_after = NULL;
+ buffer_defaults.overlay_center = BEG;
XSETFASTINT (buffer_defaults.tab_width, 8);
buffer_defaults.truncate_lines = Qnil;
buffer_defaults.cache_long_line_scans = Qnil;
buffer_defaults.file_truename = Qnil;
XSETFASTINT (buffer_defaults.display_count, 0);
+ XSETFASTINT (buffer_defaults.left_margin_cols, 0);
+ XSETFASTINT (buffer_defaults.right_margin_cols, 0);
+ buffer_defaults.left_fringe_width = Qnil;
+ buffer_defaults.right_fringe_width = Qnil;
+ buffer_defaults.fringes_outside_margins = Qnil;
+ buffer_defaults.scroll_bar_width = Qnil;
+ buffer_defaults.vertical_scroll_bar_type = Qt;
buffer_defaults.indicate_empty_lines = Qnil;
buffer_defaults.scroll_up_aggressively = Qnil;
buffer_defaults.scroll_down_aggressively = Qnil;
XSETFASTINT (buffer_local_flags.cache_long_line_scans, idx); ++idx;
XSETFASTINT (buffer_local_flags.category_table, idx); ++idx;
XSETFASTINT (buffer_local_flags.direction_reversed, idx); ++idx;
- XSETFASTINT (buffer_local_flags.buffer_file_coding_system, idx);
+ XSETFASTINT (buffer_local_flags.buffer_file_coding_system, idx);
/* Make this one a permanent local. */
buffer_permanent_local_flags[idx++] = 1;
- XSETFASTINT (buffer_local_flags.left_margin_width, idx); ++idx;
- XSETFASTINT (buffer_local_flags.right_margin_width, idx); ++idx;
+ XSETFASTINT (buffer_local_flags.left_margin_cols, idx); ++idx;
+ XSETFASTINT (buffer_local_flags.right_margin_cols, idx); ++idx;
+ XSETFASTINT (buffer_local_flags.left_fringe_width, idx); ++idx;
+ XSETFASTINT (buffer_local_flags.right_fringe_width, idx); ++idx;
+ XSETFASTINT (buffer_local_flags.fringes_outside_margins, idx); ++idx;
+ XSETFASTINT (buffer_local_flags.scroll_bar_width, idx); ++idx;
+ XSETFASTINT (buffer_local_flags.vertical_scroll_bar_type, idx); ++idx;
XSETFASTINT (buffer_local_flags.indicate_empty_lines, idx); ++idx;
XSETFASTINT (buffer_local_flags.scroll_up_aggressively, idx); ++idx;
XSETFASTINT (buffer_local_flags.scroll_down_aggressively, idx); ++idx;
if (idx >= MAX_PER_BUFFER_VARS)
abort ();
last_per_buffer_idx = idx;
-
+
Vbuffer_alist = Qnil;
current_buffer = 0;
all_buffers = 0;
Qpermanent_local = intern ("permanent-local");
Qkill_buffer_hook = intern ("kill-buffer-hook");
+ Fput (Qkill_buffer_hook, Qpermanent_local, Qt);
+
+ Qucs_set_table_for_input = intern ("ucs-set-table-for-input");
Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
text pointers will have been set to null in the dumped Emacs.
Map new memory. */
struct buffer *b;
-
+
for (b = all_buffers; b; b = b->next)
if (b->text->beg == NULL)
enlarge_buffer_text (b, 0);
}
#endif /* USE_MMAP_FOR_BUFFERS */
-
+
Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
if (NILP (buffer_defaults.enable_multibyte_characters))
- Fset_buffer_multibyte (Qnil, Qnil);
+ Fset_buffer_multibyte (Qnil);
/* If PWD is accurate, use it instead of calling getwd. PWD is
sometimes a nicer name, and using it may avoid a fatal error if a
because of the ange-ftp completion handler.
However, it is not necessary to turn / into /:/.
So avoid doing that. */
- && strcmp ("/", XSTRING (current_buffer->directory)->data))
+ && strcmp ("/", SDATA (current_buffer->directory)))
current_buffer->directory
= concat2 (build_string ("/:"), current_buffer->directory);
staticpro (&Qbefore_change_functions);
Qafter_change_functions = intern ("after-change-functions");
staticpro (&Qafter_change_functions);
+ staticpro (&Qucs_set_table_for_input);
- Qas = intern ("as");
- staticpro (&Qas);
- Qmake = intern ("make");
- staticpro (&Qmake);
- Qto = intern ("to");
- staticpro (&Qto);
+ Qkill_buffer_query_functions = intern ("kill-buffer-query-functions");
+ staticpro (&Qkill_buffer_query_functions);
Fput (Qprotected_field, Qerror_conditions,
Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
DEFVAR_LISP_NOPRO ("default-direction-reversed",
&buffer_defaults.direction_reversed,
- doc: /* Default value of `direction_reversed' for buffers that do not override it.
+ doc: /* Default value of `direction-reversed' for buffers that do not override it.
This is the same as (default-value 'direction-reversed). */);
-
+
DEFVAR_LISP_NOPRO ("default-enable-multibyte-characters",
&buffer_defaults.enable_multibyte_characters,
doc: /* *Default value of `enable-multibyte-characters' for buffers not overriding it.
This is the same as (default-value 'enable-multibyte-characters). */);
-
+
DEFVAR_LISP_NOPRO ("default-buffer-file-coding-system",
&buffer_defaults.buffer_file_coding_system,
doc: /* Default value of `buffer-file-coding-system' for buffers not overriding it.
This is the same as (default-value 'buffer-file-coding-system). */);
-
+
DEFVAR_LISP_NOPRO ("default-truncate-lines",
&buffer_defaults.truncate_lines,
doc: /* Default value of `truncate-lines' for buffers that do not override it.
This is the same as (default-value 'case-fold-search). */);
#ifdef DOS_NT
- DEFVAR_LISP_NOPRO ("default-buffer-file-type",
+ DEFVAR_LISP_NOPRO ("default-buffer-file-type",
&buffer_defaults.buffer_file_type,
doc: /* Default file type for buffers that do not override it.
This is the same as (default-value 'buffer-file-type).
#endif
DEFVAR_LISP_NOPRO ("default-left-margin-width",
- &buffer_defaults.left_margin_width,
+ &buffer_defaults.left_margin_cols,
doc: /* Default value of `left-margin-width' for buffers that don't override it.
This is the same as (default-value 'left-margin-width). */);
DEFVAR_LISP_NOPRO ("default-right-margin-width",
- &buffer_defaults.right_margin_width,
- doc: /* Default value of `right_margin_width' for buffers that don't override it.
+ &buffer_defaults.right_margin_cols,
+ doc: /* Default value of `right-margin-width' for buffers that don't override it.
This is the same as (default-value 'right-margin-width). */);
-
+
+ DEFVAR_LISP_NOPRO ("default-left-fringe-width",
+ &buffer_defaults.left_fringe_width,
+ doc: /* Default value of `left-fringe-width' for buffers that don't override it.
+This is the same as (default-value 'left-fringe-width). */);
+
+ DEFVAR_LISP_NOPRO ("default-right-fringe-width",
+ &buffer_defaults.right_fringe_width,
+ doc: /* Default value of `right-fringe-width' for buffers that don't override it.
+This is the same as (default-value 'right-fringe-width). */);
+
+ DEFVAR_LISP_NOPRO ("default-fringes-outside-margins",
+ &buffer_defaults.fringes_outside_margins,
+ doc: /* Default value of `fringes-outside-margins' for buffers that don't override it.
+This is the same as (default-value 'fringes-outside-margins). */);
+
+ DEFVAR_LISP_NOPRO ("default-scroll-bar-width",
+ &buffer_defaults.scroll_bar_width,
+ doc: /* Default value of `scroll-bar-width' for buffers that don't override it.
+This is the same as (default-value 'scroll-bar-width). */);
+
+ DEFVAR_LISP_NOPRO ("default-vertical-scroll-bar",
+ &buffer_defaults.vertical_scroll_bar_type,
+ doc: /* Default value of `vertical-scroll-bar' for buffers that don't override it.
+This is the same as (default-value 'vertical-scroll-bar). */);
+
DEFVAR_LISP_NOPRO ("default-indicate-empty-lines",
&buffer_defaults.indicate_empty_lines,
doc: /* Default value of `indicate-empty-lines' for buffers that don't override it.
This is the same as (default-value 'indicate-empty-lines). */);
-
+
DEFVAR_LISP_NOPRO ("default-scroll-up-aggressively",
&buffer_defaults.scroll_up_aggressively,
doc: /* Default value of `scroll-up-aggressively'.
This value applies in buffers that don't have their own local values.
This variable is an alias for (default-value 'scroll-up-aggressively). */);
-
+
DEFVAR_LISP_NOPRO ("default-scroll-down-aggressively",
&buffer_defaults.scroll_down_aggressively,
doc: /* Default value of `scroll-down-aggressively'.
This value applies in buffers that don't have their own local values.
This variable is an alias for (default-value 'scroll-down-aggressively). */);
-
+
DEFVAR_PER_BUFFER ("header-line-format",
¤t_buffer->header_line_format,
Qnil,
doc: /* Analogous to `mode-line-format', but controls the header line.
The header line appears, optionally, at the top of a window;
the mode line appears at the bottom. */);
-
+
DEFVAR_PER_BUFFER ("mode-line-format", ¤t_buffer->mode_line_format,
Qnil,
doc: /* Template for displaying mode line for current buffer.
For a symbol, its value is used (but it is ignored if t or nil).
A string appearing directly as the value of a symbol is processed verbatim
in that the %-constructs below are not recognized.
+ Note that unless the symbol is marked as a `risky-local-variable', all
+ properties in any strings, as well as all :eval and :propertize forms
+ in the value of that symbol will be ignored.
For a list of the form `(:eval FORM)', FORM is evaluated and the result
- is used as a mode line element.
+ is used as a mode line element. Be careful--FORM should not load any files,
+ because that can cause an infinite recursion.
+For a list of the form `(:propertize ELT PROPS...)', ELT is displayed
+ with the specified properties PROPS applied.
For a list whose car is a symbol, the symbol's value is taken,
and if that is non-nil, the cadr of the list is processed recursively.
Otherwise, the caddr of the list (if there is one) is processed.
DEFVAR_PER_BUFFER ("fill-column", ¤t_buffer->fill_column,
make_number (Lisp_Int),
- doc: /* *Column beyond which automatic line-wrapping should happen. */);
+ doc: /* *Column beyond which automatic line-wrapping should happen.
+Interactively, you can set this using \\[set-fill-column]. */);
DEFVAR_PER_BUFFER ("left-margin", ¤t_buffer->left_margin,
make_number (Lisp_Int),
DEFVAR_PER_BUFFER ("enable-multibyte-characters",
¤t_buffer->enable_multibyte_characters,
- make_number (-1),
+ Qnil,
doc: /* Non-nil means the buffer contents are regarded as multi-byte characters.
Otherwise they are regarded as unibyte. This affects the display,
file I/O and the behavior of various editing commands.
Changing its default value with `setq-default' is supported.
See also variable `default-enable-multibyte-characters' and Info node
`(elisp)Text Representations'. */);
+ XSYMBOL (intern ("enable-multibyte-characters"))->constant = 1;
DEFVAR_PER_BUFFER ("buffer-file-coding-system",
¤t_buffer->buffer_file_coding_system, Qnil,
See also the functions `display-table-slot' and `set-display-table-slot'. */);
- DEFVAR_PER_BUFFER ("left-margin-width", ¤t_buffer->left_margin_width,
+ DEFVAR_PER_BUFFER ("left-margin-width", ¤t_buffer->left_margin_cols,
Qnil,
doc: /* *Width of left marginal area for display of a buffer.
A value of nil means no marginal area. */);
-
- DEFVAR_PER_BUFFER ("right-margin-width", ¤t_buffer->right_margin_width,
+
+ DEFVAR_PER_BUFFER ("right-margin-width", ¤t_buffer->right_margin_cols,
Qnil,
doc: /* *Width of right marginal area for display of a buffer.
A value of nil means no marginal area. */);
-
+
+ DEFVAR_PER_BUFFER ("left-fringe-width", ¤t_buffer->left_fringe_width,
+ Qnil,
+ doc: /* *Width of this buffer's left fringe (in pixels).
+A value of 0 means no left fringe is shown in this buffer's window.
+A value of nil means to use the left fringe width from the window's frame. */);
+
+ DEFVAR_PER_BUFFER ("right-fringe-width", ¤t_buffer->right_fringe_width,
+ Qnil,
+ doc: /* *Width of this buffer's right fringe (in pixels).
+A value of 0 means no right fringe is shown in this buffer's window.
+A value of nil means to use the right fringe width from the window's frame. */);
+
+ DEFVAR_PER_BUFFER ("fringes-outside-margins", ¤t_buffer->fringes_outside_margins,
+ Qnil,
+ doc: /* *Non-nil means to display fringes outside display margins.
+A value of nil means to display fringes between margins and buffer text. */);
+
+ DEFVAR_PER_BUFFER ("scroll-bar-width", ¤t_buffer->scroll_bar_width,
+ Qnil,
+ doc: /* *Width of this buffer's scroll bars in pixels.
+A value of nil means to use the scroll bar width from the window's frame. */);
+
+ DEFVAR_PER_BUFFER ("vertical-scroll-bar", ¤t_buffer->vertical_scroll_bar_type,
+ Qnil,
+ doc: /* *Position of this buffer's vertical scroll bar.
+A value of left or right means to place the vertical scroll bar at that side
+of the window; a value of nil means that this window has no vertical scroll bar.
+A value of t means to use the vertical scroll bar type from the window's frame. */);
+
DEFVAR_PER_BUFFER ("indicate-empty-lines",
¤t_buffer->indicate_empty_lines, Qnil,
doc: /* *Visually indicate empty lines after the buffer end.
If non-nil, a bitmap is displayed in the left fringe of a window on
window-systems. */);
-
+
DEFVAR_PER_BUFFER ("scroll-up-aggressively",
¤t_buffer->scroll_up_aggressively, Qnil,
- doc: /* *If a number, scroll display up aggressively.
-If scrolling a window because point is below the window end, choose
-a new window start so that point ends up that fraction of the window's
-height from the bottom of the window. */);
-
+ doc: /* How far to scroll windows upward.
+If you move point off the bottom, the window scrolls automatically.
+This variable controls how far it scrolls. nil, the default,
+means scroll to center point. A fraction means scroll to put point
+that fraction of the window's height from the bottom of the window.
+When the value is 0.0, point goes at the bottom line, which in the simple
+case that you moved off with C-f means scrolling just one line. 1.0 means
+point goes at the top, so that in that simple case, the window
+window scrolls by a full window height. Meaningful values are
+between 0.0 and 1.0, inclusive. */);
+
DEFVAR_PER_BUFFER ("scroll-down-aggressively",
¤t_buffer->scroll_down_aggressively, Qnil,
- doc: /* *If a number, scroll display down aggressively.
-If scrolling a window because point is above the window start, choose
-a new window start so that point ends up that fraction of the window's
-height from the top of the window. */);
-
+ doc: /* How far to scroll windows downward.
+If you move point off the top, the window scrolls automatically.
+This variable controls how far it scrolls. nil, the default,
+means scroll to center point. A fraction means scroll to put point
+that fraction of the window's height from the top of the window.
+When the value is 0.0, point goes at the top line, which in the simple
+case that you moved off with C-b means scrolling just one line. 1.0 means
+point goes at the bottom, so that in that simple case, the window
+window scrolls by a full window height. Meaningful values are
+between 0.0 and 1.0, inclusive. */);
+
/*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
"Don't ask.");
*/
DEFVAR_PER_BUFFER ("buffer-file-format", ¤t_buffer->file_format, Qnil,
doc: /* List of formats to use when saving this buffer.
Formats are defined by `format-alist'. This variable is
-set when a file is visited. Automatically local in all buffers. */);
+set when a file is visited. */);
DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
¤t_buffer->invisibility_spec, Qnil,
Vinhibit_read_only = Qnil;
DEFVAR_PER_BUFFER ("cursor-type", ¤t_buffer->cursor_type, Qnil,
- doc: /* Cursor to use in window displaying this buffer.
+ doc: /* Cursor to use when this buffer is in the selected window.
Values are interpreted as follows:
- t use the cursor specified for the frame
- nil don't display a cursor
- `bar' display a bar cursor with default width
- (bar . WIDTH) display a bar cursor with width WIDTH
- others display a box cursor. */);
+ t use the cursor specified for the frame
+ nil don't display a cursor
+ bar display a bar cursor with default width
+ (bar . WIDTH) display a bar cursor with width WIDTH
+ ANYTHING ELSE display a box cursor.
+
+When the buffer is displayed in a nonselected window,
+this variable has no effect; the cursor appears as a hollow box. */);
DEFVAR_PER_BUFFER ("line-spacing",
¤t_buffer->extra_line_spacing, Qnil,
/* Header file for the buffer manipulation primitives.
- Copyright (C) 1985, 86, 93, 94, 95, 97, 1998, 1999, 2000, 2001
+ Copyright (C) 1985, 86, 93, 94, 95, 97, 1998, 1999, 2000, 01, 2003
Free Software Foundation, Inc.
This file is part of GNU Emacs.
/* These macros come in pairs, one for the char position
and one for the byte position. */
-/* Position of beginning of buffer. */
+/* Position of beginning of buffer. */
#define BEG (1)
-#define BEG_BYTE (1)
+#define BEG_BYTE (BEG)
-/* Position of beginning of accessible range of buffer. */
+/* Position of beginning of accessible range of buffer. */
#define BEGV (current_buffer->begv)
#define BEGV_BYTE (current_buffer->begv_byte)
/* Position of point in buffer. The "+ 0" makes this
- not an l-value, so you can't assign to it. Use SET_PT instead. */
+ not an l-value, so you can't assign to it. Use SET_PT instead. */
#define PT (current_buffer->pt + 0)
#define PT_BYTE (current_buffer->pt_byte + 0)
-/* Position of gap in buffer. */
+/* Position of gap in buffer. */
#define GPT (current_buffer->text->gpt)
#define GPT_BYTE (current_buffer->text->gpt_byte)
-/* Position of end of accessible range of buffer. */
+/* Position of end of accessible range of buffer. */
#define ZV (current_buffer->zv)
#define ZV_BYTE (current_buffer->zv_byte)
-/* Position of end of buffer. */
+/* Position of end of buffer. */
#define Z (current_buffer->text->z)
#define Z_BYTE (current_buffer->text->z_byte)
/* Macros for the addresses of places in the buffer. */
-/* Address of beginning of buffer. */
+/* Address of beginning of buffer. */
#define BEG_ADDR (current_buffer->text->beg)
-/* Address of beginning of accessible range of buffer. */
+/* Address of beginning of accessible range of buffer. */
#define BEGV_ADDR (BYTE_POS_ADDR (current_buffer->begv_byte))
-/* Address of point in buffer. */
+/* Address of point in buffer. */
#define PT_ADDR (BYTE_POS_ADDR (current_buffer->pt_byte))
-/* Address of beginning of gap in buffer. */
-#define GPT_ADDR (current_buffer->text->beg + current_buffer->text->gpt_byte - 1)
+/* Address of beginning of gap in buffer. */
+#define GPT_ADDR (current_buffer->text->beg + current_buffer->text->gpt_byte - BEG_BYTE)
/* Address of end of gap in buffer. */
-#define GAP_END_ADDR (current_buffer->text->beg + current_buffer->text->gpt_byte + current_buffer->text->gap_size - 1)
+#define GAP_END_ADDR (current_buffer->text->beg + current_buffer->text->gpt_byte + current_buffer->text->gap_size - BEG_BYTE)
-/* Address of end of accessible range of buffer. */
+/* Address of end of accessible range of buffer. */
#define ZV_ADDR (BYTE_POS_ADDR (current_buffer->zv_byte))
-/* Address of end of buffer. */
-#define Z_ADDR (current_buffer->text->beg + current_buffer->text->gap_size + current_buffer->text->z_byte - 1)
+/* Address of end of buffer. */
+#define Z_ADDR (current_buffer->text->beg + current_buffer->text->gap_size + current_buffer->text->z_byte - BEG_BYTE)
/* Size of gap. */
#define GAP_SIZE (current_buffer->text->gap_size)
/* Similar macros to operate on a specified buffer.
Note that many of these evaluate the buffer argument more than once. */
-/* Position of beginning of buffer. */
-#define BUF_BEG(buf) (1)
-#define BUF_BEG_BYTE(buf) (1)
+/* Position of beginning of buffer. */
+#define BUF_BEG(buf) (BEG)
+#define BUF_BEG_BYTE(buf) (BEG_BYTE)
-/* Position of beginning of accessible range of buffer. */
+/* Position of beginning of accessible range of buffer. */
#define BUF_BEGV(buf) ((buf)->begv)
#define BUF_BEGV_BYTE(buf) ((buf)->begv_byte)
-/* Position of point in buffer. */
+/* Position of point in buffer. */
#define BUF_PT(buf) ((buf)->pt)
#define BUF_PT_BYTE(buf) ((buf)->pt_byte)
-/* Position of gap in buffer. */
+/* Position of gap in buffer. */
#define BUF_GPT(buf) ((buf)->text->gpt)
#define BUF_GPT_BYTE(buf) ((buf)->text->gpt_byte)
-/* Position of end of accessible range of buffer. */
+/* Position of end of accessible range of buffer. */
#define BUF_ZV(buf) ((buf)->zv)
#define BUF_ZV_BYTE(buf) ((buf)->zv_byte)
-/* Position of end of buffer. */
+/* Position of end of buffer. */
#define BUF_Z(buf) ((buf)->text->z)
#define BUF_Z_BYTE(buf) ((buf)->text->z_byte)
#define BUF_BEG_ADDR(buf) ((buf)->text->beg)
/* Address of beginning of gap of buffer. */
-#define BUF_GPT_ADDR(buf) ((buf)->text->beg + (buf)->text->gpt_byte - 1)
+#define BUF_GPT_ADDR(buf) ((buf)->text->beg + (buf)->text->gpt_byte - BEG_BYTE)
/* Address of end of buffer. */
-#define BUF_Z_ADDR(buf) ((buf)->text->beg + (buf)->text->gap_size + (buf)->text->z_byte - 1)
+#define BUF_Z_ADDR(buf) ((buf)->text->beg + (buf)->text->gap_size + (buf)->text->z_byte - BEG_BYTE)
/* Address of end of gap in buffer. */
-#define BUF_GAP_END_ADDR(buf) ((buf)->text->beg + (buf)->text->gpt_byte + (buf)->text->gap_size - 1)
+#define BUF_GAP_END_ADDR(buf) ((buf)->text->beg + (buf)->text->gpt_byte + (buf)->text->gap_size - BEG_BYTE)
/* Size of gap. */
#define BUF_GAP_SIZE(buf) ((buf)->text->gap_size)
} \
} \
while (0)
-
+
\f
/* Macros to set PT in the current buffer, or another buffer. */
/* Return the address of byte position N in current buffer. */
#define BYTE_POS_ADDR(n) \
- (((n) >= GPT_BYTE ? GAP_SIZE : 0) + (n) + BEG_ADDR - 1)
+ (((n) >= GPT_BYTE ? GAP_SIZE : 0) + (n) + BEG_ADDR - BEG_BYTE)
/* Return the address of char position N. */
#define CHAR_POS_ADDR(n) \
(((n) >= GPT ? GAP_SIZE : 0) \
+ buf_charpos_to_bytepos (current_buffer, n) \
- + BEG_ADDR - 1)
+ + BEG_ADDR - BEG_BYTE)
/* Convert a character position to a byte position. */
#define PTR_BYTE_POS(ptr) \
((ptr) - (current_buffer)->text->beg \
- - (ptr - (current_buffer)->text->beg < (unsigned) GPT_BYTE ? 0 : GAP_SIZE) \
- + 1)
+ - (ptr - (current_buffer)->text->beg <= (unsigned) (GPT_BYTE - BEG_BYTE) ? 0 : GAP_SIZE) \
+ + BEG_BYTE)
/* Return character at position POS. */
/* 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 - 1), \
++ + (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,
in a specified buffer. */
-/* Return the address of character at byte position POS in buffer BUF.
+/* Return the address of character at byte position POS in buffer BUF.
Note that both arguments can be computed more than once. */
#define BUF_BYTE_ADDRESS(buf, pos) \
-((buf)->text->beg + (pos) - 1 \
+((buf)->text->beg + (pos) - BEG_BYTE \
+ ((pos) >= (buf)->text->gpt_byte ? (buf)->text->gap_size : 0))
-/* Return the address of character at char position POS in buffer BUF.
+/* Return the address of character at char position POS in buffer BUF.
Note that both arguments can be computed more than once. */
#define BUF_CHAR_ADDRESS(buf, pos) \
-((buf)->text->beg + buf_charpos_to_bytepos ((buf), (pos)) - 1 \
+((buf)->text->beg + buf_charpos_to_bytepos ((buf), (pos)) - BEG_BYTE \
+ ((pos) >= (buf)->text->gpt ? (buf)->text->gap_size : 0))
/* Convert PTR, the address of a char in buffer BUF,
#define BUF_PTR_BYTE_POS(buf, ptr) \
((ptr) - (buf)->text->beg \
- - (ptr - (buf)->text->beg < (unsigned) BUF_GPT_BYTE ((buf)) \
+ - (ptr - (buf)->text->beg <= (unsigned) (BUF_GPT_BYTE ((buf)) - BEG_BYTE)\
? 0 : BUF_GAP_SIZE ((buf))) \
- + 1)
+ + BEG_BYTE)
/* Return the character at byte position POS in buffer BUF. */
#define BUF_FETCH_MULTIBYTE_CHAR(buf, pos) \
(_fetch_multibyte_char_p \
= (((pos) >= BUF_GPT_BYTE (buf) ? BUF_GAP_SIZE (buf) : 0) \
- + (pos) + BUF_BEG_ADDR (buf) - 1), \
+ + (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. */
e.g. happen when malloc is called. So, don't pass a pointer
into a buffer's text to functions that malloc. */
unsigned char *beg;
-
- int gpt; /* Char pos of gap in buffer. */
- int z; /* Char pos of end of buffer. */
- int gpt_byte; /* Byte pos of gap in buffer. */
- int z_byte; /* Byte pos of end of buffer. */
- int gap_size; /* Size of buffer's gap. */
+
+ EMACS_INT gpt; /* Char pos of gap in buffer. */
+ EMACS_INT z; /* Char pos of end of buffer. */
+ EMACS_INT gpt_byte; /* Byte pos of gap in buffer. */
+ EMACS_INT z_byte; /* Byte pos of end of buffer. */
+ EMACS_INT gap_size; /* Size of buffer's gap. */
int modiff; /* This counts buffer-modification events
for this buffer. It is incremented for
each such event, and never otherwise
int overlay_modiff; /* Counts modifications to overlays. */
/* Minimum value of GPT - BEG since last redisplay that finished. */
- int beg_unchanged;
+ EMACS_INT beg_unchanged;
/* Minimum value of Z - GPT since last redisplay that finished. */
- int end_unchanged;
+ EMACS_INT end_unchanged;
/* MODIFF as of last redisplay that finished; if it matches MODIFF,
beg_unchanged and end_unchanged contain no useful information. */
This is actually a single marker ---
successive elements in its marker `chain'
are the other markers referring to this buffer. */
- Lisp_Object markers;
+ struct Lisp_Marker *markers;
};
/* This is the structure that the buffer Lisp object points to. */
struct buffer_text *text;
/* Char position of point in buffer. */
- int pt;
+ EMACS_INT pt;
/* Byte position of point in buffer. */
- int pt_byte;
+ EMACS_INT pt_byte;
/* Char position of beginning of accessible range. */
- int begv;
+ EMACS_INT begv;
/* Byte position of beginning of accessible range. */
- int begv_byte;
+ EMACS_INT begv_byte;
/* Char position of end of accessible range. */
- int zv;
+ EMACS_INT zv;
/* Byte position of end of accessible range. */
- int zv_byte;
+ EMACS_INT zv_byte;
/* In an indirect buffer, this points to the base buffer.
In an ordinary buffer, it is 0. */
this means the variable is always local in all buffers. */
#define MAX_PER_BUFFER_VARS 50
char local_flags[MAX_PER_BUFFER_VARS];
-
+
/* Set to the modtime of the visited file when read or written.
-1 means visited file was nonexistent.
0 means visited file modtime unknown; in no case complain
int auto_save_failure_time;
/* Position in buffer at which display started
the last time this buffer was displayed. */
- int last_window_start;
+ EMACS_INT last_window_start;
/* Set nonzero whenever the narrowing is changed in this buffer. */
int clip_changed;
displaying this buffer. */
unsigned prevent_redisplay_optimizations_p : 1;
- /* Changes in the buffer are recorded here for undo.
- t means don't record anything.
- This information belongs to the base buffer of an indirect buffer,
- But we can't store it in the struct buffer_text
- because local variables have to be right in the struct buffer.
- So we copy it around in set_buffer_internal.
- This comes before `name' because it is marked in a special way. */
- Lisp_Object undo_list;
+ /* List of overlays that end at or before the current center,
+ in order of end-position. */
+ struct Lisp_Overlay *overlays_before;
+
+ /* List of overlays that end after the current center,
+ in order of start-position. */
+ struct Lisp_Overlay *overlays_after;
+
+ /* Position where the overlay lists are centered. */
+ EMACS_INT overlay_center;
/* Everything from here down must be a Lisp_Object. */
Lisp_Object mode_name;
/* Mode line element that controls format of mode line. */
Lisp_Object mode_line_format;
-
+
+ /* Changes in the buffer are recorded here for undo.
+ t means don't record anything.
+ This information belongs to the base buffer of an indirect buffer,
+ But we can't store it in the struct buffer_text
+ because local variables have to be right in the struct buffer.
+ So we copy it around in set_buffer_internal.
+ This comes before `name' because it is marked in a special way. */
+ Lisp_Object undo_list;
+
/* Analogous to mode_line_format for the line displayed at the top
of windows. Nil means don't display that line. */
Lisp_Object header_line_format;
/* t means the mark and region are currently active. */
Lisp_Object mark_active;
- /* List of overlays that end at or before the current center,
- in order of end-position. */
- Lisp_Object overlays_before;
-
- /* List of overlays that end after the current center,
- in order of start-position. */
- Lisp_Object overlays_after;
-
- /* Position where the overlay lists are centered. */
- Lisp_Object overlay_center;
-
/* Non-nil means the buffer contents are regarded as multi-byte
form of characters, not a binary code. */
Lisp_Object enable_multibyte_characters;
/* Incremented each time the buffer is displayed in a window. */
Lisp_Object display_count;
-
+
/* Widths of left and right marginal areas for windows displaying
this buffer. */
- Lisp_Object left_margin_width, right_margin_width;
+ Lisp_Object left_margin_cols, right_margin_cols;
+
+ /* Widths of left and right fringe areas for windows displaying
+ this buffer. */
+ Lisp_Object left_fringe_width, right_fringe_width;
+
+ /* Non-nil means fringes are drawn outside display margins;
+ othersize draw them between margin areas and text. */
+ Lisp_Object fringes_outside_margins;
+
+ /* Width and type of scroll bar areas for windows displaying
+ this buffer. */
+ Lisp_Object scroll_bar_width, vertical_scroll_bar_type;
/* Non-nil means indicate lines not displaying text (in a style
like vi). */
that point ends up this number of lines from the top of the
window. Nil means that scrolling method isn't used. */
Lisp_Object scroll_up_aggressively;
-
+
/* If scrolling the display because point is above the top of a
window showing this buffer, try to choose a window start so
that point ends up this number of lines from the bottom of the
extern struct buffer buffer_local_types;
\f
+extern void delete_all_overlays P_ ((struct buffer *));
extern void reset_buffer P_ ((struct buffer *));
-extern void evaporate_overlays P_ ((int));
-extern int overlays_at P_ ((int, int, Lisp_Object **, int *, int *, int *, int));
+extern void evaporate_overlays P_ ((EMACS_INT));
+extern int overlays_at P_ ((EMACS_INT, int, Lisp_Object **, int *, int *, int *, int));
extern int sort_overlays P_ ((Lisp_Object *, int, struct window *));
-extern void recenter_overlay_lists P_ ((struct buffer *, int));
-extern int overlay_strings P_ ((int, struct window *, unsigned char **));
+extern void recenter_overlay_lists P_ ((struct buffer *, EMACS_INT));
+extern int overlay_strings P_ ((EMACS_INT, struct window *, unsigned char **));
extern void validate_region P_ ((Lisp_Object *, Lisp_Object *));
extern void set_buffer_internal P_ ((struct buffer *));
extern void set_buffer_internal_1 P_ ((struct buffer *));
extern void set_buffer_temp P_ ((struct buffer *));
extern void record_buffer P_ ((Lisp_Object));
extern void buffer_slot_type_mismatch P_ ((int));
-extern void fix_overlays_before P_ ((struct buffer *, int, int));
+extern void fix_overlays_before P_ ((struct buffer *, EMACS_INT, EMACS_INT));
extern void mmap_set_vars P_ ((int));
+ EXFUN (Fbuffer_live_p, 1);
EXFUN (Fbuffer_name, 1);
EXFUN (Fget_file_buffer, 1);
EXFUN (Fnext_overlay_change, 1);
/* Execution of byte code produced by bytecomp.el.
- Copyright (C) 1985, 1986, 1987, 1988, 1993, 2000, 2001
+ Copyright (C) 1985, 1986, 1987, 1988, 1993, 2000, 2001, 2002, 2003
Free Software Foundation, Inc.
This file is part of GNU Emacs.
hacked on by jwz@lucid.com 17-jun-91
o added a compile-time switch to turn on simple sanity checking;
o put back the obsolete byte-codes for error-detection;
- o added a new instruction, unbind_all, which I will use for
+ o added a new instruction, unbind_all, which I will use for
tail-recursion elimination;
o made temp_output_buffer_show be called with the right number
of args;
#include <config.h>
#include "lisp.h"
#include "buffer.h"
- #include "charset.h"
+ #include "character.h"
#include "syntax.h"
+#include "window.h"
#ifdef CHECK_FRAME_FONT
#include "frame.h"
#endif
/*
- * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for
+ * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for
* debugging the byte compiler...)
*
- * define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
+ * define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
*/
/* #define BYTE_CODE_SAFE */
/* #define BYTE_CODE_METER */
{
/* Program counter. This points into the byte_string below
and is relocated when that string is relocated. */
- unsigned char *pc;
+ const unsigned char *pc;
/* Top and bottom of stack. The bottom points to an area of memory
allocated with alloca in Fbyte_code. */
Storing this here protects it from GC because mark_byte_stack
marks it. */
Lisp_Object byte_string;
- unsigned char *byte_string_start;
+ const unsigned char *byte_string_start;
/* The vector of constants used during byte-code execution. Storing
this here protects it from GC because mark_byte_stack marks it. */
recorded value of `stack' here. */
if (!stack->top)
abort ();
-
+
for (obj = stack->bottom; obj <= stack->top; ++obj)
if (!XMARKBIT (*obj))
{
- mark_object (obj);
+ mark_object (*obj);
XMARK (*obj);
}
if (!XMARKBIT (stack->byte_string))
{
- mark_object (&stack->byte_string);
+ mark_object (stack->byte_string);
XMARK (stack->byte_string);
}
if (!XMARKBIT (stack->constants))
{
- mark_object (&stack->constants);
+ mark_object (stack->constants);
XMARK (stack->constants);
}
}
/* Unmark objects in the stacks on byte_stack_list. Relocate program
counters. Called when GC has completed. */
-void
+void
unmark_byte_stack ()
{
struct byte_stack *stack;
XUNMARK (stack->byte_string);
XUNMARK (stack->constants);
- if (stack->byte_string_start != XSTRING (stack->byte_string)->data)
+ if (stack->byte_string_start != SDATA (stack->byte_string))
{
int offset = stack->pc - stack->byte_string_start;
- stack->byte_string_start = XSTRING (stack->byte_string)->data;
+ stack->byte_string_start = SDATA (stack->byte_string);
stack->pc = stack->byte_string_start + offset;
}
}
(bytestr, vector, maxdepth)
Lisp_Object bytestr, vector, maxdepth;
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
#ifdef BYTE_CODE_METER
int this_op = 0;
int prev_op;
convert them back to the originally intended unibyte form. */
bytestr = Fstring_as_unibyte (bytestr);
- bytestr_length = STRING_BYTES (XSTRING (bytestr));
+ bytestr_length = SBYTES (bytestr);
vectorp = XVECTOR (vector)->contents;
stack.byte_string = bytestr;
- stack.pc = stack.byte_string_start = XSTRING (bytestr)->data;
+ stack.pc = stack.byte_string_start = SDATA (bytestr);
stack.constants = vector;
- stack.bottom = (Lisp_Object *) alloca (XFASTINT (maxdepth)
+ stack.bottom = (Lisp_Object *) alloca (XFASTINT (maxdepth)
* sizeof (Lisp_Object));
top = stack.bottom - 1;
stack.top = NULL;
#ifdef BYTE_CODE_SAFE
stacke = stack.bottom - 1 + XFASTINT (maxdepth);
#endif
-
+
while (1)
{
#ifdef BYTE_CODE_SAFE
op = FETCH2;
goto varref;
- case Bvarref:
- case Bvarref + 1:
- case Bvarref + 2:
+ case Bvarref:
+ case Bvarref + 1:
+ case Bvarref + 2:
case Bvarref + 3:
- case Bvarref + 4:
+ case Bvarref + 4:
case Bvarref + 5:
op = op - Bvarref;
goto varref;
varset:
{
Lisp_Object sym, val;
-
+
sym = vectorp[op];
val = TOP;
AFTER_POTENTIAL_GC ();
}
}
- POP;
+ (void) POP;
break;
case Bdup:
op -= Bunbind;
dounbind:
BEFORE_POTENTIAL_GC ();
- unbind_to (specpdl_ptr - specpdl - op, Qnil);
+ unbind_to (SPECPDL_INDEX () - op, Qnil);
AFTER_POTENTIAL_GC ();
break;
case Bunwind_protect:
/* The function record_unwind_protect can GC. */
BEFORE_POTENTIAL_GC ();
- record_unwind_protect (0, POP);
+ record_unwind_protect (Fprogn, POP);
AFTER_POTENTIAL_GC ();
- (specpdl_ptr - 1)->symbol = Qnil;
break;
case Bcondition_case:
case Btemp_output_buffer_setup:
BEFORE_POTENTIAL_GC ();
CHECK_STRING (TOP);
- temp_output_buffer_setup (XSTRING (TOP)->data);
+ temp_output_buffer_setup (SDATA (TOP));
AFTER_POTENTIAL_GC ();
TOP = Vstandard_output;
break;
temp_output_buffer_show (TOP);
TOP = v1;
/* pop binding of standard-output */
- unbind_to (specpdl_ptr - specpdl - 1, Qnil);
+ unbind_to (SPECPDL_INDEX () - 1, Qnil);
AFTER_POTENTIAL_GC ();
break;
}
TOP = v1;
}
else
- TOP = Fsub1 (v1);
+ {
+ BEFORE_POTENTIAL_GC ();
+ TOP = Fsub1 (v1);
+ AFTER_POTENTIAL_GC ();
+ }
break;
}
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
- XSETFASTINT (v1, current_column ());
+ XSETFASTINT (v1, (int) current_column ()); /* iftc */
AFTER_POTENTIAL_GC ();
PUSH (v1);
break;
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:
byte_stack_list = byte_stack_list->next;
/* Binds and unbinds are supposed to be compiled balanced. */
- if (specpdl_ptr - specpdl != count)
+ if (SPECPDL_INDEX () != count)
#ifdef BYTE_CODE_SAFE
error ("binding stack not balanced (serious byte compiler bug)");
#else
abort ();
#endif
-
+
return result;
}
\(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,
indicates how many times the byte opcodes CODE1 and CODE2 have been
executed in succession. */);
-
+
DEFVAR_BOOL ("byte-metering-on", &byte_metering_on,
doc: /* If non-nil, keep profiling information on byte code usage.
The variable byte-code-meter indicates how often each byte opcode is used.
#endif
#include <sys/file.h>
-#ifdef USG5
+#ifdef HAVE_FCNTL_H
#define INCLUDED_FCNTL
#include <fcntl.h>
#endif
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
- #include "charset.h"
+ #include "character.h"
#include "ccl.h"
#include "coding.h"
#include "composite.h"
Lisp_Object Vexec_path, Vexec_directory, Vexec_suffixes;
Lisp_Object Vdata_directory, Vdoc_directory;
-Lisp_Object Vconfigure_info_directory;
+Lisp_Object Vconfigure_info_directory, Vshared_game_score_directory;
Lisp_Object Vtemp_file_name_pattern;
Lisp_Object Vshell_file_name;
call_process_cleanup (fdpid)
Lisp_Object fdpid;
{
-#if defined (MSDOS) || defined (macintosh)
+#if defined (MSDOS) || defined (MAC_OS8)
/* for MSDOS fdpid is really (fd . tempfile) */
register Lisp_Object file;
file = Fcdr (fdpid);
emacs_close (XFASTINT (Fcar (fdpid)));
- if (strcmp (XSTRING (file)-> data, NULL_DEVICE) != 0)
- unlink (XSTRING (file)->data);
-#else /* not MSDOS and not macintosh */
+ if (strcmp (SDATA (file), NULL_DEVICE) != 0)
+ unlink (SDATA (file));
+#else /* not MSDOS and not MAC_OS8 */
register int pid = XFASTINT (Fcdr (fdpid));
if (call_process_exited)
if (EMACS_KILLPG (pid, SIGINT) == 0)
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
record_unwind_protect (call_process_kill, fdpid);
message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
immediate_quit = 1;
char buf[16384];
char *bufptr = buf;
int bufsize = 16384;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
- register unsigned char **new_argv
- = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
+ register const unsigned char **new_argv
+ = (const unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
struct buffer *old = current_buffer;
/* File to use for stderr in the child.
t means use same as standard output. */
char *outf, *tempfile;
int outfilefd;
#endif
-#ifdef macintosh
+#ifdef MAC_OS8
char *tempfile;
int outfilefd;
#endif
#ifndef subprocesses
/* Without asynchronous processes we cannot have BUFFER == 0. */
- if (nargs >= 3
+ if (nargs >= 3
&& (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
error ("Operating system cannot handle asynchronous subprocesses");
#endif /* subprocesses */
CHECK_BUFFER (buffer);
}
}
- else
+ else
buffer = Qnil;
/* Make sure that the child will be able to chdir to the current
display = nargs >= 4 ? args[3] : Qnil;
- filefd = emacs_open (XSTRING (infile)->data, O_RDONLY, 0);
+ filefd = emacs_open (SDATA (infile), O_RDONLY, 0);
if (filefd < 0)
{
report_file_error ("Opening process input file", Fcons (infile, Qnil));
struct gcpro gcpro1;
GCPRO1 (current_dir);
- openp (Vexec_path, args[0], Vexec_suffixes, &path, 1);
+ openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK));
UNGCPRO;
}
if (NILP (path))
emacs_close (filefd);
report_file_error ("Searching for program", Fcons (args[0], Qnil));
}
- new_argv[0] = XSTRING (path)->data;
+
+ /* If program file name starts with /: for quoting a magic name,
+ discard that. */
+ if (SBYTES (path) > 2 && SREF (path, 0) == '/'
+ && SREF (path, 1) == ':')
+ path = Fsubstring (path, make_number (2), Qnil);
+
+ new_argv[0] = SDATA (path);
if (nargs > 4)
{
register int i;
{
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] = XSTRING (args[i])->data;
+ new_argv[i - 3] = SDATA (args[i]);
}
UNGCPRO;
new_argv[nargs - 3] = 0;
*tempfile = '\0';
}
dostounix_filename (tempfile);
- if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
+ if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
strcat (tempfile, "/");
strcat (tempfile, "detmp.XXX");
mktemp (tempfile);
fd[1] = outfilefd;
#endif /* MSDOS */
-#ifdef macintosh
+#ifdef MAC_OS8
/* Since we don't have pipes on the Mac, create a temporary file to
hold the output of the subprocess. */
- tempfile = (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern)) + 1);
- bcopy (XSTRING (Vtemp_file_name_pattern)->data, tempfile,
- STRING_BYTES (XSTRING (Vtemp_file_name_pattern)) + 1);
+ tempfile = (char *) alloca (SBYTES (Vtemp_file_name_pattern) + 1);
+ bcopy (SDATA (Vtemp_file_name_pattern), tempfile,
+ SBYTES (Vtemp_file_name_pattern) + 1);
mktemp (tempfile);
}
fd[0] = filefd;
fd[1] = outfilefd;
-#endif /* macintosh */
+#endif /* MAC_OS8 */
if (INTEGERP (buffer))
fd[1] = emacs_open (NULL_DEVICE, O_WRONLY, 0), fd[0] = -1;
else
{
#ifndef MSDOS
-#ifndef macintosh
+#ifndef MAC_OS8
errno = 0;
if (pipe (fd) == -1)
{
else if (STRINGP (error_file))
{
#ifdef DOS_NT
- fd_error = emacs_open (XSTRING (error_file)->data,
+ fd_error = emacs_open (SDATA (error_file),
O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
S_IREAD | S_IWRITE);
#else /* not DOS_NT */
- fd_error = creat (XSTRING (error_file)->data, 0666);
+ fd_error = creat (SDATA (error_file), 0666);
#endif /* not DOS_NT */
}
current_dir = ENCODE_FILE (current_dir);
-#ifdef macintosh
+#ifdef MAC_OS8
{
/* Call run_mac_command in sysdep.c here directly instead of doing
a child_setup as for MSDOS and other platforms. Note that this
code does not handle passing the environment to the synchronous
Mac subprocess. */
char *infn, *outfn, *errfn, *currdn;
-
+
/* close these files so subprocess can write to them */
close (outfilefd);
if (fd_error != outfilefd)
close (fd_error);
fd1 = -1; /* No harm in closing that one! */
- infn = XSTRING (infile)->data;
+ infn = SDATA (infile);
outfn = tempfile;
if (NILP (error_file))
errfn = NULL_DEVICE;
else if (EQ (Qt, error_file))
errfn = outfn;
else
- errfn = XSTRING (error_file)->data;
- currdn = XSTRING (current_dir)->data;
+ errfn = SDATA (error_file);
+ currdn = SDATA (current_dir);
pid = run_mac_command (new_argv, currdn, infn, outfn, errfn);
/* Record that the synchronous process exited and note its
report_file_error ("Cannot re-open temporary file", Qnil);
}
}
-#else /* not macintosh */
+#else /* not MAC_OS8 */
#ifdef MSDOS /* MW, July 1993 */
/* Note that on MSDOS `child_setup' actually returns the child process
exit status, not its PID, so we assign it to `synch_process_retcode'
if (fd_error >= 0)
emacs_close (fd_error);
#endif /* not MSDOS */
-#endif /* not macintosh */
+#endif /* not MAC_OS8 */
environ = save_environ;
/* Enable sending signal if user quits below. */
call_process_exited = 0;
-#if defined(MSDOS) || defined(macintosh)
+#if defined(MSDOS) || defined(MAC_OS8)
/* MSDOS needs different cleanup information. */
record_unwind_protect (call_process_cleanup,
Fcons (make_number (fd[0]), build_string (tempfile)));
#else
record_unwind_protect (call_process_cleanup,
Fcons (make_number (fd[0]), make_number (pid)));
-#endif /* not MSDOS and not macintosh */
+#endif /* not MSDOS and not MAC_OS8 */
if (BUFFERP (buffer))
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 = !NILP (display) && INTERACTIVE;
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
/* Now NREAD is the total amount of data in the buffer. */
immediate_quit = 0;
-
+
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 (bufptr, 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, bufptr, nread);
- if (process_coding.composing != COMPOSITION_DISABLED)
- coding_allocate_composition_data (&process_coding, PT);
- }
- if (process_coding.cmp_data)
- process_coding.cmp_data->char_offset = PT;
-
- decode_coding (&process_coding, bufptr, decoding_buf,
- nread, size);
+ Lisp_Object buf;
+ XSETBUFFER (buf, current_buffer);
+ decode_coding_c_string (&process_coding, bufptr, nread,
+ buf);
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 give up
displaying on the fly. */
- xfree (decoding_buf);
+ 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;
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 (bufptr + process_coding.consumed, bufptr,
- 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, bufptr,
+ 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));
++ make_number (total_read));
}
/* Wait for it to terminate, unless it already has. */
Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
Remaining args are passed to PROGRAM at startup as command args.
-If BUFFER is nil, `call-process-region' returns immediately with value nil.
+If BUFFER is 0, `call-process-region' returns immediately with value nil.
Otherwise it waits for PROGRAM to terminate
and returns a numeric exit status or a signal description string.
If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
struct gcpro gcpro1;
Lisp_Object filename_string;
register Lisp_Object start, end;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
/* Qt denotes we have not yet called Ffind_operation_coding_system. */
Lisp_Object coding_systems;
Lisp_Object val, *args2;
strcat (tempfile, "detmp.XXX");
#endif
#else /* not DOS_NT */
- char *tempfile = (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern)) + 1);
- bcopy (XSTRING (Vtemp_file_name_pattern)->data, tempfile,
- STRING_BYTES (XSTRING (Vtemp_file_name_pattern)) + 1);
+ char *tempfile = (char *) alloca (SBYTES (Vtemp_file_name_pattern) + 1);
+ bcopy (SDATA (Vtemp_file_name_pattern), tempfile,
+ SBYTES (Vtemp_file_name_pattern) + 1);
#endif /* not DOS_NT */
coding_systems = Qt;
}
{
- int count1 = specpdl_ptr - specpdl;
+ int count1 = SPECPDL_INDEX ();
specbind (intern ("coding-system-for-write"), val);
Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil);
unbind_to (count1, Qnil);
}
- /* Note that Fcall_process takes care of binding
+ /* Note that Fcall_process takes care of binding
coding-system-for-read. */
record_unwind_protect (delete_temp_file, filename_string);
of environ around the vfork and the call to this function.
SET_PGRP is nonzero if we should put the subprocess into a separate
- process group.
+ process group.
CURRENT_DIR is an elisp string giving the path of the current
directory the subprocess should have. Since we can't really signal
#ifdef SET_EMACS_PRIORITY
{
- extern int emacs_priority;
+ extern EMACS_INT emacs_priority;
if (emacs_priority < 0)
nice (- emacs_priority);
register char *temp;
register int i;
- i = STRING_BYTES (XSTRING (current_dir));
+ i = SBYTES (current_dir);
#ifdef MSDOS
/* MSDOS must have all environment variables malloc'ed, because
low-level libc functions that launch subsidiary processes rely
#endif
temp = pwd_var + 4;
bcopy ("PWD=", pwd_var, 4);
- bcopy (XSTRING (current_dir)->data, temp, i);
+ bcopy (SDATA (current_dir), temp, i);
if (!IS_DIRECTORY_SEP (temp[i - 1])) temp[i++] = DIRECTORY_SEP;
temp[i] = 0;
tem = XCDR (tem))
{
char **ep = env;
- char *string = (char *) XSTRING (XCAR (tem))->data;
+ char *string = (char *) SDATA (XCAR (tem));
/* See if this string duplicates any string already in the env.
If so, don't put it in.
When an env var has multiple definitions,
}
#ifdef WINDOWSNT
prepare_standard_handles (in, out, err, handles);
- set_process_dir (XSTRING (current_dir)->data);
+ set_process_dir (SDATA (current_dir));
#else /* not WINDOWSNT */
/* Make sure that in, out, and err are not actually already in
descriptors zero, one, or two; this could happen if Emacs is
entry = XCAR (scan);
if (STRINGP (entry)
- && STRING_BYTES (XSTRING (entry)) > varlen
- && XSTRING (entry)->data[varlen] == '='
+ && SBYTES (entry) > varlen
+ && SREF (entry, varlen) == '='
#ifdef WINDOWSNT
/* NT environment variables are case insensitive. */
- && ! strnicmp (XSTRING (entry)->data, var, varlen)
+ && ! strnicmp (SDATA (entry), var, varlen)
#else /* not WINDOWSNT */
- && ! bcmp (XSTRING (entry)->data, var, varlen)
+ && ! bcmp (SDATA (entry), var, varlen)
#endif /* not WINDOWSNT */
)
{
- *value = (char *) XSTRING (entry)->data + (varlen + 1);
- *valuelen = STRING_BYTES (XSTRING (entry)) - (varlen + 1);
+ *value = (char *) SDATA (entry) + (varlen + 1);
+ *valuelen = SBYTES (entry) - (varlen + 1);
return 1;
}
}
int valuelen;
CHECK_STRING (var);
- if (getenv_internal (XSTRING (var)->data, STRING_BYTES (XSTRING (var)),
+ if (getenv_internal (SDATA (var), SBYTES (var),
&value, &valuelen))
return make_string (value, valuelen);
else
#endif /* not VMS */
\f
/* This is run before init_cmdargs. */
-
+
void
init_callproc_1 ()
{
char *doc_dir = egetenv ("EMACSDOC");
Vdata_directory
- = Ffile_name_as_directory (build_string (data_dir ? data_dir
+ = Ffile_name_as_directory (build_string (data_dir ? data_dir
: PATH_DATA));
Vdoc_directory
= Ffile_name_as_directory (build_string (doc_dir ? doc_dir
init_callproc ()
{
char *data_dir = egetenv ("EMACSDATA");
-
+
register char * sh;
Lisp_Object tempdir;
Vexec_path = Fcons (tem, Vexec_path);
Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
}
-
+
Vexec_directory = Ffile_name_as_directory (tem);
#endif /* not DOS_NT */
#endif
{
tempdir = Fdirectory_file_name (Vexec_directory);
- if (access (XSTRING (tempdir)->data, 0) < 0)
+ if (access (SDATA (tempdir), 0) < 0)
dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
Vexec_directory);
}
tempdir = Fdirectory_file_name (Vdata_directory);
- if (access (XSTRING (tempdir)->data, 0) < 0)
+ if (access (SDATA (tempdir), 0) < 0)
dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
Vdata_directory);
else
Vtemp_file_name_pattern = build_string ("/tmp/emacsXXXXXX");
#endif
+
+#ifdef DOS_NT
+ Vshared_game_score_directory = Qnil;
+#else
+ Vshared_game_score_directory = build_string (PATH_GAME);
+ if (NILP (Ffile_directory_p (Vshared_game_score_directory)))
+ Vshared_game_score_directory = Qnil;
+#endif
}
void
includes this. */);
Vconfigure_info_directory = build_string (PATH_INFO);
+ DEFVAR_LISP ("shared-game-score-directory", &Vshared_game_score_directory,
+ doc: /* Directory of score files for games which come with GNU Emacs.
+If this variable is nil, then Emacs is unable to use a shared directory. */);
+#ifdef DOS_NT
+ Vshared_game_score_directory = Qnil;
+#else
+ Vshared_game_score_directory = build_string (PATH_GAME);
+#endif
+
DEFVAR_LISP ("temp-file-name-pattern", &Vtemp_file_name_pattern,
doc: /* Pattern for making names for temporary files.
This is used by `call-process-region'. */);
If multiple entries define the same variable, the first one always
takes precedence.
The environment which Emacs inherits is placed in this variable
-when Emacs starts. */);
+when Emacs starts.
+Non-ASCII characters are encoded according to the initial value of
+`locale-coding-system', i.e. the elements must normally be decoded for use.
+See `setenv' and `getenv'. */);
#ifndef VMS
defsubr (&Scall_process);
#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);
- c = DOWNCASE (XFASTINT (obj) & ~flagbits);
- if (inword)
- XSETFASTINT (obj, c | flags);
- else if (c == (XFASTINT (obj) & ~flagbits))
+ c1 = XFASTINT (obj) & ~flagbits;
+ if (! multibyte)
+ MAKE_CHAR_MULTIBYTE (c1);
+ c = DOWNCASE (c1);
+ if (inword || c == c1)
{
- 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 size = XSTRING (obj)->size;
+ int i, i_byte, len;
++ int size = SCHARS (obj);
obj = Fcopy_sequence (obj);
- len = SBYTES (obj);
-
- /* Scan all single-byte characters from start of string. */
- for (i = 0; i < len;)
+ for (i = i_byte = 0; i < size; i++, i_byte += len)
{
- c = SREF (obj, i);
-
- if (multibyte && c >= 0x80)
- /* A multibyte character can't be handled in this
- simple loop. */
- break;
+ if (multibyte)
- c = STRING_CHAR_AND_LENGTH (XSTRING (obj)->data + i_byte,
- 0, len);
++ c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i_byte, 0, len);
+ else
+ {
- c = XSTRING (obj)->data[i_byte];
++ c = SREF (obj, i_byte);
+ len = 1;
+ MAKE_CHAR_MULTIBYTE (c);
+ }
- c1 = 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 this char won't fit in a single-byte string.
- fall out to the multibyte case. */
- if (multibyte ? ! ASCII_BYTE_P (c)
- : ! SINGLE_BYTE_CHAR_P (c))
- break;
-
- SSET (obj, i, c);
+ c = UPCASE1 (c1);
if ((int) flag >= (int) CASE_CAPITALIZE)
-- inword = SYNTAX (c) == Sword;
- i++;
- }
-
- /* If we didn't do the whole string as single-byte,
- scan the rest in a more complex way. */
- if (i < len)
- {
- /* The work is not yet finished because of a multibyte
- character just encountered. */
- int fromlen, j_byte = i;
- char *buf
- = (char *) alloca ((len - i) * MAX_MULTIBYTE_LENGTH + i);
-
- /* Copy data already handled. */
- bcopy (SDATA (obj), buf, i);
-
- /* From now on, I counts bytes. */
- while (i < len)
++ inword = (SYNTAX (c) == Sword);
+ if (c != c1)
{
- c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i,
- len - i, fromlen);
- if (inword && flag != CASE_CAPITALIZE_UP)
- c = DOWNCASE (c);
- else if (!UPPERCASEP (c)
- && (!inword || flag != CASE_CAPITALIZE_UP))
- c = UPCASE1 (c);
- i += fromlen;
- j_byte += CHAR_STRING (c, buf + j_byte);
- if ((int) flag >= (int) CASE_CAPITALIZE)
- inword = SYNTAX (c) == Sword;
+ if (! multibyte)
+ {
+ MAKE_CHAR_UNIBYTE (c);
- XSTRING (obj)->data[i_byte] = c;
++ SSET (obj, i_byte, c);
+ }
+ else if (ASCII_CHAR_P (c1) && ASCII_CHAR_P (c))
- XSTRING (obj)->data[i_byte] = c;
++ SSET (obj, i_byte, c);
+ else
+ {
+ Faset (obj, make_number (i), make_number (c));
+ i_byte += CHAR_BYTES (c) - len;
+ }
}
- obj = make_multibyte_string (buf, SCHARS (obj),
- j_byte);
}
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);
- 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 (i < end_byte)
- inword = SYNTAX (c) == Sword;
++ 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 if (len == CHAR_BYTES (c))
{
- int fromlen, tolen, j;
+ 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)
- {
- for (j = 0; j < tolen; ++j)
- FETCH_BYTE (i + j) = str[j];
- }
- else
- {
- error ("Can't casify letters that change length");
- #if 0 /* This is approximately what we'd like to be able to do here */
- if (tolen < fromlen)
- del_range_1 (i + tolen, i + fromlen, 0, 0);
- else if (tolen > fromlen)
- {
- TEMP_SET_PT (i + fromlen);
- insert_1 (str + fromlen, tolen - fromlen, 1, 0, 0);
- }
- #endif
- }
+ CHAR_STRING (c, str);
+ for (j = 0; j < len; ++j)
+ FETCH_BYTE (start_byte + j) = str[j];
+ }
+ else
+ {
+ TEMP_SET_PT_BOTH (start, start_byte);
+ del_range_2 (start, start_byte, start + 1, start_byte + len, 0);
+ insert_char (c);
+ len = CHAR_BYTES (c);
}
- 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);
}
#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;
while (tem = Fcase_table_p (obj), NILP (tem))
obj = wrong_type_argument (Qcase_table_p, obj);
return (obj);
-}
+}
DEFUN ("current-case-table", Fcurrent_case_table, Scurrent_case_table, 0, 0, 0,
doc: /* Return the case table of the current buffer. */)
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, 0, indices);
- map_char_table (shuffle, Qnil, 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, 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, 0, indices);
- map_char_table (shuffle, Qnil, 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;
}
+ /* This is so set_image_of_range_1 in regex.c can find the EQV table. */
+ XCHAR_TABLE (canon)->extras[2] = eqv;
+
if (standard)
Vascii_downcase_table = table;
else
\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];
- int from, to;
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 characters in RANGE to
- themselves. 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, range, elt)
- Lisp_Object table, range, elt;
+set_identity (table, c, elt)
+ Lisp_Object table, c, elt;
{
- int from, to;
-
if (NATNUMP (elt))
- Faset (table, c, c);
+ {
- if (CONSP (range))
++ int from, to;
++
++ if (CONSP (c))
+ {
- from = XINT (XCAR (range));
- to = XINT (XCDR (range));
++ from = XINT (XCAR (c));
++ to = XINT (XCDR (c));
+ }
+ else
- from = to = XINT (range);
-
++ 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
operated. */
static void
-shuffle (table, range, elt)
- Lisp_Object table, range, elt;
+shuffle (table, c, elt)
+ Lisp_Object table, c, elt;
{
- if (NATNUMP (elt) && !EQ (c, elt))
- int from, to;
-
+ if (NATNUMP (elt))
{
Lisp_Object tem = Faref (table, elt);
- Faset (table, elt, c);
- Faset (table, c, tem);
++ int from, to;
+
- if (CONSP (range))
++ if (CONSP (c))
+ {
- from = XINT (XCAR (range));
- to = XINT (XCDR (range));
++ from = XINT (XCAR (c));
++ to = XINT (XCDR (c));
+ }
+ else
- from = to = XINT (range);
++ 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++)
- CHAR_TABLE_SET (down, i,
- make_number ((i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : 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++)
- CHAR_TABLE_SET (up, i, make_number ((i >= 'A' && i <= 'Z')
- ? i + ('a' - 'A')
- : ((i >= 'a' && i <= 'z')
- ? i + ('A' - 'a')
- : 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) 1995, 1997 Electrotechnical Laboratory, JAPAN.
-- Licensed to the Free Software Foundation.
- Copyright (C) 2001, 2002
++ Licensed to the Free Software Foundation.
++ 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"
if (STRING_MULTIBYTE (categories))
error ("Multibyte string in make-category-set");
- len = XSTRING (categories)->size;
+ len = SCHARS (categories);
while (--len >= 0)
{
Lisp_Object category;
- XSETFASTINT (category, XSTRING (categories)->data[len]);
+ XSETFASTINT (category, SREF (categories, len));
CHECK_CATEGORY (category);
SET_CATEGORY_SET (val, category, Qt);
}
while (tem = Fcategory_table_p (table), NILP (tem))
table = wrong_type_argument (Qcategory_table_p, table);
return table;
-}
+}
DEFUN ("category-table", Fcategory_table, Scategory_table, 0, 0, 0,
doc: /* Return the current category table.
return Vstandard_category_table;
}
-copy_category_entry (table, range, val)
- Lisp_Object table, range, val;
+
+ static void
- if (CONSP (range))
- char_table_set_range (table, XINT (XCAR (range)), XINT (XCDR (range)),
- val);
++copy_category_entry (table, c, val)
++ Lisp_Object table, c, val;
+ {
+ val = Fcopy_sequence (val);
- char_table_set (table, XINT (range), 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, 0, NULL);
++ 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++)
++ 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. */)
(ch)
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)
+ if (INTEGERP (character))
{
- 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;
+ CHECK_CHARACTER (character);
+ start = end = XFASTINT (character);
}
-
- 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)
- {
- /* 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;
- }
-
- /* 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 (XCAR (character));
- CHECK_CHARACTER (XCDR (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;
}
\f
Fput (Qcategory_table, Qchar_table_extra_slots, make_number (2));
Vstandard_category_table = Fmake_char_table (Qcategory_table, Qnil);
- /* Set a category set which contains nothing to the default. */
+ /* Set a category set which contains nothing to the default. */
XCHAR_TABLE (Vstandard_category_table)->defalt = MAKE_CATEGORY_SET;
Fset_char_table_extra_slot (Vstandard_category_table, make_number (0),
Fmake_vector (make_number (95), Qnil));
/* Declarations having to do with Emacs category tables.
Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
Licensed to the Free Software Foundation.
- Copyright (C) 2001, 2002
++ 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) \
/* CCL (Code Conversion Language) interpreter.
Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
- Copyright (C) 2001 Free Software Foundation, Inc.
- Licensed to the Free Software Foundation.
- Copyright (C) 2001, 2002
++ Licensed to the Free Software Foundation.
+ Copyright (C) 2001, 2002 Free Software Foundation, Inc.
- Licensed to the Free Software Foundation.
++ 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;
/* Return a hash table of id number ID. */
#define GET_HASH_TABLE(id) \
(XHASH_TABLE (XCDR(XVECTOR(Vtranslation_hash_table_vector)->contents[(id)])))
-/* Copied from fns.c. */
-#define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1)
+ 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
extended_command (rrr,RRR,Rrr,ARGS)
*/
-/*
+/*
Here after, Extended CCL Instructions.
Bit length of extended command is 14.
Therefore, the instruction code range is 0..16384(0x3fff).
3:MAP-ID1
4:MAP-ID2
...
- */
+ */
/* Map the code in reg[rrr] by MAPs starting from the Nth (N =
reg[RRR]) map.
where
STARTPOINT is an offset to be used for indexing a map,
ENDPOINT is a maximum index number of a map,
- VAL and VALn is a number, nil, t, or lambda.
+ VAL and VALn is a number, nil, t, or lambda.
Valid index range of a map of type (a) is:
STARTPOINT <= index < STARTPOINT + map_size - 1
/* 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 { \
+ int i; \
if (!dst) \
CCL_INVALID_CMD; \
- else if (dst + len <= (dst_bytes ? dst_end : src)) \
+ else if (dst + len <= dst_end) \
for (i = 0; i < len; i++) \
*dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)])) \
>> ((2 - (i % 3)) * 8)) & 0xFF; \
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) \
- { \
- ic = ccl->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) \
+ /* 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) \
+ { \
+ 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)
-
-
++#define CCL_ENCODE_CHAR(c, charset_list, id, encoded) \
+ do { \
- if (charset == CHARSET_ASCII) \
- c = code & 0xFF; \
- else if (CHARSET_DEFINED_P (charset) \
- && (code & 0x7F) >= 32 \
- && (code < 256 || ((code >> 7) & 0x7F) >= 32)) \
- { \
- int c1 = code & 0x7F, c2 = 0; \
++ unsigned code; \
+ \
- if (code >= 256) \
- c2 = c1, c1 = (code >> 7) & 0x7F; \
- c = MAKE_CHAR (charset, c1, c2); \
++ 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; \
+ } \
- else \
- c = code & 0xFF; \
- } while (0)
-
++ } 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
-int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
+int ccl_backtrace_table[CCL_DEBUG_BACKTRACE_LEN];
int ccl_backtrace_idx;
#endif
int ic; /* Instruction Counter. */
};
-/* For the moment, we only support depth 256 of stack. */
+/* 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;
if (ic >= ccl->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;
}
}
CCL_INVALID_CMD;
}
-
+
ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
ccl_prog_stack_struct[stack_idx].ic = ic;
stack_idx++;
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 = ccl->eof_ic;
- 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:
op = XINT (ccl_prog[ic]); /* table */
ic++;
- {
+ {
struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
op = hash_lookup (h, make_number (reg[RRR]), NULL);
if (op >= 0)
{
- Lisp_Object opl;
+ Lisp_Object opl;
opl = HASH_VALUE (h, op);
- if (!CHAR_VALID_P (XINT (opl), 0))
- if (!CHARACTERP (opl))
++ if (! CHARACTERP (XINT (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);
op = hash_lookup (h, make_number (i), NULL);
if (op >= 0)
{
- Lisp_Object opl;
+ Lisp_Object opl;
opl = HASH_VALUE (h, op);
if (!INTEGERP (opl))
CCL_INVALID_CMD;
else
continue;
}
- else
+ else
continue;
if (NILP (content))
ic = fin_ic;
}
break;
-
+
case CCL_MapMultiple:
{
Lisp_Object map, content, attrib, value;
}
}
map_vector_size = ASIZE (Vcode_conversion_map_vector);
-
+
do {
for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
{
else
continue;
}
- else
+ else
continue;
if (NILP (content))
}
}
break;
-
+
default:
CCL_INVALID_CMD;
}
}
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)
+ {
+#if 0 /* If the remaining bytes contain 0x80..0x9F, copying them
+ results in an invalid multibyte sequence. */
+
+ /* Copy the remaining source data. */
+ int i = src_end - src;
+ if (dst_bytes && (dst_end - dst) < i)
+ i = dst_end - dst;
+ bcopy (src, dst, i);
+ src += i;
+ dst += i;
+#else
+ /* Signal that we've consumed everything. */
+ src = src_end;
+#endif
+ }
}
ccl_finish:
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;
+ ccl->produced = dst - destination;
}
/* 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");
if (ASIZE (status) != 9)
error ("Length of vector STATUS is not 9");
CHECK_STRING (str);
- str_chars = XSTRING (str)->size;
- str_bytes = STRING_BYTES (XSTRING (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);
- for (i = 0; i < 8; i++)
- XSET (AREF (status, i), Lisp_Int, ccl.reg[i]);
- XSETINT (AREF (status, 8), ccl.ic);
- UNGCPRO;
- if (NILP (unibyte_p))
+ 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 (consumed_bytes < str_bytes)
{
- int nchars;
- const unsigned char *p = XSTRING (str)->data + consumed_bytes;
- const unsigned char *endp = XSTRING (str)->data + str_bytes;
++ 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 - XSTRING (str)->data;
++ 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);
+ if (ccl.status != CCL_STAT_SUSPEND_BY_DST)
+ break;
+ 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;
+ }
- produced = str_as_multibyte (outbuf, outbufsize, produced, &nchars);
- val = make_multibyte_string (outbuf, nchars, produced);
+ if (ccl.status != CCL_STAT_SUSPEND_BY_SRC)
+ break;
- }
+ }
- else
- val = make_unibyte_string (outbuf, produced);
- 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);
-
+
+ for (i = 0; i < 8; i++)
+ XSET (XVECTOR (status)->contents[i], Lisp_Int, ccl.reg[i]);
+ XSETINT (XVECTOR (status)->contents[8], ccl.ic);
+
+ if (NILP (unibyte_p))
+ val = make_multibyte_string ((char *) outbuf, produced_chars,
+ outp - outbuf);
+ else
+ val = make_unibyte_string ((char *) outbuf, produced_chars);
+ xfree (outbuf);
+
return val;
}
CHECK_SYMBOL (symbol);
CHECK_VECTOR (map);
-
+
for (i = 0; i < len; i++)
{
Lisp_Object slot = AREF (Vcode_conversion_map_vector, i);
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 Electrotechnical Laboratory, JAPAN.
-- Licensed to the Free Software Foundation.
- Copyright (C) 2001, 2002
++ Licensed to the Free Software Foundation.
++ Copyright (C) 2003
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
int private_state; /* CCL instruction may use this
for private use, mainly for saving
internal states on suspending.
- This variable is set to 0 when ccl is
+ This variable is set to 0 when ccl is
set up. */
int last_block; /* Set to 1 while processing the last
block. */
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; /* Set to nonzero if CCL_WRITE_CHAR
- writes eight-bit-control char. */
+ int eight_bit_control; /* If nonzero, ccl_driver counts all
+ eight-bit-control bytes written by
+ CCL_WRITE_CHAR. After execution,
+ if no such byte is written, set
+ this value to zero. */
};
/* This data type is used for the spec field of the structure
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;
execution of ccl program CCL_PROG (symbol or vector). */
extern int setup_ccl_program P_ ((struct ccl_program *, Lisp_Object));
- 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 */
--- /dev/null
- Licensed to the Free Software Foundation.
+ /* Basic character support.
+ Copyright (C) 1995, 1997, 1998, 2001 Electrotechnical Laboratory, JAPAN.
- Copyright (C) 2001, 2002
++ Licensed to the Free Software Foundation.
+ Copyright (C) 2001 Free Software Foundation, Inc.
- unsigned char *str;
++ 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
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ GNU Emacs is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GNU Emacs; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+ /* At first, see the document in `character.h' to understand the code
+ in this file. */
+
+ #ifdef emacs
+ #include <config.h>
+ #endif
+
+ #include <stdio.h>
+
+ #ifdef emacs
+
+ #include <sys/types.h>
+ #include "lisp.h"
+ #include "character.h"
+ #include "buffer.h"
+ #include "charset.h"
+ #include "composite.h"
+ #include "disptab.h"
+
+ #else /* not emacs */
+
+ #include "mulelib.h"
+
+ #endif /* emacs */
+
+ Lisp_Object Qcharacterp;
+
+ /* Vector of translation table ever defined.
+ ID of a translation table is used to index this vector. */
+ Lisp_Object Vtranslation_table_vector;
+
+ /* A char-table for characters which may invoke auto-filling. */
+ Lisp_Object Vauto_fill_chars;
+
+ Lisp_Object Qauto_fill_chars;
+
+ Lisp_Object Vchar_unify_table;
+
+ /* A char-table. An element is non-nil iff the corresponding
+ character has a printable glyph. */
+ Lisp_Object Vprintable_chars;
+
+ /* A char-table. An elemnent is a column-width of the corresponding
+ character. */
+ Lisp_Object Vchar_width_table;
+
+ /* A char-table. An element is a symbol indicating the direction
+ property of corresponding character. */
+ Lisp_Object Vchar_direction_table;
+
+ /* Variable used locally in the macro FETCH_MULTIBYTE_CHAR. */
+ unsigned char *_fetch_multibyte_char_p;
+
+ /* Char table of scripts. */
+ Lisp_Object Vchar_script_table;
+
+ static Lisp_Object Qchar_script_table;
+
+ /* Mapping table from unibyte chars to multibyte chars. */
+ int unibyte_to_multibyte_table[256];
+
+ \f
+
+ int
+ char_string (c, p)
+ int c;
+ unsigned char *p;
+ {
+ int bytes;
+
+ if (c & CHAR_MODIFIER_MASK)
+ {
+ /* As a character not less than 256 can't have modifier bits, we
+ just ignore the bits. */
+ if (SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
+ {
+ /* For Meta, Shift, and Control modifiers, we need special care. */
+ if (c & CHAR_META)
+ {
+ /* Move the meta bit to the right place for a string. */
+ c = (c & ~CHAR_META) | 0x80;
+ }
+ if (c & CHAR_SHIFT)
+ {
+ /* 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');
+ }
+ if (c & CHAR_CTL)
+ {
+ /* 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));
+ }
+ }
+
+ /* If C still has any modifier bits, just ignore it. */
+ c &= ~CHAR_MODIFIER_MASK;
+ }
+
+ MAYBE_UNIFY_CHAR (c);
+
+ if (c <= MAX_3_BYTE_CHAR)
+ {
+ bytes = CHAR_STRING (c, p);
+ }
+ else if (c <= MAX_4_BYTE_CHAR)
+ {
+ p[0] = (0xF0 | (c >> 18));
+ p[1] = (0x80 | ((c >> 12) & 0x3F));
+ p[2] = (0x80 | ((c >> 6) & 0x3F));
+ p[3] = (0x80 | (c & 0x3F));
+ bytes = 4;
+ }
+ else if (c <= MAX_5_BYTE_CHAR)
+ {
+ p[0] = 0xF8;
+ p[1] = (0x80 | ((c >> 18) & 0x0F));
+ p[2] = (0x80 | ((c >> 12) & 0x3F));
+ p[3] = (0x80 | ((c >> 6) & 0x3F));
+ p[4] = (0x80 | (c & 0x3F));
+ bytes = 5;
+ }
+ else
+ {
+ c = CHAR_TO_BYTE8 (c);
+ bytes = BYTE8_STRING (c, p);
+ }
+
+ return bytes;
+ }
+
+
+ int
+ string_char (p, advanced, len)
+ const unsigned char *p;
+ const unsigned char **advanced;
+ int *len;
+ {
+ int c;
+ const unsigned char *saved_p = p;
+
+ if (*p < 0x80 || ! (*p & 0x20) || ! (*p & 0x10))
+ {
+ c = STRING_CHAR_ADVANCE (p);
+ }
+ else if (! (*p & 0x08))
+ {
+ c = ((((p)[0] & 0xF) << 18)
+ | (((p)[1] & 0x3F) << 12)
+ | (((p)[2] & 0x3F) << 6)
+ | ((p)[3] & 0x3F));
+ p += 4;
+ }
+ else
+ {
+ c = ((((p)[1] & 0x3F) << 18)
+ | (((p)[2] & 0x3F) << 12)
+ | (((p)[3] & 0x3F) << 6)
+ | ((p)[4] & 0x3F));
+ p += 5;
+ }
+
+ MAYBE_UNIFY_CHAR (c);
+
+ if (len)
+ *len = p - saved_p;
+ if (advanced)
+ *advanced = p;
+ return c;
+ }
+
+
+ /* Translate character C by translation table TABLE. If C is
+ negative, translate a character specified by CHARSET and CODE. If
+ no translation is found in TABLE, return the untranslated
+ character. */
+
+ int
+ translate_char (table, c)
+ Lisp_Object table;
+ int c;
+ {
+ Lisp_Object ch;
+
+ if (! CHAR_TABLE_P (table))
+ return c;
+ ch = CHAR_TABLE_REF (table, c);
+ if (! CHARACTERP (ch))
+ return c;
+ return XINT (ch);
+ }
+
+ /* Convert the multibyte character C to unibyte 8-bit character based
+ on the current value of charset_unibyte. If dimension of
+ charset_unibyte is more than one, return (C & 0xFF).
+
+ The argument REV_TBL is now ignored. It will be removed in the
+ future. */
+
+ int
+ multibyte_char_to_unibyte (c, rev_tbl)
+ int c;
+ Lisp_Object rev_tbl;
+ {
+ struct charset *charset;
+ unsigned c1;
+
+ if (CHAR_BYTE8_P (c))
+ return CHAR_TO_BYTE8 (c);
+ charset = CHARSET_FROM_ID (charset_unibyte);
+ c1 = ENCODE_CHAR (charset, c);
+ return ((c1 != CHARSET_INVALID_CODE (charset)) ? c1 : c & 0xFF);
+ }
+
+
+ DEFUN ("characterp", Fcharacterp, Scharacterp, 1, 2, 0,
+ doc: /* Return non-nil if OBJECT is a character. */)
+ (object, ignore)
+ Lisp_Object object, ignore;
+ {
+ return (CHARACTERP (object) ? Qt : Qnil);
+ }
+
+ DEFUN ("max-char", Fmax_char, Smax_char, 0, 0, 0,
+ doc: /* Return the character of the maximum code. */)
+ ()
+ {
+ return make_number (MAX_CHAR);
+ }
+
+ 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 multibyte character is a result of decoding CH by
+ the current unibyte charset (see `unibyte-charset'). */)
+ (ch)
+ Lisp_Object ch;
+ {
+ int c;
+ struct charset *charset;
+
+ CHECK_CHARACTER (ch);
+ c = XFASTINT (ch);
+ if (c >= 0400)
+ error ("Invalid unibyte character: %d", c);
+ charset = CHARSET_FROM_ID (charset_unibyte);
+ c = DECODE_CHAR (charset, c);
+ if (c < 0)
+ c = BYTE8_TO_CHAR (XFASTINT (ch));
+ return make_number (c);
+ }
+
+ 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.\n\
+ The unibyte character is a result of encoding CH by
+ the current primary charset (value of `charset-primary'). */)
+ (ch)
+ Lisp_Object ch;
+ {
+ int c;
+
+ CHECK_CHARACTER (ch);
+ c = XFASTINT (ch);
+ c = CHAR_TO_BYTE8 (c);
+ return make_number (c);
+ }
+
+ DEFUN ("char-bytes", Fchar_bytes, Schar_bytes, 1, 1, 0,
+ doc: /* Return 1 regardless of the argument CHAR.
+ This is now an obsolete function. We keep it just for backward compatibility. */)
+ (ch)
+ Lisp_Object ch;
+ {
+ CHECK_CHARACTER (ch);
+ return make_number (1);
+ }
+
+ DEFUN ("char-width", Fchar_width, Schar_width, 1, 1, 0,
+ doc: /* Return width of CHAR 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 disp;
+ int c, width;
+ struct Lisp_Char_Table *dp = buffer_display_table ();
+
+ CHECK_CHARACTER (ch);
+ c = XINT (ch);
+
+ /* Get the way the display table would display it. */
+ disp = dp ? DISP_CHAR_VECTOR (dp, c) : Qnil;
+
+ if (VECTORP (disp))
+ width = ASIZE (disp);
+ else
+ width = CHAR_WIDTH (c);
+
+ return make_number (width);
+ }
+
+ /* 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)
- int len = XSTRING (string)->size;
- unsigned char *str = XSTRING (string)->data;
++ const unsigned char *str;
+ int precision, *nchars, *nbytes;
+ {
+ int i = 0, i_byte = 0;
+ int width = 0;
+ struct Lisp_Char_Table *dp = buffer_display_table ();
+
+ while (i_byte < len)
+ {
+ int bytes, thiswidth;
+ Lisp_Object val;
+ int c = STRING_CHAR_AND_LENGTH (str + i_byte, len - i_byte, bytes);
+
+ if (dp)
+ {
+ val = DISP_CHAR_VECTOR (dp, c);
+ if (VECTORP (val))
+ thiswidth = XVECTOR (val)->size;
+ else
+ thiswidth = CHAR_WIDTH (c);
+ }
+ else
+ {
+ thiswidth = CHAR_WIDTH (c);
+ }
+
+ if (precision > 0
+ && (width + thiswidth > precision))
+ {
+ *nchars = i;
+ *nbytes = i_byte;
+ return width;
+ }
+ i++;
+ i_byte += bytes;
+ width += thiswidth;
+ }
+
+ if (precision > 0)
+ {
+ *nchars = i;
+ *nbytes = i_byte;
+ }
+
+ return width;
+ }
+
+ /* 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;
+ {
+ return c_string_width (str, len, -1, NULL, NULL);
+ }
+
+ /* 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;
+ {
- unsigned char *ptr;
++ int len = SCHARS (string);
++ 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;
+
+ 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 = 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;
+ else
+ thiswidth = CHAR_WIDTH (c);
+ }
+ else
+ {
+ int c = STRING_CHAR_AND_LENGTH (str + i_byte, len - i_byte, bytes);
+
+ chars = 1;
+ thiswidth = CHAR_WIDTH (c);
+ }
+
+ if (precision > 0
+ && (width + thiswidth > precision))
+ {
+ *nchars = i;
+ *nbytes = i_byte;
+ return width;
+ }
+ i += chars;
+ i_byte += bytes;
+ width += thiswidth;
+ }
+
+ if (precision > 0)
+ {
+ *nchars = i;
+ *nbytes = i_byte;
+ }
+
+ return width;
+ }
+
+ 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. */)
+ (str)
+ Lisp_Object str;
+ {
+ Lisp_Object val;
+
+ CHECK_STRING (str);
+ XSETFASTINT (val, lisp_string_width (str, -1, NULL, NULL));
+ return val;
+ }
+
+ DEFUN ("char-direction", Fchar_direction, Schar_direction, 1, 1, 0,
+ doc: /* Return the direction of CHAR.
+ The returned value is 0 for left-to-right and 1 for right-to-left. */)
+ (ch)
+ Lisp_Object ch;
+ {
+ int c;
+
+ CHECK_CHARACTER (ch);
+ c = XINT (ch);
+ return CHAR_TABLE_REF (Vchar_direction_table, c);
+ }
+
+ DEFUN ("chars-in-region", Fchars_in_region, Schars_in_region, 2, 2, 0,
+ doc: /* Return number of characters between BEG and END.
+ This is now an obsolete function. We keep it just for backward compatibility. */)
+ (beg, end)
+ Lisp_Object beg, end;
+ {
+ int from, to;
+
+ CHECK_NUMBER_COERCE_MARKER (beg);
+ CHECK_NUMBER_COERCE_MARKER (end);
+
+ from = min (XFASTINT (beg), XFASTINT (end));
+ to = max (XFASTINT (beg), XFASTINT (end));
+
+ return make_number (to - from);
+ }
+
+ /* Return the number of characters in the NBYTES bytes at PTR.
+ This works by looking at the contents and checking for multibyte
+ sequences while assuming that there's no invalid sequence.
+ However, if the current buffer has enable-multibyte-characters =
+ nil, we treat each byte as a character. */
+
+ int
+ chars_in_text (ptr, nbytes)
- unsigned char *ptr;
++ const unsigned char *ptr;
+ int nbytes;
+ {
+ /* current_buffer is null at early stages of Emacs initialization. */
+ if (current_buffer == 0
+ || NILP (current_buffer->enable_multibyte_characters))
+ return nbytes;
+
+ return multibyte_chars_in_text (ptr, nbytes);
+ }
+
+ /* Return the number of characters in the NBYTES bytes at PTR.
+ This works by looking at the contents and checking for multibyte
+ sequences while assuming that there's no invalid sequence. It
+ ignores enable-multibyte-characters. */
+
+ int
+ multibyte_chars_in_text (ptr, nbytes)
- unsigned char *endp = ptr + nbytes;
++ const unsigned char *ptr;
+ int nbytes;
+ {
- unsigned char *str;
++ const unsigned char *endp = ptr + nbytes;
+ int chars = 0;
+
+ while (ptr < endp)
+ {
+ int len = MULTIBYTE_LENGTH (ptr, endp);
+
+ if (len == 0)
+ abort ();
+ ptr += len;
+ chars++;
+ }
+
+ return chars;
+ }
+
+ /* Parse unibyte text at STR of LEN bytes as a multibyte text, count
+ characters and bytes in it, and store them in *NCHARS and *NBYTES
+ respectively. On counting bytes, pay attention to that 8-bit
+ characters not constructing a valid multibyte sequence are
+ represented by 2-byte in a multibyte text. */
+
+ void
+ parse_str_as_multibyte (str, len, nchars, nbytes)
- unsigned char *endp = str + len;
++ const unsigned char *str;
+ int len, *nchars, *nbytes;
+ {
- unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH;
++ const unsigned char *endp = str + len;
+ int n, chars = 0, bytes = 0;
+
+ if (len >= MAX_MULTIBYTE_LENGTH)
+ {
- }
++ const unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH;
+ while (str < adjusted_endp)
+ {
+ if ((n = MULTIBYTE_LENGTH_NO_CHECK (str)) > 0)
+ str += n, bytes += n;
+ else
+ str++, bytes += 2;
+ chars++;
+ }
+ }
+ while (str < endp)
+ {
+ if ((n = MULTIBYTE_LENGTH (str, endp)) > 0)
+ str += n, bytes += n;
+ else
+ str++, bytes += 2;
+ chars++;
+ }
+
+ *nchars = chars;
+ *nbytes = bytes;
+ return;
+ }
+
+ /* Arrange unibyte text at STR of NBYTES bytes as a multibyte text.
+ It actually converts only such 8-bit characters that don't contruct
+ a multibyte sequence to multibyte forms of Latin-1 characters. 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;
+ {
+ unsigned char *p = str, *endp = str + nbytes;
+ unsigned char *to;
+ int chars = 0;
+ int n;
+
+ if (nbytes >= MAX_MULTIBYTE_LENGTH)
+ {
+ unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH;
+ while (p < adjusted_endp
+ && (n = MULTIBYTE_LENGTH_NO_CHECK (p)) > 0)
+ p += n, chars++;
+ }
+ while ((n = MULTIBYTE_LENGTH (p, endp)) > 0)
+ p += n, chars++;
+ if (nchars)
+ *nchars = chars;
+ if (p == endp)
+ return nbytes;
+
+ to = p;
+ nbytes = endp - p;
+ endp = str + len;
+ safe_bcopy ((char *) p, (char *) (endp - nbytes), nbytes);
+ p = endp - nbytes;
+
+ if (nbytes >= MAX_MULTIBYTE_LENGTH)
+ {
+ unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH;
+ while (p < adjusted_endp)
+ {
+ if ((n = MULTIBYTE_LENGTH_NO_CHECK (p)) > 0)
+ {
+ while (n--)
+ *to++ = *p++;
+ }
+ else
+ {
+ int c = *p++;
+ c = BYTE8_TO_CHAR (c);
+ to += CHAR_STRING (c, to);
+ }
+ }
+ chars++;
+ }
+ while (p < endp)
+ {
+ if ((n = MULTIBYTE_LENGTH (p, endp)) > 0)
+ {
+ while (n--)
+ *to++ = *p++;
- while (p < endp)
++ }
+ else
+ {
+ int c = *p++;
+ c = BYTE8_TO_CHAR (c);
+ to += CHAR_STRING (c, to);
+ }
+ 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) ? 1 : 2;
+ return bytes;
+ }
+
+
+ /* Convert unibyte text at STR of NBYTES bytes to a 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. */
+
+ 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++;
+ if (p == endp)
+ return bytes;
+ to = p;
+ bytes = endp - p;
+ endp = str + len;
+ safe_bcopy ((char *) p, (char *) (endp - bytes), bytes);
+ p = endp - bytes;
- while (p < endp)
++ while (p < endp)
+ {
+ int c = *p++;
+
+ if (c >= 0x80)
+ c = BYTE8_TO_CHAR (c);
+ to += CHAR_STRING (c, to);
+ }
+ return (to - str);
+ }
+
+ /* Arrange multibyte text at STR of LEN bytes as a unibyte text. It
+ actually converts characters in the range 0x80..0xFF to
+ unibyte. */
+
+ int
+ str_as_unibyte (str, bytes)
+ unsigned char *str;
+ int bytes;
+ {
+ const unsigned char *p = str, *endp = str + bytes;
+ unsigned char *to;
+ int c, len;
+
+ while (p < endp)
+ {
+ c = *p;
+ len = BYTES_BY_CHAR_HEAD (c);
+ if (CHAR_BYTE8_HEAD_P (c))
+ break;
+ p += len;
+ }
+ to = str + (p - str);
- int nbytes = STRING_BYTES (XSTRING (string));
- unsigned char *p = XSTRING (string)->data;
++ while (p < endp)
+ {
+ c = *p;
+ len = BYTES_BY_CHAR_HEAD (c);
+ if (CHAR_BYTE8_HEAD_P (c))
+ {
+ c = STRING_CHAR_ADVANCE (p);
+ *to++ = CHAR_TO_BYTE8 (c);
+ }
+ else
+ {
+ while (len--) *to++ = *p++;
+ }
+ }
+ return (to - str);
+ }
+
+ int
+ string_count_byte8 (string)
+ Lisp_Object string;
+ {
+ int multibyte = STRING_MULTIBYTE (string);
- int nchars = XSTRING (string)->size;
- int nbytes = STRING_BYTES (XSTRING (string));
++ int nbytes = SBYTES (string);
++ unsigned char *p = SDATA (string);
+ unsigned char *pend = p + nbytes;
+ int count = 0;
+ int c, len;
+
+ if (multibyte)
+ while (p < pend)
+ {
+ c = *p;
+ len = BYTES_BY_CHAR_HEAD (c);
+
+ if (CHAR_BYTE8_HEAD_P (c))
+ count++;
+ p += len;
+ }
+ else
+ while (p < pend)
+ {
+ if (*p++ >= 0x80)
+ count++;
+ }
+ return count;
+ }
+
+
+ Lisp_Object
+ string_escape_byte8 (string)
+ Lisp_Object string;
+ {
- src = XSTRING (string)->data;
++ int nchars = SCHARS (string);
++ int nbytes = SBYTES (string);
+ int multibyte = STRING_MULTIBYTE (string);
+ int byte8_count;
+ const unsigned char *src, *src_end;
+ unsigned char *dst;
+ Lisp_Object val;
+ int c, len;
+
+ if (multibyte && nchars == nbytes)
+ return string;
+
+ byte8_count = string_count_byte8 (string);
+
+ if (byte8_count == 0)
+ return string;
+
+ if (multibyte)
+ /* Convert 2-byte sequence of byte8 chars to 4-byte octal. */
+ val = make_uninit_multibyte_string (nchars + byte8_count * 3,
+ nbytes + byte8_count * 2);
+ else
+ /* Convert 1-byte sequence of byte8 chars to 4-byte octal. */
+ val = make_uninit_string (nbytes + byte8_count * 3);
+
- dst = XSTRING (val)->data;
++ src = SDATA (string);
+ src_end = src + nbytes;
-DEFUN ("string", Fstring, Sstring, 1, MANY, 0,
++ dst = SDATA (val);
+ if (multibyte)
+ while (src < src_end)
+ {
+ c = *src;
+ len = BYTES_BY_CHAR_HEAD (c);
+
+ if (CHAR_BYTE8_HEAD_P (c))
+ {
+ c = STRING_CHAR_ADVANCE (src);
+ c = CHAR_TO_BYTE8 (c);
+ sprintf ((char *) dst, "\\%03o", c);
+ dst += 4;
+ }
+ else
+ while (len--) *dst++ = *src++;
+ }
+ else
+ while (src < src_end)
+ {
+ c = *src++;
+ if (c >= 0x80)
+ {
+ sprintf ((char *) dst, "\\%03o", c);
+ dst += 4;
+ }
+ else
+ *dst++ = c;
+ }
+ return 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;
+ Lisp_Object *args;
+ {
+ int i;
+ unsigned char *buf = (unsigned char *) alloca (MAX_MULTIBYTE_LENGTH * n);
+ unsigned char *p = buf;
+ int c;
+
+ for (i = 0; i < n; i++)
+ {
+ CHECK_CHARACTER (args[i]);
+ c = XINT (args[i]);
+ p += CHAR_STRING (c, p);
+ }
+
+ return make_string_from_bytes ((char *) buf, n, p - buf);
+ }
+
+ void
+ init_character_once ()
+ {
+ }
+
+ #ifdef emacs
+
+ void
+ syms_of_character ()
+ {
+ DEFSYM (Qcharacterp, "characterp");
+ DEFSYM (Qauto_fill_chars, "auto-fill-chars");
+
+ staticpro (&Vchar_unify_table);
+ Vchar_unify_table = Qnil;
+
+ defsubr (&Smax_char);
+ defsubr (&Scharacterp);
+ defsubr (&Sunibyte_char_to_multibyte);
+ defsubr (&Smultibyte_char_to_unibyte);
+ defsubr (&Schar_bytes);
+ defsubr (&Schar_width);
+ defsubr (&Sstring_width);
+ defsubr (&Schar_direction);
+ defsubr (&Schars_in_region);
+ defsubr (&Sstring);
+
+ DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector,
+ doc: /*
+ Vector recording all translation tables ever defined.
+ Each element is a pair (SYMBOL . TABLE) relating the table to the
+ symbol naming it. The ID of a translation table is an index into this vector. */);
+ Vtranslation_table_vector = Fmake_vector (make_number (16), 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, ' ', Qt);
+ CHAR_TABLE_SET (Vauto_fill_chars, '\n', Qt);
+
+ DEFVAR_LISP ("char-width-table", &Vchar_width_table,
+ doc: /*
+ A char-table for width (columns) of each character. */);
+ Vchar_width_table = Fmake_char_table (Qnil, make_number (1));
+ char_table_set_range (Vchar_width_table, 0x80, 0x9F, make_number (4));
+ char_table_set_range (Vchar_width_table, MAX_5_BYTE_CHAR + 1, MAX_CHAR,
+ make_number (4));
+
+ DEFVAR_LISP ("char-direction-table", &Vchar_direction_table,
+ doc: /* A char-table for direction of each character. */);
+ Vchar_direction_table = Fmake_char_table (Qnil, make_number (1));
+
+ DEFVAR_LISP ("printable-chars", &Vprintable_chars,
+ doc: /* A char-table for each printable character. */);
+ Vprintable_chars = Fmake_char_table (Qnil, Qnil);
+ Fset_char_table_range (Vprintable_chars,
+ Fcons (make_number (32), make_number (126)), Qt);
+ Fset_char_table_range (Vprintable_chars,
+ Fcons (make_number (160),
+ make_number (MAX_5_BYTE_CHAR)), Qt);
+
+ DEFVAR_LISP ("char-script-table", &Vchar_script_table,
+ doc: /* Char table of script symbols.
+ It has one extra slot whose value is a list of script symbols. */);
+
+ /* 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");
+ DEFSYM (Qchar_script_table, "char-script-table");
+ Fput (Qchar_script_table, Qchar_table_extra_slots, make_number (1));
+ Vchar_script_table = Fmake_char_table (Qchar_script_table, Qnil);
+ }
+
+ #endif /* emacs */
--- /dev/null
- Licensed to the Free Software Foundation.
- Copyright (C) 2001, 2002
+ /* Header for multibyte character handler.
+ Copyright (C) 1995, 1997, 1998 Electrotechnical Laboratory, JAPAN.
- | (((unsigned char) (p)[-2]) < 0xC2 ? 0x3FFF80 : 0))) \
++ Licensed to the Free Software Foundation.
++ 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
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ GNU Emacs is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GNU Emacs; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+ #ifndef EMACS_CHARACTER_H
+ #define EMACS_CHARACTER_H
+
+ /* character code 1st byte byte sequence
+ -------------- -------- -------------
+ 0-7F 00..7F 0xxxxxxx
+ 80-7FF C2..DF 110xxxxx 10xxxxxx
+ 800-FFFF E0..EF 1110xxxx 10xxxxxx 10xxxxxx
+ 10000-1FFFFF F0..F7 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
+ 200000-3FFF7F F8 11111000 1000xxxx 10xxxxxx 10xxxxxx 10xxxxxx
+ invalid F9..FF
+
+ raw-8-bit
+ 3FFF80-3FFFFF C0..C1 1100000x 10xxxxxx
+ */
+
+ /* Maximum character code ((1 << CHARACTERBITS) - 1). */
+ #define MAX_CHAR 0x3FFFFF
+
+ /* Maximum Unicode character code. */
+ #define MAX_UNICODE_CHAR 0x10FFFF
+
+ /* Maximum N-byte character codes. */
+ #define MAX_1_BYTE_CHAR 0x7F
+ #define MAX_2_BYTE_CHAR 0x7FF
+ #define MAX_3_BYTE_CHAR 0xFFFF
+ #define MAX_4_BYTE_CHAR 0x1FFFFF
+ #define MAX_5_BYTE_CHAR 0x3FFF7F
+
+ /* Leading code range of Latin-1 chars. */
+ #define LEADING_CODE_LATIN_1_MIN 0xC2
+ #define LEADING_CODE_LATIN_1_MAX 0xC3
+
+ /* Nonzero iff C is a character that corresponds to a raw 8-bit
+ byte. */
+ #define CHAR_BYTE8_P(c) ((c) > MAX_5_BYTE_CHAR)
+
+ /* Return the character code for raw 8-bit byte BYTE. */
+ #define BYTE8_TO_CHAR(byte) ((byte) + 0x3FFF00)
+
+ /* Return the raw 8-bit byte for character C. */
+ #define CHAR_TO_BYTE8(c) \
+ (CHAR_BYTE8_P (c) \
+ ? (c) - 0x3FFF00 \
+ : multibyte_char_to_unibyte (c, Qnil))
+
+ /* Nonzero iff BYTE is the 1st byte of a multibyte form of a character
+ that corresponds to a raw 8-bit byte. */
+ #define CHAR_BYTE8_HEAD_P(byte) ((byte) == 0xC0 || (byte) == 0xC1)
+
+ /* Mapping table from unibyte chars to multibyte chars. */
+ extern int unibyte_to_multibyte_table[256];
+
+ /* Convert the unibyte character C to the corresponding multibyte
+ character. If C can't be converted, return C. */
+ #define unibyte_char_to_multibyte(c) \
+ ((c) < 256 ? unibyte_to_multibyte_table[(c)] : (c))
+
+ /* If C is not ASCII, make it unibyte. */
+ #define MAKE_CHAR_UNIBYTE(c) \
+ do { \
+ if (! ASCII_CHAR_P (c)) \
+ c = CHAR_TO_BYTE8 (c); \
+ } while (0)
+
+
+ /* If C is not ASCII, make it multibyte. It assumes C < 256. */
+ #define MAKE_CHAR_MULTIBYTE(c) ((c) = unibyte_to_multibyte_table[(c)])
+
+ /* This is the maximum byte length of multibyte form. */
+ #define MAX_MULTIBYTE_LENGTH 5
+
+ /* Return a Lisp character whose character code is C. */
+ #define make_char(c) make_number (c)
+
+ /* Nonzero iff C is an ASCII byte. */
+ #define ASCII_BYTE_P(c) ((unsigned) (c) < 0x80)
+
+ /* Nonzero iff X is a character. */
+ #define CHARACTERP(x) (NATNUMP (x) && XFASTINT (x) <= MAX_CHAR)
+
+ /* Nonzero iff C is valid as a character code. GENERICP is not used
+ now. */
+ #define CHAR_VALID_P(c, genericp) ((unsigned) (c) <= MAX_CHAR)
+
+ /* Check if Lisp object X is a character or not. */
+ #define CHECK_CHARACTER(x) \
+ do { \
+ if (! CHARACTERP(x)) x = wrong_type_argument (Qcharacterp, (x)); \
+ } while (0)
+
++#define CHECK_CHARACTER_CAR(x) \
++ do { \
++ Lisp_Object tmp = XCAR (x); \
++ CHECK_CHARACTER (tmp); \
++ XSETCAR ((x), tmp); \
++ } while (0)
++
++#define CHECK_CHARACTER_CDR(x) \
++ do { \
++ Lisp_Object tmp = XCDR (x); \
++ CHECK_CHARACTER (tmp); \
++ XSETCDR ((x), tmp); \
++ } while (0)
++
+ /* Nonzero iff C is an ASCII character. */
+ #define ASCII_CHAR_P(c) ((unsigned) (c) < 0x80)
+
+ /* Nonzero iff C is a character of code less than 0x100. */
+ #define SINGLE_BYTE_CHAR_P(c) ((unsigned) (c) < 0x100)
+
+ /* Nonzero if character C has a printable glyph. */
+ #define CHAR_PRINTABLE_P(c) \
+ (((c) >= 32 && ((c) < 127) \
+ || ! NILP (CHAR_TABLE_REF (Vprintable_chars, (c)))))
+
+ /* Return byte length of multibyte form for character C. */
+ #define CHAR_BYTES(c) \
+ ( (c) <= MAX_1_BYTE_CHAR ? 1 \
+ : (c) <= MAX_2_BYTE_CHAR ? 2 \
+ : (c) <= MAX_3_BYTE_CHAR ? 3 \
+ : (c) <= MAX_4_BYTE_CHAR ? 4 \
+ : (c) <= MAX_5_BYTE_CHAR ? 5 \
+ : 2)
+
+
+ /* Return the leading code of multibyte form of C. */
+ #define CHAR_LEADING_CODE(c) \
+ ((c) <= MAX_1_BYTE_CHAR ? c \
+ : (c) <= MAX_2_BYTE_CHAR ? (0xC0 | ((c) >> 6)) \
+ : (c) <= MAX_3_BYTE_CHAR ? (0xE0 | ((c) >> 12)) \
+ : (c) <= MAX_4_BYTE_CHAR ? (0xF0 | ((c) >> 18)) \
+ : (c) <= MAX_5_BYTE_CHAR ? 0xF8 \
+ : (0xC0 | (((c) >> 6) & 0x01)))
+
+
+ /* Store multibyte form of the character C in P. The caller should
+ allocate at least MAX_MULTIBYTE_LENGTH bytes area at P in advance.
+ Returns the length of the multibyte form. */
+
+ #define CHAR_STRING(c, p) \
+ ((unsigned) (c) <= MAX_1_BYTE_CHAR \
+ ? ((p)[0] = (c), \
+ 1) \
+ : (unsigned) (c) <= MAX_2_BYTE_CHAR \
+ ? ((p)[0] = (0xC0 | ((c) >> 6)), \
+ (p)[1] = (0x80 | ((c) & 0x3F)), \
+ 2) \
+ : (unsigned) (c) <= MAX_3_BYTE_CHAR \
+ ? ((p)[0] = (0xE0 | ((c) >> 12)), \
+ (p)[1] = (0x80 | (((c) >> 6) & 0x3F)), \
+ (p)[2] = (0x80 | ((c) & 0x3F)), \
+ 3) \
+ : char_string (c, p))
+
+ /* Store multibyte form of byte B in P. The caller should allocate at
+ least MAX_MULTIBYTE_LENGTH bytes area at P in advance. Returns the
+ length of the multibyte form. */
+
+ #define BYTE8_STRING(b, p) \
+ ((p)[0] = (0xC0 | (((b) >> 6) & 0x01)), \
+ (p)[1] = (0x80 | ((c) & 0x3F)), \
+ 2)
+
+
+ /* Store multibyte form of the character C in P. The caller should
+ allocate at least MAX_MULTIBYTE_LENGTH bytes area at P in advance.
+ And, advance P to the end of the multibyte form. */
+
+ #define CHAR_STRING_ADVANCE(c, p) \
+ do { \
+ if ((c) <= MAX_1_BYTE_CHAR) \
+ *(p)++ = (c); \
+ else if ((c) <= MAX_2_BYTE_CHAR) \
+ *(p)++ = (0xC0 | ((c) >> 6)), \
+ *(p)++ = (0x80 | ((c) & 0x3F)); \
+ else if ((c) <= MAX_3_BYTE_CHAR) \
+ *(p)++ = (0xE0 | ((c) >> 12)), \
+ *(p)++ = (0x80 | (((c) >> 6) & 0x3F)), \
+ *(p)++ = (0x80 | ((c) & 0x3F)); \
+ else \
+ (p) += char_string ((c), (p)); \
+ } while (0)
+
+
+ /* Nonzero iff BYTE starts a non-ASCII character in a multibyte
+ form. */
+ #define LEADING_CODE_P(byte) (((byte) & 0xC0) == 0xC0)
+
+ /* Nonzero iff BYTE is a trailing code of a non-ASCII character in a
+ multibyte form. */
+ #define TRAILING_CODE_P(byte) (((byte) & 0xC0) == 0x80)
+
+ /* Nonzero iff BYTE starts a character in a multibyte form.
+ This is equivalent to:
+ (ASCII_BYTE_P (byte) || LEADING_CODE_P (byte)) */
+ #define CHAR_HEAD_P(byte) (((byte) & 0xC0) != 0x80)
+
+ /* Just kept for backward compatibility. This macro will be removed
+ in the future. */
+ #define BASE_LEADING_CODE_P LEADING_CODE_P
+
+ /* How many bytes a character that starts with BYTE occupies in a
+ multibyte form. */
+ #define BYTES_BY_CHAR_HEAD(byte) \
+ (!((byte) & 0x80) ? 1 \
+ : !((byte) & 0x20) ? 2 \
+ : !((byte) & 0x10) ? 3 \
+ : !((byte) & 0x08) ? 4 \
+ : 5)
+
+
+ /* Return the length of the multi-byte form at string STR of length
+ LEN while assuming that STR points a valid multi-byte form. As
+ this macro isn't necessary anymore, all callers will be changed to
+ use BYTES_BY_CHAR_HEAD directly in the future. */
+
+ #define MULTIBYTE_FORM_LENGTH(str, len) \
+ BYTES_BY_CHAR_HEAD (*(str))
+
+ /* Parse multibyte string STR of length LENGTH and set BYTES to the
+ byte length of a character at STR while assuming that STR points a
+ valid multibyte form. As this macro isn't necessary anymore, all
+ callers will be changed to use BYTES_BY_CHAR_HEAD directly in the
+ future. */
+
+ #define PARSE_MULTIBYTE_SEQ(str, length, bytes) \
+ (bytes) = BYTES_BY_CHAR_HEAD (*(str))
+
+ /* The byte length of multibyte form at unibyte string P ending at
+ PEND. If STR doesn't point a valid multibyte form, return 0. */
+
+ #define MULTIBYTE_LENGTH(p, pend) \
+ (p >= pend ? 0 \
+ : !((p)[0] & 0x80) ? 1 \
+ : ((p + 1 >= pend) || (((p)[1] & 0xC0) != 0x80)) ? 0 \
+ : ((p)[0] & 0xE0) == 0xC0 ? 2 \
+ : ((p + 2 >= pend) || (((p)[2] & 0xC0) != 0x80)) ? 0 \
+ : ((p)[0] & 0xF0) == 0xE0 ? 3 \
+ : ((p + 3 >= pend) || (((p)[3] & 0xC0) != 0x80)) ? 0 \
+ : ((p)[0] & 0xF8) == 0xF0 ? 4 \
+ : ((p + 4 >= pend) || (((p)[4] & 0xC0) != 0x80)) ? 0 \
+ : (p)[0] == 0xF8 && ((p)[1] & 0xF0) == 0x80 ? 5 \
+ : 0)
+
+
+ /* Like MULTIBYTE_LENGTH but don't check the ending address. */
+
+ #define MULTIBYTE_LENGTH_NO_CHECK(p) \
+ (!((p)[0] & 0x80) ? 1 \
+ : ((p)[1] & 0xC0) != 0x80 ? 0 \
+ : ((p)[0] & 0xE0) == 0xC0 ? 2 \
+ : ((p)[2] & 0xC0) != 0x80 ? 0 \
+ : ((p)[0] & 0xF0) == 0xE0 ? 3 \
+ : ((p)[3] & 0xC0) != 0x80 ? 0 \
+ : ((p)[0] & 0xF8) == 0xF0 ? 4 \
+ : ((p)[4] & 0xC0) != 0x80 ? 0 \
+ : (p)[0] == 0xF8 && ((p)[1] & 0xF0) == 0x80 ? 5 \
+ : 0)
+
++/* 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)); \
++ } while (0)
++
++
++/* If P is after LIMIT, advance P to the previous character boundary.
++ It assumes that P is already at a character boundary of the sane
++ mulitbyte form whose beginning address is LIMIT. */
++
++#define PREV_CHAR_BOUNDARY(p, limit) \
++ do { \
++ if ((p) > (limit)) \
++ { \
++ const unsigned char *p0 = (p); \
++ do { \
++ p0--; \
++ } while (p0 >= limit && ! CHAR_HEAD_P (*p0)); \
++ (p) = (BYTES_BY_CHAR_HEAD (*p0) == (p) - p0) ? p0 : (p) - 1; \
++ } \
++ } while (0)
+
+ /* Return the character code of character whose multibyte form is at
+ P. The argument LEN is ignored. It will be removed in the
+ future. */
+
+ #define STRING_CHAR(p, len) \
+ (!((p)[0] & 0x80) \
+ ? (p)[0] \
+ : ! ((p)[0] & 0x20) \
+ ? (((((p)[0] & 0x1F) << 6) \
+ | ((p)[1] & 0x3F)) \
+ + (((unsigned char) (p)[0]) < 0xC2 ? 0x3FFF80 : 0)) \
+ : ! ((p)[0] & 0x10) \
+ ? ((((p)[0] & 0x0F) << 12) \
+ | (((p)[1] & 0x3F) << 6) \
+ | ((p)[2] & 0x3F)) \
+ : string_char ((p), NULL, NULL))
+
+
+ /* Like STRING_CHAR but set ACTUAL_LEN to the length of multibyte
+ form. The argument LEN is ignored. It will be removed in the
+ future. */
+
+ #define STRING_CHAR_AND_LENGTH(p, len, actual_len) \
+ (!((p)[0] & 0x80) \
+ ? ((actual_len) = 1, (p)[0]) \
+ : ! ((p)[0] & 0x20) \
+ ? ((actual_len) = 2, \
+ (((((p)[0] & 0x1F) << 6) \
+ | ((p)[1] & 0x3F)) \
+ + (((unsigned char) (p)[0]) < 0xC2 ? 0x3FFF80 : 0))) \
+ : ! ((p)[0] & 0x10) \
+ ? ((actual_len) = 3, \
+ ((((p)[0] & 0x0F) << 12) \
+ | (((p)[1] & 0x3F) << 6) \
+ | ((p)[2] & 0x3F))) \
+ : string_char ((p), NULL, &actual_len))
+
+
+ /* Like STRING_CHAR but advacen P to the end of multibyte form. */
+
+ #define STRING_CHAR_ADVANCE(p) \
+ (!((p)[0] & 0x80) \
+ ? *(p)++ \
+ : ! ((p)[0] & 0x20) \
+ ? ((p) += 2, \
+ ((((p)[-2] & 0x1F) << 6) \
+ | ((p)[-1] & 0x3F) \
-extern void parse_str_as_multibyte P_ ((unsigned char *, int, int *, int *));
++ | ((unsigned char) ((p)[-2]) < 0xC2 ? 0x3FFF80 : 0))) \
+ : ! ((p)[0] & 0x10) \
+ ? ((p) += 3, \
+ ((((p)[-3] & 0x0F) << 12) \
+ | (((p)[-2] & 0x3F) << 6) \
+ | ((p)[-1] & 0x3F))) \
+ : string_char ((p), &(p), NULL))
+
+
+ /* 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)) \
+ { \
+ unsigned char *ptr = &XSTRING (STRING)->data[BYTEIDX]; \
+ int len; \
+ \
+ OUTPUT = STRING_CHAR_AND_LENGTH (ptr, 0, len); \
+ BYTEIDX += len; \
+ } \
+ else \
+ OUTPUT = XSTRING (STRING)->data[BYTEIDX++]; \
+ } \
+ else
+
+ /* Like FETCH_STRING_CHAR_ADVANCE */
+
+ #define FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE(OUTPUT, STRING, CHARIDX, BYTEIDX) \
+ if (1) \
+ { \
+ CHARIDX++; \
+ if (STRING_MULTIBYTE (STRING)) \
+ { \
+ unsigned char *ptr = &XSTRING (STRING)->data[BYTEIDX]; \
+ int len; \
+ \
+ OUTPUT = STRING_CHAR_AND_LENGTH (ptr, 0, len); \
+ BYTEIDX += len; \
+ } \
+ else \
+ { \
+ OUTPUT = XSTRING (STRING)->data[BYTEIDX++]; \
+ MAKE_CHAR_MULTIBYTE (OUTPUT); \
+ } \
+ } \
+ else
+
+
+ /* Like FETCH_STRING_CHAR_ADVANCE but assumes STRING is multibyte. */
+
+ #define FETCH_STRING_CHAR_ADVANCE_NO_CHECK(OUTPUT, STRING, CHARIDX, BYTEIDX) \
+ if (1) \
+ { \
+ unsigned char *ptr = &XSTRING (STRING)->data[BYTEIDX]; \
+ int len; \
+ \
+ OUTPUT = STRING_CHAR_AND_LENGTH (ptr, 0, len); \
+ BYTEIDX += 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 len; \
+ \
+ OUTPUT= STRING_CHAR_AND_LENGTH (ptr, 0, len); \
+ BYTEIDX += len; \
+ } \
+ else \
+ { \
+ OUTPUT = *(BYTE_POS_ADDR (BYTEIDX)); \
+ BYTEIDX++; \
+ } \
+ } \
+ else
+
+
+ /* Like FETCH_CHAR_ADVANCE but assumes STRING is multibyte. */
+
+ #define FETCH_CHAR_ADVANCE_NO_CHECK(OUTPUT, CHARIDX, BYTEIDX) \
+ if (1) \
+ { \
+ unsigned char *ptr = BYTE_POS_ADDR (BYTEIDX); \
+ int len; \
+ \
+ OUTPUT= STRING_CHAR_AND_LENGTH (ptr, 0, len); \
+ BYTEIDX += len; \
+ CHARIDX++; \
+ } \
+ else
+
+
+ /* Increase the buffer byte position POS_BYTE of the current buffer to
+ the next character boundary. No range checking of POS. */
+
+ #define INC_POS(pos_byte) \
+ do { \
+ unsigned char *p = BYTE_POS_ADDR (pos_byte); \
+ pos_byte += BYTES_BY_CHAR_HEAD (*p); \
+ } while (0)
+
+
+ /* 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; \
+ \
+ pos_byte--; \
+ if (pos_byte < GPT_BYTE) \
+ p = BEG_ADDR + pos_byte - 1; \
+ else \
+ p = BEG_ADDR + GAP_SIZE + pos_byte - 1; \
+ while (!CHAR_HEAD_P (*p)) \
+ { \
+ p--; \
+ pos_byte--; \
+ } \
+ } while (0)
+
+ /* Increment both CHARPOS and BYTEPOS, each in the appropriate way. */
+
+ #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)
+
+
+ /* 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. */
+
+ #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)
+
+
+ /* 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; \
+ pos_byte--; \
+ if (pos_byte < BUF_GPT_BYTE (buf)) \
+ p = BUF_BEG_ADDR (buf) + pos_byte - 1; \
+ else \
+ p = BUF_BEG_ADDR (buf) + BUF_GAP_SIZE (buf) + pos_byte - 1; \
+ while (!CHAR_HEAD_P (*p)) \
+ { \
+ p--; \
+ pos_byte--; \
+ } \
+ } while (0)
+
+
+ #define MAYBE_UNIFY_CHAR(c) \
+ if (c > MAX_UNICODE_CHAR \
+ && CHAR_TABLE_P (Vchar_unify_table)) \
+ { \
+ Lisp_Object val; \
+ int unified; \
+ \
+ val = CHAR_TABLE_REF (Vchar_unify_table, c); \
+ if (! NILP (val)) \
+ { \
+ if (SYMBOLP (val)) \
+ { \
+ Funify_charset (val, Qnil, Qnil); \
+ val = CHAR_TABLE_REF (Vchar_unify_table, c); \
+ } \
+ if ((unified = XINT (val)) >= 0) \
+ c = unified; \
+ } \
+ } \
+ else
+
+
+ /* Return the width of ASCII character C. The width is measured by
+ how many columns occupied on the screen when displayed in the
+ current buffer. */
+
+ #define ASCII_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 \
+ : ((NILP (current_buffer->ctl_arrow) ? 4 : 2))))
+
+ /* Return the width of character C. The width is measured by how many
+ columns occupied on the screen when displayed in the current
+ buffer. */
+
+ #define CHAR_WIDTH(c) \
+ (ASCII_CHAR_P (c) \
+ ? ASCII_CHAR_WIDTH (c) \
+ : XINT (CHAR_TABLE_REF (Vchar_width_table, c)))
+
+ extern int char_resolve_modifier_mask P_ ((int));
+ extern int char_string P_ ((int, unsigned char *));
+ extern int string_char P_ ((const unsigned char *,
+ const unsigned char **, int *));
+
+ extern int translate_char P_ ((Lisp_Object, int c));
+ extern int char_printable_p P_ ((int c));
-extern int c_string_width P_ ((unsigned char *, int, int, int *, int *));
++extern void parse_str_as_multibyte P_ ((const unsigned char *, int, int *,
++ int *));
+ extern int parse_str_to_multibyte P_ ((unsigned char *, int));
+ extern int str_as_multibyte P_ ((unsigned char *, int, int, int *));
+ extern int str_to_multibyte P_ ((unsigned char *, int, int));
+ extern int str_as_unibyte P_ ((unsigned char *, int));
+ 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 Lisp_Object Vprintable_chars;
+
+ extern Lisp_Object Qcharacterp, Qauto_fill_chars;
+ extern Lisp_Object Vtranslation_table_vector;
+ extern Lisp_Object Vchar_width_table;
+ extern Lisp_Object Vchar_direction_table;
+ extern Lisp_Object Vchar_unify_table;
+
+ extern Lisp_Object string_escape_byte8 P_ ((Lisp_Object));
+
+ /* 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;
+
+ extern Lisp_Object Vchar_script_table;
+
+ /* 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 character is the typical case. */
+
+ #define BCOPY_SHORT(from, to, len) \
+ do { \
+ int i = len; \
+ unsigned char *from_p = from, *to_p = to; \
+ while (i--) *to_p++ = *from_p++; \
+ } while (0)
+
+ #define DEFSYM(sym, name) \
+ do { (sym) = intern ((name)); staticpro (&(sym)); } while (0)
+
+ #endif /* EMACS_CHARACTER_H */
- /* Basic multilingual character support.
- Copyright (C) 1995, 1997, 1998 Electrotechnical Laboratory, JAPAN.
- Licensed to the Free Software Foundation.
+ /* Basic character set support.
+ Copyright (C) 1995, 97, 98, 2000, 2001 Electrotechnical Laboratory, JAPAN.
- Licensed to the Free Software Foundation.
++ Licensed to the Free Software Foundation.
Copyright (C) 2001 Free Software Foundation, Inc.
- Copyright (C) 2001, 2002
++ Copyright (C) 2003
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, 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 */
+ /* List of all charsets. This variable is used only from Emacs
+ Lisp. */
+ Lisp_Object Vcharset_list;
- /* 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) */
+ /* Hash table that contains attributes of each charset. Keys are
+ charset symbols, and values are vectors of charset attributes. */
+ Lisp_Object Vcharset_hash_table;
- Lisp_Object Qcharset_table;
+ /* Table of struct charset. */
+ struct charset *charset_table;
- /* A char-table containing information of each character set. */
- Lisp_Object Vcharset_table;
+ static int charset_table_size;
+ int charset_table_used;
- /* 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;
+ Lisp_Object Qcharsetp;
- /* A list of charset symbols ever defined. */
- Lisp_Object Vcharset_list;
+ /* Special charset symbols. */
+ Lisp_Object Qascii;
+ Lisp_Object Qeight_bit;
+ Lisp_Object Qiso_8859_1;
+ Lisp_Object Qunicode;
- /* Vector of translation table ever defined.
- ID of a translation table is used to index this vector. */
- Lisp_Object Vtranslation_table_vector;
+ /* The corresponding charsets. */
+ int charset_ascii;
+ int charset_eight_bit;
+ int charset_iso_8859_1;
+ int charset_unicode;
- /* A char-table for characters which may invoke auto-filling. */
- Lisp_Object Vauto_fill_chars;
+ /* The other special charsets. */
+ int charset_jisx0201_roman;
+ int charset_jisx0208_1978;
+ int charset_jisx0208;
- Lisp_Object Qauto_fill_chars;
+ /* Value of charset attribute `charset-iso-plane'. */
+ Lisp_Object Qgl, Qgr;
- /* 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];
+ /* Charset of unibyte characters. */
+ int charset_unibyte;
- /* Mapping table from ISO2022's charset (specified by DIMENSION,
- CHARS, and FINAL-CHAR) to Emacs' charset. */
- int iso_charset_table[2][2][128];
+ /* List of charsets ordered by the priority. */
+ Lisp_Object Vcharset_ordered_list;
- /* Variables used locally in the macro FETCH_MULTIBYTE_CHAR. */
- unsigned char *_fetch_multibyte_char_p;
- int _fetch_multibyte_char_len;
+ /* 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;
- /* Offset to add to a non-ASCII value when inserting it. */
- EMACS_INT nonascii_insert_offset;
+ /* List of iso-2022 charsets. */
+ Lisp_Object Viso_2022_charset_list;
- /* Translation table for converting non-ASCII unibyte characters
- to multibyte codes, or nil. */
- Lisp_Object Vnonascii_translation_table;
+ /* 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_directory;
+
+ 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: 0%o, %d, 0x%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;
+
+ 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;
+ }
- /* For Meta, Shift, and Control modifiers, we need special care. */
- if (c & CHAR_META)
+ 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));
- CHAR_TABLE_SET (table, from_c, make_number (code));
++ 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));
- CHAR_TABLE_SET (table, from_c, make_number (from_index));
++ 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))
+
+ if (control_flag < 2)
{
- 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)
+ 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;
++ 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.
+ /* Read a hexadecimal number (preceded by "0x") from the file FP while
+ paying attention to comment charcter '#'. */
- Use macro `CHAR_STRING (C, STR)' instead of calling this function
- directly if C can be an ASCII character. */
-
- 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 (Fcons (Vcharset_map_directory, Qnil), mapfile, suffixes,
- NULL, 0);
++ 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 iff 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;
- /* 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)) */
+ if ((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++;
+ }
- int
- multibyte_char_to_unibyte (c, rev_tbl)
- int c;
- Lisp_Object rev_tbl;
+ load_charset_map (charset, head, n_entries, control_flag);
+ }
+
+ 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)
+ Lisp_Object range;
+ int partial;
+
- if (CHARSET_METHOD (charset) == CHARSET_METHOD_MAP_DEFERRED)
++ if (CHARSET_METHOD (charset) == CHARSET_METHOD_MAP_DEFERRED)
+ load_charset (charset);
+
+ partial = (from > CHARSET_MIN_CODE (charset)
+ || to < CHARSET_MAX_CODE (charset));
+
+ if (CHARSET_UNIFIED_P (charset)
+ && CHAR_TABLE_P (CHARSET_DEUNIFIER (charset)))
{
- /* 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;
+ map_char_table_for_charset (c_function, function,
+ CHARSET_DEUNIFIER (charset), arg,
+ partial ? charset : NULL, from, to);
}
- else
+
+ if (CHARSET_METHOD (charset) == CHARSET_METHOD_OFFSET)
{
- /* 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);
+ 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) (range, arg);
+ else
+ call2 (function, range, arg);
}
-
- 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;
-
- {
- /* 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)))
+ else if (CHARSET_METHOD (charset) == CHARSET_METHOD_MAP)
+ {
+ if (! CHAR_TABLE_P (CHARSET_ENCODER (charset)))
+ return;
+ if (CHARSET_ASCII_COMPATIBLE_P (charset) && from <= 127)
{
- 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);
- }
+ range = Fcons (make_number (from), make_number (to));
+ if (to >= 128)
+ XSETCAR (range, make_number (127));
- if (charset != CHARSET_ASCII && charset != CHARSET_8_BIT_GRAPHIC
- && charset < MIN_CHARSET_PRIVATE_DIMENSION1)
+ if (NILP (function))
+ (*c_function) (range, arg);
+ else
+ call2 (function, range, arg);
+ }
+ 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)
{
- bytes_by_char_head[leading_code_base] = bytes;
- width_by_char_head[leading_code_base] = XINT (width);
-
- /* 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));
+ 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, from, 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 targer characters. */)
++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);
}
+ map_charset_chars (NULL, function, arg, cs, from, to);
+ return Qnil;
+ }
- for (charset = from; charset < to; charset++)
- if (!CHARSET_DEFINED_P (charset)) break;
- return make_number (charset < to ? charset : 0);
- }
+ /* 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. */
- 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;
+ 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;
{
- Lisp_Object *vec;
-
- if (!NILP (charset_id))
- CHECK_NUMBER (charset_id);
- CHECK_SYMBOL (charset_symbol);
- CHECK_VECTOR (info_vector);
+ /* 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;
+ }
- if (! NILP (charset_id))
+ val = args[charset_arg_dimension];
+ if (NILP (val))
+ charset.dimension = dimension;
+ else
{
- 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));
+ 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));
}
- 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.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)))));
+
+ if (! charset.code_linear_p)
{
- 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)));
+ 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);
}
- 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 ();
- return Qnil;
- }
+ charset.iso_chars_96 = charset.code_space[2] == 96;
- 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;
- }
+ 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;
- DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char,
- Sget_unused_iso_final_char, 2, 2, 0,
- doc: /* Return an unsed ISO's 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.
+ val = args[charset_arg_min_code];
+ if (! NILP (val))
+ {
+ unsigned code;
- 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;
+ if (INTEGERP (val))
+ code = XINT (val);
+ else
+ {
+ CHECK_CONS (val);
- CHECK_NUMBER (XCAR (val));
- CHECK_NUMBER (XCDR (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;
+ }
- 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_max_code];
+ if (! NILP (val))
{
- if (ISO_CHARSET_TABLE (dimension, chars, make_number (final_char)) < 0)
- break;
+ unsigned code;
+
+ if (INTEGERP (val))
+ code = XINT (val);
+ else
+ {
+ CHECK_CONS (val);
- CHECK_NUMBER (XCAR (val));
- CHECK_NUMBER (XCDR (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;
}
- return (final_char <= '?' ? make_number (final_char) : Qnil);
- }
- DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset, Sdeclare_equiv_charset,
- 4, 4, 0,
- doc: /* Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.
- CHARSET should be defined by `defined-charset' in advance. */)
- (dimension, chars, final_char, charset_symbol)
- Lisp_Object dimension, chars, final_char, charset_symbol;
- {
- int charset;
+ charset.compact_codes_p = charset.max_code < 0x1000000;
- CHECK_NUMBER (dimension);
- CHECK_NUMBER (chars);
- CHECK_NUMBER (final_char);
- CHECK_SYMBOL (charset_symbol);
+ val = args[charset_arg_invalid_code];
+ if (NILP (val))
+ {
+ if (charset.min_code > 0)
+ charset.invalid_code = 0;
+ else
+ {
+ 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);
+ }
- 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 = get_charset_id (charset_symbol)) < 0)
- error ("Invalid charset %s", SDATA (SYMBOL_NAME (charset_symbol)));
+ 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);
+ }
-
+
- ISO_CHARSET_TABLE (dimension, chars, final_char) = charset;
- return Qnil;
- }
+ 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);
+ }
- /* Return information about charsets in the text at PTR of NBYTES
- bytes, which are NCHARS characters. The value is:
+ val = args[charset_arg_emacs_mule_id];
+ if (NILP (val))
+ charset.emacs_mule_id = -1;
+ else
+ {
+ 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);
+ }
- 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.
+ charset.ascii_compatible_p = ! NILP (args[charset_arg_ascii_compatible_p]);
- 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.supplementary_p = ! NILP (args[charset_arg_supplementary_p]);
- int
- find_charset_in_text (ptr, nchars, nbytes, charsets, table)
- const unsigned char *ptr;
- int nchars, nbytes, *charsets;
- Lisp_Object table;
- {
- if (nchars == nbytes)
+ charset.unified_p = 0;
+
+ bzero (charset.fast_map, sizeof (charset.fast_map));
+
+ 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);
+ }
+ 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]))
{
- if (charsets && nbytes > 0)
+ 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))
{
- const unsigned char *endp = ptr + nbytes;
- int maskbits = 0;
+ Lisp_Object elt, car_part, cdr_part;
+ int this_id, offset;
+ struct charset *this_charset;
- while (ptr < endp && maskbits != 7)
+ elt = Fcar (val);
+ if (CONSP (elt))
{
- maskbits |= (*ptr < 0x80 ? 1 : *ptr < 0xA0 ? 2 : 4);
- ptr++;
+ car_part = XCAR (elt);
+ cdr_part = XCDR (elt);
+ CHECK_CHARSET_GET_ID (car_part, this_id);
+ CHECK_NUMBER (cdr_part);
+ offset = XINT (cdr_part);
}
-
- 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;
+ 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];
}
- return 0;
}
else
- {
- int return_val = 1;
- int bytes, charset, c1, c2;
+ error ("None of :code-offset, :map, :parents are specified");
- if (! CHAR_TABLE_P (table))
- table = Qnil;
+ val = args[charset_arg_unify_map];
+ if (! NILP (val) && !STRINGP (val))
+ CHECK_VECTOR (val);
+ ASET (attrs, charset_unify_map, val);
- while (nchars-- > 0)
- {
- SPLIT_MULTIBYTE_SEQ (ptr, len, bytes, charset, c1, c2);
- ptr += bytes;
+ CHECK_LIST (args[charset_arg_plist]);
+ ASET (attrs, charset_plist, args[charset_arg_plist]);
- 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.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;
+ }
- 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;
+ ASET (attrs, charset_id, make_number (id));
+ charset.id = id;
+ charset_table[id] = charset;
- if (charsets)
- charsets[charset] = 1;
- else if (return_val == 2)
- break;
+ 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;
+ 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);
- Vcharset_ordered_list = nconc2 (Vcharset_ordered_list,
++ Vcharset_ordered_list = nconc2 (Vcharset_ordered_list,
+ Fcons (make_number (id), Qnil));
+ 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", XSYMBOL (charset)->name->data);
++ error ("Inappropriate unibyte charset: %s", SDATA (SYMBOL_NAME (charset)));
+ charset_unibyte = cs->id;
+ for (i = 128; i < 256; i++)
+ {
+ c = DECODE_CHAR (cs, i);
+ unibyte_to_multibyte_table[i] = (c < 0 ? BYTE8_TO_CHAR (i) : c);
+ }
+
+ 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", XSYMBOL (charset)->name->data);
++ 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 unsed 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 a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.
+ CHARSET should be defined by `define-charset' in advance. */)
+ (dimension, chars, final_char, charset)
+ Lisp_Object dimension, chars, final_char, charset;
+ {
+ int id;
+
+ CHECK_CHARSET_GET_ID (charset, id);
+ check_iso_charset_parameter (dimension, chars, final_char);
+
+ ISO_CHARSET_TABLE (XINT (dimension), XINT (chars), 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 = XSTRING (string)->data;
- const unsigned char *endp = p + STRING_BYTES (XSTRING (string));
++ const unsigned char *p = SDATA (string);
++ const unsigned char *endp = p + SBYTES (string);
+ struct charset *charset;
+
- if (XSTRING (string)->size == STRING_BYTES (XSTRING (string)))
++ if (SCHARS (string) == SBYTES (string))
+ return 0;
+
+ charset = CHARSET_FROM_ID (charset_iso_8859_1);
+ while (p < endp)
+ {
+ int c = STRING_CHAR_ADVANCE (p);
+
+ /* Fixme: comparison of unsigned expression < 0 is always false */
+ if (ENCODE_CHAR (charset, c) < 0)
+ return 2;
+ }
+ return 1;
+ }
+
+
+ /* Find charsets in the string at PTR of NCHARS and NBYTES.
+
+ CHARSETS is a vector. Each element is a cons of CHARSET and
+ FOUND-FLAG. CHARSET is a charset id, and FOUND-FLAG is nil or t.
+ FOUND-FLAG t (or nil) means that the corresponding charset is
+ already found (or not yet found).
+
+ It may lookup a translation table TABLE if supplied. */
+
+ static void
+ find_charsets_in_text (ptr, nchars, nbytes, charsets, table)
+ const unsigned char *ptr;
+ int nchars, nbytes;
+ Lisp_Object charsets, table;
+ {
+ const unsigned char *pend = ptr + nbytes;
+ int ncharsets = ASIZE (charsets);
+
+ if (nchars == nbytes)
+ return;
+
+ while (ptr < pend)
+ {
+ int c = STRING_CHAR_ADVANCE (ptr);
+ int i;
+ int all_found = 1;
+ Lisp_Object elt;
+
+ if (!NILP (table))
+ c = translate_char (table, c);
+ for (i = 0; i < ncharsets; i++)
+ {
+ elt = AREF (charsets, i);
+ if (NILP (XCDR (elt)))
+ {
+ struct charset *charset = CHARSET_FROM_ID (XINT (XCAR (elt)));
+
+ if (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset))
- XCDR (elt) = Qt;
++ XSETCDR (elt, Qt);
+ else
+ all_found = 0;
+ }
}
- return return_val;
+ if (all_found)
+ break;
}
}
+ /* Fixme: returns nil for unibyte. */
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];
+ Lisp_Object charsets;
int from, from_byte, to, stop, stop_byte, i;
Lisp_Object val;
from_byte = CHAR_TO_BYTE (from);
- bzero (charsets, (MAX_CHARSET + 1) * sizeof (int));
+ charsets = Fmake_vector (make_number (charset_table_used), Qnil);
+ for (i = 0; i < charset_table_used; i++)
+ ASET (charsets, i, Fcons (make_number (i), 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);
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 (XCDR (AREF (charsets, i))))
+ val = Fcons (CHARSET_NAME (charset_table + i), val);
return val;
}
+ /* Fixme: returns nil for unibyte. */
DEFUN ("find-charset-string", Ffind_charset_string, Sfind_charset_string,
1, 2, 0,
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);
+ for (i = 0; i < charset_table_used; i++)
+ ASET (charsets, i, Fcons (make_number (i), Qnil));
- find_charsets_in_text (XSTRING (str)->data, XSTRING (str)->size,
- STRING_BYTES (XSTRING (str)), charsets, table);
++ find_charsets_in_text (SDATA (str), SCHARS (str), SBYTES (str),
++ charsets, table);
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 (XCDR (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
- {
- CHECK_NUMBER (code1);
- c1 = XINT (code1);
- }
- if (NILP (code2))
- c2 = 0;
- else
+ if (method == CHARSET_METHOD_MAP_DEFERRED)
{
- CHECK_NUMBER (code2);
- c2 = XINT (code2);
+ load_charset (charset);
+ method = CHARSET_METHOD (charset);
}
- if (charset_id == CHARSET_ASCII)
+ if (method == CHARSET_METHOD_SUBSET)
{
- if (c1 < 0 || c1 > 0x7F)
- goto invalid_code_posints;
- return make_number (c1);
- }
- else if (charset_id == CHARSET_8_BIT_CONTROL)
- {
- 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 CHAR.
- If CHAR is invalid as a character code,
- return a list of symbol `unknown' and CHAR. */)
- (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 CHAR. */)
- (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 iff C is a valid normal or
- generic character. If GENERICP is zero, return nonzero iff 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 CHAR. */)
- (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 CHAR 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 (XCAR (code_point));
- CHECK_NATNUM (XCDR (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;
+
+ CHECK_CHARSET_GET_ID (charset, id);
+ charsetp = CHARSET_FROM_ID (id);
- while (i_byte < len)
+ 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);
- 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 = STRING_CHAR_AND_LENGTH (str + i_byte, len - i_byte, bytes);
+ 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;
- 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;
- PARSE_MULTIBYTE_SEQ (str + i_byte, len_byte - i_byte, bytes);
- 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. */)
- (str)
- Lisp_Object str;
+
+ /* Fixme: `unknown' can't happen now? */
+ DEFUN ("split-char", Fsplit_char, Ssplit_char, 1, 1, 0,
+ doc: /*Return list of charset and one to three position-codes of CHAR.
+ If CHAR is invalid as a character code, return a list `(unknown CHAR)'. */)
+ (ch)
+ Lisp_Object ch;
{
+ struct charset *charset;
+ int c, dimension;
+ unsigned code;
Lisp_Object val;
- CHECK_STRING (str);
- XSETFASTINT (val, lisp_string_width (str, -1, NULL, NULL));
- return val;
+ CHECK_CHARACTER (ch);
+ c = XFASTINT (ch);
+ charset = CHAR_CHARSET (c);
+ if (! charset)
+ return Fcons (intern ("unknown"), Fcons (ch, Qnil));
-
++
+ code = ENCODE_CHAR (charset, c);
+ if (code == CHARSET_INVALID_CODE (charset))
+ abort ();
+ dimension = CHARSET_DIMENSION (charset);
+ val = (dimension == 1 ? Fcons (make_number (code), Qnil)
+ : dimension == 2 ? Fcons (make_number (code >> 8),
+ Fcons (make_number (code & 0xFF), Qnil))
+ : Fcons (make_number (code >> 16),
+ Fcons (make_number ((code >> 8) & 0xFF),
+ Fcons (make_number (code & 0xFF), Qnil))));
+ return Fcons (CHARSET_NAME (charset), val);
}
- DEFUN ("char-direction", Fchar_direction, Schar_direction, 1, 1, 0,
- doc: /* Return the direction of CHAR.
- The returned value is 0 for left-to-right and 1 for right-to-left. */)
+
+ DEFUN ("char-charset", Fchar_charset, Schar_charset, 1, 1, 0,
+ doc: /* Return the charset of highest priority that contains CHAR. */)
(ch)
Lisp_Object ch;
{
- int charset;
+ struct charset *charset;
- 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);
+ charset = CHAR_CHARSET (XINT (ch));
+ return (CHARSET_NAME (charset));
}
- DEFUN ("chars-in-region", Fchars_in_region, Schars_in_region, 2, 2, 0,
- doc: /* Return number of characters between BEG and END. */)
- (beg, end)
- Lisp_Object beg, end;
- {
- int from, to;
-
- CHECK_NUMBER_COERCE_MARKER (beg);
- CHECK_NUMBER_COERCE_MARKER (end);
- from = min (XFASTINT (beg), XFASTINT (end));
- to = max (XFASTINT (beg), XFASTINT (end));
+ 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;
+ struct charset *charset;
- return make_number (to - from);
+ ch = Fchar_after (pos);
+ if (! INTEGERP (ch))
+ return 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.
- 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 ("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;
{
- /* current_buffer is null at early stages of Emacs initialization. */
- if (current_buffer == 0
- || NILP (current_buffer->enable_multibyte_characters))
- return nbytes;
+ int id;
- return multibyte_chars_in_text (ptr, nbytes);
+ check_iso_charset_parameter (dimension, chars, final_char);
+ id = ISO_CHARSET_TABLE (XFASTINT (dimension), XFASTINT (chars),
+ XFASTINT (final_char));
+ return (id >= 0 ? CHARSET_NAME (CHARSET_FROM_ID (id)) : Qnil);
}
- /* 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 ("clear-charset-maps", Fclear_charset_maps, Sclear_charset_maps,
+ 0, 0, 0,
+ doc: /*
+ Clear encoder and decoder of charsets that are loaded from mapfiles. */)
+ ()
{
- const unsigned char *endp;
- int chars, bytes;
-
- endp = ptr + nbytes;
- chars = 0;
+ int i;
+ struct charset *charset;
+ Lisp_Object attrs;
- while (ptr < endp)
+ for (i = 0; i < charset_table_used; i++)
{
- PARSE_MULTIBYTE_SEQ (ptr, endp - ptr, bytes);
- ptr += bytes;
- chars++;
- }
+ charset = CHARSET_FROM_ID (i);
+ attrs = CHARSET_ATTRIBUTES (charset);
- return chars;
- }
-
- /* 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;
- {
- const unsigned char *endp = str + len;
- int n, chars = 0, bytes = 0;
+ if (CHARSET_METHOD (charset) == CHARSET_METHOD_MAP)
+ {
+ CHARSET_ATTR_DECODER (attrs) = Qnil;
+ CHARSET_ATTR_ENCODER (attrs) = Qnil;
+ CHARSET_METHOD (charset) = CHARSET_METHOD_MAP_DEFERRED;
+ }
- while (str < endp)
- {
- if (UNIBYTE_STR_AS_MULTIBYTE_P (str, endp - str, n))
- str += n, bytes += n;
- else
- str++, bytes += 2;
- chars++;
+ if (CHARSET_UNIFIED_P (charset))
+ CHARSET_ATTR_DEUNIFIER (attrs) = Qnil;
}
- *nchars = chars;
- *nbytes = bytes;
- return;
- }
-
- /* 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;
- {
- 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)
+ if (CHAR_TABLE_P (Vchar_unified_charset_table))
{
- if (UNIBYTE_STR_AS_MULTIBYTE_P (p, endp - p, n))
- {
- while (n--)
- *to++ = *p++;
- }
- else
- {
- *to++ = LEADING_CODE_8_BIT_CONTROL;
- *to++ = *p++ + 0x20;
- }
- chars++;
+ Foptimize_char_table (Vchar_unified_charset_table);
+ Vchar_unify_table = Vchar_unified_charset_table;
+ Vchar_unified_charset_table = Qnil;
}
- 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;
+ return Qnil;
}
- /* 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. */
-
- int
- str_to_multibyte (str, len, bytes)
- unsigned char *str;
- int len, 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;
-
- 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 (*p < 0x80 || *p >= 0xA0)
- *to++ = *p++;
- else
- *to++ = LEADING_CODE_8_BIT_CONTROL, *to++ = *p++ + 0x20;
- }
- 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. */
+ Lisp_Object val = Qnil, list = Vcharset_ordered_list;
- int
- str_as_unibyte (str, bytes)
- unsigned char *str;
- int bytes;
- {
- unsigned char *p = str, *endp = str + bytes;
- unsigned char *to = str;
+ if (!NILP (highestp))
+ return CHARSET_NAME (CHARSET_FROM_ID (XINT (Fcar (list))));
- while (p < endp && *p != LEADING_CODE_8_BIT_CONTROL) p++;
- to = p;
- while (p < endp)
+ 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;
- unsigned char *buf = (unsigned char *) alloca (MAX_MULTIBYTE_LENGTH * n);
- unsigned char *p = buf;
- int c;
- int multibyte = 0;
+ Lisp_Object new_head, old_list, arglist[2];
+ 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, new_head = 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)))
+ new_head = Fcons (XCAR (old_list), new_head);
}
+ Viso_2022_charset_list = Fnreverse (new_head);
- return make_string_from_bytes (buf, n, p - buf);
+ 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;
+ int id;
- val= Fget (intern (charset_name), Qcharset);
- if (!VECTORP (val))
- error ("Charset %s is not defined", charset_name);
-
- 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");
- return 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);
+ char *p;
+
+ 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");
+
+ p = (char *) xmalloc (30000);
+
+ 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);
- Vcharset_hash_table = Fmakehash (Qeq);
++ {
++ 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 (&Schars_in_region);
- 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-directory", &Vcharset_map_directory,
+ doc: /* Directory of charset map files that come with GNU Emacs.
+ The default value is sub-directory "charsets" of `data-directory'. */);
+ Vcharset_map_directory = Fexpand_file_name (build_string ("charsets"),
+ Vdata_directory);
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) 1995, 1997, 1998 Electrotechnical Laboratory, JAPAN.
-- Licensed to the Free Software Foundation.
++ Licensed to the Free Software Foundation.
Copyright (C) 2001 Free Software Foundation, Inc.
- Copyright (C) 2001, 2002
++ Copyright (C) 2003
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
#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) */
-
- /* 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) < 0x100)
-
- /* 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 character code in the charset to
+ the corresponding Unicode character. */
+ 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 iff C is a valid normal or
- generic character. If GENERICP is zero, return nonzero iff 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) \
- do { \
- int i = 1; \
- while (i < (length) && ! CHAR_HEAD_P ((str)[i])) i++; \
- (bytes) = BYTES_BY_CHAR_HEAD ((str)[0]); \
- if ((bytes) > i) \
- abort (); \
- } while (0)
+ /* 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];
- #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 iff 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 iff 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 iff 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)); \
- } while (0)
+ /* 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 P is after LIMIT, advance P to the previous character boundary.
- It assumes that P is already at a character boundary of the sane
- mulitbyte form whose beginning address is LIMIT. */
+ /* 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;
- #define PREV_CHAR_BOUNDARY(p, limit) \
- do { \
- if ((p) > (limit)) \
- { \
- const unsigned char *p0 = (p); \
- do { \
- p0--; \
- } while (p0 >= limit && ! CHAR_HEAD_P (*p0)); \
- (p) = (BYTES_BY_CHAR_HEAD (*p0) == (p) - p0) ? p0 : (p) - 1; \
- } \
- } while (0)
+ /* 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;
- #ifdef emacs
+ /* 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 iff the charset is compatible with ASCII. */
+ int ascii_compatible_p;
- /* 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. */
+ /* Nonzero iff the charset is supplementary. */
+ int supplementary_p;
+
+ /* Nonzero iff 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;
+ extern int charset_table_used;
+
+ #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 iff 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 { \
+ if (! SYMBOLP (x) || CHARSET_SYMBOL_HASH_INDEX (x) < 0) \
+ x = wrong_type_argument (Qcharsetp, (x)); \
+ } while (0)
- #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++; \
+ /* 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)
- #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); \
+ /* 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 (!SYMBOLP (x) || NILP (attr = CHARSET_SYMBOL_ATTRIBUTES (x))) \
+ x = wrong_type_argument (Qcharsetp, (x)); \
} while (0)
- #endif /* not BYTE_COMBINING_DEBUG */
- /* 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; \
- } \
+ #define CHECK_CHARSET_GET_CHARSET(x, charset) \
+ do { \
+ int id; \
+ CHECK_CHARSET_GET_ID (x, id); \
+ charset = CHARSET_FROM_ID (id); \
} while (0)
- /* Increment both CHARPOS and BYTEPOS, each in the appropriate way. */
- #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)
+ /* Lookup Vcharset_order_list and return the first charset that
+ contains the character C. */
+ #define CHAR_CHARSET(c) \
+ char_charset ((c), Qnil, NULL)
- /* 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. */
+ #if 0
+ /* Char-table of charset-sets. Each element is a bool vector indexed
+ by a charset ID. */
+ extern Lisp_Object Vchar_charset_set;
- #ifdef BYTE_COMBINING_DEBUG
+ /* Charset-bag of character C. */
+ #define CHAR_CHARSET_SET(c) \
+ CHAR_TABLE_REF (Vchar_charset_set, c)
- #define BUF_INC_POS(buf, pos_byte) \
+ /* 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)))
+
+
+ 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 */
+
+ /* 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];
+
+ /* 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)]
+
+ /* Nonzero iff 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 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 iff CHARSET may contain the character C. */
+ #define CHAR_CHARSET_P(c, charset) \
+ ((ASCII_CHAR_P (c) && (charset)->ascii_compatible_p) \
+ || (CHARSET_UNIFIED_P (charset) \
+ ? 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));
-
- 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_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 */
--- /dev/null
- Copyright (C) 2001, 2002
+ /* chartab.c -- char-table support
-}
++ 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
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ GNU Emacs is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GNU Emacs; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+ #include <config.h>
+ #include "lisp.h"
+ #include "character.h"
+ #include "charset.h"
+ #include "ccl.h"
+
+ /* 64/16/32/128 */
+
+ /* Number of elements in Nth level char-table. */
+ const int chartab_size[4] =
+ { (1 << CHARTAB_SIZE_BITS_0),
+ (1 << CHARTAB_SIZE_BITS_1),
+ (1 << CHARTAB_SIZE_BITS_2),
+ (1 << CHARTAB_SIZE_BITS_3) };
+
+ /* Number of characters each element of Nth level char-table
+ covers. */
+ const int chartab_chars[4] =
+ { (1 << (CHARTAB_SIZE_BITS_1 + CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3)),
+ (1 << (CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3)),
+ (1 << CHARTAB_SIZE_BITS_3),
+ 1 };
+
+ /* Number of characters (in bits) each element of Nth level char-table
+ covers. */
+ const int chartab_bits[4] =
+ { (CHARTAB_SIZE_BITS_1 + CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3),
+ (CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3),
+ CHARTAB_SIZE_BITS_3,
+ 0 };
+
+ #define CHARTAB_IDX(c, depth, min_char) \
+ (((c) - (min_char)) >> chartab_bits[(depth)])
+
+
+ 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. If it has a `char-table-extra-slots'
+ property, the property's value should be an integer between 0 and 10
+ that specifies how many extra slots the char-table has. Otherwise,
+ the char-table has no extra slot. */)
+ (purpose, init)
+ register Lisp_Object purpose, init;
+ {
+ Lisp_Object vector;
+ Lisp_Object n;
+ int n_extras;
+ int size;
+
+ CHECK_SYMBOL (purpose);
+ n = Fget (purpose, Qchar_table_extra_slots);
+ if (NILP (n))
+ n_extras = 0;
+ else
+ {
+ CHECK_NATNUM (n);
+ n_extras = XINT (n);
+ if (n_extras > 10)
+ args_out_of_range (n, Qnil);
+ }
+
+ size = VECSIZE (struct Lisp_Char_Table) - 1 + n_extras;
+ vector = Fmake_vector (make_number (size), init);
+ XCHAR_TABLE (vector)->parent = Qnil;
+ XCHAR_TABLE (vector)->purpose = purpose;
+ XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
+ return vector;
+ }
+
+ static Lisp_Object
+ make_sub_char_table (depth, min_char, defalt)
+ int depth, min_char;
+ Lisp_Object defalt;
+ {
+ Lisp_Object table;
+ int size = VECSIZE (struct Lisp_Sub_Char_Table) - 1 + chartab_size[depth];
+
+ table = Fmake_vector (make_number (size), defalt);
+ XSUB_CHAR_TABLE (table)->depth = make_number (depth);
+ XSUB_CHAR_TABLE (table)->min_char = make_number (min_char);
+ XSETSUB_CHAR_TABLE (table, XSUB_CHAR_TABLE (table));
+
+ return table;
+ }
+
+ static Lisp_Object
+ char_table_ascii (table)
+ Lisp_Object table;
+ {
+ Lisp_Object sub;
+
+ sub = XCHAR_TABLE (table)->contents[0];
+ if (! SUB_CHAR_TABLE_P (sub))
+ return sub;
+ sub = XSUB_CHAR_TABLE (sub)->contents[0];
+ if (! SUB_CHAR_TABLE_P (sub))
+ return sub;
+ return XSUB_CHAR_TABLE (sub)->contents[0];
+ }
+
+ Lisp_Object
+ copy_sub_char_table (table)
+ Lisp_Object table;
+ {
+ Lisp_Object copy;
+ int depth = XINT (XSUB_CHAR_TABLE (table)->depth);
+ int min_char = XINT (XSUB_CHAR_TABLE (table)->min_char);
+ Lisp_Object val;
+ int i;
+
+ copy = make_sub_char_table (depth, min_char, Qnil);
+ /* Recursively copy any sub char-tables. */
+ for (i = 0; i < chartab_size[depth]; i++)
+ {
+ val = XSUB_CHAR_TABLE (table)->contents[i];
+ if (SUB_CHAR_TABLE_P (val))
+ XSUB_CHAR_TABLE (copy)->contents[i] = copy_sub_char_table (val);
+ else
+ XSUB_CHAR_TABLE (copy)->contents[i] = val;
+ }
+
+ return copy;
+ }
+
+
+ Lisp_Object
+ copy_char_table (table)
+ Lisp_Object table;
+ {
+ Lisp_Object copy;
+ int size = XCHAR_TABLE (table)->size & PSEUDOVECTOR_SIZE_MASK;
+ int i;
+
+ copy = Fmake_vector (make_number (size), Qnil);
+ XCHAR_TABLE (copy)->defalt = XCHAR_TABLE (table)->defalt;
+ XCHAR_TABLE (copy)->parent = XCHAR_TABLE (table)->parent;
+ XCHAR_TABLE (copy)->purpose = XCHAR_TABLE (table)->purpose;
+ XCHAR_TABLE (copy)->ascii = XCHAR_TABLE (table)->ascii;
+ for (i = 0; i < chartab_size[0]; i++)
+ XCHAR_TABLE (copy)->contents[i]
+ = (SUB_CHAR_TABLE_P (XCHAR_TABLE (table)->contents[i])
+ ? copy_sub_char_table (XCHAR_TABLE (table)->contents[i])
+ : XCHAR_TABLE (table)->contents[i]);
+ if (SUB_CHAR_TABLE_P (XCHAR_TABLE (copy)->ascii))
+ XCHAR_TABLE (copy)->ascii = char_table_ascii (copy);
+ size -= VECSIZE (struct Lisp_Char_Table) - 1;
+ for (i = 0; i < size; i++)
+ XCHAR_TABLE (copy)->extras[i] = XCHAR_TABLE (table)->extras[i];
+
+ XSETCHAR_TABLE (copy, XCHAR_TABLE (copy));
+ return copy;
+ }
+
+ Lisp_Object
+ sub_char_table_ref (table, c)
+ Lisp_Object table;
+ int c;
+ {
+ struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
+ int depth = XINT (tbl->depth);
+ int min_char = XINT (tbl->min_char);
+ Lisp_Object val;
+
+ val = tbl->contents[CHARTAB_IDX (c, depth, min_char)];
+ if (SUB_CHAR_TABLE_P (val))
+ val = sub_char_table_ref (val, c);
+ return val;
+ }
+
+ Lisp_Object
+ char_table_ref (table, c)
+ Lisp_Object table;
+ int c;
+ {
+ struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
+ Lisp_Object val;
+
+ if (ASCII_CHAR_P (c))
+ {
+ val = tbl->ascii;
+ if (SUB_CHAR_TABLE_P (val))
+ val = XSUB_CHAR_TABLE (val)->contents[c];
+ }
+ else
+ {
+ val = tbl->contents[CHARTAB_IDX (c, 0, 0)];
+ if (SUB_CHAR_TABLE_P (val))
+ val = sub_char_table_ref (val, c);
+ }
+ if (NILP (val))
+ {
+ val = tbl->defalt;
+ if (NILP (val) && CHAR_TABLE_P (tbl->parent))
+ val = char_table_ref (tbl->parent, c);
+ }
+ return val;
-
++}
+
+ static Lisp_Object
+ sub_char_table_ref_and_range (table, c, from, to, defalt)
+ Lisp_Object table;
+ int c;
+ int *from, *to;
+ Lisp_Object defalt;
+ {
+ struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
+ int depth = XINT (tbl->depth);
+ int min_char = XINT (tbl->min_char);
+ int max_char = min_char + chartab_chars[depth - 1] - 1;
+ int index = CHARTAB_IDX (c, depth, min_char);
+ Lisp_Object val;
-
++
+ val = tbl->contents[index];
+ *from = min_char + index * chartab_chars[depth];
+ *to = *from + chartab_chars[depth] - 1;
+ if (SUB_CHAR_TABLE_P (val))
+ val = sub_char_table_ref_and_range (val, c, from, to, defalt);
+ else if (NILP (val))
+ val = defalt;
+
+ while (*from > min_char
+ && *from == min_char + index * chartab_chars[depth])
+ {
+ Lisp_Object this_val;
+ int this_from = *from - chartab_chars[depth];
+ int this_to = *from - 1;
+
+ index--;
+ this_val = tbl->contents[index];
+ if (SUB_CHAR_TABLE_P (this_val))
+ this_val = sub_char_table_ref_and_range (this_val, this_to,
+ &this_from, &this_to,
+ defalt);
+ else if (NILP (this_val))
+ this_val = defalt;
+
+ if (! EQ (this_val, val))
+ break;
+ *from = this_from;
+ }
+ index = CHARTAB_IDX (c, depth, min_char);
+ while (*to < max_char
+ && *to == min_char + (index + 1) * chartab_chars[depth] - 1)
+ {
+ Lisp_Object this_val;
+ int this_from = *to + 1;
+ int this_to = this_from + chartab_chars[depth] - 1;
+
+ index++;
+ this_val = tbl->contents[index];
+ if (SUB_CHAR_TABLE_P (this_val))
+ this_val = sub_char_table_ref_and_range (this_val, this_from,
+ &this_from, &this_to,
+ defalt);
+ else if (NILP (this_val))
+ this_val = defalt;
+ if (! EQ (this_val, val))
+ break;
+ *to = this_to;
+ }
+
+ return val;
+ }
+
+
+ /* Return the value for C in char-table TABLE. Set *FROM and *TO to
+ the range of characters (containing C) that have the same value as
+ C. It is not assured that the value of (*FROM - 1) and (*TO + 1)
+ is different from that of C. */
+
+ Lisp_Object
+ char_table_ref_and_range (table, c, from, to)
+ Lisp_Object table;
+ int c;
+ int *from, *to;
+ {
+ struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
+ int index = CHARTAB_IDX (c, 0, 0);
+ Lisp_Object val;
+
+ val = tbl->contents[index];
+ *from = index * chartab_chars[0];
+ *to = *from + chartab_chars[0] - 1;
+ if (SUB_CHAR_TABLE_P (val))
+ val = sub_char_table_ref_and_range (val, c, from, to, tbl->defalt);
+ else if (NILP (val))
+ val = tbl->defalt;
+
+ while (*from > 0 && *from == index * chartab_chars[0])
+ {
+ Lisp_Object this_val;
+ int this_from = *from - chartab_chars[0];
+ int this_to = *from - 1;
+
+ index--;
+ this_val = tbl->contents[index];
+ if (SUB_CHAR_TABLE_P (this_val))
+ this_val = sub_char_table_ref_and_range (this_val, this_to,
+ &this_from, &this_to,
+ tbl->defalt);
+ else if (NILP (this_val))
+ this_val = tbl->defalt;
+
+ if (! EQ (this_val, val))
+ break;
+ *from = this_from;
+ }
+ while (*to < MAX_CHAR && *to == (index + 1) * chartab_chars[0] - 1)
+ {
+ Lisp_Object this_val;
+ int this_from = *to + 1;
+ int this_to = this_from + chartab_chars[0] - 1;
+
+ index++;
+ this_val = tbl->contents[index];
+ if (SUB_CHAR_TABLE_P (this_val))
+ this_val = sub_char_table_ref_and_range (this_val, this_from,
+ &this_from, &this_to,
+ tbl->defalt);
+ else if (NILP (this_val))
+ this_val = tbl->defalt;
+ if (! EQ (this_val, val))
+ break;
+ *to = this_to;
+ }
+
+ return val;
+ }
+
+
+ #define ASET_RANGE(ARRAY, FROM, TO, LIMIT, VAL) \
+ do { \
+ int limit = (TO) < (LIMIT) ? (TO) : (LIMIT); \
+ for (; (FROM) < limit; (FROM)++) (ARRAY)->contents[(FROM)] = (VAL); \
+ } while (0)
+
+ #define GET_SUB_CHAR_TABLE(TABLE, SUBTABLE, IDX, DEPTH, MIN_CHAR) \
+ do { \
+ (SUBTABLE) = (TABLE)->contents[(IDX)]; \
+ if (!SUB_CHAR_TABLE_P (SUBTABLE)) \
+ (SUBTABLE) = make_sub_char_table ((DEPTH), (MIN_CHAR), (SUBTABLE)); \
+ } while (0)
+
+
+ static void
+ sub_char_table_set (table, c, val)
+ Lisp_Object table;
+ int c;
+ Lisp_Object val;
+ {
+ struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
+ int depth = XINT ((tbl)->depth);
+ int min_char = XINT ((tbl)->min_char);
+ int i = CHARTAB_IDX (c, depth, min_char);
+ Lisp_Object sub;
- CHECK_CHARACTER (XCAR (range));
- CHECK_CHARACTER (XCDR (range));
++
+ if (depth == 3)
+ tbl->contents[i] = val;
+ else
+ {
+ sub = tbl->contents[i];
+ if (! SUB_CHAR_TABLE_P (sub))
+ {
+ sub = make_sub_char_table (depth + 1,
+ min_char + i * chartab_chars[depth], sub);
+ tbl->contents[i] = sub;
+ }
+ sub_char_table_set (sub, c, val);
+ }
+ }
+
+ Lisp_Object
+ char_table_set (table, c, val)
+ Lisp_Object table;
+ int c;
+ Lisp_Object val;
+ {
+ struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
+
+ if (ASCII_CHAR_P (c)
+ && SUB_CHAR_TABLE_P (tbl->ascii))
+ {
+ XSUB_CHAR_TABLE (tbl->ascii)->contents[c] = val;
+ }
+ else
+ {
+ int i = CHARTAB_IDX (c, 0, 0);
+ Lisp_Object sub;
+
+ sub = tbl->contents[i];
+ if (! SUB_CHAR_TABLE_P (sub))
+ {
+ sub = make_sub_char_table (1, i * chartab_chars[0], sub);
+ tbl->contents[i] = sub;
+ }
+ sub_char_table_set (sub, c, val);
+ if (ASCII_CHAR_P (c))
+ tbl->ascii = char_table_ascii (table);
+ }
+ return val;
+ }
+
+ static void
+ sub_char_table_set_range (table, depth, min_char, from, to, val)
+ Lisp_Object *table;
+ int depth;
+ int min_char;
+ int from, to;
+ Lisp_Object val;
+ {
+ int max_char = min_char + chartab_chars[depth] - 1;
+
+ if (depth == 3 || (from <= min_char && to >= max_char))
+ *table = val;
+ else
+ {
+ int i, j;
+
+ depth++;
+ if (! SUB_CHAR_TABLE_P (*table))
+ *table = make_sub_char_table (depth, min_char, *table);
+ if (from < min_char)
+ from = min_char;
+ if (to > max_char)
+ to = max_char;
+ i = CHARTAB_IDX (from, depth, min_char);
+ j = CHARTAB_IDX (to, depth, min_char);
+ min_char += chartab_chars[depth] * i;
+ for (; i <= j; i++, min_char += chartab_chars[depth])
+ sub_char_table_set_range (XSUB_CHAR_TABLE (*table)->contents + i,
+ depth, min_char, from, to, val);
+ }
+ }
+
+
+ Lisp_Object
+ char_table_set_range (table, from, to, val)
+ Lisp_Object table;
+ int from, to;
+ Lisp_Object val;
+ {
+ struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
+ Lisp_Object *contents = tbl->contents;
+ int i, min_char;
+
+ if (from == to)
+ char_table_set (table, from, val);
+ else
+ {
+ for (i = CHARTAB_IDX (from, 0, 0), min_char = i * chartab_chars[0];
+ min_char <= to;
+ i++, min_char += chartab_chars[0])
+ sub_char_table_set_range (contents + i, 0, min_char, from, to, val);
+ if (ASCII_CHAR_P (from))
+ tbl->ascii = char_table_ascii (table);
+ }
+ return val;
+ }
+
+ \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.
+ 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; !NILP (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
+ 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 cons of character codes (for characters in the range), or a character code. */)
+ (char_table, range)
+ Lisp_Object char_table, range;
+ {
+ Lisp_Object val;
+ CHECK_CHAR_TABLE (char_table);
+
+ if (EQ (range, Qnil))
+ val = XCHAR_TABLE (char_table)->defalt;
+ else if (INTEGERP (range))
+ val = CHAR_TABLE_REF (char_table, XINT (range));
+ else if (CONSP (range))
+ {
+ int from, to;
+
- CHECK_CHARACTER (XCAR (range));
- CHECK_CHARACTER (XCDR (range));
++ CHECK_CHARACTER_CAR (range);
++ CHECK_CHARACTER_CDR (range);
+ val = char_table_ref_and_range (char_table, XINT (XCAR (range)),
+ &from, &to);
+ /* Not yet implemented. */
+ }
+ else
+ error ("Invalid RANGE argument to `char-table-range'");
+ return val;
+ }
+
+ DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range,
+ 3, 3, 0,
+ doc: /*
+ Set the value in CHAR-TABLE for characters specified by RANGE to VALUE.
+ RANGE should be t (for all characters), nil (for the default value),
+ a cons of character codes (for characters in the range), or a character code. */)
+ (char_table, range, value)
+ Lisp_Object char_table, range, value;
+ {
+ CHECK_CHAR_TABLE (char_table);
+ if (EQ (range, Qt))
+ {
+ int i;
+
+ XCHAR_TABLE (char_table)->ascii = Qnil;
+ for (i = 0; i < chartab_size[0]; i++)
+ XCHAR_TABLE (char_table)->contents[i] = Qnil;
+ XCHAR_TABLE (char_table)->defalt = value;
+ }
+ else if (EQ (range, Qnil))
+ XCHAR_TABLE (char_table)->defalt = value;
+ else if (INTEGERP (range))
+ char_table_set (char_table, XINT (range), value);
+ else if (CONSP (range))
+ {
-map_sub_char_table (c_function, function, table, arg, val, range, default_val)
++ CHECK_CHARACTER_CAR (range);
++ CHECK_CHARACTER_CDR (range);
+ char_table_set_range (char_table,
+ XINT (XCAR (range)), XINT (XCDR (range)), 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: /*
+ This function is obsolete and has no effect. */)
+ (char_table, ch, value)
+ Lisp_Object char_table, ch, value;
+ {
+ return Qnil;
+ }
+
+ /* 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)) /* fixme: use CHARACTERP? */
+ return ch;
+ return XINT (value);
+ }
+
+ static Lisp_Object
+ optimize_sub_char_table (table)
+ Lisp_Object table;
+ {
+ struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
+ int depth = XINT (tbl->depth);
+ Lisp_Object elt, this;
+ int i;
+
+ elt = XSUB_CHAR_TABLE (table)->contents[0];
+ if (SUB_CHAR_TABLE_P (elt))
+ elt = XSUB_CHAR_TABLE (table)->contents[0] = optimize_sub_char_table (elt);
+ if (SUB_CHAR_TABLE_P (elt))
+ return table;
+ for (i = 1; i < chartab_size[depth]; i++)
+ {
+ this = XSUB_CHAR_TABLE (table)->contents[i];
+ if (SUB_CHAR_TABLE_P (this))
+ this = XSUB_CHAR_TABLE (table)->contents[i]
+ = optimize_sub_char_table (this);
+ if (SUB_CHAR_TABLE_P (this)
+ || NILP (Fequal (this, elt)))
+ break;
+ }
+
+ return (i < chartab_size[depth] ? table : elt);
+ }
+
+ DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table,
+ 1, 1, 0,
+ doc: /* Optimize CHAR-TABLE. */)
+ (char_table)
+ Lisp_Object char_table;
+ {
+ Lisp_Object elt;
+ int i;
+
+ CHECK_CHAR_TABLE (char_table);
+
+ for (i = 0; i < chartab_size[0]; i++)
+ {
+ elt = XCHAR_TABLE (char_table)->contents[i];
+ if (SUB_CHAR_TABLE_P (elt))
+ XCHAR_TABLE (char_table)->contents[i] = optimize_sub_char_table (elt);
+ }
+ return Qnil;
+ }
+
+ \f
+ static Lisp_Object
- Lisp_Object function, table, arg, val, range, default_val;
++map_sub_char_table (c_function, function, table, arg, val, range,
++ default_val, parent)
+ void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
- default_val);
++ Lisp_Object function, table, arg, val, range, default_val, parent;
+ {
+ struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
+ int depth = XINT (tbl->depth);
+ int i, c;
+
+ for (i = 0, c = XINT (tbl->min_char); i < chartab_size[depth];
+ i++, c += chartab_chars[depth])
+ {
+ Lisp_Object this;
+
+ this = tbl->contents[i];
+ if (SUB_CHAR_TABLE_P (this))
+ val = map_sub_char_table (c_function, function, this, arg, val, range,
- XCDR (range) = make_number (c - 1);
++ default_val, parent);
+ else
+ {
+ if (NILP (this))
+ this = default_val;
++ if (NILP (this) && ! NILP (parent))
++ this = CHAR_TABLE_REF (parent, c);
+ if (NILP (Fequal (val, this)))
+ {
+ if (! NILP (val))
+ {
- XCAR (range) = make_number (c);
++ XSETCDR (range, make_number (c - 1));
+ if (depth == 3
+ && EQ (XCAR (range), XCDR (range)))
+ {
+ if (c_function)
+ (*c_function) (arg, XCAR (range), val);
+ else
+ call2 (function, XCAR (range), val);
+ }
+ else
+ {
+ if (c_function)
+ (*c_function) (arg, range, val);
+ else
+ call2 (function, range, val);
+ }
+ }
+ val = this;
- ARG is passed to C_FUNCTION when that is called.
-
- DEPTH and INDICES are ignored. They are removed in the new
- feature. */
++ XSETCAR (range, make_number (c));
+ }
+ }
+ }
+ return val;
+ }
+
+
+ /* Map C_FUNCTION or FUNCTION over TABLE, calling it for each
+ character or group of characters that share a value.
+
-map_char_table (c_function, function, table, arg, depth, indices)
++ ARG is passed to C_FUNCTION when that is called. */
+
+ void
- Lisp_Object function, table, arg, *indices;
- int depth;
++map_char_table (c_function, function, table, arg)
+ void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
- XCHAR_TABLE (table)->defalt);
++ Lisp_Object function, table, arg;
+ {
+ Lisp_Object range, val;
+ int c, i;
+
+ range = Fcons (make_number (0), Qnil);
+ val = XCHAR_TABLE (table)->ascii;
+ if (SUB_CHAR_TABLE_P (val))
+ val = XSUB_CHAR_TABLE (val)->contents[0];
+
+ for (i = 0, c = 0; i < chartab_size[0]; i++, c += chartab_chars[0])
+ {
+ Lisp_Object this;
+
+ this = XCHAR_TABLE (table)->contents[i];
+ if (SUB_CHAR_TABLE_P (this))
+ val = map_sub_char_table (c_function, function, this, arg, val, range,
- XCDR (range) = make_number (c - 1);
++ XCHAR_TABLE (table)->defalt,
++ XCHAR_TABLE (table)->parent);
+ else
+ {
+ if (NILP (this))
+ this = XCHAR_TABLE (table)->defalt;
++ if (NILP (this) && ! NILP (XCHAR_TABLE (table)->parent))
++ this = CHAR_TABLE_REF (XCHAR_TABLE (table)->parent, c);
+ if (NILP (Fequal (val, this)))
+ {
+ if (! NILP (val))
+ {
- XCAR (range) = make_number (c);
++ XSETCDR (range, make_number (c - 1));
+ if (c_function)
+ (*c_function) (arg, range, val);
+ else
+ call2 (function, range, val);
+ }
+ val = this;
- XCDR (range) = make_number (c - 1);
++ XSETCAR (range, make_number (c));
+ }
+ }
+ }
+
+ if (! NILP (val))
+ {
- map_char_table (NULL, function, char_table, char_table, 0, NULL);
++ XSETCDR (range, make_number (c - 1));
+ if (c_function)
+ (*c_function) (arg, range, val);
+ else
+ call2 (function, range, val);
+ }
+ }
+
+ DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
+ 2, 2, 0,
+ doc: /*
+ Call FUNCTION for each character in CHAR-TABLE that has non-nil value.
+ FUNCTION is called with two arguments--a key and a value.
+ The key is a character code or a cons of character codes specifying a
+ range of characters that have the same value. */)
+ (function, char_table)
+ Lisp_Object function, char_table;
+ {
+ CHECK_CHAR_TABLE (char_table);
+
- if (NILP (char_table_ref (table, 0)))
- range = Fcons (Qnil, Qnil);
- else
- range = Fcons (make_number (0), make_number (0));
++ map_char_table (NULL, function, char_table, char_table);
+ return Qnil;
+ }
+
+
+ static void
+ map_sub_char_table_for_charset (c_function, function, table, arg, range,
+ charset, from, to)
+ void (*c_function) P_ ((Lisp_Object, Lisp_Object));
+ Lisp_Object function, table, arg, range;
+ struct charset *charset;
+ unsigned from, to;
+ {
+ struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
+ int depth = XINT (tbl->depth);
+ int c, i;
+
+ if (depth < 3)
+ for (i = 0, c = XINT (tbl->min_char); i < chartab_size[depth];
+ i++, c += chartab_chars[depth])
+ {
+ Lisp_Object this;
+
+ this = tbl->contents[i];
+ if (SUB_CHAR_TABLE_P (this))
+ map_sub_char_table_for_charset (c_function, function, this, arg,
+ range, charset, from, to);
+ else
+ {
+ if (! NILP (XCAR (range)))
+ {
+ XSETCDR (range, make_number (c - 1));
+ if (c_function)
+ (*c_function) (arg, range);
+ else
+ call2 (function, range, arg);
+ }
+ XSETCAR (range, Qnil);
+ }
+ }
+ else
+ for (i = 0, c = XINT (tbl->min_char); i < chartab_size[depth]; i++, c ++)
+ {
+ Lisp_Object this;
+ unsigned code;
+
+ this = tbl->contents[i];
+ if (NILP (this)
+ || (charset
+ && (code = ENCODE_CHAR (charset, c),
+ (code < from || code > to))))
+ {
+ if (! NILP (XCAR (range)))
+ {
+ XSETCDR (range, make_number (c - 1));
+ if (c_function)
+ (*c_function) (range, arg);
+ else
+ call2 (function, range, arg);
+ XSETCAR (range, Qnil);
+ }
+ }
+ else
+ {
+ if (NILP (XCAR (range)))
+ XSETCAR (range, make_number (c));
+ }
+ }
+ }
+
+
+ void
+ map_char_table_for_charset (c_function, function, table, arg,
+ charset, from, to)
+ void (*c_function) P_ ((Lisp_Object, Lisp_Object));
+ Lisp_Object function, table, arg;
+ struct charset *charset;
+ unsigned from, to;
+ {
+ Lisp_Object range;
+ int c, i;
+
-
-\f
-#if 0
-Lisp_Object
-make_class_table (purpose)
- Lisp_Object purpose;
-{
- Lisp_Object table;
- Lisp_Object args[4];
-
- args[0] = purpose;
- args[1] = Qnil;
- args[2] = QCextra_slots;
- args[3] = Fmake_vector (make_number (2), Qnil);
- ASET (args[3], 0, Fmakehash (Qequal));
- table = Fmake_char_table (4, args);
- return table;
-}
-
-Lisp_Object
-modify_class_entry (c, val, table, set)
- int c;
- Lisp_Object val, table, set;
-{
- Lisp_Object classes, hash, canon;
- int i, ival;
-
- hash = XCHAR_TABLE (table)->extras[0];
- classes = CHAR_TABLE_REF (table, c);
-
- if (! BOOL_VECTOR_P (classes))
- classes = (NILP (set)
- ? Qnil
- : Fmake_bool_vector (make_number ((ival / 8) * 8 + 8), Qnil));
- else if (ival < XBOOL_VECTOR (classes)->size)
- {
- Lisp_Object old;
- old = classes;
- classes = Fmake_bool_vector (make_number ((ival / 8) * 8 + 8), Qnil);
- for (i = 0; i < XBOOL_VECTOR (classes)->size; i++)
- Faset (classes, make_number (i), Faref (old, make_number (i)));
- Faset (classes, val, set);
- }
- else if (NILP (Faref (classes, val)) != NILP (set))
- {
- classes = Fcopy_sequence (classes);
- Faset (classes, val, set);
- }
- else
- classes = Qnil;
-
- if (!NILP (classes))
- {
- canon = Fgethash (classes, hash, Qnil);
- if (NILP (canon))
- {
- canon = classes;
- Fputhash (canon, canon, hash);
- }
- char_table_set (table, c, canon);
- }
-
- return val;
-}
-#endif
-
++ range = Fcons (Qnil, Qnil);
+
+ for (i = 0, c = 0; i < chartab_size[0]; i++, c += chartab_chars[0])
+ {
+ Lisp_Object this;
+
+ this = XCHAR_TABLE (table)->contents[i];
+ if (SUB_CHAR_TABLE_P (this))
+ map_sub_char_table_for_charset (c_function, function, this, arg,
+ range, charset, from, to);
+ else
+ {
+ if (! NILP (XCAR (range)))
+ {
+ XSETCDR (range, make_number (c - 1));
+ if (c_function)
+ (*c_function) (arg, range);
+ else
+ call2 (function, range, arg);
+ }
+ XSETCAR (range, Qnil);
+ }
+ }
+ if (! NILP (XCAR (range)))
+ {
+ XSETCDR (range, make_number (c - 1));
+ if (c_function)
+ (*c_function) (arg, range);
+ else
+ call2 (function, range, arg);
+ }
+ }
+
+ \f
+ void
+ syms_of_chartab ()
+ {
+ defsubr (&Smake_char_table);
+ defsubr (&Schar_table_parent);
+ defsubr (&Schar_table_subtype);
+ 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);
+ }
/* Simple built-in editing commands.
- Copyright (C) 1985, 93, 94, 95, 96, 97, 1998, 2001 Free Software Foundation, Inc.
+ Copyright (C) 1985, 93, 94, 95, 96, 97, 1998, 2001, 02, 03
+ 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"
Lisp_Object Vself_insert_face_command;
extern Lisp_Object Qface;
+extern Lisp_Object Vtranslation_table_for_input;
\f
DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0,
doc: /* Return buffer position N characters after (before if N negative) point. */)
boundaries, either bind `inhibit-field-text-motion' to t, or use the
`forward-line' function instead. For instance, `(forward-line 0)' does
the same thing as `(beginning-of-line)', except that it ignores field
-boundaries. */)
+boundaries. */)
(n)
Lisp_Object n;
{
CHECK_NUMBER (n);
SET_PT (XINT (Fline_beginning_position (n)));
-
+
return Qnil;
}
doc: /* Move point to end of current line.
With argument N not nil or 1, move forward N - 1 lines first.
If point reaches the beginning or end of buffer, it stops there.
+To ignore intangibility, bind `inhibit-text-motion-hooks' to t.
This command does not move point across a field boundary unless doing so
would move beyond there to a different line; if N is nil or 1, and
(n)
Lisp_Object n;
{
+ int newpos;
+
if (NILP (n))
XSETFASTINT (n, 1);
else
CHECK_NUMBER (n);
- SET_PT (XINT (Fline_end_position (n)));
+ while (1)
+ {
+ newpos = XINT (Fline_end_position (n));
+ SET_PT (newpos);
+
+ if (PT > newpos
+ && FETCH_CHAR (PT - 1) == '\n')
+ {
+ /* If we skipped over a newline that follows
+ an invisible intangible run,
+ move back to the last tangible position
+ within the line. */
+
+ SET_PT (PT - 1);
+ break;
+ }
+ else if (PT > newpos && PT < ZV
+ && FETCH_CHAR (PT) != '\n')
+ /* If we skipped something intangible
+ and now we're not really at eol,
+ keep going. */
+ n = make_number (1);
+ else
+ break;
+ }
return Qnil;
}
&& ! deleted_special
&& ! (PT == ZV || FETCH_BYTE (PT_BYTE) == '\n'))
{
- int column = current_column ();
+ int column = (int) current_column (); /* iftc */
value = Fdelete_char (make_number (-XINT (n)), killflag);
- i = column - current_column ();
+ i = column - (int) current_column (); /* iftc */
Finsert_char (make_number (' '), make_number (i), Qnil);
/* Whitespace chars are ASCII chars, so we can simply subtract. */
SET_PT_BOTH (PT - i, PT_BYTE - i);
return value;
}
+/* Note that there's code in command_loop_1 which typically avoids
+ calling this. */
DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
doc: /* Insert the character you type.
Whichever character you type to run this command is inserted. */)
(n)
Lisp_Object n;
{
- int character = XINT (last_command_char);
-
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 ();
- else if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode))
- {
- int modified_char = character;
- /* Add the offset to the character, for Finsert_char.
- We pass internal_self_insert the unmodified character
- because it itself does this offsetting. */
- if (! NILP (current_buffer->enable_multibyte_characters))
- modified_char = unibyte_char_to_multibyte (modified_char);
-
- XSETFASTINT (n, XFASTINT (n) - 2);
- /* The first one might want to expand an abbrev. */
- internal_self_insert (character, 1);
- /* The bulk of the copies of this char can be inserted simply.
- We don't have to handle a user-specified face specially
- because it will get inherited from the first char inserted. */
- Finsert_char (make_number (modified_char), n, Qt);
- /* The last one might want to auto-fill. */
- internal_self_insert (character, 0);
- }
- else
- while (XINT (n) > 0)
+ {
+ 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))
{
- /* Ok since old and new vals both nonneg */
- XSETFASTINT (n, XFASTINT (n) - 1);
- internal_self_insert (character, XFASTINT (n) != 0);
+ int modified_char = character;
+ /* Add the offset to the character, for Finsert_char.
+ We pass internal_self_insert the unmodified character
+ because it itself does this offsetting. */
+ if (! NILP (current_buffer->enable_multibyte_characters))
+ modified_char = unibyte_char_to_multibyte (modified_char);
+
+ XSETFASTINT (n, XFASTINT (n) - 2);
+ /* The first one might want to expand an abbrev. */
+ internal_self_insert (character, 1);
+ /* The bulk of the copies of this char can be inserted simply.
+ We don't have to handle a user-specified face specially
+ because it will get inherited from the first char inserted. */
+ Finsert_char (make_number (modified_char), n, Qt);
+ /* The last one might want to auto-fill. */
+ internal_self_insert (character, 0);
}
+ else
+ while (XINT (n) > 0)
+ {
+ /* Ok since old and new vals both nonneg */
+ XSETFASTINT (n, XFASTINT (n) - 1);
+ internal_self_insert (character, XFASTINT (n) != 0);
+ }
+ }
return Qnil;
}
return 0. A value of 1 indicates this *might* not have been simple.
A value of 2 means this did things that call for an undo boundary. */
+static Lisp_Object Qexpand_abbrev;
+
int
internal_self_insert (c, noautofill)
int c;
int noautofill;
{
- extern Lisp_Object Fexpand_abbrev ();
int hairy = 0;
Lisp_Object tem;
register enum syntaxcode synt;
/* 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
&& ! (c2 == '\t'
&& XINT (current_buffer->tab_width) > 0
&& XFASTINT (current_buffer->tab_width) < 20
- && (target_clm = (current_column ()
+ && (target_clm = ((int) current_column () /* iftc */
+ XINT (Fchar_width (make_number (c)))),
target_clm % XFASTINT (current_buffer->tab_width)))))
{
}
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;
- sym = Fexpand_abbrev ();
+ sym = call0 (Qexpand_abbrev);
/* If we expanded an abbrev which has a hook,
and the hook has a non-nil `no-self-insert' property,
Vself_insert_face = Qnil;
}
- synt = SYNTAX (c);
if ((synt == Sclose || synt == Smath)
&& !NILP (Vblink_paren_function) && INTERACTIVE
&& !noautofill)
Qoverwrite_mode_binary = intern ("overwrite-mode-binary");
staticpro (&Qoverwrite_mode_binary);
+ Qexpand_abbrev = intern ("expand-abbrev");
+ staticpro (&Qexpand_abbrev);
+
DEFVAR_LISP ("self-insert-face", &Vself_insert_face,
doc: /* If non-nil, set the face of the next self-inserting character to this.
See also `self-insert-face-command'. */);
- /* Coding system handler (conversion, detection, and etc).
- Copyright (C) 1995,97,1998,2002,2003 Electrotechnical Laboratory, JAPAN.
- Licensed to the Free Software Foundation.
- Copyright (C) 2001,2002,2003 Free Software Foundation, Inc.
+ /* Coding system handler (conversion, detection, etc).
+ Copyright (C) 1995, 1997, 1998 Electrotechnical Laboratory, JAPAN.
- Licensed to the Free Software Foundation.
++ Licensed to the Free Software Foundation.
+ Copyright (C) 2001, 2002 Free Software Foundation, Inc.
- Copyright (C) 2001, 2002
++ 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.
- Emacs itself holds a multi-lingual character in buffers and strings
- in a special format. Details are described in section 2.
+ Coding systems are classified into the following types depending on
+ the encoding mechanism. Here's a brief description of the types.
- 1. ISO2022
+ o UTF-8
+
+ o UTF-16
+
+ o Charset-base coding system
+
+ 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 ***
+ 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,
+ 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;
{
- ...
+ unsigned char *src = coding->source;
+ 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;
- unsigned char *source, *destination;
- int src_bytes, dst_bytes;
{
- ...
+ unsigned char *src = coding->source + coding->consumed;
+ 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. */
+ unsigned char *src_base;
+ /* A buffer to produce decoded characters. */
+ int *charbuf = coding->charbuf;
+ int *charbuf_end = 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. */
-
- #define ONE_MORE_BYTE_CHECK_MULTIBYTE(c1, multibytep) \
- do { \
- if (src >= src_end) \
- { \
- coding->result = CODING_FINISH_INSUFFICIENT_SRC; \
- goto label_end_of_loop; \
- } \
- 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"
-
- #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 QCcategory;
extern Lisp_Object Qinsert_file_contents, Qwrite_region;
Lisp_Object Qcall_process, Qcall_process_region, Qprocess_argument;
Lisp_Object Qstart_process, Qopen_network_stream;
Lisp_Object Qtarget_idx;
- Lisp_Object Vselect_safe_coding_system_function;
-
+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. */
- int 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. */
/* Coding system of what is sent from terminal keyboard. */
struct coding_system keyboard_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;
- Lisp_Object Qchar_coding_system;
+ /* Two special coding systems. */
+ Lisp_Object Vsjis_coding_system;
+ Lisp_Object Vbig5_coding_system;
+
+
+ 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 *));
+
+
+ /* 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_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. */
+ };
- /* Return `safe-chars' property of CODING_SYSTEM (symbol). Don't check
- its validity. */
+ /** The macros CODING_ISO_FLAG_XXX defines a flag bit of the
+ `iso-flags' attribute of an iso2022 coding system. */
- Lisp_Object
- coding_safe_chars (coding_system)
- Lisp_Object coding_system;
- {
- Lisp_Object coding_spec, plist, safe_chars;
+ /* 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
- 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 at end-of-line to the
+ initial state. */
+ #define CODING_ISO_FLAG_RESET_AT_EOL 0x0002
- #define CODING_SAFE_CHAR_P(safe_chars, c) \
- (EQ (safe_chars, Qt) || !NILP (CHAR_TABLE_REF (safe_chars, c)))
+ /* If set, reset graphic planes and registers before any control
+ characters to the initial state. */
+ #define CODING_ISO_FLAG_RESET_AT_CNTL 0x0004
- \f
- /*** 2. Emacs internal format (emacs-mule) handlers ***/
+ /* If set, encode by 7-bit environment. */
+ #define CODING_ISO_FLAG_SEVEN_BITS 0x0008
- /* 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 locking-shift function. */
+ #define CODING_ISO_FLAG_LOCKING_SHIFT 0x0010
- 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 single-shift function. Overwrite
+ CODING_ISO_FLAG_LOCKING_SHIFT. */
+ #define CODING_ISO_FLAG_SINGLE_SHIFT 0x0020
- 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, use designation escape sequence. */
+ #define CODING_ISO_FLAG_DESIGNATION 0x0040
- 8-bit characters of the range 0xA0..0xFF are represented by
- one-byte sequences which are their 8-bit code.
+ /* If set, produce revision number sequence. */
+ #define CODING_ISO_FLAG_REVISION 0x0080
- 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, produce ISO6429's direction specifying sequence. */
+ #define CODING_ISO_FLAG_DIRECTION 0x0100
- --- 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, assume designation states are reset at beginning of line on
+ output. */
+ #define CODING_ISO_FLAG_INIT_AT_BOL 0x0200
- 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, designation sequence should be placed at beginning of line
+ on output. */
+ #define CODING_ISO_FLAG_DESIGNATE_AT_BOL 0x0400
- In that case, a sequence of one-byte codes has a slightly different
- form.
+ /* If set, do not encode unsafe charactes on output. */
+ #define CODING_ISO_FLAG_SAFE 0x0800
- Firstly, all characters in eight-bit-control are represented by
- one-byte sequences which are their 8-bit code.
+ /* If set, extra latin codes (128..159) are accepted as a valid code
+ on input. */
+ #define CODING_ISO_FLAG_LATIN_EXTRA 0x1000
- 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_COMPOSITION 0x2000
- BYTES is 0xA0 plus the byte length of these composition data,
+ #define CODING_ISO_FLAG_EUC_TW_SHIFT 0x4000
- CHARS is 0xA0 plus the number of characters composed by these
- data,
+ #define CODING_ISO_FLAG_USE_ROMAN 0x8000
- COMPONENTs are characters of multibyte form or composition
- rules encoded by two-byte of ASCII codes.
+ #define CODING_ISO_FLAG_USE_OLDJIS 0x10000
- In addition, for backward compatibility, the following formats are
- also recognized as composition data on decoding.
+ #define CODING_ISO_FLAG_FULL_SUPPORT 0x100000
- 0x80 MSEQ ...
- 0x80 0xFF MSEQ RULE MSEQ RULE ... MSEQ
+ /* 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 '?'
- 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.
- */
- enum emacs_code_class_type emacs_code_class[256];
+ /* UTF-16 section */
+ #define CODING_UTF_16_BOM(coding) \
+ ((coding)->spec.utf_16.bom)
- /* 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_ENDIAN(coding) \
+ ((coding)->spec.utf_16.endian)
- 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;
+ #define CODING_UTF_16_SURROGATE(coding) \
+ ((coding)->spec.utf_16.surrogate)
- while (1)
- {
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep);
- if (composing)
- {
- if (c < 0xA0)
- composing = 0;
- else if (c == 0xA0)
- {
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep);
- 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) \
- (XSTRING (AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_valids)) \
- ->data)
++ (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;
- }
- }
- }
- label_end_of_loop:
- return CODING_CATEGORY_MASK_EMACS_MULE;
- }
+ 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, eol_type, charset_list) \
+ do { \
+ attrs = CODING_ID_ATTRS (coding->id); \
+ eol_type = CODING_ID_EOL_TYPE (coding->id); \
+ if (VECTORP (eol_type)) \
+ eol_type = Qunix; \
+ 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'. The caller
+ should declare and set these variables appropriately in advance:
+ src, src_end, multibytep
+ */
- #define CODING_ADD_COMPOSITION_START(coding, start, method) \
+ #define ONE_MORE_BYTE(c) \
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; \
+ if (src == src_end) \
+ { \
+ if (src_base < src) \
+ coding->result = CODING_RESULT_INSUFFICIENT_SRC; \
+ goto no_more_source; \
+ } \
+ c = *src++; \
+ if (multibytep && (c & 0x80)) \
+ { \
+ if ((c & 0xFE) != 0xC0) \
+ error ("Undecodable char found"); \
+ c = ((c & 1) << 6) | *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) \
+ error ("Undecodable char found"); \
+ c = ((c & 1) << 6) | *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; \
- } \
+ /* 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.
+ */
+
+
+ #define EMIT_ONE_ASCII_BYTE(c) \
+ do { \
+ produced_chars++; \
+ *dst++ = (c); \
} while (0)
- /* 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. */
+ /* Like EMIT_ONE_ASCII_BYTE byt store two bytes; C1 and C2. */
- #define SAFE_ONE_MORE_BYTE() (src >= src_end ? -1 : *src++)
+ #define EMIT_TWO_ASCII_BYTES(c1, c2) \
+ do { \
+ produced_chars += 2; \
+ *dst++ = (c1), *dst++ = (c2); \
+ } while (0)
- /* 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. */
+ /* 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)
- #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 -= 0xA0; \
- *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; \
+
+ /* 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)
- /* 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. */
+ #define EMIT_THREE_BYTES(c1, c2, c3) \
+ do { \
+ EMIT_ONE_BYTE (c1); \
+ EMIT_TWO_BYTES (c2, c3); \
+ } 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_FOUR_BYTES(c1, c2, c3, c4) \
+ do { \
+ EMIT_TWO_BYTES (c1, c2); \
+ EMIT_TWO_BYTES (c3, c4); \
+ } while (0)
+
+
+ #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) \
+ { \
- unsigned char *orig = coding->source; \
++ 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)
- /* 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 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)
- 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.
- */
- static INLINE int
- decode_composition_emacs_mule (coding, src, src_end,
- destination, dst_end, dst_bytes)
+ static void
+ coding_set_source (coding)
struct coding_system *coding;
- unsigned char *src, *src_end, **destination, *dst_end;
- int dst_bytes;
{
- unsigned char *dst = *destination;
- int method, data_len, nchars;
- 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 (BUFFERP (coding->src_object))
+ {
+ struct buffer *buf = XBUFFER (coding->src_object);
- if (coding->cmp_data->used + COMPOSITION_DATA_MAX_BUNCH_LENGTH
- >= COMPOSITION_DATA_SIZE)
+ 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->result = CODING_FINISH_INSUFFICIENT_CMP;
- return -1;
- coding->source = (XSTRING (coding->src_object)->data
- + coding->src_pos_byte);
++ 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. */
+ ;
+ }
- ONE_MORE_BYTE (c);
- if (c - 0xF0 >= COMPOSITION_RELATIVE
- && c - 0xF0 <= COMPOSITION_WITH_RULE_ALTCHARS)
+ static void
+ coding_set_destination (coding)
+ struct coding_system *coding;
+ {
+ if (BUFFERP (coding->dst_object))
{
- int with_rule;
-
- 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;
- ONE_MORE_BYTE (c);
- nchars = c - 0xA0;
- if (c < 1)
- return 0;
- for (ncomponent = 0; src < src_base + data_len; ncomponent++)
+ if (coding->src_pos < 0)
{
- /* If it is longer than this, it can't be valid. */
- if (ncomponent >= COMPOSITION_DATA_MAX_BUNCH_LENGTH)
- return 0;
-
- if (ncomponent % 2 && with_rule)
- {
- ONE_MORE_BYTE (gref);
- gref -= 32;
- ONE_MORE_BYTE (nref);
- nref -= 32;
- c = COMPOSITION_ENCODE_RULE (gref, nref);
- }
- 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;
- }
- component[ncomponent] = c;
+ 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, bytes)
+ struct coding_system *coding;
+ EMACS_INT bytes;
+ {
+ if (BUFFERP (coding->dst_object)
+ && EQ (coding->src_object, coding->dst_object))
+ {
+ EMACS_INT add = coding->src_bytes - coding->consumed;
+
+ 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;
+ }
+ 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;
+ int nbytes;
+ unsigned char *dst;
+ {
+ EMACS_INT offset = dst - coding->destination;
+
+ if (BUFFERP (coding->dst_object))
+ coding_alloc_by_making_gap (coding, nbytes);
else
- unsigned char *src = coding->source, *src_base = src;
- unsigned char *src_end = coding->source + coding->src_bytes;
+ coding_alloc_by_realloc (coding, nbytes);
+ coding->result = 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 (5 + (MAX_COMPOSITION_COMPONENTS * 2) - 1 + 5)
+
+ /* An annotation data is stored in the array coding->charbuf in this
+ format:
+ [ -LENGTH ANNOTATION_MASK FROM TO ... ]
+ LENGTH is the number of elements in the annotation.
+ ANNOTATION_MASK is one of CODING_ANNOTATE_XXX_MASK.
+ FROM and TO specify the range of text annotated. They are relative
+ to coding->src_pos (on encoding) or coding->dst_pos (on decoding).
+
+ 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, from, to) \
+ do { \
+ *(buf)++ = -(len); \
+ *(buf)++ = (mask); \
+ *(buf)++ = (from); \
+ *(buf)++ = (to); \
+ coding->annotated = 1; \
+ } while (0);
+
+ #define ADD_COMPOSITION_DATA(buf, from, to, method) \
+ do { \
+ ADD_ANNOTATION_DATA (buf, 5, CODING_ANNOTATE_COMPOSITION_MASK, from, to); \
+ *buf++ = method; \
+ } while (0)
+
+
+ #define ADD_CHARSET_DATA(buf, from, to, id) \
+ do { \
+ ADD_ANNOTATION_DATA (buf, 5, CODING_ANNOTATE_CHARSET_MASK, from, to); \
+ *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 = src;
++ const unsigned char *src_end = coding->source + coding->src_bytes;
+ int multibytep = coding->src_multibyte;
+ int consumed_chars = 0;
+ int found = 0;
+ int incomplete;
+
+ detect_info->checked |= CATEGORY_MASK_UTF_8;
+ /* A coding system of this category is always ASCII compatible. */
+ src += coding->head_ascii;
+
+ while (1)
{
- /* 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;
+ int c, c1, c2, c3, c4;
- src_end = src;
- src = src_base + 1;
- if (c < 0xC0)
+ incomplete = 0;
+ ONE_MORE_BYTE (c);
+ if (UTF_8_1_OCTET_P (c))
+ continue;
+ incomplete = 1;
+ ONE_MORE_BYTE (c1);
+ if (! UTF_8_EXTRA_OCTET_P (c1))
+ break;
+ if (UTF_8_2_OCTET_LEADING_P (c))
{
- method = COMPOSITION_RELATIVE;
- for (ncomponent = 0; ncomponent < MAX_COMPOSITION_COMPONENTS;)
- {
- DECODE_EMACS_MULE_COMPOSITION_CHAR (c, bufp);
- if (c < 0)
- break;
- component[ncomponent++] = c;
- }
- if (ncomponent < 2)
- return 0;
- nchars = ncomponent;
+ found = CATEGORY_MASK_UTF_8;
+ continue;
}
- else if (c == 0xFF)
+ ONE_MORE_BYTE (c2);
+ if (! UTF_8_EXTRA_OCTET_P (c2))
+ break;
+ if (UTF_8_3_OCTET_LEADING_P (c))
{
- 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;)
- {
- 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;
- }
- if (ncomponent < 3)
- return 0;
- nchars = (ncomponent + 1) / 2;
+ found = CATEGORY_MASK_UTF_8;
+ continue;
}
- else
- return 0;
+ ONE_MORE_BYTE (c3);
+ if (! 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 (! 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;
- if (buf == bufp || dst + (bufp - buf) <= (dst_bytes ? dst_end : src))
+ no_more_source:
+ if (incomplete && 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_UTF_8;
+ return 0;
}
- label_end_of_loop:
- return -1;
+ detect_info->found |= found;
+ return 1;
}
- /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
static void
- decode_coding_emacs_mule (coding, source, destination, src_bytes, dst_bytes)
+ decode_coding_utf_8 (coding)
struct coding_system *coding;
- unsigned char *source, *destination;
- int src_bytes, dst_bytes;
{
- 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 code, or
- when there's not enough destination area to produce a
- character. */
- unsigned char *src = coding->source + coding->consumed;
- unsigned char *src_end = coding->source + coding->src_bytes;
-- unsigned char *src_base;
++ 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;
+ int *charbuf_end = charbuf + coding->charbuf_size;
+ int consumed_chars = 0, consumed_chars_base;
+ int multibytep = coding->src_multibyte;
+ Lisp_Object attr, eol_type, charset_list;
- coding->produced_char = 0;
- while ((src_base = src) < src_end)
+ CODING_GET_INFO (coding, attr, eol_type, charset_list);
+
+ while (1)
{
- unsigned char tmp[MAX_MULTIBYTE_LENGTH], *p;
- int bytes;
+ int c, c1, c2, c3, c4, c5;
- 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)
+ if (charbuf >= charbuf_end)
+ break;
+
+ ONE_MORE_BYTE (c1);
+ if (UTF_8_1_OCTET_P(c1))
+ {
+ c = c1;
+ if (c == '\r')
{
- ONE_MORE_BYTE (c);
- if (c != '\n')
+ if (EQ (eol_type, Qdos))
{
- src--;
- c = '\r';
+ if (src == src_end)
+ {
+ coding->result = CODING_RESULT_INSUFFICIENT_SRC;
+ goto no_more_source;
+ }
+ if (*src == '\n')
+ ONE_MORE_BYTE (c);
}
+ else if (EQ (eol_type, Qmac))
+ c = '\n';
}
- *dst++ = c;
- coding->produced_char++;
- continue;
}
- else if (*src == '\n')
+ else
{
- if ((coding->eol_type == CODING_EOL_CR
- || coding->eol_type == CODING_EOL_CRLF)
- && coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL)
+ ONE_MORE_BYTE (c2);
+ if (! UTF_8_EXTRA_OCTET_P (c2))
+ goto invalid_code;
+ if (UTF_8_2_OCTET_LEADING_P (c1))
{
- coding->result = CODING_FINISH_INCONSISTENT_EOL;
- goto label_end_of_loop;
+ 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;
}
- *dst++ = *src++;
- coding->produced_char++;
- continue;
- }
- else if (*src == 0x80 && coding->cmp_data)
- {
- /* 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)
+ else
{
- src += consumed;
- continue;
+ ONE_MORE_BYTE (c3);
+ if (! 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 (! 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 (! 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;
+ }
+ }
}
- bytes = CHAR_STRING (*src, tmp);
- p = tmp;
- src++;
- }
- 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])))
- {
- p = src;
- src += bytes;
}
- else
+
+ *charbuf++ = c;
+ 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);
+ 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)
{
- bytes = CHAR_STRING (*src, tmp);
- p = tmp;
- src++;
+ 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);
+ }
}
- if (dst + bytes >= (dst_bytes ? dst_end : src))
+ }
+ else
+ {
+ int safe_room = MAX_MULTIBYTE_LENGTH;
+
+ while (charbuf < charbuf_end)
{
- coding->result = CODING_FINISH_INSUFFICIENT_DST;
- break;
+ ASSURE_DESTINATION (safe_room);
+ c = *charbuf++;
+ dst += CHAR_STRING (c, dst);
+ produced_chars++;
}
- while (bytes--) *dst++ = *p++;
- coding->produced_char++;
}
- label_end_of_loop:
- coding->consumed = coding->consumed_char = src_base - source;
- coding->produced = dst - destination;
+ coding->result = CODING_RESULT_SUCCESS;
+ coding->produced_char += produced_chars;
+ coding->produced = dst - coding->destination;
+ return 0;
}
- /* 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. */
+ /* 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 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 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 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
+ detect_coding_utf_16 (coding, detect_info)
struct coding_system *coding;
- unsigned char *source, *destination;
- int src_bytes, dst_bytes;
+ 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;
- unsigned char *src_base;
- int c;
- int char_offset;
- int *data;
- unsigned char *src = coding->source, *src_base = src;
- unsigned char *src_end = coding->source + coding->src_bytes;
++ 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;
- Lisp_Object translation_table;
+ detect_info->checked |= CATEGORY_MASK_UTF_16;
- translation_table = Qnil;
+ if (coding->mode & CODING_MODE_LAST_BLOCK
+ && (coding->src_bytes & 1))
+ {
+ detect_info->rejected |= CATEGORY_MASK_UTF_16;
+ return 0;
+ }
+ ONE_MORE_BYTE (c1);
+ ONE_MORE_BYTE (c2);
- /* Optimization for the case that there's no composition. */
- if (!coding->cmp_data || coding->cmp_data->used == 0)
+ if ((c1 == 0xFF) && (c2 == 0xFE))
{
- encode_eol (coding, source, destination, src_bytes, dst_bytes);
- return;
+ detect_info->found |= (CATEGORY_MASK_UTF_16_LE
+ | CATEGORY_MASK_UTF_16_AUTO);
+ detect_info->rejected |= CATEGORY_MASK_UTF_16_BE;
}
+ 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;
+ }
+ no_more_source:
+ return 1;
+ }
- char_offset = coding->cmp_data->char_offset;
- data = coding->cmp_data->data + coding->cmp_data_start;
- while (1)
+ static void
+ decode_coding_utf_16 (coding)
+ struct coding_system *coding;
+ {
- unsigned char *src = coding->source + coding->consumed;
- unsigned char *src_end = coding->source + coding->src_bytes;
- unsigned char *src_base;
++ 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;
+ int *charbuf_end = 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, eol_type, charset_list;
+
+ CODING_GET_INFO (coding, attr, eol_type, 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 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 (endian == utf_16_big_endian
+ ? c != 0xFEFF : c != 0xFFFE)
{
- ENCODE_COMPOSITION_EMACS_MULE (coding, data);
- char_offset = coding->cmp_data->char_offset;
- data = coding->cmp_data->data + coding->cmp_data_start;
+ /* 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;
+ }
- ONE_MORE_CHAR (c);
- if (c == '\n' && (coding->eol_type == CODING_EOL_CRLF
- || coding->eol_type == CODING_EOL_CR))
- {
- if (coding->eol_type == CODING_EOL_CRLF)
- EMIT_TWO_BYTES ('\r', c);
- else
- EMIT_ONE_BYTE ('\r');
- }
- else if (SINGLE_BYTE_CHAR_P (c))
+ while (1)
+ {
+ int c, c1, c2;
+
+ src_base = src;
+ consumed_chars_base = consumed_chars;
+
+ if (charbuf + 2 >= charbuf_end)
+ break;
+
+ ONE_MORE_BYTE (c1);
+ ONE_MORE_BYTE (c2);
+ c = (endian == utf_16_big_endian
+ ? ((c1 << 8) | c2) : ((c2 << 8) | c1));
+ if (surrogate)
{
- if (coding->flags && ! ASCII_BYTE_P (c))
+ if (! UTF_16_LOW_SURROGATE_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);
-
- if (bytes == 1)
- EMIT_ONE_BYTE (buf[0]);
+ 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
- EMIT_TWO_BYTES (buf[0], buf[1]);
+ *charbuf++ = c;
}
else
- EMIT_ONE_BYTE (c);
+ {
+ c = ((surrogate - 0xD800) << 10) | (c - 0xDC00);
+ CODING_UTF_16_SURROGATE (coding) = surrogate = 0;
+ *charbuf++ = c;
+ }
}
else
- EMIT_BYTES (src_base, src);
- coding->consumed_char++;
+ {
+ if (UTF_16_HIGH_SURROGATE_P (c))
+ CODING_UTF_16_SURROGATE (coding) = surrogate = c;
+ else
+ *charbuf++ = c;
- }
++ }
}
- label_end_of_loop:
- coding->consumed = src_base - source;
- coding->produced = coding->produced_char = dst - destination;
- return;
+
+ no_more_source:
+ coding->consumed_char += consumed_chars_base;
+ coding->consumed = src_base - coding->source;
+ coding->charbuf_used = charbuf - coding->charbuf;
}
- \f
- /*** 3. ISO2022 handlers ***/
+ 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, eol_type, charset_list;
+ int c;
- /* The following note describes the coding system ISO2022 briefly.
- Since the intention of this note is to help understand the
- functions in this file, some parts are NOT ACCURATE or are OVERLY
- SIMPLIFIED. For thorough understanding, please refer to the
- original document of ISO2022. This is equivalent to the standard
+ CODING_GET_INFO (coding, attrs, eol_type, 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);
+ }
+ }
+ coding->result = 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;
+ unsigned char *src;
+ int *nbytes, *nchars, *id;
+ {
- unsigned char *src_end = coding->source + coding->src_bytes;
++ const unsigned char *src_end = coding->source + coding->src_bytes;
++ const unsigned char *src_base = src;
+ int multibytep = coding->src_multibyte;
- unsigned char *src_base = src;
+ struct charset *charset;
+ unsigned code;
+ int c;
+ int consumed_chars = 0;
+
+ ONE_MORE_BYTE (c);
+ switch (emacs_mule_bytes[c])
+ {
+ case 2:
+ if (! (charset = emacs_mule_charset[c]))
+ goto invalid_code;
+ ONE_MORE_BYTE (c);
+ code = c & 0x7F;
+ break;
+
+ case 3:
+ if (c == EMACS_MULE_LEADING_CODE_PRIVATE_11
+ || c == EMACS_MULE_LEADING_CODE_PRIVATE_12)
+ {
+ ONE_MORE_BYTE (c);
+ if (! (charset = emacs_mule_charset[c]))
+ goto invalid_code;
+ ONE_MORE_BYTE (c);
+ code = c & 0x7F;
+ }
+ else
+ {
+ if (! (charset = emacs_mule_charset[c]))
+ goto invalid_code;
+ ONE_MORE_BYTE (c);
+ code = (c & 0x7F) << 8;
+ ONE_MORE_BYTE (c);
+ code |= c & 0x7F;
+ }
+ break;
+
+ case 4:
+ ONE_MORE_BYTE (c);
+ if (! (charset = emacs_mule_charset[c]))
+ goto invalid_code;
+ ONE_MORE_BYTE (c);
+ code = (c & 0x7F) << 8;
+ ONE_MORE_BYTE (c);
+ 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;
+ *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;
+ {
- unsigned char *src = coding->source, *src_base = src;
- unsigned char *src_end = coding->source + coding->src_bytes;
++ 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 c;
+ int found = 0;
+ int incomplete;
+
+ detect_info->checked |= CATEGORY_MASK_EMACS_MULE;
+ /* A coding system of this category is always ASCII compatible. */
+ src += coding->head_ascii;
+
+ while (1)
+ {
+ incomplete = 0;
+ ONE_MORE_BYTE (c);
+ incomplete = 1;
+
+ if (c == 0x80)
+ {
+ /* 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. */
- unsigned char *src_base;
++ const unsigned char *src_base;
+
+ repeat:
+ src_base = src;
+ do
+ {
+ ONE_MORE_BYTE (c);
+ }
+ while (c >= 0xA0);
+
+ if (src - src_base <= 4)
+ break;
+ found = CATEGORY_MASK_EMACS_MULE;
+ if (c == 0x80)
+ goto repeat;
+ }
+
+ if (c < 0x80)
+ {
+ if (c < 0x20
+ && (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO))
+ break;
+ }
+ else
+ {
- unsigned char *src_base = src - 1;
++ const unsigned char *src_base = src - 1;
+
+ do
+ {
+ ONE_MORE_BYTE (c);
+ }
+ while (c >= 0xA0);
+ if (src - src_base != emacs_mule_bytes[*src_base])
+ break;
+ found = CATEGORY_MASK_EMACS_MULE;
+ }
+ }
+ detect_info->rejected |= CATEGORY_MASK_EMACS_MULE;
+ return 0;
+
+ no_more_source:
+ if (incomplete && coding->mode & CODING_MODE_LAST_BLOCK)
+ {
+ detect_info->rejected |= CATEGORY_MASK_EMACS_MULE;
+ return 0;
+ }
+ 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 -= 0x20; \
+ 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 from, to; \
+ int consumed_chars_limit; \
+ int nbytes, nchars; \
+ \
+ ONE_MORE_BYTE (c); \
+ nbytes = c - 0xA0; \
+ if (nbytes < 3) \
+ goto invalid_code; \
+ ONE_MORE_BYTE (c); \
+ nchars = c - 0xA0; \
+ from = coding->produced + char_offset; \
+ to = from + nchars; \
+ ADD_COMPOSITION_DATA (charbuf, from, to, 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; \
+ int from, to; \
+ \
+ src = src_base; \
+ ONE_MORE_BYTE (c); /* skip 0x80 */ \
+ for (i = 0; i < MAX_COMPOSITION_COMPONENTS; i++) \
+ DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
+ if (i < 2) \
+ goto invalid_code; \
+ from = coding->produced_char + char_offset; \
+ to = from + i; \
+ ADD_COMPOSITION_DATA (charbuf, from, to, 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 components[MAX_COMPOSITION_COMPONENTS * 2 - 1]; \
+ int *buf = components; \
+ int i, j; \
+ int from, to; \
+ \
+ DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
+ for (i = 0; i < MAX_COMPOSITION_COMPONENTS; i++) \
+ { \
+ 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; \
+ from = coding->produced_char + char_offset; \
+ to = from + i; \
+ ADD_COMPOSITION_DATA (buf, from, to, method); \
+ for (j = 0; j < i; j++) \
+ *charbuf++ = components[j]; \
+ for (j = 0; j < i; j += 2) \
+ *charbuf++ = components[j]; \
+ } while (0)
+
+
+ static void
+ decode_coding_emacs_mule (coding)
+ struct coding_system *coding;
+ {
- unsigned char *src = coding->source + coding->consumed;
- unsigned char *src_end = coding->source + coding->src_bytes;
- unsigned char *src_base;
++ 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;
+ int *charbuf_end = charbuf + coding->charbuf_size - MAX_ANNOTATION_LENGTH;
+ int consumed_chars = 0, consumed_chars_base;
+ int multibytep = coding->src_multibyte;
+ Lisp_Object attrs, eol_type, charset_list;
+ int char_offset = coding->produced_char;
+ int last_offset = char_offset;
+ int last_id = charset_ascii;
+
+ CODING_GET_INFO (coding, attrs, eol_type, charset_list);
+
+ while (1)
+ {
+ int c;
+
+ src_base = src;
+ consumed_chars_base = consumed_chars;
+
+ if (charbuf >= charbuf_end)
+ break;
+
+ ONE_MORE_BYTE (c);
+
+ if (c < 0x80)
+ {
+ if (c == '\r')
+ {
+ if (EQ (eol_type, Qdos))
+ {
+ if (src == src_end)
+ {
+ coding->result = CODING_RESULT_INSUFFICIENT_SRC;
+ goto no_more_source;
+ }
+ if (*src == '\n')
+ ONE_MORE_BYTE (c);
+ }
+ else if (EQ (eol_type, Qmac))
+ c = '\n';
+ }
+ *charbuf++ = c;
+ char_offset++;
+ }
+ else if (c == 0x80)
+ {
+ ONE_MORE_BYTE (c);
+ 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 if (c < 0xA0 && emacs_mule_bytes[c] > 1)
+ {
+ int nbytes, nchars;
+ int id;
+
+ src = src_base;
+ consumed_chars = consumed_chars_base;
+ c = emacs_mule_char (coding, src, &nbytes, &nchars, &id);
+ if (c < 0)
+ {
+ if (c == -2)
+ break;
+ goto invalid_code;
+ }
+ if (last_id != id)
+ {
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, last_offset, char_offset, last_id);
+ last_id = id;
+ last_offset = char_offset;
+ }
+ *charbuf++ = c;
+ src += nbytes;
+ consumed_chars += nchars;
+ char_offset++;
+ }
+ 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++;
+ }
+
+ no_more_source:
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, last_offset, char_offset, last_id);
+ coding->consumed_char += consumed_chars_base;
+ coding->consumed = src_base - coding->source;
+ coding->charbuf_used = charbuf - coding->charbuf;
+ }
+
+
+ #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 int
+ encode_coding_emacs_mule (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;
+ int produced_chars = 0;
+ Lisp_Object attrs, eol_type, charset_list;
+ int c;
+ int preferred_charset_id = -1;
+
+ CODING_GET_INFO (coding, attrs, eol_type, charset_list);
+
+ while (charbuf < charbuf_end)
+ {
+ ASSURE_DESTINATION (safe_room);
+ c = *charbuf++;
+
+ if (c < 0)
+ {
+ /* 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;
+ }
+
+ 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
+ {
+ struct charset *charset;
+ unsigned code;
+ int dimension;
+ int emacs_mule_id;
+ unsigned char leading_codes[2];
+
+ 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, &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);
+ else
+ {
+ EMIT_ONE_BYTE (code >> 8);
+ EMIT_ONE_BYTE (code & 0xFF);
+ }
+ }
+ }
+ coding->result = CODING_RESULT_SUCCESS;
+ coding->produced_char += produced_chars;
+ coding->produced = dst - coding->destination;
+ return 0;
+ }
+
+ \f
+ /*** 7. ISO2022 handlers ***/
+
+ /* The following note describes the coding system ISO2022 briefly.
+ Since the intention of this note is to help understand the
+ functions in this file, some parts are NOT ACCURATE or are OVERLY
+ SIMPLIFIED. For thorough understanding, please refer to the
+ original document of ISO2022. This is equivalent to the standard
ECMA-35, obtainable from <URL:http://www.ecma.ch/> (*).
ISO2022 provides many mechanisms to encode several character sets
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)
+
+ 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;
+ }
- #define SHIFT_OUT_OK(idx) \
- (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding_system_table[idx], 1) >= 0)
+ 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))
- XSTRING (safe_charsets)->data[XINT (id)] = XINT (reg);
++ SSET (safe_charsets, XINT (id), XINT (reg));
+ else if (charset->iso_chars_96)
+ {
+ if (reg96 < 4)
- XSTRING (safe_charsets)->data[XINT (id)] = reg96;
++ SSET (safe_charsets, XINT (id), reg96);
+ }
+ else
+ {
+ if (reg94 < 4)
- XSTRING (safe_charsets)->data[XINT (id)] = reg94;
++ 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 && src < src_end)
- {
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep);
- retry:
- unsigned char *src = coding->source, *src_base = src;
- unsigned char *src_end = coding->source + coding->src_bytes;
++ 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 = XSTRING (val)->size - 1;
- this->safe_charsets = (char *) XSTRING (val)->data;
++ 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)
+ {
+ 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);
+ ONE_MORE_BYTE (c);
if (c >= '(' && c <= '/')
{
/* Designation sequence for a charset of dimension 1. */
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c1, multibytep);
+ 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);
+ 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);
+ 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;
+ found |= CATEGORY_MASK_ISO_ELSE;
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 = 1;
+ 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;
+ if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_2])
+ & CODING_ISO_FLAG_SINGLE_SHIFT)
+ found |= CATEGORY_MASK_ISO_8_2;
+ goto check_extra_latin;
default:
if (c < 0x80)
single_shifting = 0;
break;
}
- else if (c < 0xA0)
+ 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
- {
- 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);
+ 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;
+ if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_2])
+ & CODING_ISO_FLAG_LATIN_EXTRA)
+ found |= CATEGORY_MASK_ISO_8_2;
+ else
+ rejected |= CATEGORY_MASK_ISO_8_2;
}
}
- label_end_of_loop:
- 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; \
- } \
+ #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; \
+ goto invalid_code; \
+ } \
+ 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) \
+ goto invalid_code; \
} 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;
- }
+ #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 \
+ { \
- unsigned char *p; \
++ 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) \
+ { \
+ if (coding->mode & CODING_MODE_LAST_BLOCK) \
+ goto invalid_code; \
+ 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; \
- int from = coding->produced_char + char_offset; \
++ int from = char_offset; \
+ int to = from + nchars; \
+ \
+ ADD_COMPOSITION_DATA (charbuf, from, to, 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;
- unsigned char *source, *destination;
- int src_bytes, dst_bytes;
{
- unsigned char *src = source;
- unsigned char *src_end = source + src_bytes;
- unsigned char *dst = destination;
- unsigned char *dst_end = destination + dst_bytes;
- unsigned char *src = coding->source + coding->consumed;
- unsigned char *src_end = coding->source + coding->src_bytes;
- unsigned char *src_base;
++ 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;
+ int *charbuf_end
+ = 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 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). */
- 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 charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
+ int charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1);
+ 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, eol_type, charset_list;
+ int char_offset = coding->produced_char;
+ int last_offset = char_offset;
+ int last_id = charset_ascii;
+
+ CODING_GET_INFO (coding, attrs, eol_type, charset_list);
+ setup_iso_safe_charsets (attrs);
while (1)
{
int c1, c2;
src_base = src;
+ consumed_chars_base = consumed_chars;
+
+ if (charbuf >= charbuf_end)
+ break;
+
ONE_MORE_BYTE (c1);
- /* 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)
+ if (composition_state != COMPOSING_NO)
{
- DECODE_COMPOSITION_RULE (c1);
- continue;
- }
- if (charset0 < 0 || CHARSET_CHARS (charset0) == 94)
- {
- /* 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;
+ 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;
- 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;
+ if (charset_id_1 < 0)
+ goto invalid_code;
+ charset = CHARSET_FROM_ID (charset_id_1);
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)
+ if (c1 == '\r')
{
- ONE_MORE_BYTE (c1);
- if (c1 != ISO_CODE_LF)
+ if (EQ (eol_type, Qdos))
{
- src--;
- c1 = '\r';
+ if (src == src_end)
+ {
+ coding->result = CODING_RESULT_INSUFFICIENT_SRC;
+ goto no_more_source;
- }
++ }
+ if (*src == '\n')
+ ONE_MORE_BYTE (c1);
}
+ else if (EQ (eol_type, Qmac))
+ c1 = '\n';
}
- charset = CHARSET_ASCII;
+ /* fall through */
+
+ case ISO_control_0:
+ MAYBE_FINISH_COMPOSITION ();
+ charset = CHARSET_FROM_ID (charset_ascii);
break;
+ case ISO_control_1:
+ 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;
+ if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATION))
+ goto invalid_code;
ONE_MORE_BYTE (c1);
if (c1 >= '@' && c1 <= 'B')
{ /* designation of JISX0208.1978, GB2312.1980,
or JISX0208.1980 */
- DECODE_DESIGNATION (0, 2, 94, c1);
+ DECODE_DESIGNATION (0, 2, 0, c1);
}
else if (c1 >= 0x28 && c1 <= 0x2B)
{ /* designation of DIMENSION2_CHARS94 character set */
ONE_MORE_BYTE (c2);
- DECODE_DESIGNATION (c1 - 0x28, 2, 94, c2);
+ DECODE_DESIGNATION (c1 - 0x28, 2, 0, c2);
}
else if (c1 >= 0x2C && c1 <= 0x2F)
{ /* designation of DIMENSION2_CHARS96 character set */
ONE_MORE_BYTE (c2);
- DECODE_DESIGNATION (c1 - 0x2C, 2, 96, c2);
+ DECODE_DESIGNATION (c1 - 0x2C, 2, 1, c2);
}
else
- goto label_invalid_code;
+ goto invalid_code;
/* We must update these variables now. */
- charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
- charset1 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 1);
+ charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
+ charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1);
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 = CHARSET_FROM_ID (CODING_ISO_DESIGNATION (coding, 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 = CHARSET_FROM_ID (CODING_ISO_DESIGNATION (coding, 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[0] == '%'
&& src[1] == '@')
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 (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATION))
+ goto invalid_code;
if (c1 >= 0x28 && c1 <= 0x2B)
{ /* designation of DIMENSION1_CHARS94 character set */
ONE_MORE_BYTE (c2);
- DECODE_DESIGNATION (c1 - 0x28, 1, 94, c2);
+ DECODE_DESIGNATION (c1 - 0x28, 1, 0, c2);
}
else if (c1 >= 0x2C && c1 <= 0x2F)
{ /* designation of DIMENSION1_CHARS96 character set */
ONE_MORE_BYTE (c2);
- DECODE_DESIGNATION (c1 - 0x2C, 1, 96, c2);
+ DECODE_DESIGNATION (c1 - 0x2C, 1, 1, c2);
}
else
- goto label_invalid_code;
+ goto invalid_code;
/* We must update these variables now. */
- charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
- charset1 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 1);
+ charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
+ charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1);
continue;
}
}
+ if (charset->id != charset_ascii
+ && last_id != charset->id)
+ {
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, last_offset, char_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++;
- EMIT_CHAR (c);
+ consumed_chars = consumed_chars_base;
+ ONE_MORE_BYTE (c);
+ *charbuf++ = 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, last_offset, char_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) \
+ { \
+ id = charset_jisx0208_1978; \
+ charset = CHARSET_FROM_ID (id); \
+ } \
+ \
+ if (CODING_ISO_SINGLE_SHIFTING (coding)) \
{ \
- if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS) \
- *dst++ = c1 & 0x7F, *dst++ = c2 & 0x7F; \
+ 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;
- unsigned char *src, *src_end, *dst;
+ 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;
- unsigned char *source, *destination;
- int src_bytes, dst_bytes;
{
- unsigned char *src = source;
- 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). */
- 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;
+ int preferred_charset_id = -1;
- if (coding->flags & CODING_FLAG_ISO_SAFE)
- coding->mode |= CODING_MODE_INHIBIT_UNENCODABLE_CHAR;
+ CODING_GET_INFO (coding, attrs, eol_type, charset_list);
+ setup_iso_safe_charsets (attrs);
+ /* Charset list may have been changed. */
+ charset_list = CODING_ATTR_CHARSET_LIST (attrs); \
- coding->safe_charsets
- = (char *) XSTRING (CODING_ATTR_SAFE_CHARSETS(attrs))->data;
++ coding->safe_charsets = (char *) SDATA (CODING_ATTR_SAFE_CHARSETS(attrs));
- safe_chars = coding_safe_chars (coding->symbol);
+ ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
- 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;
- }
-
- coding->consumed_char = 0;
- coding->errors = 0;
- while (1)
+ while (charbuf < charbuf_end)
{
- src_base = src;
+ ASSURE_DESTINATION (safe_room);
- if (dst >= (dst_bytes ? adjusted_dst_end : (src - 19)))
+ if (bol_designation)
{
- coding->result = CODING_FINISH_INSUFFICIENT_DST;
- break;
- }
+ unsigned char *dst_prev = dst;
- if (coding->flags & CODING_FLAG_ISO_DESIGNATE_AT_BOL
- && CODING_SPEC_ISO_BOL (coding))
- {
/* 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[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);
-
/* 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 ();
+ }
+ coding->result = 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;
{
- unsigned char *src = coding->source, *src_base = src;
- unsigned char *src_end = coding->source + coding->src_bytes;
++ 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 found = 0;
int c;
- /* Dummy for ONE_MORE_BYTE. */
- struct coding_system dummy_coding;
- struct coding_system *coding = &dummy_coding;
+ int incomplete;
+
+ 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);
+ incomplete = 0;
+ ONE_MORE_BYTE (c);
+ incomplete = 1;
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);
+ 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 (incomplete && coding->mode & CODING_MODE_LAST_BLOCK)
+ {
+ detect_info->rejected |= CATEGORY_MASK_SJIS;
+ return 0;
}
- label_end_of_loop:
- return CODING_CATEGORY_MASK_SJIS;
+ 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;
{
- unsigned char *src = coding->source, *src_base = src;
- unsigned char *src_end = coding->source + coding->src_bytes;
++ 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 found = 0;
int c;
- /* 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);
- if (c < 0x80)
- continue;
- if (c < 0xA1 || c > 0xFE)
- return 0;
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep);
- if (c < 0x40 || (c > 0x7F && c < 0xA1) || c > 0xFE)
- return 0;
- }
- label_end_of_loop:
- return CODING_CATEGORY_MASK_BIG5;
- }
-
- /* 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. */
-
- #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)
+ int incomplete;
- static int
- detect_coding_utf_8 (src, src_end, multibytep)
- unsigned char *src, *src_end;
- int multibytep;
- {
- unsigned char c;
- int seq_maybe_bytes;
- /* 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);
- if (UTF_8_1_OCTET_P (c))
+ incomplete = 0;
+ ONE_MORE_BYTE (c);
+ incomplete = 1;
+ if (c < 0x80)
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;
- else
- return 0;
-
- do
+ if (c >= 0xA1)
{
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep);
- if (!UTF_8_EXTRA_OCTET_P (c))
+ ONE_MORE_BYTE (c);
+ if (c < 0x40 || (c >= 0x7F && c <= 0xA0))
return 0;
- seq_maybe_bytes--;
+ found = CATEGORY_MASK_BIG5;
}
- while (seq_maybe_bytes > 0);
+ else
+ break;
}
+ detect_info->rejected |= CATEGORY_MASK_BIG5;
+ return 0;
- label_end_of_loop:
- return CODING_CATEGORY_MASK_UTF_8;
+ no_more_source:
+ if (incomplete && 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-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. */
+ /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions".
+ If SJIS_P is 1, decode SJIS text, else decode BIG5 test. */
- #define UTF_16_INVALID_P(val) \
- (((val) == 0xFFFE) \
- || ((val) == 0xFFFF))
+ static void
+ decode_coding_sjis (coding)
+ struct coding_system *coding;
+ {
- unsigned char *src = coding->source + coding->consumed;
- unsigned char *src_end = coding->source + coding->src_bytes;
- unsigned char *src_base;
++ 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;
+ int *charbuf_end = 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;
+ Lisp_Object attrs, eol_type, charset_list, val;
+ int char_offset = coding->produced_char;
+ int last_offset = char_offset;
+ int last_id = charset_ascii;
+
+ CODING_GET_INFO (coding, attrs, eol_type, 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)));
- #define UTF_16_HIGH_SURROGATE_P(val) \
- (((val) & 0xD800) == 0xD800)
+ while (1)
+ {
+ int c, c1;
- #define UTF_16_LOW_SURROGATE_P(val) \
- (((val) & 0xDC00) == 0xDC00)
+ src_base = src;
+ consumed_chars_base = consumed_chars;
- static int
- detect_coding_utf_16 (src, src_end, multibytep)
- unsigned char *src, *src_end;
- int multibytep;
- {
- unsigned char c1, c2;
- /* Dummy for ONE_MORE_BYTE_CHECK_MULTIBYTE. */
- struct coding_system dummy_coding;
- struct coding_system *coding = &dummy_coding;
+ if (charbuf >= charbuf_end)
+ break;
+
+ ONE_MORE_BYTE (c);
+
+ if (c == '\r')
+ {
+ if (EQ (eol_type, Qdos))
+ {
+ if (src == src_end)
+ {
+ coding->result = CODING_RESULT_INSUFFICIENT_SRC;
+ goto no_more_source;
+ }
+ if (*src == '\n')
+ ONE_MORE_BYTE (c);
+ }
+ else if (EQ (eol_type, Qmac))
+ c = '\n';
+ }
+ else
+ {
+ struct charset *charset;
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c1, multibytep);
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c2, multibytep);
+ if (c < 0x80)
+ charset = charset_roman;
+ else
+ {
+ if (c >= 0xF0)
+ goto invalid_code;
+ if (c < 0xA0 || c >= 0xE0)
+ {
+ /* 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 > 0xA0)
+ {
+ /* SJIS -> JISX0201-Kana */
+ c &= 0x7F;
+ charset = charset_kana;
+ }
+ else
+ goto invalid_code;
+ }
+ if (charset->id != charset_ascii
+ && last_id != charset->id)
+ {
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, last_offset, char_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;
- 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;
+ 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++;
+ }
- label_end_of_loop:
- return 0;
+ no_more_source:
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, last_offset, char_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 `decode_coding_XXX ()' functions".
- If SJIS_P is 1, decode SJIS text, else decode BIG5 test. */
-
static void
- decode_coding_sjis_big5 (coding, source, destination,
- src_bytes, dst_bytes, sjis_p)
+ decode_coding_big5 (coding)
struct coding_system *coding;
- unsigned char *source, *destination;
- int src_bytes, dst_bytes;
- int sjis_p;
{
- 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 code
- (within macro ONE_MORE_BYTE), or when there's not enough
- destination area to produce a character (within macro
- EMIT_CHAR). */
- unsigned char *src = coding->source + coding->consumed;
- unsigned char *src_end = coding->source + coding->src_bytes;
-- unsigned char *src_base;
- Lisp_Object translation_table;
-
- 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;
- }
++ 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;
+ int *charbuf_end = 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, eol_type, charset_list, val;
+ int char_offset = coding->produced_char;
+ int last_offset = char_offset;
+ int last_id = charset_ascii;
+
+ CODING_GET_INFO (coding, attrs, eol_type, charset_list);
+ val = charset_list;
+ charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
+ charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val)));
- coding->produced_char = 0;
while (1)
{
- int c, charset, c1, c2;
+ int c, c1;
src_base = src;
- ONE_MORE_BYTE (c1);
+ consumed_chars_base = consumed_chars;
+
+ if (charbuf >= charbuf_end)
+ break;
+
+ ONE_MORE_BYTE (c);
- if (c1 < 0x80)
+ if (c == '\r')
{
- charset = CHARSET_ASCII;
- if (c1 < 0x20)
+ if (EQ (eol_type, Qdos))
{
- 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))
+ if (src == src_end)
{
- coding->result = CODING_FINISH_INCONSISTENT_EOL;
- goto label_end_of_loop;
+ coding->result = CODING_RESULT_INSUFFICIENT_SRC;
+ goto no_more_source;
}
+ if (*src == '\n')
+ ONE_MORE_BYTE (c);
}
+ else if (EQ (eol_type, Qmac))
+ c = '\n';
}
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;
- }
+ {
+ struct charset *charset;
+ if (c < 0x80)
+ charset = charset_roman;
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);
+ 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, last_offset, char_offset, last_id);
+ last_id = charset->id;
+ last_offset = char_offset;
}
+ CODING_DECODE_CHAR (coding, src, src_base, src_end, charset, c, c);
}
- c = DECODE_ISO_CHARACTER (charset, c1, c2);
- EMIT_CHAR (c);
+ *charbuf++ = c;
+ char_offset++;
continue;
- label_invalid_code:
- coding->errors++;
+ invalid_code:
src = src_base;
- c = *src++;
- EMIT_CHAR (c);
+ consumed_chars = consumed_chars_base;
+ ONE_MORE_BYTE (c);
+ *charbuf++ = 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, last_offset, char_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".
charsets are produced without any encoding. If SJIS_P is 1, encode
SJIS text, else encode BIG5 text. */
- static void
- encode_coding_sjis_big5 (coding, source, destination,
- src_bytes, dst_bytes, sjis_p)
+ static int
+ encode_coding_sjis (coding)
struct coding_system *coding;
- unsigned char *source, *destination;
- int src_bytes, dst_bytes;
- int sjis_p;
{
- 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;
-
- 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;
- }
+ 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, eol_type, charset_list, val;
+ int ascii_compatible;
+ struct charset *charset_roman, *charset_kanji, *charset_kana;
+ int c;
- while (1)
- {
- int c, charset, c1, c2;
+ CODING_GET_INFO (coding, attrs, eol_type, 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)));
- src_base = src;
- ONE_MORE_CHAR (c);
+ ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
+ while (charbuf < charbuf_end)
+ {
+ ASSURE_DESTINATION (safe_room);
+ c = *charbuf++;
/* Now encode the character C. */
- if (SINGLE_BYTE_CHAR_P (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
{
- switch (c)
+ unsigned code;
+ struct charset *charset = char_charset (c, charset_list, &code);
+
+ if (!charset)
{
- case '\r':
- if (!(coding->mode & CODING_MODE_SELECTIVE_DISPLAY))
+ if (coding->mode & CODING_MODE_SAFE_ENCODING)
{
- EMIT_ONE_BYTE (c);
- break;
+ code = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
+ charset = CHARSET_FROM_ID (charset_ascii);
}
- c = '\n';
- case '\n':
- if (coding->eol_type == CODING_EOL_CRLF)
+ else
{
- EMIT_TWO_BYTES ('\r', c);
- break;
+ c = coding->default_char;
+ charset = char_charset (c, charset_list, &code);
}
- else if (coding->eol_type == CODING_EOL_CR)
- c = '\r';
- default:
- EMIT_ONE_BYTE (c);
}
+ 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
+ EMIT_ONE_ASCII_BYTE (code & 0x7F);
+ }
+ }
+ coding->result = 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, eol_type, charset_list, val;
+ int ascii_compatible;
+ struct charset *charset_roman, *charset_big5;
+ int c;
+
+ CODING_GET_INFO (coding, attrs, eol_type, 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
{
- SPLIT_CHAR (c, charset, c1, c2);
- if (sjis_p)
+ unsigned code;
+ struct charset *charset = char_charset (c, charset_list, &code);
+
+ if (! charset)
{
- if (charset == charset_jisx0208
- || charset == charset_jisx0208_1978)
+ if (coding->mode & CODING_MODE_SAFE_ENCODING)
{
- ENCODE_SJIS (c1, c2, c1, c2);
- EMIT_TWO_BYTES (c1, c2);
+ code = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
+ charset = CHARSET_FROM_ID (charset_ascii);
}
- 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)
+ else
{
- EMIT_ONE_BYTE (CODING_REPLACEMENT_CHARACTER);
- if (CHARSET_WIDTH (charset) > 1)
- EMIT_ONE_BYTE (CODING_REPLACEMENT_CHARACTER);
+ c = coding->default_char;
+ charset = char_charset (c, charset_list, &code);
}
- else
- /* There's no way other than producing the internal
- codes as is. */
- EMIT_BYTES (src_base, src);
}
- else
+ if (code == CHARSET_INVALID_CODE (charset))
+ abort ();
+ if (charset == charset_big5)
{
- if (charset == charset_big5_1 || charset == charset_big5_2)
- {
- ENCODE_BIG5 (charset, c1, c2, c1, c2);
- EMIT_TWO_BYTES (c1, c2);
- }
- 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);
+ int c1, c2;
+
+ c1 = code >> 8, c2 = code & 0xFF;
+ EMIT_TWO_BYTES (c1, c2);
}
+ else
+ EMIT_ONE_ASCII_BYTE (code & 0x7F);
}
- coding->consumed_char++;
}
-
- label_end_of_loop:
- coding->consumed = src_base - source;
- coding->produced = coding->produced_char = dst - destination;
+ coding->result = CODING_RESULT_SUCCESS;
+ coding->produced_char += produced_chars;
+ coding->produced = dst - coding->destination;
+ return 0;
}
\f
- /*** 5. CCL handlers ***/
+ /*** 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
- CODING_CATEGORY_MASK_CCL, else return 0. */
+ CATEGORY_MASK_CCL, else return 0. */
static int
- detect_coding_ccl (src, src_end, multibytep)
- unsigned char *src, *src_end;
- int multibytep;
+ detect_coding_ccl (coding, detect_info)
+ struct coding_system *coding;
+ struct coding_detection_info *detect_info;
{
- unsigned char *valid;
- int c;
- /* Dummy for ONE_MORE_BYTE. */
- struct coding_system dummy_coding;
- struct coding_system *coding = &dummy_coding;
- unsigned char *src = coding->source, *src_base = src;
- unsigned char *src_end = coding->source + coding->src_bytes;
++ 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 found = 0;
+ unsigned char *valids = CODING_CCL_VALIDS (coding);
+ int head_ascii = coding->head_ascii;
+ Lisp_Object attrs;
+
+ detect_info->checked |= CATEGORY_MASK_CCL;
+
+ coding = &coding_categories[coding_category_ccl];
+ attrs = CODING_ID_ATTRS (coding->id);
+ if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
+ src += head_ascii;
- /* No coding system is assigned to coding-category-ccl. */
- if (!coding_system_table[CODING_CATEGORY_IDX_CCL])
- return 0;
-
- valid = coding_system_table[CODING_CATEGORY_IDX_CCL]->spec.ccl.valid_codes;
while (1)
{
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep);
- if (! valid[c])
- return 0;
+ int c;
+ ONE_MORE_BYTE (c);
+ if (! 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;
+ }
+
+ static void
+ decode_coding_ccl (coding)
+ struct coding_system *coding;
+ {
+ const unsigned char *src = coding->source + coding->consumed;
- unsigned char *src_end = coding->source + coding->src_bytes;
++ const unsigned char *src_end = coding->source + coding->src_bytes;
+ int *charbuf = coding->charbuf;
+ int *charbuf_end = 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, eol_type, charset_list;
+
+ CODING_GET_INFO (coding, attrs, eol_type, 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
+ while (i < 1024 && p < src_end)
+ source_charbuf[i++] = *p++;
-
++
+ 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)
+ {
+ 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;
+ }
+ if (source < source_end)
+ src += source_byteidx[source - source_charbuf];
+ else
+ src = p;
+ consumed_chars += source - source_charbuf;
+
+ if (ccl.status != CCL_STAT_SUSPEND_BY_SRC
+ && ccl.status != CODING_RESULT_INSUFFICIENT_SRC)
+ break;
+ }
+
+ switch (ccl.status)
+ {
+ case CCL_STAT_SUSPEND_BY_SRC:
+ coding->result = CODING_RESULT_INSUFFICIENT_SRC;
+ break;
+ case CCL_STAT_SUSPEND_BY_DST:
+ break;
+ case CCL_STAT_QUIT:
+ case CCL_STAT_INVALID_CMD:
+ coding->result = CODING_RESULT_INTERRUPT;
+ break;
+ default:
+ coding->result = CODING_RESULT_SUCCESS;
+ break;
+ }
+ coding->consumed_char += consumed_chars;
+ coding->consumed = src - coding->source;
+ coding->charbuf_used = charbuf - coding->charbuf;
+ }
+
+ static int
+ encode_coding_ccl (coding)
+ struct coding_system *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;
+ unsigned char *adjusted_dst_end = dst_end - 1;
+ int destination_charbuf[1024];
+ int i, produced_chars = 0;
+ Lisp_Object attrs, eol_type, charset_list;
+
+ CODING_GET_INFO (coding, attrs, eol_type, 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 && dst < adjusted_dst_end)
+ {
+ int dst_bytes = dst_end - dst;
+ if (dst_bytes > 1024)
+ dst_bytes = 1024;
+
+ ccl_driver (&ccl, charbuf, destination_charbuf,
+ charbuf_end - charbuf, dst_bytes, charset_list);
+ charbuf += ccl.consumed;
+ if (multibytep)
+ for (i = 0; i < ccl.produced; i++)
+ EMIT_ONE_BYTE (destination_charbuf[i] & 0xFF);
+ else
+ {
+ for (i = 0; i < ccl.produced; i++)
+ *dst++ = destination_charbuf[i] & 0xFF;
+ produced_chars += ccl.produced;
+ }
+ }
+
+ switch (ccl.status)
+ {
+ case CCL_STAT_SUSPEND_BY_SRC:
+ coding->result = CODING_RESULT_INSUFFICIENT_SRC;
+ break;
+ case CCL_STAT_SUSPEND_BY_DST:
+ coding->result = CODING_RESULT_INSUFFICIENT_DST;
+ break;
+ case CCL_STAT_QUIT:
+ case CCL_STAT_INVALID_CMD:
+ coding->result = CODING_RESULT_INTERRUPT;
+ break;
+ default:
+ coding->result = CODING_RESULT_SUCCESS;
+ break;
}
- label_end_of_loop:
- return CODING_CATEGORY_MASK_CCL;
+
+ coding->produced_char += produced_chars;
+ coding->produced = dst - coding->destination;
+ return 0;
}
+
\f
- /*** 6. End-of-line handlers ***/
+ /*** 10, 11. no-conversion handlers ***/
/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
static void
- decode_eol (coding, source, destination, src_bytes, dst_bytes)
+ decode_coding_raw_text (coding)
struct coding_system *coding;
- unsigned char *source, *destination;
- int src_bytes, dst_bytes;
{
- unsigned char *src = source;
- unsigned char *dst = destination;
- 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). */
- unsigned char *src_base;
+ coding->chars_at_source = 1;
+ coding->consumed_char = 0;
+ coding->consumed = 0;
+ coding->result = CODING_RESULT_SUCCESS;
+ }
+
+ 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;
- translation_table = Qnil;
- switch (coding->eol_type)
+ if (multibytep)
+ {
+ int safe_room = MAX_MULTIBYTE_LENGTH * 2;
+
+ 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;
+
+ 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
{
- case CODING_EOL_CRLF:
- while (1)
+ if (coding->src_multibyte)
{
- src_base = src;
- ONE_MORE_BYTE (c);
- if (c == '\r')
- {
- ONE_MORE_BYTE (c);
- if (c != '\n')
- {
- src--;
- c = '\r';
- }
- }
- else if (c == '\n'
- && (coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL))
+ int safe_room = MAX_MULTIBYTE_LENGTH;
+
+ while (charbuf < charbuf_end)
{
- 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++;
}
- EMIT_CHAR (c);
}
- break;
+ else
+ {
+ ASSURE_DESTINATION (charbuf_end - charbuf);
+ while (charbuf < charbuf_end && dst < dst_end)
+ *dst++ = *charbuf++;
+ produced_chars = dst - (coding->destination + coding->dst_bytes);
- }
++ }
+ }
+ coding->result = 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 a charset-based coding system. If it
+ is, return 1, else return 0. */
+
+ static int
+ detect_coding_charset (coding, detect_info)
+ struct coding_system *coding;
+ struct coding_detection_info *detect_info;
+ {
- unsigned char *src = coding->source, *src_base = src;
- unsigned char *src_end = coding->source + coding->src_bytes;
++ 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;
+ Lisp_Object attrs, valids;
+ int found = 0;
+
+ 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 += coding->head_ascii;
+
+ while (1)
+ {
+ int c;
+
+ ONE_MORE_BYTE (c);
+ if (NILP (AREF (valids, c)))
+ break;
+ if (c >= 0x80)
+ found = CATEGORY_MASK_CHARSET;
+ }
+ detect_info->rejected |= CATEGORY_MASK_CHARSET;
+ return 0;
+
+ no_more_source:
+ detect_info->found |= found;
+ return 1;
+ }
- case CODING_EOL_CR:
- while (1)
+ static void
+ decode_coding_charset (coding)
+ struct coding_system *coding;
+ {
- unsigned char *src = coding->source + coding->consumed;
- unsigned char *src_end = coding->source + coding->src_bytes;
- unsigned char *src_base;
++ 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;
+ int *charbuf_end = charbuf + coding->charbuf_size - MAX_ANNOTATION_LENGTH;
+ int consumed_chars = 0, consumed_chars_base;
+ int multibytep = coding->src_multibyte;
+ Lisp_Object attrs, eol_type, charset_list, valids;
+ int char_offset = coding->produced_char;
+ int last_offset = char_offset;
+ int last_id = charset_ascii;
+
+ CODING_GET_INFO (coding, attrs, eol_type, charset_list);
+ valids = AREF (attrs, coding_attr_charset_valids);
+
+ while (1)
+ {
+ int c;
+
+ src_base = src;
+ consumed_chars_base = consumed_chars;
+
+ if (charbuf >= charbuf_end)
+ break;
+
+ ONE_MORE_BYTE (c);
+ if (c == '\r')
{
- src_base = src;
- ONE_MORE_BYTE (c);
- if (c == '\n')
+ /* Here we assume that no charset maps '\r' to something
+ else. */
+ if (EQ (eol_type, Qdos))
{
- if (coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL)
+ if (src == src_end)
{
- coding->result = CODING_FINISH_INCONSISTENT_EOL;
- goto label_end_of_loop;
+ coding->result = CODING_RESULT_INSUFFICIENT_SRC;
+ goto no_more_source;
}
+ if (*src == '\n')
+ ONE_MORE_BYTE (c);
}
- else if (c == '\r')
+ else if (EQ (eol_type, Qmac))
c = '\n';
- EMIT_CHAR (c);
}
- break;
-
- default: /* no need for EOL handling */
- while (1)
+ else
{
- src_base = src;
- ONE_MORE_BYTE (c);
- EMIT_CHAR (c);
+ Lisp_Object val;
+ struct charset *charset;
+ int dim;
+ int len = 1;
+ unsigned code = c;
+
+ val = AREF (valids, c);
+ if (NILP (val))
+ goto invalid_code;
+ if (INTEGERP (val))
+ {
+ charset = CHARSET_FROM_ID (XFASTINT (val));
+ dim = CHARSET_DIMENSION (charset);
+ while (len < dim)
+ {
+ ONE_MORE_BYTE (c);
+ code = (code << 8) | c;
+ len++;
+ }
+ CODING_DECODE_CHAR (coding, src, src_base, src_end,
+ charset, code, c);
+ }
+ else
+ {
+ /* 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))
+ {
+ charset = CHARSET_FROM_ID (XFASTINT (XCAR (val)));
+ dim = CHARSET_DIMENSION (charset);
+ while (len < dim)
+ {
+ 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);
+ }
+ }
+ if (c < 0)
+ goto invalid_code;
+ if (charset->id != charset_ascii
+ && last_id != charset->id)
+ {
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, last_offset, char_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++ = 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, last_offset, char_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 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, eol_type, charset_list;
+ int ascii_compatible;
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;
- }
+ CODING_GET_INFO (coding, attrs, eol_type, charset_list);
+ ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
- 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
+ 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;
+ coding->result = 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));
+ if (NILP (coding_system))
+ coding_system = Qno_conversion;
- /* 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;
+ CHECK_CODING_SYSTEM_GET_ID (coding_system, coding->id);
- if (NILP (coding_system))
- goto label_invalid_coding_system;
+ attrs = CODING_ID_ATTRS (coding->id);
+ eol_type = CODING_ID_EOL_TYPE (coding->id);
- coding_spec = Fget (coding_system, Qcoding_system);
+ coding->mode = 0;
+ coding->head_ascii = -1;
+ coding->common_flags
+ = (VECTORP (eol_type) ? CODING_REQUIRE_DETECTION_MASK : 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;
- if (!VECTORP (coding_spec)
- || XVECTOR (coding_spec)->size != 5
- || !CONSP (XVECTOR (coding_spec)->contents[3]))
- goto label_invalid_coding_system;
+ val = CODING_ATTR_SAFE_CHARSETS (attrs);
- coding->max_charset_id = XSTRING (val)->size - 1;
- coding->safe_charsets = (char *) XSTRING (val)->data;
++ coding->max_charset_id = SCHARS (val) - 1;
++ coding->safe_charsets = (char *) SDATA (val);
+ coding->default_char = XINT (CODING_ATTR_DEFAULT_CHAR (attrs));
- eol_type = inhibit_eol_conversion ? Qnil : Fget (coding_system, Qeol_type);
- if (VECTORP (eol_type))
+ coding_type = CODING_ATTR_TYPE (attrs);
+ if (EQ (coding_type, Qundecided))
{
- coding->eol_type = CODING_EOL_UNDECIDED;
- coding->common_flags = CODING_REQUIRE_DETECTION_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 = XSTRING (val)->size - 1;
- coding->safe_charsets = (char *) XSTRING (val)->data;
++ 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
- coding->eol_type = CODING_EOL_LF;
-
- coding_type = XVECTOR (coding_spec)->contents[0];
- /* Try short cut. */
- if (SYMBOLP (coding_type))
+ else if (EQ (coding_type, Qutf_8))
{
- if (EQ (coding_type, Qt))
- {
- coding->type = coding_type_undecided;
- coding->common_flags |= CODING_REQUIRE_DETECTION_MASK;
- }
- 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;
+ 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;
}
- 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;
-
- switch (XFASTINT (coding_type))
+ else if (EQ (coding_type, Qccl))
{
- 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->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;
- break;
-
- case 2:
- coding->type = coding_type_iso2022;
+ |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK
+ | CODING_REQUIRE_FLUSHING_MASK);
+ }
+ else if (EQ (coding_type, Qemacs_mule))
+ {
+ 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;
- {
- 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_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))
+ {
+ 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))
- XSTRING (safe_charsets)->data[XFASTINT (XCAR (tail))] = 0;
++ SSET (safe_charsets, XFASTINT (XCAR (tail)), 0);
+ coding->max_charset_id = max_charset_id;
- coding->safe_charsets = (char *) XSTRING (safe_charsets)->data;
++ coding->safe_charsets = (char *) SDATA (safe_charsets);
+ }
+ }
+ else if (EQ (coding_type, Qshift_jis))
+ {
+ 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;
-
- default:
- goto label_invalid_coding_system;
+ |= (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;
- coding->common_flags |= CODING_FOR_UNIBYTE_MASK;
}
- 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_LF;
- coding->pre_write_conversion = coding->post_read_conversion = Qnil;
- return -1;
+ return;
}
- /* Free memory blocks allocated for storing composition information. */
+ /* Return raw-text or one of its subsidiaries that has the same
+ eol_type as CODING-SYSTEM. */
- void
- coding_free_composition_data (coding)
- struct coding_system *coding;
+ Lisp_Object
+ raw_text_coding_system (coding_system)
+ Lisp_Object coding_system;
{
- struct composition_data *cmp_data = coding->cmp_data, *next;
-
- 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)
- {
- next = cmp_data->next;
- xfree (cmp_data);
- cmp_data = next;
- }
- coding->cmp_data = NULL;
- }
+ Lisp_Object spec, attrs;
+ Lisp_Object eol_type, raw_text_eol_type;
- /* Set `char_offset' member of all memory blocks pointed by
- coding->cmp_data to POS. */
+ if (NILP (coding_system))
+ return Qraw_text;
+ spec = CODING_SYSTEM_SPEC (coding_system);
+ attrs = AREF (spec, 0);
-
+
- void
- coding_adjust_composition_offset (coding, pos)
- struct coding_system *coding;
- int pos;
- {
- struct composition_data *cmp_data;
+ 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. */
+
+ Lisp_Object
+ coding_inherit_eol_type (coding_system, parent)
+ Lisp_Object coding_system, parent;
{
- if (coding->type != coding_type_raw_text)
- {
- coding->symbol = Qraw_text;
- coding->type = coding_type_raw_text;
- if (coding->eol_type != CODING_EOL_UNDECIDED)
- {
- Lisp_Object subsidiaries;
- subsidiaries = Fget (Qraw_text, Qeol_type);
+ Lisp_Object spec, attrs, eol_type;
- if (VECTORP (subsidiaries)
- && XVECTOR (subsidiaries)->size == 3)
- coding->symbol
- = XVECTOR (subsidiaries)->contents[coding->eol_type];
- }
- setup_coding_system (coding->symbol, coding);
- }
- return;
+ if (NILP (coding_system))
+ coding_system = Qraw_text;
+ spec = CODING_SYSTEM_SPEC (coding_system);
+ attrs = AREF (spec, 0);
+ eol_type = AREF (spec, 2);
+ if (VECTORP (eol_type)
+ && ! NILP (parent))
+ {
+ Lisp_Object parent_spec;
+ Lisp_Object parent_eol_type;
+
+ parent_spec
+ = CODING_SYSTEM_SPEC (buffer_defaults.buffer_file_coding_system);
+ parent_eol_type = AREF (parent_spec, 2);
+ 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];
+ #define EOL_SEEN_NONE 0
+ #define EOL_SEEN_LF 1
+ #define EOL_SEEN_CR 2
+ #define EOL_SEEN_CRLF 4
- /* 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.
+ /* Detect how end-of-line of a text of length SRC_BYTES pointed by
+ 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.
+
+ Return one of EOL_SEEN_XXX. */
- How many ASCII characters are at the head is returned as *SKIP. */
+ #define MAX_EOL_CHECK_COUNT 3
static int
- detect_coding_mask (source, src_bytes, priorities, skip, multibytep)
+ detect_eol (source, src_bytes, category)
unsigned char *source;
- int src_bytes, *priorities, *skip;
- int multibytep;
+ EMACS_INT src_bytes;
+ enum coding_category category;
{
- register unsigned char c;
- unsigned char *src = source, *src_end = source + src_bytes;
- unsigned int mask, utf16_examined_p, iso2022_examined_p;
- int i;
+ unsigned char *src = source, *src_end = src + src_bytes;
+ unsigned char c;
+ int total = 0;
+ int eol_seen = EOL_SEEN_NONE;
- /* 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)
+ if ((1 << category) & CATEGORY_MASK_UTF_16)
+ {
+ int msb, lsb;
+
+ msb = category == (coding_category_utf_16_le
+ | coding_category_utf_16_le_nosig);
+ lsb = 1 - msb;
+
+ while (src + 1 < src_end)
{
- for (i = 0; i < CODING_CATEGORY_IDX_MAX; i++)
+ c = src[lsb];
+ if (src[msb] == 0 && (c == '\n' || c == '\r'))
{
- if (mask & priorities[i])
- return priorities[i];
+ 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;
++ this_eol = EOL_SEEN_CRLF;
+
+ 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 CODING_CATEGORY_MASK_RAW_TEXT;
+ src += 2;
}
- }
+ }
else
{
- int try;
+ while (src < src_end)
+ {
+ c = *src++;
+ if (c == '\n' || c == '\r')
+ {
+ int this_eol;
+
+ 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++;
+
+ 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;
+ }
+
+
+ static void
+ adjust_coding_eol_type (coding, eol_seen)
+ struct coding_system *coding;
+ int eol_seen;
+ {
+ Lisp_Object eol_type;
-
++
+ eol_type = CODING_ID_EOL_TYPE (coding->id);
+ if (eol_seen & EOL_SEEN_LF)
+ coding->id = CODING_SYSTEM_ID (AREF (eol_type, 0));
+ else if (eol_seen & EOL_SEEN_CRLF)
+ coding->id = CODING_SYSTEM_ID (AREF (eol_type, 1));
+ else if (eol_seen & EOL_SEEN_CR)
+ coding->id = CODING_SYSTEM_ID (AREF (eol_type, 2));
+ }
- if (multibytep && c == LEADING_CODE_8_BIT_CONTROL)
- c = src[1] - 0x20;
+ /* Detect how a text specified in CODING is encoded. If a coding
+ system is detected, update fields of CODING by the detected coding
+ system. */
- if (c < 0xA0)
+ void
+ detect_coding (coding)
+ struct coding_system *coding;
+ {
- unsigned char *src, *src_end;
++ const unsigned char *src, *src_end;
+ Lisp_Object attrs, coding_type;
+
+ coding->consumed = coding->consumed_char = 0;
+ coding->produced = coding->produced_char = 0;
+ coding_set_source (coding);
+
+ src_end = coding->source + coding->src_bytes;
+
+ /* If we have not yet decided the text encoding type, detect it
+ now. */
+ if (EQ (CODING_ATTR_TYPE (CODING_ID_ATTRS (coding->id)), Qundecided))
+ {
+ int c, i;
+
+ for (src = coding->source; src < src_end; src++)
{
- /* 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);
+ c = *src;
+ if (c & 0x80 || (c < 0x20 && (c == ISO_CODE_ESC
+ || c == ISO_CODE_SI
+ || c == ISO_CODE_SO)))
+ break;
}
- 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)
+ coding->head_ascii = src - (coding->source + coding->consumed);
+
+ if (coding->head_ascii < coding->src_bytes)
{
- for (i = 0; i < CODING_CATEGORY_IDX_MAX; i++)
+ struct coding_detection_info detect_info;
+ enum coding_category category;
+ struct coding_system *this;
+
+ detect_info.checked = detect_info.found = detect_info.rejected = 0;
+ for (i = 0; i < coding_category_raw_text; i++)
{
- if (!iso2022_examined_p
- && (priorities[i] & try & CODING_CATEGORY_MASK_ISO))
+ category = coding_priorities[i];
+ this = coding_categories + category;
+ if (this->id < 0)
{
- mask |= detect_coding_iso2022 (src, src_end, multibytep);
- iso2022_examined_p = 1;
+ /* No coding system of this category is defined. */
+ detect_info.rejected |= (1 << category);
}
- 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))
+ else if (category >= coding_category_raw_text)
+ continue;
+ else if (detect_info.checked & (1 << category))
{
- mask |= detect_coding_utf_16 (src, src_end, multibytep);
- utf16_examined_p = 1;
+ if (detect_info.found & (1 << category))
+ break;
}
- 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];
+ else if ((*(this->detector)) (coding, &detect_info)
+ && detect_info.found & (1 << category))
+ break;
}
- return CODING_CATEGORY_MASK_RAW_TEXT;
+ 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;
+ }
}
- 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);
- }
+ }
+ else if (EQ (CODING_ATTR_TYPE (CODING_ID_ATTRS (coding->id)), Qutf_16))
+ {
+ 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)
+ && (detect_info.found & (CATEGORY_MASK_UTF_16_LE
+ | CATEGORY_MASK_UTF_16_BE)))
+ {
+ if (detect_info.found & CATEGORY_MASK_UTF_16_LE)
+ setup_coding_system (XCAR (coding_systems), coding);
+ else
+ setup_coding_system (XCDR (coding_systems), coding);
+ }
+ }
- /* Detect how a text of length SRC_BYTES pointed by SRC is encoded.
- The information of the detected coding system is set in CODING. */
+ attrs = CODING_ID_ATTRS (coding->id);
+ coding_type = CODING_ATTR_TYPE (attrs);
- 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;
+ /* If we have not yet decided the EOL type, detect it now. But, the
+ detection is impossible for a CCL based coding system, in which
+ case, we detct the EOL type after decoding. */
+ if (VECTORP (CODING_ID_EOL_TYPE (coding->id))
+ && ! EQ (coding_type, Qccl))
+ {
+ int eol_seen = detect_eol (coding->source, coding->src_bytes,
+ XINT (CODING_ATTR_CATEGORY (attrs)));
- val = Vcoding_category_list;
- mask = detect_coding_mask (src, src_bytes, coding_priorities, &skip,
- coding->src_multibyte);
- coding->heading_ascii = skip;
+ if (eol_seen != EOL_SEEN_NONE)
+ adjust_coding_eol_type (coding, eol_seen);
+ }
+ }
- 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;
+ static void
+ decode_eol (coding)
+ struct coding_system *coding;
+ {
+ if (VECTORP (CODING_ID_EOL_TYPE (coding->id)))
+ {
+ unsigned char *p = CHAR_POS_ADDR (coding->dst_pos);
+ unsigned char *pend = p + coding->produced;
+ int eol_seen = EOL_SEEN_NONE;
- val = SYMBOL_VALUE (XVECTOR (Vcoding_category_table)->contents[idx]);
+ for (; p < pend; p++)
+ {
+ if (*p == '\n')
+ eol_seen |= EOL_SEEN_LF;
+ else if (*p == '\r')
+ {
+ if (p + 1 < pend && *(p + 1) == '\n')
+ {
+ eol_seen |= EOL_SEEN_CRLF;
+ p++;
+ }
+ else
+ eol_seen |= EOL_SEEN_CR;
+ }
+ }
+ if (eol_seen != EOL_SEEN_NONE)
+ adjust_coding_eol_type (coding, eol_seen);
+ }
- if (coding->eol_type != CODING_EOL_UNDECIDED)
+ if (EQ (CODING_ID_EOL_TYPE (coding->id), Qmac))
{
- Lisp_Object tmp;
+ unsigned char *p = CHAR_POS_ADDR (coding->dst_pos);
+ unsigned char *pend = p + coding->produced;
-
+
- tmp = Fget (val, Qeol_type);
- if (VECTORP (tmp))
- val = XVECTOR (tmp)->contents[coding->eol_type];
+ for (; p < pend; p++)
+ if (*p == '\r')
+ *p = '\n';
}
+ else if (EQ (CODING_ID_EOL_TYPE (coding->id), Qdos))
+ {
+ unsigned char *p, *pbeg, *pend;
+ Lisp_Object undo_list;
- /* Setup this new coding system while preserving some slots. */
- {
- int src_multibyte = coding->src_multibyte;
- int dst_multibyte = coding->dst_multibyte;
+ move_gap_both (coding->dst_pos + coding->produced_char,
+ coding->dst_pos_byte + coding->produced);
+ undo_list = current_buffer->undo_list;
+ current_buffer->undo_list = Qt;
+ del_range_2 (coding->dst_pos, coding->dst_pos_byte, GPT, GPT_BYTE, 0);
+ current_buffer->undo_list = undo_list;
+ pbeg = GPT_ADDR;
+ pend = pbeg + coding->produced;
- setup_coding_system (val, coding);
- coding->src_multibyte = src_multibyte;
- coding->dst_multibyte = dst_multibyte;
- coding->heading_ascii = skip;
- }
+ for (p = pend - 1; p >= pbeg; p--)
+ if (*p == '\r')
+ {
+ safe_bcopy ((char *) (p + 1), (char *) p, pend - p - 1);
+ pend--;
+ }
+ coding->produced_char -= coding->produced - (pend - pbeg);
+ coding->produced = pend - pbeg;
+ insert_from_gap (coding->produced_char, coding->produced);
+ }
}
- /* 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.
+ static void
+ translate_chars (coding, table)
+ struct coding_system *coding;
+ Lisp_Object table;
+ {
+ int *charbuf = coding->charbuf;
+ int *charbuf_end = charbuf + coding->charbuf_used;
+ int c;
- How many non-eol characters are at the head is returned as *SKIP. */
+ if (coding->chars_at_source)
+ return;
- #define MAX_EOL_CHECK_COUNT 3
+ while (charbuf < charbuf_end)
+ {
+ c = *charbuf;
+ if (c < 0)
+ charbuf += c;
+ else
+ *charbuf++ = translate_char (table, c);
+ }
+ }
static int
- detect_eol_type (source, src_bytes, skip)
- unsigned char *source;
- int src_bytes, *skip;
+ produce_chars (coding)
+ struct coding_system *coding;
{
- 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;
+ unsigned char *dst = coding->destination + coding->produced;
+ unsigned char *dst_end = coding->destination + coding->dst_bytes;
+ int produced;
+ int produced_chars = 0;
- *skip = 0;
-
- while (src < src_end && total < MAX_EOL_CHECK_COUNT)
+ if (! coding->chars_at_source)
{
- c = *src++;
- if (c == '\n' || c == '\r')
+ /* Characters are in coding->charbuf. */
+ int *buf = coding->charbuf;
+ int *buf_end = buf + coding->charbuf_used;
+ unsigned char *adjusted_dst_end;
+
+ if (BUFFERP (coding->src_object)
+ && EQ (coding->src_object, coding->dst_object))
- dst_end = coding->source + coding->consumed;
++ dst_end = ((unsigned char *) coding->source) + coding->consumed;
+ adjusted_dst_end = dst_end - MAX_MULTIBYTE_LENGTH;
+
+ while (buf < buf_end)
{
- 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++;
+ int c = *buf++;
-
+
- 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)
+ if (dst >= adjusted_dst_end)
{
- /* The found type is different from what found before. */
- eol_type = CODING_EOL_INCONSISTENT;
- break;
+ dst = alloc_destination (coding,
+ buf_end - buf + MAX_MULTIBYTE_LENGTH,
+ dst);
+ dst_end = coding->destination + coding->dst_bytes;
+ adjusted_dst_end = dst_end - MAX_MULTIBYTE_LENGTH;
+ }
+ if (c >= 0)
+ {
+ if (coding->dst_multibyte
+ || ! CHAR_BYTE8_P (c))
+ CHAR_STRING_ADVANCE (c, dst);
+ else
+ *dst++ = CHAR_TO_BYTE8 (c);
+ produced_chars++;
}
+ else
+ /* This is an annotation datum. (-C) is the length of
+ it. */
+ buf += -c - 1;
}
}
-
- 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)
- unsigned char *source;
- int src_bytes, *skip, big_endian_p;
- {
- 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;
- unsigned char *src = coding->source;
- unsigned char *src_end = src + coding->src_bytes;
++ const unsigned char *src = coding->source;
++ const unsigned char *src_end = src + coding->src_bytes;
+ Lisp_Object eol_type;
- if (c1 == '\n' || c1 == '\r')
+ eol_type = CODING_ID_EOL_TYPE (coding->id);
+
+ if (coding->src_multibyte != coding->dst_multibyte)
{
- if (*skip == 0)
- *skip = src - 2 - source;
- total++;
- if (c1 == '\n')
+ if (coding->src_multibyte)
{
- this_eol_type = CODING_EOL_LF;
+ int multibytep = 1;
+ int consumed_chars;
+
+ while (1)
+ {
- unsigned char *src_base = src;
++ const unsigned char *src_base = src;
+ int c;
+
+ ONE_MORE_BYTE (c);
+ if (c == '\r')
+ {
+ if (EQ (eol_type, Qdos))
+ {
+ if (src == src_end)
+ {
+ coding->result = 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 = src;
++ 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
- dst_end = src;
+ while (src < src_end)
+ {
+ int multibytep = 1;
+ int c = *src++;
+
+ 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))
{
- if ((src + 1) >= src_end)
- {
- this_eol_type = CODING_EOL_CR;
- }
- else
+ int require = coding->src_bytes - coding->dst_bytes;
+
+ if (require > 0)
{
- c2 = (src[msb] << 8) | (src[lsb]);
- if (c2 == '\n')
- this_eol_type = CODING_EOL_CRLF, src += 2;
- else
- this_eol_type = CODING_EOL_CR;
+ 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;
}
}
-
- 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)
+ produced_chars = coding->src_chars;
+ while (src < src_end)
{
- /* The found type is different from what found before. */
- eol_type = CODING_EOL_INCONSISTENT;
- break;
+ int c = *src++;
+
+ if (c == '\r')
+ {
+ if (EQ (eol_type, Qdos))
+ {
+ if (src < src_end
+ && *src == '\n')
+ c = *src++;
+ produced_chars--;
+ }
+ else if (EQ (eol_type, Qmac))
+ c = '\n';
+ }
+ *dst++ = c;
}
}
+ coding->consumed = coding->src_bytes;
+ coding->consumed_char = coding->src_chars;
}
- if (*skip == 0)
- *skip = src_end - source;
- return eol_type;
+ produced = dst - (coding->destination + coding->produced);
+ if (BUFFERP (coding->dst_object))
+ insert_from_gap (produced_chars, produced);
+ coding->produced += produced;
+ coding->produced_char += produced_chars;
+ return produced_chars;
}
- /* 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. */
+ /* 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... ] ]
+ */
- void
- detect_eol (coding, src, src_bytes)
+ static INLINE void
+ produce_composition (coding, charbuf)
struct coding_system *coding;
- const unsigned char *src;
- int src_bytes;
+ int *charbuf;
{
- Lisp_Object val;
- int skip;
- int eol_type;
+ int len;
+ EMACS_INT from, to;
+ enum composition_method method;
+ Lisp_Object components;
- 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;
- }
+ len = -charbuf[0];
+ from = coding->dst_pos + charbuf[2];
+ to = coding->dst_pos + charbuf[3];
+ method = (enum composition_method) (charbuf[4]);
- if (coding->heading_ascii > skip)
- coding->heading_ascii = skip;
+ if (method == COMPOSITION_RELATIVE)
+ components = Qnil;
else
- skip = coding->heading_ascii;
-
- 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. */
-
- /* 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;
- }
-
- val = Fget (coding->symbol, Qeol_type);
- if (VECTORP (val) && XVECTOR (val)->size == 3)
{
- int src_multibyte = coding->src_multibyte;
- int dst_multibyte = coding->dst_multibyte;
- struct composition_data *cmp_data = coding->cmp_data;
+ Lisp_Object args[MAX_COMPOSITION_COMPONENTS * 2 - 1];
+ int i;
- 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;
+ len -= 5;
+ charbuf += 5;
+ for (i = 0; i < len; i++)
+ args[i] = make_number (charbuf[i]);
+ components = (method == COMPOSITION_WITH_ALTCHARS
+ ? Fstring (len, args) : Fvector (len, args));
}
+ compose_text (from, to, components, Qnil, coding->dst_object);
}
- #define CONVERSION_BUFFER_EXTRA_ROOM 256
-
- #define DECODING_BUFFER_MAG(coding) \
- (coding->type == coding_type_iso2022 \
- ? 3 \
- : (coding->type == coding_type_ccl \
- ? coding->spec.ccl.decoder.buf_magnification \
- : 2))
- /* Return maximum size (bytes) of a buffer enough for decoding
- SRC_BYTES of text encoded in CODING. */
+ /* Put `charset' property on text in CODING->object according to
+ the annotation data at CHARBUF. CHARBUF is an array:
+ [ -LENGTH ANNOTATION_MASK FROM TO CHARSET-ID ]
+ */
- int
- decoding_buffer_size (coding, src_bytes)
+ static INLINE void
+ produce_charset (coding, charbuf)
struct coding_system *coding;
- int src_bytes;
+ int *charbuf;
{
- return (src_bytes * DECODING_BUFFER_MAG (coding)
- + CONVERSION_BUFFER_EXTRA_ROOM);
+ EMACS_INT from = coding->dst_pos + charbuf[2];
+ EMACS_INT to = coding->dst_pos + charbuf[3];
+ struct charset *charset = CHARSET_FROM_ID (charbuf[4]);
+
+ Fput_text_property (make_number (from), make_number (to),
+ Qcharset, CHARSET_NAME (charset),
+ coding->dst_object);
}
- /* Return maximum size (bytes) of a buffer enough for encoding
- SRC_BYTES of text to CODING. */
- int
- encoding_buffer_size (coding, src_bytes)
+ #define CHARBUF_SIZE 0x4000
+
+ #define ALLOC_CONVERSION_WORK_AREA(coding) \
+ do { \
+ int size = CHARBUF_SIZE;; \
+ \
+ coding->charbuf = NULL; \
+ while (size > 1024) \
+ { \
+ coding->charbuf = (int *) alloca (sizeof (int) * size); \
+ if (coding->charbuf) \
+ break; \
+ size >>= 1; \
+ } \
+ if (! coding->charbuf) \
+ { \
+ coding->result = CODING_RESULT_INSUFFICIENT_MEM; \
+ return coding->result; \
+ } \
+ coding->charbuf_size = size; \
+ } while (0)
+
+
+ static void
+ produce_annotation (coding)
struct coding_system *coding;
- int src_bytes;
{
- int magnification;
+ int *charbuf = coding->charbuf;
+ int *charbuf_end = charbuf + coding->charbuf_used;
+
+ if (NILP (coding->dst_object))
+ return;
- if (coding->type == coding_type_ccl)
+ while (charbuf < charbuf_end)
{
- magnification = coding->spec.ccl.encoder.buf_magnification;
- if (coding->eol_type == CODING_EOL_CRLF)
- magnification *= 2;
+ if (*charbuf >= 0)
+ charbuf++;
+ else
+ {
+ int len = -*charbuf;
+ switch (charbuf[1])
+ {
+ case CODING_ANNOTATE_COMPOSITION_MASK:
+ produce_composition (coding, charbuf);
+ break;
+ case CODING_ANNOTATE_CHARSET_MASK:
+ produce_charset (coding, charbuf);
+ break;
+ default:
+ abort ();
+ }
+ charbuf += len;
+ }
}
- 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;
- };
+ /* 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.
- /* Don't use alloca for allocating memory space larger than this, lest
- we overflow their stack. */
- #define MAX_ALLOCA 16*1024
+ 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.
- /* 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)
+ If CODING->src_object is a string, CODING->src_pos in an index to
+ that string.
- /* Double the allocated memory for *BUF. */
- static void
- extend_conversion_buffer (buf)
- struct conversion_buffer *buf;
- {
- if (buf->on_stack)
- {
- unsigned char *save = buf->data;
- buf->data = (unsigned char *) xmalloc (buf->size * 2);
- bcopy (save, buf->data, buf->size);
- buf->on_stack = 0;
- }
- else
- {
- buf->data = (unsigned char *) xrealloc (buf->data, buf->size * 2);
- }
- buf->size *= 2;
- }
+ 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.
- /* 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);
- }
+ The decoded data is inserted at the current point of the buffer
+ CODING->dst_object.
+ */
- int
- ccl_coding_driver (coding, source, destination, src_bytes, dst_bytes, encodep)
+ static int
+ decode_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;
+ Lisp_Object attrs;
- 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)
+ 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 (BUFFERP (coding->dst_object))
{
- /* 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;
+ if (current_buffer != XBUFFER (coding->dst_object))
+ set_buffer_internal (XBUFFER (coding->dst_object));
+ if (GPT != PT)
+ move_gap_both (PT, PT_BYTE);
}
- coding->produced = (ccl_driver (ccl, source, dst, src_bytes, dst_bytes,
- &(coding->consumed))
- + dst - destination);
+ coding->consumed = coding->consumed_char = 0;
+ coding->produced = coding->produced_char = 0;
+ coding->chars_at_source = 0;
+ coding->result = CODING_RESULT_SUCCESS;
+ coding->errors = 0;
- 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
+ ALLOC_CONVERSION_WORK_AREA (coding);
+
+ attrs = CODING_ID_ATTRS (coding->id);
+
+ do
{
- /* 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)
+ coding_set_source (coding);
+ coding->annotated = 0;
+ (*(coding->decoder)) (coding);
+ if (!NILP (CODING_ATTR_DECODE_TBL (attrs)))
+ translate_chars (coding, CODING_ATTR_DECODE_TBL (attrs));
+ else if (!NILP (Vstandard_translation_table_for_decode))
+ translate_chars (coding, Vstandard_translation_table_for_decode);
+ coding_set_destination (coding);
+ produce_chars (coding);
+ if (coding->annotated)
+ produce_annotation (coding);
+ }
+ while (coding->consumed < coding->src_bytes
+ && ! coding->result);
+
+ if (EQ (CODING_ATTR_TYPE (CODING_ID_ATTRS (coding->id)), Qccl)
+ && SYMBOLP (CODING_ID_EOL_TYPE (coding->id))
+ && ! EQ (CODING_ID_EOL_TYPE (coding->id), Qunix))
+ decode_eol (coding);
+
+ coding->carryover_bytes = 0;
+ if (coding->consumed < coding->src_bytes)
+ {
+ int nbytes = coding->src_bytes - coding->consumed;
- unsigned char *src;
++ const unsigned char *src;
+
+ coding_set_source (coding);
+ coding_set_destination (coding);
+ src = coding->source + coding->consumed;
+
+ if (coding->mode & CODING_MODE_LAST_BLOCK)
{
- /* 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)
- {
- if (destination[coding->produced - 2] >= 0x80)
- {
- 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;
- }
- }
- if (carryover > 0)
+ /* Flush out unprocessed data as binary chars. We are sure
+ that the number of data is less than the size of
+ coding->charbuf. */
+ while (nbytes-- > 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;
+ int c = *src++;
+
+ coding->charbuf[coding->charbuf_used++] = (c & 0x80 ? - c : c);
}
+ produce_chars (coding);
+ }
+ else
+ {
+ /* 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->produced = str_as_multibyte (destination, bytes,
- coding->produced,
- &(coding->produced_char));
+ coding->consumed = coding->src_bytes;
}
- switch (ccl->status)
- {
- 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;
- }
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)
+ /* 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;
- unsigned char *ptr;
- int bytes;
+ int *buf;
+ EMACS_INT *stop;
{
- 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;
-
- 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;
- }
+ EMACS_INT start, end;
+ Lisp_Object prop;
- 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 (! find_composition (pos, limit, &start, &end, &prop, coding->src_object)
+ || end > limit)
+ *stop = limit;
+ else if (start > pos)
+ *stop = start;
+ else
{
- unsigned char *pstart = ptr, *p = ptr;
-
- 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)
+ if (start == pos)
{
- if (*ptr == '\r')
+ /* 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, 0, nchars, method);
+ if (method != COMPOSITION_RELATIVE)
{
- if (ptr + 1 < pend && *(ptr + 1) == '\n')
+ Lisp_Object components;
+ int len, i, i_byte;
+
+ components = COMPOSITION_COMPONENTS (prop);
+ if (VECTORP (components))
{
- *p++ = '\n';
- ptr += 2;
+ len = XVECTOR (components)->size;
+ for (i = 0; i < len; i++)
+ *buf++ = XINT (AREF (components, i));
}
- else
+ else if (STRINGP (components))
{
- if (coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL)
- goto undo_eol_conversion;
- *p++ = *ptr++;
- len = XSTRING (components)->size;
++ 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 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++;
+ abort ();
+ *head -= len;
}
- 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 (find_composition (end, limit, &start, &end, &prop,
+ coding->src_object)
+ && end <= limit)
+ *stop = start;
+ else
+ *stop = limit;
}
- else /* i.e. coding->eol_type == CODING_EOL_CR */
+ return buf;
+ }
+
+
+ /* 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.
+
+ 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;
+
+ 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, 0, id);
+ next = Fnext_single_property_change (make_number (pos), Qcharset,
+ coding->src_object,
+ make_number (limit));
+ *stop = XINT (next);
+ return buf;
+ }
+
+
+ static void
+ consume_chars (coding)
+ struct coding_system *coding;
+ {
+ 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;
+
+ eol_type = CODING_ID_EOL_TYPE (coding->id);
+ if (VECTORP (eol_type))
+ eol_type = Qunix;
+
+ /* Note: composition handling is not yet implemented. */
+ coding->common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
+
+ 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;
+
+ /* Compensate for CRLF and annotation. */
+ buf_end -= 1 + MAX_ANNOTATION_LENGTH;
+ while (buf < buf_end)
{
- unsigned char *p = ptr;
+ if (pos == stop)
+ {
+ if (pos == end_pos)
+ break;
+ 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 (! multibytep)
+ {
+ EMACS_INT bytes;
- for (; ptr < pend; ptr++)
+ if (! CODING_FOR_UNIBYTE (coding)
+ && (bytes = MULTIBYTE_LENGTH (src, src_end)) > 0)
+ c = STRING_CHAR_ADVANCE (src), pos += bytes;
+ else
+ c = *src++, pos++;
+ }
+ else
+ c = STRING_CHAR_ADVANCE (src), pos++;
+ if ((c == '\r') && (coding->mode & CODING_MODE_SELECTIVE_DISPLAY))
+ c = '\n';
+ if (! EQ (eol_type, Qunix))
{
- if (*ptr == '\r')
- *ptr = '\n';
- else if (*ptr == '\n'
- && coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL)
+ if (c == '\n')
{
- for (; p < ptr; p++)
- {
- if (*p == '\n')
- *p = '\r';
- }
- ptr = pend;
- coding->eol_type = CODING_EOL_LF;
- coding->symbol = saved_coding_symbol;
+ if (EQ (eol_type, Qdos))
+ *buf++ = '\r';
+ else
+ c = '\r';
}
}
+ *buf++ = c;
}
+
+ coding->consumed = src - coding->source;
+ coding->consumed_char = pos - coding->src_pos;
+ coding->charbuf_used = buf - coding->charbuf;
+ coding->chars_at_source = 0;
}
- /* 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)
+ /* 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 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 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;
- const unsigned char *source;
- unsigned char *destination;
- int src_bytes, dst_bytes;
{
- int extra = 0;
+ Lisp_Object attrs;
- if (coding->type == coding_type_undecided)
- detect_coding (coding, source, src_bytes);
+ attrs = CODING_ID_ATTRS (coding->id);
- if (coding->eol_type == CODING_EOL_UNDECIDED
- && coding->type != coding_type_ccl)
+ if (BUFFERP (coding->dst_object))
{
- 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;
+ set_buffer_internal (XBUFFER (coding->dst_object));
+ coding->dst_multibyte
+ = ! NILP (current_buffer->enable_multibyte_characters);
}
- coding->produced = coding->produced_char = 0;
coding->consumed = coding->consumed_char = 0;
+ coding->produced = coding->produced_char = 0;
+ coding->result = CODING_RESULT_SUCCESS;
coding->errors = 0;
- coding->result = CODING_FINISH_NORMAL;
- switch (coding->type)
- {
- case coding_type_sjis:
- decode_coding_sjis_big5 (coding, source, destination,
- src_bytes, dst_bytes, 1);
- break;
+ ALLOC_CONVERSION_WORK_AREA (coding);
- case coding_type_iso2022:
- decode_coding_iso2022 (coding, source, destination,
- src_bytes, dst_bytes);
- break;
+ do {
+ coding_set_source (coding);
+ consume_chars (coding);
- case coding_type_big5:
- decode_coding_sjis_big5 (coding, source, destination,
- src_bytes, dst_bytes, 0);
- break;
+ if (!NILP (CODING_ATTR_ENCODE_TBL (attrs)))
+ translate_chars (coding, CODING_ATTR_ENCODE_TBL (attrs));
+ else if (!NILP (Vstandard_translation_table_for_encode))
+ translate_chars (coding, Vstandard_translation_table_for_encode);
- case coding_type_emacs_mule:
- decode_coding_emacs_mule (coding, source, destination,
- src_bytes, dst_bytes);
- break;
+ coding_set_destination (coding);
+ (*(coding->encoder)) (coding);
+ } while (coding->consumed_char < coding->src_chars);
+
+ if (BUFFERP (coding->dst_object))
+ insert_from_gap (coding->produced_char, coding->produced);
+
+ return (coding->result);
+ }
+
+
+ /* Stack of working buffers used in code conversion. An nil element
+ means that the code conversion of that level is not using a working
+ buffer. */
+ Lisp_Object Vcode_conversion_work_buf_list;
+
+ /* A working buffer used by the top level conversion. */
+ Lisp_Object Vcode_conversion_reused_work_buf;
+
+
+ /* Return a working buffer that can be freely used by the following
+ code conversion. MULTIBYTEP specifies the multibyteness of the
+ buffer. */
+
+ Lisp_Object
+ make_conversion_work_buffer (multibytep, depth)
+ int multibytep, depth;
+ {
+ struct buffer *current = current_buffer;
+ Lisp_Object buf, name;
- case coding_type_ccl:
- if (coding->spec.ccl.cr_carryover)
+ if (depth == 0)
+ {
+ if (NILP (Vcode_conversion_reused_work_buf))
+ Vcode_conversion_reused_work_buf
+ = Fget_buffer_create (build_string (" *code-converting-work<0>*"));
+ buf = Vcode_conversion_reused_work_buf;
+ }
+ else
+ {
+ if (depth < 0)
{
- /* 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;
+ name = build_string (" *code-converting-work*");
+ name = Fgenerate_new_buffer_name (name, Qnil);
}
- ccl_coding_driver (coding, source, destination + extra,
- src_bytes, dst_bytes, 0);
- if (coding->eol_type != CODING_EOL_LF)
+ else
{
- coding->produced += extra;
- coding->produced_char += extra;
- decode_eol_post_ccl (coding, destination, coding->produced);
- }
- break;
+ char str[128];
- default:
- decode_eol (coding, source, destination, src_bytes, dst_bytes);
+ sprintf (str, " *code-converting-work*<%d>", depth);
+ name = build_string (str);
+ }
+ buf = Fget_buffer_create (name);
}
- Fset_buffer_multibyte (multibytep ? Qt : Qnil, Qnil);
+ set_buffer_internal (XBUFFER (buf));
+ current_buffer->undo_list = Qt;
+ Ferase_buffer ();
++ Fset_buffer_multibyte (multibytep ? Qt : Qnil);
+ set_buffer_internal (current);
+ return buf;
+ }
+
+ static Lisp_Object
+ code_conversion_restore (buffer)
+ Lisp_Object buffer;
+ {
+ Lisp_Object workbuf;
+
+ workbuf = XCAR (Vcode_conversion_work_buf_list);
+ if (! NILP (workbuf)
+ && ! EQ (workbuf, Vcode_conversion_reused_work_buf)
+ && ! NILP (Fbuffer_live_p (workbuf)))
+ Fkill_buffer (workbuf);
+ Vcode_conversion_work_buf_list = XCDR (Vcode_conversion_work_buf_list);
+ set_buffer_internal (XBUFFER (buffer));
+ return Qnil;
+ }
- if (coding->result == CODING_FINISH_INSUFFICIENT_SRC
- && coding->mode & CODING_MODE_LAST_BLOCK
- && coding->consumed == src_bytes)
- coding->result = CODING_FINISH_NORMAL;
+ static Lisp_Object
+ code_conversion_save (buffer, with_work_buf, multibyte)
+ Lisp_Object buffer;
+ int with_work_buf, multibyte;
+ {
+ Lisp_Object workbuf;
- if (coding->mode & CODING_MODE_LAST_BLOCK
- && coding->result == CODING_FINISH_INSUFFICIENT_SRC)
+ if (with_work_buf)
{
- const unsigned char *src = source + coding->consumed;
- unsigned char *dst = destination + coding->produced;
+ int depth = XINT (Flength (Vcode_conversion_work_buf_list));
- src_bytes -= coding->consumed;
- coding->errors++;
- if (COMPOSING_P (coding))
- DECODE_COMPOSITION_END ('1');
- while (src_bytes--)
- {
- int c = *src++;
- dst += CHAR_STRING (c, dst);
- coding->produced_char++;
- }
- coding->consumed = coding->consumed_char = src - source;
- coding->produced = dst - destination;
- coding->result = CODING_FINISH_NORMAL;
+ workbuf = make_conversion_work_buffer (multibyte, depth);
}
+ else
+ workbuf = Qnil;
+ Vcode_conversion_work_buf_list
+ = Fcons (workbuf, Vcode_conversion_work_buf_list);
+ record_unwind_protect (code_conversion_restore, buffer);
+ return workbuf;
+ }
+
+ int
+ decode_coding_gap (coding, chars, bytes)
+ struct coding_system *coding;
+ EMACS_INT chars, bytes;
+ {
+ int count = specpdl_ptr - specpdl;
+ Lisp_Object attrs;
+ Lisp_Object buffer;
+
+ buffer = Fcurrent_buffer ();
+ code_conversion_save (buffer, 0, 0);
+
+ coding->src_object = 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 = buffer;
+ coding->dst_pos = PT;
+ coding->dst_pos_byte = PT_BYTE;
+ coding->dst_multibyte = ! NILP (current_buffer->enable_multibyte_characters);
+ coding->mode |= CODING_MODE_LAST_BLOCK;
- if (!coding->dst_multibyte)
+ if (CODING_REQUIRE_DETECTION (coding))
+ detect_coding (coding);
-
++
+ decode_coding (coding);
+
+ attrs = CODING_ID_ATTRS (coding->id);
+ if (! NILP (CODING_ATTR_POST_READ (attrs)))
{
- coding->produced = str_as_unibyte (destination, coding->produced);
- coding->produced_char = coding->produced;
- struct gcpro gcpro1;
+ EMACS_INT prev_Z = Z, prev_Z_BYTE = Z_BYTE;
+ Lisp_Object val;
+
+ TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
- GCPRO1 (buffer);
+ val = 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;
}
+ unbind_to (count, Qnil);
return coding->result;
}
- /* 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)
+ encode_coding_gap (coding, chars, bytes)
struct coding_system *coding;
- const unsigned char *source;
- unsigned char *destination;
- int src_bytes, dst_bytes;
+ EMACS_INT chars, bytes;
{
- coding->produced = coding->produced_char = 0;
- coding->consumed = coding->consumed_char = 0;
- coding->errors = 0;
- coding->result = CODING_FINISH_NORMAL;
+ int count = specpdl_ptr - specpdl;
+ Lisp_Object buffer;
- switch (coding->type)
- {
- case coding_type_sjis:
- encode_coding_sjis_big5 (coding, source, destination,
- src_bytes, dst_bytes, 1);
- break;
+ buffer = Fcurrent_buffer ();
+ code_conversion_save (buffer, 0, 0);
- case coding_type_iso2022:
- encode_coding_iso2022 (coding, source, destination,
- src_bytes, dst_bytes);
- break;
+ coding->src_object = 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;
- case coding_type_big5:
- encode_coding_sjis_big5 (coding, source, destination,
- src_bytes, dst_bytes, 0);
- break;
+ encode_coding (coding);
- case coding_type_emacs_mule:
- encode_coding_emacs_mule (coding, source, destination,
- src_bytes, dst_bytes);
- break;
+ unbind_to (count, Qnil);
+ return coding->result;
+ }
- case coding_type_ccl:
- ccl_coding_driver (coding, source, destination,
- src_bytes, dst_bytes, 1);
- break;
- default:
- encode_eol (coding, source, destination, src_bytes, dst_bytes);
- }
+ /* Decode the text in the range FROM/FROM_BYTE and TO/TO_BYTE in
+ SRC_OBJECT into DST_OBJECT by coding context CODING.
- if (coding->mode & CODING_MODE_LAST_BLOCK
- && coding->result == CODING_FINISH_INSUFFICIENT_SRC)
- {
- const unsigned char *src = source + coding->consumed;
- unsigned char *dst = destination + coding->produced;
+ SRC_OBJECT is a buffer, a string, or Qnil.
- 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)
- {
- int len = src_bytes - coding->consumed;
+ If it is a buffer, the text is at point of the buffer. FROM and TO
+ are positions in the buffer.
- BCOPY_SHORT (src, dst, len);
- if (coding->src_multibyte)
- len = str_as_unibyte (dst, len);
- dst += len;
- coding->consumed = src_bytes;
- }
- coding->produced = coding->produced_char = dst - destination;
- coding->result = CODING_FINISH_NORMAL;
- }
+ If it is a string, the text is at the beginning of the string.
+ FROM and TO are indices to the string.
- if (coding->result == CODING_FINISH_INSUFFICIENT_SRC
- && coding->consumed == src_bytes)
- coding->result = CODING_FINISH_NORMAL;
+ If it is nil, the text is at coding->source. FROM and TO are
+ indices to coding->source.
- return coding->result;
- }
+ DST_OBJECT is a buffer, Qt, or Qnil.
- /* 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 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 STR is not NULL, *BEG and *END are indices into STR. */
+ If it is Qt, a string is made from the decoded text, and
+ set in CODING->dst_object.
- static void
- shrink_decoding_region (beg, end, coding, str)
- int *beg, *end;
+ 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;
- unsigned char *str;
+ Lisp_Object src_object;
+ EMACS_INT from, from_byte, to, to_byte;
+ Lisp_Object dst_object;
{
- unsigned char *begp_orig, *begp, *endp_orig, *endp, c;
- int eol_conversion;
- Lisp_Object translation_table;
+ 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->type == coding_type_ccl
- || coding->type == coding_type_undecided
- || coding->eol_type != CODING_EOL_LF
- || !NILP (coding->post_read_conversion)
- || coding->composing != COMPOSITION_DISABLED)
+ buffer = Fcurrent_buffer ();
+
+ if (NILP (dst_object))
{
- /* We can't skip any data. */
- return;
+ destination = coding->destination;
+ dst_bytes = coding->dst_bytes;
}
- if (coding->type == coding_type_no_conversion
- || coding->type == coding_type_raw_text
- || coding->type == coding_type_emacs_mule)
+
+ coding->src_object = src_object;
+ coding->src_chars = chars;
+ coding->src_bytes = bytes;
+ coding->src_multibyte = chars < bytes;
+
+ if (STRINGP (src_object))
{
- /* We need no conversion, but don't have to skip any data here.
- Decoding routine handles them effectively anyway. */
- return;
+ coding->src_pos = from;
+ coding->src_pos_byte = from_byte;
}
-
- 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))
+ else if (BUFFERP (src_object))
{
- 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;
+ set_buffer_internal (XBUFFER (src_object));
+ if (from != GPT)
+ move_gap_both (from, from_byte);
+ if (EQ (src_object, dst_object))
+ {
+ 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;
+ }
+ else
+ {
+ coding->src_pos = from;
+ coding->src_pos_byte = from_byte;
+ }
}
- if (coding->heading_ascii >= 0)
- /* Detection routine has already found how much we can skip at the
- head. */
- *beg += coding->heading_ascii;
+ if (CODING_REQUIRE_DETECTION (coding))
+ detect_coding (coding);
+ attrs = CODING_ID_ATTRS (coding->id);
- if (str)
+ if (EQ (dst_object, Qt)
+ || (! NILP (CODING_ATTR_POST_READ (attrs))
+ && NILP (dst_object)))
+ {
+ coding->dst_object = code_conversion_save (buffer, 1, 1);
+ coding->dst_pos = BEG;
+ coding->dst_pos_byte = BEG_BYTE;
+ coding->dst_multibyte = 1;
+ }
+ else if (BUFFERP (dst_object))
{
- begp_orig = begp = str + *beg;
- endp_orig = endp = str + *end;
+ code_conversion_save (buffer, 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);
}
else
{
- begp_orig = begp = BYTE_POS_ADDR (*beg);
- endp_orig = endp = begp + *end - *beg;
+ code_conversion_save (buffer, 0, 0);
+ coding->dst_object = Qnil;
+ coding->dst_multibyte = 1;
}
- eol_conversion = (coding->eol_type == CODING_EOL_CR
- || coding->eol_type == CODING_EOL_CRLF);
+ decode_coding (coding);
- 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 (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 (BUFFERP (coding->dst_object))
+ set_buffer_internal (XBUFFER (coding->dst_object));
- 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--;
- 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;
+ if (! NILP (CODING_ATTR_POST_READ (attrs)))
+ {
+ struct gcpro gcpro1, gcpro2;
+ EMACS_INT prev_Z = Z, prev_Z_BYTE = Z_BYTE;
+ Lisp_Object val;
- 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;
+ TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
+ GCPRO2 (coding->src_object, coding->dst_object);
+ val = 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 (eol_conversion)
- while (begp < endp
- && (c = endp[-1]) != ISO_CODE_ESC && c != '\r')
- {
- if (!eight_bit && c & 0x80) eight_bit = endp;
- endp--;
- }
- else
- while (begp < endp
- && (c = endp[-1]) != ISO_CODE_ESC)
- {
- if (!eight_bit && c & 0x80) eight_bit = endp;
- 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[-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;
- }
+ 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)
+ {
+ coding->result = CODING_RESULT_INSUFFICIENT_DST;
+ unbind_to (count, Qnil);
+ return;
+ }
+ if (BEGV < GPT && GPT < BEGV + coding->produced_char)
+ move_gap_both (BEGV, BEGV_BYTE);
+ bcopy (BEGV_ADDR, destination, coding->produced);
+ coding->destination = destination;
}
- break;
+ }
- default:
- abort ();
+ 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));
}
- *beg += begp - begp_orig;
- *end += endp - endp_orig;
- return;
+
+ unbind_to (count, Qnil);
}
- /* Like shrink_decoding_region but for encoding. */
- static void
- shrink_encoding_region (beg, end, coding, str)
- int *beg, *end;
+ void
+ encode_coding_object (coding, src_object, from, from_byte, to, to_byte,
+ dst_object)
struct coding_system *coding;
- unsigned char *str;
+ Lisp_Object src_object;
+ EMACS_INT from, from_byte, to, to_byte;
+ Lisp_Object dst_object;
{
- unsigned char *begp_orig, *begp, *endp_orig, *endp;
- int eol_conversion;
- Lisp_Object translation_table;
+ 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;
+
+ 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 (buffer, 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);
- 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))
+ 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));
+ }
+
+ call2 (CODING_ATTR_PRE_WRITE (attrs),
+ make_number (BEG), make_number (Z));
+ 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))
{
- /* We can't skip any data. */
- return;
+ code_conversion_save (buffer, 0, 0);
+ coding->src_pos = from;
+ coding->src_pos_byte = from_byte;
}
- if (coding->type == coding_type_no_conversion
- || coding->type == coding_type_raw_text
- || coding->type == coding_type_emacs_mule
- || coding->type == coding_type_undecided)
+ else if (BUFFERP (src_object))
{
- /* We need no conversion, but don't have to skip any data here.
- Encoding routine handles them effectively anyway. */
- return;
+ code_conversion_save (buffer, 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 (buffer, 0, 0);
- 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 (BUFFERP (dst_object))
{
- 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;
+ coding->dst_object = dst_object;
+ if (EQ (src_object, dst_object))
+ {
+ coding->dst_pos = from;
+ coding->dst_pos_byte = from_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);
}
-
- if (str)
+ else if (EQ (dst_object, Qt))
{
- begp_orig = begp = str + *beg;
- endp_orig = endp = str + *end;
+ 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
{
- begp_orig = begp = BYTE_POS_ADDR (*beg);
- endp_orig = endp = begp + *end - *beg;
+ coding->dst_object = Qnil;
+ coding->dst_multibyte = 0;
}
- eol_conversion = (coding->eol_type == CODING_EOL_CR
- || coding->eol_type == CODING_EOL_CRLF);
+ encode_coding (coding);
- /* Here, we don't have to check coding->pre_write_conversion because
- the caller is expected to have handled it already. */
- switch (coding->type)
+ if (EQ (dst_object, Qt))
{
- 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)
+ if (BUFFERP (coding->dst_object))
+ coding->dst_object = Fbuffer_string ();
+ else
{
- unsigned char *bol = begp;
- while (begp < endp && *begp < 0x80)
- {
- begp++;
- if (begp[-1] == '\n')
- bol = begp;
- }
- begp = bol;
- goto label_skip_tail;
+ coding->dst_object
+ = make_unibyte_string ((char *) coding->destination,
+ coding->produced);
+ xfree (coding->destination);
}
- /* 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--;
+ 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
- while (begp < endp && *(endp - 1) < 0x80) endp--;
- break;
+ TEMP_SET_PT_BOTH (saved_pt + (coding->produced - bytes),
+ saved_pt_byte + (coding->produced - bytes));
+ }
+
+ unbind_to (count, Qnil);
+ }
+
+
+ Lisp_Object
+ preferred_coding_system ()
+ {
+ int id = coding_categories[coding_priorities[0]].id;
+
+ return CODING_ID_NAME (id);
+ }
+
+ \f
+ #ifdef emacs
+ /*** 8. Emacs Lisp library functions ***/
+
+ 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 `define-coding-system' for information
+ about coding-system objects. */)
+ (obj)
+ Lisp_Object obj;
+ {
+ return ((NILP (obj) || CODING_SYSTEM_P (obj)) ? Qt : Qnil);
+ }
+
+ DEFUN ("read-non-nil-coding-system", Fread_non_nil_coding_system,
+ Sread_non_nil_coding_system, 1, 1, 0,
+ doc: /* Read a coding system from the minibuffer, prompting with string PROMPT. */)
+ (prompt)
+ Lisp_Object prompt;
+ {
+ Lisp_Object val;
+ do
+ {
+ val = Fcompleting_read (prompt, Vcoding_system_alist, Qnil,
+ Qt, Qnil, Qcoding_system_history, Qnil, Qnil);
+ }
- while (XSTRING (val)->size == 0);
++ while (SCHARS (val) == 0);
+ return (Fintern (val, Qnil));
+ }
+
+ DEFUN ("read-coding-system", Fread_coding_system, Sread_coding_system, 1, 2, 0,
+ doc: /* Read a coding system from the minibuffer, prompting with string PROMPT.
+ If the user enters null input, return second argument DEFAULT-CODING-SYSTEM. */)
+ (prompt, default_coding_system)
+ Lisp_Object prompt, default_coding_system;
+ {
+ Lisp_Object val;
+ if (SYMBOLP (default_coding_system))
- XSETSTRING (default_coding_system, XSYMBOL (default_coding_system)->name);
++ XSETSTRING (default_coding_system, SYMBOL_NAME (default_coding_system));
+ val = Fcompleting_read (prompt, Vcoding_system_alist, Qnil,
+ Qt, Qnil, Qcoding_system_history,
+ default_coding_system, Qnil);
- return (XSTRING (val)->size == 0 ? Qnil : Fintern (val, Qnil));
++ return (SCHARS (val) == 0 ? Qnil : Fintern (val, Qnil));
+ }
+
+ DEFUN ("check-coding-system", Fcheck_coding_system, Scheck_coding_system,
+ 1, 1, 0,
+ doc: /* Check validity of CODING-SYSTEM.
+ If valid, return CODING-SYSTEM, else signal a `coding-system-error' error. */)
+ (coding_system)
+ Lisp_Object coding_system;
+ {
+ CHECK_SYMBOL (coding_system);
+ if (!NILP (Fcoding_system_p (coding_system)))
+ return coding_system;
+ while (1)
+ Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
+ }
+
+ \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, coding_system)
- unsigned char *src;
++ const unsigned char *src;
+ int src_bytes, highest;
+ int multibytep;
+ Lisp_Object coding_system;
+ {
- unsigned char *src_end = src + src_bytes;
++ 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;
- default:
- abort ();
- }
+ 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_bytes = src_bytes;
+ coding.src_multibyte = multibytep;
+ coding.consumed = 0;
+ coding.mode |= CODING_MODE_LAST_BLOCK;
- *beg += begp - begp_orig;
- *end += endp - endp_orig;
- return;
- }
+ detect_info.checked = detect_info.found = detect_info.rejected = 0;
- /* 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;
+ /* At first, detect text-format if necessary. */
+ if (XINT (CODING_ATTR_CATEGORY (attrs)) == coding_category_undecided)
+ {
+ enum coding_category category;
+ struct coding_system *this;
+ int c, i;
- #define SHRINK_CONVERSION_REGION(beg, end, coding, str, encodep) \
- do { \
- if (*(end) - *(beg) > shrink_conversion_region_threshhold) \
- { \
- if (encodep) shrink_encoding_region (beg, end, coding, str); \
- else shrink_decoding_region (beg, end, coding, str); \
- } \
- } while (0)
+ for (; src < src_end; src++)
+ {
+ c = *src;
+ if (c & 0x80
+ || (c < 0x20 && (c == ISO_CODE_ESC
+ || c == ISO_CODE_SI
+ || c == ISO_CODE_SO)))
+ break;
+ }
+ coding.head_ascii = src - coding.source;
- static Lisp_Object
- code_convert_region_unwind (arg)
- Lisp_Object arg;
- {
- inhibit_pre_post_conversion = 0;
- Vlast_coding_system_used = arg;
- return Qnil;
- }
+ if (src < src_end)
+ for (i = 0; i < coding_category_raw_text; i++)
+ {
+ category = coding_priorities[i];
+ this = coding_categories + category;
- /* 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. */
+ 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)))
+ break;
+ }
+ }
- void
- coding_save_composition (coding, from, to, obj)
- struct coding_system *coding;
- int from, to;
- Lisp_Object obj;
- {
- Lisp_Object prop;
- int start, end;
- 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)
- return;
- if (start < from
- && (!find_composition (end, to, &start, &end, &prop, obj)
- || end > to))
- return;
- coding->composing = COMPOSITION_NO;
- do
- {
- if (COMPOSITION_VALID_P (start, end, prop))
+ if (detect_info.rejected == CATEGORY_MASK_ANY)
{
- 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)
+ 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)
{
- /* We must store a*/
- Lisp_Object val, ch;
+ 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
+ {
+ int mask = detect_info.rejected | detect_info.found;
+ int found = 0;
+ val = Qnil;
- 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))
+ for (i = coding_category_raw_text - 1; i >= 0; i--)
+ {
+ category = coding_priorities[i];
+ if (! (mask & (1 << category)))
{
- 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));
- }
+ found |= 1 << category;
+ id = coding_categories[category].id;
+ 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);
}
- else /* INTEGERP (val) */
- CODING_ADD_COMPOSITION_COMPONENT (coding, XINT (val));
}
- CODING_ADD_COMPOSITION_END (coding, end - from);
+ detect_info.found |= found;
}
- start = end;
}
- while (start < to
- && find_composition (start, to, &start, &end, &prop, obj)
- && end <= to);
+ else
+ {
+ 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));
+ }
+ }
- /* 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;
+ return (highest ? XCAR (val) : val);
}
- /* 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. */
- void
- coding_restore_composition (coding, obj)
- struct coding_system *coding;
- Lisp_Object obj;
- {
- struct composition_data *cmp_data = coding->cmp_data;
+ DEFUN ("detect-coding-region", Fdetect_coding_region, Sdetect_coding_region,
+ 2, 3, 0,
+ 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 (!cmp_data)
- return;
+ If only ASCII characters are found, it returns a list of single element
+ `undecided' or its subsidiary coding system according to a detected
+ end-of-line format.
- while (cmp_data->prev)
- cmp_data = cmp_data->prev;
+ If optional argument HIGHEST is non-nil, return the coding system of
+ highest priority. */)
+ (start, end, highest)
+ Lisp_Object start, end, highest;
+ {
+ int from, to;
+ int from_byte, to_byte;
- while (cmp_data)
- {
- int i;
+ CHECK_NUMBER_COERCE_MARKER (start);
+ CHECK_NUMBER_COERCE_MARKER (end);
- 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;
+ validate_region (&start, &end);
+ from = XINT (start), to = XINT (end);
+ from_byte = CHAR_TO_BYTE (from);
+ to_byte = CHAR_TO_BYTE (to);
- 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 --;
- 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;
- }
+ if (from < GPT && to >= GPT)
+ move_gap_both (to, to_byte);
+
+ return detect_coding_system (BYTE_POS_ADDR (from_byte),
+ to_byte - from_byte,
+ !NILP (highest),
+ !NILP (current_buffer
+ ->enable_multibyte_characters),
+ Qnil);
}
- /* 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).
+ DEFUN ("detect-coding-string", Fdetect_coding_string, Sdetect_coding_string,
+ 1, 2, 0,
+ doc: /* Detect coding system of the text in STRING.
+ Return a list of possible coding systems ordered by priority.
- How many characters (and bytes) are converted to how many
- characters (and bytes) are recorded in members of the structure
- CODING.
+ If only ASCII characters are found, it returns a list of single element
+ `undecided' or its subsidiary coding system according to a detected
+ end-of-line format.
- 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 optional argument HIGHEST is non-nil, return the coding system of
+ highest priority. */)
+ (string, highest)
+ Lisp_Object string, highest;
+ {
+ CHECK_STRING (string);
- If REPLACE is zero, it is assumed that the source text is unibyte.
- Otherwise, it is assumed that the source text is multibyte. */
- return detect_coding_system (XSTRING (string)->data,
- STRING_BYTES (XSTRING (string)),
- !NILP (highest),
- STRING_MULTIBYTE (string),
++ return detect_coding_system (SDATA (string), SBYTES (string),
++ !NILP (highest), STRING_MULTIBYTE (string),
+ Qnil);
+ }
- 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);
- deletion = Qnil;
- saved_coding_symbol = coding->symbol;
+ static INLINE int
+ char_encodable_p (c, attrs)
+ int c;
+ Lisp_Object attrs;
+ {
+ Lisp_Object tail;
+ struct charset *charset;
- if (from < PT && PT < to)
+ for (tail = CODING_ATTR_CHARSET_LIST (attrs);
+ CONSP (tail); tail = XCDR (tail))
{
- TEMP_SET_PT_BOTH (from, from_byte);
- orig_point = from;
+ charset = CHARSET_FROM_ID (XINT (XCAR (tail)));
+ if (CHAR_CHARSET_P (c, charset))
+ break;
}
+ return (! NILP (tail));
+ }
- if (replace)
- {
- 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;
- }
+ /* 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. */
- /* 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;
- }
+ DEFUN ("find-coding-systems-region-internal",
+ Ffind_coding_systems_region_internal,
+ Sfind_coding_systems_region_internal, 2, 3, 0,
+ doc: /* Internal use only. */)
+ (start, end, exclude)
+ Lisp_Object start, end, exclude;
+ {
+ 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 (! encodep && CODING_REQUIRE_DETECTION (coding))
+ if (STRINGP (start))
+ {
+ if (!STRING_MULTIBYTE (start)
- || XSTRING (start)->size == STRING_BYTES (XSTRING (start)))
++ || SCHARS (start) == SBYTES (start))
+ return Qt;
+ start_byte = 0;
- end_byte = STRING_BYTES (XSTRING (start));
++ end_byte = SBYTES (start);
+ }
+ else
{
- /* We must detect encoding of text and eol format. */
+ 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;
+ 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 (from < GPT && to > GPT)
- move_gap_both (from, from_byte);
- if (coding->type == coding_type_undecided)
- {
- detect_coding (coding, BYTE_POS_ADDR (from_byte), len_byte);
- if (coding->type == coding_type_undecided)
- {
- /* 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;
- }
- }
- if (coding->eol_type == CODING_EOL_UNDECIDED
- && coding->type != coding_type_ccl)
+ if (XINT (start) < GPT && XINT (end) > GPT)
{
- 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;
+ if ((GPT - XINT (start)) < (XINT (end) - GPT))
+ move_gap_both (XINT (start), start_byte);
+ else
+ move_gap_both (XINT (end), end_byte);
}
}
- /* Now we convert the text. */
+ 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;
- /* 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)))
- {
- /* The function in pre-write-conversion may put a new text in a
- new buffer. */
- struct buffer *prev = current_buffer;
- Lisp_Object new;
+ attrs = AREF (CODING_SYSTEM_SPEC (XCAR (tail)), 0);
+ if (EQ (XCAR (tail), CODING_ATTR_BASE_NAME (attrs))
+ && ! EQ (CODING_ATTR_TYPE (attrs), Qundecided))
+ coding_attrs_list = Fcons (attrs, coding_attrs_list);
+ }
- record_unwind_protect (code_convert_region_unwind,
- Vlast_coding_system_used);
- /* 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 (STRINGP (start))
- p = pbeg = XSTRING (start)->data;
++ p = pbeg = SDATA (start);
+ else
+ p = pbeg = BYTE_POS_ADDR (start_byte);
+ pend = p + (end_byte - start_byte);
- 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);
- }
- }
+ while (p < pend && ASCII_BYTE_P (*p)) p++;
+ while (p < pend && ASCII_BYTE_P (*(pend - 1))) pend--;
- if (replace)
+ while (p < pend)
{
- if (! EQ (current_buffer->undo_list, Qt))
- deletion = make_buffer_string_both (from, from_byte, to, to_byte, 1);
+ if (ASCII_BYTE_P (*p))
+ p++;
else
{
- nchars_del = to - from;
- nbytes_del = to_byte - from_byte;
- }
- }
+ c = STRING_CHAR_ADVANCE (p);
- if (coding->composing != COMPOSITION_DISABLED)
- {
- if (encodep)
- coding_save_composition (coding, from, to, Fcurrent_buffer ());
- else
- coding_allocate_composition_data (coding, from);
+ 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 = XSTRING (start)->data;
++ pbeg = SDATA (start);
+ else
+ pbeg = BYTE_POS_ADDR (start_byte);
+ p = pbeg + p_offset;
+ pend = pbeg + pend_offset;
+ }
+ }
}
- /* Try to skip the heading and tailing ASCIIs. */
- if (coding->type != coding_type_ccl)
- {
- int from_byte_orig = from_byte, to_byte_orig = to_byte;
+ safe_codings = Qnil;
+ 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);
- 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);
- return 0;
- }
+ return safe_codings;
+ }
- 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;
++DEFUN ("unencodable-char-position", Funencodable_char_position,
++ Sunencodable_char_position, 3, 5, 0,
++ doc: /*
++Return position of first un-encodable character in a region.
++START and END specfiy the region and CODING-SYSTEM specifies the
++encoding to check. Return nil if CODING-SYSTEM does encode the region.
+
- if (GAP_SIZE < require)
- make_gap (require - GAP_SIZE);
- move_gap_both (from, from_byte);
++If optional 4th argument COUNT is non-nil, it specifies at most how
++many un-encodable characters to search. In this case, the value is a
++list of positions.
+
- inserted = inserted_byte = 0;
++If optional 5th argument STRING is non-nil, it is a string to search
++for un-encodable characters. In that case, START and END are indexes
++to the string. */)
++ (start, end, coding_system, count, string)
++ Lisp_Object start, end, coding_system, count, string;
++{
++ int n;
++ struct coding_system coding;
++ Lisp_Object attrs, charset_list;
++ Lisp_Object positions;
++ int from, to;
++ const unsigned char *p, *stop, *pend;
++ int ascii_compatible;
+
- GAP_SIZE += len_byte;
- ZV -= len;
- Z -= len;
- ZV_BYTE -= len_byte;
- Z_BYTE -= len_byte;
++ 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);
+
- if (GPT - BEG < BEG_UNCHANGED)
- BEG_UNCHANGED = GPT - BEG;
- if (Z - GPT < END_UNCHANGED)
- END_UNCHANGED = Z - GPT;
++ if (NILP (string))
++ {
++ validate_region (&start, &end);
++ from = XINT (start);
++ to = XINT (end);
++ 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);
++ pend = CHAR_POS_ADDR (to);
++ if (from < GPT && to >= GPT)
++ stop = GPT_ADDR;
++ else
++ stop = pend;
++ }
++ else
++ {
++ CHECK_STRING (string);
++ CHECK_NATNUM (start);
++ CHECK_NATNUM (end);
++ from = XINT (start);
++ to = XINT (end);
++ if (from > to
++ || to > SCHARS (string))
++ args_out_of_range_3 (string, start, end);
++ if (! STRING_MULTIBYTE (string))
++ return Qnil;
++ p = SDATA (string) + string_char_to_byte (string, from);
++ stop = pend = SDATA (string) + string_char_to_byte (string, to);
++ if (ascii_compatible && (to - from) == (pend - p))
++ return Qnil;
++ }
+
- if (!encodep && coding->src_multibyte)
++ if (NILP (count))
++ n = 1;
++ else
+ {
- /* 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;
++ CHECK_NATNUM (count);
++ n = XINT (count);
+ }
+
- for (;;)
++ positions = Qnil;
++ while (1)
+ {
- 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;
++ int c;
+
- if (encodep)
- result = encode_coding (coding, src, dst, len_byte, 0);
- else
++ if (ascii_compatible)
++ while (p < stop && ASCII_BYTE_P (*p))
++ p++, from++;
++ if (p >= stop)
+ {
- if (coding->composing != COMPOSITION_DISABLED)
- coding->cmp_data->char_offset = from + inserted;
- result = decode_coding (coding, src, dst, len_byte, 0);
++ if (p >= pend)
++ break;
++ stop = pend;
++ p = GAP_END_ADDR;
+ }
+
- /* The buffer memory is now:
- +--------+-------converted-text----+--+------original-text----+---+
- |<-from->|<-inserted->|<-produced->|--|<-(len_byte-consumed)->|---|
- |<---------------------- GAP ----------------------->| */
-
- inserted += coding->produced_char;
- inserted_byte += coding->produced;
- len_byte -= coding->consumed;
-
- if (result == CODING_FINISH_INSUFFICIENT_CMP)
++ c = STRING_CHAR_ADVANCE (p);
++ if (! (ASCII_CHAR_P (c) && ascii_compatible)
++ && ! char_charset (c, charset_list, NULL))
+ {
- coding_allocate_composition_data (coding, from + inserted);
- continue;
++ positions = Fcons (make_number (from), positions);
++ n--;
++ if (n == 0)
++ break;
+ }
+
- src += coding->consumed;
- dst += coding->produced;
++ from++;
++ }
+
- 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;
++ return (NILP (count) ? Fcar (positions) : Fnreverse (positions));
++}
+
- /* 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;
+
- 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';
- }
- }
+ 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.
- /* Suppress eol-format conversion in the further conversion. */
- coding->eol_type = CODING_EOL_LF;
+ START and END are buffer positions specifying the region.
+ CODING-SYSTEM-LIST is a list of coding systems to check.
- /* 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;
+ 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.
- continue;
- }
- if (len_byte <= 0)
- {
- if (coding->type != coding_type_ccl
- || coding->mode & CODING_MODE_LAST_BLOCK)
- break;
- coding->mode |= CODING_MODE_LAST_BLOCK;
- continue;
- }
- 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;
+ If all coding systems in CODING-SYSTEM-LIST can encode the region, the
+ value is nil.
- inserted += len_byte;
- while (len_byte--)
- {
- int c = *src++;
- dst += CHAR_STRING (c, dst);
- }
+ 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;
- inserted_byte += dst - start;
- }
- 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;
- }
- if (first)
- {
- /* 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. */
- float ratio;
-
- if (coding->produced <= coding->consumed)
- {
- /* This happens because of CCL-based coding system with
- eol-type CRLF. */
- require = 0;
- }
- else
- {
- ratio = (coding->produced - coding->consumed) / coding->consumed;
- require = len_byte * ratio;
- }
- 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 (STRINGP (start))
+ {
+ if (!STRING_MULTIBYTE (start)
- && XSTRING (start)->size != STRING_BYTES (XSTRING (start)))
++ && SCHARS (start) != SBYTES (start))
+ return Qnil;
+ start_byte = 0;
- end_byte = STRING_BYTES (XSTRING (start));
++ end_byte = SBYTES (start);
+ pos = 0;
}
- if (src - dst > 0) *dst = 0; /* Put an anchor. */
-
- if (encodep && coding->dst_multibyte)
+ else
{
- /* The output is unibyte. We must convert 8-bit characters to
- multibyte form. */
- if (inserted_byte * 2 > GAP_SIZE)
+ 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)
{
- 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;
+ if ((GPT - XINT (start)) < (XINT (end) - GPT))
+ move_gap_both (XINT (start), start_byte);
+ else
+ move_gap_both (XINT (end), end_byte);
}
- inserted_byte = str_to_multibyte (GPT_ADDR, GAP_SIZE, inserted_byte);
+ pos = XINT (start);
}
- /* If we shrank the conversion area, adjust it now. */
- if (total_skip > 0)
+ list = Qnil;
+ for (tail = coding_system_list; CONSP (tail); tail = XCDR (tail))
{
- 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;
+ elt = XCAR (tail);
+ list = Fcons (Fcons (elt, Fcons (AREF (CODING_SYSTEM_SPEC (elt), 0),
+ Qnil)),
+ list);
}
- prev_Z = Z;
- if (! EQ (current_buffer->undo_list, Qt))
- adjust_after_replace (from, from_byte, deletion, inserted, inserted_byte);
+ if (STRINGP (start))
- p = pbeg = XSTRING (start)->data;
++ p = pbeg = SDATA (start);
else
- adjust_after_replace_noundo (from, from_byte, nchars_del, nbytes_del,
- inserted, inserted_byte);
- inserted = Z - prev_Z;
+ p = pbeg = BYTE_POS_ADDR (start_byte);
+ pend = p + (end_byte - start_byte);
- if (!encodep && coding->cmp_data && coding->cmp_data->used)
- coding_restore_composition (coding, Fcurrent_buffer ());
- coding_free_composition_data (coding);
+ while (p < pend && ASCII_BYTE_P (*p)) p++, pos++;
+ while (p < pend && ASCII_BYTE_P (*(pend - 1))) pend--;
- if (! inhibit_pre_post_conversion
- && ! encodep && ! NILP (coding->post_read_conversion))
+ while (p < pend)
{
- Lisp_Object val;
- Lisp_Object saved_coding_system;
-
- if (from != PT)
- TEMP_SET_PT_BOTH (from, from_byte);
- prev_Z = Z;
- record_unwind_protect (code_convert_region_unwind,
- Vlast_coding_system_used);
- 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;
+ if (ASCII_BYTE_P (*p))
+ p++;
else
- orig_point = from;
- TEMP_SET_PT (orig_point);
+ {
+ 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 = XSTRING (start)->data;
++ pbeg = SDATA (start);
+ else
+ pbeg = BYTE_POS_ADDR (start_byte);
+ p = pbeg + p_offset;
+ pend = pbeg + pend_offset;
+ }
+ }
+ pos++;
}
- if (replace)
+ tail = list;
+ list = Qnil;
+ for (; CONSP (tail); tail = XCDR (tail))
{
- signal_after_change (from, to - from, inserted);
- update_compositions (from, from + inserted, CHECK_BORDER);
+ elt = XCAR (tail);
+ if (CONSP (XCDR (XCDR (elt))))
+ list = Fcons (Fcons (XCAR (elt), Fnreverse (XCDR (XCDR (elt)))),
+ list);
}
- {
- coding->consumed = to_byte - from_byte;
- coding->consumed_char = to - from;
- coding->produced = inserted_byte;
- coding->produced_char = inserted;
- }
-
- return 0;
+ return list;
}
- Lisp_Object
- run_pre_post_conversion_on_str (str, coding, encodep)
- Lisp_Object str;
- struct coding_system *coding;
- int encodep;
- {
- int count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2;
- int multibyte = STRING_MULTIBYTE (str);
- Lisp_Object buffer;
- struct buffer *buf;
- Lisp_Object old_deactivate_mark;
-
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
- record_unwind_protect (code_convert_region_unwind,
- Vlast_coding_system_used);
- /* It is not crucial to specbind this. */
- old_deactivate_mark = Vdeactivate_mark;
- GCPRO2 (str, old_deactivate_mark);
-
- buffer = Fget_buffer_create (build_string (" *code-converting-work*"));
- buf = XBUFFER (buffer);
-
- 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);
- /* 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. */
- Ferase_buffer ();
- buf->enable_multibyte_characters = multibyte ? Qt : Qnil;
- insert_from_string (str, 0, 0,
- SCHARS (str), SBYTES (str), 0);
- UNGCPRO;
- inhibit_pre_post_conversion = 1;
- if (encodep)
- call2 (coding->pre_write_conversion, make_number (BEG), make_number (Z));
- else
- {
- 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;
- }
- inhibit_pre_post_conversion = 0;
- Vdeactivate_mark = old_deactivate_mark;
- str = make_buffer_string (BEG, Z, 1);
- return unbind_to (count, str);
- }
Lisp_Object
- decode_coding_string (str, coding, nocopy)
- Lisp_Object str;
- struct coding_system *coding;
- int nocopy;
+ code_convert_region (start, end, coding_system, dst_object, encodep, norecord)
+ Lisp_Object start, end, coding_system, dst_object;
+ int encodep, norecord;
{
- 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;
- if (CODING_REQUIRE_DETECTION (coding))
- {
- /* See the comments in code_convert_region. */
- if (coding->type == coding_type_undecided)
- {
- 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;
- }
- }
- if (coding->eol_type == CODING_EOL_UNDECIDED
- && coding->type != coding_type_ccl)
- {
- 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;
- }
- }
+ struct coding_system coding;
+ EMACS_INT from, from_byte, to, to_byte;
+ Lisp_Object src_object;
- if (coding->type == coding_type_no_conversion
- || coding->type == coding_type_raw_text)
- coding->dst_multibyte = 0;
+ CHECK_NUMBER_COERCE_MARKER (start);
+ CHECK_NUMBER_COERCE_MARKER (end);
+ 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);
- require_decoding = CODING_REQUIRE_DECODING (coding);
+ setup_coding_system (coding_system, &coding);
+ coding.mode |= CODING_MODE_LAST_BLOCK;
- if (STRING_MULTIBYTE (str))
- {
- /* Decoding routines expect the source text to be unibyte. */
- str = Fstring_as_unibyte (str);
- to_byte = SBYTES (str);
- nocopy = 1;
- coding->src_multibyte = 0;
- }
+ 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);
- /* Try to skip the heading and tailing ASCIIs. */
- if (require_decoding && coding->type != coding_type_ccl)
- {
- SHRINK_CONVERSION_REGION (&from, &to_byte, coding, SDATA (str),
- 0);
- if (from == to_byte)
- require_decoding = 0;
- shrinked_bytes = from + (SBYTES (str) - to_byte);
- }
+ if (coding.result != CODING_RESULT_SUCCESS)
+ error ("Code conversion error: %d", coding.result);
- if (!require_decoding
- && !(SYMBOLP (coding->post_read_conversion)
- && !NILP (Ffboundp (coding->post_read_conversion))))
- {
- 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));
- }
+ return (BUFFERP (dst_object)
+ ? make_number (coding.produced_char)
+ : coding.dst_object);
+ }
- if (coding->composing != COMPOSITION_DISABLED)
- coding_allocate_composition_data (coding, from);
- len = decoding_buffer_size (coding, to_byte - from);
- allocate_conversion_buffer (buf, len);
- consumed = consumed_char = produced = produced_char = 0;
- while (1)
- {
- 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_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;
+ DEFUN ("decode-coding-region", Fdecode_coding_region, Sdecode_coding_region,
+ 3, 4, "r\nzCoding system: ",
+ doc: /* Decode the current region from the specified coding system.
+ When called from a program, takes four arguments:
+ START, END, CODING-SYSTEM, and DESTINATION.
+ START and END are buffer positions.
- /* 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)
- {
- 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;
- }
- /* 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;
+ Optional 4th arguments DESTINATION specifies where the decoded text goes.
+ If nil, the region between START and END is replace 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, destination)
+ Lisp_Object start, end, coding_system, destination;
+ {
+ return code_convert_region (start, end, coding_system, destination, 0, 0);
+ }
- }
- }
+ DEFUN ("encode-coding-region", Fencode_coding_region, Sencode_coding_region,
+ 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.
- coding->consumed = consumed;
- coding->consumed_char = consumed_char;
- coding->produced = produced;
- coding->produced_char = produced_char;
+ 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.
- 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);
-
- 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;
+ 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, destination)
+ Lisp_Object start, end, coding_system, destination;
+ {
+ return code_convert_region (start, end, coding_system, destination, 1, 0);
}
Lisp_Object
- encode_coding_string (str, coding, nocopy)
- Lisp_Object str;
- struct coding_system *coding;
- int nocopy;
+ code_convert_string (string, coding_system, dst_object,
+ encodep, nocopy, norecord)
+ Lisp_Object string, coding_system, dst_object;
+ int encodep, nocopy, norecord;
{
- 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);
-
- from = 0;
- to = SCHARS (str);
- to_byte = SBYTES (str);
-
- /* Encoding routines determine the multibyteness of the source text
- by coding->src_multibyte. */
- coding->src_multibyte = STRING_MULTIBYTE (str);
- coding->dst_multibyte = 0;
- if (! CODING_REQUIRE_ENCODING (coding))
- {
- coding->consumed = SBYTES (str);
- coding->consumed_char = SCHARS (str);
- if (STRING_MULTIBYTE (str))
- {
- str = Fstring_as_unibyte (str);
- nocopy = 1;
- }
- coding->produced = SBYTES (str);
- coding->produced_char = SCHARS (str);
- return (nocopy ? str : Fcopy_sequence (str));
- }
-
- if (coding->composing != COMPOSITION_DISABLED)
- coding_save_composition (coding, from, to, str);
+ struct coding_system coding;
+ EMACS_INT chars, bytes;
- /* Try to skip the heading and tailing ASCIIs. */
- if (coding->type != coding_type_ccl)
+ CHECK_STRING (string);
+ if (NILP (coding_system))
{
- SHRINK_CONVERSION_REGION (&from, &to_byte, coding, SDATA (str),
- 1);
- if (from == to_byte)
- return (nocopy ? str : Fcopy_sequence (str));
- shrinked_bytes = from + (SBYTES (str) - to_byte);
+ if (! norecord)
+ Vlast_coding_system_used = Qno_conversion;
+ if (NILP (dst_object))
+ return (nocopy ? Fcopy_sequence (string) : string);
}
- len = encoding_buffer_size (coding, to_byte - from);
- allocate_conversion_buffer (buf, len);
+ 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);
- consumed = consumed_char = produced = produced_char = 0;
- while (1)
- {
- 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_INSUFFICIENT_SRC
- && coding->consumed == 0))
- break;
- /* Now result should be CODING_FINISH_INSUFFICIENT_DST. */
- extend_conversion_buffer (&buf);
- }
+ setup_coding_system (coding_system, &coding);
+ coding.mode |= CODING_MODE_LAST_BLOCK;
- chars = XSTRING (string)->size;
- bytes = STRING_BYTES (XSTRING (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);
- coding->consumed = consumed;
- coding->consumed_char = consumed_char;
- coding->produced = produced;
- coding->produced_char = produced_char;
+ if (coding.result != CODING_RESULT_SUCCESS)
+ error ("Code conversion error: %d", coding.result);
- 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);
+ return (BUFFERP (dst_object)
+ ? make_number (coding.produced_char)
+ : coding.dst_object);
+ }
- free_conversion_buffer (&buf);
- coding_free_composition_data (coding);
- return newstr;
- }
+ /* Encode or decode STRING according to CODING_SYSTEM.
+ Do not set Vlast_coding_system_used.
- \f
- #ifdef emacs
- /*** 8. Emacs Lisp library functions ***/
+ This function is called only from macros DECODE_FILE and
+ ENCODE_FILE, thus we ignore character composition. */
- 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
- about coding-system objects. */)
- (obj)
- Lisp_Object obj;
+ Lisp_Object
+ code_convert_string_norecord (string, coding_system, encodep)
+ Lisp_Object string, coding_system;
+ int encodep;
{
- if (NILP (obj))
- return Qt;
- if (!SYMBOLP (obj))
- return Qnil;
- /* Get coding-spec vector for OBJ. */
- obj = Fget (obj, Qcoding_system);
- return ((VECTORP (obj) && XVECTOR (obj)->size == 5)
- ? Qt : Qnil);
+ return code_convert_string (string, coding_system, Qt, encodep, 0, 1);
}
- DEFUN ("read-non-nil-coding-system", Fread_non_nil_coding_system,
- Sread_non_nil_coding_system, 1, 1, 0,
- doc: /* Read a coding system from the minibuffer, prompting with string PROMPT. */)
- (prompt)
- Lisp_Object prompt;
- {
- Lisp_Object val;
- do
- {
- val = Fcompleting_read (prompt, Vcoding_system_alist, Qnil,
- Qt, Qnil, Qcoding_system_history, Qnil, Qnil);
- }
- while (SCHARS (val) == 0);
- return (Fintern (val, Qnil));
- }
- DEFUN ("read-coding-system", Fread_coding_system, Sread_coding_system, 1, 2, 0,
- doc: /* Read a coding system from the minibuffer, prompting with string PROMPT.
- If the user enters null input, return second argument DEFAULT-CODING-SYSTEM. */)
- (prompt, default_coding_system)
- Lisp_Object prompt, default_coding_system;
+ 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;
{
- Lisp_Object val;
- if (SYMBOLP (default_coding_system))
- default_coding_system = SYMBOL_NAME (default_coding_system);
- val = Fcompleting_read (prompt, Vcoding_system_alist, Qnil,
- Qt, Qnil, Qcoding_system_history,
- default_coding_system, Qnil);
- return (SCHARS (val) == 0 ? Qnil : Fintern (val, Qnil));
+ return code_convert_string (string, coding_system, buffer,
+ 0, ! NILP (nocopy), 0);
}
- DEFUN ("check-coding-system", Fcheck_coding_system, Scheck_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 a symbol with a non-nil `coding-system' property.
- The value of property should be a vector of length 5. */)
- (coding_system)
- Lisp_Object coding_system;
+ DEFUN ("encode-coding-string", Fencode_coding_string, Sencode_coding_string,
+ 2, 4, 0,
+ doc: /* Encode STRING to CODING-SYSTEM, and return the result.
+
+ Optional third arg NOCOPY non-nil means it is OK to return STRING
+ itself if the encoding operation is trivial.
+
+ 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;
{
- CHECK_SYMBOL (coding_system);
- if (!NILP (Fcoding_system_p (coding_system)))
- return coding_system;
- while (1)
- Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
+ return code_convert_string (string, coding_system, buffer,
+ 1, ! NILP (nocopy), 1);
}
+
\f
- Lisp_Object
- detect_coding_system (src, src_bytes, highest, multibytep)
- const unsigned char *src;
- int src_bytes, highest;
- int multibytep;
+ 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.
+ Return the corresponding character. */)
+ (code)
+ Lisp_Object code;
{
- int coding_mask, eol_type;
- Lisp_Object val, tmp;
- int dummy;
+ Lisp_Object spec, attrs, val;
+ struct charset *charset_roman, *charset_kanji, *charset_kana, *charset;
+ int c;
- 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;
+ CHECK_NATNUM (code);
+ c = XFASTINT (code);
+ CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system, spec);
+ attrs = AREF (spec, 0);
- if (!coding_mask)
- {
- val = Qundecided;
- if (eol_type != CODING_EOL_UNDECIDED)
- {
- Lisp_Object val2;
- val2 = Fget (Qundecided, Qeol_type);
- if (VECTORP (val2))
- val = XVECTOR (val2)->contents[eol_type];
- }
- return (highest ? val : Fcons (val, Qnil));
- }
+ if (ASCII_BYTE_P (c)
+ && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
+ return code;
- /* At first, gather possible coding systems in VAL. */
- val = Qnil;
- for (tmp = Vcoding_category_list; CONSP (tmp); tmp = XCDR (tmp))
- {
- Lisp_Object category_val, category_index;
+ 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)));
- 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))))
- {
- val = Fcons (category_val, val);
- if (highest)
- break;
- }
+ if (c <= 0x7F)
+ charset = charset_roman;
+ else if (c >= 0xA0 && c < 0xDF)
+ {
+ charset = charset_kana;
+ c -= 0x80;
}
- 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]);
- }
+ 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 (highest ? XCAR (val) : val);
+ c = DECODE_CHAR (charset, c);
+ if (c < 0)
+ error ("Invalid code: %d", code);
+ return make_number (c);
}
- 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.
- If only ASCII characters are found, it returns a list of single element
- `undecided' or its subsidiary coding system according to a detected
- end-of-line format.
+ DEFUN ("encode-sjis-char", Fencode_sjis_char, Sencode_sjis_char, 1, 1, 0,
+ doc: /* Encode a Japanese character CHAR to shift_jis encoding.
+ Return the corresponding code in SJIS. */)
+ (ch)
+ Lisp_Object ch;
+ {
+ Lisp_Object spec, attrs, charset_list;
+ int c;
+ struct charset *charset;
+ unsigned code;
- If optional argument HIGHEST is non-nil, return the coding system of
- highest priority. */)
- (start, end, highest)
- Lisp_Object start, end, highest;
+ 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,
+ doc: /* Decode a Big5 character which has CODE in BIG5 coding system.
+ Return the corresponding character. */)
+ (code)
+ Lisp_Object code;
{
- int from, to;
- int from_byte, to_byte;
- int include_anchor_byte = 0;
+ Lisp_Object spec, attrs, val;
+ struct charset *charset_roman, *charset_big5, *charset;
+ int c;
- CHECK_NUMBER_COERCE_MARKER (start);
- CHECK_NUMBER_COERCE_MARKER (end);
+ CHECK_NATNUM (code);
+ c = XFASTINT (code);
+ CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system, spec);
+ attrs = AREF (spec, 0);
- validate_region (&start, &end);
- from = XINT (start), to = XINT (end);
- from_byte = CHAR_TO_BYTE (from);
- to_byte = CHAR_TO_BYTE (to);
+ if (ASCII_BYTE_P (c)
+ && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
+ return code;
- 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.
+ 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)));
- 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,
- !NILP (highest),
- !NILP (current_buffer
- ->enable_multibyte_characters));
+ if (c <= 0x7F)
+ charset = charset_roman;
+ else
+ {
+ 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;
+ }
+ c = DECODE_CHAR (charset, (unsigned )c);
+ if (c < 0)
+ error ("Invalid code: %d", code);
+ return make_number (c);
}
- 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.
+ DEFUN ("encode-big5-char", Fencode_big5_char, Sencode_big5_char, 1, 1, 0,
+ doc: /* Encode the Big5 character CHAR to BIG5 coding system.
+ Return the corresponding character code in Big5. */)
+ (ch)
+ Lisp_Object ch;
+ {
+ 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);
+ }
- If only ASCII characters are found, it returns a list of single element
- `undecided' or its subsidiary coding system according to a detected
- end-of-line format.
+ \f
+ DEFUN ("set-terminal-coding-system-internal",
+ Fset_terminal_coding_system_internal,
+ Sset_terminal_coding_system_internal, 1, 1, 0,
+ doc: /* Internal use only. */)
+ (coding_system)
+ Lisp_Object coding_system;
+ {
+ CHECK_SYMBOL (coding_system);
+ setup_coding_system (Fcheck_coding_system (coding_system),
+ &terminal_coding);
-
+
- If optional argument HIGHEST is non-nil, return the coding system of
- highest priority. */)
- (string, highest)
- Lisp_Object string, highest;
+ /* We had better not send unsafe characters to terminal. */
+ 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,
+ Sset_safe_terminal_coding_system_internal, 1, 1, 0,
+ doc: /* Internal use only. */)
+ (coding_system)
+ Lisp_Object coding_system;
{
- CHECK_STRING (string);
+ CHECK_SYMBOL (coding_system);
+ setup_coding_system (Fcheck_coding_system (coding_system),
+ &safe_terminal_coding);
+ /* 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;
+ }
- 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));
+ DEFUN ("terminal-coding-system",
+ Fterminal_coding_system, Sterminal_coding_system, 0, 0, 0,
+ doc: /* Return coding system specified for terminal output. */)
+ ()
+ {
+ return CODING_ID_NAME (terminal_coding.id);
+ }
+
+ DEFUN ("set-keyboard-coding-system-internal",
+ Fset_keyboard_coding_system_internal,
+ Sset_keyboard_coding_system_internal, 1, 1, 0,
+ doc: /* Internal use only. */)
+ (coding_system)
+ Lisp_Object coding_system;
+ {
+ CHECK_SYMBOL (coding_system);
+ setup_coding_system (Fcheck_coding_system (coding_system),
+ &keyboard_coding);
+ /* Characer composition should be disabled. */
+ keyboard_coding.common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
+ return Qnil;
+ }
+
+ DEFUN ("keyboard-coding-system",
+ Fkeyboard_coding_system, Skeyboard_coding_system, 0, 0, 0,
+ doc: /* Return coding system specified for decoding keyboard input. */)
+ ()
+ {
+ return CODING_ID_NAME (keyboard_coding.id);
}
- /* Subroutine for Fsafe_coding_systems_region_internal.
+ \f
+ DEFUN ("find-operation-coding-system", Ffind_operation_coding_system,
+ Sfind_operation_coding_system, 1, MANY, 0,
+ doc: /* Choose a coding system for an operation based on the target name.
+ The value names a pair of coding systems: (DECODING-SYSTEM . ENCODING-SYSTEM).
+ DECODING-SYSTEM is the coding system to use for decoding
+ \(in case OPERATION does decoding), and ENCODING-SYSTEM is the coding system
+ for encoding (in case OPERATION does encoding).
- 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.
+ The first argument OPERATION specifies an I/O primitive:
+ For file I/O, `insert-file-contents' or `write-region'.
+ For process I/O, `call-process', `call-process-region', or `start-process'.
+ For network I/O, `open-network-stream'.
- WORK_TABLE is a copy of the char-table Vchar_coding_system_table. An
- element of WORK_TABLE is set to t once the element is looked up.
+ 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.
- If a non-ASCII single byte char is found, set
- *single_byte_char_found to 1. */
+ TARGET has a meaning which depends on OPERATION:
+ For file I/O, TARGET is a file name.
+ For process I/O, TARGET is a process name.
+ For network I/O, TARGET is a service name or a port number
- 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;
+ 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.
+
+ usage: (find-operation-coding-system OPERATION ARGUMENTS ...) */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
{
- int c, len;
- Lisp_Object val, ch;
- Lisp_Object prev, tail;
+ Lisp_Object operation, target_idx, target, val;
+ register Lisp_Object chain;
- while (p < pend)
+ 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",
- XSYMBOL (operation)->name->data);
++ SDATA (SYMBOL_NAME (operation)));
+ target = args[XINT (target_idx) + 1];
+ if (!(STRINGP (target)
+ || (EQ (operation, Qopen_network_stream) && INTEGERP (target))))
+ error ("Invalid %dth argument", XINT (target_idx) + 1);
+
+ 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))
{
- 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;
- if (NILP (safe_codings))
- /* Already all coding systems are excluded. But, we can't
- terminate the loop here because non-ASCII single-byte char
- must be found. */
- continue;
- /* 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);
+ Lisp_Object elt;
- for (prev = tail = safe_codings; CONSP (tail); tail = XCDR (tail))
+ elt = XCAR (chain);
+ if (CONSP (elt)
+ && ((STRINGP (target)
+ && STRINGP (XCAR (elt))
+ && fast_string_match (XCAR (elt), target) >= 0)
+ || (INTEGERP (target) && EQ (target, XCAR (elt)))))
{
- 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
+ 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)))
{
- /* Exclude this coding system from SAFE_CODINGS. */
- if (EQ (tail, safe_codings))
- safe_codings = XCDR (safe_codings);
- else
- XSETCDR (prev, XCDR (tail));
+ 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 safe_codings;
+ return Qnil;
}
- DEFUN ("find-coding-systems-region-internal",
- Ffind_coding_systems_region_internal,
- Sfind_coding_systems_region_internal, 2, 2, 0,
- doc: /* Internal use only. */)
- (start, end)
- Lisp_Object start, end;
- {
- 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;
-
- if (STRINGP (start))
- {
- if (!STRING_MULTIBYTE (start))
- return Qt;
- p1 = SDATA (start), p1end = p1 + SBYTES (start);
- p2 = p2end = p1end;
- if (SCHARS (start) != SBYTES (start))
- non_ascii_p = 1;
- }
- 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;
- }
+ 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. */)
+ (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);
- if (!non_ascii_p)
+ for (i = j = 0; i < nargs; i++)
{
- /* 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)
- {
- for (p = p2; p < p2end && ASCII_BYTE_P (*p); p++);
- if (p == p2end)
- return Qt;
- }
- }
+ enum coding_category category;
+ Lisp_Object spec, attrs;
- /* The text contains non-ASCII characters. */
+ 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]);
+ }
- work_table = Fmake_char_table (Qchar_coding_system, Qnil);
- safe_codings = Fcopy_sequence (XCDR (Vcoding_system_safe_chars));
+ /* Now we have decided top J priorities. Reflect the order of the
+ original priorities to the remaining priorities. */
- 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;
- else
+ for (i = j, j = 0; i < coding_category_max; i++, j++)
{
- /* Turn safe_codings to a list of coding systems... */
- Lisp_Object val;
+ while (j < coding_category_max
+ && changed[coding_priorities[j]])
+ j++;
+ if (j == coding_category_max)
+ abort ();
+ priorities[i] = coding_priorities[j];
+ }
- 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));
+ bcopy (priorities, coding_priorities, sizeof priorities);
- for (; CONSP (safe_codings); safe_codings = XCDR (safe_codings))
- val = Fcons (XCAR (XCAR (safe_codings)), val);
- safe_codings = val;
- }
+ /* 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 safe_codings;
+ 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;
- /* 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.
+ 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 SAFE_CHARS is nil, all non-ASCII characters are unencodable.
+ 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);
+ }
- Otherwise, SAFE_CHARS is t, and only eight-bit-contrl and
- eight-bit-graphic characters are unencodable. */
+ static char *suffixes[] = { "-unix", "-dos", "-mac" };
static Lisp_Object
- unencodable_char_position (safe_chars, pos, p, pend, n)
- Lisp_Object safe_chars;
- int pos;
- unsigned char *p, *pend;
- int n;
+ make_subsidiaries (base)
+ Lisp_Object base;
{
- Lisp_Object pos_list;
+ Lisp_Object subsidiaries;
- int base_name_len = STRING_BYTES (XSYMBOL (base)->name);
++ int base_name_len = SBYTES (SYMBOL_NAME (base));
+ char *buf = (char *) alloca (base_name_len + 6);
+ int i;
-
- bcopy (XSYMBOL (base)->name->data, buf, base_name_len);
+
- pos_list = Qnil;
- while (p < pend)
++ bcopy (SDATA (SYMBOL_NAME (base)), buf, base_name_len);
+ subsidiaries = Fmake_vector (make_number (3), Qnil);
+ for (i = 0; i < 3; i++)
{
- 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)))
- {
- pos_list = Fcons (make_number (pos), pos_list);
- if (--n <= 0)
- break;
- }
- pos++;
- p += len;
+ bcopy (suffixes[i], buf + base_name_len, strlen (suffixes[i]) + 1);
+ ASET (subsidiaries, i, intern (buf));
}
- return Fnreverse (pos_list);
+ return subsidiaries;
}
- DEFUN ("unencodable-char-position", Funencodable_char_position,
- Sunencodable_char_position, 3, 5, 0,
- doc: /*
- Return position of first un-encodable character in a region.
- START and END specfiy the region and CODING-SYSTEM specifies the
- encoding to check. Return nil if CODING-SYSTEM does encode the region.
-
- If optional 4th argument COUNT is non-nil, it specifies at most how
- many un-encodable characters to search. In this case, the value is a
- list of positions.
-
- If optional 5th argument STRING is non-nil, it is a string to search
- for un-encodable characters. In that case, START and END are indexes
- to the string. */)
- (start, end, coding_system, count, string)
- Lisp_Object start, end, coding_system, count, string;
+ 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;
{
- int n;
- Lisp_Object safe_chars;
- struct coding_system coding;
- Lisp_Object positions;
- int from, to;
- unsigned char *p, *pend;
+ 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 (NILP (string))
- {
- validate_region (&start, &end);
- from = XINT (start);
- to = XINT (end);
- if (NILP (current_buffer->enable_multibyte_characters))
- return Qnil;
- p = CHAR_POS_ADDR (from);
- if (to == GPT)
- pend = GPT_ADDR;
- else
- pend = CHAR_POS_ADDR (to);
- }
- else
- {
- CHECK_STRING (string);
- CHECK_NATNUM (start);
- CHECK_NATNUM (end);
- from = XINT (start);
- to = XINT (end);
- if (from > to
- || to > SCHARS (string))
- args_out_of_range_3 (string, start, end);
- if (! STRING_MULTIBYTE (string))
- return Qnil;
- p = SDATA (string) + string_char_to_byte (string, from);
- pend = SDATA (string) + string_char_to_byte (string, to);
- }
+ if (nargs < coding_arg_max)
+ goto short_args;
- setup_coding_system (Fcheck_coding_system (coding_system), &coding);
+ attrs = Fmake_vector (make_number (coding_attr_last_index), Qnil);
- if (NILP (count))
- n = 1;
- else
- {
- CHECK_NATNUM (count);
- n = XINT (count);
- }
+ name = args[coding_arg_name];
+ CHECK_SYMBOL (name);
+ CODING_ATTR_BASE_NAME (attrs) = name;
- if (coding.type == coding_type_no_conversion
- || coding.type == coding_type_raw_text)
- return Qnil;
+ val = args[coding_arg_mnemonic];
+ if (! STRINGP (val))
+ CHECK_CHARACTER (val);
+ CODING_ATTR_MNEMONIC (attrs) = val;
- if (coding.type == coding_type_undecided)
- safe_chars = Qnil;
- else
- safe_chars = coding_safe_chars (coding_system);
+ coding_type = args[coding_arg_coding_type];
+ CHECK_SYMBOL (coding_type);
+ CODING_ATTR_TYPE (attrs) = coding_type;
- if (STRINGP (string)
- || from >= GPT || to <= GPT)
- positions = unencodable_char_position (safe_chars, from, p, pend, n);
+ 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
{
- Lisp_Object args[2];
-
- args[0] = unencodable_char_position (safe_chars, from, p, GPT_ADDR, n);
- n -= XINT (Flength (args[0]));
- if (n <= 0)
- positions = args[0];
- else
+ charset_list = Fcopy_sequence (charset_list);
+ for (tail = charset_list; !NILP (tail); tail = Fcdr (tail))
{
- args[1] = unencodable_char_position (safe_chars, GPT, GAP_END_ADDR,
- pend, n);
- positions = Fappend (2, args);
+ struct charset *charset;
+
+ val = Fcar (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'",
- XSYMBOL (CHARSET_NAME (charset))->name->data);
++ SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
+
- XCAR (tail) = make_number (charset->id);
++ XSETCAR (tail, make_number (charset->id));
+ if (max_charset_id < charset->id)
+ max_charset_id = charset->id;
}
}
+ CODING_ATTR_CHARSET_LIST (attrs) = charset_list;
- return (NILP (count) ? Fcar (positions) : positions);
- }
-
+ safe_charsets = Fmake_string (make_number (max_charset_id + 1),
+ make_number (255));
+ for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
- XSTRING (safe_charsets)->data[XFASTINT (XCAR (tail))] = 0;
++ SSET (safe_charsets, XFASTINT (XCAR (tail)), 0);
+ CODING_ATTR_SAFE_CHARSETS (attrs) = safe_charsets;
- Lisp_Object
- code_convert_region1 (start, end, coding_system, encodep)
- Lisp_Object start, end, coding_system;
- int encodep;
- {
- struct coding_system coding;
- int from, to;
+ CODING_ATTR_ASCII_COMPAT (attrs) = args[coding_arg_ascii_compatible_p];
- CHECK_NUMBER_COERCE_MARKER (start);
- CHECK_NUMBER_COERCE_MARKER (end);
- CHECK_SYMBOL (coding_system);
+ val = args[coding_arg_decode_translation_table];
+ if (! NILP (val))
+ CHECK_CHAR_TABLE (val);
+ CODING_ATTR_DECODE_TBL (attrs) = val;
- validate_region (&start, &end);
- from = XFASTINT (start);
- to = XFASTINT (end);
+ val = args[coding_arg_encode_translation_table];
+ if (! NILP (val))
+ CHECK_CHAR_TABLE (val);
+ CODING_ATTR_ENCODE_TBL (attrs) = val;
- if (NILP (coding_system))
- return make_number (to - from);
+ val = args[coding_arg_post_read_conversion];
+ CHECK_SYMBOL (val);
+ CODING_ATTR_POST_READ (attrs) = val;
- if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0)
- error ("Invalid coding system: %s", SDATA (SYMBOL_NAME (coding_system)));
+ val = args[coding_arg_pre_write_conversion];
+ CHECK_SYMBOL (val);
+ CODING_ATTR_PRE_WRITE (attrs) = val;
- 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);
- }
+ val = args[coding_arg_default_char];
+ if (NILP (val))
+ CODING_ATTR_DEFAULT_CHAR (attrs) = make_number (' ');
+ else
+ {
- CHECK_CHARACTER (val);
++ CHECK_CHARACTER (val);
+ CODING_ATTR_DEFAULT_CHAR (attrs) = val;
+ }
- DEFUN ("decode-coding-region", Fdecode_coding_region, Sdecode_coding_region,
- 3, 3, "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.
- 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;
- {
- return code_convert_region1 (start, end, coding_system, 0);
- }
++ val = args[coding_arg_for_unibyte];
++ CODING_ATTR_FOR_UNIBYTE (attrs) = NILP (val) ? Qnil : Qt;
+
- 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.
- When called from a program, takes three arguments:
- START, END, and CODING-SYSTEM. START and END are buffer positions.
- 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;
- {
- return code_convert_region1 (start, end, coding_system, 1);
- }
+ val = args[coding_arg_plist];
+ CHECK_LIST (val);
+ CODING_ATTR_PLIST (attrs) = val;
- Lisp_Object
- code_convert_string1 (string, coding_system, nocopy, encodep)
- Lisp_Object string, coding_system, nocopy;
- int encodep;
- {
- struct coding_system coding;
+ if (EQ (coding_type, Qcharset))
+ {
+ Lisp_Object list;
+ /* Generate a lisp vector of 256 elements. Each element is nil,
+ integer, or a list of charset IDs.
- CHECK_STRING (string);
- CHECK_SYMBOL (coding_system);
+ If Nth element is nil, the byte code N is invalid in this
+ coding system.
- if (NILP (coding_system))
- return (NILP (nocopy) ? Fcopy_sequence (string) : string);
+ If Nth element is a number NUM, N is the first byte of a
+ charset whose ID is NUM.
- if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0)
- error ("Invalid coding system: %s", SDATA (SYMBOL_NAME (coding_system)));
+ 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.
+ */
+ for (list = Qnil, tail = charset_list; CONSP (tail); tail = XCDR (tail))
+ {
+ struct charset *charset = CHARSET_FROM_ID (XFASTINT (XCAR (tail)));
- 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;
+ if (charset->method == CHARSET_METHOD_SUPERSET)
+ {
+ val = CHARSET_SUPERSET (charset);
+ for (; CONSP (val); val = XCDR (val))
- list = Fcons (XCAR (XCAR (val)), list);
++ list = Fcons (XCAR (XCAR (val)), list);
+ }
+ else
+ list = Fcons (XCAR (tail), list);
+ }
- return string;
- }
+ val = Fmake_vector (make_number (256), Qnil);
- 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);
- }
+ for (tail = Fnreverse (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;
-
+
- 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);
- }
+ if (CHARSET_ASCII_COMPATIBLE_P (charset))
+ CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
- /* Encode or decode STRING according to CODING_SYSTEM.
- Do not set Vlast_coding_system_used.
+ for (i = charset->code_space[idx];
+ i <= charset->code_space[idx + 1]; i++)
+ {
+ Lisp_Object tmp, tmp2;
+ int dim2;
- This function is called only from macros DECODE_FILE and
- ENCODE_FILE, thus we ignore character composition. */
+ 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;
-
+
- Lisp_Object
- code_convert_string_norecord (string, coding_system, encodep)
- Lisp_Object string, coding_system;
- int encodep;
- {
- struct coding_system coding;
+ if (nargs < coding_arg_ccl_max)
+ goto short_args;
- CHECK_STRING (string);
- CHECK_SYMBOL (coding_system);
+ val = args[coding_arg_ccl_decoder];
+ CHECK_CCL_PROGRAM (val);
+ if (VECTORP (val))
+ val = Fcopy_sequence (val);
+ ASET (attrs, coding_attr_ccl_decoder, val);
- if (NILP (coding_system))
- return string;
+ 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 (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0)
- error ("Invalid coding system: %s", SDATA (SYMBOL_NAME (coding_system)));
+ 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;
- coding.composing = COMPOSITION_DISABLED;
- coding.mode |= CODING_MODE_LAST_BLOCK;
- return (encodep
- ? encode_coding_string (string, &coding, 1)
- : decode_coding_string (string, &coding, 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.
- Return the corresponding character. */)
- (code)
- Lisp_Object code;
- {
- unsigned char c1, c2, s1, s2;
- Lisp_Object val;
+ 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_NUMBER (XCAR (val));
- CHECK_NUMBER (XCDR (val));
++ CHECK_NATNUM_CAR (val);
++ CHECK_NATNUM_CDR (val);
+ from = XINT (XCAR (val));
- if (from < 0 || from > 255)
++ 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++)
- XSTRING (valids)->data[i] = 1;
++ SSET (valids, i, 1);
+ }
+ ASET (attrs, coding_attr_ccl_valids, valids);
-
+
- CHECK_NUMBER (code);
- s1 = (XFASTINT (code)) >> 8, s2 = (XFASTINT (code)) & 0xFF;
- if (s1 == 0)
- {
- 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));
+ category = coding_category_ccl;
}
- else
+ else if (EQ (coding_type, Qutf_16))
{
- 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));
- }
- return val;
- }
+ Lisp_Object bom, endian;
- DEFUN ("encode-sjis-char", Fencode_sjis_char, Sencode_sjis_char, 1, 1, 0,
- doc: /* Encode a Japanese character CHAR to shift_jis encoding.
- Return the corresponding code in SJIS. */)
- (ch)
- Lisp_Object ch;
- {
- int charset, c1, c2, s1, s2;
- Lisp_Object val;
+ CODING_ATTR_ASCII_COMPAT (attrs) = Qnil;
- 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;
- }
+ if (nargs < coding_arg_utf16_max)
+ goto short_args;
- DEFUN ("decode-big5-char", Fdecode_big5_char, Sdecode_big5_char, 1, 1, 0,
- doc: /* Decode a Big5 character which has CODE in BIG5 coding system.
- Return the corresponding character. */)
- (code)
- Lisp_Object code;
- {
- int charset;
- unsigned char b1, b2, c1, c2;
- Lisp_Object val;
+ bom = args[coding_arg_utf16_bom];
+ if (! NILP (bom) && ! EQ (bom, Qt))
+ {
+ CHECK_CONS (bom);
- CHECK_CODING_SYSTEM (XCAR (bom));
- CHECK_CODING_SYSTEM (XCDR (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", XSYMBOL (endian)->name->data);
++ 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))
+ {
+ 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;
+ }
+ else
+ ASET (initial, i, make_number (-1));
+ }
+
+ reg_usage = args[coding_arg_iso2022_reg_usage];
+ CHECK_CONS (reg_usage);
- CHECK_NATNUM (XCAR (reg_usage));
- CHECK_NATNUM (XCDR (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);
- CHECK_CHARSET_GET_ID (XCAR (val), id);
- CHECK_NATNUM (XCDR (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)));
- XCAR (val) = make_number (id);
++ XSETCAR (val, make_number (id));
+ }
- CHECK_NUMBER (code);
- b1 = (XFASTINT (code)) >> 8, b2 = (XFASTINT (code)) & 0xFF;
- if (b1 == 0)
+ 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 (b2 >= 0x80)
- error ("Invalid BIG5 code: %x", XFASTINT (code));
- val = code;
+ 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
+ else if (EQ (coding_type, Qshift_jis))
{
- 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));
+
+ struct charset *charset;
+
+ if (XINT (Flength (charset_list)) != 3)
+ error ("There should be just three charsets");
+
+ charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
+ if (CHARSET_DIMENSION (charset) != 1)
+ error ("Dimension of charset %s is not one",
- XSYMBOL (CHARSET_NAME (charset))->name->data);
++ 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",
- XSYMBOL (CHARSET_NAME (charset))->name->data);
++ 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",
- XSYMBOL (CHARSET_NAME (charset))->name->data);
++ SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
+
+ category = coding_category_sjis;
+ Vsjis_coding_system = name;
}
- return val;
- }
+ else if (EQ (coding_type, Qbig5))
+ {
+ struct charset *charset;
- DEFUN ("encode-big5-char", Fencode_big5_char, Sencode_big5_char, 1, 1, 0,
- doc: /* Encode the Big5 character CHAR to BIG5 coding system.
- Return the corresponding character code in Big5. */)
- (ch)
- Lisp_Object ch;
- {
- int charset, c1, c2, b1, b2;
- Lisp_Object val;
+ 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",
- XSYMBOL (CHARSET_NAME (charset))->name->data);
++ 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",
- XSYMBOL (CHARSET_NAME (charset))->name->data);
++ SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
- CHECK_NUMBER (ch);
- SPLIT_CHAR (XFASTINT (ch), charset, c1, c2);
- if (charset == CHARSET_ASCII)
+ category = coding_category_big5;
+ Vbig5_coding_system = name;
+ }
+ else if (EQ (coding_type, Qraw_text))
{
- val = ch;
+ category = coding_category_raw_text;
+ CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
}
- else if ((charset == charset_big5_1
- && (XFASTINT (ch) >= 0x250a1 && XFASTINT (ch) <= 0x271ec))
- || (charset == charset_big5_2
- && XFASTINT (ch) >= 0x290a1 && XFASTINT (ch) <= 0x2bdb2))
+ else if (EQ (coding_type, Qutf_8))
{
- ENCODE_BIG5 (charset, c1, c2, b1, b2);
- XSETFASTINT (val, (b1 << 8) | b2);
+ category = coding_category_utf_8;
+ CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
}
+ else if (EQ (coding_type, Qundecided))
+ category = coding_category_undecided;
else
- error ("Can't encode to Big5: %d", XFASTINT (ch));
- return val;
- }
- \f
- DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_internal,
- Sset_terminal_coding_system_internal, 1, 1, 0,
- doc: /* Internal use only. */)
- (coding_system)
- Lisp_Object coding_system;
- {
- 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.src_multibyte = 1;
- terminal_coding.dst_multibyte = 0;
- return Qnil;
- }
+ error ("Invalid coding system type: %s",
- XSYMBOL (coding_type)->name->data);
++ SDATA (SYMBOL_NAME (coding_type)));
- 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)
- Lisp_Object 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. */
- terminal_coding.suppress_error = 1;
- safe_terminal_coding.src_multibyte = 1;
- safe_terminal_coding.dst_multibyte = 0;
- return Qnil;
- }
+ CODING_ATTR_CATEGORY (attrs) = make_number (category);
+ CODING_ATTR_PLIST (attrs)
+ = Fcons (QCcategory, Fcons (AREF (Vcoding_category_table, category),
+ CODING_ATTR_PLIST (attrs)));
- DEFUN ("terminal-coding-system", Fterminal_coding_system,
- Sterminal_coding_system, 0, 0, 0,
- doc: /* Return coding system specified for terminal output. */)
- ()
- {
- return terminal_coding.symbol;
- }
+ 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");
- DEFUN ("set-keyboard-coding-system-internal", Fset_keyboard_coding_system_internal,
- Sset_keyboard_coding_system_internal, 1, 1, 0,
- doc: /* Internal use only. */)
- (coding_system)
- Lisp_Object coding_system;
- {
- CHECK_SYMBOL (coding_system);
- setup_coding_system (Fcheck_coding_system (coding_system), &keyboard_coding);
- /* Character composition should be disabled. */
- keyboard_coding.composing = COMPOSITION_DISABLED;
- return Qnil;
- }
+ aliases = Fcons (name, Qnil);
- DEFUN ("keyboard-coding-system", Fkeyboard_coding_system,
- Skeyboard_coding_system, 0, 0, 0,
- doc: /* Return coding system specified for decoding keyboard input. */)
- ()
- {
- return keyboard_coding.symbol;
- }
+ if (NILP (eol_type))
+ {
+ eol_type = make_subsidiaries (name);
+ for (i = 0; i < 3; i++)
+ {
+ 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);
+ Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (this_name), Qnil),
+ Vcoding_system_alist);
+ }
+ }
- \f
- DEFUN ("find-operation-coding-system", Ffind_operation_coding_system,
- Sfind_operation_coding_system, 1, MANY, 0,
- doc: /* Choose a coding system for an operation based on the target name.
- The value names a pair of coding systems: (DECODING-SYSTEM . ENCODING-SYSTEM).
- DECODING-SYSTEM is the coding system to use for decoding
- \(in case OPERATION does decoding), and ENCODING-SYSTEM is the coding system
- for encoding (in case OPERATION does encoding).
+ spec_vec = Fmake_vector (make_number (3), attrs);
+ ASET (spec_vec, 1, aliases);
+ ASET (spec_vec, 2, eol_type);
- The first argument OPERATION specifies an I/O primitive:
- For file I/O, `insert-file-contents' or `write-region'.
- For process I/O, `call-process', `call-process-region', or `start-process'.
- For network I/O, `open-network-stream'.
+ Fputhash (name, spec_vec, Vcoding_system_hash_table);
+ Vcoding_system_list = Fcons (name, Vcoding_system_list);
+ Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (name), Qnil),
+ Vcoding_system_alist);
- 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.
+ {
+ int id = coding_categories[category].id;
- TARGET has a meaning which depends on OPERATION:
- For file I/O, TARGET is a file name.
- For process I/O, TARGET is a process name.
- For network I/O, TARGET is a service name or a port number
+ if (id < 0 || EQ (name, CODING_ID_NAME (id)))
+ setup_coding_system (name, &coding_categories[category]);
+ }
- 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.
+ return Qnil;
- 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;
+ short_args:
+ return Fsignal (Qwrong_number_of_arguments,
+ Fcons (intern ("define-coding-system-internal"),
+ make_number (nargs)));
+ }
- 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, Qopen_network_stream) && INTEGERP (target))))
- error ("Invalid argument %d", XINT (target_idx) + 1);
+ /* Fixme: should this record the alias relationships for
+ diagnostics? Should it update coding-system-list? */
+ 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;
- 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;
+ CHECK_SYMBOL (alias);
+ CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
+ aliases = AREF (spec, 1);
+ while (!NILP (XCDR (aliases)))
+ aliases = XCDR (aliases);
- XCDR (aliases) = Fcons (alias, Qnil);
++ XSETCDR (aliases, Fcons (alias, Qnil));
- for (; CONSP (chain); chain = XCDR (chain))
+ eol_type = AREF (spec, 2);
+ if (VECTORP (eol_type))
{
- Lisp_Object elt;
- elt = XCAR (chain);
+ Lisp_Object subsidiaries;
+ int i;
- 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)))
- {
- 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;
- }
+ subsidiaries = make_subsidiaries (alias);
+ for (i = 0; i < 3; i++)
+ Fdefine_coding_system_alias (AREF (subsidiaries, i),
+ AREF (eol_type, i));
+
+ ASET (spec, 2, subsidiaries);
}
+
+ Fputhash (alias, spec, Vcoding_system_hash_table);
+ Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (alias), Qnil),
+ Vcoding_system_alist);
+
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. */)
- ()
+ 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;
{
- int i;
+ Lisp_Object spec, attrs;
- for (i = CODING_CATEGORY_IDX_EMACS_MULE; i < CODING_CATEGORY_IDX_MAX; i++)
- {
- Lisp_Object val;
+ 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);
+ }
- val = SYMBOL_VALUE (XVECTOR (Vcoding_category_table)->contents[i]);
- if (!NILP (val))
- {
- 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]);
- }
- else if (coding_system_table[i])
- {
- xfree (coding_system_table[i]);
- coding_system_table[i] = NULL;
- }
- }
+ 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;
- return Qnil;
+ 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 ("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-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;
{
- int i = 0, idx;
- Lisp_Object val;
+ Lisp_Object spec;
- val = Vcoding_category_list;
+ if (NILP (coding_system))
+ coding_system = Qno_conversion;
+ CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
+ return AREF (spec, 1);
+ }
- while (CONSP (val) && i < CODING_CATEGORY_IDX_MAX)
- {
- 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);
- }
- /* 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;
+ 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.
- return Qnil;
- }
+ Integer values 0, 1, and 2 indicate a format of end-of-line; LF, CRLF,
+ and CR respectively.
- 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. */)
+ 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 safe_chars, slot;
+ Lisp_Object spec, eol_type;
+ int n;
- if (NILP (Fcheck_coding_system (coding_system)))
- Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil));
- 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)));
- 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;
+ 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[ISO_CODE_SS3] = ISO_single_shift_3;
iso_code_class[ISO_CODE_CSI] = ISO_control_sequence_introducer;
- setup_coding_system (Qnil, &keyboard_coding);
- setup_coding_system (Qnil, &terminal_coding);
- 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 ()
{
- Qtarget_idx = intern ("target-idx");
- staticpro (&Qtarget_idx);
+ staticpro (&Vcoding_system_hash_table);
- Vcoding_system_hash_table = Fmakehash (Qeq);
++ {
++ 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;
- Qcoding_system_history = intern ("coding-system-history");
- staticpro (&Qcoding_system_history);
+ staticpro (&Vbig5_coding_system);
+ Vbig5_coding_system = Qnil;
+
+ staticpro (&Vcode_conversion_work_buf_list);
+ Vcode_conversion_work_buf_list = Qnil;
+
+ staticpro (&Vcode_conversion_reused_work_buf);
+ Vcode_conversion_reused_work_buf = Qnil;
+
+ 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);
-
- Qeol_type = intern ("eol-type");
- staticpro (&Qeol_type);
+ DEFSYM (Qcoding_system, "coding-system");
+ DEFSYM (Qcoding_aliases, "coding-aliases");
- Qbuffer_file_coding_system = intern ("buffer-file-coding-system");
- staticpro (&Qbuffer_file_coding_system);
+ DEFSYM (Qeol_type, "eol-type");
+ DEFSYM (Qunix, "unix");
+ DEFSYM (Qdos, "dos");
- Qpost_read_conversion = intern ("post-read-conversion");
- staticpro (&Qpost_read_conversion);
+ 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");
- Qpre_write_conversion = intern ("pre-write-conversion");
- staticpro (&Qpre_write_conversion);
+ DEFSYM (Qiso_2022, "iso-2022");
- Qno_conversion = intern ("no-conversion");
- staticpro (&Qno_conversion);
+ DEFSYM (Qutf_8, "utf-8");
++ DEFSYM (Qutf_8_emacs, "utf-8-emacs");
- Qundecided = intern ("undecided");
- staticpro (&Qundecided);
+ DEFSYM (Qutf_16, "utf-16");
+ DEFSYM (Qbig, "big");
+ DEFSYM (Qlittle, "little");
- Qcoding_system_p = intern ("coding-system-p");
- staticpro (&Qcoding_system_p);
+ DEFSYM (Qshift_jis, "shift-jis");
+ DEFSYM (Qbig5, "big5");
- 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);
+ DEFSYM (Qtranslation_table, "translation-table");
+ Fput (Qtranslation_table, Qchar_table_extra_slots, make_number (1));
+ 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");
+
+ 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"));
defsubr (&Scoding_system_p);
defsubr (&Sread_coding_system);
defsubr (&Sdetect_coding_region);
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_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_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.
and the cdr part is used for encoding.
If VAL is a function symbol, the function must return a coding system
or a cons of coding systems which are used as above. The function gets
- the arguments with which `find-operation-coding-system' was called.
+ the arguments with which `find-operation-coding-systems' was called.
See also the function `find-operation-coding-system'
and the variable `auto-coding-alist'. */);
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
The default value is `select-safe-coding-system' (which see). */);
Vselect_safe_coding_system_function = Qnil;
+ DEFVAR_BOOL ("coding-system-require-warning",
+ &coding_system_require_warning,
+ doc: /* Internal use only.
+If non-nil, on writing a file, `select-safe-coding-system-function' is
+called even if `coding-system-for-write' is non-nil. The command
+`universal-coding-system-argument' binds this variable to t temporarily. */);
+ coding_system_require_warning = 0;
+
+
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
escape sequence (e.g `latin-1') on reading by \\[universal-coding-system-argument]. */);
inhibit_iso_escape_detection = 0;
- Lisp_Object plist[14];
+ DEFVAR_LISP ("translation-table-for-input", &Vtranslation_table_for_input,
+ doc: /* Char table for translating self-inserting characters.
+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];
- plist[10] = intern (":docstring");
- plist[11] = build_string ("Do no conversion.\n\
++ 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[12] = intern (":eol-type");
- plist[13] = args[coding_arg_eol_type] = Qunix;
- args[coding_arg_plist] = Flist (14, plist);
++ 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);
+ }
+
+ setup_coding_system (Qno_conversion, &keyboard_coding);
+ setup_coding_system (Qno_conversion, &terminal_coding);
+ 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);
+ }
}
char *
Lisp_Object dec = code_convert_string_norecord (build_string (str),
Vlocale_coding_system,
0);
- str = (char *) XSTRING (dec)->data;
+ str = (char *) SDATA (dec);
}
return str;
}
#endif /* emacs */
-
/* Header for coding system handler.
Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
-- Licensed to the Free Software Foundation.
- Copyright (C) 2001, 2002
++ Licensed to the Free Software Foundation.
++ 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
+ extern Lisp_Object Vcoding_system_hash_table;
- /* If set, reset graphic planes and registers at end-of-line to the
- initial state. */
- #define CODING_FLAG_ISO_RESET_AT_EOL 0x0002
+ /* Enumeration of coding system type. */
- /* If set, reset graphic planes and registers before any control
- characters to the initial state. */
- #define CODING_FLAG_ISO_RESET_AT_CNTL 0x0004
+ 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, encode by 7-bit environment. */
- #define CODING_FLAG_ISO_SEVEN_BITS 0x0008
- /* If set, use locking-shift function. */
- #define CODING_FLAG_ISO_LOCKING_SHIFT 0x0010
+ /* Enumeration of end-of-line format type. */
- /* If set, use single-shift function. Overwrite
- CODING_FLAG_ISO_LOCKING_SHIFT. */
- #define CODING_FLAG_ISO_SINGLE_SHIFT 0x0020
+ 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, designate JISX0201-Roman instead of ASCII. */
- #define CODING_FLAG_ISO_USE_ROMAN 0x0040
+ /* Enumeration of index to an attribute vector of a coding system. */
- /* If set, designate JISX0208-1978 instead of JISX0208-1983. */
- #define CODING_FLAG_ISO_USE_OLDJIS 0x0080
+ 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_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, do not produce ISO6429's direction specifying sequence. */
- #define CODING_FLAG_ISO_NO_DIRECTION 0x0100
- /* If set, assume designation states are reset at beginning of line on
- output. */
- #define CODING_FLAG_ISO_INIT_AT_BOL 0x0200
+ #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_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_DIRECTION(attrs) AREF (attrs, coding_attr_direction)
++#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, 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
+ #define CODING_ID_ATTRS(id) \
+ (AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 0))
- /* If set, extra latin codes (128..159) are accepted as a valid code
- on input. */
- #define CODING_FLAG_ISO_LATIN_EXTRA 0x1000
+ #define CODING_ID_ALIASES(id) \
+ (AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 1))
- /* If set, use designation escape sequence. */
- #define CODING_FLAG_ISO_DESIGNATION 0x10000
+ #define CODING_ID_EOL_TYPE(id) \
+ (AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 2))
- /* 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 '?'
+ #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];
+ #define CODING_SYSTEM_SPEC(coding_system_symbol) \
+ (Fgethash (coding_system_symbol, Vcoding_system_hash_table, Qnil))
- /* The current charset designated to each graphic register. */
- int current_designation[4];
+ #define CODING_SYSTEM_ID(coding_system_symbol) \
+ hash_lookup (XHASH_TABLE (Vcoding_system_hash_table), \
+ coding_system_symbol, NULL)
- /* A charset initially designated to each graphic register. */
- int initial_designation[4];
+ #define CODING_SYSTEM_P(coding_system_symbol) \
+ (! NILP (CODING_SYSTEM_SPEC (coding_system_symbol)))
- /* If not -1, it is a graphic register specified in an invalid
- designation sequence. */
- int last_invalid_designation_register;
-#define CHECK_CODING_SYSTEM(x) \
++#define CHECK_CODING_SYSTEM(x) \
+ do { \
+ if (!CODING_SYSTEM_P (x)) \
- x = wrong_type_argument (Qcoding_system_p, (x)); \
++ wrong_type_argument (Qcoding_system_p, (x)); \
+ } while (0)
- /* A graphic register to which each charset should be designated. */
- unsigned char requested_designation[MAX_CHARSET + 1];
- /* 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 CHECK_CODING_SYSTEM_GET_SPEC(x, spec) \
+ do { \
+ spec = CODING_SYSTEM_SPEC (x); \
+ if (NILP (spec)) \
+ x = wrong_type_argument (Qcoding_system_p, (x)); \
+ } while (0)
- /* 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;
- };
+ #define CHECK_CODING_SYSTEM_GET_ID(x, id) \
+ do \
+ { \
+ 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_INSUFFICIENT_CMP,
+ 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 iff 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
+
+ #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;
+ };
- /* The current status of composition handling. */
- int composing;
+ struct ccl_spec;
- /* 1 iff the next character is a composition rule. */
- int composition_rule_follows;
+ 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;
+ };
- /* Information of compositions are stored here on decoding and set
- in advance on encoding. */
- struct composition_data *cmp_data;
+ 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;
+ };
- /* Index to cmp_data->data for the first element for the current
- composition. */
- int cmp_data_start;
- /* Index to cmp_data->data for the current element for the current
- composition. */
- int cmp_data_index;
+ 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;
+
+ /* Flag bits of the coding system. The meaning of each bit is common
+ to all types of coding systems. */
+ int common_flags;
+
+ /* 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. */
- /* Backward pointer to the Lisp symbol of the coding system. */
- Lisp_Object symbol;
+ EMACS_INT src_pos, src_pos_byte, src_chars, src_bytes;
+ Lisp_Object src_object;
- unsigned char *source;
++ const unsigned char *source;
- /* Lisp function (symbol) to be called after decoding to do
- additional conversion, or nil. */
- Lisp_Object post_read_conversion;
+ EMACS_INT dst_pos, dst_pos_byte, dst_bytes;
+ Lisp_Object dst_object;
+ unsigned char *destination;
- /* Lisp function (symbol) to be called before encoding to do
- additional conversion, or nil. */
- Lisp_Object pre_write_conversion;
+ int chars_at_source;
- /* Character translation tables to look up, or nil. */
- Lisp_Object translation_table_for_decode;
- Lisp_Object translation_table_for_encode;
- };
+ /* If an element is non-negative, it is a character code.
+
+ 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;
- #define CODING_REQUIRE_FLUSHING_MASK 1
- #define CODING_REQUIRE_DECODING_MASK 2
- #define CODING_REQUIRE_ENCODING_MASK 4
- #define CODING_REQUIRE_DETECTION_MASK 8
+ unsigned char carryover[64];
+ int carryover_bytes;
- /* Return 1 if the coding system CODING requires specific code to be
+ int default_char;
+
+ int (*detector) P_ ((struct coding_system *,
+ struct coding_detection_info *));
+ void (*decoder) P_ ((struct coding_system *));
+ int (*encoder) P_ ((struct coding_system *));
+ };
+
+ /* 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. */
- #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 ENCODE_SJIS(c1, c2, s1, s2) \
+
+ #define JIS_TO_SJIS(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 / 2 + ((j1 < 0x5F) ? 0x71 : 0xB1), \
+ s2 = j2 + ((j2 >= 0x60) ? 0x20 : 0x1F)); \
else \
- s1 = c1 / 2 + ((c1 < 0x5F) ? 0x70 : 0xB0), \
- s2 = c2 + 0x7E; \
+ (s1 = j1 / 2 + ((j1 < 0x5F) ? 0x70 : 0xB0), \
+ s2 = j2 + 0x7E); \
+ (code) = (s1 << 8) | s2; \
} while (0)
+
/* Encode the file name NAME using the specified coding system
for file names, if any. */
#define ENCODE_FILE(name) \
? 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))
+
#ifdef WINDOWSNT
/* Encode the string STR using the specified coding system
for w32 system functions, if any. */
- #define ENCODE_SYSTEM(str) \
- (! NILP (Vlocale_coding_system) \
- && XFASTINT (Vlocale_coding_system) != 0 \
- ? code_convert_string_norecord (str, Vlocale_coding_system, 1) \
+ #define ENCODE_SYSTEM(str) \
+ (! NILP (Vlocale_coding_system) \
+ && XFASTINT (Vlocale_coding_system) != 0 \
+ ? code_convert_string_norecord (str, Vlocale_coding_system, 1) \
: str)
/* Decode the string STR using the specified coding system
for w32 system functions, if any. */
- #define DECODE_SYSTEM(name) \
- (! NILP (Vlocale_coding_system) \
- && XFASTINT (Vlocale_coding_system) != 0 \
- ? code_convert_string_norecord (str, Vlocale_coding_system, 0) \
+ #define DECODE_SYSTEM(name) \
+ (! NILP (Vlocale_coding_system) \
+ && XFASTINT (Vlocale_coding_system) != 0 \
+ ? code_convert_string_norecord (str, Vlocale_coding_system, 0) \
: str)
#else /* WINDOWSNT */
#endif /* !WINDOWSNT */
- #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 Lisp_Object make_conversion_work_buffer 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 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));
+
+ #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;
function `set-keyboard-coding-system'. */
extern struct coding_system keyboard_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;
+/* If nonzero, on writing a file, Vselect_safe_coding_system_function
+ is called even if Vcoding_system_for_write is non-nil. */
+extern int coding_system_require_warning;
+
/* Coding system for file names, or nil if none. */
extern Lisp_Object Vfile_name_coding_system;
/* 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 */
/* Composite sequence support.
Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
-- Licensed to the Free Software Foundation.
++ Licensed to the Free Software Foundation.
Copyright (C) 2001 Free Software Foundation, Inc.
- Copyright (C) 2001, 2002
++ Copyright (C) 2003
+ 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;
/* 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)))
-
/* 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
}
/* This composition is a new one. We must register it. */
-
+
/* Check if we have sufficient memory to store this information. */
if (composition_table_size == 0)
{
&& find_composition (to, -1, &start, &end, &prop, Qnil)
&& !COMPOSITION_VALID_P (start, end, prop))
to = end;
- if (!NILP (func))
+ 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. */
{
Lisp_Object prop;
int start, end;
+ /* The beginning and end of the region to set the property
+ `auto-composed' to nil. */
+ int min_pos = from, max_pos = to;
if (inhibit_modification_hooks)
return;
-
+
/* If FROM and TO are not in a valid range, do nothing. */
if (! (BEGV <= from && from <= to && to <= ZV))
return;
if (from > BEGV
&& find_composition (from - 1, -1, &start, &end, &prop, Qnil))
{
+ 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))
- 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))
- run_composition_function (start, end, prop);
+ {
+ run_composition_function (start, end, prop);
+ max_pos = end;
+ }
}
-
+ if (min_pos < max_pos)
- Fput_text_property (make_number (min_pos), make_number (max_pos),
- Qauto_composed, Qnil, Qnil);
++ Fremove_list_of_text_properties (make_number (min_pos),
++ make_number (max_pos),
++ Fcons (Qauto_composed, Qnil), Qnil);
}
Fput_text_property (make_number (start), make_number (end),
Qcomposition, prop, string);
}
-
- /* Compose sequences of characters in the region between START and END
- by functions registered in Vcomposition_function_table. If STRING
- is non-nil, operate on characters contained between indices START
- and END in STRING. */
-
- void
- compose_chars_in_text (start, end, string)
- int start, end;
- Lisp_Object string;
- {
- int count = 0;
- struct gcpro gcpro1;
- Lisp_Object tail, elt, val, to;
- /* Set to nonzero if we don't have to compose ASCII characters. */
- int skip_ascii;
- int i, len, stop, c;
- const unsigned char *ptr, *pend;
-
- if (! CHAR_TABLE_P (Vcomposition_function_table))
- return;
-
- if (STRINGP (string))
- {
- count = SPECPDL_INDEX ();
- GCPRO1 (string);
- stop = end;
- ptr = SDATA (string) + string_char_to_byte (string, start);
- pend = ptr + SBYTES (string);
- }
- else
- {
- record_unwind_protect (save_excursion_restore, save_excursion_save ());
- TEMP_SET_PT (start);
- stop = (start < GPT && GPT < end ? GPT : end);
- ptr = CHAR_POS_ADDR (start);
- pend = CHAR_POS_ADDR (end);
- }
-
- /* Preserve the match data. */
- record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
-
- /* If none of ASCII characters have composition functions, we can
- skip them quickly. */
- for (i = 0; i < 128; i++)
- if (!NILP (CHAR_TABLE_REF (Vcomposition_function_table, i)))
- break;
- skip_ascii = (i == 128);
-
-
- while (1)
- {
- if (skip_ascii)
- while (start < stop && ASCII_BYTE_P (*ptr))
- start++, ptr++;
-
- if (start >= stop)
- {
- if (stop == end || start >= end)
- break;
- stop = end;
- if (STRINGP (string))
- ptr = SDATA (string) + string_char_to_byte (string, start);
- else
- ptr = CHAR_POS_ADDR (start);
- }
-
- c = STRING_CHAR_AND_LENGTH (ptr, pend - ptr, len);
- tail = CHAR_TABLE_REF (Vcomposition_function_table, c);
- while (CONSP (tail))
- {
- elt = XCAR (tail);
- if (CONSP (elt)
- && STRINGP (XCAR (elt))
- && !NILP (Ffboundp (XCDR (elt))))
- {
- if (STRINGP (string))
- val = Fstring_match (XCAR (elt), string, make_number (start));
- else
- {
- val = Flooking_at (XCAR (elt));
- if (!NILP (val))
- val = make_number (start);
- }
- if (INTEGERP (val) && XFASTINT (val) == start)
- {
- to = Fmatch_end (make_number (0));
- val = call4 (XCDR (elt), val, to, XCAR (elt), string);
- if (INTEGERP (val) && XINT (val) > 1)
- {
- start += XINT (val);
- if (STRINGP (string))
- ptr = SDATA (string) + string_char_to_byte (string, start);
- else
- ptr = CHAR_POS_ADDR (start);
- }
- else
- {
- start++;
- ptr += len;
- }
- break;
- }
- }
- tail = XCDR (tail);
- }
- if (!CONSP (tail))
- {
- /* No composition done. Try the next character. */
- start++;
- ptr += len;
- }
- }
--
- unbind_to (count, Qnil);
- if (STRINGP (string))
- UNGCPRO;
- }
\f
/* Emacs Lisp APIs. */
if (XINT (start) < 0 ||
XINT (start) > XINT (end)
- || XINT (end) > XSTRING (string)->size)
+ || XINT (end) > SCHARS (string))
args_out_of_range (start, end);
compose_text (XINT (start), XINT (end), components, mod_func, string);
}
DEFUN ("find-composition-internal", Ffind_composition_internal,
- Sfind_composition_internal, 4, 4, 0,
+ Sfind_composition_internal, 4, 4, 0,
doc: /* Internal use only.
Return information about composition at or nearest to position POS.
}
else
end = -1;
-
+
if (!NILP (string))
{
CHECK_STRING (string);
- if (XINT (pos) < 0 || XINT (pos) > XSTRING (string)->size)
+ if (XINT (pos) < 0 || XINT (pos) > SCHARS (string))
args_out_of_range (string, pos);
}
else
{
Lisp_Object args[6];
extern Lisp_Object QCsize;
-
+
args[0] = QCtest;
args[1] = Qequal;
args[2] = QCweakness;
- args[3] = Qnil;
+ args[3] = Qt;
args[4] = QCsize;
args[5] = make_number (311);
composition_hash_table = Fmake_hash_table (6, args);
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 two arguments,
+ POS 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 following POS
+ 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 POS is an index to the string. In
+ this case, the function must compose characters following POS in
+ the string. */);
+ Vauto_composition_function = Qnil;
defsubr (&Scompose_region_internal);
defsubr (&Scompose_string_internal);
/* Header for composite sequence handler.
Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
-- Licensed to the Free Software Foundation.
++ Licensed to the Free Software Foundation.
Copyright (C) 2001 Free Software Foundation, Inc.
- Copyright (C) 2001, 2002
++ Copyright (C) 2003
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
/* Methods to display a sequence of components 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,
+ /* This is not a method. */
+ COMPOSITION_NO
};
/* Maximum number of compoments a single composition can have. */
#define COMPOSITION_MODIFICATION_FUNC(prop) \
(COMPOSITION_REGISTERD_P (prop) \
? XCDR (XCDR (XCDR (prop))) \
- : XCDR (prop))
+ : CONSP (prop) ? XCDR (prop) : Qnil)
/* Return the method of composition. */
#define COMPOSITION_METHOD(prop) \
When a composition is assigned an ID number (by
get_composition_id), this structure is allocated for the
- composition and linked in composition_table[ID].
+ composition and linked in composition_table[ID].
Identical compositions appearing at different places have the same
ID, and thus share the same instance of this structure. */
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 *,
/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
- Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001, 2002
+ Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001, 2003
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"
Lisp_Object object;
{
if (SYMBOLP (object)
- && XSYMBOL (object)->name->data[0] == ':'
+ && SREF (SYMBOL_NAME (object), 0) == ':'
&& SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (object))
return Qt;
return Qnil;
}
DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
- doc: /* Return t if OBJECT is a character or a string. */)
+ doc: /* Return t if OBJECT is a character (an integer) or a string. */)
(object)
register Lisp_Object object;
{
- if (INTEGERP (object) || STRINGP (object))
+ if (CHARACTERP (object) || STRINGP (object))
return Qt;
return Qnil;
}
}
DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
- doc: /* Make SYMBOL's value be void. */)
+ doc: /* Make SYMBOL's value be void.
+Return SYMBOL. */)
(symbol)
register Lisp_Object symbol;
{
}
DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
- doc: /* Make SYMBOL's function definition be void. */)
+ doc: /* Make SYMBOL's function definition be void.
+Return SYMBOL. */)
(symbol)
register Lisp_Object symbol;
{
register Lisp_Object name;
CHECK_SYMBOL (symbol);
- XSETSTRING (name, XSYMBOL (symbol)->name);
+ name = SYMBOL_NAME (symbol);
return name;
}
return definition;
}
-DEFUN ("defalias", Fdefalias, Sdefalias, 2, 2, 0,
+extern Lisp_Object Qfunction_documentation;
+
+DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0,
doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.
-Associates the function with the current load file, if any. */)
- (symbol, definition)
- register Lisp_Object symbol, definition;
-{
+Associates the function with the current load file, if any.
+The optional third argument DOCSTRING specifies the documentation string
+for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string
+determined by DEFINITION. */)
+ (symbol, definition, docstring)
+ register Lisp_Object symbol, definition, docstring;
+{
+ if (CONSP (XSYMBOL (symbol)->function)
+ && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
+ LOADHIST_ATTACH (Fcons (Qt, symbol));
definition = Ffset (symbol, definition);
LOADHIST_ATTACH (symbol);
+ if (!NILP (docstring))
+ Fput (symbol, Qfunction_documentation, docstring);
return definition;
}
hare = XSYMBOL (hare)->value;
if (!XSYMBOL (hare)->indirect_variable)
break;
-
+
hare = XSYMBOL (hare)->value;
tortoise = XSYMBOL (tortoise)->value;
*XINTFWD (valcontents)->intvar = XINT (newval);
if (*XINTFWD (valcontents)->intvar != XINT (newval))
error ("Value out of range for variable `%s'",
- XSYMBOL (symbol)->name->data);
+ SDATA (SYMBOL_NAME (symbol)));
break;
case Lisp_Misc_Boolfwd:
Lisp_Object type;
type = PER_BUFFER_TYPE (offset);
- if (XINT (type) == -1)
- error ("Variable %s is read-only", XSYMBOL (symbol)->name->data);
-
if (! NILP (type) && ! NILP (newval)
&& XTYPE (newval) != XINT (type))
buffer_slot_type_mismatch (offset);
Lisp_Object symbol;
{
Lisp_Object valcontents, cdr;
-
+
valcontents = SYMBOL_VALUE (symbol);
if (!BUFFER_LOCAL_VALUEP (valcontents)
&& !SOME_BUFFER_LOCAL_VALUEP (valcontents))
/* Unload the previously loaded binding. */
Fsetcdr (XCAR (cdr),
do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
-
+
/* Select the global binding in the symbol. */
XSETCAR (cdr, cdr);
store_symval_forwarding (symbol, valcontents, XCDR (cdr), NULL);
Lisp_Object symbol, valcontents;
{
register Lisp_Object tem1;
-
+
tem1 = XBUFFER_LOCAL_VALUE (valcontents)->buffer;
if (NILP (tem1)
{
if (XSYMBOL (symbol)->indirect_variable)
symbol = indirect_variable (symbol);
-
+
/* Unload the previously loaded binding. */
tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
Fsetcdr (tem1,
{
register Lisp_Object valcontents;
register Lisp_Object val;
-
+
CHECK_SYMBOL (symbol);
valcontents = SYMBOL_VALUE (symbol);
let_shadows_buffer_binding_p (symbol)
Lisp_Object symbol;
{
- struct specbinding *p;
+ volatile struct specbinding *p;
for (p = specpdl_ptr - 1; p >= specpdl; p--)
if (p->func == NULL
return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
innercontents = valcontents = SYMBOL_VALUE (symbol);
-
+
if (BUFFER_OBJFWDP (valcontents))
{
int offset = XBUFFER_OBJFWD (valcontents)->offset;
and load that binding. */
else
{
- tem1 = Fcons (symbol, Fcdr (current_alist_element));
+ tem1 = Fcons (symbol, XCDR (current_alist_element));
buf->local_var_alist
= Fcons (tem1, buf->local_var_alist);
}
if (idx > 0)
{
struct buffer *b;
-
+
for (b = all_buffers; b; b = b->next)
if (!PER_BUFFER_VALUE_P (b, idx))
PER_BUFFER_VALUE (b, offset) = value;
DEFUN ("setq-default", Fsetq_default, Ssetq_default, 2, UNEVALLED, 0,
doc: /* Set the default value of variable VAR to VALUE.
VAR, the variable name, is literal (not evaluated);
-VALUE is an expression and it is evaluated.
+VALUE is an expression: it is evaluated and its value returned.
The default value of a variable is seen in buffers
that do not have their own values for the variable.
do
{
val = Feval (Fcar (Fcdr (args_left)));
- symbol = Fcar (args_left);
+ symbol = XCAR (args_left);
Fset_default (symbol, val);
- args_left = Fcdr (Fcdr (args_left));
+ args_left = Fcdr (XCDR (args_left));
}
while (!NILP (args_left));
in which case the default value is in effect.
Note that binding the variable with `let', or setting it while
a `let'-style binding made in this buffer is in effect,
-does not make the variable buffer-local.
+does not make the variable buffer-local. Return VARIABLE.
The function `default-value' gets the default value and `set-default' sets it. */)
(variable)
valcontents = SYMBOL_VALUE (variable);
if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents))
- error ("Symbol %s may not be buffer-local", XSYMBOL (variable)->name->data);
+ error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents))
return variable;
Other buffers will continue to share a common default value.
\(The buffer-local value of VARIABLE starts out as the same value
VARIABLE previously had. If VARIABLE was void, it remains void.\)
-See also `make-variable-buffer-local'.
+See also `make-variable-buffer-local'. Return VARIABLE.
If the variable is already arranged to become local when set,
this function causes a local value to exist for this buffer,
valcontents = SYMBOL_VALUE (variable);
if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents))
- error ("Symbol %s may not be buffer-local", XSYMBOL (variable)->name->data);
+ error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents))
{
DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable,
1, 1, "vKill Local Variable: ",
doc: /* Make VARIABLE no longer have a separate value in the current buffer.
-From now on the default value will apply in this buffer. */)
+From now on the default value will apply in this buffer. Return VARIABLE. */)
(variable)
register Lisp_Object variable;
{
loaded, recompute its value. We have to do it now, or else
forwarded objects won't work right. */
{
- Lisp_Object *pvalbuf;
+ Lisp_Object *pvalbuf, buf;
valcontents = SYMBOL_VALUE (variable);
pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
- if (current_buffer == XBUFFER (*pvalbuf))
+ XSETBUFFER (buf, current_buffer);
+ if (EQ (buf, *pvalbuf))
{
*pvalbuf = Qnil;
XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
doc: /* Enable VARIABLE to have frame-local bindings.
When a frame-local binding exists in the current frame,
it is in effect whenever the current buffer has no buffer-local binding.
-A frame-local binding is actual a frame parameter value;
-thus, any given frame has a local binding for VARIABLE
-if it has a value for the frame parameter named VARIABLE.
-See `modify-frame-parameters'. */)
+A frame-local binding is actually a frame parameter value;
+thus, any given frame has a local binding for VARIABLE if it has
+a value for the frame parameter named VARIABLE. Return VARIABLE.
+See `modify-frame-parameters' for how to set frame parameters. */)
(variable)
register Lisp_Object variable;
{
valcontents = SYMBOL_VALUE (variable);
if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)
|| BUFFER_OBJFWDP (valcontents))
- error ("Symbol %s may not be frame-local", XSYMBOL (variable)->name->data);
+ error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
if (BUFFER_LOCAL_VALUEP (valcontents)
|| SOME_BUFFER_LOCAL_VALUEP (valcontents))
{
int c, idxval_byte;
- if (idxval < 0 || idxval >= XSTRING (array)->size)
+ if (idxval < 0 || idxval >= SCHARS (array))
args_out_of_range (array, idx);
if (! STRING_MULTIBYTE (array))
- return make_number ((unsigned char) XSTRING (array)->data[idxval]);
+ return make_number ((unsigned char) SREF (array, idxval));
idxval_byte = string_char_to_byte (array, idxval);
- c = STRING_CHAR (&XSTRING (array)->data[idxval_byte],
- STRING_BYTES (XSTRING (array)) - idxval_byte);
+ c = STRING_CHAR (SDATA (array) + idxval_byte,
+ SBYTES (array) - idxval_byte);
return make_number (c);
}
else if (BOOL_VECTOR_P (array))
}
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)
- {
- /* For ASCII and 8-bit European characters, the element is
- stored in the top table. */
- val = XCHAR_TABLE (array)->contents[idxval];
- 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;
-
- 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:
- 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;
- else
- {
- if (NILP (val))
- val = XCHAR_TABLE (sub_table)->defalt;
- if (NILP (val))
- {
- array = XCHAR_TABLE (array)->parent;
- if (!NILP (array))
- goto try_parent_char_table;
- }
- return val;
- }
- }
- /* Here, VAL is a sub char table. We try the default value
- and parent. */
- val = XCHAR_TABLE (val)->defalt;
- 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
{
DEFUN ("aset", Faset, Saset, 3, 3, 0,
doc: /* Store into the element of ARRAY at index IDX the value NEWELT.
-ARRAY may be a vector, a string, a char-table or a bool-vector.
-IDX starts at 0. */)
+Return NEWELT. ARRAY may be a vector, a string, a char-table or a
+bool-vector. IDX starts at 0. */)
(array, idx, newelt)
register Lisp_Object array;
Lisp_Object idx, newelt;
}
else if (CHAR_TABLE_P (array))
{
- if (idxval < 0)
- args_out_of_range (array, idx);
- if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
- 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
- default value VAL or XCHAR_TABLE (array)->defalt
- and look into it. */
-
- temp = make_sub_char_table (NILP (val)
- ? XCHAR_TABLE (array)->defalt
- : 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))
{
- int idxval_byte, prev_bytes, new_bytes;
+ int idxval_byte, prev_bytes, new_bytes, nbytes;
unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
- if (idxval < 0 || idxval >= XSTRING (array)->size)
+ if (idxval < 0 || idxval >= SCHARS (array))
args_out_of_range (array, idx);
CHECK_NUMBER (newelt);
+ nbytes = SBYTES (array);
+
idxval_byte = string_char_to_byte (array, idxval);
- p1 = &XSTRING (array)->data[idxval_byte];
+ p1 = SDATA (array) + idxval_byte;
PARSE_MULTIBYTE_SEQ (p1, nbytes - idxval_byte, prev_bytes);
new_bytes = CHAR_STRING (XINT (newelt), p0);
if (prev_bytes != new_bytes)
{
/* We must relocate the string data. */
- int nchars = XSTRING (array)->size;
- int nbytes = STRING_BYTES (XSTRING (array));
+ int nchars = SCHARS (array);
unsigned char *str;
str = (nbytes <= MAX_ALLOCA
? (unsigned char *) alloca (nbytes)
: (unsigned char *) xmalloc (nbytes));
- bcopy (XSTRING (array)->data, str, nbytes);
+ bcopy (SDATA (array), str, nbytes);
allocate_string_data (XSTRING (array), nchars,
nbytes + new_bytes - prev_bytes);
- bcopy (str, XSTRING (array)->data, idxval_byte);
- p1 = XSTRING (array)->data + idxval_byte;
+ bcopy (str, SDATA (array), idxval_byte);
+ p1 = SDATA (array) + idxval_byte;
bcopy (str + idxval_byte + prev_bytes, p1 + new_bytes,
nbytes - (idxval_byte + prev_bytes));
if (nbytes > MAX_ALLOCA)
}
else
{
- if (idxval < 0 || idxval >= XSTRING (array)->size)
+ if (idxval < 0 || idxval >= SCHARS (array))
args_out_of_range (array, idx);
CHECK_NUMBER (newelt);
- if (XINT (newelt) < 0 || SINGLE_BYTE_CHAR_P (XINT (newelt)))
+ if (XINT (newelt) < 0 || ASCII_CHAR_P (XINT (newelt)))
- XSTRING (array)->data[idxval] = 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 = XSTRING (array)->data, *str;
+ unsigned char *origstr = SDATA (array), *str;
int nchars, nbytes;
- nchars = XSTRING (array)->size;
+ nchars = SCHARS (array);
nbytes = idxval_byte = count_size_as_multibyte (origstr, idxval);
nbytes += count_size_as_multibyte (origstr + idxval,
nchars - idxval);
str = (nbytes <= MAX_ALLOCA
? (unsigned char *) alloca (nbytes)
: (unsigned char *) xmalloc (nbytes));
- copy_text (XSTRING (array)->data, str, nchars, 0, 1);
+ 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, XSTRING (array)->data, idxval_byte);
- p1 = XSTRING (array)->data + idxval_byte;
+ bcopy (str, SDATA (array), idxval_byte);
+ p1 = SDATA (array) + idxval_byte;
while (new_bytes--)
*p1++ = *p0++;
bcopy (str + idxval_byte + prev_bytes, p1,
long_to_cons (i)
unsigned long i;
{
- unsigned int top = i >> 16;
+ unsigned long top = i >> 16;
unsigned int bot = i & 0xFFFF;
if (top == 0)
return make_number (bot);
}
\f
DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0,
- doc: /* Convert NUMBER to a string by printing it in decimal.
+ doc: /* Return the decimal representation of NUMBER as a string.
Uses a minus sign if negative.
NUMBER may be an integer or a floating point number. */)
(number)
return -1;
else
return digit;
-}
+}
DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0,
- doc: /* Convert STRING to a number by parsing it as a decimal number.
+ doc: /* Parse STRING as a decimal number and return the number.
This parses both integers and floating point numbers.
It ignores leading spaces and tabs.
/* Skip any whitespace at the front of the number. Some versions of
atoi do this anyway, so we might as well make Emacs lisp consistent. */
- p = XSTRING (string)->data;
+ p = SDATA (string);
while (*p == ' ' || *p == '\t')
p++;
}
else if (*p == '+')
p++;
-
+
if (isfloat_string (p) && b == 10)
val = make_float (sign * atof (p));
else
}
DEFUN ("-", Fminus, Sminus, 0, MANY, 0,
- doc: /* Negate number or subtract numbers or markers.
+ doc: /* Negate number or subtract numbers or markers and return the result.
With one arg, negates it. With more than one arg,
subtracts all but the first from the first.
usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */)
DEFUN ("lsh", Flsh, Slsh, 2, 2, 0,
doc: /* Return VALUE with its bits shifted left by COUNT.
If COUNT is negative, shifting is actually to the right.
-In this case, zeros are shifted in on the left. */)
+In this case, zeros are shifted in on the left. */)
(value, count)
register Lisp_Object value, count;
{
DEFVAR_LISP ("most-positive-fixnum", &Vmost_positive_fixnum,
doc: /* The largest value that is representable in a Lisp integer. */);
Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM);
-
+
DEFVAR_LISP ("most-negative-fixnum", &Vmost_negative_fixnum,
doc: /* The smallest value that is representable in a Lisp integer. */);
Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
#include "lisp.h"
#include "buffer.h"
#include "commands.h"
+ #include "character.h"
#include "charset.h"
#include "coding.h"
#include "regex.h"
return Qnil;
}
-/* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
+/* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
When ATTRS is zero, return a list of directory filenames; when
non-zero, return a list of directory filenames and their attributes. */
Lisp_Object list, dirfilename, encoded_directory;
struct re_pattern_buffer *bufp = NULL;
int needsep = 0;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
DIRENTRY *dp;
int retry_p;
Ffuncall, and cause a GC. */
list = encoded_directory = dirfilename = Qnil;
GCPRO5 (match, directory, list, dirfilename, encoded_directory);
- directory = Fexpand_file_name (directory, Qnil);
dirfilename = Fdirectory_file_name (directory);
if (!NILP (match))
have to make sure it gets closed, and setting up an
unwind_protect to do so would be a pain. */
retry:
-
- d = opendir (XSTRING (dirfilename)->data);
+
+ d = opendir (SDATA (dirfilename));
if (d == NULL)
report_file_error ("Opening directory", Fcons (directory, Qnil));
Fcons (make_number (((unsigned long) d) >> 16),
make_number (((unsigned long) d) & 0xffff)));
- directory_nbytes = STRING_BYTES (XSTRING (directory));
+ directory_nbytes = SBYTES (directory);
re_match_object = Qt;
/* Decide whether we need to add a directory separator. */
#ifndef VMS
if (directory_nbytes == 0
- || !IS_ANY_SEP (XSTRING (directory)->data[directory_nbytes - 1]))
+ || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
needsep = 1;
#endif /* not VMS */
if (dp == NULL && errno == EAGAIN)
continue;
#endif
-
+
if (dp == NULL)
break;
len = NAMLEN (dp);
name = finalname = make_unibyte_string (dp->d_name, len);
GCPRO2 (finalname, name);
-
+
/* Note: ENCODE_FILE can GC; it should protect its argument,
though. */
name = DECODE_FILE (name);
- len = STRING_BYTES (XSTRING (name));
+ len = SBYTES (name);
/* Now that we have unwind_protect in place, we might as well
allow matching to be interrupted. */
QUIT;
if (NILP (match)
- || (0 <= re_search (bufp, XSTRING (name)->data, len, 0, len, 0)))
+ || (0 <= re_search (bufp, SDATA (name), len, 0, len, 0)))
wanted = 1;
immediate_quit = 0;
int nchars;
fullname = make_uninit_multibyte_string (nbytes, nbytes);
- bcopy (XSTRING (directory)->data, XSTRING (fullname)->data,
+ bcopy (SDATA (directory), SDATA (fullname),
directory_nbytes);
-
+
if (needsep)
- XSTRING (fullname)->data[directory_nbytes] = DIRECTORY_SEP;
-
- bcopy (XSTRING (name)->data,
- XSTRING (fullname)->data + directory_nbytes + needsep,
+ SSET (fullname, directory_nbytes, DIRECTORY_SEP);
+
+ bcopy (SDATA (name),
+ SDATA (fullname) + directory_nbytes + needsep,
len);
-
- nchars = chars_in_text (XSTRING (fullname)->data, nbytes);
+
+ nchars = chars_in_text (SDATA (fullname), nbytes);
/* Some bug somewhere. */
if (nchars > nbytes)
abort ();
-
- XSTRING (fullname)->size = nchars;
+
+ STRING_SET_CHARS (fullname, nchars);
if (nchars == nbytes)
- SET_STRING_BYTES (XSTRING (fullname), -1);
-
+ STRING_SET_UNIBYTE (fullname);
+
finalname = fullname;
}
else
if (NILP (nosort))
list = Fsort (Fnreverse (list),
attrs ? Qfile_attributes_lessp : Qstring_lessp);
-
+
RETURN_UNGCPRO (list);
}
Lisp_Object directory, full, match, nosort;
{
Lisp_Object handler;
+ directory = Fexpand_file_name (directory, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
Lisp_Object directory, full, match, nosort;
{
Lisp_Object handler;
+ directory = Fexpand_file_name (directory, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
struct stat st;
int directoryp;
int passcount;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
elt = Qnil;
for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
{
- d = opendir (XSTRING (Fdirectory_file_name (encoded_dir))->data);
+ int inner_count = SPECPDL_INDEX ();
+
+ d = opendir (SDATA (Fdirectory_file_name (encoded_dir)));
if (!d)
report_file_error ("Opening directory", Fcons (dirname, Qnil));
+ record_unwind_protect (directory_files_internal_unwind,
+ Fcons (make_number (((unsigned long) d) >> 16),
+ make_number (((unsigned long) d) & 0xffff)));
+
/* Loop reading blocks */
/* (att3b compiler bug requires do a null comparison this way) */
while (1)
len = NAMLEN (dp);
- if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
- goto quit;
+ QUIT;
if (! DIRENTRY_NONEMPTY (dp)
- || len < XSTRING (encoded_file)->size
- || 0 <= scmp (dp->d_name, XSTRING (encoded_file)->data,
- XSTRING (encoded_file)->size))
+ || len < SCHARS (encoded_file)
+ || 0 <= scmp (dp->d_name, SDATA (encoded_file),
+ SCHARS (encoded_file)))
continue;
if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
actually in the way in a directory contains only one file. */
if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
continue;
- if (!passcount && len > XSTRING (encoded_file)->size)
+ if (!passcount && len > SCHARS (encoded_file))
/* Ignore directories if they match an element of
completion-ignored-extensions which ends in a slash. */
for (tem = Vcompletion_ignored_extensions;
/* Need to encode ELT, since scmp compares unibyte
strings only. */
elt = ENCODE_FILE (elt);
- elt_len = XSTRING (elt)->size - 1; /* -1 for trailing / */
+ elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
if (elt_len <= 0)
continue;
- p1 = XSTRING (elt)->data;
+ p1 = SDATA (elt);
if (p1[elt_len] != '/')
continue;
skip = len - elt_len;
{
/* Compare extensions-to-be-ignored against end of this file name */
/* if name is not an exact match against specified string */
- if (!passcount && len > XSTRING (encoded_file)->size)
+ if (!passcount && len > SCHARS (encoded_file))
/* and exit this for loop if a match is found */
for (tem = Vcompletion_ignored_extensions;
CONSP (tem); tem = XCDR (tem))
/* Need to encode ELT, since scmp compares unibyte
strings only. */
elt = ENCODE_FILE (elt);
- skip = len - XSTRING (elt)->size;
+ skip = len - SCHARS (elt);
if (skip < 0) continue;
if (0 <= scmp (dp->d_name + skip,
- XSTRING (elt)->data,
- XSTRING (elt)->size))
+ SDATA (elt),
+ SCHARS (elt)))
continue;
break;
}
else
{
bestmatch = name;
- bestmatchsize = XSTRING (name)->size;
+ bestmatchsize = SCHARS (name);
}
}
else
{
compare = min (bestmatchsize, len);
- p1 = XSTRING (bestmatch)->data;
+ p1 = SDATA (bestmatch);
p2 = (unsigned char *) dp->d_name;
matchsize = scmp(p1, p2, compare);
if (matchsize < 0)
/* This tests that the current file is an exact match
but BESTMATCH is not (it is too long). */
if ((matchsize == len
- && matchsize + !!directoryp
- < XSTRING (bestmatch)->size)
+ && matchsize + !!directoryp
+ < SCHARS (bestmatch))
||
/* If there is no exact match ignoring case,
prefer a match that does not change the case
either both or neither are exact. */
(((matchsize == len)
==
- (matchsize + !!directoryp
- == XSTRING (bestmatch)->size))
- && !bcmp (p2, XSTRING (encoded_file)->data, XSTRING (encoded_file)->size)
- && bcmp (p1, XSTRING (encoded_file)->data, XSTRING (encoded_file)->size)))
+ (matchsize + !!directoryp
+ == SCHARS (bestmatch)))
+ && !bcmp (p2, SDATA (encoded_file), SCHARS (encoded_file))
+ && bcmp (p1, SDATA (encoded_file), SCHARS (encoded_file))))
{
bestmatch = make_string (dp->d_name, len);
if (directoryp)
bestmatchsize = matchsize;
}
}
- closedir (d);
+ /* This closes the directory. */
+ bestmatch = unbind_to (inner_count, bestmatch);
}
UNGCPRO;
bestmatch = DECODE_FILE (bestmatch);
return bestmatch;
}
- if (matchcount == 1 && bestmatchsize == XSTRING (file)->size)
+ if (matchcount == 1 && bestmatchsize == SCHARS (file))
return Qt;
bestmatch = Fsubstring (bestmatch, make_number (0),
make_number (bestmatchsize));
decode it from the coding system in use. */
bestmatch = DECODE_FILE (bestmatch);
return bestmatch;
-
- quit:
- if (d) closedir (d);
- Vquit_flag = Qnil;
- return Fsignal (Qquit, Qnil);
}
/* Compare exactly LEN chars of strings at S1 and S2,
struct stat *st_addr;
{
int len = NAMLEN (dp);
- int pos = XSTRING (dirname)->size;
+ int pos = SCHARS (dirname);
int value;
char *fullname = (char *) alloca (len + pos + 2);
#endif /* __DJGPP__ > 1 */
#endif /* MSDOS */
- bcopy (XSTRING (dirname)->data, fullname, pos);
+ bcopy (SDATA (dirname), fullname, pos);
#ifndef VMS
if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
fullname[pos++] = DIRECTORY_SEP;
filename = Fexpand_file_name (filename, Qnil);
fab = cc$rms_fab;
xabfhc = cc$rms_xabfhc;
- fab.fab$l_fna = XSTRING (filename)->data;
+ fab.fab$l_fna = SDATA (filename);
fab.fab$b_fns = strlen (fab.fab$l_fna);
fab.fab$l_xab = (char *) &xabfhc;
status = sys$open (&fab, 0, 0);
encoded = ENCODE_FILE (filename);
- if (lstat (XSTRING (encoded)->data, &s) < 0)
+ if (lstat (SDATA (encoded), &s) < 0)
return Qnil;
switch (s.st_mode & S_IFMT)
/* If the size is out of range for an integer, return a float. */
if (XINT (values[7]) != s.st_size)
values[7] = make_float ((double)s.st_size);
+ /* If the size is negative, and its type is long, convert it back to
+ positive. */
+ if (s.st_size < 0 && sizeof (s.st_size) == sizeof (long))
+ values[7] = make_float ((double) ((unsigned long) s.st_size));
+
filemodestring (&s, modes);
values[8] = make_string (modes, 10);
#if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
dirname = Ffile_name_directory (filename);
if (! NILP (dirname))
encoded = ENCODE_FILE (dirname);
- if (! NILP (dirname) && stat (XSTRING (encoded)->data, &sdir) == 0)
+ if (! NILP (dirname) && stat (SDATA (encoded), &sdir) == 0)
values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
else /* if we can't tell, assume worst */
values[9] = Qt;
#else /* file gid will be egid */
values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
#endif /* BSD4_2 (or BSD4_3) */
- /* Cast -1 to avoid warning if int is not as wide as VALBITS. */
if (FIXNUM_OVERFLOW_P (s.st_ino))
/* To allow inode numbers larger than VALBITS, separate the bottom
16 bits. */
/* Interface definitions for display code.
- Copyright (C) 1985, 1993, 1994, 1997, 1998, 1999, 2000, 2001
+ Copyright (C) 1985, 1993, 1994, 1997, 1998, 1999, 2000, 2001, 2002, 2003
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#define DISPEXTERN_H_INCLUDED
#ifdef HAVE_X_WINDOWS
+
#include <X11/Xlib.h>
#ifdef USE_X_TOOLKIT
#include <X11/Intrinsic.h>
#endif /* USE_X_TOOLKIT */
+
+#else /* !HAVE_X_WINDOWS */
+
+/* X-related stuff used by non-X gui code. */
+
+typedef struct {
+ unsigned long pixel;
+ unsigned short red, green, blue;
+ char flags;
+ char pad;
+} XColor;
+
#endif /* HAVE_X_WINDOWS */
#ifdef MSDOS
#include "msdos.h"
#endif
+#ifdef HAVE_X_WINDOWS
+typedef struct x_display_info Display_Info;
+#define NativeRectangle XRectangle
+#endif
+
#ifdef HAVE_NTGUI
#include "w32gui.h"
+typedef struct w32_display_info Display_Info;
#endif
-#ifdef macintosh
+#ifdef HAVE_CARBON
#include "macgui.h"
+typedef struct mac_display_info Display_Info;
+
+/* Include Carbon.h to define Cursor and Rect. */
+#undef mktime
+#undef DEBUG
+#undef Z
+#undef free
+#undef malloc
+#undef realloc
+/* Macros max and min defined in lisp.h conflict with those in
+ precompiled header Carbon.h. */
+#undef max
+#undef min
+#undef init_process
+#include <Carbon/Carbon.h>
+#undef Z
+#define Z (current_buffer->text->z)
+#undef free
+#define free unexec_free
+#undef malloc
+#define malloc unexec_malloc
+#undef realloc
+#define realloc unexec_realloc
+#undef min
+#define min(a, b) ((a) < (b) ? (a) : (b))
+#undef max
+#define max(a, b) ((a) > (b) ? (a) : (b))
+#undef init_process
+#define init_process emacs_init_process
+
+#endif
+
+
+#ifndef NativeRectangle
+#define NativeRectangle int
#endif
+
/* Structure forward declarations. Some are here because function
prototypes below reference structure types before their definition
in this file. Some are here because not every file including
struct window;
+/* Values returned from coordinates_in_window. */
+
+enum window_part
+{
+ ON_NOTHING,
+ ON_TEXT,
+ ON_MODE_LINE,
+ ON_VERTICAL_BORDER,
+ ON_HEADER_LINE,
+ ON_LEFT_FRINGE,
+ ON_RIGHT_FRINGE,
+ ON_LEFT_MARGIN,
+ ON_RIGHT_MARGIN
+};
+
+
\f
/***********************************************************************
Debugging
#endif /* GLYPH_DEBUG == 0 */
-
+
\f
/***********************************************************************
Text positions
/* Starting with Emacs 20.3, characters from strings and buffers have
both a character and a byte position associated with them. The
following structure holds such a pair of positions. */
-
+
struct text_pos
{
/* Character position. */
#define SET_MARKER_FROM_TEXT_POS(MARKER, POS) \
set_marker_both ((MARKER), Qnil, CHARPOS ((POS)), BYTEPOS ((POS)))
-
+
/* Value is non-zero if character and byte positions of POS1 and POS2
are equal. */
enum glyph_type
{
/* Glyph describes a character. */
- CHAR_GLYPH,
+ CHAR_GLYPH,
/* Glyph describes a composition sequence. */
COMPOSITE_GLYPH,
/* Glyphs.
Be extra careful when changing this structure! Esp. make sure that
- functions producing glyphs, like x_append_glyph, fill ALL of the
+ functions producing glyphs, like append_glyph, fill ALL of the
glyph structure, and that GLYPH_EQUAL_P compares all
display-relevant members of glyphs (not to imply that these are the
only things to check when you add a member). */
int charpos;
/* Lisp object source of this glyph. Currently either a buffer or
- a string, if the glyph was produced from characters which came from
+ a string, if the glyph was produced from characters which came from
a buffer or a string; or 0 if the glyph was inserted by redisplay
for its own purposes such as padding. */
Lisp_Object object;
unsigned glyph_not_available_p : 1;
/* Face of the glyph. */
- unsigned face_id : 22;
+ unsigned face_id : 21;
-#ifdef WINDOWSNT
- /* Type of font used to display the character glyph. Used to
+ /* Type of font used to display the character glyph. May be used to
determine which set of functions to use to obtain font metrics
- for the glyph. Value should be an enumerator of the type
- w32_char_font_type. */
- unsigned w32_font_type : 2;
-#endif
+ for the glyph. On W32, value should be an enumerator of the type
+ w32_char_font_type. Otherwise it equals FONT_TYPE_UNKNOWN. */
+ unsigned font_type : 3;
/* A union of sub-structures for different glyph types. */
union
unsigned ascent : 16;
}
stretch;
-
+
/* Used to compare all bit-fields above in one step. */
unsigned val;
} u;
};
+/* Default value of the glyph font_type field. */
+
+#define FONT_TYPE_UNKNOWN 0
+
/* Is GLYPH a space? */
#define CHAR_GLYPH_SPACE_P(GLYPH) \
(GLYPH_FROM_CHAR_GLYPH ((GLYPH)) == SPACEGLYPH)
/* Are glyphs *X and *Y displayed equal? */
-
+
#define GLYPH_EQUAL_P(X, Y) \
((X)->type == (Y)->type \
&& (X)->u.val == (Y)->u.val \
/* Fill a character glyph GLYPH. CODE, FACE_ID, PADDING_P correspond
to the bits defined for the typedef `GLYPH' in lisp.h. */
-
+
#define SET_CHAR_GLYPH(GLYPH, CODE, FACE_ID, PADDING_P) \
do \
{ \
/* Fill a character type glyph GLYPH from a glyph typedef FROM as
defined in lisp.h. */
-
+
#define SET_CHAR_GLYPH_FROM_GLYPH(GLYPH, FROM) \
SET_CHAR_GLYPH ((GLYPH), \
FAST_GLYPH_CHAR ((FROM)), \
/* Construct a glyph code from a character glyph GLYPH. If the
character is multibyte, return -1 as we can't use glyph table for a
multibyte character. */
-
+
#define GLYPH_FROM_CHAR_GLYPH(GLYPH) \
((GLYPH).u.ch < 256 \
? ((GLYPH).u.ch | ((GLYPH).face_id << CHARACTERBITS)) \
: -1)
/* Is GLYPH a padding glyph? */
-
+
#define CHAR_GLYPH_PADDING_P(GLYPH) (GLYPH).padding_p
int matrix_w, matrix_h;
/* If this structure describes a window matrix of window W,
- window_left_x is the value of W->left, window_top_y the value of
- W->top, window_height and window_width are width and height of W,
- as returned by window_box, and window_vscroll is the value of
- W->vscroll at the time the matrix was last adjusted. Only set
- for window-based redisplay. */
- int window_left_x, window_top_y, window_height, window_width, window_vscroll;
+ window_left_col is the value of W->left_col, window_top_line the
+ value of W->top_line, window_height and window_width are width and
+ height of W, as returned by window_box, and window_vscroll is the
+ value of W->vscroll at the time the matrix was last adjusted.
+ Only set for window-based redisplay. */
+ int window_left_col, window_top_line;
+ int window_height, window_width;
+ int window_vscroll;
/* Number of glyphs reserved for left and right marginal areas when
the matrix was last adjusted. */
Each row is partitioned into three areas. The start and end of
each area is recorded in a pointer as shown below.
-
+
+--------------------+-------------+---------------------+
| left margin area | text area | right margin area |
+--------------------+-------------+---------------------+
glyphs[LEFT_MARGIN_AREA] glyphs[RIGHT_MARGIN_AREA]
| |
glyphs[TEXT_AREA] |
- glyphs[LAST_AREA]
+ glyphs[LAST_AREA]
Rows in frame matrices reference glyph memory allocated in a frame
glyph pool (see the description of struct glyph_pool). Rows in
window matrices on frames having frame matrices reference slices of
the glyphs of corresponding rows in the frame matrix.
-
+
Rows in window matrices on frames having no frame matrices point to
glyphs allocated from the heap via xmalloc;
glyphs[LEFT_MARGIN_AREA] is the start address of the allocated
/* 1 means the overlay arrow is on this line. */
unsigned overlay_arrow_p : 1;
-
+
/* 1 means that this row displays a continued line, i.e. it has a
continuation mark at the right side. */
unsigned continued_p : 1;
of more than one glyph. Some glyphs have been put in this row,
the rest are put in rows below this one. */
unsigned ends_in_middle_of_char_p : 1;
-
+
/* 1 means this line starts in the middle of a character consisting
of more than one glyph. Some glyphs have been put in the
previous row, the rest are put in this row. */
#define MATRIX_ROW(MATRIX, ROW) ((MATRIX)->rows + (ROW))
#endif
-/* Return a pointer to the row reserved for the mode line in MATRIX.
+/* Return a pointer to the row reserved for the mode line in MATRIX.
Row MATRIX->nrows - 1 is always reserved for the mode line. */
#define MATRIX_MODE_LINE_ROW(MATRIX) \
(MATRIX_ROW ((MATRIX), (ROW))->glyphs[TEXT_AREA])
/* Return the number of used glyphs in the text area of a row. */
-
+
#define MATRIX_ROW_USED(MATRIX, ROW) \
(MATRIX_ROW ((MATRIX), (ROW))->used[TEXT_AREA])
/* Return the character/ byte position at which the display of ROW
starts. */
-
+
#define MATRIX_ROW_START_CHARPOS(ROW) ((ROW)->start.pos.charpos)
#define MATRIX_ROW_START_BYTEPOS(ROW) ((ROW)->start.pos.bytepos)
/* Return the character/ byte position at which ROW ends. */
-
+
#define MATRIX_ROW_END_CHARPOS(ROW) ((ROW)->end.pos.charpos)
#define MATRIX_ROW_END_BYTEPOS(ROW) ((ROW)->end.pos.bytepos)
/* Return the vertical position of ROW in MATRIX. */
-
+
#define MATRIX_ROW_VPOS(ROW, MATRIX) ((ROW) - (MATRIX)->rows)
/* Return the last glyph row + 1 in MATRIX on window W reserved for
text. If W has a mode line, the last row in the matrix is reserved
for it. */
-
+
#define MATRIX_BOTTOM_TEXT_ROW(MATRIX, W) \
((MATRIX)->rows \
+ (MATRIX)->nrows \
/* Non-zero if the face of the last glyph in ROW's text area has
to be drawn to the end of the text area. */
-
+
#define MATRIX_ROW_EXTENDS_FACE_P(ROW) ((ROW)->fill_line_p)
/* Set and query the enabled_p flag of glyph row ROW in MATRIX. */
-
+
#define SET_MATRIX_ROW_ENABLED_P(MATRIX, ROW, VALUE) \
(MATRIX_ROW ((MATRIX), (ROW))->enabled_p = (VALUE) != 0)
-
+
#define MATRIX_ROW_ENABLED_P(MATRIX, ROW) \
(MATRIX_ROW ((MATRIX), (ROW))->enabled_p)
/* Non-zero if ROW displays text. Value is non-zero if the row is
blank but displays a line end. */
-
+
#define MATRIX_ROW_DISPLAYS_TEXT_P(ROW) ((ROW)->displays_text_p)
/* Non-zero if ROW is not completely visible in window W. */
-
+
#define MATRIX_ROW_PARTIALLY_VISIBLE_P(ROW) \
((ROW)->height != (ROW)->visible_height)
/* Non-zero if ROW is partially visible at the top of window W. */
-
+
#define MATRIX_ROW_PARTIALLY_VISIBLE_AT_TOP_P(W, ROW) \
(MATRIX_ROW_PARTIALLY_VISIBLE_P ((ROW)) \
- && (ROW)->y < WINDOW_DISPLAY_HEADER_LINE_HEIGHT ((W)))
+ && (ROW)->y < WINDOW_HEADER_LINE_HEIGHT ((W)))
/* Non-zero if ROW is partially visible at the bottom of window W. */
-
+
#define MATRIX_ROW_PARTIALLY_VISIBLE_AT_BOTTOM_P(W, ROW) \
(MATRIX_ROW_PARTIALLY_VISIBLE_P ((ROW)) \
- && (ROW)->y + (ROW)->height > WINDOW_DISPLAY_HEIGHT_NO_MODE_LINE ((W)))
+ && (ROW)->y + (ROW)->height > WINDOW_BOX_HEIGHT_NO_MODE_LINE ((W)))
/* Return the bottom Y + 1 of ROW. */
-
+
#define MATRIX_ROW_BOTTOM_Y(ROW) ((ROW)->y + (ROW)->height)
/* Is ROW the last visible one in the display described by the
iterator structure pointed to by IT?. */
-
+
#define MATRIX_ROW_LAST_VISIBLE_P(ROW, IT) \
(MATRIX_ROW_BOTTOM_Y ((ROW)) >= (IT)->last_visible_y)
((ROW)->end.overlay_string_index >= 0)
/* Non-zero if ROW starts in the middle of a character. See above. */
-
+
#define MATRIX_ROW_STARTS_IN_MIDDLE_OF_CHAR_P(ROW) \
((ROW)->start.dpvec_index >= 0 \
|| (ROW)->starts_in_middle_of_char_p \
extern struct glyph_row scratch_glyph_row;
+\f
+/************************************************************************
+ Glyph Strings
+ ************************************************************************/
+
+/* Enumeration for overriding/changing the face to use for drawing
+ glyphs in draw_glyphs. */
+
+enum draw_glyphs_face
+{
+ DRAW_NORMAL_TEXT,
+ DRAW_INVERSE_VIDEO,
+ DRAW_CURSOR,
+ DRAW_MOUSE_FACE,
+ DRAW_IMAGE_RAISED,
+ DRAW_IMAGE_SUNKEN
+};
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* A sequence of glyphs to be drawn in the same face. */
+
+struct glyph_string
+{
+ /* X-origin of the string. */
+ int x;
+
+ /* Y-origin and y-position of the base line of this string. */
+ int y, ybase;
+
+ /* The width of the string, not including a face extension. */
+ int width;
+
+ /* The width of the string, including a face extension. */
+ int background_width;
+
+ /* The height of this string. This is the height of the line this
+ string is drawn in, and can be different from the height of the
+ font the string is drawn in. */
+ int height;
+
+ /* Number of pixels this string overwrites in front of its x-origin.
+ This number is zero if the string has an lbearing >= 0; it is
+ -lbearing, if the string has an lbearing < 0. */
+ int left_overhang;
+
+ /* Number of pixels this string overwrites past its right-most
+ nominal x-position, i.e. x + width. Zero if the string's
+ rbearing is <= its nominal width, rbearing - width otherwise. */
+ int right_overhang;
+
+ /* The frame on which the glyph string is drawn. */
+ struct frame *f;
+
+ /* The window on which the glyph string is drawn. */
+ struct window *w;
+
+ /* X display and window for convenience. */
+ Display *display;
+ Window window;
+
+ /* The glyph row for which this string was built. It determines the
+ y-origin and height of the string. */
+ struct glyph_row *row;
+
+ /* The area within row. */
+ enum glyph_row_area area;
+
+ /* Characters to be drawn, and number of characters. */
+ XChar2b *char2b;
+ int nchars;
+
+ /* A face-override for drawing cursors, mouse face and similar. */
+ enum draw_glyphs_face hl;
+
+ /* Face in which this string is to be drawn. */
+ struct face *face;
+
+ /* Font in which this string is to be drawn. */
+ XFontStruct *font;
+
+ /* Font info for this string. */
+ struct font_info *font_info;
+
+ /* Non-null means this string describes (part of) a composition.
+ All characters from char2b are drawn composed. */
+ struct composition *cmp;
+
+ /* Index of this glyph string's first character in the glyph
+ definition of CMP. If this is zero, this glyph string describes
+ the first character of a composition. */
+ int gidx;
+
+ /* 1 means this glyph strings face has to be drawn to the right end
+ of the window's drawing area. */
+ unsigned extends_to_end_of_line_p : 1;
+
+ /* 1 means the background of this string has been drawn. */
+ unsigned background_filled_p : 1;
+
+ /* 1 means glyph string must be drawn with 16-bit functions. */
+ unsigned two_byte_p : 1;
+
+ /* 1 means that the original font determined for drawing this glyph
+ string could not be loaded. The member `font' has been set to
+ the frame's default font in this case. */
+ unsigned font_not_found_p : 1;
+
+ /* 1 means that the face in which this glyph string is drawn has a
+ stipple pattern. */
+ unsigned stippled_p : 1;
+
+ /* 1 means only the foreground of this glyph string must be drawn,
+ and we should use the physical height of the line this glyph
+ string appears in as clip rect. */
+ unsigned for_overlaps_p : 1;
+
+ /* The GC to use for drawing this glyph string. */
+#if defined(HAVE_X_WINDOWS) || defined(HAVE_CARBON)
+ GC gc;
+#endif
+#if defined(HAVE_NTGUI)
+ XGCValues *gc;
+ HDC hdc;
+#endif
+
+ /* A pointer to the first glyph in the string. This glyph
+ corresponds to char2b[0]. Needed to draw rectangles if
+ font_not_found_p is 1. */
+ struct glyph *first_glyph;
+
+ /* Image, if any. */
+ struct image *img;
+
+ struct glyph_string *next, *prev;
+};
+
+#endif /* HAVE_WINDOW_SYSTEM */
+
\f
/************************************************************************
Display Dimensions
selected_window, this macro needs three arguments: SELW which is
compared against the current value of selected_window, MBW which is
compared against minibuf_window (if SELW doesn't match), and SCRW
- which is compared against Vminibuf_selected_window (if MBW matches). */
+ which is compared against minibuf_selected_window (if MBW matches). */
#define CURRENT_MODE_LINE_FACE_ID_3(SELW, MBW, SCRW) \
((!mode_line_in_non_selected_windows \
|| (SELW) == XWINDOW (selected_window) \
|| (minibuf_level > 0 \
- && !NILP (Vminibuf_selected_window) \
+ && !NILP (minibuf_selected_window) \
&& (MBW) == XWINDOW (minibuf_window) \
- && (SCRW) == XWINDOW (Vminibuf_selected_window))) \
+ && (SCRW) == XWINDOW (minibuf_selected_window))) \
? MODE_LINE_FACE_ID \
: MODE_LINE_INACTIVE_FACE_ID)
#define DESIRED_HEADER_LINE_HEIGHT(W) \
MATRIX_HEADER_LINE_HEIGHT ((W)->desired_matrix)
-/* Like FRAME_INTERNAL_BORDER_WIDTH but checks whether frame F is a
- window-system frame. */
-
-#define FRAME_INTERNAL_BORDER_WIDTH_SAFE(F) \
- (FRAME_WINDOW_P (F) ? FRAME_INTERNAL_BORDER_WIDTH (F) : 0)
-
-/* Width of display region of window W. For terminal frames, this
- equals the width of W since there are no vertical scroll bars. For
- window system frames, the value has to be corrected by the pixel
- width of vertical scroll bars, and fringes. */
-
-#define WINDOW_DISPLAY_PIXEL_WIDTH(W) \
- (((XFASTINT ((W)->width) \
- - FRAME_SCROLL_BAR_WIDTH (XFRAME (WINDOW_FRAME ((W)))) \
- - FRAME_FRINGE_COLS (XFRAME (WINDOW_FRAME ((W))))) \
- * CANON_X_UNIT (XFRAME (WINDOW_FRAME ((W))))))
-
-/* Height of the display region of W, including a mode line, if any. */
-
-#define WINDOW_DISPLAY_PIXEL_HEIGHT(W) \
- (XFASTINT ((W)->height) \
- * CANON_Y_UNIT (XFRAME (WINDOW_FRAME ((W)))))
-
-/* Height in pixels of the mode line. May be zero if W doesn't have a
- mode line. */
-
-#define WINDOW_DISPLAY_MODE_LINE_HEIGHT(W) \
- (WINDOW_WANTS_MODELINE_P ((W)) \
- ? CURRENT_MODE_LINE_HEIGHT (W) \
- : 0)
-
-/* Height in pixels of the header line. Zero if W doesn't have a header
- line. */
-
-#define WINDOW_DISPLAY_HEADER_LINE_HEIGHT(W) \
- (WINDOW_WANTS_HEADER_LINE_P ((W)) \
- ? CURRENT_HEADER_LINE_HEIGHT (W) \
- : 0)
-
-/* Pixel height of window W without mode line. */
-
-#define WINDOW_DISPLAY_HEIGHT_NO_MODE_LINE(W) \
- (WINDOW_DISPLAY_PIXEL_HEIGHT ((W)) \
- - WINDOW_DISPLAY_MODE_LINE_HEIGHT ((W)))
-
-/* Pixel height of window W without mode and header line. */
-
-#define WINDOW_DISPLAY_TEXT_HEIGHT(W) \
- (WINDOW_DISPLAY_PIXEL_HEIGHT ((W)) \
- - WINDOW_DISPLAY_MODE_LINE_HEIGHT ((W)) \
- - WINDOW_DISPLAY_HEADER_LINE_HEIGHT ((W)))
-
-/* Left edge of W in pixels relative to its frame. */
-
-#define WINDOW_DISPLAY_LEFT_EDGE_PIXEL_X(W) \
- (FRAME_INTERNAL_BORDER_WIDTH_SAFE (XFRAME (WINDOW_FRAME ((W)))) \
- + (WINDOW_LEFT_MARGIN ((W)) \
- * CANON_X_UNIT (XFRAME (WINDOW_FRAME ((W))))) \
- + FRAME_LEFT_FRINGE_WIDTH (XFRAME (WINDOW_FRAME ((W)))))
-
-/* Right edge of window W in pixels, relative to its frame. */
-
-#define WINDOW_DISPLAY_RIGHT_EDGE_PIXEL_X(W) \
- (WINDOW_DISPLAY_LEFT_EDGE_PIXEL_X ((W)) \
- + WINDOW_DISPLAY_PIXEL_WIDTH ((W)))
-
-/* Top edge of W in pixels relative to its frame. */
-
-#define WINDOW_DISPLAY_TOP_EDGE_PIXEL_Y(W) \
- (FRAME_INTERNAL_BORDER_WIDTH_SAFE (XFRAME (WINDOW_FRAME ((W)))) \
- + (XFASTINT ((W)->top) \
- * CANON_Y_UNIT (XFRAME (WINDOW_FRAME ((W))))))
-
-/* Bottom edge of window W relative to its frame. */
-
-#define WINDOW_DISPLAY_BOTTOM_EDGE_PIXEL_Y(W) \
- (WINDOW_DISPLAY_TOP_EDGE_PIXEL_Y ((W)) \
- + WINDOW_DISPLAY_PIXEL_HEIGHT ((W)))
-
-/* Convert window W relative pixel X to frame pixel coordinates. */
-
-#define WINDOW_TO_FRAME_PIXEL_X(W, X) \
- ((X) + WINDOW_DISPLAY_LEFT_EDGE_PIXEL_X ((W)))
-
-/* Convert window W relative pixel Y to frame pixel coordinates. */
-
-#define WINDOW_TO_FRAME_PIXEL_Y(W, Y) \
- ((Y) + WINDOW_DISPLAY_TOP_EDGE_PIXEL_Y ((W)))
-
-/* Convert frame relative pixel X to window relative pixel X. */
-
-#define FRAME_TO_WINDOW_PIXEL_X(W, X) \
- ((X) - WINDOW_DISPLAY_LEFT_EDGE_PIXEL_X ((W)))
-
-/* Convert frame relative pixel Y to window relative pixel Y. */
-
-#define FRAME_TO_WINDOW_PIXEL_Y(W, Y) \
- ((Y) - WINDOW_DISPLAY_TOP_EDGE_PIXEL_Y ((W)))
-
-/* Width of left margin area in pixels. */
-
-#define WINDOW_DISPLAY_LEFT_AREA_PIXEL_WIDTH(W) \
- (NILP ((W)->left_margin_width) \
- ? 0 \
- : (XINT ((W)->left_margin_width) \
- * CANON_X_UNIT (XFRAME (WINDOW_FRAME ((W))))))
-
-/* Width of right marginal area in pixels. */
-
-#define WINDOW_DISPLAY_RIGHT_AREA_PIXEL_WIDTH(W) \
- (NILP ((W)->right_margin_width) \
- ? 0 \
- : (XINT ((W)->right_margin_width) \
- * CANON_X_UNIT (XFRAME (WINDOW_FRAME ((W))))))
-
-/* Width of text area in pixels. */
-
-#define WINDOW_DISPLAY_TEXT_AREA_PIXEL_WIDTH(W) \
- (WINDOW_DISPLAY_PIXEL_WIDTH ((W)) \
- - WINDOW_DISPLAY_LEFT_AREA_PIXEL_WIDTH ((W)) \
- - WINDOW_DISPLAY_RIGHT_AREA_PIXEL_WIDTH ((W)))
-
-/* Convert a text area relative x-position in window W to frame X
- pixel coordinates. */
-
-#define WINDOW_TEXT_TO_FRAME_PIXEL_X(W, X) \
- (WINDOW_TO_FRAME_PIXEL_X ((W), (X)) \
- + WINDOW_DISPLAY_LEFT_AREA_PIXEL_WIDTH ((W)))
-
-/* Translate an x-position relative to AREA in window W to frame pixel
- coordinates. */
-
-#define WINDOW_AREA_TO_FRAME_PIXEL_X(W, AREA, X) \
- (WINDOW_TO_FRAME_PIXEL_X ((W), (X)) \
- + (((AREA) > LEFT_MARGIN_AREA) \
- ? WINDOW_DISPLAY_LEFT_AREA_PIXEL_WIDTH ((W)) \
- : 0) \
- + (((AREA) > TEXT_AREA) \
- ? WINDOW_DISPLAY_TEXT_AREA_PIXEL_WIDTH ((W)) \
- : 0))
-
-/* Return the pixel width of AREA in W. */
-
-#define WINDOW_AREA_PIXEL_WIDTH(W, AREA) \
- (((AREA) == TEXT_AREA) \
- ? WINDOW_DISPLAY_TEXT_AREA_PIXEL_WIDTH ((W)) \
- : (((AREA) == LEFT_MARGIN_AREA) \
- ? WINDOW_DISPLAY_LEFT_AREA_PIXEL_WIDTH ((W)) \
- : WINDOW_DISPLAY_RIGHT_AREA_PIXEL_WIDTH ((W))))
-
/* Value is non-zero if window W wants a mode line. */
#define WINDOW_WANTS_MODELINE_P(W) \
&& FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \
&& BUFFERP ((W)->buffer) \
&& !NILP (XBUFFER ((W)->buffer)->mode_line_format) \
- && XFASTINT ((W)->height) > 1)
+ && WINDOW_TOTAL_LINES (W) > 1)
/* Value is non-zero if window W wants a header line. */
&& FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \
&& BUFFERP ((W)->buffer) \
&& !NILP (XBUFFER ((W)->buffer)->header_line_format) \
- && XFASTINT ((W)->height) > 1 + !NILP (XBUFFER ((W)->buffer)->mode_line_format))
+ && WINDOW_TOTAL_LINES (W) > 1 + !NILP (XBUFFER ((W)->buffer)->mode_line_format))
+
+
+/* Return proper value to be used as baseline offset of font that has
+ ASCENT and DESCENT to draw characters by the font at the vertical
+ center of the line of frame F.
+
+ Here, our task is to find the value of BOFF in the following figure;
+
+ -------------------------+-----------+-
+ -+-+---------+-+ | |
+ | | | | | |
+ | | | | F_ASCENT F_HEIGHT
+ | | | ASCENT | |
+ HEIGHT | | | | |
+ | | |-|-+------+-----------|------- baseline
+ | | | | BOFF | |
+ | |---------|-+-+ | |
+ | | | DESCENT | |
+ -+-+---------+-+ F_DESCENT |
+ -------------------------+-----------+-
+
+ -BOFF + DESCENT + (F_HEIGHT - HEIGHT) / 2 = F_DESCENT
+ BOFF = DESCENT + (F_HEIGHT - HEIGHT) / 2 - F_DESCENT
+ DESCENT = FONT->descent
+ HEIGHT = FONT_HEIGHT (FONT)
+ F_DESCENT = (FRAME_FONT (F)->descent
+ - F->output_data.x->baseline_offset)
+ F_HEIGHT = FRAME_LINE_HEIGHT (F)
+*/
+
+#define VCENTER_BASELINE_OFFSET(FONT, F) \
+ (FONT_DESCENT (FONT) \
+ + (FRAME_LINE_HEIGHT ((F)) - FONT_HEIGHT ((FONT)) \
+ + (FRAME_LINE_HEIGHT ((F)) > FONT_HEIGHT ((FONT)))) / 2 \
+ - (FONT_DESCENT (FRAME_FONT (F)) - FRAME_BASELINE_OFFSET (F)))
-\f
+\f
/***********************************************************************
Faces
***********************************************************************/
-
+
/* Indices of face attributes in Lisp face vectors. Slot zero is the
symbol `face'. */
LFACE_FONT_INDEX,
LFACE_INHERIT_INDEX,
LFACE_AVGWIDTH_INDEX,
+ LFACE_FONTSET_INDEX,
LFACE_VECTOR_SIZE
};
int id;
#ifdef HAVE_WINDOW_SYSTEM
-
+
/* If non-zero, this is a GC that we can use without modification for
drawing the characters in this face. */
GC gc;
-
+
/* Font used for this face, or null if the font could not be loaded
for some reason. This points to a `font' slot of a struct
font_info, and we should not call XFreeFont on it because the
/* Pixel value of foreground color for X frames. Color index
for tty frames. */
unsigned long foreground;
-
+
/* Pixel value or color index of background color. */
unsigned long background;
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. */
+ /* 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. */
unsigned int pixmap_w, pixmap_h;
-
+
/* Non-zero means characters in this face have a box that thickness
around them. If it is negative, the absolute value indicates the
thickness, and the horizontal lines of box (top and bottom) are
/* 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;
/* 1 means that either no color is specified for underlining or that
the specified color couldn't be loaded. Use the foreground
color when drawing in that case. */
- unsigned underline_defaulted_p : 1;
+ unsigned underline_defaulted_p : 1;
/* 1 means that either no color is specified for the corresponding
attribute or that the specified color couldn't be loaded.
realize_x_face). */
unsigned colors_copied_bitwise_p : 1;
+ /* If non-zero, use overstrike (to simulate bold-face). */
+ unsigned overstrike : 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;
};
{
/* Hash table of cached realized faces. */
struct face **buckets;
-
+
/* Back-pointer to the frame this cache belongs to. */
struct frame *f;
/* 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) \
++ (ASCII_CHAR_P (CHAR) \
? (FACE) == (FACE)->ascii_face \
: face_suitable_for_char_p ((FACE), (CHAR)))
/* Return the id of the realized face on frame F that is like the face
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) \
- (ASCII_CHAR_P (CHAR) \
++ (ASCII_CHAR_P (CHAR) \
? (FACE)->ascii_face->id \
: face_for_char ((F), (FACE), (CHAR)))
+\f
+/***********************************************************************
+ Fringes
+ ***********************************************************************/
+
+enum fringe_bitmap_type
+{
+ NO_FRINGE_BITMAP = 0,
+ LEFT_TRUNCATION_BITMAP,
+ RIGHT_TRUNCATION_BITMAP,
+ CONTINUED_LINE_BITMAP,
+ CONTINUATION_LINE_BITMAP,
+ OVERLAY_ARROW_BITMAP,
+ ZV_LINE_BITMAP,
+ MAX_FRINGE_BITMAPS
+};
+
+struct fringe_bitmap
+{
+ int width;
+ int height;
+ int period;
+ unsigned char *bits;
+};
+
+/* Structure used to describe where and how to draw a fringe bitmap.
+ WHICH is the fringe bitmap to draw. WD and H is the (adjusted)
+ width and height of the bitmap, DH is the height adjustment (if
+ bitmap is periodic). X and Y are frame coordinates of the area to
+ display the bitmap, DY is relative offset of the bitmap into that
+ area. BX, NX, BY, NY specifies the area to clear if the bitmap
+ does not fill the entire area. FACE is the fringe face. */
+
+struct draw_fringe_bitmap_params
+{
+ enum fringe_bitmap_type which;
+ int wd, h, dh;
+ int x, y;
+ int bx, nx, by, ny;
+ struct face *face;
+};
+
+extern struct fringe_bitmap fringe_bitmaps[MAX_FRINGE_BITMAPS];
+
\f
/***********************************************************************
Display Iterator
enum prop_idx
{
+ AUTO_COMPOSED_PROP_IDX,
FONTIFIED_PROP_IDX,
FACE_PROP_IDX,
INVISIBLE_PROP_IDX,
/* Stack pointer. */
int sp;
-
+
/* Setting of buffer-local variable selective-display-ellipsis. */
unsigned selective_display_ellipsis_p : 1;
/* Non-null means that the current character is the first in a run
of characters with box face. */
unsigned start_of_box_run_p : 1;
-
+
/* Non-zero means that the current character is the last in a run
of characters with box face. */
unsigned end_of_box_run_p : 1;
/* The character to display, possibly translated to multibyte
if unibyte_display_via_language_environment is set. This
- is set after x_produce_glyphs has been called. */
+ is set after produce_glyphs has been called. */
int char_to_display;
/* If what == IT_IMAGE, the id of the image to display. */
short truncation_pixel_width, continuation_pixel_width;
/* First and last visible x-position in the display area. If window
- is hscrolled by n columns, first_visible_x == n * CANON_X_UNIT
+ is hscrolled by n columns, first_visible_x == n * FRAME_COLUMN_WIDTH
(f), and last_visible_x == pixel width of W + first_visible_x. */
int first_visible_x, last_visible_x;
/* Number of glyphs needed for the last character requested via
produce_glyphs. This is 1 except for tabs. */
int nglyphs;
-
+
/* Width of the display element in pixels. Result of
produce_glyphs. */
int pixel_width;
/* Call produce_glyphs or produce_glyphs_hook, if set. Shortcut to
avoid the function call overhead. */
-#define PRODUCE_GLYPHS(IT) \
- (rif \
- ? rif->produce_glyphs ((IT)) \
- : produce_glyphs ((IT)))
+#define PRODUCE_GLYPHS(IT) \
+ do { \
+ extern int inhibit_free_realized_faces; \
+ if (rif != NULL) \
+ rif->produce_glyphs ((IT)); \
+ else \
+ produce_glyphs ((IT)); \
+ if ((IT)->glyph_row != NULL) \
+ inhibit_free_realized_faces = 1; \
+ } while (0)
/* Bit-flags indicating what operation move_it_to should perform. */
};
+/* Handlers for setting frame parameters. */
+
+typedef void (*frame_parm_handler) P_ ((struct frame *, Lisp_Object, Lisp_Object));
+
+
/* Structure holding system-dependent interface functions needed
for window-based redisplay. */
struct redisplay_interface
{
+ /* Handlers for setting frame parameters. */
+ frame_parm_handler *frame_parm_handlers;
+
/* Produce glyphs/get display metrics for the display element IT is
loaded with. */
void (*produce_glyphs) P_ ((struct it *it));
-
+
/* Write or insert LEN glyphs from STRING at the nominal output
position. */
void (*write_glyphs) P_ ((struct glyph *string, int len));
/* Clear from nominal output position to X. X < 0 means clear
to right end of display. */
void (*clear_end_of_line) P_ ((int x));
-
+
/* Function to call to scroll the display as described by RUN on
window W. */
void (*scroll_run_hook) P_ ((struct window *w, struct run *run));
have to update the mouse highlight. */
void (*update_window_end_hook) P_ ((struct window *w, int cursor_on_p,
int mouse_face_overwritten_p));
-
+
/* Move cursor to row/column position VPOS/HPOS, pixel coordinates
Y/X. HPOS/VPOS are window-relative row and column numbers and X/Y
are window-relative pixel positions. */
/* Flush the display of frame F. For X, this is XFlush. */
void (*flush_display) P_ ((struct frame *f));
+ /* Flush the display of frame F if non-NULL. This is called
+ during redisplay, and should be NULL on systems which flushes
+ automatically before reading input. */
+ void (*flush_display_optional) P_ ((struct frame *f));
+
/* Clear the mouse hightlight in window W, if there is any. */
- void (*clear_mouse_face) P_ ((struct window *w));
+ void (*clear_window_mouse_face) P_ ((struct window *w));
/* Set *LEFT and *RIGHT to the left and right overhang of GLYPH on
frame F. */
desired rows have been made current. */
void (*fix_overlapping_area) P_ ((struct window *w, struct glyph_row *row,
enum glyph_row_area area));
- struct font_info *font_into, int *two_byte_p));
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+ /* Draw a fringe bitmap in window W of row ROW using parameters P. */
+ void (*draw_fringe_bitmap) P_ ((struct window *w, struct glyph_row *row,
+ struct draw_fringe_bitmap_params *p));
+
+/* Get metrics of character CHAR2B in FONT of type FONT_TYPE.
+ Value is null if CHAR2B is not contained in the font. */
+ XCharStruct * (*per_char_metric) P_ ((XFontStruct *font, XChar2b *char2b,
+ int font_type));
+
+/* Encode CHAR2B using encoding information from FONT_INFO. CHAR2B is
+ 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,
++ 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. */
+ void (*compute_glyph_string_overhangs) P_ ((struct glyph_string *s));
+
+/* Draw a glyph string S. */
+ void (*draw_glyph_string) P_ ((struct glyph_string *s));
+
+/* Define cursor CURSOR on frame F. */
+ void (*define_frame_cursor) P_ ((struct frame *f, Cursor cursor));
+
+/* Clear the area at (X,Y,WIDTH,HEIGHT) of frame F. */
+ void (*clear_frame_area) P_ ((struct frame *f, int x, int y,
+ int width, int height));
+
+/* Draw specified cursor CURSOR_TYPE of width CURSOR_WIDTH
+ at row GLYPH_ROW on window W if ON_P is 1. If ON_P is
+ 0, don't draw cursor. If ACTIVE_P is 1, system caret
+ should track this cursor (when applicable). */
+ void (*draw_window_cursor) P_ ((struct window *w,
+ struct glyph_row *glyph_row,
+ int x, int y,
+ int cursor_type, int cursor_width,
+ int on_p, int active_p));
+
+/* Draw vertical border for window W from (X,Y0) to (X,Y1). */
+ void (*draw_vertical_window_border) P_ ((struct window *w,
+ int x, int y0, int y1));
+
+/* Shift display of frame F to make room for inserted glyphs.
+ The area at pixel (X,Y) of width WIDTH and height HEIGHT is
+ shifted right by SHIFT_BY pixels. */
+ void (*shift_glyphs_for_insert) P_ ((struct frame *f,
+ int x, int y, int width,
+ int height, int shift_by));
+
+#endif /* HAVE_WINDOW_SYSTEM */
};
/* The current interface for window-based redisplay. */
extern struct redisplay_interface *rif;
-/* Hook to call in estimate_mode_line_height. */
-
-extern int (* estimate_mode_line_height_hook) P_ ((struct frame *,
- enum face_id));
-
\f
/***********************************************************************
Images
TOOL_BAR_IMAGE_DISABLED_DESELECTED
};
-/* Non-zero means raise tool-bar buttons when the mouse moves over them. */
-
-extern int auto_raise_tool_bar_buttons_p;
-
/* Margin around tool-bar buttons in pixels. */
extern Lisp_Object Vtool_bar_button_margin;
/* Thickness of relief to draw around tool-bar buttons. */
-extern int tool_bar_button_relief;
+extern EMACS_INT tool_bar_button_relief;
/* Default values of the above variables. */
-#define DEFAULT_TOOL_BAR_BUTTON_MARGIN 1
-#define DEFAULT_TOOL_BAR_BUTTON_RELIEF 3
+#define DEFAULT_TOOL_BAR_BUTTON_MARGIN 4
+#define DEFAULT_TOOL_BAR_BUTTON_RELIEF 1
/* The height in pixels of the default tool-bar images. */
\f
/***********************************************************************
- Function Prototypes
+ Terminal Capabilities
+ ***********************************************************************/
+
+/* Each of these is a bit representing a terminal `capability' (bold,
+ inverse, etc). They are or'd together to specify the set of
+ capabilities being queried for when calling `tty_capable_p' (which
+ returns true if the terminal supports all of them). */
+
+#define TTY_CAP_INVERSE 0x01
+#define TTY_CAP_UNDERLINE 0x02
+#define TTY_CAP_BOLD 0x04
+#define TTY_CAP_DIM 0x08
+#define TTY_CAP_BLINK 0x10
+#define TTY_CAP_ALT_CHARSET 0x20
+
+\f
+/***********************************************************************
+ Function Prototypes
***********************************************************************/
/* Defined in xdisp.c */
int window_box_left P_ ((struct window *, int));
int window_box_right P_ ((struct window *, int));
void window_box_edges P_ ((struct window *, int, int *, int *, int *, int *));
+int estimate_mode_line_height P_ ((struct frame *, enum face_id));
+void pixel_to_glyph_coords P_ ((struct frame *, int, int, int *, int *,
+ NativeRectangle *, int));
+int glyph_to_pixel_coords P_ ((struct window *, int, int, int *, int *));
void mark_window_display_accurate P_ ((Lisp_Object, int));
void redisplay_preserve_echo_area P_ ((int));
void set_cursor_from_row P_ ((struct window *, struct glyph_row *,
void move_it_vertically_backward P_ ((struct it *, int));
void move_it_by_lines P_ ((struct it *, int, int));
void move_it_past_eol P_ ((struct it *));
+int in_display_vector_p P_ ((struct it *));
int frame_mode_line_height P_ ((struct frame *));
void highlight_trailing_whitespace P_ ((struct frame *, struct glyph_row *));
-int tool_bar_item_info P_ ((struct frame *, struct glyph *, int *));
+void draw_row_fringe_bitmaps P_ ((struct window *, struct glyph_row *));
+void compute_fringe_widths P_ ((struct frame *, int));
extern Lisp_Object Qtool_bar;
extern Lisp_Object Vshow_trailing_whitespace;
extern int mode_line_in_non_selected_windows;
extern void add_to_log P_ ((char *, Lisp_Object, Lisp_Object));
extern int help_echo_showing_p;
extern int current_mode_line_height, current_header_line_height;
-extern int cursor_in_non_selected_windows;
+extern Lisp_Object help_echo_string, help_echo_window;
+extern Lisp_Object help_echo_object, previous_help_echo_string;
+extern int help_echo_pos;
+extern struct frame *last_mouse_frame;
+extern int last_tool_bar_item;
+extern int mouse_autoselect_window;
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+#if GLYPH_DEBUG
+extern void dump_glyph_string P_ ((struct glyph_string *));
+#endif
+
+extern void x_get_glyph_overhangs P_ ((struct glyph *, struct frame *,
+ int *, int *));
+extern void x_produce_glyphs P_ ((struct it *));
+
+extern void x_write_glyphs P_ ((struct glyph *, int));
+extern void x_insert_glyphs P_ ((struct glyph *, int len));
+extern void x_clear_end_of_line P_ ((int));
+
+extern int x_stretch_cursor_p;
+extern struct cursor_pos output_cursor;
+
+extern void x_fix_overlapping_area P_ ((struct window *, struct glyph_row *,
+ enum glyph_row_area));
+extern void draw_phys_cursor_glyph P_ ((struct window *,
+ struct glyph_row *,
+ enum draw_glyphs_face));
+extern void erase_phys_cursor P_ ((struct window *));
+extern void display_and_set_cursor P_ ((struct window *,
+ int, int, int, int, int));
+
+extern void set_output_cursor P_ ((struct cursor_pos *));
+extern void x_cursor_to P_ ((int, int, int, int));
+
+extern void x_update_cursor P_ ((struct frame *, int));
+extern void x_clear_cursor P_ ((struct window *));
+extern void x_draw_vertical_border P_ ((struct window *w));
+
+extern void frame_to_window_pixel_xy P_ ((struct window *, int *, int *));
+extern void get_glyph_string_clip_rect P_ ((struct glyph_string *,
+ NativeRectangle *nr));
+extern void note_mouse_highlight P_ ((struct frame *, int, int));
+extern void x_clear_window_mouse_face P_ ((struct window *));
+extern void cancel_mouse_face P_ ((struct frame *));
+
+extern void handle_tool_bar_click P_ ((struct frame *,
+ int, int, int, unsigned int));
+
+/* msdos.c defines its own versions of these functions. */
+extern int clear_mouse_face P_ ((Display_Info *));
+extern void show_mouse_face P_ ((Display_Info *, enum draw_glyphs_face));
+extern int cursor_in_mouse_face_p P_ ((struct window *w));
+
+extern void expose_frame P_ ((struct frame *, int, int, int, int));
+extern int x_intersect_rectangles P_ ((XRectangle *, XRectangle *,
+ XRectangle *));
+#endif
/* Defined in sysdep.c */
unsigned long load_color P_ ((struct frame *, struct face *, Lisp_Object,
enum lface_attribute_index));
void unload_color P_ ((struct frame *, unsigned long));
-int frame_update_line_height P_ ((struct frame *));
-char *choose_face_font P_ ((struct frame *, Lisp_Object *, 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_ ((unsigned char *, unsigned char *));
+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 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 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 lookup_derived_face P_ ((struct frame *, Lisp_Object, int));
void init_frame_faces P_ ((struct frame *));
void free_frame_faces P_ ((struct frame *));
void recompute_basic_faces P_ ((struct frame *));
int, int *, enum face_id, 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 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 */
extern int inverse_video;
extern int required_matrix_width P_ ((struct window *));
extern int required_matrix_height P_ ((struct window *));
-extern int estimate_mode_line_height P_ ((struct frame *, enum face_id));
-extern Lisp_Object mode_line_string P_ ((struct window *, int, int, int, int *));
+extern Lisp_Object mode_line_string P_ ((struct window *, int, int,
+ enum window_part, int *));
+extern Lisp_Object marginal_area_string P_ ((struct window *, int, int,
+ enum window_part, int *));
extern void redraw_frame P_ ((struct frame *));
extern void redraw_garbaged_frames P_ ((void));
extern void cancel_line P_ ((int, struct frame *));
void set_window_update_flags P_ ((struct window *, int));
void write_glyphs P_ ((struct glyph *, int));
void insert_glyphs P_ ((struct glyph *, int));
+void redraw_frame P_ ((struct frame *));
+void redraw_garbaged_frames P_ ((void));
int scroll_cost P_ ((struct frame *, int, int, int));
int direct_output_for_insert P_ ((int));
int direct_output_forward_char P_ ((int));
extern void term_init P_ ((char *));
extern void fatal P_ ((/* char *, ... */));
void cursor_to P_ ((int, int));
+extern int tty_capable_p P_ ((struct frame *, unsigned, unsigned long, unsigned long));
/* Defined in scroll.c */
void scrolling_1 P_ ((struct frame *, int, int, int, int *, int *, int *,
int *, int));
+/* Defined in frame.c */
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* Types we might convert a resource string into. */
+enum resource_types
+{
+ RES_TYPE_NUMBER,
+ RES_TYPE_FLOAT,
+ RES_TYPE_BOOLEAN,
+ RES_TYPE_STRING,
+ RES_TYPE_SYMBOL
+};
+
+extern Lisp_Object x_get_arg P_ ((Display_Info *, Lisp_Object,
+ Lisp_Object, char *, char *class,
+ enum resource_types));
+extern Lisp_Object x_frame_get_arg P_ ((struct frame *, Lisp_Object,
+ Lisp_Object, char *, char *,
+ enum resource_types));
+extern Lisp_Object x_frame_get_and_record_arg P_ ((
+ struct frame *, Lisp_Object,
+ Lisp_Object, char *, char *,
+ enum resource_types));
+extern Lisp_Object x_default_parameter P_ ((struct frame *, Lisp_Object,
+ Lisp_Object, Lisp_Object,
+ char *, char *,
+ enum resource_types));
+
+#endif /* HAVE_WINDOW_SYSTEM */
+
#endif /* not DISPEXTERN_H_INCLUDED */
/* Updating of data structures for redisplay.
- Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001
+ Copyright (C) 1985,86,87,88,93,94,95,97,98,1999,2000,01,02,2003
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 "window.h"
#include "w32term.h"
#endif /* HAVE_NTGUI */
-#ifdef macintosh
+#ifdef MAC_OS
#include "macterm.h"
-#endif /* macintosh */
+#endif /* MAC_OS */
/* Include systime.h after xterm.h to avoid double inclusion of time.h. */
/* Line speed of the terminal. */
-int baud_rate;
+EMACS_INT baud_rate;
/* Either nil or a symbol naming the window system under which Emacs
is running. */
int fonts_changed_p;
-/* Convert vpos and hpos from frame to window and vice versa.
+/* Convert vpos and hpos from frame to window and vice versa.
This may only be used for terminal frames. */
#if GLYPH_DEBUG
int paused_p;
{
char *buf;
-
+
if (history_idx >= REDISPLAY_HISTORY_SIZE)
history_idx = 0;
buf = redisplay_history[history_idx].trace;
++history_idx;
-
+
sprintf (buf, "%d: window %p (`%s')%s\n",
history_tick++,
w,
((BUFFERP (w->buffer)
&& STRINGP (XBUFFER (w->buffer)->name))
- ? (char *) XSTRING (XBUFFER (w->buffer)->name)->data
+ ? (char *) SDATA (XBUFFER (w->buffer)->name)
: "???"),
paused_p ? " ***paused***" : "");
strcat (buf, msg);
int paused_p;
{
char *buf;
-
+
if (history_idx >= REDISPLAY_HISTORY_SIZE)
history_idx = 0;
buf = redisplay_history[history_idx].trace;
++history_idx;
-
+
sprintf (buf, "%d: update frame %p%s",
history_tick++,
f, paused_p ? " ***paused***" : "");
#else /* GLYPH_DEBUG == 0 */
-#define WINDOW_TO_FRAME_VPOS(W, VPOS) ((VPOS) + XFASTINT ((W)->top))
-#define WINDOW_TO_FRAME_HPOS(W, HPOS) ((HPOS) + XFASTINT ((W)->left))
+#define WINDOW_TO_FRAME_VPOS(W, VPOS) ((VPOS) + WINDOW_TOP_EDGE_LINE (W))
+#define WINDOW_TO_FRAME_HPOS(W, HPOS) ((HPOS) + WINDOW_LEFT_EDGE_COL (W))
#endif /* GLYPH_DEBUG == 0 */
void
safe_bcopy (from, to, size)
- char *from, *to;
+ const char *from;
+ char *to;
int size;
{
if (size <= 0 || from == to)
/* Otherwise, we'll copy from the end. */
else
{
- register char *endf = from + size;
+ register const char *endf = from + size;
register char *endt = to + size;
/* If TO - FROM is large, then we should break the copy into
bcopy (from, to, endt - from);
}
}
-}
+}
\f
is freed. If the count gets negative, more structures were freed
than allocated, i.e. one matrix was freed more than once or a bogus
pointer was passed to this function.
-
+
If MATRIX->pool is null, this means that the matrix manages its own
glyph memory---this is done for matrices on X frames. Freeing the
matrix also frees the glyph memory in this case. */
if (matrix->pool == NULL)
for (i = 0; i < matrix->rows_allocated; ++i)
xfree (matrix->rows[i].glyphs[LEFT_MARGIN_AREA]);
-
+
/* Free row structures and the matrix itself. */
xfree (matrix->rows);
xfree (matrix);
if (NUMBERP (margin))
{
- int width = XFASTINT (w->width);
+ int width = XFASTINT (w->total_cols);
double d = max (0, XFLOATINT (margin));
d = min (width / 2 - 1, d);
n = (int) ((double) total_glyphs / width * d);
int header_line_changed_p = 0;
int header_line_p = 0;
int left = -1, right = -1;
- int window_x, window_y, window_width = -1, window_height;
+ int window_width = -1, window_height;
/* See if W had a header line that has disappeared now, or vice versa. */
if (w)
the matrix means preventing redisplay. */
if (matrix->pool == NULL)
{
- window_box (w, -1, &window_x, &window_y, &window_width, &window_height);
- left = margin_glyphs_to_reserve (w, dim.width, w->left_margin_width);
- right = margin_glyphs_to_reserve (w, dim.width, w->right_margin_width);
+ window_box (w, -1, 0, 0, &window_width, &window_height);
+ left = margin_glyphs_to_reserve (w, dim.width, w->left_margin_cols);
+ right = margin_glyphs_to_reserve (w, dim.width, w->right_margin_cols);
xassert (left >= 0 && right >= 0);
marginal_areas_changed_p = (left != matrix->left_margin_glyphs
|| right != matrix->right_margin_glyphs);
if (!marginal_areas_changed_p
&& !fonts_changed_p
&& !header_line_changed_p
- && matrix->window_left_x == XFASTINT (w->left)
- && matrix->window_top_y == XFASTINT (w->top)
+ && matrix->window_left_col == WINDOW_LEFT_EDGE_COL (w)
+ && matrix->window_top_line == WINDOW_TOP_EDGE_LINE (w)
&& matrix->window_height == window_height
&& matrix->window_vscroll == w->vscroll
&& matrix->window_width == window_width)
return;
}
-
+
/* Enlarge MATRIX->rows if necessary. New rows are cleared. */
if (matrix->rows_allocated < dim.height)
{
if (matrix->pool)
{
xassert (matrix->pool->glyphs);
-
+
if (w)
{
left = margin_glyphs_to_reserve (w, dim.width,
- w->left_margin_width);
+ w->left_margin_cols);
right = margin_glyphs_to_reserve (w, dim.width,
- w->right_margin_width);
+ w->right_margin_cols);
}
else
left = right = 0;
-
+
for (i = 0; i < dim.height; ++i)
{
struct glyph_row *row = &matrix->rows[i];
-
- row->glyphs[LEFT_MARGIN_AREA]
+
+ row->glyphs[LEFT_MARGIN_AREA]
= (matrix->pool->glyphs
+ (y + i) * matrix->pool->ncolumns
+ x);
-
+
if (w == NULL
|| row == matrix->rows + dim.height - 1
|| (row == matrix->rows && matrix->header_line_p))
= row->glyphs[LEFT_MARGIN_AREA] + dim.width;
}
}
-
+
matrix->left_margin_glyphs = left;
matrix->right_margin_glyphs = right;
}
{
struct glyph_row *row = matrix->rows;
struct glyph_row *end = row + matrix->rows_allocated;
-
+
while (row < end)
{
row->glyphs[LEFT_MARGIN_AREA]
= (struct glyph *) xrealloc (row->glyphs[LEFT_MARGIN_AREA],
(dim.width
* sizeof (struct glyph)));
-
+
/* The mode line never has marginal areas. */
if (row == matrix->rows + dim.height - 1
|| (row == matrix->rows && matrix->header_line_p))
matrix->left_margin_glyphs = left;
matrix->right_margin_glyphs = right;
}
-
+
/* Number of rows to be used by MATRIX. */
matrix->nrows = dim.height;
xassert (matrix->nrows >= 0);
building desired matrices when this function runs. */
if (window_width < 0)
window_width = window_box_width (w, -1);
-
+
/* Optimize the case that only the height has changed (C-x 2,
upper window). Invalidate all rows that are no longer part
of the window. */
&& !header_line_changed_p
&& new_rows == 0
&& dim.width == matrix->matrix_w
- && matrix->window_left_x == XFASTINT (w->left)
- && matrix->window_top_y == XFASTINT (w->top)
+ && matrix->window_left_col == WINDOW_LEFT_EDGE_COL (w)
+ && matrix->window_top_line == WINDOW_TOP_EDGE_LINE (w)
&& matrix->window_width == window_width)
{
/* Find the last row in the window. */
if (INTEGERP (w->window_end_vpos)
&& XFASTINT (w->window_end_vpos) >= i)
w->window_end_valid = Qnil;
-
+
while (i < matrix->nrows)
matrix->rows[i++].enabled_p = 0;
}
matrix->rows[i].enabled_p = 0;
}
}
-
-
+
+
/* Remember last values to be able to optimize frame redraws. */
matrix->matrix_x = x;
matrix->matrix_y = y;
was last adjusted. This is used to optimize redisplay above. */
if (w)
{
- matrix->window_left_x = XFASTINT (w->left);
- matrix->window_top_y = XFASTINT (w->top);
+ matrix->window_left_col = WINDOW_LEFT_EDGE_COL (w);
+ matrix->window_top_line = WINDOW_TOP_EDGE_LINE (w);
matrix->window_height = window_height;
matrix->window_width = window_width;
matrix->window_vscroll = w->vscroll;
xassert (start <= end);
xassert (start >= 0 && start < matrix->nrows);
xassert (end >= 0 && end <= matrix->nrows);
-
+
for (; start < end; ++start)
matrix->rows[start].enabled_p = enabled_p != 0;
}
matrix->no_scrolling_p = 0;
}
}
-
+
/* Shift part of the glyph matrix MATRIX of window W up or down.
Increment y-positions in glyph rows between START and END by DY,
int start, end, dy;
{
int min_y, max_y;
-
+
xassert (start <= end);
xassert (start >= 0 && start < matrix->nrows);
xassert (end >= 0 && end <= matrix->nrows);
-
- min_y = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w);
- max_y = WINDOW_DISPLAY_HEIGHT_NO_MODE_LINE (w);
-
+
+ min_y = WINDOW_HEADER_LINE_HEIGHT (w);
+ max_y = WINDOW_BOX_HEIGHT_NO_MODE_LINE (w);
+
for (; start < end; ++start)
{
struct glyph_row *row = &matrix->rows[start];
-
+
row->y += dy;
row->visible_height = row->height;
-
+
if (row->y < min_y)
row->visible_height -= min_y - row->y;
if (row->y + row->height > max_y)
{
if (f->desired_matrix)
clear_glyph_matrix (f->desired_matrix);
-
+
if (WINDOWP (f->menu_bar_window))
clear_glyph_matrix (XWINDOW (f->menu_bar_window)->desired_matrix);
int y;
{
int min_y, max_y;
-
- min_y = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w);
- max_y = WINDOW_DISPLAY_HEIGHT_NO_MODE_LINE (w);
-
+
+ min_y = WINDOW_HEADER_LINE_HEIGHT (w);
+ max_y = WINDOW_BOX_HEIGHT_NO_MODE_LINE (w);
+
clear_glyph_row (row);
row->y = y;
row->ascent = row->phys_ascent = 0;
- row->height = row->phys_height = CANON_Y_UNIT (XFRAME (w->frame));
+ row->height = row->phys_height = FRAME_LINE_HEIGHT (XFRAME (w->frame));
row->visible_height = row->height;
-
+
if (row->y < min_y)
row->visible_height -= min_y - row->y;
if (row->y + row->height > max_y)
/* Copy glyphs from FROM to TO. */
for (area = 0; area < LAST_AREA; ++area)
if (from->used[area])
- bcopy (from->glyphs[area], to->glyphs[area],
+ bcopy (from->glyphs[area], to->glyphs[area],
from->used[area] * sizeof (struct glyph));
/* Increment buffer positions in TO by DELTA. */
struct glyph_row *row;
{
int hash = 0;
-
+
if (row->enabled_p)
{
struct glyph *glyph = row->glyphs[TEXT_AREA];
while (end > beg && CHAR_GLYPH_SPACE_P (*(end - 1)))
--end;
- /* All blank line. */
+ /* All blank line. */
if (end == beg)
return 0;
while (beg < end)
{
GLYPH g = GLYPH_FROM_CHAR_GLYPH (*beg);
-
+
if (g < 0
|| GLYPH_SIMPLE_P (glyph_table_base, glyph_table_len, g))
len += 1;
else
len += GLYPH_LENGTH (glyph_table_base, g);
-
+
++beg;
}
}
-
+
return len;
}
visibility. MOUSE_FACE_P non-zero means compare the mouse_face_p
flags of A and B, too. */
-static INLINE int
+static INLINE int
row_equal_p (w, a, b, mouse_face_p)
struct window *w;
struct glyph_row *a, *b;
{
if (a->used[area] != b->used[area])
return 0;
-
+
a_glyph = a->glyphs[area];
a_end = a_glyph + a->used[area];
b_glyph = b->glyphs[area];
-
+
while (a_glyph < a_end
&& GLYPH_EQUAL_P (a_glyph, b_glyph))
++a_glyph, ++b_glyph;
-
+
if (a_glyph != a_end)
return 0;
}
/* Allocate a new glyph_pool and clear it. */
result = (struct glyph_pool *) xmalloc (sizeof *result);
bzero (result, sizeof *result);
-
+
/* For memory leak and double deletion checking. */
++glyph_pool_count;
-
+
return result;
}
determine pointers to rows of window sub-matrices. */
pool->nrows = matrix_dim.height;
pool->ncolumns = matrix_dim.width;
-
+
return changed_p;
}
struct glyph_matrix *matrix;
{
int i, j;
-
+
for (i = 0; i < matrix->nrows; ++i)
for (j = 0; j < matrix->nrows; ++j)
xassert (i == j
#if 0
check_matrix_pointer_lossage (matrix);
#endif
-
+
return matrix->rows + row;
}
struct buffer *saved = current_buffer;
struct buffer *buffer = XBUFFER (w->buffer);
int c;
-
+
/* This can sometimes happen for a fresh window. */
if (matrix->nrows < 2)
return;
&& !NILP (XWINDOW (XWINDOW (window)->parent)->hchild));
/* For WINDOW and all windows on the same level. */
- do
+ do
{
w = XWINDOW (window);
/* Get the dimension of the window sub-matrix for W, depending
on whether this is a combination or a leaf window. */
if (!NILP (w->hchild))
- dim = allocate_matrices_for_frame_redisplay (w->hchild, x, y,
+ dim = allocate_matrices_for_frame_redisplay (w->hchild, x, y,
dim_only_p,
window_change_flags);
else if (!NILP (w->vchild))
- dim = allocate_matrices_for_frame_redisplay (w->vchild, x, y,
+ dim = allocate_matrices_for_frame_redisplay (w->vchild, x, y,
dim_only_p,
window_change_flags);
else
w->current_matrix = new_glyph_matrix (f->current_pool);
*window_change_flags |= NEW_LEAF_MATRIX;
}
-
+
/* Width and height MUST be chosen so that there are no
holes in the frame matrix. */
dim.width = required_matrix_width (w);
|| dim.width != w->desired_matrix->matrix_w
|| dim.height != w->desired_matrix->matrix_h
|| (margin_glyphs_to_reserve (w, dim.width,
- w->right_margin_width)
+ w->right_margin_cols)
!= w->desired_matrix->left_margin_glyphs)
|| (margin_glyphs_to_reserve (w, dim.width,
- w->left_margin_width)
+ w->left_margin_cols)
!= w->desired_matrix->right_margin_glyphs))
*window_change_flags |= CHANGED_LEAF_MATRIX;
below W. */
if (in_horz_combination_p)
x += dim.width;
- else
+ else
y += dim.height;
/* Remember maximum glyph matrix dimensions. */
total.width = x - x0;
total.height = hmax;
}
- else
+ else
{
total.width = wmax;
total.height = y - y0;
{
#ifdef HAVE_WINDOW_SYSTEM
struct frame *f = XFRAME (w->frame);
-
+
if (FRAME_WINDOW_P (f))
{
int ch_height = FRAME_SMALLEST_FONT_HEIGHT (f);
+ 2);
}
#endif /* HAVE_WINDOW_SYSTEM */
-
- return XINT (w->height);
+
+ return WINDOW_TOTAL_LINES (w);
}
if (FRAME_WINDOW_P (f))
{
int ch_width = FRAME_SMALLEST_CHAR_WIDTH (f);
- int window_pixel_width = XFLOATINT (w->width) * CANON_X_UNIT (f);
-
+ int window_pixel_width = WINDOW_TOTAL_WIDTH (w);
+
/* Compute number of glyphs needed in a glyph row. */
return (((window_pixel_width + ch_width - 1)
/ ch_width)
}
#endif /* HAVE_WINDOW_SYSTEM */
- return XINT (w->width);
+ return XINT (w->total_cols);
}
/* Allocate window matrices for window-based redisplay. W is the
window whose matrices must be allocated/reallocated. CH_DIM is the
size of the smallest character that could potentially be used on W. */
-
+
static void
allocate_matrices_for_window_redisplay (w)
struct window *w;
adjust_glyph_matrix (w, w->desired_matrix, 0, 0, dim);
adjust_glyph_matrix (w, w->current_matrix, 0, 0, dim);
}
-
+
w = NILP (w->next) ? NULL : XWINDOW (w->next);
}
}
else
{
Lisp_Object tail, lisp_frame;
-
+
FOR_EACH_FRAME (tail, lisp_frame)
adjust_frame_glyphs (XFRAME (lisp_frame));
}
/* Adjust frame glyphs when Emacs is initialized.
-
- To be called from init_display.
-
+
+ To be called from init_display.
+
We need a glyph matrix because redraw will happen soon.
Unfortunately, window sizes on selected_frame are not yet set to
meaningful values. I believe we can assume that there are only two
struct frame *sf = SELECTED_FRAME ();
struct window *root = XWINDOW (sf->root_window);
struct window *mini = XWINDOW (root->next);
- int frame_height = FRAME_HEIGHT (sf);
- int frame_width = FRAME_WIDTH (sf);
+ int frame_lines = FRAME_LINES (sf);
+ int frame_cols = FRAME_COLS (sf);
int top_margin = FRAME_TOP_MARGIN (sf);
/* Do it for the root window. */
- XSETFASTINT (root->top, top_margin);
- XSETFASTINT (root->width, frame_width);
- set_window_height (sf->root_window, frame_height - 1 - top_margin, 0);
+ XSETFASTINT (root->top_line, top_margin);
+ XSETFASTINT (root->total_cols, frame_cols);
+ set_window_height (sf->root_window, frame_lines - 1 - top_margin, 0);
/* Do it for the mini-buffer window. */
- XSETFASTINT (mini->top, frame_height - 1);
- XSETFASTINT (mini->width, frame_width);
+ XSETFASTINT (mini->top_line, frame_lines - 1);
+ XSETFASTINT (mini->total_cols, frame_cols);
set_window_height (root->next, 1, 0);
adjust_frame_glyphs (sf);
glyphs_initialized_initially_p = 1;
}
-
+
/* Allocate/reallocate glyph matrices of a single frame F. */
adjust_frame_glyphs_for_window_redisplay (f);
else
adjust_frame_glyphs_for_frame_redisplay (f);
-
+
/* Don't forget the message buffer and the buffer for
decode_mode_spec. */
adjust_frame_message_buffer (f);
Lisp_Object window;
{
struct window *w;
-
+
for (; !NILP (window); window = w->next)
{
w = XWINDOW (window);
-
+
if (!NILP (w->hchild))
fake_current_matrices (w->hchild);
else if (!NILP (w->vchild))
struct glyph_matrix *m = w->current_matrix;
struct glyph_matrix *fm = f->current_matrix;
- xassert (m->matrix_h == XFASTINT (w->height));
- xassert (m->matrix_w == XFASTINT (w->width));
-
+ xassert (m->matrix_h == WINDOW_TOTAL_LINES (w));
+ xassert (m->matrix_w == WINDOW_TOTAL_COLS (w));
+
for (i = 0; i < m->matrix_h; ++i)
{
struct glyph_row *r = m->rows + i;
- struct glyph_row *fr = fm->rows + i + XFASTINT (w->top);
+ struct glyph_row *fr = fm->rows + i + WINDOW_TOP_EDGE_LINE (w);
xassert (r->glyphs[TEXT_AREA] >= fr->glyphs[TEXT_AREA]
&& r->glyphs[LAST_AREA] <= fr->glyphs[LAST_AREA]);
to->used[TEXT_AREA] = from->used[TEXT_AREA];
xfree (from->glyphs[TEXT_AREA]);
}
-
+
xfree (saved->rows);
xfree (saved);
}
/* Determine the smallest character in any font for F. On
console windows, all characters have dimension (1, 1). */
ch_dim.width = ch_dim.height = 1;
-
+
top_window_y = FRAME_TOP_MARGIN (f);
/* Allocate glyph pool structures if not already done. */
f->desired_matrix = new_glyph_matrix (f->desired_pool);
f->current_matrix = new_glyph_matrix (f->current_pool);
}
-
+
/* Compute window glyph matrices. (This takes the mini-buffer
window into account). The result is the size of the frame glyph
matrix needed. The variable window_change_flags is set to a bit
pool_changed_p = realloc_glyph_pool (f->desired_pool, matrix_dim);
realloc_glyph_pool (f->current_pool, matrix_dim);
- /* Set up glyph pointers within window matrices. Do this only if
+ /* Set up glyph pointers within window matrices. Do this only if
absolutely necessary since it requires a frame redraw. */
if (pool_changed_p || window_change_flags)
{
/* Size of frame matrices must equal size of frame. Note
that we are called for X frames with window widths NOT equal
to the frame width (from CHANGE_FRAME_SIZE_1). */
- xassert (matrix_dim.width == FRAME_WIDTH (f)
- && matrix_dim.height == FRAME_HEIGHT (f));
-
+ xassert (matrix_dim.width == FRAME_COLS (f)
+ && matrix_dim.height == FRAME_LINES (f));
+
/* Pointers to glyph memory in glyph rows are exchanged during
the update phase of redisplay, which means in general that a
frame's current matrix consists of pointers into both the
struct window *w;
xassert (FRAME_WINDOW_P (f) && FRAME_LIVE_P (f));
-
+
/* Get minimum sizes. */
#ifdef HAVE_WINDOW_SYSTEM
ch_dim.width = FRAME_SMALLEST_CHAR_WIDTH (f);
#else
ch_dim.width = ch_dim.height = 1;
#endif
-
+
/* Allocate/reallocate window matrices. */
allocate_matrices_for_window_redisplay (XWINDOW (FRAME_ROOT_WINDOW (f)));
/* Allocate/ reallocate matrices of the dummy window used to display
the menu bar under X when no X toolkit support is available. */
-#ifndef USE_X_TOOLKIT
+#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
{
/* Allocate a dummy window if not already done. */
if (NILP (f->menu_bar_window))
/* Set window dimensions to frame dimensions and allocate or
adjust glyph matrices of W. */
- XSETFASTINT (w->top, 0);
- XSETFASTINT (w->left, 0);
- XSETFASTINT (w->height, FRAME_MENU_BAR_LINES (f));
- XSETFASTINT (w->width, FRAME_WINDOW_WIDTH (f));
+ XSETFASTINT (w->top_line, 0);
+ XSETFASTINT (w->left_col, 0);
+ XSETFASTINT (w->total_lines, FRAME_MENU_BAR_LINES (f));
+ XSETFASTINT (w->total_cols, FRAME_TOTAL_COLS (f));
allocate_matrices_for_window_redisplay (w);
}
#endif /* not USE_X_TOOLKIT */
+#ifndef USE_GTK
/* Allocate/ reallocate matrices of the tool bar window. If we
don't have a tool bar window yet, make one. */
if (NILP (f->tool_bar_window))
else
w = XWINDOW (f->tool_bar_window);
- XSETFASTINT (w->top, FRAME_MENU_BAR_LINES (f));
- XSETFASTINT (w->left, 0);
- XSETFASTINT (w->height, FRAME_TOOL_BAR_LINES (f));
- XSETFASTINT (w->width, FRAME_WINDOW_WIDTH (f));
+ XSETFASTINT (w->top_line, FRAME_MENU_BAR_LINES (f));
+ XSETFASTINT (w->left_col, 0);
+ XSETFASTINT (w->total_lines, FRAME_TOOL_BAR_LINES (f));
+ XSETFASTINT (w->total_cols, FRAME_TOTAL_COLS (f));
allocate_matrices_for_window_redisplay (w);
+#endif
}
-/* Adjust/ allocate message buffer of frame F.
+/* Adjust/ allocate message buffer of frame F.
Note that the message buffer is never freed. Since I could not
find a free in 19.34, I assume that freeing it would be
event while we're in an inconsistent state. */
BLOCK_INPUT;
f->glyphs_initialized_p = 0;
-
+
/* Release window sub-matrices. */
if (!NILP (f->root_window))
free_window_matrices (XWINDOW (f->root_window));
free_glyph_pool (f->current_pool);
f->desired_pool = f->current_pool = NULL;
}
-
+
UNBLOCK_INPUT;
}
}
free_window_matrices (XWINDOW (w->hchild));
else if (!NILP (w->vchild))
free_window_matrices (XWINDOW (w->vchild));
- else
+ else
{
/* This is a leaf window. Free its memory and reset fields
to zero in case this function is called a second time for
up glyph lengths of the window matrices. A line in the frame
matrix is enabled, if a corresponding line in a window matrix is
enabled.
-
+
After building the desired frame matrix, it will be passed to
terminal code, which will manipulate both the desired and current
frame matrix. Changes applied to the frame's current matrix have
contents needed in a frame matrix. Thus, any modification of
glyphs done in terminal code will be reflected in window matrices
automatically.
-
+
2. Exchanges of rows in a frame matrix done by terminal code are
intercepted by hook functions so that corresponding row operations
on window matrices can be performed. This is necessary because we
/* F must have a frame matrix when this function is called. */
xassert (!FRAME_WINDOW_P (f));
-
+
/* Clear all rows in the frame matrix covered by window matrices.
Menu bar lines are not covered by windows. */
for (i = FRAME_TOP_MARGIN (f); i < f->desired_matrix->nrows; ++i)
window_row = w->current_matrix->rows + window_y;
current_row_p = 1;
}
-
+
if (current_row_p)
{
/* Copy window row to frame row. */
else
{
xassert (window_row->enabled_p);
-
+
/* Only when a desired row has been displayed, we want
the corresponding frame row to be updated. */
frame_row->enabled_p = 1;
-
+
/* Maybe insert a vertical border between horizontally adjacent
windows. */
if (right_border_glyph)
/* Window row window_y must be a slice of frame row
frame_y. */
xassert (glyph_row_slice_p (window_row, frame_row));
-
+
/* If rows are in sync, we don't have to copy glyphs because
frame and window share glyphs. */
-
+
#if GLYPH_DEBUG
strcpy (w->current_matrix->method, w->desired_matrix->method);
add_window_display_history (w, w->current_matrix->method, 0);
/* Set number of used glyphs in the frame matrix. Since we fill
up with spaces, and visit leaf windows from left to right it
can be done simply. */
- frame_row->used[TEXT_AREA]
+ frame_row->used[TEXT_AREA]
= window_matrix->matrix_x + window_matrix->matrix_w;
/* Next row. */
{
int i = row->used[TEXT_AREA];
struct glyph *glyph = row->glyphs[TEXT_AREA];
-
+
while (i < upto)
glyph[i++] = space_glyph;
current_row->enabled_p = 1;
}
}
-
+
w = NILP (w->next) ? 0 : XWINDOW (w->next);
}
}
row 0 <= I < NLINES which is empty.
This function is called from do_scrolling and do_direct_scrolling. */
-
+
void
mirrored_line_dance (matrix, unchanged_at_top, nlines, copy_from,
retained_p)
/* Rows to assign to. */
struct glyph_row *new_rows = MATRIX_ROW (matrix, unchanged_at_top);
-
+
int i;
/* Make a copy of the original rows. */
xassert (NILP (w->hchild) && NILP (w->vchild));
xassert (!FRAME_WINDOW_P (f));
- left = margin_glyphs_to_reserve (w, 1, w->left_margin_width);
- right = margin_glyphs_to_reserve (w, 1, w->right_margin_width);
+ left = margin_glyphs_to_reserve (w, 1, w->left_margin_cols);
+ right = margin_glyphs_to_reserve (w, 1, w->right_margin_cols);
x = w->current_matrix->matrix_x;
width = w->current_matrix->matrix_w;
window_row = w->current_matrix->rows;
window_row_end = window_row + w->current_matrix->nrows;
- frame_row = f->current_matrix->rows + XFASTINT (w->top);
-
+ frame_row = f->current_matrix->rows + WINDOW_TOP_EDGE_LINE (w);
+
for (; window_row < window_row_end; ++window_row, ++frame_row)
{
window_row->glyphs[LEFT_MARGIN_AREA]
int row;
{
struct window *found = NULL;
-
+
while (w && !found)
{
if (!NILP (w->hchild))
found = frame_row_to_window (XWINDOW (w->hchild), row);
else if (!NILP (w->vchild))
found = frame_row_to_window (XWINDOW (w->vchild), row);
- else if (row >= XFASTINT (w->top)
- && row < XFASTINT (w->top) + XFASTINT (w->height))
+ else if (row >= WINDOW_TOP_EDGE_LINE (w)
+ && row < WINDOW_BOTTOM_EDGE_LINE (w))
found = w;
-
+
w = NILP (w->next) ? 0 : XWINDOW (w->next);
}
{
/* Frame relative line assigned to. */
int frame_to = i + unchanged_at_top;
-
+
/* Frame relative line assigned. */
int frame_from = copy_from[i] + unchanged_at_top;
-
+
/* Window relative line assigned to. */
int window_to = frame_to - m->matrix_y;
-
+
/* Window relative line assigned. */
int window_from = frame_from - m->matrix_y;
-
+
/* Is assigned line inside window? */
int from_inside_window_p
= window_from >= 0 && window_from < m->matrix_h;
-
+
/* Is assigned to line inside window? */
int to_inside_window_p
= window_to >= 0 && window_to < m->matrix_h;
-
+
if (from_inside_window_p && to_inside_window_p)
{
/* Enabled setting before assignment. */
int enabled_before_p;
-
+
/* Do the assignment. The enabled_p flag is saved
over the assignment because the old redisplay did
that. */
enabled_before_p = m->rows[window_to].enabled_p;
m->rows[window_to] = old_rows[window_from];
m->rows[window_to].enabled_p = enabled_before_p;
-
+
/* If frame line is empty, window line is empty, too. */
if (!retained_p[copy_from[i]])
m->rows[window_to].enabled_p = 0;
m2_from = frame_from - m2->matrix_y;
copy_row_except_pointers (m->rows + window_to,
m2->rows + m2_from);
-
+
/* If frame line is empty, window line is empty, too. */
if (!retained_p[copy_from[i]])
m->rows[window_to].enabled_p = 0;
pointers are in sync with the frame matrix. */
if (sync_p)
sync_window_with_frame_matrix_rows (w);
-
+
/* Check that no pointers are lost. */
CHECK_MATRIX (m);
}
check_matrix_pointers (w->desired_matrix, f->desired_matrix);
check_matrix_pointers (w->current_matrix, f->current_matrix);
}
-
+
w = NILP (w->next) ? 0 : XWINDOW (w->next);
}
}
/* Row number corresponding to I in FRAME_MATRIX. */
int j = window_matrix->matrix_y;
- /* For all rows check that the row in the window matrix is a
+ /* For all rows check that the row in the window matrix is a
slice of the row in the frame matrix. If it isn't we didn't
mirror an operation on the frame matrix correctly. */
while (i < window_matrix->nrows)
int vpos;
{
struct frame *f = XFRAME (w->frame);
-
+
xassert (!FRAME_WINDOW_P (f));
xassert (vpos >= 0 && vpos <= w->desired_matrix->nrows);
- vpos += XFASTINT (w->top);
- xassert (vpos >= 0 && vpos <= FRAME_HEIGHT (f));
+ vpos += WINDOW_TOP_EDGE_LINE (w);
+ xassert (vpos >= 0 && vpos <= FRAME_LINES (f));
return vpos;
}
int hpos;
{
struct frame *f = XFRAME (w->frame);
-
+
xassert (!FRAME_WINDOW_P (f));
- hpos += XFASTINT (w->left);
+ hpos += WINDOW_LEFT_EDGE_COL (w);
return hpos;
}
-
+
#endif /* GLYPH_DEBUG */
is handled specially there (see display_line). */
|| (MINI_WINDOW_P (w) && XFASTINT (w->hscroll))
/* Give up if overwriting in the middle of a line. */
- || (overwrite_p
- && PT != ZV
+ || (overwrite_p
+ && PT != ZV
&& FETCH_BYTE (PT) != '\n')
/* Give up for tabs and line ends. */
|| g == '\t'
glyph_row = MATRIX_ROW (w->current_matrix, w->cursor.vpos);
if (glyph_row->mouse_face_p)
return 0;
-
+
/* Give up if highlighting trailing whitespace and we have trailing
whitespace in glyph_row. We would have to remove the trailing
whitespace face in that case. */
if the overlay string has newlines in it. */
if (STRINGP (it.string))
return 0;
-
+
it.hpos = w->cursor.hpos;
it.vpos = w->cursor.vpos;
it.current_x = w->cursor.x + it.first_visible_x;
/* More than one display element may be returned for PT - 1 if
(i) it's a control character which is translated into `\003' or
- `^C', or (ii) it has a display table entry, or (iii) it's a
+ `^C', or (ii) it has a display table entry, or (iii) it's a
combination of both. */
delta = delta_bytes = 0;
while (get_next_display_element (&it))
bcopy (it.glyph_row->glyphs[TEXT_AREA], glyphs, n * sizeof *glyphs);
glyph_row->used[TEXT_AREA] = min (glyph_row->used[TEXT_AREA] + n,
end - glyph_row->glyphs[TEXT_AREA]);
-
+
/* Compute new line width. */
glyph = glyph_row->glyphs[TEXT_AREA];
end = glyph + glyph_row->used[TEXT_AREA];
++glyph;
}
- /* Increment buffer positions for glyphs following the newly
+ /* Increment buffer positions for glyphs following the newly
inserted ones. */
for (glyph = glyphs + n; glyph < end; ++glyph)
if (glyph->charpos > 0 && BUFFERP (glyph->object))
glyph->charpos += delta;
-
+
if (MATRIX_ROW_END_CHARPOS (glyph_row) > 0)
{
MATRIX_ROW_END_CHARPOS (glyph_row) += delta;
MATRIX_ROW_END_BYTEPOS (glyph_row) += delta_bytes;
}
-
+
/* Adjust positions in lines following the one we are in. */
increment_matrix_positions (w->current_matrix,
w->cursor.vpos + 1,
if (rif)
{
rif->update_window_begin_hook (w);
-
+
if (glyphs == end - n
/* In front of a space added by append_space. */
|| (glyphs == end - n - 1
{
int x, y;
x = (WINDOW_TO_FRAME_HPOS (w, w->cursor.hpos)
- + (INTEGERP (w->left_margin_width)
- ? XFASTINT (w->left_margin_width)
+ + (INTEGERP (w->left_margin_cols)
+ ? XFASTINT (w->left_margin_cols)
: 0));
y = WINDOW_TO_FRAME_VPOS (w, w->cursor.vpos);
cursor_to (y, x);
fflush (stdout);
TRACE ((stderr, "direct output for insert\n"));
-
- UNCHANGED_MODIFIED = MODIFF;
- BEG_UNCHANGED = GPT - BEG;
- XSETFASTINT (w->last_point, PT);
- w->last_cursor = w->cursor;
- XSETFASTINT (w->last_modified, MODIFF);
- XSETFASTINT (w->last_overlay_modified, OVERLAY_MODIFF);
-
+ mark_window_display_accurate (it.window, 1);
redisplay_performed_directly_p = 1;
return 1;
}
/* Give up if face attributes have been changed. */
if (face_change_count)
return 0;
-
- /* Give up if current matrix is not up to date or we are
+
+ /* Give up if current matrix is not up to date or we are
displaying a message. */
if (!display_completed || cursor_in_echo_area)
return 0;
if (XWINDOW (minibuf_window) == w
&& EQ (minibuf_window, echo_area_window))
return 0;
-
+
/* Give up if we don't know where the cursor is. */
if (w->cursor.vpos < 0)
return 0;
return 0;
set_cursor_from_row (w, row, w->current_matrix, 0, 0, 0, 0);
-
+
w->last_cursor = w->cursor;
XSETFASTINT (w->last_point, PT);
xassert (w->cursor.hpos >= 0
&& w->cursor.hpos < w->desired_matrix->matrix_w);
-
+
if (FRAME_WINDOW_P (f))
rif->cursor_to (w->cursor.vpos, w->cursor.hpos,
w->cursor.y, w->cursor.x);
{
int x, y;
x = (WINDOW_TO_FRAME_HPOS (w, w->cursor.hpos)
- + (INTEGERP (w->left_margin_width)
- ? XFASTINT (w->left_margin_width)
+ + (INTEGERP (w->left_margin_cols)
+ ? XFASTINT (w->left_margin_cols)
: 0));
y = WINDOW_TO_FRAME_VPOS (w, w->cursor.vpos);
cursor_to (y, x);
}
-
+
fflush (stdout);
redisplay_performed_directly_p = 1;
return 1;
If FORCE_P is non-zero, don't let redisplay be stopped by detecting
pending input. If INHIBIT_HAIRY_ID_P is non-zero, don't try
scrolling.
-
+
Value is non-zero if redisplay was stopped due to pending input. */
int
f->desired_tool_bar_string = tem;
}
}
-
+
/* Update windows. */
paused_p = update_window_tree (root_window, force_p);
update_end (f);
-
+
#if 0 /* This flush is a performance bottleneck under X,
and it doesn't seem to be necessary anyway. */
rif->flush_display (f);
/* Build F's desired matrix from window matrices. */
build_frame_matrix (f);
-
+
/* Update the display */
update_begin (f);
paused_p = update_frame_1 (f, force_p, inhibit_hairy_id_p);
/* Reset flags indicating that a window should be updated. */
set_window_update_flags (root_window, 0);
-
+
display_completed = !paused_p;
return paused_p;
}
int force_p;
{
int paused_p = 0;
-
+
while (w && !paused_p)
{
if (!NILP (w->hchild))
int yb;
{
int i;
-
+
/* If rows overlapping others have been changed, the rows being
overlapped have to be redrawn. This won't draw lines that have
already been drawn in update_window_line because overlapped_p in
break;
else if (row->mode_line_p)
continue;
-
+
if (row->overlapped_p)
{
enum glyph_row_area area;
-
+
for (area = LEFT_MARGIN_AREA; area < LAST_AREA; ++area)
{
updated_row = row;
rif->write_glyphs (row->glyphs[area], row->used[area]);
rif->clear_end_of_line (-1);
}
-
+
row->overlapped_p = 0;
}
{
int i, bottom_y;
struct glyph_row *row;
-
+
for (i = 0; i < w->current_matrix->nrows; ++i)
{
row = w->current_matrix->rows + i;
break;
else if (row->mode_line_p)
continue;
-
+
bottom_y = MATRIX_ROW_BOTTOM_Y (row);
if (row->overlapping_p && i > 0 && bottom_y < yb)
{
if (row->used[LEFT_MARGIN_AREA])
rif->fix_overlapping_area (w, row, LEFT_MARGIN_AREA);
-
+
if (row->used[TEXT_AREA])
rif->fix_overlapping_area (w, row, TEXT_AREA);
-
+
if (row->used[RIGHT_MARGIN_AREA])
rif->fix_overlapping_area (w, row, RIGHT_MARGIN_AREA);
extern Lisp_Object do_mouse_tracking;
#if GLYPH_DEBUG
struct frame *f = XFRAME (WINDOW_FRAME (w));
- extern struct frame *updating_frame;
#endif
/* Check that W's frame doesn't have glyph matrices. */
Adjust y-positions of other rows by the header line height. */
row = desired_matrix->rows;
end = row + desired_matrix->nrows - 1;
-
+
if (row->mode_line_p)
{
header_line_row = row;
be also completely empty matrices. */
while (row < end && !row->enabled_p)
++row;
-
+
/* Try reusing part of the display by copying. */
if (row < end && !desired_matrix->no_scrolling_p)
{
{
int vpos = MATRIX_ROW_VPOS (row, desired_matrix);
int i;
-
+
/* We'll have to play a little bit with when to
detect_input_pending. If it's done too often,
scrolling large windows with repeated scroll-up
/* Was display preempted? */
paused_p = row < end;
-
+
set_cursor:
-
+
/* Fix the appearance of overlapping/overlapped rows. */
if (!paused_p && !w->pseudo_window_p)
{
redraw_overlapped_rows (w, yb);
redraw_overlapping_rows (w, yb);
}
-
+
/* Make cursor visible at cursor position of W. */
set_window_cursor_after_update (w);
/* check_current_matrix_flags (w); */
add_window_display_history (w, w->current_matrix->method, paused_p);
#endif
-
+
clear_glyph_matrix (desired_matrix);
return paused_p;
/* Let functions in xterm.c know what area subsequent X positions
will be relative to. */
updated_area = TEXT_AREA;
-
+
/* If rows are at different X or Y, or rows have different height,
or the current row is marked invalid, write the entire line. */
if (!current_row->enabled_p
|| current_row->x != desired_row->x)
{
rif->cursor_to (vpos, 0, desired_row->y, desired_row->x);
-
+
if (desired_row->used[TEXT_AREA])
rif->write_glyphs (desired_row->glyphs[TEXT_AREA],
desired_row->used[TEXT_AREA]);
-
+
/* Clear to end of window. */
rif->clear_end_of_line (-1);
changed_p = 1;
+
+ /* This erases the cursor. We do this here because
+ notice_overwritten_cursor cannot easily check this, which
+ might indicate that the whole functionality of
+ notice_overwritten_cursor would better be implemented here.
+ On the other hand, we need notice_overwritten_cursor as long
+ as mouse highlighting is done asynchronously outside of
+ redisplay. */
+ if (vpos == w->phys_cursor.vpos)
+ w->phys_cursor_on_p = 0;
}
else
{
extension actually takes place. */
if (MATRIX_ROW_EXTENDS_FACE_P (desired_row))
--desired_stop_pos;
-
+
stop = min (current_row->used[TEXT_AREA], desired_stop_pos);
i = 0;
x = desired_row->x;
while (i < stop)
{
int can_skip_p = 1;
-
+
/* Skip over glyphs that both rows have in common. These
don't have to be written. We can't skip if the last
current glyph overlaps the glyph to its right. For
{
struct glyph *glyph = ¤t_row->glyphs[TEXT_AREA][i - 1];
int left, right;
-
+
rif->get_glyph_overhangs (glyph, XFRAME (w->frame),
&left, &right);
can_skip_p = right == 0;
}
-
+
if (can_skip_p)
{
while (i < stop
first `p' in the current row. If we would start
writing glyphs there, we wouldn't erase the lbearing
of the `p'. The rest of the lbearing problem is then
- taken care of by x_draw_glyphs. */
+ taken care of by draw_glyphs. */
if (overlapping_glyphs_p
&& i > 0
&& i < current_row->used[TEXT_AREA]
!= desired_row->used[TEXT_AREA]))
{
int left, right;
-
+
rif->get_glyph_overhangs (current_glyph, XFRAME (w->frame),
&left, &right);
while (left > 0 && i > 0)
}
}
}
-
+
/* Try to avoid writing the entire rest of the desired row
by looking for a resync point. This mainly prevents
mode line flickering in the case the mode line is in
changed_p = 1;
}
}
-
+
/* Write the rest. */
if (i < desired_row->used[TEXT_AREA])
{
rif->write_glyphs (desired_glyph, desired_row->used[TEXT_AREA] - i);
changed_p = 1;
}
-
+
/* Maybe clear to end of line. */
if (MATRIX_ROW_EXTENDS_FACE_P (desired_row))
{
/* Otherwise clear to the end of the old row. Everything
after that position should be clear already. */
int x;
-
+
if (i >= desired_row->used[TEXT_AREA])
rif->cursor_to (vpos, i, desired_row->y,
desired_row->x + desired_row->pixel_width);
know what line height values are in effect. */
updated_row = desired_row;
- /* A row can be completely invisible in case a desired matrix was
- built with a vscroll and then make_cursor_line_fully_visible shifts
+ /* A row can be completely invisible in case a desired matrix was
+ built with a vscroll and then make_cursor_line_fully_visible shifts
the matrix. Make sure to make such rows current anyway, since
we need the correct y-position, for example, in the current matrix. */
if (desired_row->mode_line_p
/* Update display of the left margin area, if there is one. */
if (!desired_row->full_width_p
- && !NILP (w->left_margin_width))
+ && !NILP (w->left_margin_cols))
{
changed_p = 1;
update_marginal_area (w, LEFT_MARGIN_AREA, vpos);
}
-
+
/* Update the display of the text area. */
if (update_text_area (w, vpos))
{
if (current_row->mouse_face_p)
*mouse_face_overwritten_p = 1;
}
-
+
/* Update display of the right margin area, if there is one. */
if (!desired_row->full_width_p
- && !NILP (w->right_margin_width))
+ && !NILP (w->right_margin_cols))
{
changed_p = 1;
update_marginal_area (w, RIGHT_MARGIN_AREA, vpos);
}
-
+
/* Draw truncation marks etc. */
if (!current_row->enabled_p
|| desired_row->y != current_row->y
!= MATRIX_ROW_CONTINUATION_LINE_P (current_row)))
rif->after_update_window_line_hook (desired_row);
}
-
+
/* Update current_row from desired_row. */
make_current (w->desired_matrix, w->current_matrix, vpos);
updated_row = NULL;
/* Not intended for frame matrix updates. */
xassert (FRAME_WINDOW_P (f));
-
+
if (cursor_in_echo_area
&& !NILP (echo_area_buffer[0])
/* If we are showing a message instead of the mini-buffer,
last_row = row;
++row;
}
-
+
if (last_row)
{
struct glyph *start = last_row->glyphs[TEXT_AREA];
while (last > start && last->charpos < 0)
--last;
-
+
for (glyph = start; glyph < last; ++glyph)
{
cx += glyph->pixel_width;
w = NILP (w->next) ? 0 : XWINDOW (w->next);
}
-}
+}
\f
{
/* Number of occurrences of this row in desired and current matrix. */
int old_uses, new_uses;
-
+
/* Vpos of row in new matrix. */
int new_line_number;
/* Bucket index of this row_entry in the hash table row_table. */
int bucket;
-
+
/* The row described by this entry. */
struct glyph_row *row;
-
+
/* Hash collision chain. */
struct row_entry *next;
};
{
struct row_entry *entry;
int i = row->hash % row_table_size;
-
+
entry = row_table[i];
while (entry && !row_equal_p (w, entry->row, row, 1))
entry = entry->next;
-
+
if (entry == NULL)
{
entry = row_entry_pool + row_entry_idx++;
/* Give up if some rows in the desired matrix are not enabled. */
if (!MATRIX_ROW (desired_matrix, i)->enabled_p)
return -1;
-
+
first_old = first_new = i;
/* Set last_new to the index + 1 of the last enabled row in the
return 0;
/* Reallocate vectors, tables etc. if necessary. */
-
+
if (current_matrix->nrows > old_lines_size)
{
old_lines_size = current_matrix->nrows;
nbytes = old_lines_size * sizeof *old_lines;
old_lines = (struct row_entry **) xrealloc (old_lines, nbytes);
}
-
+
if (desired_matrix->nrows > new_lines_size)
{
new_lines_size = desired_matrix->nrows;
/* Add rows from the current and desired matrix to the hash table
row_hash_table to be able to find equal ones quickly. */
-
+
for (i = first_old; i < last_old; ++i)
{
if (MATRIX_ROW (current_matrix, i)->enabled_p)
&& old_lines[j] == new_lines[k])
{
int h = MATRIX_ROW (current_matrix, j)->height;
- --run->current_vpos;
- --run->desired_vpos;
+ --run->current_vpos;
+ --run->desired_vpos;
++run->nrows;
run->height += h;
run->desired_y -= h;
&& old_lines[j] == new_lines[k])
{
int h = MATRIX_ROW (current_matrix, j)->height;
- ++run->nrows;
+ ++run->nrows;
run->height += h;
++j, ++k;
}
for (j = i + 1; j < nruns; ++j)
{
struct run *p = runs[j];
-
+
if ((p->current_y >= r->desired_y
&& p->current_y < r->desired_y + r->height)
|| (p->current_y + p->height >= r->desired_y
update_frame_line (f, i);
}
}
-
- pause = (i < FRAME_HEIGHT (f) - 1) ? i : 0;
+
+ pause = (i < FRAME_LINES (f) - 1) ? i : 0;
/* Now just clean up termcap drivers and set cursor, etc. */
if (!pause)
&& FRAME_HAS_MINIBUF_P (f)
&& EQ (FRAME_MINIBUF_WINDOW (f), echo_area_window))
{
- int top = XINT (XWINDOW (FRAME_MINIBUF_WINDOW (f))->top);
+ int top = WINDOW_TOP_EDGE_LINE (XWINDOW (FRAME_MINIBUF_WINDOW (f)));
int row, col;
if (cursor_in_echo_area < 0)
cursor at the end of the prompt. If the mini-buffer
is several lines high, find the last line that has
any text on it. */
- row = FRAME_HEIGHT (f);
- do
+ row = FRAME_LINES (f);
+ do
{
--row;
col = 0;
-
+
if (MATRIX_ROW_ENABLED_P (current_matrix, row))
{
/* Frame rows are filled up with spaces that
while (last > start
&& (last - 1)->charpos < 0)
--last;
-
+
col = last - start;
}
}
if (col >= FRAME_CURSOR_X_LIMIT (f))
{
/* If we have another row, advance cursor into it. */
- if (row < FRAME_HEIGHT (f) - 1)
+ if (row < FRAME_LINES (f) - 1)
{
- col = FRAME_LEFT_SCROLL_BAR_WIDTH (f);
+ col = FRAME_LEFT_SCROLL_BAR_COLS (f);
row++;
}
/* Otherwise move it back in range. */
with the cursor in the lower half of it. The window
is split, and a message causes a redisplay before
a new cursor position has been computed. */
- && w->cursor.vpos < XFASTINT (w->height))
+ && w->cursor.vpos < WINDOW_TOTAL_LINES (w))
{
int x = WINDOW_TO_FRAME_HPOS (w, w->cursor.hpos);
int y = WINDOW_TO_FRAME_VPOS (w, w->cursor.vpos);
- if (INTEGERP (w->left_margin_width))
- x += XFASTINT (w->left_margin_width);
-
- /* x = max (min (x, FRAME_WINDOW_WIDTH (f) - 1), 0); */
+ if (INTEGERP (w->left_margin_cols))
+ x += XFASTINT (w->left_margin_cols);
+
+ /* x = max (min (x, FRAME_TOTAL_COLS (f) - 1), 0); */
cursor_to (y, x);
}
}
int unchanged_at_top, unchanged_at_bottom;
int window_size;
int changed_lines;
- int *old_hash = (int *) alloca (FRAME_HEIGHT (frame) * sizeof (int));
- int *new_hash = (int *) alloca (FRAME_HEIGHT (frame) * sizeof (int));
- int *draw_cost = (int *) alloca (FRAME_HEIGHT (frame) * sizeof (int));
- int *old_draw_cost = (int *) alloca (FRAME_HEIGHT (frame) * sizeof (int));
+ int *old_hash = (int *) alloca (FRAME_LINES (frame) * sizeof (int));
+ int *new_hash = (int *) alloca (FRAME_LINES (frame) * sizeof (int));
+ int *draw_cost = (int *) alloca (FRAME_LINES (frame) * sizeof (int));
+ int *old_draw_cost = (int *) alloca (FRAME_LINES (frame) * sizeof (int));
register int i;
- int free_at_end_vpos = FRAME_HEIGHT (frame);
+ int free_at_end_vpos = FRAME_LINES (frame);
struct glyph_matrix *current_matrix = frame->current_matrix;
struct glyph_matrix *desired_matrix = frame->desired_matrix;
number of unchanged lines at the end. */
changed_lines = 0;
unchanged_at_top = 0;
- unchanged_at_bottom = FRAME_HEIGHT (frame);
- for (i = 0; i < FRAME_HEIGHT (frame); i++)
+ unchanged_at_bottom = FRAME_LINES (frame);
+ for (i = 0; i < FRAME_LINES (frame); i++)
{
/* Give up on this scrolling if some old lines are not enabled. */
if (!MATRIX_ROW_ENABLED_P (current_matrix, i))
if (old_hash[i] != new_hash[i])
{
changed_lines++;
- unchanged_at_bottom = FRAME_HEIGHT (frame) - i - 1;
+ unchanged_at_bottom = FRAME_LINES (frame) - i - 1;
}
else if (i == unchanged_at_top)
unchanged_at_top++;
/* If changed lines are few, don't allow preemption, don't scroll. */
if ((!scroll_region_ok && changed_lines < baud_rate / 2400)
- || unchanged_at_bottom == FRAME_HEIGHT (frame))
+ || unchanged_at_bottom == FRAME_LINES (frame))
return 1;
- window_size = (FRAME_HEIGHT (frame) - unchanged_at_top
+ window_size = (FRAME_LINES (frame) - unchanged_at_top
- unchanged_at_bottom);
if (scroll_region_ok)
if (!scroll_region_ok && window_size >= 18 && baud_rate > 2400
&& (window_size >=
10 * scrolling_max_lines_saved (unchanged_at_top,
- FRAME_HEIGHT (frame) - unchanged_at_bottom,
+ FRAME_LINES (frame) - unchanged_at_bottom,
old_hash, new_hash, draw_cost)))
return 0;
int len;
{
int i;
-
+
for (i = 0; i < len; ++i)
if (!CHAR_GLYPH_SPACE_P (r[i]))
break;
{
struct glyph *p1 = str1;
struct glyph *p2 = str2;
-
+
while (p1 < end1
&& p2 < end2
&& GLYPH_CHAR_AND_FACE_EQUAL_P (p1, p2))
++p1, ++p2;
-
+
return p1 - str1;
}
/* Char insertion/deletion cost vector, from term.c */
extern int *char_ins_del_vector;
-#define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_WINDOW_WIDTH((f))])
+#define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_TOTAL_COLS((f))])
/* Perform a frame-based update on line VPOS in frame FRAME. */
{
obody = MATRIX_ROW_GLYPH_START (current_matrix, vpos);
olen = current_row->used[TEXT_AREA];
-
+
/* Ignore trailing spaces, if we can. */
if (!write_spaces_p)
while (olen > 0 && CHAR_GLYPH_SPACE_P (obody[olen-1]))
cursor_to (vpos, 0);
write_glyphs (nbody, nlen);
}
-
+
/* Don't call clear_end_of_line if we already wrote the whole
line. The cursor will not be at the right margin in that
case but in the line below. */
- if (nlen < FRAME_WINDOW_WIDTH (f))
+ if (nlen < FRAME_TOTAL_COLS (f))
{
cursor_to (vpos, nlen);
- clear_end_of_line (FRAME_WINDOW_WIDTH (f));
+ clear_end_of_line (FRAME_TOTAL_COLS (f));
}
else
/* Make sure we are in the right row, otherwise cursor movement
with cmgoto might use `ch' in the wrong row. */
cursor_to (vpos, 0);
-
+
make_current (desired_matrix, current_matrix, vpos);
return;
}
|| !GLYPH_EQUAL_P (nbody + j, obody + j)
|| CHAR_GLYPH_PADDING_P (nbody[j])))
++j;
-
- /* Output this run of non-matching chars. */
+
+ /* Output this run of non-matching chars. */
cursor_to (vpos, i);
write_glyphs (nbody + i, j - i);
i = j - 1;
no need to do clear-to-eol at the end of this function
(and it would not be safe, since cursor is not going to
be "at the margin" after the text is done). */
- if (nlen == FRAME_WINDOW_WIDTH (f))
+ if (nlen == FRAME_TOTAL_COLS (f))
olen = 0;
/* Function write_glyphs is prepared to do nothing
int del;
cursor_to (vpos, nsp + begmatch);
-
+
/* Calculate columns we can actually overwrite. */
while (CHAR_GLYPH_PADDING_P (nbody[nsp + begmatch + out]))
out--;
write_glyphs (nbody + nsp + begmatch, out);
-
+
/* If we left columns to be overwritten, we must delete them. */
del = olen - tem - out;
if (del > 0)
delete_glyphs (del);
-
+
/* At last, we insert columns not yet written out. */
insert_glyphs (nbody + nsp + begmatch + out, nlen - olen + del);
olen = nlen;
CHARPOS (startp) = min (ZV, max (BEGV, CHARPOS (startp)));
BYTEPOS (startp) = min (ZV_BYTE, max (BEGV_BYTE, BYTEPOS (startp)));
start_display (&it, w, startp);
-
- left_area_width = WINDOW_DISPLAY_LEFT_AREA_PIXEL_WIDTH (w);
+
+ left_area_width = WINDOW_LEFT_MARGIN_WIDTH (w);
move_it_to (&it, -1, *x + it.first_visible_x - left_area_width, *y, -1,
MOVE_TO_X | MOVE_TO_Y);
-
+
*x = it.current_x - it.first_visible_x + left_area_width;
*y = it.current_y;
current_buffer = old_current_buffer;
the string returned. */
Lisp_Object
-mode_line_string (w, x, y, mode_line_p, charpos)
+mode_line_string (w, x, y, part, charpos)
struct window *w;
- int x, y, mode_line_p;
+ int x, y;
+ enum window_part part;
int *charpos;
{
struct glyph_row *row;
struct glyph *glyph, *end;
- struct frame *f = XFRAME (w->frame);
int x0;
Lisp_Object string = Qnil;
- if (mode_line_p)
+ if (part == ON_MODE_LINE)
row = MATRIX_MODE_LINE_ROW (w->current_matrix);
else
row = MATRIX_HEADER_LINE_ROW (w->current_matrix);
if (row->mode_line_p && row->enabled_p)
{
- /* The mode lines are displayed over scroll bars and fringes,
- and X is window-relative. Correct X by the scroll bar
- and fringe width. */
- if (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
- x += FRAME_SCROLL_BAR_COLS (f) * CANON_X_UNIT (f);
- x += FRAME_LEFT_FRINGE_WIDTH (f);
-
/* Find the glyph under X. If we find one with a string object,
it's the one we were looking for. */
glyph = row->glyphs[TEXT_AREA];
}
+/* Value is the string under window-relative coordinates X/Y in either
+ marginal area, or nil if none. *CHARPOS is set to the position in
+ the string returned. */
+
+Lisp_Object
+marginal_area_string (w, x, y, part, charpos)
+ struct window *w;
+ int x, y;
+ enum window_part part;
+ int *charpos;
+{
+ struct glyph_row *row = w->current_matrix->rows;
+ struct glyph *glyph, *end;
+ int x0, i, wy = y;
+ int area;
+ Lisp_Object string = Qnil;
+
+ if (part == ON_LEFT_MARGIN)
+ area = LEFT_MARGIN_AREA;
+ else if (part == ON_RIGHT_MARGIN)
+ area = RIGHT_MARGIN_AREA;
+ else
+ abort ();
+
+ for (i = 0; row->enabled_p && i < w->current_matrix->nrows; ++i, ++row)
+ if (wy >= row->y && wy < MATRIX_ROW_BOTTOM_Y (row))
+ break;
+
+ if (row->enabled_p)
+ {
+ /* Find the glyph under X. If we find one with a string object,
+ it's the one we were looking for. */
+ glyph = row->glyphs[area];
+ end = glyph + row->used[area];
+
+ if (area == RIGHT_MARGIN_AREA)
+ x0 = ((WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
+ ? WINDOW_LEFT_FRINGE_WIDTH (w)
+ : WINDOW_TOTAL_FRINGE_WIDTH (w))
+ + window_box_width (w, LEFT_MARGIN_AREA)
+ + window_box_width (w, TEXT_AREA));
+ else
+ x0 = (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
+ ? WINDOW_LEFT_FRINGE_WIDTH (w)
+ : 0);
+
+ for (; glyph < end; x0 += glyph->pixel_width, ++glyph)
+ if (x >= x0 && x < x0 + glyph->pixel_width)
+ {
+ string = glyph->object;
+ *charpos = glyph->charpos;
+ break;
+ }
+ }
+
+ return string;
+}
+
+
/***********************************************************************
Changing Frame Sizes
***********************************************************************/
/* If window_change_signal should have run before, run it now. */
if (redisplaying_p && !safe)
return;
-
+
while (delayed_size_change)
{
Lisp_Object tail, frame;
{
struct frame *f = XFRAME (frame);
- int height = FRAME_NEW_HEIGHT (f);
- int width = FRAME_NEW_WIDTH (f);
-
- if (height != 0 || width != 0)
- change_frame_size (f, height, width, 0, 0, safe);
+ if (f->new_text_lines != 0 || f->new_text_cols != 0)
+ change_frame_size (f, f->new_text_lines, f->new_text_cols,
+ 0, 0, safe);
}
}
}
/* Change the frame height and/or width. Values may be given as zero to
- indicate no change is to take place.
+ indicate no change is to take place.
If DELAY is non-zero, then assume we're being called from a signal
handler, and queue the change for later - perhaps the next
register struct frame *f;
int newheight, newwidth, pretend, delay, safe;
{
- int new_frame_window_width;
- int count = specpdl_ptr - specpdl;
+ int new_frame_total_cols;
+ int count = SPECPDL_INDEX ();
/* If we can't deal with the change now, queue it for later. */
if (delay || (redisplaying_p && !safe))
{
- FRAME_NEW_HEIGHT (f) = newheight;
- FRAME_NEW_WIDTH (f) = newwidth;
+ f->new_text_lines = newheight;
+ f->new_text_cols = newwidth;
delayed_size_change = 1;
return;
}
/* This size-change overrides any pending one for this frame. */
- FRAME_NEW_HEIGHT (f) = 0;
- FRAME_NEW_WIDTH (f) = 0;
+ f->new_text_lines = 0;
+ f->new_text_cols = 0;
/* If an argument is zero, set it to the current value. */
if (newheight == 0)
- newheight = FRAME_HEIGHT (f);
+ newheight = FRAME_LINES (f);
if (newwidth == 0)
- newwidth = FRAME_WIDTH (f);
+ newwidth = FRAME_COLS (f);
/* Compute width of windows in F.
This is the width of the frame without vertical scroll bars. */
- new_frame_window_width = FRAME_WINDOW_WIDTH_ARG (f, newwidth);
+ new_frame_total_cols = FRAME_TOTAL_COLS_ARG (f, newwidth);
/* Round up to the smallest acceptable size. */
check_frame_size (f, &newheight, &newwidth);
/* If we're not changing the frame size, quit now. */
- if (newheight == FRAME_HEIGHT (f)
- && new_frame_window_width == FRAME_WINDOW_WIDTH (f))
+ if (newheight == FRAME_LINES (f)
+ && new_frame_total_cols == FRAME_TOTAL_COLS (f))
return;
BLOCK_INPUT;
dos_set_window_size (&newheight, &newwidth);
#endif
- if (newheight != FRAME_HEIGHT (f))
+ if (newheight != FRAME_LINES (f))
{
if (FRAME_HAS_MINIBUF_P (f) && !FRAME_MINIBUF_ONLY_P (f))
{
/* Frame has both root and mini-buffer. */
- XSETFASTINT (XWINDOW (FRAME_ROOT_WINDOW (f))->top,
+ XSETFASTINT (XWINDOW (FRAME_ROOT_WINDOW (f))->top_line,
FRAME_TOP_MARGIN (f));
set_window_height (FRAME_ROOT_WINDOW (f),
(newheight
- 1
- FRAME_TOP_MARGIN (f)),
0);
- XSETFASTINT (XWINDOW (FRAME_MINIBUF_WINDOW (f))->top,
+ XSETFASTINT (XWINDOW (FRAME_MINIBUF_WINDOW (f))->top_line,
newheight - 1);
set_window_height (FRAME_MINIBUF_WINDOW (f), 1, 0);
}
FrameRows = newheight;
}
- if (new_frame_window_width != FRAME_WINDOW_WIDTH (f))
+ if (new_frame_total_cols != FRAME_TOTAL_COLS (f))
{
- set_window_width (FRAME_ROOT_WINDOW (f), new_frame_window_width, 0);
+ set_window_width (FRAME_ROOT_WINDOW (f), new_frame_total_cols, 0);
if (FRAME_HAS_MINIBUF_P (f))
- set_window_width (FRAME_MINIBUF_WINDOW (f), new_frame_window_width, 0);
+ set_window_width (FRAME_MINIBUF_WINDOW (f), new_frame_total_cols, 0);
if (FRAME_TERMCAP_P (f) && !pretend)
FrameCols = newwidth;
if (WINDOWP (f->tool_bar_window))
- XSETFASTINT (XWINDOW (f->tool_bar_window)->width, newwidth);
+ XSETFASTINT (XWINDOW (f->tool_bar_window)->total_cols, newwidth);
}
- FRAME_HEIGHT (f) = newheight;
- SET_FRAME_WIDTH (f, newwidth);
+ FRAME_LINES (f) = newheight;
+ SET_FRAME_COLS (f, newwidth);
{
struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f));
int text_area_x, text_area_y, text_area_width, text_area_height;
-
+
window_box (w, TEXT_AREA, &text_area_x, &text_area_y, &text_area_width,
&text_area_height);
if (w->cursor.x >= text_area_x + text_area_width)
/* This isn't quite a no-op: it runs window-configuration-change-hook. */
Fset_window_buffer (FRAME_SELECTED_WINDOW (f),
- XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer);
+ XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer, Qt);
unbind_to (count, Qnil);
}
if (! NILP (file))
{
file = Fexpand_file_name (file, Qnil);
- termscript = fopen (XSTRING (file)->data, "w");
+ termscript = fopen (SDATA (file), "w");
if (termscript == 0)
report_file_error ("Opening termscript", Fcons (file, Qnil));
}
{
/* ??? Perhaps we should do something special for multibyte strings here. */
CHECK_STRING (string);
- fwrite (XSTRING (string)->data, 1, STRING_BYTES (XSTRING (string)), stdout);
+ fwrite (SDATA (string), 1, SBYTES (string), stdout);
fflush (stdout);
if (termscript)
{
- fwrite (XSTRING (string)->data, 1, STRING_BYTES (XSTRING (string)),
+ fwrite (SDATA (string), 1, SBYTES (string),
termscript);
fflush (termscript);
}
#ifdef VMS
sys_sleep (sec);
#else /* not VMS */
-/* The reason this is done this way
+/* The reason this is done this way
(rather than defined (H_S) && defined (H_T))
is because the VMS preprocessor doesn't grok `defined'. */
#ifdef HAVE_SELECT
EMACS_GET_TIME (end_time);
EMACS_SET_SECS_USECS (timeout, sec, usec);
EMACS_ADD_TIME (end_time, end_time, timeout);
-
+
while (1)
{
EMACS_GET_TIME (timeout);
sleep (sec);
#endif /* HAVE_SELECT */
#endif /* not VMS */
-
+
immediate_quit = 0;
#endif /* no subprocesses */
swallow_events (display);
- if (detect_input_pending_run_timers (display))
+ if (detect_input_pending_run_timers (display) || !NILP (Vexecuting_macro))
return Qnil;
if (initial_display)
DEFUN ("sit-for", Fsit_for, Ssit_for, 1, 3, 0,
doc: /* Perform redisplay, then wait for SECONDS seconds or until input is available.
SECONDS may be a floating-point value, meaning that you can wait for a
-fraction of a second. Optional second arg MILLISECONDS specifies an
-additional wait period, in milliseconds; this may be useful if your
-Emacs was built without floating point support.
+fraction of a second.
\(Not all operating systems support waiting for a fraction of a second.)
-Optional third arg NODISP non-nil means don't redisplay, just wait for input.
+Optional arg NODISP non-nil means don't redisplay, just wait for input.
Redisplay is preempted as always if input arrives, and does not happen
if input is available before it starts.
-Value is t if waited the full time with no input arriving. */)
+Value is t if waited the full time with no input arriving.
+
+An obsolete but still supported form is
+\(sit-for SECONDS &optional MILLISECONDS NODISP)
+Where the optional arg MILLISECONDS specifies an additional wait period,
+in milliseconds; this was useful when Emacs was built without
+floating point support.
+usage: (sit-for SECONDS &optional NODISP OLD-NODISP) */)
+
+/* The `old-nodisp' stuff is there so that the arglist has the correct
+ length. Otherwise, `defdvice' will redefine it with fewer args. */
(seconds, milliseconds, nodisp)
Lisp_Object seconds, milliseconds, nodisp;
{
int sec, usec;
+ if (NILP (nodisp) && !NUMBERP (milliseconds))
+ { /* New style. */
+ nodisp = milliseconds;
+ milliseconds = Qnil;
+ }
+
if (NILP (milliseconds))
XSETINT (milliseconds, 0);
else
{
buf = XCDR (XCAR (tail));
/* Ignore buffers that aren't included in buffer lists. */
- if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
+ if (SREF (XBUFFER (buf)->name, 0) == ' ')
continue;
if (!EQ (*vecp++, buf))
goto changed;
{
buf = XCDR (XCAR (tail));
/* Ignore buffers that aren't included in buffer lists. */
- if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
+ if (SREF (XBUFFER (buf)->name, 0) == ' ')
continue;
*vecp++ = buf;
*vecp++ = XBUFFER (buf)->read_only;
display_arg = (display != 0 && *display != 0);
}
- if (!inhibit_window_system && display_arg
+ if (!inhibit_window_system && display_arg
#ifndef CANNOT_DUMP
&& initialized
#endif
#endif /* HAVE_X_WINDOWS */
#ifdef HAVE_NTGUI
- if (!inhibit_window_system)
+ if (!inhibit_window_system)
{
Vwindow_system = intern ("w32");
Vwindow_system_version = make_number (1);
}
#endif /* HAVE_NTGUI */
-#ifdef macintosh
- if (!inhibit_window_system)
+#ifdef MAC_OS
+ if (!inhibit_window_system)
{
Vwindow_system = intern ("mac");
Vwindow_system_version = make_number (1);
adjust_frame_glyphs_initially ();
return;
}
-#endif /* macintosh */
+#endif /* MAC_OS */
/* If no window system has been specified, try to use the terminal. */
if (! isatty (0))
*p = tolower (*p);
terminal_type = new;
- }
+ }
#endif /* VMS */
term_init (terminal_type);
-
+
{
struct frame *sf = SELECTED_FRAME ();
- int width = FRAME_WINDOW_WIDTH (sf);
- int height = FRAME_HEIGHT (sf);
+ int width = FRAME_TOTAL_COLS (sf);
+ int height = FRAME_LINES (sf);
unsigned int total_glyphs = height * (width + 2) * sizeof (struct glyph);
window = selected_window;
else
CHECK_WINDOW (window);
-
+
XWINDOW (window)->cursor_off_p = NILP (show);
}
Lisp_Object window;
{
struct window *w;
-
+
if (NILP (window))
window = selected_window;
else
CHECK_WINDOW (window);
-
+
w = XWINDOW (window);
- return w->cursor_off_p ? Qnil : Qt;
+ return w->cursor_off_p ? Qnil : Qt;
}
\f
doc: /* *The output baud rate of the terminal.
On most systems, changing this value will affect the amount of padding
and the other strategic decisions made during redisplay. */);
-
+
DEFVAR_BOOL ("inverse-video", &inverse_video,
doc: /* *Non-nil means invert the entire frame display.
This means everything is in inverse video which otherwise would not be. */);
-
+
DEFVAR_BOOL ("visible-bell", &visible_bell,
doc: /* *Non-nil means try to flash the frame to represent a bell.
See also `ring-bell-function'. */);
-
+
DEFVAR_BOOL ("no-redraw-on-reenter", &no_redraw_on_reenter,
doc: /* *Non-nil means no need to redraw entire frame after suspending.
A non-nil value is useful if the terminal can automatically preserve
Emacs's frame display when you reenter Emacs.
It is up to you to set this variable if your terminal can do that. */);
-
+
DEFVAR_LISP ("window-system", &Vwindow_system,
doc: /* Name of window system that Emacs is displaying through.
The value is a symbol--for instance, `x' for X windows.
The value is nil if Emacs is using a text-only terminal. */);
-
+
DEFVAR_LISP ("window-system-version", &Vwindow_system_version,
doc: /* The version number of the window system in use.
For X windows, this is 10 or 11. */);
-
+
DEFVAR_BOOL ("cursor-in-echo-area", &cursor_in_echo_area,
doc: /* Non-nil means put cursor in minibuffer, at end of any message there. */);
-
+
DEFVAR_LISP ("glyph-table", &Vglyph_table,
doc: /* Table defining how to output a glyph code to the frame.
If not nil, this is a vector indexed by glyph code to define the glyph.
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 *));
/* Assuming that GLYPH_SIMPLE_P (BASE, LEN, G) is 0,
return the length and the address of the character-sequence
used for outputting GLYPH G. */
-#define GLYPH_LENGTH(base,g) XSTRING (base[g])->size
-#define GLYPH_STRING(base,g) XSTRING (base[g])->data
+#define GLYPH_LENGTH(base,g) SCHARS (base[g])
+#define GLYPH_STRING(base,g) SDATA (base[g])
/* GLYPH for a space character. */
#include <sys/types.h>
#include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
-#ifdef USG5
+#ifdef HAVE_FCNTL_H
#include <fcntl.h>
#endif
#include "lisp.h"
#include "buffer.h"
#include "keyboard.h"
- #include "charset.h"
+ #include "character.h"
#include "keymap.h"
#ifdef HAVE_INDEX
(A negative integer is used for user variables, so we can distinguish
them without actually fetching the doc string.)
+ If the location does not point to the beginning of a docstring
+ (e.g. because the file has been modified and the location is stale),
+ return nil.
+
If UNIBYTE is nonzero, always make a unibyte string.
If DEFINITION is nonzero, assume this is for reading
if (!STRINGP (file))
return Qnil;
-
+
/* Put the file name in NAME as a C string.
If it is relative, combine it with Vdoc_directory. */
tem = Ffile_name_absolute_p (file);
if (NILP (tem))
{
- minsize = XSTRING (Vdoc_directory)->size;
+ minsize = SCHARS (Vdoc_directory);
/* sizeof ("../etc/") == 8 */
if (minsize < 8)
minsize = 8;
- name = (char *) alloca (minsize + XSTRING (file)->size + 8);
- strcpy (name, XSTRING (Vdoc_directory)->data);
- strcat (name, XSTRING (file)->data);
+ name = (char *) alloca (minsize + SCHARS (file) + 8);
+ strcpy (name, SDATA (Vdoc_directory));
+ strcat (name, SDATA (file));
munge_doc_file_name (name);
}
else
{
- name = (char *) XSTRING (file)->data;
+ name = (char *) SDATA (file);
}
fd = emacs_open (name, O_RDONLY, 0);
/* Preparing to dump; DOC file is probably not installed.
So check in ../etc. */
strcpy (name, "../etc/");
- strcat (name, XSTRING (file)->data);
+ strcat (name, SDATA (file));
munge_doc_file_name (name);
fd = emacs_open (name, O_RDONLY, 0);
}
/* Seek only to beginning of disk block. */
- offset = position % (8 * 1024);
+ /* Make sure we read at least 1024 bytes before `position'
+ so we can check the leading text for consistency. */
+ offset = min (position, max (1024, position % (8 * 1024)));
if (0 > lseek (fd, position - offset, 0))
{
emacs_close (fd);
}
emacs_close (fd);
+ /* Sanity checking. */
+ if (CONSP (filepos))
+ {
+ int test = 1;
+ if (get_doc_string_buffer[offset - test++] != ' ')
+ return Qnil;
+ while (get_doc_string_buffer[offset - test] >= '0'
+ && get_doc_string_buffer[offset - test] <= '9')
+ test++;
+ if (get_doc_string_buffer[offset - test++] != '@'
+ || get_doc_string_buffer[offset - test] != '#')
+ return Qnil;
+ }
+ else
+ {
+ int test = 1;
+ if (get_doc_string_buffer[offset - test++] != '\n')
+ return Qnil;
+ while (get_doc_string_buffer[offset - test] > ' ')
+ test++;
+ if (get_doc_string_buffer[offset - test] != '\037')
+ return Qnil;
+ }
+
/* Scan the text and perform quoting with ^A (char code 1).
^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
from = get_doc_string_buffer + offset;
return get_doc_string (filepos, 0, 1);
}
+static int
+reread_doc_file (file)
+ Lisp_Object file;
+{
+#if 0
+ Lisp_Object reply, prompt[3];
+ struct gcpro gcpro1;
+ GCPRO1 (file);
+ prompt[0] = build_string ("File ");
+ prompt[1] = NILP (file) ? Vdoc_file_name : file;
+ prompt[2] = build_string (" is out of sync. Reload? ");
+ reply = Fy_or_n_p (Fconcat (3, prompt));
+ UNGCPRO;
+ if (NILP (reply))
+ return 0;
+#endif
+
+ if (NILP (file))
+ Fsnarf_documentation (Vdoc_file_name);
+ else
+ Fload (file, Qt, Qt, Qt, Qnil);
+
+ return 1;
+}
+
DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
doc: /* Return the documentation string of FUNCTION.
Unless a non-nil second argument RAW is given, the
Lisp_Object fun;
Lisp_Object funcar;
Lisp_Object tem, doc;
+ int try_reload = 1;
+
+ documentation:
doc = Qnil;
-
+
if (SYMBOLP (function)
&& (tem = Fget (function, Qfunction_documentation),
!NILP (tem)))
return Fdocumentation_property (function, Qfunction_documentation, raw);
-
+
fun = Findirect_function (function);
if (SUBRP (fun))
{
Fsignal (Qinvalid_function, Fcons (fun, Qnil));
}
+ /* If DOC is 0, it's typically because of a dumped file missing
+ from the DOC file (bug in src/Makefile.in). */
+ if (EQ (doc, make_number (0)))
+ doc = Qnil;
if (INTEGERP (doc) || CONSP (doc))
- doc = get_doc_string (doc, 0, 0);
+ {
+ Lisp_Object tem;
+ tem = get_doc_string (doc, 0, 0);
+ if (NILP (tem) && try_reload)
+ {
+ /* The file is newer, we need to reset the pointers. */
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (function, raw);
+ try_reload = reread_doc_file (Fcar_safe (doc));
+ UNGCPRO;
+ if (try_reload)
+ {
+ try_reload = 0;
+ goto documentation;
+ }
+ }
+ else
+ doc = tem;
+ }
if (NILP (raw))
doc = Fsubstitute_command_keys (doc);
(symbol, prop, raw)
Lisp_Object symbol, prop, raw;
{
+ int try_reload = 1;
Lisp_Object tem;
+ documentation_property:
+
tem = Fget (symbol, prop);
+ if (EQ (tem, make_number (0)))
+ tem = Qnil;
if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
- tem = get_doc_string (tem, 0, 0);
+ {
+ Lisp_Object doc = tem;
+ tem = get_doc_string (tem, 0, 0);
+ if (NILP (tem) && try_reload)
+ {
+ /* The file is newer, we need to reset the pointers. */
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ GCPRO3 (symbol, prop, raw);
+ try_reload = reread_doc_file (Fcar_safe (doc));
+ UNGCPRO;
+ if (try_reload)
+ {
+ try_reload = 0;
+ goto documentation_property;
+ }
+ }
+ }
else if (!STRINGP (tem))
/* Feval protects its argument. */
tem = Feval (tem);
-
+
if (NILP (raw) && STRINGP (tem))
tem = Fsubstitute_command_keys (tem);
return tem;
Lisp_Object sym;
char *name;
-#ifndef CANNOT_DUMP
- if (NILP (Vpurify_flag))
- error ("Snarf-documentation can only be called in an undumped Emacs");
-#endif
-
CHECK_STRING (filename);
+ if
#ifndef CANNOT_DUMP
- name = (char *) alloca (XSTRING (filename)->size + 14);
- strcpy (name, "../etc/");
+ (!NILP (Vpurify_flag))
#else /* CANNOT_DUMP */
- CHECK_STRING (Vdoc_directory);
- name = (char *) alloca (XSTRING (filename)->size
- + XSTRING (Vdoc_directory)->size + 1);
- strcpy (name, XSTRING (Vdoc_directory)->data);
+ (0)
#endif /* CANNOT_DUMP */
- strcat (name, XSTRING (filename)->data); /*** Add this line ***/
+ {
+ name = (char *) alloca (SCHARS (filename) + 14);
+ strcpy (name, "../etc/");
+ }
+ else
+ {
+ CHECK_STRING (Vdoc_directory);
+ name = (char *) alloca (SCHARS (filename)
+ + SCHARS (Vdoc_directory) + 1);
+ strcpy (name, SDATA (Vdoc_directory));
+ }
+ strcat (name, SDATA (filename)); /*** Add this line ***/
#ifdef VMS
#ifndef VMS4_4
/* For VMS versions with limited file name syntax,
if (NILP (keymap))
keymap = Voverriding_local_map;
- bsize = STRING_BYTES (XSTRING (string));
+ bsize = SBYTES (string);
bufp = buf = (unsigned char *) xmalloc (bsize);
- strp = (unsigned char *) XSTRING (string)->data;
- while (strp < XSTRING (string)->data + STRING_BYTES (XSTRING (string)))
+ strp = SDATA (string);
+ while (strp < SDATA (string) + SBYTES (string))
{
if (strp[0] == '\\' && strp[1] == '=')
{
if (multibyte)
{
int len;
+ int maxlen = SDATA (string) + SBYTES (string) - strp;
STRING_CHAR_AND_LENGTH (strp, maxlen, len);
if (len == 1)
changed = 1;
strp += 2; /* skip \[ */
start = strp;
- start_idx = start - XSTRING (string)->data;
+ start_idx = start - SDATA (string);
- while ((strp - (unsigned char *) XSTRING (string)->data
- < STRING_BYTES (XSTRING (string)))
+ while ((strp - SDATA (string)
+ < SBYTES (string))
&& *strp != ']')
strp++;
length_byte = strp - start;
strp++; /* skip ] */
/* Save STRP in IDX. */
- idx = strp - (unsigned char *) XSTRING (string)->data;
+ idx = strp - SDATA (string);
tem = Fintern (make_string (start, length_byte), Qnil);
/* Note the Fwhere_is_internal can GC, so we have to take
relocation of string contents into account. */
tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil);
- strp = XSTRING (string)->data + idx;
- start = XSTRING (string)->data + start_idx;
+ strp = SDATA (string) + idx;
+ start = SDATA (string) + start_idx;
/* Disregard menu bar bindings; it is positively annoying to
mention them when there's no menu bar, and it isn't terribly
changed = 1;
strp += 2; /* skip \{ or \< */
start = strp;
- start_idx = start - XSTRING (string)->data;
+ start_idx = start - SDATA (string);
- while ((strp - (unsigned char *) XSTRING (string)->data
- < XSTRING (string)->size)
+ while ((strp - SDATA (string) < SCHARS (string))
&& *strp != '}' && *strp != '>')
strp++;
strp++; /* skip } or > */
/* Save STRP in IDX. */
- idx = strp - (unsigned char *) XSTRING (string)->data;
+ idx = strp - SDATA (string);
/* Get the value of the keymap in TEM, or nil if undefined.
Do this while still in the user's current buffer
{
tem = get_keymap (tem, 0, 1);
/* Note that get_keymap can GC. */
- strp = XSTRING (string)->data + idx;
- start = XSTRING (string)->data + start_idx;
+ strp = SDATA (string) + idx;
+ start = SDATA (string) + start_idx;
}
}
name = Fsymbol_name (name);
insert_string ("\nUses keymap \"");
insert_from_string (name, 0, 0,
- XSTRING (name)->size,
- STRING_BYTES (XSTRING (name)), 1);
+ SCHARS (name),
+ SBYTES (name), 1);
insert_string ("\", which is not currently defined.\n");
if (start[-1] == '<') keymap = Qnil;
}
set_buffer_internal (oldbuf);
subst_string:
- start = XSTRING (tem)->data;
- length = XSTRING (tem)->size;
- length_byte = STRING_BYTES (XSTRING (tem));
+ start = SDATA (tem);
+ length = SCHARS (tem);
+ length_byte = SBYTES (tem);
subst:
{
int offset = bufp - buf;
bufp += length_byte;
nchars += length;
/* Check STRING again in case gc relocated it. */
- strp = (unsigned char *) XSTRING (string)->data + idx;
+ strp = (unsigned char *) SDATA (string) + idx;
}
}
else if (! multibyte) /* just copy other chars */
else
{
int len;
+ int maxlen = SDATA (string) + SBYTES (string) - strp;
STRING_CHAR_AND_LENGTH (strp, maxlen, len);
if (len == 1)
{
Qfunction_documentation = intern ("function-documentation");
staticpro (&Qfunction_documentation);
-
+
DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
doc: /* Name of file containing documentation strings of built-in symbols. */);
Vdoc_file_name = Qnil;
/* 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 ();
terminated at position FORMAT_END.
Output goes in BUFFER, which has room for BUFSIZE chars.
If the output does not fit, truncate it to fit.
- Returns the number of characters stored into BUFFER.
+ Returns the number of bytes stored into BUFFER.
ARGS points to the vector of arguments, and NARGS says how many.
A double counts as two arguments.
String arguments are passed as C strings.
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
-
#include <config.h>
#ifdef MSDOS
#include "dosfns.h"
#include "msdos.h"
#include "dispextern.h"
- #include "charset.h"
+ #include "character.h"
#include "coding.h"
#include <dpmi.h>
#include <go32.h>
CHECK_NUMBER (interrupt);
no = (unsigned long) XINT (interrupt);
CHECK_VECTOR (registers);
- if (no < 0 || no > 0xff || XVECTOR (registers)-> size != 8)
+ if (no < 0 || no > 0xff || XVECTOR (registers)-> size != 8)
return Qnil;
for (i = 0; i < 8; i++)
CHECK_NUMBER (XVECTOR (registers)->contents[i]);
offs = (unsigned long) XINT (address);
CHECK_VECTOR (vector);
len = XVECTOR (vector)-> size;
- if (len < 1 || len > 2048 || address < 0 || address > 0xfffff - len)
+ if (len < 1 || len > 2048 || address < 0 || address > 0xfffff - len)
return Qnil;
buf = alloca (len);
dosmemget (offs, len, buf);
-
+
for (i = 0; i < len; i++)
XVECTOR (vector)->contents[i] = make_number (buf[i]);
offs = (unsigned long) XINT (address);
CHECK_VECTOR (vector);
len = XVECTOR (vector)-> size;
- if (len < 1 || len > 2048 || address < 0 || address > 0xfffff - len)
+ if (len < 1 || len > 2048 || address < 0 || address > 0xfffff - len)
return Qnil;
buf = alloca (len);
}
#endif
-
DEFUN ("msdos-mouse-init", Fmsdos_mouse_init, Smsdos_mouse_init, 0, 0, "",
doc: /* Initialize and enable mouse if available. */)
()
()
{
char *s;
- int rows, cols;
- int i, j;
-
+ int rows, cols, i, j;
+
if (!dos_get_saved_screen (&s, &rows, &cols))
return Qnil;
-
+
for (i = 0; i < rows; i++)
{
for (j = 0; j < cols; j++)
}
\f
/* country info */
-int dos_country_code;
-int dos_codepage;
-int dos_timezone_offset;
-int dos_decimal_point;
-int dos_keyboard_layout;
+EMACS_INT dos_country_code;
+EMACS_INT dos_codepage;
+EMACS_INT dos_timezone_offset;
+EMACS_INT dos_decimal_point;
+EMACS_INT dos_keyboard_layout;
unsigned char dos_country_info[DOS_COUNTRY_INFO];
static unsigned char usa_country_info[DOS_COUNTRY_INFO] = {
0, 0, /* date format */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /* reserved */
};
-int dos_hyper_key;
-int dos_super_key;
-int dos_keypad_mode;
+EMACS_INT dos_hyper_key;
+EMACS_INT dos_super_key;
+EMACS_INT dos_keypad_mode;
Lisp_Object Vdos_version;
Lisp_Object Vdos_display_scancodes;
delay (50);
}
#endif /* !HAVE_X_WINDOWS */
-
+
void
init_dosfns ()
{
intdos (®s, ®s);
if (regs.x.cflag)
/* Estimate code page from country code */
- switch (dos_country_code)
+ switch (dos_country_code)
{
case 45: /* Denmark */
case 47: /* Norway */
if (FRAME_MSDOS_P (f))
{
BLOCK_INPUT;
- w95_set_virtual_machine_title (XSTRING (name)->data);
+ w95_set_virtual_machine_title (SDATA (name));
UNBLOCK_INPUT;
}
}
filename = Fexpand_file_name (filename, Qnil);
encoded = ENCODE_FILE (filename);
- if (statfs (XSTRING (encoded)->data, &stfs))
+ if (statfs (SDATA (encoded), &stfs))
value = Qnil;
else
value = list3 (make_float ((double) stfs.f_bsize * stfs.f_blocks),
DEFVAR_INT ("dos-timezone-offset", &dos_timezone_offset,
doc: /* The current timezone offset to UTC in minutes.
Implicitly modified when the TZ variable is changed. */);
-
+
DEFVAR_LISP ("dos-version", &Vdos_version,
doc: /* The (MAJOR . MINOR) Dos version (subject to modification with setver). */);
The output format is: scan code:char code*modifiers. */);
Vdos_display_scancodes = Qnil;
-
+
DEFVAR_INT ("dos-hyper-key", &dos_hyper_key,
doc: /* *If set to 1, use right ALT key as hyper key.
If set to 2, use right CTRL key as hyper key. */);
dos_hyper_key = 0;
-
+
DEFVAR_INT ("dos-super-key", &dos_super_key,
doc: /* *If set to 1, use right ALT key as super key.
If set to 2, use right CTRL key as super key. */);
dos_super_key = 0;
-
+
DEFVAR_INT ("dos-keypad-mode", &dos_keypad_mode,
doc: /* *Controls what key code is returned by a key in the numeric keypad.
The `numlock ON' action is only taken if no modifier keys are pressed.
0x200 ALT-0..ALT-9 in top-row produces shifted codes. */);
dos_keypad_mode = 0x75;
-
+
DEFVAR_INT ("dos-keyboard-layout", &dos_keyboard_layout,
doc: /* Contains the country code for the current keyboard layout.
Use msdos-set-keyboard to select another keyboard layout. */);
dos_keyboard_layout = 1; /* US */
-
+
DEFVAR_INT ("dos-decimal-point", &dos_decimal_point,
doc: /* The character to produce when kp-decimal key is pressed.
If non-zero, this variable contains the character to be returned when the
/* Lisp functions pertaining to editing.
- Copyright (C) 1985,86,87,89,93,94,95,96,97,98, 1999, 2000, 2001
+ Copyright (C) 1985,86,87,89,93,94,95,96,97,98, 1999, 2000, 2001, 02, 2003
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <unistd.h>
#endif
+/* Without this, sprintf on Mac OS Classic will produce wrong
+ result. */
+#ifdef MAC_OS8
+#include <stdio.h>
+#endif
+
#include <ctype.h>
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
- #include "charset.h"
+ #include "character.h"
#include "coding.h"
#include "frame.h"
#include "window.h"
static int lisp_time_argument P_ ((Lisp_Object, time_t *, int *));
static size_t emacs_memftimeu P_ ((char *, size_t, const char *,
size_t, const struct tm *, int));
-static void general_insert_function P_ ((void (*) (unsigned char *, int),
+static void general_insert_function P_ ((void (*) (const unsigned char *, int),
void (*) (Lisp_Object, int, int, int,
int, int),
int, int, Lisp_Object *));
CHECK_NUMBER (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);
}
register Lisp_Object string;
{
register Lisp_Object val;
- register struct Lisp_String *p;
CHECK_STRING (string);
- p = XSTRING (string);
- if (p->size)
+ if (SCHARS (string))
{
if (STRING_MULTIBYTE (string))
- XSETFASTINT (val, STRING_CHAR (p->data, STRING_BYTES (p)));
+ XSETFASTINT (val, STRING_CHAR (SDATA (string), SBYTES (string)));
else
- XSETFASTINT (val, p->data[0]);
+ XSETFASTINT (val, SREF (string, 0));
}
else
XSETFASTINT (val, 0);
{
extern Lisp_Object Vmark_even_if_inactive; /* Defined in callint.c. */
Lisp_Object m;
-
+
if (!NILP (Vtransient_mark_mode)
&& NILP (Vmark_even_if_inactive)
&& NILP (current_buffer->mark_active))
Fsignal (Qmark_inactive, Qnil);
-
+
m = Fmarker_position (current_buffer->mark);
if (NILP (m))
error ("The mark is not set now, so there is no region");
-
+
if ((PT < XFASTINT (m)) == beginningp)
m = make_number (PT);
return m;
}
\f
-#if 0 /* Not used. */
-
-/* Return nonzero if POS1 and POS2 have the same value
- for the text property PROP. */
+/* Find all the overlays in the current buffer that touch position POS.
+ Return the number found, and store them in a vector in VEC
+ of length LEN. */
static int
-char_property_eq (prop, pos1, pos2)
- Lisp_Object prop;
- Lisp_Object pos1, pos2;
+overlays_around (pos, vec, len)
+ int pos;
+ Lisp_Object *vec;
+ int len;
{
- Lisp_Object pval1, pval2;
-
- pval1 = Fget_char_property (pos1, prop, Qnil);
- pval2 = Fget_char_property (pos2, prop, Qnil);
+ Lisp_Object overlay, start, end;
+ struct Lisp_Overlay *tail;
+ int startpos, endpos;
+ int idx = 0;
- return EQ (pval1, pval2);
-}
+ for (tail = current_buffer->overlays_before; tail; tail = tail->next)
+ {
+ XSETMISC (overlay, tail);
+
+ end = OVERLAY_END (overlay);
+ endpos = OVERLAY_POSITION (end);
+ if (endpos < pos)
+ break;
+ start = OVERLAY_START (overlay);
+ startpos = OVERLAY_POSITION (start);
+ if (startpos <= pos)
+ {
+ if (idx < len)
+ vec[idx] = overlay;
+ /* Keep counting overlays even if we can't return them all. */
+ idx++;
+ }
+ }
-#endif /* 0 */
+ for (tail = current_buffer->overlays_after; tail; tail = tail->next)
+ {
+ XSETMISC (overlay, tail);
+
+ start = OVERLAY_START (overlay);
+ startpos = OVERLAY_POSITION (start);
+ if (pos < startpos)
+ break;
+ end = OVERLAY_END (overlay);
+ endpos = OVERLAY_POSITION (end);
+ if (pos <= endpos)
+ {
+ if (idx < len)
+ vec[idx] = overlay;
+ idx++;
+ }
+ }
-/* Return the direction from which the text-property PROP would be
- inherited by any new text inserted at POS: 1 if it would be
- inherited from the char after POS, -1 if it would be inherited from
- the char before POS, and 0 if from neither. */
+ return idx;
+}
-static int
-text_property_stickiness (prop, pos)
- Lisp_Object prop;
- Lisp_Object pos;
+/* Return the value of property PROP, in OBJECT at POSITION.
+ It's the value of PROP that a char inserted at POSITION would get.
+ OBJECT is optional and defaults to the current buffer.
+ If OBJECT is a buffer, then overlay properties are considered as well as
+ text properties.
+ If OBJECT is a window, then that window's buffer is used, but
+ window-specific overlays are considered only if they are associated
+ with OBJECT. */
+Lisp_Object
+get_pos_property (position, prop, object)
+ Lisp_Object position, object;
+ register Lisp_Object prop;
{
- Lisp_Object prev_pos, front_sticky;
- int is_rear_sticky = 1, is_front_sticky = 0; /* defaults */
+ CHECK_NUMBER_COERCE_MARKER (position);
+
+ if (NILP (object))
+ XSETBUFFER (object, current_buffer);
+ else if (WINDOWP (object))
+ object = XWINDOW (object)->buffer;
- if (XINT (pos) > BEGV)
- /* Consider previous character. */
+ if (!BUFFERP (object))
+ /* pos-property only makes sense in buffers right now, since strings
+ have no overlays and no notion of insertion for which stickiness
+ could be obeyed. */
+ return Fget_text_property (position, prop, object);
+ else
{
- Lisp_Object rear_non_sticky;
+ int posn = XINT (position);
+ int noverlays;
+ Lisp_Object *overlay_vec, tem;
+ struct buffer *obuf = current_buffer;
- prev_pos = make_number (XINT (pos) - 1);
- rear_non_sticky = Fget_text_property (prev_pos, Qrear_nonsticky, Qnil);
+ set_buffer_temp (XBUFFER (object));
- if (!NILP (CONSP (rear_non_sticky)
- ? Fmemq (prop, rear_non_sticky)
- : rear_non_sticky))
- /* PROP is rear-non-sticky. */
- is_rear_sticky = 0;
- }
+ /* First try with room for 40 overlays. */
+ noverlays = 40;
+ overlay_vec = (Lisp_Object *) alloca (noverlays * sizeof (Lisp_Object));
+ noverlays = overlays_around (posn, overlay_vec, noverlays);
- /* Consider following character. */
- front_sticky = Fget_text_property (pos, Qfront_sticky, Qnil);
+ /* If there are more than 40,
+ make enough space for all, and try again. */
+ if (noverlays > 40)
+ {
+ overlay_vec = (Lisp_Object *) alloca (noverlays * sizeof (Lisp_Object));
+ noverlays = overlays_around (posn, overlay_vec, noverlays);
+ }
+ noverlays = sort_overlays (overlay_vec, noverlays, NULL);
- if (EQ (front_sticky, Qt)
- || (CONSP (front_sticky)
- && !NILP (Fmemq (prop, front_sticky))))
- /* PROP is inherited from after. */
- is_front_sticky = 1;
+ set_buffer_temp (obuf);
- /* Simple cases, where the properties are consistent. */
- if (is_rear_sticky && !is_front_sticky)
- return -1;
- else if (!is_rear_sticky && is_front_sticky)
- return 1;
- else if (!is_rear_sticky && !is_front_sticky)
- return 0;
+ /* Now check the overlays in order of decreasing priority. */
+ while (--noverlays >= 0)
+ {
+ Lisp_Object ol = overlay_vec[noverlays];
+ tem = Foverlay_get (ol, prop);
+ if (!NILP (tem))
+ {
+ /* Check the overlay is indeed active at point. */
+ Lisp_Object start = OVERLAY_START (ol), finish = OVERLAY_END (ol);
+ if ((OVERLAY_POSITION (start) == posn
+ && XMARKER (start)->insertion_type == 1)
+ || (OVERLAY_POSITION (finish) == posn
+ && XMARKER (finish)->insertion_type == 0))
+ ; /* The overlay will not cover a char inserted at point. */
+ else
+ {
+ return tem;
+ }
+ }
+ }
- /* The stickiness properties are inconsistent, so we have to
- disambiguate. Basically, rear-sticky wins, _except_ if the
- property that would be inherited has a value of nil, in which case
- front-sticky wins. */
- if (XINT (pos) == BEGV || NILP (Fget_text_property (prev_pos, prop, Qnil)))
- return 1;
- else
- return -1;
+ { /* Now check the text-properties. */
+ int stickiness = text_property_stickiness (prop, position, object);
+ if (stickiness > 0)
+ return Fget_text_property (position, prop, object);
+ else if (stickiness < 0
+ && XINT (position) > BUF_BEGV (XBUFFER (object)))
+ return Fget_text_property (make_number (XINT (position) - 1),
+ prop, object);
+ else
+ return Qnil;
+ }
+ }
}
-\f
/* Find the field surrounding POS in *BEG and *END. If POS is nil,
the value of point is used instead. If BEG or END null,
means don't store the beginning or end of the field.
{
/* Fields right before and after the point. */
Lisp_Object before_field, after_field;
- /* If the fields came from overlays, the associated overlays.
- Qnil means they came from text-properties. */
- Lisp_Object before_overlay = Qnil, after_overlay = Qnil;
/* 1 if POS counts as the start of a field. */
int at_field_start = 0;
/* 1 if POS counts as the end of a field. */
CHECK_NUMBER_COERCE_MARKER (pos);
after_field
- = get_char_property_and_overlay (pos, Qfield, Qnil, &after_overlay);
+ = get_char_property_and_overlay (pos, Qfield, Qnil, NULL);
before_field
= (XFASTINT (pos) > BEGV
? get_char_property_and_overlay (make_number (XINT (pos) - 1),
- Qfield, Qnil,
- &before_overlay)
+ Qfield, Qnil, NULL)
: Qnil);
/* See if we need to handle the case where MERGE_AT_BOUNDARY is nil
MERGE_AT_BOUNDARY is non-nil (see function comment) is actually the
more natural one; then we avoid treating the beginning of a field
specially. */
- if (NILP (merge_at_boundary) && !EQ (after_field, before_field))
- /* We are at a boundary, see which direction is inclusive. We
- decide by seeing which field the `field' property sticks to. */
- {
- /* -1 means insertions go into before_field, 1 means they go
- into after_field, 0 means neither. */
- int stickiness;
- /* Whether the before/after_field come from overlays. */
- int bop = !NILP (before_overlay);
- int aop = !NILP (after_overlay);
-
- if (bop && XMARKER (OVERLAY_END (before_overlay))->insertion_type == 1)
- /* before_field is from an overlay, which expands upon
- end-insertions. Note that it's possible for after_overlay to
- also eat insertions here, but then they will overlap, and
- there's not much we can do. */
- stickiness = -1;
- else if (aop
- && XMARKER (OVERLAY_START (after_overlay))->insertion_type == 0)
- /* after_field is from an overlay, which expand to contain
- start-insertions. */
- stickiness = 1;
- else if (bop && aop)
- /* Both fields come from overlays, but neither will contain any
- insertion here. */
- stickiness = 0;
- else if (bop)
- /* before_field is an overlay that won't eat any insertion, but
- after_field is from a text-property. Assume that the
- text-property continues underneath the overlay, and so will
- be inherited by any insertion, regardless of any stickiness
- settings. */
- stickiness = 1;
- else if (aop)
- /* Similarly, when after_field is the overlay. */
- stickiness = -1;
- else
- /* Both fields come from text-properties. Look for explicit
- stickiness properties. */
- stickiness = text_property_stickiness (Qfield, pos);
-
- if (stickiness > 0)
- at_field_start = 1;
- else if (stickiness < 0)
+ if (NILP (merge_at_boundary))
+ {
+ Lisp_Object field = get_pos_property (pos, Qfield, Qnil);
+ if (!EQ (field, after_field))
at_field_end = 1;
- else
- /* STICKINESS == 0 means that any inserted text will get a
- `field' char-property of nil, so check to see if that
- matches either of the adjacent characters (this being a
- kind of "stickiness by default"). */
- {
- if (NILP (before_field))
- at_field_end = 1; /* Sticks to the left. */
- else if (NILP (after_field))
- at_field_start = 1; /* Sticks to the right. */
- }
+ if (!EQ (field, before_field))
+ at_field_start = 1;
+ if (NILP (field) && at_field_start && at_field_end)
+ /* If an inserted char would have a nil field while the surrounding
+ text is non-nil, we're probably not looking at a
+ zero-length field, but instead at a non-nil field that's
+ not intended for editing (such as comint's prompts). */
+ at_field_end = at_field_start = 0;
}
/* Note about special `boundary' fields:
else
/* Find the previous field boundary. */
{
+ Lisp_Object p = pos;
if (!NILP (merge_at_boundary) && EQ (before_field, Qboundary))
/* Skip a `boundary' field. */
- pos = Fprevious_single_char_property_change (pos, Qfield, Qnil,
- beg_limit);
-
- pos = Fprevious_single_char_property_change (pos, Qfield, Qnil,
+ p = Fprevious_single_char_property_change (p, Qfield, Qnil,
beg_limit);
- *beg = NILP (pos) ? BEGV : XFASTINT (pos);
+
+ p = Fprevious_single_char_property_change (p, Qfield, Qnil,
+ beg_limit);
+ *beg = NILP (p) ? BEGV : XFASTINT (p);
}
}
/* Point marker. */
tem = XCAR (info);
Fgoto_char (tem);
- unchain_marker (tem);
+ unchain_marker (XMARKER (tem));
/* Mark marker. */
info = XCDR (info);
omark = Fmarker_position (current_buffer->mark);
Fset_marker (current_buffer->mark, tem, Fcurrent_buffer ());
nmark = Fmarker_position (tem);
- unchain_marker (tem);
+ unchain_marker (XMARKER (tem));
/* visible */
info = XCDR (info);
visible_p = !NILP (XCAR (info));
-
+
#if 0 /* We used to make the current buffer visible in the selected window
if that was true previously. That avoids some anomalies.
But it creates others, and it wasn't documented, and it is simpler
Lisp_Object args;
{
register Lisp_Object val;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
record_unwind_protect (save_excursion_restore, save_excursion_save ());
Lisp_Object args;
{
Lisp_Object val;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
else if (NUMBERP (uid))
pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid));
else if (STRINGP (uid))
- pw = (struct passwd *) getpwnam (XSTRING (uid)->data);
+ pw = (struct passwd *) getpwnam (SDATA (uid));
else
error ("Invalid UID specification");
full = make_string (p, q ? q - p : strlen (p));
#ifdef AMPERSAND_FULL_NAME
- p = XSTRING (full)->data;
+ p = SDATA (full);
q = (unsigned char *) index (p, '&');
/* Substitute the login name for the &, upcasing the first character. */
if (q)
Lisp_Object login;
login = Fuser_login_name (make_number (pw->pw_uid));
- r = (unsigned char *) alloca (strlen (p) + XSTRING (login)->size + 1);
+ r = (unsigned char *) alloca (strlen (p) + SCHARS (login) + 1);
bcopy (p, r, q - p);
r[q - p] = 0;
- strcat (r, XSTRING (login)->data);
+ strcat (r, SDATA (login));
r[q - p] = UPCASE (r[q - p]);
strcat (r, q + 1);
full = build_string (r);
get_system_name ()
{
if (STRINGP (Vsystem_name))
- return (char *) XSTRING (Vsystem_name)->data;
+ return (char *) SDATA (Vsystem_name);
else
return "";
}
Certain flags and modifiers are available with some format controls.
The flags are `_', `-', `^' and `#'. For certain characters X,
%_X is like %X, but padded with blanks; %-X is like %X,
-ut without padding. %^X is like %X but with all textual
-characters up-cased; %#X is like %X but with letter-case of
+but without padding. %^X is like %X, but with all textual
+characters up-cased; %#X is like %X, but with letter-case of
all textual characters reversed.
%NX (where N stands for an integer) is like %X,
but takes up at least N (a number) positions.
Vlocale_coding_system, 1);
/* This is probably enough. */
- size = STRING_BYTES (XSTRING (format_string)) * 6 + 50;
+ size = SBYTES (format_string) * 6 + 50;
tm = ut ? gmtime (&value) : localtime (&value);
if (! tm)
int result;
buf[0] = '\1';
- result = emacs_memftimeu (buf, size, XSTRING (format_string)->data,
- STRING_BYTES (XSTRING (format_string)),
+ result = emacs_memftimeu (buf, size, SDATA (format_string),
+ SBYTES (format_string),
tm, ut);
if ((result > 0 && result < size) || (result == 0 && buf[0] == '\0'))
return code_convert_string_norecord (make_string (buf, result),
/* If buffer was too small, make it bigger and try again. */
result = emacs_memftimeu (NULL, (size_t) -1,
- XSTRING (format_string)->data,
- STRING_BYTES (XSTRING (format_string)),
+ SDATA (format_string),
+ SBYTES (format_string),
tm, ut);
size = result + 1;
}
if (EQ (zone, Qt))
tzstring = "UTC0";
else if (STRINGP (zone))
- tzstring = (char *) XSTRING (zone)->data;
+ tzstring = (char *) SDATA (zone);
else if (INTEGERP (zone))
{
int abszone = abs (XINT (zone));
else
{
CHECK_STRING (tz);
- tzstring = (char *) XSTRING (tz)->data;
+ tzstring = (char *) SDATA (tz);
}
set_time_zone_rule (tzstring);
static void
general_insert_function (insert_func, insert_from_string_func,
inherit, nargs, args)
- void (*insert_func) P_ ((unsigned char *, int));
+ void (*insert_func) P_ ((const unsigned char *, int));
void (*insert_from_string_func) P_ ((Lisp_Object, int, int, int, int, int));
int inherit, nargs;
register Lisp_Object *args;
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;
else if (STRINGP (val))
{
(*insert_from_string_func) (val, 0, 0,
- XSTRING (val)->size,
- STRING_BYTES (XSTRING (val)),
+ SCHARS (val),
+ SBYTES (val),
inherit);
}
else
Any other markers at the point of insertion remain before the text.
If the current buffer is multibyte, unibyte strings are converted
-to multibyte for insertion (see `unibyte-char-to-multibyte').
+to multibyte for insertion (see `string-make-multibyte').
If the current buffer is unibyte, multibyte strings are converted
-to unibyte for insertion.
+to unibyte for insertion (see `string-make-unibyte').
+
+When operating on binary data, it may be necessary to preserve the
+original bytes of a unibyte string when inserting it into a multibyte
+buffer; to accomplish this, apply `string-as-multibyte' to the string
+and insert the result.
usage: (insert &rest ARGS) */)
(nargs, args)
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. */
result = make_uninit_multibyte_string (end - start, end_byte - start_byte);
else
result = make_uninit_string (end - start);
- bcopy (BYTE_POS_ADDR (start_byte), XSTRING (result)->data,
+ bcopy (BYTE_POS_ADDR (start_byte), SDATA (result),
end_byte - start_byte);
/* If desired, update and copy the text properties. */
int changed = 0;
unsigned char fromstr[MAX_MULTIBYTE_LENGTH], tostr[MAX_MULTIBYTE_LENGTH];
unsigned char *p;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
#define COMBINING_NO 0
#define COMBINING_BEFORE 1
#define COMBINING_AFTER 2
validate_region (&start, &end);
CHECK_STRING (table);
- size = STRING_BYTES (XSTRING (table));
- tt = XSTRING (table)->data;
+ size = SBYTES (table);
+ tt = SDATA (table);
pos_byte = CHAR_TO_BYTE (XINT (start));
stop = CHAR_TO_BYTE (XINT (end));
struct Lisp_Marker *end = XMARKER (XCDR (data));
struct buffer *buf = beg->buffer; /* END should have the same buffer. */
- if (beg->charpos != BUF_BEGV(buf) || end->charpos != BUF_ZV(buf))
+ if (buf /* Verify marker still points to a buffer. */
+ && (beg->charpos != BUF_BEGV (buf) || end->charpos != BUF_ZV (buf)))
/* The restriction has changed from the saved one, so restore
the saved restriction. */
{
/* The point is outside the new visible range, move it inside. */
SET_BUF_PT_BOTH (buf,
clip_to_bounds (beg->charpos, pt, end->charpos),
- clip_to_bounds (beg->bytepos, BUF_PT_BYTE(buf),
+ clip_to_bounds (beg->bytepos, BUF_PT_BYTE (buf),
end->bytepos));
-
+
buf->clip_changed = 1; /* Remember that the narrowing changed. */
}
}
{
struct buffer *buf = XBUFFER (data);
- if (BUF_BEGV(buf) != BUF_BEG(buf) || BUF_ZV(buf) != BUF_Z(buf))
+ if (buf /* Verify marker still points to a buffer. */
+ && (BUF_BEGV (buf) != BUF_BEG (buf) || BUF_ZV (buf) != BUF_Z (buf)))
/* The buffer has been narrowed, get rid of the narrowing. */
{
- SET_BUF_BEGV_BOTH (buf, BUF_BEG(buf), BUF_BEG_BYTE(buf));
- SET_BUF_ZV_BOTH (buf, BUF_Z(buf), BUF_Z_BYTE(buf));
+ SET_BUF_BEGV_BOTH (buf, BUF_BEG (buf), BUF_BEG_BYTE (buf));
+ SET_BUF_ZV_BOTH (buf, BUF_Z (buf), BUF_Z_BYTE (buf));
buf->clip_changed = 1; /* Remember that the narrowing changed. */
}
Lisp_Object body;
{
register Lisp_Object val;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
record_unwind_protect (save_restriction_restore, save_restriction_save ());
val = Fprogn (body);
int nargs;
Lisp_Object *args;
{
- if (NILP (args[0]))
+ if (NILP (args[0])
+ || (STRINGP (args[0])
+ && SBYTES (args[0]) == 0))
{
message (0);
return Qnil;
{
register Lisp_Object val;
val = Fformat (nargs, args);
- message3 (val, STRING_BYTES (XSTRING (val)), STRING_MULTIBYTE (val));
+ message3 (val, SBYTES (val), STRING_MULTIBYTE (val));
return val;
}
}
message_text = (char *)xmalloc (80);
message_length = 80;
}
- if (STRING_BYTES (XSTRING (val)) > message_length)
+ if (SBYTES (val) > message_length)
{
- message_length = STRING_BYTES (XSTRING (val));
+ message_length = SBYTES (val);
message_text = (char *)xrealloc (message_text, message_length);
}
- bcopy (XSTRING (val)->data, message_text, STRING_BYTES (XSTRING (val)));
- message2 (message_text, STRING_BYTES (XSTRING (val)),
+ bcopy (SDATA (val), message_text, SBYTES (val));
+ message2 (message_text, SBYTES (val),
STRING_MULTIBYTE (val));
return val;
}
}
Fadd_text_properties (make_number (0),
- make_number (XSTRING (string)->size),
+ make_number (SCHARS (string)),
properties, string);
RETURN_UNGCPRO (string);
}
#define CONVERTED_BYTE_SIZE(MULTIBYTE, STRING) \
(((MULTIBYTE) && ! STRING_MULTIBYTE (STRING)) \
- ? count_size_as_multibyte (XSTRING (STRING)->data, \
- STRING_BYTES (XSTRING (STRING))) \
- : STRING_BYTES (XSTRING (STRING)))
+ ? count_size_as_multibyte (SDATA (STRING), SBYTES (STRING)) \
+ : SBYTES (STRING))
DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
doc: /* Format a string out of a control-string and arguments.
register int n; /* The number of the next arg to substitute */
register int total; /* An estimate of the final length */
char *buf, *p;
- register unsigned char *format, *end;
+ register unsigned char *format, *end, *format_start;
int nchars;
/* Nonzero if the output should be a multibyte string,
which is true if any of the inputs is one. */
must consider such a situation or not. */
int maybe_combine_byte;
unsigned char *this_format;
+ /* Precision for each spec, or -1, a flag value meaning no precision
+ was given in that spec. Element 0, corresonding to the format
+ string itself, will not be used. Element NARGS, corresponding to
+ no argument, *will* be assigned to in the case that a `%' and `.'
+ occur after the final format specifier. */
+ int *precision = (int *) (alloca(nargs * sizeof (int)));
int longest_format;
Lisp_Object val;
+ int arg_intervals = 0;
+
+ /* discarded[I] is 1 if byte I of the format
+ string was not copied into the output.
+ It is 2 if byte I was not the first byte of its character. */
+ char *discarded;
+
+ /* Each element records, for one argument,
+ the start and end bytepos in the output string,
+ and whether the argument is a string with intervals.
+ info[0] is unused. Unused elements have -1 for start. */
struct info
{
- int start, end;
+ int start, end, intervals;
} *info = 0;
/* It should not be necessary to GCPRO ARGS, because
because of an object that we will pass through prin1,
and in that case, we won't know it here. */
for (n = 0; n < nargs; n++)
- if (STRINGP (args[n]) && STRING_MULTIBYTE (args[n]))
- multibyte = 1;
+ {
+ if (STRINGP (args[n]) && STRING_MULTIBYTE (args[n]))
+ multibyte = 1;
+ /* Piggyback on this loop to initialize precision[N]. */
+ precision[n] = -1;
+ }
CHECK_STRING (args[0]);
+ /* We may have to change "%S" to "%s". */
+ args[0] = Fcopy_sequence (args[0]);
+
+ /* GC should never happen here, so abort if it does. */
+ abort_on_gc++;
/* If we start out planning a unibyte result,
- and later find it has to be multibyte, we jump back to retry. */
+ then discover it has to be multibyte, we jump back to retry.
+ That can only happen from the first large while loop below. */
retry:
- format = XSTRING (args[0])->data;
- end = format + STRING_BYTES (XSTRING (args[0]));
+ format = SDATA (args[0]);
+ format_start = format;
+ end = format + SBYTES (args[0]);
longest_format = 0;
/* Make room in result for all the non-%-codes in the control string. */
total = 5 + CONVERTED_BYTE_SIZE (multibyte, args[0]);
+ /* Allocate the info and discarded tables. */
+ {
+ int nbytes = nargs * sizeof *info;
+ int i;
+ info = (struct info *) alloca (nbytes);
+ bzero (info, nbytes);
+ for (i = 0; i <= nargs; i++)
+ info[i].start = -1;
+ discarded = (char *) alloca (SBYTES (args[0]));
+ bzero (discarded, SBYTES (args[0]));
+ }
+
/* Add to TOTAL enough space to hold the converted arguments. */
n = 0;
int thissize = 0;
int actual_width = 0;
unsigned char *this_format_start = format - 1;
- int field_width, precision;
+ int field_width = 0;
/* General format specifications look like
the output should be padded with blanks, iff the output
string is shorter than field-width.
- if precision is specified, it specifies the number of
+ If precision is specified, it specifies the number of
digits to print after the '.' for floats, or the max.
number of chars to print from a string. */
- precision = field_width = 0;
-
+ /* NOTE the handling of specifiers here differs in some ways
+ from the libc model. There are bugs in this code that lead
+ to incorrect formatting when flags recognized by C but
+ neither parsed nor rejected here are used. Further
+ revisions will be made soon. */
+
+ /* incorrect list of flags to skip; will be fixed */
while (index ("-*# 0", *format))
++format;
field_width = 10 * field_width + *format - '0';
}
+ /* N is not incremented for another few lines below, so refer to
+ element N+1 (which might be precision[NARGS]). */
if (*format == '.')
{
++format;
- for (precision = 0; *format >= '0' && *format <= '9'; ++format)
- precision = 10 * precision + *format - '0';
+ for (precision[n+1] = 0; *format >= '0' && *format <= '9'; ++format)
+ precision[n+1] = 10 * precision[n+1] + *format - '0';
}
if (format - this_format_start + 1 > longest_format)
goto retry;
}
args[n] = tem;
+ /* If we restart the loop, we should not come here again
+ because args[n] is now a string and calling
+ Fprin1_to_string on it produces superflous double
+ quotes. So, change "%S" to "%s" now. */
+ *format = 's';
goto string;
}
else if (SYMBOLP (args[n]))
{
- /* Use a temp var to avoid problems when ENABLE_CHECKING
- is turned on. */
- struct Lisp_String *t = XSYMBOL (args[n])->name;
- XSETSTRING (args[n], t);
+ args[n] = SYMBOL_NAME (args[n]);
if (STRING_MULTIBYTE (args[n]) && ! multibyte)
{
multibyte = 1;
string:
if (*format != 's' && *format != 'S')
error ("Format specifier doesn't match argument type");
- thissize = CONVERTED_BYTE_SIZE (multibyte, args[n]);
+ /* In the case (PRECISION[N] > 0), THISSIZE may not need
+ to be as large as is calculated here. Easy check for
+ the case PRECISION = 0. */
+ thissize = precision[n] ? CONVERTED_BYTE_SIZE (multibyte, args[n]) : 0;
actual_width = lisp_string_width (args[n], -1, NULL, NULL);
}
/* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */
error ("Invalid format operation %%%c", *format);
thissize = 30;
- if (*format == 'c'
- && (! ASCII_CHAR_P (XINT (args[n]))
- || XINT (args[n]) == 0))
+ if (*format == 'c')
{
- if (! SINGLE_BYTE_CHAR_P (XINT (args[n]))
- if (! multibyte)
++ 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. */
+ || XINT (args[n]) == 0)
+ {
+ if (! multibyte)
+ {
+ multibyte = 1;
+ goto retry;
+ }
+ args[n] = Fchar_to_string (args[n]);
+ thissize = SBYTES (args[n]);
+ }
+ else if (! ASCII_BYTE_P (XINT (args[n])) && multibyte)
{
- multibyte = 1;
- goto retry;
+ args[n]
+ = Fchar_to_string (Funibyte_char_to_multibyte (args[n]));
+ thissize = SBYTES (args[n]);
}
- args[n] = Fchar_to_string (args[n]);
- thissize = STRING_BYTES (XSTRING (args[n]));
}
}
else if (FLOATP (args[n]) && *format != 's')
{
if (! (*format == 'e' || *format == 'f' || *format == 'g'))
- args[n] = Ftruncate (args[n], Qnil);
+ {
+ if (*format != 'd' && *format != 'o' && *format != 'x'
+ && *format != 'i' && *format != 'X' && *format != 'c')
+ error ("Invalid format operation %%%c", *format);
+ args[n] = Ftruncate (args[n], Qnil);
+ }
/* Note that we're using sprintf to print floats,
so we have to take into account what that function
prints. */
- thissize = MAX_10_EXP + 100 + precision;
+ /* Filter out flag value of -1. */
+ thissize = (MAX_10_EXP + 100
+ + (precision[n] > 0 ? precision[n] : 0));
}
else
{
total += thissize + 4;
}
+ abort_on_gc--;
+
/* Now we can no longer jump to retry.
TOTAL and LONGEST_FORMAT are known for certain. */
n = 0;
/* Scan the format and store result in BUF. */
- format = XSTRING (args[0])->data;
+ format = SDATA (args[0]);
+ format_start = format;
+ end = format + SBYTES (args[0]);
maybe_combine_byte = 0;
while (format != end)
{
int negative = 0;
unsigned char *this_format_start = format;
+ discarded[format - format_start] = 1;
format++;
/* Process a numeric arg and skip it. */
+ /* NOTE atoi is the wrong thing to use here; will be fixed */
minlen = atoi (format);
if (minlen < 0)
minlen = - minlen, negative = 1;
+ /* NOTE the parsing here is not consistent with the first
+ pass, and neither attempt is what we want to do. Will be
+ fixed. */
while ((*format >= '0' && *format <= '9')
|| *format == '-' || *format == ' ' || *format == '.')
- format++;
+ {
+ discarded[format - format_start] = 1;
+ format++;
+ }
if (*format++ == '%')
{
++n;
+ discarded[format - format_start - 1] = 1;
+ info[n].start = nchars;
+
if (STRINGP (args[n]))
{
- int padding, nbytes, start, end;
- int width = lisp_string_width (args[n], -1, NULL, NULL);
+ /* handle case (precision[n] >= 0) */
+
+ int width, padding;
+ int nbytes, start, end;
+ int nchars_string;
+
+ /* lisp_string_width ignores a precision of 0, but GNU
+ libc functions print 0 characters when the precision
+ is 0. Imitate libc behavior here. Changing
+ lisp_string_width is the right thing, and will be
+ done, but meanwhile we work with it. */
+
+ if (precision[n] == 0)
+ width = nchars_string = nbytes = 0;
+ else if (precision[n] > 0)
+ width = lisp_string_width (args[n], precision[n], &nchars_string, &nbytes);
+ else
+ { /* no precision spec given for this argument */
+ width = lisp_string_width (args[n], -1, NULL, NULL);
+ nbytes = SBYTES (args[n]);
+ nchars_string = SCHARS (args[n]);
+ }
/* If spec requires it, pad on right with spaces. */
padding = minlen - width;
}
start = nchars;
-
+ nchars += nchars_string;
+ end = nchars;
+
if (p > buf
&& multibyte
&& !ASCII_BYTE_P (*((unsigned char *) p - 1))
&& STRING_MULTIBYTE (args[n])
- && !CHAR_HEAD_P (XSTRING (args[n])->data[0]))
+ && !CHAR_HEAD_P (SREF (args[n], 0)))
maybe_combine_byte = 1;
- nbytes = copy_text (XSTRING (args[n])->data, p,
- STRING_BYTES (XSTRING (args[n])),
- STRING_MULTIBYTE (args[n]), multibyte);
- p += nbytes;
- nchars += XSTRING (args[n])->size;
- end = nchars;
+
+ p += copy_text (SDATA (args[n]), p,
+ nbytes,
+ STRING_MULTIBYTE (args[n]), multibyte);
if (negative)
while (padding-- > 0)
/* If this argument has text properties, record where
in the result string it appears. */
- if (XSTRING (args[n])->intervals)
- {
- if (!info)
- {
- int nbytes = nargs * sizeof *info;
- info = (struct info *) alloca (nbytes);
- bzero (info, nbytes);
- }
-
- info[n].start = start;
- info[n].end = end;
- }
+ if (STRING_INTERVALS (args[n]))
+ info[n].intervals = arg_intervals = 1;
}
else if (INTEGERP (args[n]) || FLOATP (args[n]))
{
p += this_nchars;
nchars += this_nchars;
}
+
+ info[n].end = nchars;
}
else if (STRING_MULTIBYTE (args[0]))
{
&& !CHAR_HEAD_P (*format))
maybe_combine_byte = 1;
*p++ = *format++;
- while (! CHAR_HEAD_P (*format)) *p++ = *format++;
+ while (! CHAR_HEAD_P (*format))
+ {
+ discarded[format - format_start] = 2;
+ *p++ = *format++;
+ }
nchars++;
}
else if (multibyte)
arguments has text properties, set up text properties of the
result string. */
- if (XSTRING (args[0])->intervals || info)
+ if (STRING_INTERVALS (args[0]) || arg_intervals)
{
Lisp_Object len, new_len, props;
struct gcpro gcpro1;
/* Add text properties from the format string. */
- len = make_number (XSTRING (args[0])->size);
+ len = make_number (SCHARS (args[0]));
props = text_property_list (args[0], make_number (0), len, Qnil);
GCPRO1 (props);
if (CONSP (props))
{
- new_len = make_number (XSTRING (val)->size);
- extend_property_ranges (props, len, new_len);
+ int bytepos = 0, position = 0, translated = 0, argn = 1;
+ Lisp_Object list;
+
+ /* Adjust the bounds of each text property
+ to the proper start and end in the output string. */
+ /* We take advantage of the fact that the positions in PROPS
+ are in increasing order, so that we can do (effectively)
+ one scan through the position space of the format string.
+
+ BYTEPOS is the byte position in the format string,
+ POSITION is the untranslated char position in it,
+ TRANSLATED is the translated char position in BUF,
+ and ARGN is the number of the next arg we will come to. */
+ for (list = props; CONSP (list); list = XCDR (list))
+ {
+ Lisp_Object item;
+ int pos;
+
+ item = XCAR (list);
+
+ /* First adjust the property start position. */
+ pos = XINT (XCAR (item));
+
+ /* Advance BYTEPOS, POSITION, TRANSLATED and ARGN
+ up to this position. */
+ for (; position < pos; bytepos++)
+ {
+ if (! discarded[bytepos])
+ position++, translated++;
+ else if (discarded[bytepos] == 1)
+ {
+ position++;
+ if (translated == info[argn].start)
+ {
+ translated += info[argn].end - info[argn].start;
+ argn++;
+ }
+ }
+ }
+
+ XSETCAR (item, make_number (translated));
+
+ /* Likewise adjust the property end position. */
+ pos = XINT (XCAR (XCDR (item)));
+
+ for (; bytepos < pos; bytepos++)
+ {
+ if (! discarded[bytepos])
+ position++, translated++;
+ else if (discarded[bytepos] == 1)
+ {
+ position++;
+ if (translated == info[argn].start)
+ {
+ translated += info[argn].end - info[argn].start;
+ argn++;
+ }
+ }
+ }
+
+ XSETCAR (XCDR (item), make_number (translated));
+ }
+
add_text_properties_from_list (val, props, make_number (0));
}
/* Add text properties from arguments. */
- if (info)
+ if (arg_intervals)
for (n = 1; n < nargs; ++n)
- if (info[n].end)
+ if (info[n].intervals)
{
- len = make_number (XSTRING (args[n])->size);
+ len = make_number (SCHARS (args[n]));
new_len = make_number (info[n].end - info[n].start);
props = text_property_list (args[n], make_number (0), len, Qnil);
extend_property_ranges (props, len, new_len);
return val;
}
-
-/* VARARGS 1 */
Lisp_Object
-#ifdef NO_ARG_ARRAY
-format1 (string1, arg0, arg1, arg2, arg3, arg4)
- EMACS_INT arg0, arg1, arg2, arg3, arg4;
-#else
-format1 (string1)
-#endif
+format2 (string1, arg0, arg1)
char *string1;
+ Lisp_Object arg0, arg1;
{
- char buf[100];
-#ifdef NO_ARG_ARRAY
- EMACS_INT args[5];
- args[0] = arg0;
- args[1] = arg1;
- args[2] = arg2;
- args[3] = arg3;
- args[4] = arg4;
- doprnt (buf, sizeof buf, string1, (char *)0, 5, (char **) args);
-#else
- doprnt (buf, sizeof buf, string1, (char *)0, 5, &string1 + 1);
-#endif
- return build_string (buf);
+ Lisp_Object args[3];
+ args[0] = build_string (string1);
+ args[1] = arg0;
+ args[2] = arg1;
+ return Fformat (3, args);
}
\f
DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0,
/* 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
register int start1_byte, end1_byte, start2_byte, end2_byte;
{
register int amt1, amt1_byte, amt2, amt2_byte, diff, diff_byte, mpos;
- register Lisp_Object marker;
+ register struct Lisp_Marker *marker;
/* Update point as if it were a marker. */
if (PT < start1)
amt1_byte = (end2_byte - start2_byte) + (start2_byte - end1_byte);
amt2_byte = (end1_byte - start1_byte) + (start2_byte - end1_byte);
- for (marker = BUF_MARKERS (current_buffer); !NILP (marker);
- marker = XMARKER (marker)->chain)
+ for (marker = BUF_MARKERS (current_buffer); marker; marker = marker->next)
{
- mpos = marker_byte_position (marker);
+ mpos = marker->bytepos;
if (mpos >= start1_byte && mpos < end2_byte)
{
if (mpos < end1_byte)
mpos += diff_byte;
else
mpos -= amt2_byte;
- XMARKER (marker)->bytepos = mpos;
+ marker->bytepos = mpos;
}
- mpos = XMARKER (marker)->charpos;
+ mpos = marker->charpos;
if (mpos >= start1 && mpos < end2)
{
if (mpos < end1)
else
mpos -= amt2;
}
- XMARKER (marker)->charpos = mpos;
+ marker->charpos = mpos;
}
}
staticpro (&Qbuffer_access_fontify_functions);
DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion,
- doc: /* Non-nil means.text motion commands don't notice fields. */);
+ doc: /* Non-nil means text motion commands don't notice fields. */);
Vinhibit_field_text_motion = Qnil;
DEFVAR_LISP ("buffer-access-fontify-functions",
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,86,87,93,94,95,97,98,1999,2001
+ Copyright (C) 1985,86,87,93,94,95,97,98,1999,2001,02,2003
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <sys/ioctl.h>
#endif
+#ifdef WINDOWSNT
+#include <fcntl.h>
+#endif
+
#include "lisp.h"
#include "commands.h"
#include "intervals.h"
#include "buffer.h"
+#include "window.h"
#include "systty.h"
#include "blockinput.h"
#ifdef DATA_SEG_BITS
EMACS_INT gdb_data_seg_bits = DATA_SEG_BITS;
#else
-EMACS_INT gdb_data_seg_bits = 0;
+EMACS_INT gdb_data_seg_bits = 0;
#endif
EMACS_INT PVEC_FLAG = PSEUDOVECTOR_FLAG;
Lisp_Object Vsystem_time_locale;
Lisp_Object Vprevious_system_time_locale;
-/* If non-zero, emacs should not attempt to use an window-specific code,
+/* If non-zero, emacs should not attempt to use a window-specific code,
but instead should use the virtual terminal under which it was started. */
int inhibit_window_system;
/* If nonzero, set Emacs to run at this priority. This is also used
in child_setup and sys_suspend to make sure subshells run at normal
priority; those functions have their own extern declaration. */
-int emacs_priority;
+EMACS_INT emacs_priority;
/* If non-zero, a filter or a sentinel is running. Tested to save the match
data on the first attempt to change it inside asynchronous code. */
Initialization options:\n\
\n\
--batch do not do interactive display; implies -q\n\
+--script FILE run FILE as an Emacs Lisp script.\n\
--debug-init enable Emacs Lisp debugger during init file\n\
--help display this help message and exit\n\
--multibyte, --no-unibyte run Emacs in multibyte mode\n\
--no-init-file, -q load neither ~/.emacs nor default.el\n\
--no-shared-memory, -nl do not use shared memory\n\
--no-site-file do not load site-start.el\n\
+--no-splash do not display a splash screen on startup\n\
--no-window-system, -nw don't communicate with X, ignoring $DISPLAY\n\
--terminal, -t DEVICE use DEVICE for terminal I/O\n\
--unibyte, --no-multibyte run Emacs in unibyte mode\n\
{
register int i;
Lisp_Object name, dir, tem;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object raw_name;
initial_argv = argv;
{
Lisp_Object found;
int yes = openp (Vexec_path, Vinvocation_name,
- Vexec_suffixes, &found, 1);
+ Vexec_suffixes, &found, make_number (X_OK));
if (yes == 1)
{
/* Add /: to the front of the name
{}
void __do_global_dtors ()
{}
-/* Linux has a bug in its library; avoid an error. */
+/* GNU/Linux has a bug in its library; avoid an error. */
#ifndef GNU_LINUX
char * __CTOR_LIST__[2] = { (char *) (-1), 0 };
#endif
if (!STRINGP(temp))
return REPORT_EMACS_BUG_ADDRESS;
- string = XSTRING (temp)->data;
+ string = SDATA (temp);
/* Count dots in `emacs-version'. */
while (*string)
/* ARGSUSED */
int
-main (argc, argv, envp)
+main (argc, argv
+#ifdef VMS
+, envp
+#endif
+)
int argc;
char **argv;
+#ifdef VMS
char **envp;
+#endif
{
#if GC_MARK_STACK
Lisp_Object dummy;
struct rlimit rlim;
#endif
int no_loadup = 0;
+ char *junk = 0;
#if GC_MARK_STACK
extern Lisp_Object *stack_base;
run_time_remap (argv[0]);
#endif
+#ifdef MAC_OSX
+ if (!initialized)
+ unexec_init_emacs_zone ();
+#endif
+
sort_args (argc, argv);
argc = 0;
while (argv[argc]) argc++;
}
else
{
- printf ("GNU Emacs %s\n", XSTRING (tem)->data);
- printf ("Copyright (C) 2001 Free Software Foundation, Inc.\n");
+ printf ("GNU Emacs %s\n", SDATA (tem));
+ printf ("Copyright (C) 2002 Free Software Foundation, Inc.\n");
printf ("GNU Emacs comes with ABSOLUTELY NO WARRANTY.\n");
printf ("You may redistribute copies of Emacs\n");
printf ("under the terms of the GNU General Public License.\n");
}
#endif /* NeXT */
+#ifdef MAC_OSX
+ /* Skip process serial number passed in the form -psn_x_y as
+ command-line argument. */
+ if (argc > skip_args + 1 && strncmp (argv[skip_args+1], "-psn_", 5) == 0)
+ skip_args++;
+#endif /* MAC_OSX */
+
#ifdef VMS
/* If -map specified, map the data file in. */
{
uninterrupt_malloc ();
#endif /* not SYSTEM_MALLOC */
-#ifdef MSDOS
+#if defined (MSDOS) || defined (WINDOWSNT)
/* We do all file input/output as binary files. When we need to translate
newlines, we do that manually. */
_fmode = O_BINARY;
+#endif /* MSDOS || WINDOWSNT */
+#ifdef MSDOS
#if __DJGPP__ >= 2
if (!isatty (fileno (stdin)))
setmode (fileno (stdin), O_BINARY);
noninteractive = 0;
if (argmatch (argv, argc, "-batch", "--batch", 5, NULL, &skip_args))
noninteractive = 1;
+ if (argmatch (argv, argc, "-script", "--script", 3, &junk, &skip_args))
+ {
+ noninteractive = 1; /* Set batch mode. */
+ /* Convert --script to -l, un-skip it, and sort again so that -l will be
+ handled in proper sequence. */
+ argv[skip_args - 1] = "-l";
+ skip_args -= 2;
+ sort_args (argc, argv);
+ }
/* Handle the --help option, which gives a usage message. */
if (argmatch (argv, argc, "-help", "--help", 3, NULL, &skip_args))
init_alloc_once ();
init_obarray ();
init_eval_once ();
+ init_character_once ();
init_charset_once ();
init_coding_once ();
init_syntax_once (); /* Create standard syntax table. */
CANNOT_DUMP is defined. */
syms_of_keyboard ();
-#ifdef macintosh
+#ifdef MAC_OS8
/* init_window_once calls make_terminal_frame which on Mac OS
creates a full-fledge output_mac type frame. This does not
work correctly before syms_of_textprop, syms_of_macfns,
syms_of_ccl, syms_of_fontset, syms_of_xterm, syms_of_search,
- syms_of_frame, x_term_init, and init_keyboard have already
+ syms_of_frame, mac_initialize, and init_keyboard have already
been called. */
syms_of_textprop ();
syms_of_macfns ();
syms_of_search ();
syms_of_frame ();
- x_term_init ();
+ mac_initialize ();
init_keyboard ();
#endif
/* Handle --unibyte and the EMACS_UNIBYTE envvar,
but not while dumping. */
- if (
-#ifndef CANNOT_DUMP
- ! noninteractive || initialized
-#else
- 1
-#endif
- )
+ if (1)
{
int inhibit_unibyte = 0;
/* --multibyte overrides EMACS_UNIBYTE. */
if (argmatch (argv, argc, "-no-unibyte", "--no-unibyte", 4, NULL, &skip_args)
- || argmatch (argv, argc, "-multibyte", "--multibyte", 4, NULL, &skip_args))
+ || argmatch (argv, argc, "-multibyte", "--multibyte", 4, NULL, &skip_args)
+ /* Ignore EMACS_UNIBYTE before dumping. */
+ || (!initialized && noninteractive))
inhibit_unibyte = 1;
/* --unibyte requests that we set up to do everything with single-byte
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 all multibyte buffers unibyte. */
++ /* 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, Qnil);
++ Fset_buffer_multibyte (Qnil);
+ set_buffer_temp (current);
+ }
}
}
}
#endif /* MSDOS */
#ifdef WINDOWSNT
+ globals_of_w32 ();
/* Initialize environment from registry settings. */
init_environment (argv);
init_ntproc (); /* must precede init_editfns. */
#endif
+#ifdef HAVE_CARBON
+ if (initialized)
+ init_mac_osx_environment ();
+#endif
+
/* egetenv is a pretty low-level facility, which may get called in
many circumstances; it seems flimsy to put off initializing it
until calling init_callproc. */
init_callproc (); /* Must follow init_cmdargs but not init_sys_modes. */
init_lread ();
+ init_charset ();
/* Intern the names of all standard functions and variables;
define standard keys. */
/* The basic levels of Lisp must come first. */
/* And data must come first of all
for the sake of symbols like error-message. */
-#ifndef macintosh
- /* Called before init_window_once for Mac OS. */
+#ifndef MAC_OS8
+ /* 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 ();
syms_of_casetab ();
syms_of_callproc ();
syms_of_category ();
-#ifndef macintosh
- /* Called before init_window_once for Mac OS. */
+#ifndef MAC_OS8
+ /* Called before init_window_once for Mac OS Classic. */
syms_of_ccl ();
#endif
+ syms_of_character ();
syms_of_charset ();
syms_of_cmds ();
#ifndef NO_DIR_LIBRARY
syms_of_marker ();
syms_of_minibuf ();
syms_of_process ();
-#ifndef macintosh
- /* Called before init_window_once for Mac OS. */
+#ifndef MAC_OS8
+ /* Called before init_window_once for Mac OS Classic. */
syms_of_search ();
syms_of_frame ();
#endif
#ifdef HAVE_SOUND
syms_of_sound ();
#endif
-#ifndef macintosh
- /* Called before init_window_once for Mac OS. */
+#ifndef MAC_OS8
+ /* Called before init_window_once for Mac OS Classic. */
syms_of_textprop ();
#endif
syms_of_composite ();
syms_of_xterm ();
syms_of_xfns ();
syms_of_fontset ();
+#ifdef HAVE_X_SM
+ syms_of_xsmfns ();
+#endif
#ifdef HAVE_X11
syms_of_xselect ();
#endif
#endif /* HAVE_X_WINDOWS */
#ifndef HAVE_NTGUI
-#ifndef macintosh
+#ifndef MAC_OS
+ /* Called before init_window_once for Mac OS Classic. */
syms_of_xmenu ();
#endif
#endif
syms_of_fontset ();
#endif /* HAVE_NTGUI */
+#ifdef HAVE_CARBON
+ syms_of_macterm ();
+ syms_of_macfns ();
+ syms_of_macmenu ();
+ syms_of_fontset ();
+#endif /* HAVE_CARBON */
+
#ifdef SYMS_SYSTEM
SYMS_SYSTEM;
#endif
keys_of_keymap ();
keys_of_minibuf ();
keys_of_window ();
+ }
+ else
+ {
+ /*
+ Initialization that must be done even if the global variable
+ initialized is non zero
+ */
+#ifdef HAVE_NTGUI
+ globals_of_w32fns ();
+ globals_of_w32menu ();
+#endif /* end #ifdef HAVE_NTGUI */
}
if (!noninteractive)
#endif /* VMS */
init_display (); /* Determine terminal type. init_sys_modes uses results. */
}
-#ifndef macintosh
- /* Called before init_window_once for Mac OS. */
+#ifndef MAC_OS8
+ /* Called before init_window_once for Mac OS Classic. */
init_keyboard (); /* This too must precede init_sys_modes. */
#endif
#ifdef VMS
init_vmsproc (); /* And this too. */
#endif /* VMS */
init_sys_modes (); /* Init system terminal modes (RAW or CBREAK, etc.). */
-#ifdef HAVE_X_WINDOWS
+#if defined (HAVE_X_WINDOWS) || defined (WINDOWSNT)
init_xfns ();
#endif /* HAVE_X_WINDOWS */
init_fns ();
if (argmatch (argv, argc, "-l", "--load", 3, &file, &skip_args))
Vtop_level = Fcons (intern ("load"),
Fcons (build_string (file), Qnil));
-#ifdef CANNOT_DUMP
/* Unless next switch is -nl, load "loadup.el" first thing. */
if (! no_loadup)
Vtop_level = Fcons (intern ("load"),
Fcons (build_string ("loadup.el"), Qnil));
-#endif /* CANNOT_DUMP */
}
if (initialized)
{ "-nw", "--no-window-system", 110, 0 },
{ "-nw", "--no-windows", 110, 0 },
{ "-batch", "--batch", 100, 0 },
+ { "-script", "--script", 100, 1 },
{ "-help", "--help", 90, 0 },
{ "-no-unibyte", "--no-unibyte", 83, 0 },
{ "-multibyte", "--multibyte", 82, 0 },
{ "-unibyte", "--unibyte", 81, 0 },
{ "-no-multibyte", "--no-multibyte", 80, 0 },
-#ifdef CANNOT_DUMP
{ "-nl", "--no-loadup", 70, 0 },
-#endif
/* -d must come last before the options handled in startup.el. */
{ "-d", "--display", 60, 1 },
{ "-display", 0, 60, 1 },
{ "-q", "--no-init-file", 50, 0 },
{ "-no-init-file", 0, 50, 0 },
{ "-no-site-file", "--no-site-file", 40, 0 },
+ { "-no-splash", "--no-splash", 40, 0 },
{ "-u", "--user", 30, 1 },
{ "-user", 0, 30, 1 },
{ "-debug-init", "--debug-init", 20, 0 },
kill it because we are exiting Emacs deliberately (not crashing).
Do it after shut_down_emacs, which does an auto-save. */
if (STRINGP (Vauto_save_list_file_name))
- unlink (XSTRING (Vauto_save_list_file_name)->data);
+ unlink (SDATA (Vauto_save_list_file_name));
exit (INTEGERP (arg) ? XINT (arg)
#ifdef VMS
#ifdef HAVE_X_WINDOWS
/* It's not safe to call intern here. Maybe we are crashing. */
if (!noninteractive && SYMBOLP (Vwindow_system)
- && XSYMBOL (Vwindow_system)->name->size == 1
- && XSYMBOL (Vwindow_system)->name->data[0] == 'x'
+ && SCHARS (SYMBOL_NAME (Vwindow_system)) == 1
+ && SREF (SYMBOL_NAME (Vwindow_system), 0) == 'x'
&& ! no_x)
Fx_close_current_connection ();
#endif /* HAVE_X_WINDOWS */
#ifndef SYSTEM_MALLOC
memory_warnings (my_edata, malloc_warning);
#endif
- map_out_data (XSTRING (filename)->data);
+ map_out_data (SDATA (filename));
Vpurify_flag = tem;
extern char my_edata[];
Lisp_Object tem;
Lisp_Object symbol;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
check_pure_size ();
/* Bind `command-line-processed' to nil before dumping,
so that the dumped Emacs will process its command line
and set up to work with X windows if appropriate. */
- symbol = intern ("command-line-process");
+ symbol = intern ("command-line-processed");
specbind (symbol, Qnil);
CHECK_STRING (filename);
if (!NILP (symfile))
{
CHECK_STRING (symfile);
- if (XSTRING (symfile)->size)
+ if (SCHARS (symfile))
symfile = Fexpand_file_name (symfile, Qnil);
}
fflush (stdout);
#ifdef VMS
- mapout_data (XSTRING (filename)->data);
+ mapout_data (SDATA (filename));
#else
/* Tell malloc where start of impure now is. */
/* Also arrange for warnings when nearly out of space. */
#ifdef USE_MMAP_FOR_BUFFERS
mmap_set_vars (0);
#endif
- unexec (XSTRING (filename)->data,
- !NILP (symfile) ? XSTRING (symfile)->data : 0, my_edata, 0, 0);
+ unexec (SDATA (filename),
+ !NILP (symfile) ? SDATA (symfile) : 0, my_edata, 0, 0);
#ifdef USE_MMAP_FOR_BUFFERS
mmap_set_vars (1);
#endif
{
*plocale = desired_locale;
setlocale (category, (STRINGP (desired_locale)
- ? (char *)(XSTRING (desired_locale)->data)
+ ? (char *)(SDATA (desired_locale))
: ""));
}
}
/* Add /: to the front of the name
if it would otherwise be treated as magic. */
tem = Ffind_file_name_handler (element, Qt);
+
+ /* However, if the handler says "I'm safe",
+ don't bother adding /:. */
+ if (SYMBOLP (tem))
+ {
+ Lisp_Object prop;
+ prop = Fget (tem, intern ("safe-magic"));
+ if (! NILP (prop))
+ tem = Qnil;
+ }
+
if (! NILP (tem))
element = concat2 (build_string ("/:"), element);
defsubr (&Sinvocation_directory);
DEFVAR_LISP ("command-line-args", &Vcommand_line_args,
- doc: /* Args passed by shell to Emacs, as a list of strings. */);
+ doc: /* Args passed by shell to Emacs, as a list of strings.
+Many arguments are deleted from the list as they are processed. */);
DEFVAR_LISP ("system-type", &Vsystem_type,
doc: /* Value is symbol indicating type of operating system you are using. */);
doc: /* Non-nil means Emacs is running without interactive terminal. */);
DEFVAR_LISP ("kill-emacs-hook", &Vkill_emacs_hook,
- doc: /* Hook to be run whenever kill-emacs is called.
-Since kill-emacs may be invoked when the terminal is disconnected (or
+ doc: /* Hook to be run when kill-emacs is called.
+Since `kill-emacs' may be invoked when the terminal is disconnected (or
in other similar situations), functions placed on this hook should not
expect to be able to interact with the user. To ask for confirmation,
-see `kill-emacs-query-functions' instead. */);
+see `kill-emacs-query-functions' instead.
+
+The hook is not run in batch mode, i.e., if `noninteractive' is non-nil. */);
Vkill_emacs_hook = Qnil;
empty_string = build_string ("");
/* File IO for GNU Emacs.
- Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000, 2001
+ Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000,01,2003
Free Software Foundation, Inc.
This file is part of GNU Emacs.
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
-#define _GNU_SOURCE /* for euidaccess */
-
#include <config.h>
-#if defined (USG5) || defined (BSD_SYSTEM) || defined (GNU_LINUX)
+#ifdef HAVE_FCNTL_H
#include <fcntl.h>
#endif
#include <sys/time.h>
#endif
-#ifndef USG
-#ifndef VMS
-#ifndef BSD4_1
-#ifndef WINDOWSNT
-#define HAVE_FSYNC
-#endif
-#endif
-#endif
-#endif
-
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
- #include "charset.h"
+ #include "character.h"
#include "coding.h"
#include "window.h"
a new file with the same mode as the original */
int auto_save_mode_bits;
+/* The symbol bound to coding-system-for-read when
+ insert-file-contents is called for recovering a file. This is not
+ an actual coding system name, but just an indicator to tell
+ insert-file-contents to use `emacs-mule' with a special flag for
+ auto saving and recovering a file. */
+Lisp_Object Qauto_save_coding;
+
/* Coding system for file names, or nil if none. */
Lisp_Object Vfile_name_coding_system;
/* Functions to be called to process text properties in inserted file. */
Lisp_Object Vafter_insert_file_functions;
+/* Lisp function for setting buffer-file-coding-system and the
+ multibyteness of the current buffer after inserting a file. */
+Lisp_Object Qafter_insert_file_set_coding;
+
/* Functions to be called to create text property annotations for file. */
Lisp_Object Vwrite_region_annotate_functions;
+Lisp_Object Qwrite_region_annotate_functions;
/* During build_annotations, each time an annotation function is called,
this holds the annotations made by the previous functions. */
/* File name in which we write a list of all our auto save files. */
Lisp_Object Vauto_save_list_file_name;
+/* Function to call to read a file name. */
+Lisp_Object Vread_file_name_function;
+
+/* Current predicate used by read_file_name_internal. */
+Lisp_Object Vread_file_name_predicate;
+
/* Nonzero means, when reading a filename in the minibuffer,
start out by inserting the default directory into the minibuffer. */
int insert_default_directory;
\f
void
report_file_error (string, data)
- char *string;
+ const char *string;
Lisp_Object data;
{
Lisp_Object errstring;
default:
/* System error messages are capitalized. Downcase the initial
unless it is followed by a slash. */
- if (XSTRING (errstring)->data[1] != '/')
- XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
+ if (SREF (errstring, 1) != '/')
+ SSET (errstring, 0, DOWNCASE (SREF (errstring, 0)));
Fsignal (Qfile_error,
Fcons (build_string (string), Fcons (errstring, data)));
Fset_marker (location, Qnil, Qnil);
return Qnil;
}
-
+
+ /* Kill the working buffer for code conversion. */
+
+ static Lisp_Object
+ kill_workbuf_unwind (workbuf)
+ Lisp_Object workbuf;
+ {
+ if (! NILP (workbuf) && ! NILP (Fbuffer_live_p (workbuf)))
+ Fkill_buffer (workbuf);
+ return Qnil;
+ }
\f
Lisp_Object Qexpand_file_name;
Lisp_Object Qsubstitute_in_file_name;
(filename)
Lisp_Object filename;
{
+#ifndef DOS_NT
+ register const unsigned char *beg;
+#else
register unsigned char *beg;
- register unsigned char *p;
+#endif
+ register const unsigned char *p;
Lisp_Object handler;
CHECK_STRING (filename);
#ifdef FILE_SYSTEM_CASE
filename = FILE_SYSTEM_CASE (filename);
#endif
- beg = XSTRING (filename)->data;
+ beg = SDATA (filename);
#ifdef DOS_NT
beg = strcpy (alloca (strlen (beg) + 1), beg);
#endif
- p = beg + STRING_BYTES (XSTRING (filename));
+ p = beg + SBYTES (filename);
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef VMS
CORRECT_DIR_SEPS (beg);
#endif /* DOS_NT */
- if (STRING_MULTIBYTE (filename))
- return make_string (beg, p - beg);
- return make_unibyte_string (beg, p - beg);
+ return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
}
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
(filename)
Lisp_Object filename;
{
- register unsigned char *beg, *p, *end;
+ register const unsigned char *beg, *p, *end;
Lisp_Object handler;
CHECK_STRING (filename);
if (!NILP (handler))
return call2 (handler, Qfile_name_nondirectory, filename);
- beg = XSTRING (filename)->data;
- end = p = beg + STRING_BYTES (XSTRING (filename));
+ beg = SDATA (filename);
+ end = p = beg + SBYTES (filename);
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef VMS
)
p--;
- if (STRING_MULTIBYTE (filename))
- return make_string (p, end - p);
- return make_unibyte_string (p, end - p);
+ return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
}
DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
/* For Unix syntax, Append a slash if necessary */
if (!IS_DIRECTORY_SEP (out[size]))
{
- out[size + 1] = DIRECTORY_SEP;
+ /* Cannot use DIRECTORY_SEP, which could have any value */
+ out[size + 1] = '/';
out[size + 2] = '\0';
}
#ifdef DOS_NT
DEFUN ("file-name-as-directory", Ffile_name_as_directory,
Sfile_name_as_directory, 1, 1, 0,
- doc: /* Return a string representing file FILENAME interpreted as a directory.
+ doc: /* Return a string representing the file name FILE interpreted as a directory.
This operation exists because a directory is also a file, but its name as
a directory is different from its name as a file.
The result can be used as the value of `default-directory'
if (!NILP (handler))
return call2 (handler, Qfile_name_as_directory, file);
- buf = (char *) alloca (STRING_BYTES (XSTRING (file)) + 10);
- return build_string (file_name_as_directory (buf, XSTRING (file)->data));
+ buf = (char *) alloca (SBYTES (file) + 10);
+ file_name_as_directory (buf, SDATA (file));
+ return make_specified_string (buf, -1, strlen (buf),
+ STRING_MULTIBYTE (file));
}
\f
/*
/* 20 extra chars is insufficient for VMS, since we might perform a
logical name translation. an equivalence string can be up to 255
chars long, so grab that much extra space... - sss */
- buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20 + 255);
+ buf = (char *) alloca (SBYTES (directory) + 20 + 255);
#else
- buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20);
+ buf = (char *) alloca (SBYTES (directory) + 20);
#endif
- directory_file_name (XSTRING (directory)->data, buf);
- return build_string (buf);
+ directory_file_name (SDATA (directory), buf);
+ return make_specified_string (buf, -1, strlen (buf),
+ STRING_MULTIBYTE (directory));
}
static char make_temp_name_tbl[64] =
static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
/* Value is a temporary file name starting with PREFIX, a string.
-
+
The Emacs process number forms part of the result, so there is
no danger of generating a name being used by another process.
In addition, this function makes an attempt to choose a name
which has no existing file. To make this work, PREFIX should be
an absolute file name.
-
+
BASE64_P non-zero means add the pid as 3 characters in base64
encoding. In this case, 6 characters will be added to PREFIX to
form the file name. Otherwise, if Emacs is running on a system
unsigned char *p, *data;
char pidbuf[20];
int pidlen;
-
+
CHECK_STRING (prefix);
/* VAL is created by adding 6 characters to PREFIX. The first
pidlen = 3;
#endif
}
-
- len = XSTRING (prefix)->size;
+
+ len = SCHARS (prefix);
val = make_uninit_string (len + 3 + pidlen);
- data = XSTRING (val)->data;
- bcopy(XSTRING (prefix)->data, data, len);
+ data = SDATA (val);
+ bcopy(SDATA (prefix), data, len);
p = data + len;
bcopy (pidbuf, p, pidlen);
}
error ("Cannot create temporary name for prefix `%s'",
- XSTRING (prefix)->data);
+ SDATA (prefix));
return Qnil;
}
There is a race condition between calling `make-temp-name' and creating the
file which opens all kinds of security holes. For that reason, you should
-probably use `make-temp-file' instead. */)
+probably use `make-temp-file' instead, except in three circumstances:
+
+* If you are creating the file in the user's home directory.
+* If you are creating a directory rather than an ordinary file.
+* If you are taking special precautions as `make-temp-file' does. */)
(prefix)
Lisp_Object prefix;
{
int is_escaped = 0;
#endif /* DOS_NT */
int length;
- Lisp_Object handler;
+ Lisp_Object handler, result;
CHECK_STRING (name);
return call3 (handler, Qexpand_file_name, name, default_directory);
}
- o = XSTRING (default_directory)->data;
+ o = SDATA (default_directory);
/* Make sure DEFAULT_DIRECTORY is properly expanded.
It would be better to do this down below where we actually use
name = FILE_SYSTEM_CASE (name);
#endif
- nm = XSTRING (name)->data;
+ nm = SDATA (name);
#ifdef DOS_NT
/* We will force directory separators to be either all \ or /, so make
&& IS_DIRECTORY_SEP (p[0])
&& IS_DIRECTORY_SEP (p[1]))
lose = 1;
-
+
#ifdef VMS
if (p[0] == '\\')
lose = 1;
{
#ifdef VMS
if (index (nm, '/'))
- return build_string (sys_translate_unix (nm));
+ {
+ nm = sys_translate_unix (nm);
+ return make_specified_string (nm, -1, strlen (nm),
+ STRING_MULTIBYTE (name));
+ }
#endif /* VMS */
#ifdef DOS_NT
/* Make sure directories are all separated with / or \ as
#ifdef WINDOWSNT
if (IS_DIRECTORY_SEP (nm[1]))
{
- if (strcmp (nm, XSTRING (name)->data) != 0)
- name = build_string (nm);
+ if (strcmp (nm, SDATA (name)) != 0)
+ name = make_specified_string (nm, -1, strlen (nm),
+ STRING_MULTIBYTE (name));
}
else
#endif
/* drive must be set, so this is okay */
- if (strcmp (nm - 2, XSTRING (name)->data) != 0)
+ if (strcmp (nm - 2, SDATA (name)) != 0)
{
- name = make_string (nm - 2, p - nm + 2);
- XSTRING (name)->data[0] = DRIVE_LETTER (drive);
- XSTRING (name)->data[1] = ':';
+ char temp[] = " :";
+
+ name = make_specified_string (nm, -1, p - nm,
+ STRING_MULTIBYTE (name));
+ temp[0] = DRIVE_LETTER (drive);
+ name = concat2 (build_string (temp), name);
}
return name;
#else /* not DOS_NT */
- if (nm == XSTRING (name)->data)
+ if (nm == SDATA (name))
return name;
- return build_string (nm);
+ return make_specified_string (nm, -1, strlen (nm),
+ STRING_MULTIBYTE (name));
#endif /* not DOS_NT */
}
}
#endif
&& !newdir)
{
- newdir = XSTRING (default_directory)->data;
+ newdir = SDATA (default_directory);
#ifdef DOS_NT
/* Note if special escape prefix is present, but remove for now. */
if (newdir[0] == '/' && newdir[1] == ':')
absolute directory in nm produces "//", which will then be
incorrectly treated as a network share. Ignore newdir in
this case (keeping the drive letter). */
- if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
+ if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
&& newdir[1] == '\0'))
#endif
strcpy (target, newdir);
CORRECT_DIR_SEPS (target);
#endif /* DOS_NT */
- return make_string (target, o - target);
+ result = make_specified_string (target, -1, o - target,
+ STRING_MULTIBYTE (name));
+
+ /* Again look to see if the file name has special constructs in it
+ and perhaps call the corresponding file handler. This is needed
+ for filenames such as "/foo/../user@host:/bar/../baz". Expanding
+ the ".." component gives us "/user@host:/bar/../baz" which needs
+ to be expanded again. */
+ handler = Ffind_file_name_handler (result, Qexpand_file_name);
+ if (!NILP (handler))
+ return call3 (handler, Qexpand_file_name, result, default_directory);
+
+ return result;
}
#if 0
name = Fupcase (name);
#endif
- nm = XSTRING (name)->data;
+ nm = SDATA (name);
/* If nm is absolute, flush ...// and detect /./ and /../.
If no /./ or /../ we can return right away. */
if (index (nm, '/'))
return build_string (sys_translate_unix (nm));
#endif /* VMS */
- if (nm == XSTRING (name)->data)
+ if (nm == SDATA (name))
return name;
return build_string (nm);
}
if (NILP (defalt))
defalt = current_buffer->directory;
CHECK_STRING (defalt);
- newdir = XSTRING (defalt)->data;
+ newdir = SDATA (defalt);
}
/* Now concatenate the directory and name to new space in the stack frame */
if (!NILP (handler))
return call2 (handler, Qsubstitute_in_file_name, filename);
- nm = XSTRING (filename)->data;
+ nm = SDATA (filename);
#ifdef DOS_NT
nm = strcpy (alloca (strlen (nm) + 1), nm);
CORRECT_DIR_SEPS (nm);
- substituted = (strcmp (nm, XSTRING (filename)->data) != 0);
+ substituted = (strcmp (nm, SDATA (filename)) != 0);
#endif
- endp = nm + STRING_BYTES (XSTRING (filename));
+ endp = nm + SBYTES (filename);
/* If /~ or // appears, discard everything through first slash. */
for (p = nm; p != endp; p++)
{
if ((p[0] == '~'
-#if defined (APOLLO) || defined (WINDOWSNT)
- /* // at start of file name is meaningful in Apollo and
- WindowsNT systems. */
+#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
+ /* // at start of file name is meaningful in Apollo,
+ WindowsNT and Cygwin systems. */
|| (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
-#else /* not (APOLLO || WINDOWSNT) */
+#else /* not (APOLLO || WINDOWSNT || CYGWIN) */
|| IS_DIRECTORY_SEP (p[0])
-#endif /* not (APOLLO || WINDOWSNT) */
+#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
)
&& p != nm
&& (0
}
#ifdef VMS
- return build_string (nm);
+ return make_specified_string (nm, -1, strlen (nm),
+ STRING_MULTIBYTE (filename));
#else
/* See if any variables are substituted into the string
/* If substitution required, recopy the string and do it */
/* Make space in stack frame for the new copy */
- xnm = (unsigned char *) alloca (STRING_BYTES (XSTRING (filename)) + total + 1);
+ xnm = (unsigned char *) alloca (SBYTES (filename) + total + 1);
x = xnm;
/* Copy the rest of the name through, replacing $ constructs with values */
for (p = xnm; p != x; p++)
if ((p[0] == '~'
-#if defined (APOLLO) || defined (WINDOWSNT)
+#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
|| (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
-#else /* not (APOLLO || WINDOWSNT) */
+#else /* not (APOLLO || WINDOWSNT || CYGWIN) */
|| IS_DIRECTORY_SEP (p[0])
-#endif /* not (APOLLO || WINDOWSNT) */
+#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
)
&& p != xnm && IS_DIRECTORY_SEP (p[-1]))
xnm = p;
xnm = p;
#endif
- if (STRING_MULTIBYTE (filename))
- return make_string (xnm, x - xnm);
- return make_unibyte_string (xnm, x - xnm);
+ return make_specified_string (xnm, -1, x - xnm, STRING_MULTIBYTE (filename));
badsubst:
error ("Bad format environment-variable substitution");
absname = Fexpand_file_name (filename, defdir);
#ifdef VMS
{
- register int c = XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1];
+ register int c = SREF (absname, SBYTES (absname) - 1);
if (c == ':' || c == ']' || c == '>')
absname = Fdirectory_file_name (absname);
}
#else
/* Remove final slash, if any (unless this is the root dir).
stat behaves differently depending! */
- if (XSTRING (absname)->size > 1
- && IS_DIRECTORY_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1])
- && !IS_DEVICE_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname))-2]))
+ if (SCHARS (absname) > 1
+ && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
+ && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname)-2)))
/* We cannot take shortcuts; they might be wrong for magic file names. */
absname = Fdirectory_file_name (absname);
#endif
/* stat is a good way to tell whether the file exists,
regardless of what access permissions it has. */
- if (stat (XSTRING (encoded_filename)->data, &statbuf) >= 0)
+ if (stat (SDATA (encoded_filename), &statbuf) >= 0)
{
if (! interactive)
Fsignal (Qfile_already_exists,
Fcons (build_string ("File already exists"),
Fcons (absname, Qnil)));
GCPRO1 (absname);
- tem = format1 ("File %s already exists; %s anyway? ",
- XSTRING (absname)->data, querystring);
+ tem = format2 ("File %s already exists; %s anyway? ",
+ absname, build_string (querystring));
if (quick)
tem = Fy_or_n_p (tem);
else
This is what happens in interactive use with M-x.
Fourth arg KEEP-TIME non-nil means give the new file the same
last-modified time as the old one. (This works on only some systems.)
-A prefix arg makes KEEP-TIME non-nil. */)
+A prefix arg makes KEEP-TIME non-nil.
+Also set the file modes of the target file to match the source file. */)
(file, newname, ok_if_already_exists, keep_time)
Lisp_Object file, newname, ok_if_already_exists, keep_time;
{
struct stat st, out_st;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int input_file_statable_p;
Lisp_Object encoded_file, encoded_newname;
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (encoded_newname, "copy to it",
INTEGERP (ok_if_already_exists), &out_st, 0);
- else if (stat (XSTRING (encoded_newname)->data, &out_st) < 0)
+ else if (stat (SDATA (encoded_newname), &out_st) < 0)
out_st.st_mode = 0;
#ifdef WINDOWSNT
- if (!CopyFile (XSTRING (encoded_file)->data,
- XSTRING (encoded_newname)->data,
+ if (!CopyFile (SDATA (encoded_file),
+ SDATA (encoded_newname),
FALSE))
report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil)));
+ /* CopyFile retains the timestamp by default. */
else if (NILP (keep_time))
{
EMACS_TIME now;
+ DWORD attributes;
+ char * filename;
+
EMACS_GET_TIME (now);
- if (set_file_times (XSTRING (encoded_newname)->data,
- now, now))
- Fsignal (Qfile_date_error,
- Fcons (build_string ("Cannot set file date"),
- Fcons (newname, Qnil)));
+ filename = SDATA (encoded_newname);
+
+ /* Ensure file is writable while its modified time is set. */
+ attributes = GetFileAttributes (filename);
+ SetFileAttributes (filename, attributes & ~FILE_ATTRIBUTE_READONLY);
+ if (set_file_times (filename, now, now))
+ {
+ /* Restore original attributes. */
+ SetFileAttributes (filename, attributes);
+ Fsignal (Qfile_date_error,
+ Fcons (build_string ("Cannot set file date"),
+ Fcons (newname, Qnil)));
+ }
+ /* Restore original attributes. */
+ SetFileAttributes (filename, attributes);
}
#else /* not WINDOWSNT */
- ifd = emacs_open (XSTRING (encoded_file)->data, O_RDONLY, 0);
+ immediate_quit = 1;
+ ifd = emacs_open (SDATA (encoded_file), O_RDONLY, 0);
+ immediate_quit = 0;
+
if (ifd < 0)
report_file_error ("Opening input file", Fcons (file, Qnil));
#ifdef VMS
/* Create the copy file with the same record format as the input file */
- ofd = sys_creat (XSTRING (encoded_newname)->data, 0666, ifd);
+ ofd = sys_creat (SDATA (encoded_newname), 0666, ifd);
#else
#ifdef MSDOS
/* System's default file type was set to binary by _fmode in emacs.c. */
- ofd = creat (XSTRING (encoded_newname)->data, S_IREAD | S_IWRITE);
+ ofd = creat (SDATA (encoded_newname), S_IREAD | S_IWRITE);
#else /* not MSDOS */
- ofd = creat (XSTRING (encoded_newname)->data, 0666);
+ ofd = creat (SDATA (encoded_newname), 0666);
#endif /* not MSDOS */
#endif /* VMS */
if (ofd < 0)
EMACS_TIME atime, mtime;
EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
- if (set_file_times (XSTRING (encoded_newname)->data,
+ if (set_file_times (SDATA (encoded_newname),
atime, mtime))
Fsignal (Qfile_date_error,
Fcons (build_string ("Cannot set file date"),
Fcons (newname, Qnil)));
}
#ifndef MSDOS
- chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777);
+ chmod (SDATA (encoded_newname), st.st_mode & 07777);
#else /* MSDOS */
#if defined (__DJGPP__) && __DJGPP__ > 1
/* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
get only the READ bit, which will make the copied file read-only,
so it's better not to chmod at all. */
if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
- chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777);
+ chmod (SDATA (encoded_newname), st.st_mode & 07777);
#endif /* DJGPP version 2 or newer */
#endif /* MSDOS */
}
(directory)
Lisp_Object directory;
{
- unsigned char *dir;
+ const unsigned char *dir;
Lisp_Object handler;
Lisp_Object encoded_dir;
encoded_dir = ENCODE_FILE (directory);
- dir = XSTRING (encoded_dir)->data;
+ dir = SDATA (encoded_dir);
#ifdef WINDOWSNT
if (mkdir (dir) != 0)
}
DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",
- doc: /* Delete the directory named DIRECTORY. */)
+ doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
(directory)
Lisp_Object directory;
{
- unsigned char *dir;
+ const unsigned char *dir;
Lisp_Object handler;
Lisp_Object encoded_dir;
encoded_dir = ENCODE_FILE (directory);
- dir = XSTRING (encoded_dir)->data;
+ dir = SDATA (encoded_dir);
if (rmdir (dir) != 0)
report_file_error ("Removing directory", Flist (1, &directory));
}
DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
- doc: /* Delete file named FILENAME.
+ doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
If file has multiple names, it continues to exist with the other names. */)
(filename)
Lisp_Object filename;
{
Lisp_Object handler;
Lisp_Object encoded_file;
+ struct gcpro gcpro1;
- CHECK_STRING (filename);
+ GCPRO1 (filename);
+ if (!NILP (Ffile_directory_p (filename))
+ && NILP (Ffile_symlink_p (filename)))
+ Fsignal (Qfile_error,
+ Fcons (build_string ("Removing old name: is a directory"),
+ Fcons (filename, Qnil)));
+ UNGCPRO;
filename = Fexpand_file_name (filename, Qnil);
handler = Ffind_file_name_handler (filename, Qdelete_file);
encoded_file = ENCODE_FILE (filename);
- if (0 > unlink (XSTRING (encoded_file)->data))
+ if (0 > unlink (SDATA (encoded_file)))
report_file_error ("Removing old name", Flist (1, &filename));
return Qnil;
}
barf_or_query_if_file_exists (encoded_newname, "rename to it",
INTEGERP (ok_if_already_exists), 0, 0);
#ifndef BSD4_1
- if (0 > rename (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data))
+ if (0 > rename (SDATA (encoded_file), SDATA (encoded_newname)))
#else
- if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data)
- || 0 > unlink (XSTRING (encoded_file)->data))
+ if (0 > link (SDATA (encoded_file), SDATA (encoded_newname))
+ || 0 > unlink (SDATA (encoded_file)))
#endif
{
if (errno == EXDEV)
barf_or_query_if_file_exists (encoded_newname, "make it a new name",
INTEGERP (ok_if_already_exists), 0, 0);
- unlink (XSTRING (newname)->data);
- if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data))
+ unlink (SDATA (newname));
+ if (0 > link (SDATA (encoded_file), SDATA (encoded_newname)))
{
#ifdef NO_ARG_ARRAY
args[0] = file;
/* If the link target has a ~, we must expand it to get
a truly valid file name. Otherwise, do not expand;
we want to permit links to relative file names. */
- if (XSTRING (filename)->data[0] == '~')
+ if (SREF (filename, 0) == '~')
filename = Fexpand_file_name (filename, Qnil);
linkname = Fexpand_file_name (linkname, Qnil);
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (encoded_linkname, "make it a link",
INTEGERP (ok_if_already_exists), 0, 0);
- if (0 > symlink (XSTRING (encoded_filename)->data,
- XSTRING (encoded_linkname)->data))
+ if (0 > symlink (SDATA (encoded_filename),
+ SDATA (encoded_linkname)))
{
/* If we didn't complain already, silently delete existing file. */
if (errno == EEXIST)
{
- unlink (XSTRING (encoded_linkname)->data);
- if (0 <= symlink (XSTRING (encoded_filename)->data,
- XSTRING (encoded_linkname)->data))
+ unlink (SDATA (encoded_linkname));
+ if (0 <= symlink (SDATA (encoded_filename),
+ SDATA (encoded_linkname)))
{
UNGCPRO;
return Qnil;
{
CHECK_STRING (name);
if (NILP (string))
- delete_logical_name (XSTRING (name)->data);
+ delete_logical_name (SDATA (name));
else
{
CHECK_STRING (string);
- if (XSTRING (string)->size == 0)
- delete_logical_name (XSTRING (name)->data);
+ if (SCHARS (string) == 0)
+ delete_logical_name (SDATA (name));
else
- define_logical_name (XSTRING (name)->data, XSTRING (string)->data);
+ define_logical_name (SDATA (name), SDATA (string));
}
return string;
CHECK_STRING (path);
CHECK_STRING (login);
- netresult = netunam (XSTRING (path)->data, XSTRING (login)->data);
+ netresult = netunam (SDATA (path), SDATA (login));
if (netresult == -1)
return Qnil;
(filename)
Lisp_Object filename;
{
- unsigned char *ptr;
+ const unsigned char *ptr;
CHECK_STRING (filename);
- ptr = XSTRING (filename)->data;
+ ptr = SDATA (filename);
if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
#ifdef VMS
/* ??? This criterion is probably wrong for '<'. */
absname = ENCODE_FILE (absname);
- return (stat (XSTRING (absname)->data, &statbuf) >= 0) ? Qt : Qnil;
+ return (stat (SDATA (absname), &statbuf) >= 0) ? Qt : Qnil;
}
DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
absname = ENCODE_FILE (absname);
- return (check_executable (XSTRING (absname)->data) ? Qt : Qnil);
+ return (check_executable (SDATA (absname)) ? Qt : Qnil);
}
DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
#if defined(DOS_NT) || defined(macintosh)
/* Under MS-DOS, Windows, and Macintosh, open does not work for
directories. */
- if (access (XSTRING (absname)->data, 0) == 0)
+ if (access (SDATA (absname), 0) == 0)
return Qt;
return Qnil;
#else /* not DOS_NT and not macintosh */
/* Opening a fifo without O_NONBLOCK can wait.
We don't want to wait. But we don't want to mess wth O_NONBLOCK
except in the case of a fifo, on a system which handles it. */
- desc = stat (XSTRING (absname)->data, &statbuf);
+ desc = stat (SDATA (absname), &statbuf);
if (desc < 0)
return Qnil;
if (S_ISFIFO (statbuf.st_mode))
flags |= O_NONBLOCK;
#endif
- desc = emacs_open (XSTRING (absname)->data, flags, 0);
+ desc = emacs_open (SDATA (absname), flags, 0);
if (desc < 0)
return Qnil;
emacs_close (desc);
return call2 (handler, Qfile_writable_p, absname);
encoded = ENCODE_FILE (absname);
- if (stat (XSTRING (encoded)->data, &statbuf) >= 0)
- return (check_writable (XSTRING (encoded)->data)
+ if (stat (SDATA (encoded), &statbuf) >= 0)
+ return (check_writable (SDATA (encoded))
? Qt : Qnil);
dir = Ffile_name_directory (absname);
/* The read-only attribute of the parent directory doesn't affect
whether a file or directory can be created within it. Some day we
should check ACLs though, which do affect this. */
- if (stat (XSTRING (dir)->data, &statbuf) < 0)
+ if (stat (SDATA (dir), &statbuf) < 0)
return Qnil;
return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
#else
- return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "")
+ return (check_writable (!NILP (dir) ? (char *) SDATA (dir) : "")
? Qt : Qnil);
#endif
}
encoded_filename = ENCODE_FILE (absname);
- fd = emacs_open (XSTRING (encoded_filename)->data, O_RDONLY, 0);
+ fd = emacs_open (SDATA (encoded_filename), O_RDONLY, 0);
if (fd < 0)
- report_file_error (XSTRING (string)->data, Fcons (filename, Qnil));
+ report_file_error (SDATA (string), Fcons (filename, Qnil));
emacs_close (fd);
return Qnil;
\f
DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
-The value is the name of the file to which it is linked.
+The value is the link target, as a string.
Otherwise returns nil. */)
(filename)
Lisp_Object filename;
{
-#ifdef S_IFLNK
- char *buf;
- int bufsize;
- int valsize;
- Lisp_Object val;
Lisp_Object handler;
CHECK_STRING (filename);
if (!NILP (handler))
return call2 (handler, Qfile_symlink_p, filename);
+#ifdef S_IFLNK
+ {
+ char *buf;
+ int bufsize;
+ int valsize;
+ Lisp_Object val;
+
filename = ENCODE_FILE (filename);
bufsize = 50;
bufsize *= 2;
buf = (char *) xrealloc (buf, bufsize);
bzero (buf, bufsize);
-
+
errno = 0;
- valsize = readlink (XSTRING (filename)->data, buf, bufsize);
+ valsize = readlink (SDATA (filename), buf, bufsize);
if (valsize == -1)
{
#ifdef ERANGE
}
}
while (valsize >= bufsize);
-
+
val = make_string (buf, valsize);
if (buf[0] == '/' && index (buf, ':'))
val = concat2 (build_string ("/:"), val);
xfree (buf);
val = DECODE_FILE (val);
return val;
+ }
#else /* not S_IFLNK */
return Qnil;
#endif /* not S_IFLNK */
absname = ENCODE_FILE (absname);
- if (stat (XSTRING (absname)->data, &st) < 0)
+ if (stat (SDATA (absname), &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
}
if (!NILP (handler))
return call2 (handler, Qfile_accessible_directory_p, filename);
- /* It's an unlikely combination, but yes we really do need to gcpro:
- Suppose that file-accessible-directory-p has no handler, but
- file-directory-p does have a handler; this handler causes a GC which
- relocates the string in `filename'; and finally file-directory-p
- returns non-nil. Then we would end up passing a garbaged string
- to file-executable-p. */
GCPRO1 (filename);
tem = (NILP (Ffile_directory_p (filename))
|| NILP (Ffile_executable_p (filename)));
/* Tell stat to use expensive method to get accurate info. */
Vw32_get_true_file_attributes = Qt;
- result = stat (XSTRING (absname)->data, &st);
+ result = stat (SDATA (absname), &st);
Vw32_get_true_file_attributes = tem;
if (result < 0)
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
}
#else
- if (stat (XSTRING (absname)->data, &st) < 0)
+ if (stat (SDATA (absname), &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
#endif
absname = ENCODE_FILE (absname);
- if (stat (XSTRING (absname)->data, &st) < 0)
+ if (stat (SDATA (absname), &st) < 0)
return Qnil;
#if defined (MSDOS) && __DJGPP__ < 2
- if (check_executable (XSTRING (absname)->data))
+ if (check_executable (SDATA (absname)))
st.st_mode |= S_IEXEC;
#endif /* MSDOS && __DJGPP__ < 2 */
encoded_absname = ENCODE_FILE (absname);
- if (chmod (XSTRING (encoded_absname)->data, XINT (mode)) < 0)
+ if (chmod (SDATA (encoded_absname), XINT (mode)) < 0)
report_file_error ("Doing chmod", Fcons (absname, Qnil));
return Qnil;
absname2 = ENCODE_FILE (absname2);
UNGCPRO;
- if (stat (XSTRING (absname1)->data, &st) < 0)
+ if (stat (SDATA (absname1), &st) < 0)
return Qnil;
mtime1 = st.st_mtime;
- if (stat (XSTRING (absname2)->data, &st) < 0)
+ if (stat (SDATA (absname2), &st) < 0)
return Qt;
return (mtime1 > st.st_mtime) ? Qt : Qnil;
read_non_regular ()
{
int nbytes;
-
+
immediate_quit = 1;
QUIT;
nbytes = emacs_read (non_regular_fd,
- BEG_ADDR + PT_BYTE - 1 + non_regular_inserted,
+ BEG_ADDR + PT_BYTE - BEG_BYTE + non_regular_inserted,
non_regular_nbytes);
immediate_quit = 0;
return make_number (nbytes);
DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
1, 5, 0,
doc: /* Insert contents of file FILENAME after point.
-Returns list of absolute file name and number of bytes inserted.
+Returns list of absolute file name and number of characters inserted.
If second argument VISIT is non-nil, the buffer's visited filename
and last save file modtime are set, and it is marked unmodified.
If visiting and the file does not exist, visiting is completed
int inserted = 0;
register int how_much;
register int unprocessed;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object handler, val, insval, orig_filename;
Lisp_Object p;
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;
if (current_buffer->base_buffer && ! NILP (visit))
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);
/* Tell stat to use expensive method to get accurate info. */
Vw32_get_true_file_attributes = Qt;
- total = stat (XSTRING (filename)->data, &st);
+ total = stat (SDATA (filename), &st);
Vw32_get_true_file_attributes = tem;
}
if (total < 0)
#else
#ifndef APOLLO
- if (stat (XSTRING (filename)->data, &st) < 0)
+ if (stat (SDATA (filename), &st) < 0)
#else
- if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0
+ if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0
|| fstat (fd, &st) < 0)
#endif /* not APOLLO */
#endif /* WINDOWSNT */
#endif
if (fd < 0)
- if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0)
+ if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0)
goto badopen;
/* Replacement should preserve point as it preserves markers. */
record_unwind_protect (close_file_unwind, make_number (fd));
/* Supposedly happens on VMS. */
+ /* Can happen on any platform that uses long as type of off_t, but allows
+ file sizes to exceed 2Gb. VMS is no longer officially supported, so
+ give a message suitable for the latter case. */
if (! not_regular && st.st_size < 0)
- error ("File size is negative");
+ error ("Maximum buffer size exceeded");
/* Prevent redisplay optimizations. */
current_buffer->clip_changed = 1;
}
}
- if (BEG < Z)
+ 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 = Qutf_8_emacs;
+ 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 if (! NILP (replace))
/* In REPLACE mode, we can use the same coding system
that was used to visit the file. */
- val = current_buffer->buffer_file_coding_system;
+ coding_system = current_buffer->buffer_file_coding_system;
else
{
/* Don't try looking inside a file for a coding system
if (nread < 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, emacs_strerror (errno));
+ SDATA (orig_filename), emacs_strerror (errno));
else if (nread > 0)
{
struct buffer *prev = current_buffer;
- int count1;
+ Lisp_Object buffer;
+ struct buffer *buf;
record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
- /* The call to temp_output_buffer_setup binds
- standard-output. */
- count1 = specpdl_ptr - specpdl;
- temp_output_buffer_setup (" *code-converting-work*");
-
- set_buffer_internal (XBUFFER (Vstandard_output));
- current_buffer->enable_multibyte_characters = Qnil;
+ buffer = Fget_buffer_create (build_string (" *code-converting-work*"));
+ buf = XBUFFER (buffer);
+
+ 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);
+ Ferase_buffer ();
+ buf->enable_multibyte_characters = Qnil;
+
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));
++ filename, make_number (nread));
set_buffer_internal (prev);
- /* Remove the binding for standard-output. */
- unbind_to (count1, Qnil);
-
/* Discard the unwind protect for recovering the
current buffer. */
specpdl_ptr--;
}
}
- 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 = 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
nread = emacs_read (fd, buffer, sizeof buffer);
if (nread < 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, emacs_strerror (errno));
+ SDATA (orig_filename), emacs_strerror (errno));
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, 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;
nread = emacs_read (fd, buffer + total_read, trial - total_read);
if (nread < 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, emacs_strerror (errno));
+ SDATA (orig_filename), emacs_strerror (errno));
else if (nread == 0)
break;
total_read += nread;
}
-
+
/* Scan this bufferful from the end, comparing with
the Emacs buffer. */
bufpos = total_read;
-
+
/* 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
{
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 = BINDING_STACK_SIZE ();
++ int this_count = SPECPDL_INDEX ();
+ int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
+ Lisp_Object conversion_buffer
+ = make_conversion_work_buffer (-1, multibyte);
+ struct gcpro1;
+
+ record_unwind_protect (kill_workbuf_unwind, conversion_buffer);
/* 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)
{
- xfree (conversion_buffer);
-
if (how_much == -1)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, emacs_strerror (errno));
+ SDATA (orig_filename), emacs_strerror (errno));
else if (how_much == -2)
error ("maximum buffer size exceeded");
}
- /* Compare the beginning of the converted file
- with the buffer text. */
+ if (unprocessed > 0)
+ {
+ coding.mode |= CODING_MODE_LAST_BLOCK;
+ decode_coding_c_string (&coding, read_buf, unprocessed,
+ conversion_buffer);
+ coding.mode &= ~CODING_MODE_LAST_BLOCK;
+ }
+
+ 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);
- emacs_close (fd);
specpdl_ptr--;
/* Truncate the buffer to the size of the file. */
del_range_byte (same_at_start, same_at_end, 0);
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 -= (Z_BYTE - same_at_end) + (same_at_start - BEG_BYTE);
if (same_at_end != same_at_start)
- {
+ {
del_range_byte (same_at_start, same_at_end, 0);
temp = GPT;
same_at_start = GPT_BYTE;
}
/* Insert from the file at the proper position. */
SET_PT_BOTH (temp, same_at_start);
- insert_1 (conversion_buffer + same_at_start - BEG_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);
+ insert_from_buffer (XBUFFER (conversion_buffer),
+ same_at_start_charpos, inserted_chars, 0);
/* Set `inserted' to the number of inserted characters. */
inserted = PT - temp;
- xfree (conversion_buffer);
- emacs_close (fd);
- specpdl_ptr--;
+ unbind_to (this_count, Qnil);
goto handled;
}
before exiting the loop, it is set to a negative value if I/O
error occurs. */
how_much = 0;
-
+
/* Total bytes inserted. */
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;
-
+
while (how_much < total)
{
/* try is reserved in some compilers (Microsoft C) */
here doesn't do any harm. */
immediate_quit = 1;
QUIT;
- this = emacs_read (fd, BEG_ADDR + PT_BYTE - 1 + inserted, trytry);
+ this = emacs_read (fd, BEG_ADDR + PT_BYTE - BEG_BYTE + inserted, trytry);
immediate_quit = 0;
}
-
+
if (this <= 0)
{
how_much = this;
if (how_much < 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, emacs_strerror (errno));
+ SDATA (orig_filename), emacs_strerror (errno));
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
this way, we can run Lisp program safely before decoding
the inserted text. */
Lisp_Object unwind_data;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
unwind_data = Fcons (current_buffer->enable_multibyte_characters,
Fcons (current_buffer->undo_list,
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));
++ 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 = 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 (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 we have not yet decided how to decode a text,
+ decide it at first by detecting the file's encoding. */
+ if (CODING_REQUIRE_DETECTION (&coding))
+ {
+ coding_system = detect_coding_system (PT_ADDR, inserted, 1, 0,
+ coding_system);
+ setup_coding_system (coding_system, &coding);
+ }
+
+ 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_REQUIRE_DETECTION (&coding)
+ || CODING_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;
}
+ else if (inserted > 0)
+ adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
+ inserted);
+ /* Now INSERTED is measured in characters. */
+
#ifdef DOS_NT
/* 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 ((coding.eol_type == eol_type_undecided
++ if ((coding.eol_type == eol_type_undecided
+ || coding.eol_type == eol_type_lf)
&& ! CODING_REQUIRE_DECODING (&coding))
current_buffer->buffer_file_type = Qt;
else
if (!EQ (current_buffer->undo_list, Qt))
current_buffer->undo_list = Qnil;
#ifdef APOLLO
- stat (XSTRING (filename)->data, &st);
+ stat (SDATA (filename), &st);
#endif
if (NILP (handler))
Fcons (orig_filename, Qnil)));
}
- Vlast_coding_system_used = coding.symbol;
+ if (set_coding_system)
++ Vlast_coding_system_used = coding_system;
+
+ if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
+ {
+ insval = call1 (Qafter_insert_file_set_coding, make_number (inserted));
+ if (! NILP (insval))
+ {
+ CHECK_NUMBER (insval);
+ inserted = XFASTINT (insval);
+ }
+ }
+
/* Decode file format */
if (inserted > 0)
{
int empty_undo_list_p = 0;
-
+
/* If we're anyway going to discard undo information, don't
record it in the first place. The buffer's undo list at this
point is either nil or t when visiting a file. */
empty_undo_list_p = NILP (current_buffer->undo_list);
current_buffer->undo_list = Qt;
}
-
+
insval = call3 (Qformat_decode,
Qnil, make_number (inserted), visit);
CHECK_NUMBER (insval);
inserted = XFASTINT (insval);
-
+
if (!NILP (visit))
current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt;
}
- if (set_coding_system)
- Vlast_coding_system_used = coding_system;
-
/* Call after-change hooks for the inserted text, aside from the case
of normal visiting (not with REPLACE), which is done in a new buffer
"before" the buffer is changed. */
}
p = Vafter_insert_file_functions;
- while (!NILP (p))
+ while (CONSP (p))
{
- insval = call1 (Fcar (p), make_number (inserted));
+ insval = call1 (XCAR (p), make_number (inserted));
if (!NILP (insval))
{
CHECK_NUMBER (insval);
inserted = XFASTINT (insval);
}
QUIT;
- p = Fcdr (p);
+ p = XCDR (p);
}
if (!NILP (visit)
}
\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;
Lisp_Object val;
if (auto_saving)
- {
- /* 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;
- goto done_setup_coding;
- }
- val = Qnil;
++ val = Qutf_8_emacs;
else if (!NILP (Vcoding_system_for_write))
- val = Vcoding_system_for_write;
+ {
+ val = Vcoding_system_for_write;
+ if (coding_system_require_warning
+ && !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, Fcons (Qt, Fcons (val, Qnil)),
+ Qnil, filename);
+ }
else
{
/* If the variable `buffer-file-coding-system' is set locally,
if (NILP (current_buffer->enable_multibyte_characters))
force_raw_text = 1;
}
-
+
if (NILP (val))
{
/* Check file-coding-system-alist. */
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. */
val = current_buffer->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 = call3 (Vselect_safe_coding_system_function, start, end, val);
+ 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);
+ setup_coding_system (val, coding);
+ if (! NILP (val)
+ && VECTORP (CODING_ID_EOL_TYPE (coding->id)))
+ val = AREF (CODING_ID_EOL_TYPE (coding->id), 0);
- done_setup_coding:
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,
the output goes to FILENAME, but the buffer is marked as visiting VISIT.
VISIT is also the file name to lock and unlock for clash detection.
If VISIT is neither t nor nil nor a string,
- that means do not print the \"Wrote file\" message.
+ that means do not display the \"Wrote file\" message.
The optional sixth arg LOCKNAME, if non-nil, specifies the name to
use for locking and unlocking, overriding FILENAME and VISIT.
The optional seventh arg MUSTBENEW, if non-nil, insists on a check
register int desc;
int failure;
int save_errno = 0;
- unsigned char *fn;
+ const unsigned char *fn;
struct stat st;
int tem;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int count1;
#ifdef VMS
unsigned char *fname = 0; /* If non-0, original filename (must rename) */
return val;
}
+ record_unwind_protect (save_restriction_restore, save_restriction_save ());
+
/* Special kludge to simplify auto-saving. */
if (NILP (start))
{
XSETFASTINT (start, BEG);
XSETFASTINT (end, Z);
+ Fwiden ();
}
record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
- count1 = specpdl_ptr - specpdl;
+ count1 = SPECPDL_INDEX ();
given_buffer = current_buffer;
- annotations = build_annotations (start, end);
- if (current_buffer != given_buffer)
+
+ if (!STRINGP (start))
{
- XSETFASTINT (start, BEGV);
- XSETFASTINT (end, ZV);
+ annotations = build_annotations (start, end);
+
+ if (current_buffer != given_buffer)
+ {
+ XSETFASTINT (start, BEGV);
+ XSETFASTINT (end, ZV);
+ }
}
UNGCPRO;
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);
- given_buffer = current_buffer;
- if (current_buffer != given_buffer)
- {
- XSETFASTINT (start, BEGV);
- XSETFASTINT (end, ZV);
- }
-
#ifdef CLASH_DETECTION
if (!auto_saving)
{
encoded_filename = ENCODE_FILE (filename);
- fn = XSTRING (encoded_filename)->data;
+ fn = SDATA (encoded_filename);
desc = -1;
if (!NILP (append))
#ifdef DOS_NT
desc = emacs_open (fn, O_RDWR, 0);
if (desc < 0)
desc = creat_copy_attrs (STRINGP (current_buffer->filename)
- ? XSTRING (current_buffer->filename)->data : 0,
+ ? SDATA (current_buffer->filename) : 0,
fn);
}
else /* Write to temporary name and rename if no errors */
{
temp_name = Fmake_temp_name (concat2 (temp_name,
build_string ("$$SAVE$$")));
- fname = XSTRING (filename)->data;
- fn = XSTRING (temp_name)->data;
+ fname = SDATA (filename);
+ fn = SDATA (temp_name);
desc = creat_copy_attrs (fname, fn);
if (desc < 0)
{
if (!NILP (append) && !NILP (Ffile_regular_p (filename)))
{
long ret;
-
+
if (NUMBERP (append))
ret = lseek (desc, XINT (append), 1);
else
report_file_error ("Lseek error", Fcons (filename, Qnil));
}
}
-
+
UNGCPRO;
#ifdef VMS
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;
if (STRINGP (start))
{
- failure = 0 > a_write (desc, start, 0, XSTRING (start)->size,
+ failure = 0 > a_write (desc, start, 0, SCHARS (start),
&annotations, &coding);
save_errno = errno;
}
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;
}
current_buffer->modtime = st.st_mtime;
if (failure)
- error ("IO error writing %s: %s", XSTRING (filename)->data,
+ error ("IO error writing %s: %s", SDATA (filename),
emacs_strerror (save_errno));
if (visiting)
return Qnil;
if (!auto_saving)
- message_with_string ("Wrote %s", visit_file, 1);
+ message_with_string ((! INTEGERP (append)
+ ? "Updated %s"
+ : ! NILP (append)
+ ? "Added to %s"
+ : "Wrote %s"),
+ visit_file, 1);
return Qnil;
}
Lisp_Object p, res;
struct gcpro gcpro1, gcpro2;
Lisp_Object original_buffer;
- int i;
+ int i, used_global = 0;
XSETBUFFER (original_buffer, current_buffer);
annotations = Qnil;
p = Vwrite_region_annotate_functions;
GCPRO2 (annotations, p);
- while (!NILP (p))
+ while (CONSP (p))
{
struct buffer *given_buffer = current_buffer;
+ if (EQ (Qt, XCAR (p)) && !used_global)
+ { /* Use the global value of the hook. */
+ Lisp_Object arg[2];
+ used_global = 1;
+ arg[0] = Fdefault_value (Qwrite_region_annotate_functions);
+ arg[1] = XCDR (p);
+ p = Fappend (2, arg);
+ continue;
+ }
Vwrite_region_annotations_so_far = annotations;
- res = call2 (Fcar (p), start, end);
+ res = call2 (XCAR (p), start, end);
/* If the function makes a different buffer current,
assume that means this buffer contains altered text to be output.
Reset START and END from the buffer bounds
}
Flength (res); /* Check basic validity of return value */
annotations = merge (annotations, res, Qcar_less_than_car);
- p = Fcdr (p);
+ p = XCDR (p);
}
/* Now do the same for annotation functions implied by the file-format */
p = Vauto_save_file_format;
else
p = current_buffer->file_format;
- for (i = 0; !NILP (p); p = Fcdr (p), ++i)
+ for (i = 0; CONSP (p); p = XCDR (p), ++i)
{
struct buffer *given_buffer = current_buffer;
-
+
Vwrite_region_annotations_so_far = annotations;
/* Value is either a list of annotations or nil if the function
has written annotations to a temporary buffer, which is now
current. */
- res = call5 (Qformat_annotate_function, Fcar (p), start, end,
+ res = call5 (Qformat_annotate_function, XCAR (p), start, end,
original_buffer, make_number (i));
if (current_buffer != given_buffer)
{
XSETFASTINT (end, ZV);
annotations = Qnil;
}
-
+
if (CONSP (res))
annotations = merge (annotations, res, Qcar_less_than_car);
}
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.
tem = Fcdr (Fcar (*annot));
if (STRINGP (tem))
{
- if (0 > e_write (desc, tem, 0, XSTRING (tem)->size, coding))
+ if (0 > e_write (desc, tem, 0, SCHARS (tem), coding))
return -1;
}
*annot = Fcdr (*annot);
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 = XSTRING (string)->size;
++ end = SCHARS (string);
}
- coding->mode |= CODING_MODE_FIXED_DESTINATION;
- if (! NILP (current_buffer->selective_display))
- coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
-
/* We used to have a code for handling selective display here. But,
now it is handled within encode_coding. */
- while (1)
+ do
{
- int result;
+ if (STRINGP (string))
+ encode_coding_object (coding, string,
+ start, string_char_to_byte (string, start),
+ end, string_char_to_byte (string, end), Qt);
+ else
+ encode_coding_object (coding, Fcurrent_buffer (),
+ start, CHAR_TO_BYTE (start),
+ end, CHAR_TO_BYTE (end), Qt);
- result = encode_coding (coding, addr, buf, nbytes, WRITE_BUF_SIZE);
if (coding->produced > 0)
{
- coding->produced -= emacs_write (desc, buf, coding->produced);
- coding->produced -= emacs_write (desc,
- XSTRING (coding->dst_object)->data,
++ coding->produced -= emacs_write (desc, SDATA (coding->dst_object),
+ coding->produced);
++
if (coding->produced)
{
return_val = -1;
break;
}
}
- nbytes -= coding->consumed;
- addr += coding->consumed;
- if (result == CODING_FINISH_INSUFFICIENT_SRC
- && nbytes > 0)
- {
- /* 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)
- {
- return_val = -1;
- break;
- }
- }
- if (nbytes <= 0)
- break;
start += coding->consumed_char;
- if (coding->cmp_data)
- coding_adjust_composition_offset (coding, start);
}
-
- if (coding->cmp_data)
- coding_free_composition_data (coding);
+ while (start < end);
return return_val;
}
filename = ENCODE_FILE (b->filename);
- if (stat (XSTRING (filename)->data, &st) < 0)
+ if (stat (SDATA (filename), &st) < 0)
{
/* If the file doesn't exist now and didn't exist before,
we say that it isn't modified, provided the error is a tame one. */
filename = ENCODE_FILE (filename);
- if (stat (XSTRING (filename)->data, &st) >= 0)
+ if (stat (SDATA (filename), &st) >= 0)
current_buffer->modtime = st.st_mtime;
}
Lisp_Object args[3], msg;
int i, nbytes;
struct gcpro gcpro1;
-
+
ring_bell ();
-
+
args[0] = build_string ("Auto-saving %s: %s");
args[1] = current_buffer->name;
args[2] = Ferror_message_string (error);
msg = Fformat (3, args);
GCPRO1 (msg);
- nbytes = STRING_BYTES (XSTRING (msg));
+ nbytes = SBYTES (msg);
for (i = 0; i < 3; ++i)
{
if (i == 0)
- message2 (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));
+ message2 (SDATA (msg), nbytes, STRING_MULTIBYTE (msg));
else
- message2_nolog (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));
+ message2_nolog (SDATA (msg), nbytes, STRING_MULTIBYTE (msg));
Fsleep_for (make_number (1), Qnil);
}
/* Get visited file's mode to become the auto save file's mode. */
if (! NILP (current_buffer->filename)
- && stat (XSTRING (current_buffer->filename)->data, &st) >= 0)
+ && stat (SDATA (current_buffer->filename), &st) >= 0)
/* But make sure we can overwrite it later! */
auto_save_mode_bits = st.st_mode | 0600;
else
if (!NILP (stream))
fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16
| XFASTINT (XCDR (stream))));
- pop_message ();
return Qnil;
}
return Qnil;
}
+static Lisp_Object
+do_auto_save_make_dir (dir)
+ Lisp_Object dir;
+{
+ return call2 (Qmake_directory, dir, Qt);
+}
+
+static Lisp_Object
+do_auto_save_eh (ignore)
+ Lisp_Object ignore;
+{
+ return Qnil;
+}
+
DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
doc: /* Auto-save all buffers that need it.
This is all buffers that have auto-saving enabled
Lisp_Object oquit;
FILE *stream;
Lisp_Object lispstream;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int orig_minibuffer_auto_raise = minibuffer_auto_raise;
- int message_p = 0;
+ int old_message_p = 0;
+ struct gcpro gcpro1, gcpro2;
if (max_specpdl_size < specpdl_size + 40)
max_specpdl_size = specpdl_size + 40;
if (minibuf_level)
no_message = Qt;
- if (NILP (no_message));
- message_p = push_message ();
-
+ if (NILP (no_message))
+ {
+ old_message_p = push_message ();
+ record_unwind_protect (pop_message_unwind, Qnil);
+ }
+
/* Ordinarily don't quit within this function,
but don't make it impossible to quit (in case we get hung in I/O). */
oquit = Vquit_flag;
if (STRINGP (Vauto_save_list_file_name))
{
Lisp_Object listfile;
-
+
listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
/* Don't try to create the directory when shutting down Emacs,
if (!NILP (Vrun_hooks))
{
Lisp_Object dir;
+ dir = Qnil;
+ GCPRO2 (dir, listfile);
dir = Ffile_name_directory (listfile);
if (NILP (Ffile_directory_p (dir)))
- call2 (Qmake_directory, dir, Qt);
+ internal_condition_case_1 (do_auto_save_make_dir,
+ dir, Fcons (Fcons (Qfile_error, Qnil), Qnil),
+ do_auto_save_eh);
+ UNGCPRO;
}
-
- stream = fopen (XSTRING (listfile)->data, "w");
+
+ stream = fopen (SDATA (listfile), "w");
if (stream != NULL)
{
/* Arrange to close that file whether or not we get an error.
{
if (!NILP (b->filename))
{
- fwrite (XSTRING (b->filename)->data, 1,
- STRING_BYTES (XSTRING (b->filename)), stream);
+ fwrite (SDATA (b->filename), 1,
+ SBYTES (b->filename), stream);
}
putc ('\n', stream);
- fwrite (XSTRING (b->auto_save_file_name)->data, 1,
- STRING_BYTES (XSTRING (b->auto_save_file_name)), stream);
+ fwrite (SDATA (b->auto_save_file_name), 1,
+ SBYTES (b->auto_save_file_name), stream);
putc ('\n', stream);
}
if (auto_saved && NILP (no_message))
{
- if (message_p)
+ if (old_message_p)
{
+ /* If we are going to restore an old message,
+ give time to read ours. */
sit_for (1, 0, 0, 0, 0);
restore_message ();
}
else
+ /* If we displayed a message and then restored a state
+ with no message, leave a "done" message on the screen. */
message1 ("Auto-saving...done");
}
Vquit_flag = oquit;
+ /* This restores the message-stack status. */
unbind_to (count, Qnil);
return Qnil;
}
double_dollars (val)
Lisp_Object val;
{
- register unsigned char *old, *new;
+ register const unsigned char *old;
+ register unsigned char *new;
register int n;
int osize, count;
- osize = STRING_BYTES (XSTRING (val));
+ osize = SBYTES (val);
/* Count the number of $ characters. */
- for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--)
+ for (n = osize, count = 0, old = SDATA (val); n > 0; n--)
if (*old++ == '$') count++;
if (count > 0)
{
- old = XSTRING (val)->data;
- val = make_uninit_multibyte_string (XSTRING (val)->size + count,
+ old = SDATA (val);
+ val = make_uninit_multibyte_string (SCHARS (val) + count,
osize + count);
- new = XSTRING (val)->data;
+ new = SDATA (val);
for (n = osize; n > 0; n--)
if (*old != '$')
*new++ = *old++;
return val;
}
+static Lisp_Object
+read_file_name_cleanup (arg)
+ Lisp_Object arg;
+{
+ return (current_buffer->directory = arg);
+}
+
DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal,
3, 3, 0,
doc: /* Internal subroutine for read-file-name. Do not call this. */)
/* No need to protect ACTION--we only compare it with t and nil. */
GCPRO5 (string, realdir, name, specdir, orig_string);
- if (XSTRING (string)->size == 0)
+ if (SCHARS (string) == 0)
{
if (EQ (action, Qlambda))
{
UNGCPRO;
if (EQ (action, Qt))
- return Ffile_name_all_completions (name, realdir);
+ {
+ Lisp_Object all = Ffile_name_all_completions (name, realdir);
+ Lisp_Object comp;
+ int count;
+
+ if (NILP (Vread_file_name_predicate)
+ || EQ (Vread_file_name_predicate, Qfile_exists_p))
+ return all;
+
+#ifndef VMS
+ if (EQ (Vread_file_name_predicate, Qfile_directory_p))
+ {
+ /* Brute-force speed up for directory checking:
+ Discard strings which don't end in a slash. */
+ for (comp = Qnil; CONSP (all); all = XCDR (all))
+ {
+ Lisp_Object tem = XCAR (all);
+ int len;
+ if (STRINGP (tem) &&
+ (len = SCHARS (tem), len > 0) &&
+ IS_DIRECTORY_SEP (SREF (tem, len-1)))
+ comp = Fcons (tem, comp);
+ }
+ }
+ else
+#endif
+ {
+ /* Must do it the hard (and slow) way. */
+ GCPRO3 (all, comp, specdir);
+ count = SPECPDL_INDEX ();
+ record_unwind_protect (read_file_name_cleanup, current_buffer->directory);
+ current_buffer->directory = realdir;
+ for (comp = Qnil; CONSP (all); all = XCDR (all))
+ if (!NILP (call1 (Vread_file_name_predicate, XCAR (all))))
+ comp = Fcons (XCAR (all), comp);
+ unbind_to (count, Qnil);
+ UNGCPRO;
+ }
+ return Fnreverse (comp);
+ }
+
/* Only other case actually used is ACTION = lambda */
#ifdef VMS
/* Supposedly this helps commands such as `cd' that read directory names,
but can someone explain how it helps them? -- RMS */
- if (XSTRING (name)->size == 0)
+ if (SCHARS (name) == 0)
return Qt;
#endif /* VMS */
+ if (!NILP (Vread_file_name_predicate))
+ return call1 (Vread_file_name_predicate, string);
return Ffile_exists_p (string);
}
-DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
+DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0,
doc: /* Read file name, prompting with PROMPT and completing in directory DIR.
Value is not expanded---you must call `expand-file-name' yourself.
Default name to DEFAULT-FILENAME if user enters a null string.
Fourth arg MUSTMATCH non-nil means require existing file's name.
Non-nil and non-t means also require confirmation after completion.
Fifth arg INITIAL specifies text to start with.
+If optional sixth arg PREDICATE is non-nil, possible completions and the
+resulting file name must satisfy (funcall PREDICATE NAME).
DIR defaults to current buffer's directory default.
If this command was invoked with the mouse, use a file dialog box if
`use-dialog-box' is non-nil, and the window system or X toolkit in use
provides a file dialog box. */)
- (prompt, dir, default_filename, mustmatch, initial)
- Lisp_Object prompt, dir, default_filename, mustmatch, initial;
+ (prompt, dir, default_filename, mustmatch, initial, predicate)
+ Lisp_Object prompt, dir, default_filename, mustmatch, initial, predicate;
{
Lisp_Object val, insdef, tem;
struct gcpro gcpro1, gcpro2;
register char *homedir;
+ Lisp_Object decoded_homedir;
int replace_in_history = 0;
int add_to_history = 0;
int count;
if (NILP (dir))
dir = current_buffer->directory;
if (NILP (default_filename))
- {
- if (! NILP (initial))
- default_filename = Fexpand_file_name (initial, dir);
- else
- default_filename = current_buffer->filename;
- }
+ default_filename = !NILP (initial)
+ ? Fexpand_file_name (initial, dir)
+ : current_buffer->filename;
/* If dir starts with user's homedir, change that to ~. */
homedir = (char *) egetenv ("HOME");
CORRECT_DIR_SEPS (homedir);
}
#endif
+ if (homedir != 0)
+ decoded_homedir
+ = DECODE_FILE (make_unibyte_string (homedir, strlen (homedir)));
if (homedir != 0
&& STRINGP (dir)
- && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
- && IS_DIRECTORY_SEP (XSTRING (dir)->data[strlen (homedir)]))
+ && !strncmp (SDATA (decoded_homedir), SDATA (dir),
+ SBYTES (decoded_homedir))
+ && IS_DIRECTORY_SEP (SREF (dir, SBYTES (decoded_homedir))))
{
- dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
- STRING_BYTES (XSTRING (dir)) - strlen (homedir) + 1);
- XSTRING (dir)->data[0] = '~';
+ dir = Fsubstring (dir, make_number (SCHARS (decoded_homedir)), Qnil);
+ dir = concat2 (build_string ("~"), dir);
}
/* Likewise for default_filename. */
if (homedir != 0
&& STRINGP (default_filename)
- && !strncmp (homedir, XSTRING (default_filename)->data, strlen (homedir))
- && IS_DIRECTORY_SEP (XSTRING (default_filename)->data[strlen (homedir)]))
+ && !strncmp (SDATA (decoded_homedir), SDATA (default_filename),
+ SBYTES (decoded_homedir))
+ && IS_DIRECTORY_SEP (SREF (default_filename, SBYTES (decoded_homedir))))
{
default_filename
- = make_string (XSTRING (default_filename)->data + strlen (homedir) - 1,
- STRING_BYTES (XSTRING (default_filename)) - strlen (homedir) + 1);
- XSTRING (default_filename)->data[0] = '~';
+ = Fsubstring (default_filename,
+ make_number (SCHARS (decoded_homedir)), Qnil);
+ default_filename = concat2 (build_string ("~"), default_filename);
}
if (!NILP (default_filename))
{
args[0] = insdef;
args[1] = initial;
insdef = Fconcat (2, args);
- pos = make_number (XSTRING (double_dollars (dir))->size);
+ pos = make_number (SCHARS (double_dollars (dir)));
insdef = Fcons (double_dollars (insdef), pos);
}
else
else
insdef = Qnil;
- count = specpdl_ptr - specpdl;
+ if (!NILP (Vread_file_name_function))
+ {
+ Lisp_Object args[7];
+
+ GCPRO2 (insdef, default_filename);
+ args[0] = Vread_file_name_function;
+ args[1] = prompt;
+ args[2] = dir;
+ args[3] = default_filename;
+ args[4] = mustmatch;
+ args[5] = initial;
+ args[6] = predicate;
+ RETURN_UNGCPRO (Ffuncall (7, args));
+ }
+
+ count = SPECPDL_INDEX ();
#ifdef VMS
specbind (intern ("completion-ignore-case"), Qt);
#endif
specbind (intern ("minibuffer-completing-file-name"), Qt);
+ specbind (intern ("read-file-name-predicate"),
+ (NILP (predicate) ? Qfile_exists_p : predicate));
GCPRO2 (insdef, default_filename);
-
-#if defined (USE_MOTIF) || defined (HAVE_NTGUI)
+
+#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& use_dialog_box
&& have_menus_p ())
/* If DIR contains a file name, split it. */
Lisp_Object file;
file = Ffile_name_nondirectory (dir);
- if (XSTRING (file)->size && NILP (default_filename))
+ if (SCHARS (file) && NILP (default_filename))
{
default_filename = file;
dir = Ffile_name_directory (dir);
if (! replace_in_history)
add_to_history = 1;
- val = build_string ("");
+ val = empty_string;
}
unbind_to (count, Qnil);
if (!NILP (tem) && !NILP (default_filename))
val = default_filename;
- else if (XSTRING (val)->size == 0 && NILP (insdef))
+ else if (SCHARS (val) == 0 && NILP (insdef))
{
if (!NILP (default_filename))
val = default_filename;
Fset (Qfile_name_history,
Fcons (val1, tem));
}
-
+
return val;
}
Qwrite_region = intern ("write-region");
Qverify_visited_file_modtime = intern ("verify-visited-file-modtime");
Qset_visited_file_modtime = intern ("set-visited-file-modtime");
+ Qauto_save_coding = intern ("auto-save-coding");
staticpro (&Qexpand_file_name);
staticpro (&Qsubstitute_in_file_name);
staticpro (&Qwrite_region);
staticpro (&Qverify_visited_file_modtime);
staticpro (&Qset_visited_file_modtime);
+ staticpro (&Qauto_save_coding);
Qfile_name_history = intern ("file-name-history");
Fset (Qfile_name_history, Qnil);
staticpro (&Qformat_decode);
Qformat_annotate_function = intern ("format-annotate-function");
staticpro (&Qformat_annotate_function);
-
+ Qafter_insert_file_set_coding = intern ("after-insert-file-set-coding");
+ staticpro (&Qafter_insert_file_set_coding);
+
Qcar_less_than_car = intern ("car-less-than-car");
staticpro (&Qcar_less_than_car);
Fput (Qfile_date_error, Qerror_message,
build_string ("Cannot set file date"));
+ DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function,
+ doc: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
+ Vread_file_name_function = Qnil;
+
+ DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate,
+ doc: /* Current predicate used by `read-file-name-internal'. */);
+ Vread_file_name_predicate = Qnil;
+
DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
doc: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
insert_default_directory = 1;
DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char,
doc: /* Directory separator character for built-in functions that return file names.
-The value should be either ?/ or ?\\ (any other value is treated as ?\\).
-This variable affects the built-in functions only on Windows,
-on other platforms, it is initialized so that Lisp code can find out
-what the normal separator is.
-
-WARNING: This variable is deprecated and will be removed in the near
-future. DO NOT USE IT. */);
+The value is always ?/. Don't use this variable, just use `/'. */);
DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
doc: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions,
doc: /* A list of functions to be called at the end of `insert-file-contents'.
-Each is passed one argument, the number of bytes inserted. It should return
-the new byte count, and leave point the same. If `insert-file-contents' is
-intercepted by a handler from `file-name-handler-alist', that handler is
-responsible for calling the after-insert-file-functions if appropriate. */);
+Each is passed one argument, the number of characters inserted.
+It should return the new character count, and leave point the same.
+If `insert-file-contents' is intercepted by a handler from
+`file-name-handler-alist', that handler is responsible for calling the
+functions in `after-insert-file-functions' if appropriate. */);
Vafter_insert_file_functions = Qnil;
DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions,
inserted at the specified positions of the file being written (1 means to
insert before the first byte written). The POSITIONs must be sorted into
increasing order. If there are several functions in the list, the several
-lists are merged destructively. */);
+lists are merged destructively. Alternatively, the function can return
+with a different buffer current; in that case it should pay attention
+to the annotations returned by previous functions and listed in
+`write-region-annotations-so-far'.*/);
Vwrite_region_annotate_functions = Qnil;
+ staticpro (&Qwrite_region_annotate_functions);
+ Qwrite_region_annotate_functions
+ = intern ("write-region-annotate-functions");
DEFVAR_LISP ("write-region-annotations-so-far",
&Vwrite_region_annotations_so_far,
defsubr (&Sunix_sync);
#endif
}
-
#include "lisp.h"
#include "buffer.h"
- #include "charset.h"
+ #include "character.h"
-#include "charset.h"
#include "coding.h"
#include "systime.h"
#ifndef WTMP_FILE
#define WTMP_FILE "/var/log/wtmp"
#endif
-
+
/* The strategy: to lock a file FN, create a symlink .#FN in FN's
directory, with link data `user@host.pid'. This avoids a single
mount (== failure) point for lock files.
When the host in the lock data is the current host, we can check if
the pid is valid with kill.
-
+
Otherwise, we could look at a separate file that maps hostnames to
reboot times to see if the remote pid can possibly be valid, since we
don't want Emacs to have to communicate via pipes or sockets or
files to be useful on old systems lacking symlinks, nowadays
virtually all such systems are probably single-user anyway, so it
didn't seem worth the complication.
-
+
Similarly, we don't worry about a possible 14-character limit on
file names, because those are all the same systems that don't have
symlinks.
-
+
This is compatible with the locking scheme used by Interleaf (which
has contributed this implementation for Emacs), and was designed by
Ethan Jacobson, Kimbo Mundy, and others.
-
+
--karl@cs.umb.edu/karl@hq.ileaf.com. */
\f
args[3] = Qnil;
args[4] = build_string ("-c");
sprintf (cmd_string, "gunzip < %s.%d.gz > %s",
- WTMP_FILE, counter, XSTRING (tempname)->data);
+ WTMP_FILE, counter, SDATA (tempname));
args[5] = build_string (cmd_string);
Fcall_process (6, args);
filename = tempname;
if (! NILP (filename))
{
- get_boot_time_1 (XSTRING (filename)->data, 1);
+ get_boot_time_1 (SDATA (filename), 1);
if (delete_flag)
- unlink (XSTRING (filename)->data);
+ unlink (SDATA (filename));
}
}
trailing period plus one for the digit after it plus one for the
null. */
#define MAKE_LOCK_NAME(lock, file) \
- (lock = (char *) alloca (STRING_BYTES (XSTRING (file)) + 2 + 1 + 1 + 1), \
+ (lock = (char *) alloca (SBYTES (file) + 2 + 1 + 1 + 1), \
fill_in_lock_file_name (lock, (file)))
static void
struct stat st;
int count = 0;
- strcpy (lockfile, XSTRING (fn)->data);
+ strcpy (lockfile, SDATA (fn));
/* Shift the nondirectory part of the file name (including the null)
right two characters. Here is one of the places where we'd have to
do something to support 14-character-max file names. */
for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--)
p[2] = *p;
-
+
/* Insert the `.#'. */
p[1] = '.';
p[2] = '#';
static int
lock_file_1 (lfname, force)
- char *lfname;
+ char *lfname;
int force;
{
register int err;
char *lock_info_str;
if (STRINGP (Fuser_login_name (Qnil)))
- user_name = (char *)XSTRING (Fuser_login_name (Qnil))->data;
+ user_name = (char *)SDATA (Fuser_login_name (Qnil));
else
user_name = "";
if (STRINGP (Fsystem_name ()))
- host_name = (char *)XSTRING (Fsystem_name ())->data;
+ host_name = (char *)SDATA (Fsystem_name ());
else
host_name = "";
lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name)
(unsigned long) getpid (), (unsigned long) boot_time);
else
sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name,
- (unsigned long) getpid ());
+ (unsigned long) getpid ());
err = symlink (lock_info_str, lfname);
if (errno == EEXIST && force)
#endif
}
while (len >= bufsize);
-
+
/* If nonexistent lock file, all is well; otherwise, got strange error. */
if (len == -1)
{
/* Link info exists, so `len' is its length. Null terminate. */
lfinfo[len] = 0;
-
+
/* Even if the caller doesn't want the owner info, we still have to
read it to determine return value, so allocate it. */
if (!owner)
owner = (lock_info_type *) alloca (sizeof (lock_info_type));
local_owner = 1;
}
-
+
/* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return -1. */
/* The USER is everything before the first @. */
at = index (lfinfo, '@');
owner->user = (char *) xmalloc (len + 1);
strncpy (owner->user, lfinfo, len);
owner->user[len] = 0;
-
+
/* The PID is everything from the last `.' to the `:'. */
owner->pid = atoi (dot + 1);
colon = dot;
/* We're done looking at the link info. */
xfree (lfinfo);
-
+
/* On current host? */
if (STRINGP (Fsystem_name ())
- && strcmp (owner->host, XSTRING (Fsystem_name ())->data) == 0)
+ && strcmp (owner->host, SDATA (Fsystem_name ())) == 0)
{
if (owner->pid == getpid ())
ret = 2; /* We own it. */
here's where we'd do it. */
ret = 1;
}
-
+
/* Avoid garbage. */
if (local_owner || ret <= 0)
{
static int
lock_if_free (clasher, lfname)
lock_info_type *clasher;
- register char *lfname;
+ register char *lfname;
{
while (lock_file_1 (lfname, 0) == 0)
{
if (errno != EEXIST)
return -1;
-
+
locker = current_lock_owner (clasher, lfname);
if (locker == 2)
{
sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
lock_info.pid);
FREE_LOCK_INFO (lock_info);
-
+
attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
if (!NILP (attack))
/* User says take the lock */
if (SAVE_MODIFF < MODIFF
&& !NILP (file))
lock_file (file);
- return Qnil;
+ return Qnil;
}
DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
/* Random utility Lisp functions.
- Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 01, 02
+ Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001, 02, 2003
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#endif
#include <time.h>
+#ifndef MAC_OSX
+/* On Mac OS X, defining this conflicts with precompiled headers. */
+
/* Note on some machines this defines `vector' as a typedef,
so make sure we don't use that name in this file. */
#undef vector
#define vector *****
+#endif /* ! MAC_OSX */
+
#include "lisp.h"
#include "commands.h"
- #include "charset.h"
+ #include "character.h"
#include "coding.h"
#include "buffer.h"
#include "keyboard.h"
#endif
#ifndef NULL
-#define NULL (void *)0
+#define NULL ((POINTER_TYPE *)0)
#endif
/* Nonzero enables use of dialog boxes for questions
Lisp_Object Qyes_or_no_p_history;
Lisp_Object Qcursor_in_echo_area;
Lisp_Object Qwidget_type;
-Lisp_Object Qcodeset, Qdays, Qmonths;
+Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
extern Lisp_Object Qinput_method_function;
DEFUN ("length", Flength, Slength, 1, 1, 0,
doc: /* Return the length of vector, list or string SEQUENCE.
A byte-code function object is also allowed.
-If the string contains multibyte characters, this is not the necessarily
+If the string contains multibyte characters, this is not necessarily
the number of bytes in the string; it is the number of characters.
To get the number of bytes, use `string-bytes'. */)
(sequence)
retry:
if (STRINGP (sequence))
- XSETFASTINT (val, XSTRING (sequence)->size);
+ XSETFASTINT (val, SCHARS (sequence));
else if (VECTORP (sequence))
XSETFASTINT (val, XVECTOR (sequence)->size);
- 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))
return length;
}
-DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
+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. */)
(string)
Lisp_Object string;
{
CHECK_STRING (string);
- return make_number (STRING_BYTES (XSTRING (string)));
+ return make_number (SBYTES (string));
}
DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
register Lisp_Object s1, s2;
{
if (SYMBOLP (s1))
- XSETSTRING (s1, XSYMBOL (s1)->name);
+ s1 = SYMBOL_NAME (s1);
if (SYMBOLP (s2))
- XSETSTRING (s2, XSYMBOL (s2)->name);
+ s2 = SYMBOL_NAME (s2);
CHECK_STRING (s1);
CHECK_STRING (s2);
- if (XSTRING (s1)->size != XSTRING (s2)->size
- || STRING_BYTES (XSTRING (s1)) != STRING_BYTES (XSTRING (s2))
- || bcmp (XSTRING (s1)->data, XSTRING (s2)->data, STRING_BYTES (XSTRING (s1))))
+ if (SCHARS (s1) != SCHARS (s2)
+ || SBYTES (s1) != SBYTES (s2)
+ || bcmp (SDATA (s1), SDATA (s2), SBYTES (s1)))
return Qnil;
return Qt;
}
i1_byte = string_char_to_byte (str1, i1);
i2_byte = string_char_to_byte (str2, i2);
- end1_char = XSTRING (str1)->size;
+ end1_char = SCHARS (str1);
if (! NILP (end1) && end1_char > XINT (end1))
end1_char = XINT (end1);
- end2_char = XSTRING (str2)->size;
+ end2_char = SCHARS (str2);
if (! NILP (end2) && end2_char > XINT (end2))
end2_char = XINT (end2);
FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c1, str1, i1, i1_byte);
else
{
- c1 = XSTRING (str1)->data[i1++];
+ c1 = SREF (str1, i1++);
c1 = unibyte_char_to_multibyte (c1);
}
FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c2, str2, i2, i2_byte);
else
{
- c2 = XSTRING (str2)->data[i2++];
+ c2 = SREF (str2, i2++);
c2 = unibyte_char_to_multibyte (c2);
}
register int i1, i1_byte, i2, i2_byte;
if (SYMBOLP (s1))
- XSETSTRING (s1, XSYMBOL (s1)->name);
+ s1 = SYMBOL_NAME (s1);
if (SYMBOLP (s2))
- XSETSTRING (s2, XSYMBOL (s2)->name);
+ s2 = SYMBOL_NAME (s2);
CHECK_STRING (s1);
CHECK_STRING (s2);
i1 = i1_byte = i2 = i2_byte = 0;
- end = XSTRING (s1)->size;
- if (end > XSTRING (s2)->size)
- end = XSTRING (s2)->size;
+ end = SCHARS (s1);
+ if (end > SCHARS (s2))
+ end = SCHARS (s2);
while (i1 < end)
{
if (c1 != c2)
return c1 < c2 ? Qt : Qnil;
}
- return i1 < XSTRING (s2)->size ? Qt : Qnil;
+ return i1 < SCHARS (s2) ? Qt : Qnil;
}
\f
static Lisp_Object concat ();
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 (XCHAR_TABLE (arg)->defalt);
- int i;
-
- /* 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 or string.
+ doc: /* Return a copy of a list, vector, string or char-table.
The elements of a list or vector are not copied; they are shared
with the original. */)
(arg)
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))
{
Lisp_Object val;
return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
}
+ #if 0 /* unused */
/* In string STR of length LEN, see if bytes before STR[I] combine
with bytes after STR[I] to form a single character. If so, return
the number of bytes after STR[I] which combine in this way.
PARSE_MULTIBYTE_SEQ (str + j, len - j, bytes);
return (bytes <= i - j ? 0 : bytes - (i - j));
}
+ #endif
/* This structure holds information of an argument of `concat' that is
a string and has text properties to be copied. */
for (i = 0; i < len; i++)
{
ch = XVECTOR (this)->contents[i];
- if (! INTEGERP (ch))
- wrong_type_argument (Qintegerp, ch);
+ if (! CHARACTERP (ch))
+ wrong_type_argument (Qcharacterp, 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)))
++ if (! ASCII_CHAR_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);
- if (! INTEGERP (ch))
- wrong_type_argument (Qintegerp, ch);
+ if (! CHARACTERP (ch))
+ wrong_type_argument (Qcharacterp, 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)))
++ if (! ASCII_CHAR_P (XINT (ch)))
some_multibyte = 1;
}
else if (STRINGP (this))
if (STRING_MULTIBYTE (this))
{
some_multibyte = 1;
- result_len_byte += STRING_BYTES (XSTRING (this));
+ result_len_byte += SBYTES (this);
}
else
- result_len_byte += count_size_as_multibyte (XSTRING (this)->data,
- XSTRING (this)->size);
+ result_len_byte += count_size_as_multibyte (SDATA (this),
+ SCHARS (this));
}
}
if (STRINGP (this) && STRINGP (val)
&& STRING_MULTIBYTE (this) == some_multibyte)
{
- int thislen_byte = STRING_BYTES (XSTRING (this));
+ int thislen_byte = SBYTES (this);
- int combined;
- bcopy (XSTRING (this)->data, XSTRING (val)->data + toindex_byte,
- STRING_BYTES (XSTRING (this)));
- if (! NULL_INTERVAL_P (XSTRING (this)->intervals))
+ bcopy (SDATA (this), SDATA (val) + toindex_byte,
+ SBYTES (this));
- combined = (some_multibyte && toindex_byte > 0
- ? count_combining (SDATA (val),
- toindex_byte + thislen_byte,
- toindex_byte)
- : 0);
+ if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
{
textprops[num_textprops].argnum = argnum;
- /* We ignore text properties on characters being combined. */
- textprops[num_textprops].from = combined;
+ textprops[num_textprops].from = 0;
textprops[num_textprops++].to = toindex;
}
toindex_byte += thislen_byte;
- toindex += thisleni - combined;
- STRING_SET_CHARS (val, SCHARS (val) - combined);
+ toindex += thisleni;
}
/* Copy a single-byte string to a multibyte string. */
else if (STRINGP (this) && STRINGP (val))
{
- if (! NULL_INTERVAL_P (XSTRING (this)->intervals))
+ if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
{
textprops[num_textprops].argnum = argnum;
textprops[num_textprops].from = 0;
textprops[num_textprops++].to = toindex;
}
- toindex_byte += copy_text (XSTRING (this)->data,
- XSTRING (val)->data + toindex_byte,
- XSTRING (this)->size, 0, 1);
+ toindex_byte += copy_text (SDATA (this),
+ SDATA (val) + toindex_byte,
+ SCHARS (this), 0, 1);
toindex += thisleni;
}
else
}
else
{
- XSETFASTINT (elt, XSTRING (this)->data[thisindex++]);
+ XSETFASTINT (elt, SREF (this, 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));
- if (some_multibyte
- && toindex_byte > 0
- && count_combining (SDATA (val),
- toindex_byte, toindex_byte - 1))
- STRING_SET_CHARS (val, SCHARS (val) - 1);
- else
- toindex++;
- }
+ if (some_multibyte)
- toindex_byte
- += CHAR_STRING (XINT (elt),
- XSTRING (val)->data + toindex_byte);
++ 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++;
- }
- XSTRING (val)->data[toindex_byte++] = XINT (elt);
++ SSET (val, toindex_byte++, XINT (elt));
+ toindex++;
}
}
}
this = args[textprops[argnum].argnum];
props = text_property_list (this,
make_number (0),
- make_number (XSTRING (this)->size),
+ make_number (SCHARS (this)),
Qnil);
/* If successive arguments have properites, be sure that the
value of `composition' property be the copy. */
make_composition_value_copy (props);
add_text_properties_from_list (val, props,
make_number (textprops[argnum].to));
- last_to_end = textprops[argnum].to + XSTRING (this)->size;
+ last_to_end = textprops[argnum].to + SCHARS (this);
}
}
return val;
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;
return char_index;
best_below = best_below_byte = 0;
- best_above = XSTRING (string)->size;
- best_above_byte = STRING_BYTES (XSTRING (string));
+ best_above = SCHARS (string);
+ best_above_byte = SBYTES (string);
if (EQ (string, string_char_byte_cache_string))
{
if (char_index - best_below < best_above - char_index)
{
- unsigned char *p = XSTRING (string)->data + best_below_byte;
++ 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 - XSTRING (string)->data;
++ i_byte = p - SDATA (string);
}
else
{
- unsigned char *p = XSTRING (string)->data + best_above_byte;
++ 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 - XSTRING (string)->data;
++ 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;
return byte_index;
best_below = best_below_byte = 0;
- best_above = XSTRING (string)->size;
- best_above_byte = STRING_BYTES (XSTRING (string));
+ best_above = SCHARS (string);
+ best_above_byte = SBYTES (string);
if (EQ (string, string_char_byte_cache_string))
{
if (byte_index - best_below_byte < best_above_byte - byte_index)
{
- while (best_below_byte < byte_index)
- unsigned char *p = XSTRING (string)->data + best_below_byte;
- unsigned char *pend = XSTRING (string)->data + 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 - XSTRING (string)->data;
++ i_byte = p - SDATA (string);
}
else
{
- while (best_above_byte > byte_index)
- unsigned char *p = XSTRING (string)->data + best_above_byte;
- unsigned char *pbeg = XSTRING (string)->data + 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 - XSTRING (string)->data;
++ 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)
if (STRING_MULTIBYTE (string))
return string;
- nbytes = count_size_as_multibyte (XSTRING (string)->data,
- XSTRING (string)->size);
+ nbytes = count_size_as_multibyte (SDATA (string),
+ SCHARS (string));
/* If all the chars are ASCII, they won't need any more bytes
once converted. In that case, we can return STRING itself. */
- if (nbytes == STRING_BYTES (XSTRING (string)))
+ if (nbytes == SBYTES (string))
return string;
buf = (unsigned char *) alloca (nbytes);
- copy_text (XSTRING (string)->data, buf, STRING_BYTES (XSTRING (string)),
+ copy_text (SDATA (string), buf, SBYTES (string),
0, 1);
- return make_multibyte_string (buf, XSTRING (string)->size, nbytes);
+ return make_multibyte_string (buf, SCHARS (string), nbytes);
}
- /* 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. */
+
- /* If all the chars are ASCII or eight-bit-graphic, they won't need
- any more bytes once converted. */
++/* 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)
+ Lisp_Object string;
+{
+ unsigned char *buf;
+ int nbytes;
+
+ if (STRING_MULTIBYTE (string))
+ return string;
+
+ nbytes = parse_str_to_multibyte (SDATA (string), SBYTES (string));
++ /* 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);
+
+ buf = (unsigned char *) alloca (nbytes);
+ bcopy (SDATA (string), buf, SBYTES (string));
+ str_to_multibyte (buf, nbytes, SBYTES (string));
+
+ return make_multibyte_string (buf, SCHARS (string), nbytes);
+}
+
+
/* Convert STRING to a single-byte string. */
Lisp_Object
if (! STRING_MULTIBYTE (string))
return string;
- buf = (unsigned char *) alloca (XSTRING (string)->size);
+ buf = (unsigned char *) alloca (SCHARS (string));
- copy_text (XSTRING (string)->data, buf, STRING_BYTES (XSTRING (string)),
+ copy_text (SDATA (string), buf, SBYTES (string),
1, 0);
- return make_unibyte_string (buf, XSTRING (string)->size);
+ return make_unibyte_string (buf, SCHARS (string));
}
DEFUN ("string-make-multibyte", Fstring_make_multibyte, Sstring_make_multibyte,
DEFUN ("string-make-unibyte", Fstring_make_unibyte, Sstring_make_unibyte,
1, 1, 0,
doc: /* Return the unibyte equivalent of STRING.
-Multibyte character codes are converted to unibyte
-by using just the low 8 bits. */)
+Multibyte character codes are converted to unibyte according to
+`nonascii-translation-table' or, if that is nil, `nonascii-insert-offset'.
+If the lookup in the translation table fails, this function takes just
+the low 8 bits of each character. */)
(string)
Lisp_Object string;
{
if (STRING_MULTIBYTE (string))
{
- int bytes = STRING_BYTES (XSTRING (string));
+ int bytes = SBYTES (string);
unsigned char *str = (unsigned char *) xmalloc (bytes);
- bcopy (XSTRING (string)->data, str, bytes);
+ bcopy (SDATA (string), str, bytes);
bytes = str_as_unibyte (str, bytes);
string = make_unibyte_string (str, bytes);
xfree (str);
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'. */)
(string)
Lisp_Object string;
{
Lisp_Object new_string;
int nchars, nbytes;
- parse_str_as_multibyte (XSTRING (string)->data,
- STRING_BYTES (XSTRING (string)),
+ parse_str_as_multibyte (SDATA (string),
+ SBYTES (string),
&nchars, &nbytes);
new_string = make_uninit_multibyte_string (nchars, nbytes);
- bcopy (XSTRING (string)->data, XSTRING (new_string)->data,
- STRING_BYTES (XSTRING (string)));
- if (nbytes != STRING_BYTES (XSTRING (string)))
- str_as_multibyte (XSTRING (new_string)->data, nbytes,
- STRING_BYTES (XSTRING (string)), NULL);
+ bcopy (SDATA (string), SDATA (new_string),
+ SBYTES (string));
+ if (nbytes != SBYTES (string))
+ str_as_multibyte (SDATA (new_string), nbytes,
+ SBYTES (string), NULL);
string = new_string;
- XSTRING (string)->intervals = NULL_INTERVAL;
+ STRING_SET_INTERVALS (string, NULL_INTERVAL);
}
return string;
}
-
DEFUN ("string-to-multibyte", Fstring_to_multibyte, Sstring_to_multibyte,
1, 1, 0,
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-control characters of the same character
- codes. */)
+
+ 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;
{
CHECK_STRING (string);
- if (! STRING_MULTIBYTE (string))
- {
- Lisp_Object new_string;
- int nchars, nbytes;
-
- nchars = XSTRING (string)->size;
- nbytes = parse_str_to_multibyte (XSTRING (string)->data,
- STRING_BYTES (XSTRING (string)));
- new_string = make_uninit_multibyte_string (nchars, nbytes);
- bcopy (XSTRING (string)->data, XSTRING (new_string)->data,
- STRING_BYTES (XSTRING (string)));
- if (nbytes != STRING_BYTES (XSTRING (string)))
- str_to_multibyte (XSTRING (new_string)->data, nbytes,
- STRING_BYTES (XSTRING (string)));
- string = new_string;
- XSTRING (string)->intervals = NULL_INTERVAL;
- }
- return string;
+ return string_to_multibyte (string);
}
+
\f
DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
doc: /* Return a copy of ALIST.
DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
doc: /* Return a substring of STRING, starting at index FROM and ending before TO.
TO may be nil or omitted; then the substring runs to the end of STRING.
-If FROM or TO is negative, it counts from the end.
+FROM and TO start at 0. If either is negative, it counts from the end.
This function allows vectors as well as strings. */)
(string, from, to)
if (STRINGP (string))
{
- size = XSTRING (string)->size;
- size_byte = STRING_BYTES (XSTRING (string));
+ size = SCHARS (string);
+ size_byte = SBYTES (string);
}
else
size = XVECTOR (string)->size;
if (STRINGP (string))
{
- res = make_specified_string (XSTRING (string)->data + from_byte,
+ res = make_specified_string (SDATA (string) + from_byte,
to_char - from_char, to_byte - from_byte,
STRING_MULTIBYTE (string));
copy_text_properties (make_number (from_char), make_number (to_char),
return res;
}
+
+DEFUN ("substring-no-properties", Fsubstring_no_properties, Ssubstring_no_properties, 1, 3, 0,
+ doc: /* Return a substring of STRING, without text properties.
+It starts at index FROM and ending before TO.
+TO may be nil or omitted; then the substring runs to the end of STRING.
+If FROM is nil or omitted, the substring starts at the beginning of STRING.
+If FROM or TO is negative, it counts from the end.
+
+With one argument, just copy STRING without its properties. */)
+ (string, from, to)
+ Lisp_Object string;
+ register Lisp_Object from, to;
+{
+ int size, size_byte;
+ int from_char, to_char;
+ int from_byte, to_byte;
+
+ CHECK_STRING (string);
+
+ size = SCHARS (string);
+ size_byte = SBYTES (string);
+
+ if (NILP (from))
+ from_char = from_byte = 0;
+ else
+ {
+ CHECK_NUMBER (from);
+ from_char = XINT (from);
+ if (from_char < 0)
+ from_char += size;
+
+ from_byte = string_char_to_byte (string, from_char);
+ }
+
+ if (NILP (to))
+ {
+ to_char = size;
+ to_byte = size_byte;
+ }
+ else
+ {
+ CHECK_NUMBER (to);
+
+ to_char = XINT (to);
+ if (to_char < 0)
+ to_char += size;
+
+ to_byte = string_char_to_byte (string, to_char);
+ }
+
+ if (!(0 <= from_char && from_char <= to_char && to_char <= size))
+ args_out_of_range_3 (string, make_number (from_char),
+ make_number (to_char));
+
+ return make_specified_string (SDATA (string) + from_byte,
+ to_char - from_char, to_byte - from_byte,
+ STRING_MULTIBYTE (string));
+}
+
/* Extract a substring of STRING, giving start and end positions
both in characters and in bytes. */
if (STRINGP (string))
{
- size = XSTRING (string)->size;
- size_byte = STRING_BYTES (XSTRING (string));
+ size = SCHARS (string);
+ size_byte = SBYTES (string);
}
else
size = XVECTOR (string)->size;
if (STRINGP (string))
{
- res = make_specified_string (XSTRING (string)->data + from_byte,
+ res = make_specified_string (SDATA (string) + from_byte,
to - from, to_byte - from_byte,
STRING_MULTIBYTE (string));
copy_text_properties (make_number (from), make_number (to),
int c;
for (i = nchars = nbytes = ibyte = 0;
- i < XSTRING (seq)->size;
+ i < SCHARS (seq);
++i, ibyte += cbytes)
{
if (STRING_MULTIBYTE (seq))
{
- c = STRING_CHAR (&XSTRING (seq)->data[ibyte],
- STRING_BYTES (XSTRING (seq)) - ibyte);
+ c = STRING_CHAR (SDATA (seq) + ibyte,
+ SBYTES (seq) - ibyte);
cbytes = CHAR_BYTES (c);
}
else
{
- c = XSTRING (seq)->data[i];
+ c = SREF (seq, i);
cbytes = 1;
}
}
}
- if (nchars != XSTRING (seq)->size)
+ if (nchars != SCHARS (seq))
{
Lisp_Object tem;
tem = make_uninit_multibyte_string (nchars, nbytes);
if (!STRING_MULTIBYTE (seq))
- SET_STRING_BYTES (XSTRING (tem), -1);
+ STRING_SET_UNIBYTE (tem);
for (i = nchars = nbytes = ibyte = 0;
- i < XSTRING (seq)->size;
+ i < SCHARS (seq);
++i, ibyte += cbytes)
{
if (STRING_MULTIBYTE (seq))
{
- c = STRING_CHAR (&XSTRING (seq)->data[ibyte],
- STRING_BYTES (XSTRING (seq)) - ibyte);
+ c = STRING_CHAR (SDATA (seq) + ibyte,
+ SBYTES (seq) - ibyte);
cbytes = CHAR_BYTES (c);
}
else
{
- c = XSTRING (seq)->data[i];
+ c = SREF (seq, i);
cbytes = 1;
}
if (!INTEGERP (elt) || c != XINT (elt))
{
- unsigned char *from = &XSTRING (seq)->data[ibyte];
- unsigned char *to = &XSTRING (tem)->data[nbytes];
+ unsigned char *from = SDATA (seq) + ibyte;
+ unsigned char *to = SDATA (tem) + nbytes;
EMACS_INT n;
++nchars;
Lisp_Object new;
for (new = Qnil; CONSP (list); list = XCDR (list))
- new = Fcons (XCAR (list), new);
+ {
+ QUIT;
+ new = Fcons (XCAR (list), new);
+ }
if (!NILP (list))
wrong_type_argument (Qconsp, list);
return new;
Lisp_Object prop;
{
Lisp_Object tail;
-
+
for (tail = plist;
CONSP (tail) && CONSP (XCDR (tail));
tail = XCDR (XCDR (tail)))
if (!NILP (tail))
wrong_type_argument (Qlistp, prop);
-
+
return Qnil;
}
Fsetcar (XCDR (tail), val);
return plist;
}
-
+
prev = tail;
QUIT;
}
= Fplist_put (XSYMBOL (symbol)->plist, propname, value);
return value;
}
+\f
+DEFUN ("lax-plist-get", Flax_plist_get, Slax_plist_get, 2, 2, 0,
+ doc: /* Extract a value from a property list, comparing with `equal'.
+PLIST is a property list, which is a list of the form
+\(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
+corresponding to the given PROP, or nil if PROP is not
+one of the properties on the list. */)
+ (plist, prop)
+ Lisp_Object plist;
+ Lisp_Object prop;
+{
+ Lisp_Object tail;
+
+ for (tail = plist;
+ CONSP (tail) && CONSP (XCDR (tail));
+ tail = XCDR (XCDR (tail)))
+ {
+ if (! NILP (Fequal (prop, XCAR (tail))))
+ return XCAR (XCDR (tail));
+
+ QUIT;
+ }
+ if (!NILP (tail))
+ wrong_type_argument (Qlistp, prop);
+
+ return Qnil;
+}
+
+DEFUN ("lax-plist-put", Flax_plist_put, Slax_plist_put, 3, 3, 0,
+ doc: /* Change value in PLIST of PROP to VAL, comparing with `equal'.
+PLIST is a property list, which is a list of the form
+\(PROP1 VALUE1 PROP2 VALUE2 ...). PROP and VAL are any objects.
+If PROP is already a property on the list, its value is set to VAL,
+otherwise the new PROP VAL pair is added. The new plist is returned;
+use `(setq x (lax-plist-put x prop val))' to be sure to use the new value.
+The PLIST is modified by side effects. */)
+ (plist, prop, val)
+ Lisp_Object plist;
+ register Lisp_Object prop;
+ Lisp_Object val;
+{
+ register Lisp_Object tail, prev;
+ Lisp_Object newcell;
+ prev = Qnil;
+ for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
+ tail = XCDR (XCDR (tail)))
+ {
+ if (! NILP (Fequal (prop, XCAR (tail))))
+ {
+ Fsetcar (XCDR (tail), val);
+ return plist;
+ }
+
+ prev = tail;
+ QUIT;
+ }
+ newcell = Fcons (prop, Fcons (val, Qnil));
+ if (NILP (prev))
+ return newcell;
+ else
+ Fsetcdr (XCDR (prev), newcell);
+ return plist;
+}
+\f
DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
doc: /* Return t if two Lisp objects have similar structure and contents.
They must have the same data type.
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)))
++ if (!(size & (PVEC_COMPILED
++ | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE)))
return 0;
size &= PSEUDOVECTOR_SIZE_MASK;
}
break;
case Lisp_String:
- if (XSTRING (o1)->size != XSTRING (o2)->size)
+ if (SCHARS (o1) != SCHARS (o2))
return 0;
- if (STRING_BYTES (XSTRING (o1)) != STRING_BYTES (XSTRING (o2)))
+ if (SBYTES (o1) != SBYTES (o2))
return 0;
- if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data,
- STRING_BYTES (XSTRING (o1))))
+ if (bcmp (SDATA (o1), SDATA (o2),
+ SBYTES (o1)))
return 0;
return 1;
case Lisp_Type_Limit:
break;
}
-
+
return 0;
}
\f
}
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))
{
- register unsigned char *p = XSTRING (array)->data;
+ register unsigned char *p = SDATA (array);
CHECK_NUMBER (item);
charval = XINT (item);
- size = XSTRING (array)->size;
+ size = SCHARS (array);
if (STRING_MULTIBYTE (array))
{
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len = CHAR_STRING (charval, str);
- int size_byte = STRING_BYTES (XSTRING (array));
+ int size_byte = SBYTES (array);
unsigned char *p1 = p, *endp = p + size_byte;
int i;
return array;
}
- \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.
- 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; !NILP (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
- 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. */)
- (char_table, range)
- Lisp_Object char_table, range;
- {
- CHECK_CHAR_TABLE (char_table);
-
- if (EQ (range, Qnil))
- return XCHAR_TABLE (char_table)->defalt;
- else if (INTEGERP (range))
- return Faref (char_table, range);
- else if (SYMBOLP (range))
- {
- Lisp_Object charset_info;
-
- charset_info = Fget (range, Qcharset);
- CHECK_VECTOR (charset_info);
-
- return Faref (char_table,
- make_number (XINT (XVECTOR (charset_info)->contents[0])
- + 128));
- }
- else if (VECTORP (range))
- {
- if (XVECTOR (range)->size == 1)
- return Faref (char_table,
- make_number (XINT (XVECTOR (range)->contents[0]) + 128));
- else
- {
- int size = XVECTOR (range)->size;
- 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]);
- return Faref (char_table, ch);
- }
- }
- else
- error ("Invalid RANGE argument to `char-table-range'");
- return Qt;
- }
-
- 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 vector which identifies a character set or a row of a character set,
- a coding system, or a character code. */)
- (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++)
- 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;
-
- charset_info = Fget (range, Qcharset);
- CHECK_VECTOR (charset_info);
-
- return Faset (char_table,
- make_number (XINT (XVECTOR (charset_info)->contents[0])
- + 128),
- value);
- }
- else if (INTEGERP (range))
- Faset (char_table, range, value);
- else if (VECTORP (range))
- {
- if (XVECTOR (range)->size == 1)
- return Faset (char_table,
- make_number (XINT (XVECTOR (range)->contents[0]) + 128),
- value);
- else
- {
- int size = XVECTOR (range)->size;
- 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]);
- return 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.
- 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 (charset == CHARSET_ASCII)
- return (XCHAR_TABLE (char_table)->defalt = 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 (!code1)
- {
- if (SUB_CHAR_TABLE_P (temp))
- XCHAR_TABLE (temp)->defalt = value;
- else
- XCHAR_TABLE (char_table)->contents[charset + 128] = value;
- return value;
- }
- if (SUB_CHAR_TABLE_P (temp))
- char_table = temp;
- else
- char_table = (XCHAR_TABLE (char_table)->contents[charset + 128]
- = make_sub_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))
- 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;
- 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);
- if (dim == 2)
- for (j = 32; j < SUB_CHAR_TABLE_ORDINARY_SLOTS; j++)
- optimize_sub_char_table (XCHAR_TABLE (elt)->contents + j, dim);
- optimize_sub_char_table (XCHAR_TABLE (table)->contents + i, dim);
- }
- 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, *indices;
- int depth;
- {
- int i, to;
-
- 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))
- return;
- #endif
- to = CHAR_TABLE_ORDINARY_SLOTS;
- }
- else
- {
- int charset = XFASTINT (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];
- XSETFASTINT (indices[depth], i);
- charset = XFASTINT (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 ? XFASTINT (indices[1]) : 0;
- c2 = depth >= 2 ? XFASTINT (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);
- }
- }
- }
-
- 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. */
- Lisp_Object 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];
- }
-
+DEFUN ("clear-string", Fclear_string, Sclear_string,
+ 1, 1, 0,
+ doc: /* Clear the contents of STRING.
+This makes STRING unibyte and may change its length. */)
+ (string)
+ Lisp_Object string;
+{
+ int len = SBYTES (string);
+ bzero (SDATA (string), len);
+ STRING_SET_CHARS (string, len);
+ STRING_SET_UNIBYTE (string);
+ return Qnil;
+}
\f
/* ARGSUSED */
Lisp_Object
while (CONSP (tem))
{
tail = tem;
- tem = Fcdr (tail);
+ tem = XCDR (tail);
QUIT;
}
Lisp_Object xprompt;
Lisp_Object args[2];
struct gcpro gcpro1, gcpro2;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
specbind (Qcursor_in_echo_area, Qt);
#endif /* HAVE_MENUS */
cursor_in_echo_area = 1;
choose_minibuf_frame ();
- message_with_string ("%s(y or n) ", xprompt, 0);
+
+ {
+ Lisp_Object pargs[3];
+
+ /* Colorize prompt according to `minibuffer-prompt' face. */
+ pargs[0] = build_string ("%s(y or n) ");
+ pargs[1] = intern ("face");
+ pargs[2] = intern ("minibuffer-prompt");
+ args[0] = Fpropertize (3, pargs);
+ args[1] = xprompt;
+ Fmessage (2, args);
+ }
if (minibuffer_auto_raise)
{
ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,
Qyes_or_no_p_history, Qnil,
Qnil));
- if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))
+ if (SCHARS (ans) == 3 && !strcmp (SDATA (ans), "yes"))
{
UNGCPRO;
return Qt;
}
- if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no"))
+ if (SCHARS (ans) == 2 && !strcmp (SDATA (ans), "no"))
{
UNGCPRO;
return Qnil;
\f
DEFUN ("load-average", Fload_average, Sload_average, 0, 1, 0,
doc: /* Return list of 1 minute, 5 minute and 15 minute load averages.
-
+
Each of the three load averages is multiplied by 100, then converted
to integer.
These floats are not multiplied by 100.
If the 5-minute or 15-minute load averages are not available, return a
-shortened list, containing only those averages which are available. */)
+shortened list, containing only those averages which are available.
+
+An error is thrown if the load average can't be obtained. In some
+cases making it work would require Emacs being installed setuid or
+setgid so that it can read kernel information, and that usually isn't
+advisable. */)
(use_floats)
Lisp_Object use_floats;
{
DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 2, 0,
doc: /* Returns t if FEATURE is present in this Emacs.
-
+
Use this to conditionalize execution of lisp code based on the
presence or absence of emacs or environment extensions.
Use `provide' to declare that a feature is available. This function
CHECK_SYMBOL (feature);
tem = Fmemq (feature, Vfeatures);
if (!NILP (tem) && !NILP (subfeature))
- tem = Fmemq (subfeature, Fget (feature, Qsubfeatures));
+ tem = Fmember (subfeature, Fget (feature, Qsubfeatures));
return (NILP (tem)) ? Qnil : Qt;
}
{
register Lisp_Object tem;
CHECK_SYMBOL (feature);
+ CHECK_LIST (subfeatures);
if (!NILP (Vautoload_queue))
Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
tem = Fmemq (feature, Vfeatures);
/* Run any load-hooks for this file. */
tem = Fassq (feature, Vafter_load_alist);
- if (!NILP (tem))
- Fprogn (Fcdr (tem));
+ if (CONSP (tem))
+ Fprogn (XCDR (tem));
return feature;
}
tem = Fmemq (feature, Vfeatures);
- LOADHIST_ATTACH (Fcons (Qrequire, feature));
-
if (NILP (tem))
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int nesting = 0;
-
+
+ LOADHIST_ATTACH (Fcons (Qrequire, feature));
+
+ /* This is to make sure that loadup.el gives a clear picture
+ of what files are preloaded and when. */
+ if (! NILP (Vpurify_flag))
+ error ("(require %s) while preparing to dump",
+ SDATA (SYMBOL_NAME (feature)));
+
/* A certain amount of recursive `require' is legitimate,
but if we require the same feature recursively 3 times,
signal an error. */
nesting++;
tem = XCDR (tem);
}
- if (nesting > 2)
+ if (nesting > 3)
error ("Recursive `require' for feature `%s'",
- XSYMBOL (feature)->name->data);
+ SDATA (SYMBOL_NAME (feature)));
/* Update the list for any nested `require's that occur. */
record_unwind_protect (require_unwind, require_nesting_list);
tem = Fmemq (feature, Vfeatures);
if (NILP (tem))
error ("Required feature `%s' was not provided",
- XSYMBOL (feature)->name->data);
+ SDATA (SYMBOL_NAME (feature)));
/* Once loading finishes, don't undo it. */
Vautoload_queue = Qt;
#include <langinfo.h>
#endif
-DEFUN ("langinfo", Flanginfo, Slanginfo, 1, 1, 0,
- doc: /* Access locale category ITEM, if available.
+DEFUN ("locale-info", Flocale_info, Slocale_info, 1, 1, 0,
+ doc: /* Access locale data ITEM for the current C locale, if available.
+ITEM should be one of the following:
+
+`codeset', returning the character set as a string (locale item CODESET);
-ITEM may be one of the following:
-`codeset', returning the character set as a string (CODESET);
-`days', returning a 7-element vector of day names (DAY_n);
-`months', returning a 12-element vector of month names (MON_n).
+`days', returning a 7-element vector of day names (locale items DAY_n);
+
+`months', returning a 12-element vector of month names (locale items MON_n);
+
+`paper', returning a list (WIDTH HEIGHT) for the default paper size,
+ both measured in milimeters (locale items PAPER_WIDTH, PAPER_HEIGHT).
If the system can't provide such information through a call to
-nl_langinfo(3), return nil. */)
+`nl_langinfo', or if ITEM isn't from the list above, return nil.
+
+See also Info node `(libc)Locales'.
+
+The data read from the system are decoded using `locale-coding-system'. */)
(item)
Lisp_Object item;
{
#ifdef HAVE_LANGINFO_CODESET
Lisp_Object val;
if (EQ (item, Qcodeset))
- str = nl_langinfo (CODESET);
+ {
+ str = nl_langinfo (CODESET);
+ return build_string (str);
+ }
#ifdef DAY_1
else if (EQ (item, Qdays)) /* e.g. for calendar-day-name-array */
{
for (i = 0; i < 7; i++)
{
str = nl_langinfo (days[i]);
+ val = make_unibyte_string (str, strlen (str));
+ /* Fixme: Is this coding system necessarily right, even if
+ it is consistent with CODESET? If not, what to do? */
Faset (v, make_number (i),
- code_convert_string (make_unibyte_string (str, strlen (str)),
- Vlocale_coding_system, Qnil, 0, 0, 1));
+ code_convert_string_norecord (val, Vlocale_coding_system,
+ 0));
}
return v;
}
-#endif
+#endif /* DAY_1 */
#ifdef MON_1
else if (EQ (item, Qmonths)) /* e.g. for calendar-month-name-array */
{
for (i = 0; i < 12; i++)
{
str = nl_langinfo (months[i]);
+ val = make_unibyte_string (str, strlen (str));
p->contents[i] =
- code_convert_string (make_unibyte_string (str, strlen (str)),
- Vlocale_coding_system, Qnil, 0, 0, 1);
+ code_convert_string_norecord (val, Vlocale_coding_system, 0);
}
XSETVECTOR (val, p);
return val;
}
-#endif
-#endif
- if (str)
- return build_string (str);
- else
- return Qnil;
+#endif /* MON_1 */
+/* LC_PAPER stuff isn't defined as accessible in glibc as of 2.3.1,
+ but is in the locale files. This could be used by ps-print. */
+#ifdef PAPER_WIDTH
+ else if (EQ (item, Qpaper))
+ {
+ return list2 (make_number (nl_langinfo (PAPER_WIDTH)),
+ make_number (nl_langinfo (PAPER_HEIGHT)));
+ }
+#endif /* PAPER_WIDTH */
+#endif /* HAVE_LANGINFO_CODESET*/
+ return Qnil;
}
\f
/* base64 encode/decode functions (RFC 2045).
/* We need to allocate enough room for encoding the text.
We need 33 1/3% more space, plus a newline every 76
characters, and then we round up. */
- length = STRING_BYTES (XSTRING (string));
+ length = SBYTES (string);
allength = length + length/3 + 1;
allength += allength / MIME_LINE_LENGTH + 1 + 6;
else
encoded = (char *) xmalloc (allength);
- encoded_length = base64_encode_1 (XSTRING (string)->data,
+ encoded_length = base64_encode_1 (SDATA (string),
encoded, length, NILP (no_line_break),
STRING_MULTIBYTE (string));
if (encoded_length > allength)
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)
- return -1;
+ if (CHAR_BYTE8_P (c))
+ c = CHAR_TO_BYTE8 (c);
+ else if (c >= 256)
- return -1;
i += bytes;
}
else
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;
}
CHECK_STRING (string);
- length = STRING_BYTES (XSTRING (string));
+ length = SBYTES (string);
/* We need to allocate enough room for decoding the text. */
if (length <= MAX_ALLOCA)
decoded = (char *) alloca (length);
decoded = (char *) xmalloc (length);
/* The decoded result should be unibyte. */
- decoded_length = base64_decode_1 (XSTRING (string)->data, decoded, length,
+ decoded_length = base64_decode_1 (SDATA (string), decoded, length,
0, NULL);
if (decoded_length > length)
abort ();
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++;
if a `:linear-search t' argument is given to make-hash-table. */
-/* Value is the index of the next entry following the one at IDX
- in hash table H. */
-
-#define HASH_NEXT(H, IDX) AREF ((H)->next, (IDX))
-
-/* Value is the hash code computed for entry IDX in hash table H. */
-
-#define HASH_HASH(H, IDX) AREF ((H)->hash, (IDX))
-
-/* Value is the index of the element in hash table H that is the
- start of the collision list at index IDX in the index vector of H. */
-
-#define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX))
-
-/* Value is the size of hash table H. */
-
-#define HASH_TABLE_SIZE(H) XVECTOR ((H)->next)->size
-
/* The list of all weak hash tables. Don't staticpro this one. */
Lisp_Object Vweak_hash_tables;
/* Make sure key and value survive. */
if (!key_known_to_survive_p)
{
- mark_object (&HASH_KEY (h, i));
+ mark_object (HASH_KEY (h, i));
marked = 1;
}
if (!value_known_to_survive_p)
{
- mark_object (&HASH_VALUE (h, i));
+ mark_object (HASH_VALUE (h, i));
marked = 1;
}
}
{
h = XHASH_TABLE (table);
next = h->next_weak;
-
+
if (h->size & ARRAY_MARK_FLAG)
{
/* TABLE is marked as used. Sweep its contents. */
break;
case Lisp_Symbol:
- hash = sxhash_string (XSYMBOL (obj)->name->data,
- XSYMBOL (obj)->name->size);
+ hash = sxhash_string (SDATA (SYMBOL_NAME (obj)),
+ SCHARS (SYMBOL_NAME (obj)));
break;
case Lisp_Misc:
break;
case Lisp_String:
- hash = sxhash_string (XSTRING (obj)->data, XSTRING (obj)->size);
+ hash = sxhash_string (SDATA (obj), SCHARS (obj));
break;
/* This can be everything from a vector to an overlay. */
DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,
doc: /* Create and return a new hash table.
-
+
Arguments are specified as keyword/argument pairs. The following
arguments are defined:
/* See if there's a `:size SIZE' argument. */
i = get_key_arg (QCsize, nargs, args, used);
- size = i < 0 ? make_number (DEFAULT_HASH_SIZE) : args[i];
- if (!INTEGERP (size) || XINT (size) < 0)
+ size = i < 0 ? Qnil : args[i];
+ if (NILP (size))
+ size = make_number (DEFAULT_HASH_SIZE);
+ else if (!INTEGERP (size) || XINT (size) < 0)
Fsignal (Qerror,
list2 (build_string ("Invalid hash table size"),
size));
}
-DEFUN ("makehash", Fmakehash, Smakehash, 0, 1, 0,
- doc: /* Create a new hash table.
-
-Optional first argument TEST specifies how to compare keys in the
-table. Predefined tests are `eq', `eql', and `equal'. Default is
-`eql'. New tests can be defined with `define-hash-table-test'. */)
- (test)
- Lisp_Object test;
-{
- Lisp_Object args[2];
- args[0] = QCtest;
- args[1] = NILP (test) ? Qeql : test;
- return Fmake_hash_table (2, args);
-}
-
-
DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,
doc: /* Return the number of elements in TABLE. */)
(table)
DEFUN ("define-hash-table-test", Fdefine_hash_table_test,
Sdefine_hash_table_test, 3, 3, 0,
doc: /* Define a new hash table test with name NAME, a symbol.
-
+
In hash tables created with NAME specified as test, use TEST to
compare keys, and HASH for computing hash codes of keys.
************************************************************************/
#include "md5.h"
- #include "coding.h"
DEFUN ("md5", Fmd5, Smd5, 1, 5, 0,
doc: /* Return MD5 message digest of OBJECT, a buffer or string.
-
+
A message digest is a cryptographic checksum of a document, and the
algorithm to calculate it is defined in RFC 1321.
if (STRING_MULTIBYTE (object))
/* use default, we can't guess correct value */
- coding_system = SYMBOL_VALUE (XCAR (Vcoding_category_list));
+ coding_system = preferred_coding_system ();
- else
+ else
coding_system = Qraw_text;
}
-
+
if (NILP (Fcoding_system_p (coding_system)))
{
/* Invalid coding system. */
-
+
if (!NILP (noerror))
coding_system = Qraw_text;
else
}
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 = XSTRING (object)->size;
- size_byte = STRING_BYTES (XSTRING (object));
+ size = SCHARS (object);
+ size_byte = SBYTES (object);
if (!NILP (start))
{
else
{
CHECK_NUMBER (end);
-
+
end_char = XINT (end);
if (end_char < 0)
end_char += size;
-
+
end_byte = string_char_to_byte (object, end_char);
}
-
+
if (!(0 <= start_char && start_char <= end_char && end_char <= size))
args_out_of_range_3 (object, make_number (start_char),
make_number (end_char));
CHECK_BUFFER (object);
bp = XBUFFER (object);
-
+
if (NILP (start))
b = BUF_BEGV (bp);
else
CHECK_NUMBER_COERCE_MARKER (end);
e = XINT (end);
}
-
+
if (b > e)
temp = b, b = e, e = temp;
-
+
if (!(BUF_BEGV (bp) <= b && e <= BUF_ZV (bp)))
args_out_of_range (start, end);
-
+
if (NILP (coding_system))
{
- /* Decide the coding-system to encode the data with.
+ /* Decide the coding-system to encode the data with.
See fileio.c:Fwrite-region */
if (!NILP (Vcoding_system_for_write))
{
/* Check file-coding-system-alist. */
Lisp_Object args[4], val;
-
+
args[0] = Qwrite_region; args[1] = start; args[2] = end;
args[3] = Fbuffer_file_name(object);
val = Ffind_operation_coding_system (4, args);
if (!force_raw_text
&& !NILP (Ffboundp (Vselect_safe_coding_system_function)))
/* Confirm that VAL can surely encode the current region. */
- coding_system = call3 (Vselect_safe_coding_system_function,
+ coding_system = call4 (Vselect_safe_coding_system_function,
make_number (b), make_number (e),
- coding_system);
+ coding_system, Qnil);
if (force_raw_text)
coding_system = Qraw_text;
object = make_buffer_string (b, e, 0);
if (STRING_MULTIBYTE (object))
- object = code_convert_string1 (object, coding_system, Qnil, 1);
- object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
++ object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
}
- md5_buffer (XSTRING (object)->data + start_byte,
- STRING_BYTES(XSTRING (object)) - (size_byte - end_byte),
+ md5_buffer (SDATA (object) + start_byte,
+ SBYTES (object) - (size_byte - end_byte),
digest);
for (i = 0; i < 16; i++)
defsubr (&Ssxhash);
defsubr (&Smake_hash_table);
defsubr (&Scopy_hash_table);
- defsubr (&Smakehash);
defsubr (&Shash_table_count);
defsubr (&Shash_table_rehash_size);
defsubr (&Shash_table_rehash_threshold);
Qsubfeatures = intern ("subfeatures");
staticpro (&Qsubfeatures);
+#ifdef HAVE_LANGINFO_CODESET
Qcodeset = intern ("codeset");
staticpro (&Qcodeset);
Qdays = intern ("days");
staticpro (&Qdays);
Qmonths = intern ("months");
staticpro (&Qmonths);
+ Qpaper = intern ("paper");
+ staticpro (&Qpaper);
+#endif /* HAVE_LANGINFO_CODESET */
DEFVAR_BOOL ("use-dialog-box", &use_dialog_box,
doc: /* *Non-nil means mouse commands use dialog boxes to ask questions.
-This applies to y-or-n and yes-or-no questions asked by commands
+This applies to `y-or-n-p' and `yes-or-no-p' questions asked by commands
invoked by mouse clicks and mouse menu items. */);
use_dialog_box = 1;
defsubr (&Sstring_to_multibyte);
defsubr (&Scopy_alist);
defsubr (&Ssubstring);
+ defsubr (&Ssubstring_no_properties);
defsubr (&Snthcdr);
defsubr (&Snth);
defsubr (&Selt);
defsubr (&Sget);
defsubr (&Splist_put);
defsubr (&Sput);
+ defsubr (&Slax_plist_get);
+ defsubr (&Slax_plist_put);
defsubr (&Sequal);
defsubr (&Sfillarray);
- 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 (&Sclear_string);
defsubr (&Snconc);
defsubr (&Smapcar);
defsubr (&Smapc);
defsubr (&Sbase64_encode_string);
defsubr (&Sbase64_decode_string);
defsubr (&Smd5);
- defsubr (&Slanginfo);
+ defsubr (&Slocale_info);
}
/* Fontset handler.
Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.
-- Licensed to the Free Software Foundation.
- Copyright (C) 2001, 2002
++ Licensed to the Free Software Foundation.
++ Copyright (C) 2003
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
#endif
#include "lisp.h"
+ #include "blockinput.h"
#include "buffer.h"
+ #include "character.h"
#include "charset.h"
#include "ccl.h"
#include "keyboard.h"
#include "fontset.h"
#include "window.h"
--#ifdef FONTSET_DEBUG
#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:
+ [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
+ or
+ FONT-NAME
+ where FAMILY, WEIGHT, SLANT, SWIDTH, ADSTYLE, REGISTRY, and
+ FONT-NAME are strings.
+
+ ENCODING is a charset ID or a char-table that can convert
+ characters to glyph codes of the corresponding font.
+
+ REPERTORY is a charset ID or nil. If REPERTORY is a charset ID,
+ the repertory of the charset exactly matches with that of the font.
+ 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 form FONT-SPEC
+ (if it is a vector) or FONT-NAME as a key.
+
+
+ An element of a realized fontset is nil or t, or has this form:
- A fontset object is implemented by a char-table.
+ ( CHARSET-PRIORITY-LIST-TICK . FONT-VECTOR )
- 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
+ FONT-VECTOR is a vector whose elements have this form:
- An element of a realized fontset is FACE-ID which is a face to use
- for displaying the corresponding character.
+ [ FACE-ID FONT-INDEX FONT-DEF ]
- 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.
+ FONT-VECTOR is automatically reordered by the current charset
+ priority list.
- To access or set each element, use macros FONTSET_REF and
- FONTSET_SET respectively for efficiency.
+ The value nil means that we have not yet generated FONT-VECTOR from
+ the base of the fontset.
- A fontset has 3 extra slots.
+ The value t means that no font is available for the corresponding
+ range of characters.
- The 1st slot is an ID number of the fontset.
- The 2nd slot is a name of the fontset. This is nil for a realized
- face.
+ A fontset has 8 extra slots.
- The 3rd slot is a frame that the fontset belongs to. This is nil
- for a default face.
+ The 1st slot: the ID number of the fontset
- A parent of a base fontset is nil. A parent of a realized fontset
- is a base fontset.
+ The 2nd slot:
+ base: the name of the fontset
+ realized: nil
- All fontsets are recorded in Vfontset_table.
+ 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.
+
+ 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;
/* 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;
Lisp_Object Vfont_encoding_alist;
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 void fontset_set P_ ((Lisp_Object, int, Lisp_Object));
+ static Lisp_Object fontset_add P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object));
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 void accumulate_script_ranges P_ ((Lisp_Object, Lisp_Object,
+ Lisp_Object));
+ static Lisp_Object find_font_encoding P_ ((char *));
+
+ #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_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[7]
- #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;
}
- #define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
+ /* 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
- fontset_ref_via_base (fontset, c)
+ fontset_ref_and_range (fontset, c, from, to)
Lisp_Object fontset;
- int *c;
+ int c;
+ int *from, *to;
{
- int charset, c1, c2;
Lisp_Object elt;
- if (SINGLE_BYTE_CHAR_P (*c))
- return FONTSET_ASCII (fontset);
-
- elt = FONTSET_REF (FONTSET_BASE (fontset), *c);
- if (NILP (elt) && ! EQ (fontset, Vdefault_fontset))
- elt = FONTSET_REF (Vdefault_fontset, *c);
- if (NILP (elt))
- return Qnil;
+ 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)))
+ {
+ int from1, to1;
- *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];
+ elt = char_table_ref_and_range (Vdefault_fontset, c, &from1, &to1);
+ if (*from < from1)
+ *from = from1;
+ if (*to > to1)
+ *to = to1;
+ }
return elt;
}
- /* Store into the element of FONTSET at index C the value NEWELT. */
- #define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
+ /* 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 ETL. 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) \
+ ? Fset_char_table_range ((fontset), (range), \
+ Fmake_vector (make_number (1), (elt))) \
+ : fontset_add ((fontset), (range), (elt), (add)))
+
+ static Lisp_Object
+ fontset_add (fontset, range, elt, add)
+ Lisp_Object fontset, range, elt, add;
+ {
+ int from, to, from1, to1;
+ Lisp_Object elt1;
-
++
+ from = XINT (XCAR (range));
+ to = XINT (XCDR (range));
+ do {
+ elt1 = char_table_ref_and_range (fontset, from, &from1, &to1);
+ if (to < to1)
+ to1 = to;
+ if (NILP (elt1))
+ elt1 = Fmake_vector (make_number (1), elt);
+ else
+ {
+ int i, i0 = 1, i1 = ASIZE (elt1) + 1;
+ Lisp_Object new;
+
+ new = Fmake_vector (make_number (i1), elt);
+ if (EQ (add, Qappend))
+ i0--, i1--;
+ for (i = 0; i0 < i1; i++, i0++)
+ ASET (new, i0, AREF (elt1, i));
+ elt1 = new;
+ }
+ char_table_set_range (fontset, from, to1, elt1);
+ from = to1 + 1;
+ } while (from < to);
+ return Qnil;
+ }
+
+
+ /* Update FONTSET_ELEMENT which has this form:
+ ( CHARSET-PRIORITY-LIST-TICK . FONT-VECTOR).
+ Reorder FONT-VECTOR according to the current order of charset
+ (Vcharset_ordered_list), and update CHARSET-PRIORITY-LIST-TICK to
+ the latest value. */
static void
- fontset_set (fontset, c, newelt)
+ reorder_font_vector (fontset_element)
+ Lisp_Object fontset_element;
+ {
+ Lisp_Object vec, list, *new_vec;
+ int size;
+ int *charset_id_table;
+ int i, idx;
+
+ XSETCAR (fontset_element, make_number (charset_ordered_list_tick));
+ vec = XCDR (fontset_element);
+ size = ASIZE (vec);
+ if (size < 2)
+ /* No need of reordering VEC. */
+ return;
+ 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 VEC. VEC has this
+ form:
+ [[FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ]] ...] */
+ for (i = 0; i < size; i++)
+ charset_id_table[i] = XINT (AREF (AREF (AREF (vec, i), 2), 1));
+
+ /* Then, store the elements of VEC in NEW_VEC in the correct
+ order. */
+ idx = 0;
+ for (list = Vcharset_ordered_list; CONSP (list); list = XCDR (list))
+ {
+ for (i = 0; i < size; i++)
+ if (charset_id_table[i] == XINT (XCAR (list)))
+ new_vec[idx++] = AREF (vec, i);
+ if (idx == size)
+ break;
+ }
+
+ /* At last, update VEC. */
+ for (i = 0; i < size; i++)
+ ASET (vec, i, 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. */
+
+ static int
+ load_font_get_repertory (f, face, font_def, fontset)
+ FRAME_PTR f;
+ struct face *face;
+ Lisp_Object font_def;
+ Lisp_Object fontset;
+ {
+ char *font_name;
+ struct font_info *font_info;
+
- font_name = choose_face_font (f, face->lface, AREF (font_def, 0));
++ font_name = choose_face_font (f, face->lface, AREF (font_def, 0), NULL);
+ if (! (font_info = fs_load_font (f, font_name, XINT (AREF (font_def, 1)))))
+ 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));
++ FONTSET_REPERTORY (fontset));
+ }
+
+ return font_info->font_idx;
+ }
+
+
+ /* Return a face ID registerd in the realized fontset FONTSET for the
+ character C. If FACE is NULL, return -1 if a face is not yet
+ set. Otherwise, realize a proper face from FACE and return it. */
+
+ static int
+ fontset_face (fontset, c, face)
Lisp_Object fontset;
int c;
- Lisp_Object newelt;
+ struct face *face;
{
- int charset, code[3];
- Lisp_Object *elt;
- int i;
+ Lisp_Object base_fontset, elt, vec;
+ int i, from, to;
+ int font_idx;
+ FRAME_PTR f = XFRAME (FONTSET_FRAME (fontset));
+
+ base_fontset = FONTSET_BASE (fontset);
+ elt = CHAR_TABLE_REF (fontset, c);
+
+ if (EQ (elt, Qt))
+ goto try_default;
+
+ if (NILP (elt))
+ {
+ /* We have not yet decided a face for C. */
+ Lisp_Object range;
+
+ if (! face)
+ return -1;
+ elt = FONTSET_REF_AND_RANGE (base_fontset, c, from, to);
+ range = Fcons (make_number (from), make_number (to));
+ if (NILP (elt))
+ {
+ /* Record that we have no font for characters of this
+ range. */
+ FONTSET_SET (fontset, range, Qt);
+ goto try_default;
+ }
+ elt = Fcopy_sequence (elt);
+ /* Now ELT is a vector of FONT-DEFs. We at first change it to
+ FONT-VECTOR, a vector of [ nil nil FONT-DEF ]. */
+ for (i = 0; i < ASIZE (elt); i++)
+ {
+ Lisp_Object tmp;
+
+ tmp = Fmake_vector (make_number (3), Qnil);
+ ASET (tmp, 2, AREF (elt, i));
+ ASET (elt, i, tmp);
+ }
+ /* Then store (-1 . FONT-VECTOR) in the fontset. -1 is to force
+ reordering of FONT-VECTOR. */
+ elt = Fcons (make_number (-1), elt);
+ FONTSET_SET (fontset, range, elt);
+ }
- if (SINGLE_BYTE_CHAR_P (c))
+ if (XINT (XCAR (elt)) != charset_ordered_list_tick)
+ /* The priority of charsets is changed after we selected a face
+ for C last time. */
+ reorder_font_vector (elt);
+
+ vec = XCDR (elt);
+ /* Find the first available font in the font vector VEC. */
+ for (i = 0; i < ASIZE (vec); i++)
{
- FONTSET_ASCII (fontset) = newelt;
- return;
+ Lisp_Object font_def;
+
+ elt = AREF (vec, i);
+ /* ELT == [ FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ] ] */
+ font_def = AREF (elt, 2);
+ 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)) || NILP (AREF (elt, 0))))
+ /* We have not yet opened the font, or we have not yet made a
+ realized face for the font. */
+ return -1;
+
+ 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
+ {
+ 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. */
+ 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;
+ }
+
+ slot = Fassq (AREF (elt, 1), FONTSET_REPERTORY (fontset));
+ if (! CONSP (slot))
+ abort ();
+ if (NILP (CHAR_TABLE_REF (XCDR (slot), c)))
+ /* This fond can't display C. */
+ continue;
+ }
+
+ /* Now we have decided to use this font spec to display C. */
+ if (INTEGERP (AREF (elt, 1)))
+ font_idx = XINT (AREF (elt, 1));
+ else
+ {
+ /* But not yet opened the best matching font. */
+ font_idx = load_font_get_repertory (f, face, font_def, fontset);
+ ASET (elt, 1, make_number (font_idx));
+ if (font_idx < 0)
+ continue;
+ }
+
+ /* Now we have the opened font. */
+ if (NILP (AREF (elt, 0)))
+ {
+ /* But not yet made a realized face that uses this font. */
+ int face_id = lookup_non_ascii_face (f, font_idx, face);
+
+ ASET (elt, 0, make_number (face_id));
+ }
+
+ /* Ok, this face can display C. */
+ return XINT (AREF (elt, 0));
}
- 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++)
+ try_default:
+ if (! EQ (base_fontset, Vdefault_fontset))
+ return fontset_face (FONTSET_FALLBACK (fontset), c, face);
+
+ /* We have tried all the fonts for C, but none of them can be opened
+ nor can display C. */
+ if (NILP (FONTSET_NOFONT_FACE (fontset)))
{
- if (!SUB_CHAR_TABLE_P (*elt))
- *elt = make_sub_char_table (*elt);
- elt = &XCHAR_TABLE (*elt)->contents[code[i]];
+ int face_id;
+
+ if (! face)
+ return -1;
+ face_id = lookup_non_ascii_face (f, -1, face);
+ FONTSET_NOFONT_FACE (fontset) = make_number (face_id);
}
- if (SUB_CHAR_TABLE_P (*elt))
- XCHAR_TABLE (*elt)->defalt = newelt;
- else
- *elt = newelt;
+ return XINT (FONTSET_NOFONT_FACE (fontset));
}
/* 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
if (id + 1 == size)
{
+ /* We must grow Vfontset_table. */
Lisp_Object tem;
int i;
- tem = Fmake_vector (make_number (size + 8), Qnil);
+ tem = Fmake_vector (make_number (size + 32), Qnil);
for (i = 0; i < size; i++)
AREF (tem, i) = AREF (Vfontset_table, i);
Vfontset_table = tem;
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;
+ if (! NILP (base) && ! EQ (base, Vdefault_fontset))
+ FONTSET_FALLBACK (fontset) = make_fontset (frame, Qnil, Vdefault_fontset);
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)
- 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;
-
- family = make_unibyte_string (sep[0], sep[2] - 1 - sep[0]);
- registry = make_unibyte_string (sep[12], p - sep[12]);
- return Fcons (family, registry);
- }
-
\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);
+ /* 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))
- {
- AREF (Vfontset_table, face->fontset) = Qnil;
- if (face->fontset < next_fontset_id)
- next_fontset_id = face->fontset;
- }
+ ASET (Vfontset_table, face->fontset, Qnil);
+ if (face->fontset < next_fontset_id)
+ next_fontset_id = face->fontset;
}
/* Return 1 iff 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;
- 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));
+ return (face->id == fontset_face (fontset, c, NULL));
}
/* 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)
struct face *face;
int c;
{
- Lisp_Object fontset, elt;
- int face_id;
+ Lisp_Object fontset;
+
+ 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));
-
- elt = FONTSET_REF_VIA_BASE (fontset, c);
- if (!NILP (elt))
- return XINT (elt);
-
- /* 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);
-
- /* 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;
+ return fontset_face (fontset, c, face);
}
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);
+ {
+ Lisp_Object elt;
+
+ elt = FONTSET_REF (base_fontset, 0);
+ elt = Fmake_vector (make_number (3), AREF (elt, 0));
+ ASET (elt, 0, make_number (face->id));
+ ASET (elt, 1, make_number (face->font_info_id));
+ elt = Fcons (make_number (charset_ordered_list_tick),
+ Fmake_vector (make_number (1), elt));
+ char_table_set_range (fontset, 0, 127, elt);
+ }
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
- fontset_font_pattern (f, id, c)
- FRAME_PTR f;
- int id, c;
- {
- Lisp_Object fontset, elt;
- struct font_info *fontp;
-
- elt = Qnil;
- if (fontset_id_valid_p (id))
- {
- fontset = FONTSET_FROM_ID (id);
- xassert (!BASE_FONTSET_P (fontset));
- fontset = FONTSET_BASE (fontset);
- elt = FONTSET_REF (fontset, 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));
- }
-
-
#if defined(WINDOWSNT) && defined (_MSC_VER)
#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;
- 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));
- }
- }
if (!fontname)
/* No way to get fontname. */
- return 0;
+ return NULL;
- fontp = (*load_font_func) (f, fontname, size);
- if (!fontp)
- return 0;
+ fontp = (*load_font_func) (f, fontname, 0);
+ if (! fontp || fontp->charset >= 0)
+ return fontp;
- /* Fill in members (charset, vertical_centering, encoding, etc) of
- font_info structure that are not set by (*load_font_func). */
- fontp->charset = charset;
+ fontname = fontp->full_name;
- fontp->vertical_centering
- = (STRINGP (Vvertical_centering_font_regexp)
- && (fast_c_string_match_ignore_case
- (Vvertical_centering_font_regexp, fontp->full_name) >= 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;
+ Lisp_Object charset_symbol;
- fontp->encoding[0] = fontp->encoding[1];
- for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
- fontp->encoding[i] = fontp->encoding[1];
+ charset_symbol = find_font_encoding (fontname);
+ if (CONSP (charset_symbol))
+ charset_symbol = XCAR (charset_symbol);
+ charset = XINT (CHARSET_SYMBOL_ID (charset_symbol));
}
- else
+ fontp->charset = charset;
+ fontp->vertical_centering = 0;
+ fontp->font_encoder = NULL;
+
+ if (charset != charset_ascii)
{
- /* The font itself doesn't have information about encoding. */
- int i;
+ fontp->vertical_centering
+ = (STRINGP (Vvertical_centering_font_regexp)
+ && (fast_c_string_match_ignore_case
+ (Vvertical_centering_font_regexp, fontname) >= 0));
- fontname = fontp->full_name;
- /* 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_c_string_match_ignore_case (XCAR (elt), fontname)
- >= 0))
- {
- Lisp_Object tmp;
-
- 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);
}
- fontp->font_encoder = (struct ccl_program *) 0;
-
- if (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;
}
#endif
\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. */
+
+
+ static Lisp_Object
+ find_font_encoding (fontname)
+ char *fontname;
+ {
+ Lisp_Object tail, elt;
+
+ for (tail = Vfont_encoding_alist; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ if (CONSP (elt)
+ && STRINGP (XCAR (elt))
+ && fast_c_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 Unicode
+ encoding. */
+ return Qunicode;
+ }
+
+
/* 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. */
static Lisp_Object Vcached_fontset_data;
-#define CACHED_FONTSET_NAME (XSTRING (XCAR (Vcached_fontset_data))->data)
+#define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data)))
#define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
/* If fontset name PATTERN contains any wild card, return regular
fontset_pattern_regexp (pattern)
Lisp_Object pattern;
{
- if (!index (XSTRING (pattern)->data, '*')
- && !index (XSTRING (pattern)->data, '?'))
+ if (!index (SDATA (pattern), '*')
+ && !index (SDATA (pattern), '?'))
/* PATTERN does not contain any wild cards. */
return Qnil;
if (!CONSP (Vcached_fontset_data)
- || strcmp (XSTRING (pattern)->data, CACHED_FONTSET_NAME))
+ || strcmp (SDATA (pattern), CACHED_FONTSET_NAME))
{
/* We must at first update the cached data. */
- char *regex = (char *) alloca (XSTRING (pattern)->size * 2 + 3);
+ char *regex = (char *) alloca (SCHARS (pattern) * 2 + 3);
char *p0, *p1 = regex;
/* Convert "*" to ".*", "?" to ".". */
*p1++ = '^';
- for (p0 = (char *) XSTRING (pattern)->data; *p0; p0++)
+ for (p0 = (char *) SDATA (pattern); *p0; p0++)
{
if (*p0 == '*')
{
*p1++ = '$';
*p1++ = 0;
- Vcached_fontset_data = Fcons (build_string (XSTRING (pattern)->data),
+ Vcached_fontset_data = Fcons (build_string (SDATA (pattern)),
build_string (regex));
}
for (i = 0; i < ASIZE (Vfontset_table); i++)
{
Lisp_Object fontset;
- const unsigned char *this_name;
+ unsigned char *this_name;
fontset = FONTSET_FROM_ID (i);
if (NILP (fontset)
|| !BASE_FONTSET_P (fontset))
continue;
- this_name = XSTRING (FONTSET_NAME (fontset))->data;
+ this_name = SDATA (FONTSET_NAME (fontset));
if (regexpp
? fast_c_string_match_ignore_case (name, this_name) >= 0
- : !strcmp (XSTRING (name)->data, this_name))
+ : !strcmp (SDATA (name), this_name))
return i;
}
return -1;
CHECK_STRING (pattern);
- if (XSTRING (pattern)->size == 0)
+ if (SCHARS (pattern) == 0)
return Qnil;
id = fs_query_fontset (pattern, !NILP (regexpp));
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)
for (id = 0; id < ASIZE (Vfontset_table); id++)
{
Lisp_Object fontset;
- const unsigned char *name;
+ unsigned char *name;
fontset = FONTSET_FROM_ID (id);
if (NILP (fontset)
|| !BASE_FONTSET_P (fontset)
|| !EQ (frame, FONTSET_FRAME (fontset)))
continue;
- name = XSTRING (FONTSET_NAME (fontset))->data;
+ name = SDATA (FONTSET_NAME (fontset));
- if (!NILP (regexp)
+ if (STRINGP (regexp)
? (fast_c_string_match_ignore_case (regexp, name) < 0)
- : strcmp (XSTRING (pattern)->data, name))
+ : strcmp (SDATA (pattern), name))
continue;
- if (size)
- {
- struct font_info *fontp;
- fontp = FS_LOAD_FONT (f, 0, NULL, id);
- if (!fontp || size != fontp->size)
- continue;
- }
val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
}
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;
- (*check_window_system_func) ();
-/* Free all realized fontsets whose base fontset is BASE. */
++/* Free all realized fontsets whose base fontset is BASE. */
- CHECK_STRING (name);
- CHECK_LIST (fontlist);
+ static void
+ free_realized_fontsets (base)
+ Lisp_Object base;
+ {
+ #if 0
+ int id;
- name = Fdowncase (name);
- tem = Fquery_fontset (name, Qnil);
- if (!NILP (tem))
- error ("Fontset `%s' matches the existing fontset `%s'",
- SDATA (name), SDATA (tem));
-
- /* Check the validity of FONTLIST while creating a template for
- fontset elements. */
- elements = ascii_font = Qnil;
- for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
+ /* 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++)
{
- int c, charset;
-
- 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");
+ Lisp_Object this = AREF (Vfontset_table, id);
- 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
+ if (EQ (FONTSET_BASE (this), base))
{
- c = MAKE_CHAR (charset, 0, 0);
- elements = Fcons (Fcons (make_number (c), tem), elements);
- }
- }
+ Lisp_Object tail;
- if (NILP (ascii_font))
- error ("No ASCII font in the fontlist");
+ 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);
-
+
- fontset = make_fontset (Qnil, name, Qnil);
- FONTSET_ASCII (fontset) = Fcons (make_number (0), ascii_font);
- for (; CONSP (elements); elements = XCDR (elements))
- {
- 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);
+ /* Face THIS itself is also freed by the following call. */
+ free_realized_face (f, face);
+ }
+ }
}
-
- 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;
+ UNBLOCK_INPUT;
+ #else /* not 0 */
+ Fclear_face_cache (Qt);
+ #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 nil, return Vdefault_fontset. */
+ If NAME is t, return Vdefault_fontset. */
static Lisp_Object
check_fontset_name (name)
{
int id;
- if (EQ (name, Qnil))
+ if (EQ (name, Qt))
return Vdefault_fontset;
CHECK_STRING (name);
id = fs_query_fontset (name, 0);
if (id < 0)
- error ("Fontset `%s' does not exist", XSTRING (name)->data);
+ error ("Fontset `%s' does not exist", SDATA (name));
return FONTSET_FROM_ID (id);
}
- DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,
- doc: /* Modify fontset NAME to use FONTNAME for CHARACTER.
+ 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
+ ASCII font specification ASCII_SPEC. NAME is a string conforming
+ to XLFD. ASCII_SPEC is a vector:
+ [FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY]. */
+
+ static INLINE Lisp_Object
+ generate_ascii_font_name (name, ascii_spec)
+ Lisp_Object name, ascii_spec;
+ {
+ Lisp_Object vec;
+ int i;
+
+ vec = split_font_name_into_vector (name);
+ for (i = FONT_SPEC_FAMILY_INDEX; i <= FONT_SPEC_ADSTYLE_INDEX; i++)
+ if (! NILP (AREF (ascii_spec, i)))
+ ASET (vec, 1 + i, AREF (ascii_spec, i));
+ if (! NILP (AREF (ascii_spec, FONT_SPEC_REGISTRY_INDEX)))
+ ASET (vec, 12, AREF (ascii_spec, FONT_SPEC_REGISTRY_INDEX));
+ return build_font_name_from_vector (vec);
+ }
+
+
+ DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
- doc: /*
++ doc: /*
+ Modify fontset NAME to use FONT-SPEC 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.
-
- 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;
+ characters. In that case, use FONT-SPEC for all characters in the
+ range FROM and TO (inclusive).
+
+ CHARACTER may be a script name symbol. In that case, use FONT-SPEC
+ for all characters that belong to the script.
+
+ CHARACTER may be a charset which has a :code-offset attribute and the
+ attribute value is greater than the maximum Unicode character
+ \(#x10FFFF). In that case, use FONT-SPEC for all characters in the
+ charset.
+
+ FONT-SPEC may be:
+ * A vector [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ].
+ See the documentation of `set-face-attribute' for the detail of
+ these vector elements;
+ * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
+ REGISTRY is a font registry name;
+ * A font name string.
+
+ 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 RANGE 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, character, font_spec, frame, add)
+ Lisp_Object name, character, font_spec, frame, add;
{
- Lisp_Object fontset, elt;
- Lisp_Object realized;
- int from, to;
- int id;
- Lisp_Object family, registry;
+ Lisp_Object fontset;
+ Lisp_Object font_def, registry;
+ Lisp_Object encoding, repertory;
+ Lisp_Object range_list;
fontset = check_fontset_name (name);
- if (CONSP (character))
+ /* The arg FRAME is kept for backward compatibility. We only check
+ the validity. */
+ if (!NILP (frame))
+ CHECK_LIVE_FRAME (frame);
+
+ if (VECTORP (font_spec))
{
- /* 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");
+ int j;
+
+ if (ASIZE (font_spec) != FONT_SPEC_MAX_INDEX)
+ args_out_of_range (make_number (FONT_SPEC_MAX_INDEX),
+ make_number (ASIZE (font_spec)));
+
+ font_spec = Fcopy_sequence (font_spec);
+ for (j = 0; j < FONT_SPEC_MAX_INDEX - 1; j++)
+ if (! NILP (AREF (font_spec, j)))
+ {
+ CHECK_STRING (AREF (font_spec, j));
+ ASET (font_spec, j, Fdowncase (AREF (font_spec, j)));
+ }
+ /* REGISTRY should not be omitted. */
+ CHECK_STRING (AREF (font_spec, FONT_SPEC_REGISTRY_INDEX));
+ registry = Fdowncase (AREF (font_spec, FONT_SPEC_REGISTRY_INDEX));
+ ASET (font_spec, FONT_SPEC_REGISTRY_INDEX, registry);
+
}
- else if (SYMBOLP (character))
+ else if (CONSP (font_spec))
{
- 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;
+ Lisp_Object family;
+
+ family = XCAR (font_spec);
+ registry = XCDR (font_spec);
+
+ if (! NILP (family))
+ {
+ CHECK_STRING (family);
+ family = Fdowncase (family);
+ }
+ CHECK_STRING (registry);
+ registry = Fdowncase (registry);
+ font_spec = Fmake_vector (make_number (FONT_SPEC_MAX_INDEX), Qnil);
+ ASET (font_spec, FONT_SPEC_FAMILY_INDEX, family);
+ ASET (font_spec, FONT_SPEC_REGISTRY_INDEX, registry);
}
else
{
- CHECK_NUMBER (character);
- from = XINT (character);
- to = from;
+ CHECK_STRING (font_spec);
+ font_spec = Fdowncase (font_spec);
+ registry = split_font_name_into_vector (font_spec);
+ if (NILP (registry))
- error ("No XLFD: %s", XSTRING (font_spec)->data);
++ error ("No XLFD: %s", SDATA (font_spec));
+ if (NILP (AREF (registry, 12))
+ || NILP (AREF (registry, 13)))
+ error ("Registry must be specified");
+ registry = concat2 (concat2 (AREF (registry, 12), build_string ("-")),
+ AREF (registry, 13));
}
- 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)
+
+ if (STRINGP (font_spec))
- encoding = find_font_encoding ((char *) XSTRING (font_spec)->data);
++ encoding = find_font_encoding ((char *) SDATA (font_spec));
+ else
- encoding = find_font_encoding ((char *) XSTRING (registry)->data);
++ encoding = find_font_encoding ((char *) SDATA (registry));
+ if (SYMBOLP (encoding))
+ encoding = repertory = CHARSET_SYMBOL_ID (encoding);
+ else
{
- 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");
+ repertory = XCDR (encoding);
+ encoding = CHARSET_SYMBOL_ID (XCAR (encoding));
}
+ font_def = Fmake_vector (make_number (3), font_spec);
+ ASET (font_def, 1, encoding);
+ ASET (font_def, 2, repertory);
- if (STRINGP (fontname))
+ if (CHARACTERP (character))
+ range_list = Fcons (Fcons (character, character), Qnil);
+ else if (CONSP (character))
{
- fontname = Fdowncase (fontname);
- elt = Fcons (make_number (from), font_family_registry (fontname, 0));
+ Lisp_Object from, to;
+
+ from = Fcar (character);
+ to = Fcdr (character);
+ CHECK_CHARACTER (from);
+ CHECK_CHARACTER (to);
+ range_list = Fcons (character, Qnil);
}
else
{
- CHECK_CONS (fontname);
- family = XCAR (fontname);
- registry = XCDR (fontname);
- if (!NILP (family))
+ Lisp_Object script_list;
+ Lisp_Object val;
+
+ CHECK_SYMBOL (character);
+ range_list = Qnil;
+ script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
+ if (! NILP (Fmemq (character, script_list)))
{
- CHECK_STRING (family);
- family = Fdowncase (family);
+ val = Fcons (character, Qnil);
+ map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
- val, 0, NULL);
- range_list = XCDR (val);
++ val);
++ range_list = XCDR (val);
}
- if (!NILP (registry))
+ else if (CHARSETP (character))
{
- CHECK_STRING (registry);
- registry = Fdowncase (registry);
+ struct charset *charset;
+
+ CHECK_CHARSET_GET_CHARSET (character, charset);
+ if (CHARSET_METHOD (charset) == CHARSET_METHOD_OFFSET)
+ range_list
+ = Fcons (Fcons (make_number (CHARSET_MIN_CHAR (charset)),
+ make_number (CHARSET_MAX_CHAR (charset))),
+ range_list);
+ if (EQ (character, Qascii))
+ {
+ if (VECTORP (font_spec))
+ font_spec = generate_ascii_font_name (FONTSET_NAME (fontset),
+ font_spec);
+ FONTSET_ASCII (fontset) = font_spec;
+ }
}
- elt = Fcons (make_number (from), Fcons (family, registry));
+
+ if (NILP (range_list))
+ error ("Invalid script or charset name: %s",
- XSYMBOL (character)->name->data);
++ SDATA (SYMBOL_NAME (character)));
}
- /* The arg FRAME is kept for backward compatibility. We only check
- the validity. */
- if (!NILP (frame))
- CHECK_LIVE_FRAME (frame);
+ for (; CONSP (range_list); range_list = XCDR (range_list))
+ FONTSET_ADD (fontset, XCAR (range_list), font_def, add);
- for (; from <= to; from++)
- FONTSET_SET (fontset, from, elt);
- Foptimize_char_table (fontset);
+ /* 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);
- /* 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++)
+ return 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.
+
+ SCRIPT is a symbol that appears in the first extra slot of the
+ char-table `char-script-table'.
+
+ 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;
+
+ CHECK_STRING (name);
+ CHECK_LIST (fontlist);
+
+ id = fs_query_fontset (name, 0);
+ if (id < 0)
{
- realized = AREF (Vfontset_table, id);
- if (!NILP (realized)
- && !BASE_FONTSET_P (realized)
- && EQ (FONTSET_BASE (realized), fontset))
- {
- FRAME_PTR f = XFRAME (FONTSET_FRAME (realized));
- clear_fontset_elements (realized);
- free_realized_multibyte_face (f, id);
- }
+ name = Fdowncase (name);
+ val = split_font_name_into_vector (name);
+ if (NILP (val))
+ error ("Fontset name must be in XLFD format");
- if (strcmp (XSTRING (AREF (val, 12))->data, "fontset"))
++ 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
+ {
+ fontset = FONTSET_FROM_ID (id);;
+ free_realized_fontsets (fontset);
+ Fset_char_table_range (fontset, Qt, Qnil);
}
- return Qnil;
+ for (; ! NILP (fontlist); fontlist = Fcdr (fontlist))
+ {
+ Lisp_Object elt, script;
+
+ elt = Fcar (fontlist);
+ script = Fcar (elt);
+ for (elt = Fcdr (elt); ! NILP (elt); elt = Fcdr (elt))
+ Fset_fontset_font (name, script, Fcar (elt), Qnil, Qappend);
+ }
+ return name;
+ }
+
+
+ /* Number of fontsets created from a fontname automatically. */
+ static int n_auto_fontsets;
+
+ int
+ new_fontset_from_font_name (Lisp_Object fontname)
+ {
+ Lisp_Object name;
+ Lisp_Object vec;
+
+ fontname = Fdowncase (fontname);
+ 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 (n_auto_fontsets == 0)
+ {
+ ASET (vec, 13, build_string ("startup"));
+ name = build_font_name_from_vector (vec);
+ n_auto_fontsets++;
+ }
+ else
+ {
+ char temp[20];
+
+ do {
+ sprintf (temp, "auto%d", n_auto_fontsets);
+ ASET (vec, 13, build_string (temp));
+ name = build_font_name_from_vector (vec);
+ n_auto_fontsets++;
+ } while (fs_query_fontset (name, 0) >= 0);
+ }
+ name = Fnew_fontset (name,
+ Fcons (Fcons (Qascii, Fcons (fontname, Qnil)), Qnil));
+ Vfontset_alias_alist = Fcons (Fcons (name, fontname), Vfontset_alias_alist);
+ return fs_query_fontset (name, 0);
}
+
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.
if (!query_font_func)
error ("Font query function is not supported");
- fontp = (*query_font_func) (f, XSTRING (name)->data);
+ fontp = (*query_font_func) (f, SDATA (name));
if (!fontp)
return Qnil;
args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
pos_byte = CHAR_TO_BYTE (pos);
c = FETCH_CHAR (pos_byte);
- if (! CHAR_VALID_P (c, 0))
- return Qnil;
window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
if (NILP (window))
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;
- Lisp_Object indices[3];
- Lisp_Object val, tail, elt;
+ Lisp_Object table, val, elt;
Lisp_Object *realized;
- struct font_info *fontp = NULL;
int n_realized = 0;
- int i;
+ int fallback;
+ int c, i, j;
(*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'. */
+ /* Recode fontsets realized on FRAME from the base fontset FONTSET
+ in the table `realized'. */
realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)
* ASIZE (Vfontset_table));
for (i = 0; i < ASIZE (Vfontset_table); i++)
{
elt = FONTSET_FROM_ID (i);
if (!NILP (elt)
- && EQ (FONTSET_BASE (elt), fontset))
+ && EQ (FONTSET_BASE (elt), fontset)
+ && EQ (FONTSET_FRAME (elt), frame))
realized[n_realized++] = elt;
}
- if (! EQ (fontset, Vdefault_fontset))
- {
- /* 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;
- }
- /* 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))
+ table = Fmake_char_table (Qfontset_info, Qnil);
+ XCHAR_TABLE (table)->extras[0] = Fmake_char_table (Qnil, Qnil);
+ /* Accumulate information of the fontset in TABLE. The format of
+ each element is ((FONT-SPEC OPENED-FONT ...) ...). */
+ for (fallback = 0; fallback <= 1; fallback++)
{
- int c;
- elt = XCAR (tail);
- if (INTEGERP (XCAR (elt)))
+ Lisp_Object this_fontset, this_table;
-
++
+ if (! fallback)
{
- int charset, c1, c2;
- c = XINT (XCAR (elt));
- SPLIT_CHAR (c, charset, c1, c2);
- if (c1 == 0)
- XSETCAR (elt, CHARSET_SYMBOL (charset));
+ this_fontset = fontset;
+ this_table = table;
}
else
- c = XINT (XCAR (XCAR (elt)));
- for (i = 0; i < n_realized; i++)
{
- Lisp_Object face_id, font;
- struct face *face;
+ this_fontset = Vdefault_fontset;
+ this_table = XCHAR_TABLE (table)->extras[0];
+ #if 0
+ for (i = 0; i < n_realized; i++)
+ realized[i] = FONTSET_FALLBACK (realized[i]);
+ #endif
+ }
+ for (c = 0; c <= MAX_5_BYTE_CHAR; )
+ {
+ int from, to;
- face_id = FONTSET_REF_VIA_BASE (realized[i], c);
- if (INTEGERP (face_id))
+ val = char_table_ref_and_range (this_fontset, c, &from, &to);
+ if (VECTORP (val))
{
- face = FACE_FROM_ID (f, XINT (face_id));
- if (face && face->font && face->font_name)
+ 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; i < n_realized; i++)
{
- font = build_string (face->font_name);
- if (NILP (Fmember (font, XCDR (XCDR (elt)))))
- XSETCDR (XCDR (elt), Fcons (font, XCDR (XCDR (elt))));
+ if (NILP (realized[i]))
+ continue;
+ val = FONTSET_REF (realized[i], c);
+ if (NILP (val))
+ continue;
+ val = XCDR (val);
+ /* Now VAL is [[FACE-ID FONT-INDEX FONT-DEF] ...].
+ If a font of an element is already opened,
+ FONT-INDEX of the element is integer. */
+ for (j = 0; j < ASIZE (val); j++)
+ if (INTEGERP (AREF (AREF (val, j), 0)))
+ {
+ 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. */
+ char_table_set_range (this_table, c, to, 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 table;
}
+
DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 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. */)
+ If NAME is t, find a font name pattern in the default fontset. */)
(name, ch)
Lisp_Object name, ch;
{
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);
-
- return elt;
+ return Fcopy_sequence (elt);
}
DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
/* 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 (8));
+ DEFSYM (Qfontset_info, "fontset-info");
+ Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1));
+
+ DEFSYM (Qprepend, "prepend");
+ DEFSYM (Qappend, "append");
Vcached_fontset_data = Qnil;
staticpro (&Vcached_fontset_data);
FONTSET_ID (Vdefault_fontset) = make_number (0);
FONTSET_NAME (Vdefault_fontset)
= build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
- #if defined (MAC_OS)
- FONTSET_ASCII (Vdefault_fontset)
- = Fcons (make_number (0),
- build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman"));
+ {
+ Lisp_Object default_ascii_font;
+
+ #if defined (macintosh)
+ default_ascii_font
+ = build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman");
#elif defined (WINDOWSNT)
- FONTSET_ASCII (Vdefault_fontset)
- = Fcons (make_number (0),
- build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1"));
+ default_ascii_font
+ = build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
#else
- FONTSET_ASCII (Vdefault_fontset)
- = Fcons (make_number (0),
- build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
+ default_ascii_font
+ = build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
#endif
+ FONTSET_ASCII (Vdefault_fontset) = default_ascii_font;
+ }
AREF (Vfontset_table, 0) = Vdefault_fontset;
next_fontset_id = 1;
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.
++and REPERTORY is a charset, a char-table, or nil.
+
+ 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 ("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
defsubr (&Sfontset_font);
defsubr (&Sfontset_list);
}
-
+
+ Lisp_Object
+ dump_fontset (fontset)
+ Lisp_Object fontset;
+ {
+ Lisp_Object val;
++
+ if (NILP (FONTSET_FALLBACK (fontset)))
+ val = Fcons (Fcons (intern ("fallback-id"), Qnil), Qnil);
+ else
+ val = Fcons (Fcons (intern ("fallback-id"),
+ FONTSET_ID (FONTSET_FALLBACK (fontset))),
+ Qnil);
+ if (NILP (FONTSET_BASE (fontset)))
+ val = Fcons (Fcons (intern ("base"), Qnil), val);
+ else
+ val = Fcons (Fcons (intern ("base"),
+ FONTSET_NAME (FONTSET_BASE (fontset))),
+ val);
+ val = Fcons (Fcons (intern ("name"), FONTSET_NAME (fontset)), val);
+ val = Fcons (Fcons (intern ("id"), FONTSET_ID (fontset)), val);
+ return val;
+ }
/* Header for fontset handler.
Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.
-- Licensed to the Free Software Foundation.
- Copyright (C) 2001, 2002
++ Licensed to the Free Software Foundation.
++ Copyright (C) 2003
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
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'
`ascent'. In other words, the value indicates how many bits
higher we should draw a character of the font than normal ASCII
text for a better looking.
-
+
We also have to consider the fact that the concept of `baseline'
differs among languages to which each character belongs. For
instance, baseline should be at the bottom most position of all
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 struct font_info *fs_load_font P_ ((struct frame *, int, char *, int,
- struct face *));
+ extern int make_fontset_for_ascii_face P_ ((FRAME_PTR, int, struct face *));
+ extern int new_fontset_from_font_name P_ ((Lisp_Object));
+ 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 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;
- /* 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
/* Generic frame functions.
- Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001
+ Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2003
Free Software Foundation.
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 WINDOWSNT
#include "w32term.h"
#endif
-#ifdef macintosh
+#ifdef MAC_OS
#include "macterm.h"
#endif
#include "buffer.h"
#ifdef HAVE_WINDOW_SYSTEM
#include "fontset.h"
#endif
+#include "blockinput.h"
#include "termhooks.h"
#include "dispextern.h"
#include "window.h"
#include "dosfns.h"
#endif
-Lisp_Object Qframep;
-Lisp_Object Qframe_live_p;
-Lisp_Object Qheight;
-Lisp_Object Qicon;
-Lisp_Object Qminibuffer;
-Lisp_Object Qmodeline;
-Lisp_Object Qname;
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* The name we're using in resource queries. Most often "emacs". */
+
+Lisp_Object Vx_resource_name;
+
+/* The application class we're using in resource queries.
+ Normally "Emacs". */
+
+Lisp_Object Vx_resource_class;
+
+#endif
+
+Lisp_Object Qframep, Qframe_live_p;
+Lisp_Object Qicon, Qmodeline;
Lisp_Object Qonly;
-Lisp_Object Qunsplittable;
-Lisp_Object Qmenu_bar_lines;
-Lisp_Object Qtool_bar_lines;
-Lisp_Object Qwidth;
-Lisp_Object Qx;
-Lisp_Object Qw32;
-Lisp_Object Qpc;
-Lisp_Object Qmac;
+Lisp_Object Qx, Qw32, Qmac, Qpc;
Lisp_Object Qvisible;
-Lisp_Object Qbuffer_predicate;
-Lisp_Object Qbuffer_list;
-Lisp_Object Qtitle;
Lisp_Object Qdisplay_type;
Lisp_Object Qbackground_mode;
Lisp_Object Qinhibit_default_face_x_resources;
-Lisp_Object Qleft_fringe;
-Lisp_Object Qright_fringe;
+
+Lisp_Object Qx_frame_parameter;
+Lisp_Object Qx_resource_name;
+
+/* Frame parameters (set or reported). */
+
+Lisp_Object Qauto_raise, Qauto_lower;
+Lisp_Object Qborder_color, Qborder_width;
+Lisp_Object Qcursor_color, Qcursor_type;
+Lisp_Object Qgeometry; /* Not used */
+Lisp_Object Qheight, Qwidth;
+Lisp_Object Qleft, Qright;
+Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name;
+Lisp_Object Qinternal_border_width;
+Lisp_Object Qmouse_color;
+Lisp_Object Qminibuffer;
+Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
+Lisp_Object Qvisibility;
+Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
+Lisp_Object Qscreen_gamma;
+Lisp_Object Qline_spacing;
+Lisp_Object Quser_position, Quser_size;
+Lisp_Object Qwait_for_wm;
+Lisp_Object Qwindow_id;
+#ifdef HAVE_X_WINDOWS
+Lisp_Object Qouter_window_id;
+#endif
+Lisp_Object Qparent_id;
+Lisp_Object Qtitle, Qname;
+Lisp_Object Qunsplittable;
+Lisp_Object Qmenu_bar_lines, Qtool_bar_lines;
+Lisp_Object Qleft_fringe, Qright_fringe;
+Lisp_Object Qbuffer_predicate, Qbuffer_list;
Lisp_Object Qtty_color_mode;
+Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth;
+
+Lisp_Object Qface_set_after_frame_default;
+
+
Lisp_Object Vterminal_frame;
Lisp_Object Vdefault_frame_alist;
Lisp_Object Vmouse_position_function;
Lisp_Object Vmouse_highlight;
+Lisp_Object Vdelete_frame_functions;
\f
static void
set_menu_bar_lines_1 (window, n)
struct window *w = XWINDOW (window);
XSETFASTINT (w->last_modified, 0);
- XSETFASTINT (w->top, XFASTINT (w->top) + n);
- XSETFASTINT (w->height, XFASTINT (w->height) - n);
-
- if (INTEGERP (w->orig_top))
- XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n);
- if (INTEGERP (w->orig_height))
- XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n);
+ XSETFASTINT (w->top_line, XFASTINT (w->top_line) + n);
+ XSETFASTINT (w->total_lines, XFASTINT (w->total_lines) - n);
+
+ if (INTEGERP (w->orig_top_line))
+ XSETFASTINT (w->orig_top_line, XFASTINT (w->orig_top_line) + n);
+ if (INTEGERP (w->orig_total_lines))
+ XSETFASTINT (w->orig_total_lines, XFASTINT (w->orig_total_lines) - n);
/* Handle just the top child in a vertical split. */
if (!NILP (w->vchild))
f->tool_bar_items = Qnil;
f->desired_tool_bar_string = f->current_tool_bar_string = Qnil;
f->n_tool_bar_items = 0;
+ f->left_fringe_width = f->right_fringe_width = 0;
+ f->fringe_cols = 0;
+ f->scroll_bar_actual_width = 0;
+ f->border_width = 0;
+ f->internal_border_width = 0;
+ f->column_width = 1; /* !FRAME_WINDOW_P value */
+ f->line_height = 1; /* !FRAME_WINDOW_P value */
+ f->x_pixels_diff = f->y_pixels_diff = 0;
+#ifdef HAVE_WINDOW_SYSTEM
+ f->want_fullscreen = FULLSCREEN_NONE;
+#endif
+ f->size_hint_flags = 0;
+ f->win_gravity = 0;
root_window = make_window ();
if (mini_p)
just so that there is "something there."
Correct size will be set up later with change_frame_size. */
- SET_FRAME_WIDTH (f, 10);
- f->height = 10;
+ SET_FRAME_COLS (f, 10);
+ FRAME_LINES (f) = 10;
- XSETFASTINT (XWINDOW (root_window)->width, 10);
- XSETFASTINT (XWINDOW (root_window)->height, (mini_p ? 9 : 10));
+ XSETFASTINT (XWINDOW (root_window)->total_cols, 10);
+ XSETFASTINT (XWINDOW (root_window)->total_lines, (mini_p ? 9 : 10));
if (mini_p)
{
- XSETFASTINT (XWINDOW (mini_window)->width, 10);
- XSETFASTINT (XWINDOW (mini_window)->top, 9);
- XSETFASTINT (XWINDOW (mini_window)->height, 1);
+ XSETFASTINT (XWINDOW (mini_window)->total_cols, 10);
+ XSETFASTINT (XWINDOW (mini_window)->top_line, 9);
+ XSETFASTINT (XWINDOW (mini_window)->total_lines, 1);
}
/* Choose a buffer for the frame's root window. */
buf = Fcurrent_buffer ();
/* If buf is a 'hidden' buffer (i.e. one whose name starts with
a space), try to find another one. */
- if (XSTRING (Fbuffer_name (buf))->data[0] == ' ')
+ if (SREF (Fbuffer_name (buf), 0) == ' ')
buf = Fother_buffer (buf, Qnil, Qnil);
/* Use set_window_buffer, not Fset_window_buffer, and don't let
don't have the right size, glyph matrices aren't initialized
etc. Running Lisp functions at this point surely ends in a
SEGV. */
- set_window_buffer (root_window, buf, 0);
+ set_window_buffer (root_window, buf, 0, 0);
f->buffer_list = Fcons (buf, Qnil);
}
(NILP (Vminibuffer_list)
? get_minibuffer (0)
: Fcar (Vminibuffer_list)),
- 0);
+ 0, 0);
}
f->root_window = root_window;
a newly-created, never-selected window. */
XSETFASTINT (XWINDOW (f->selected_window)->use_time, ++window_select_count);
+ f->default_face_done_p = 0;
+
return f;
}
\f
call1 (intern ("make-initial-minibuffer-frame"), display);
UNGCPRO;
}
-
+
mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window;
}
Fset_window_buffer (mini_window,
(NILP (Vminibuffer_list)
? get_minibuffer (0)
- : Fcar (Vminibuffer_list)));
+ : Fcar (Vminibuffer_list)), Qnil);
return f;
}
Fset_window_buffer (mini_window,
(NILP (Vminibuffer_list)
? get_minibuffer (0)
- : Fcar (Vminibuffer_list)));
+ : Fcar (Vminibuffer_list)), Qnil);
return f;
}
#endif /* HAVE_WINDOW_SYSTEM */
f->output_method = output_termcap;
f->output_data.x = &tty_display;
#else
-#ifdef macintosh
+#ifdef MAC_OS8
make_mac_terminal_frame (f);
#else
f->output_data.x = &tty_display;
-#endif /* macintosh */
+#ifdef CANNOT_DUMP
+ FRAME_FOREGROUND_PIXEL(f) = FACE_TTY_DEFAULT_FG_COLOR;
+ FRAME_BACKGROUND_PIXEL(f) = FACE_TTY_DEFAULT_BG_COLOR;
+#endif
+#endif /* MAC_OS8 */
#endif /* WINDOWSNT */
#endif /* MSDOS */
abort ();
#else /* not MSDOS */
-#ifdef macintosh
+#ifdef MAC_OS
if (sf->output_method != output_mac)
error ("Not running on a Macintosh screen; cannot make a new Macintosh frame");
#else
f = make_terminal_frame ();
- change_frame_size (f, FRAME_HEIGHT (sf),
- FRAME_WIDTH (sf), 0, 0, 0);
+ change_frame_size (f, FRAME_LINES (sf),
+ FRAME_COLS (sf), 0, 0, 0);
adjust_glyphs (f);
calculate_costs (f);
XSETFRAME (frame, f);
int track, for_deletion;
{
struct frame *sf = SELECTED_FRAME ();
-
+
/* If FRAME is a switch-frame event, extract the frame we should
switch to. */
if (CONSP (frame)
if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
last_nonminibuf_frame = XFRAME (selected_frame);
- Fselect_window (XFRAME (frame)->selected_window);
+ Fselect_window (XFRAME (frame)->selected_window, Qnil);
#ifndef WINDOWSNT
/* Make sure to switch the tty color mode to that of the newly
DEFUN ("ignore-event", Fignore_event, Signore_event, 0, 0, "",
doc: /* Do nothing, but preserve any prefix argument already specified.
-This is a suitable binding for iconify-frame and make-frame-visible. */)
+This is a suitable binding for `iconify-frame' and `make-frame-visible'. */)
()
{
current_kboard->Vprefix_arg = Vcurrent_prefix_arg;
Lisp_Object frame;
{
Lisp_Object window;
-
+
if (NILP (frame))
window = SELECTED_FRAME ()->root_window;
else
CHECK_LIVE_FRAME (frame);
window = XFRAME (frame)->root_window;
}
-
+
return window;
}
Lisp_Object frame;
{
Lisp_Object window;
-
+
if (NILP (frame))
window = SELECTED_FRAME ()->selected_window;
else
{
if (NILP (frame))
frame = selected_frame;
-
+
CHECK_LIVE_FRAME (frame);
CHECK_LIVE_WINDOW (window);
error ("In `set-frame-selected-window', WINDOW is not on FRAME");
if (EQ (frame, selected_frame))
- return Fselect_window (window);
+ return Fselect_window (window, Qnil);
return XFRAME (frame)->selected_window = window;
}
{
if (NILP (frame))
frame = selected_frame;
-
+
CHECK_LIVE_FRAME (frame);
return next_frame (frame, miniframe);
}
Normally, you may not delete a frame if all other frames are invisible,
but if the second optional argument FORCE is non-nil, you may do so.
-This function runs `delete-frame-hook' before actually deleting the
-frame. The hook is called with one argument FRAME. */)
+This function runs `delete-frame-functions' before actually deleting the
+frame, unless the frame is a tooltip.
+The functions are run with one arg, the frame to be deleted. */)
(frame, force)
Lisp_Object frame, force;
{
return Qnil;
if (NILP (force) && !other_visible_frames (f)
-#ifdef macintosh
+#ifdef MAC_OS8
/* Terminal frame deleted before any other visible frames are
created. */
- && strcmp (XSTRING (f->name)->data, "F1") != 0
+ && strcmp (SDATA (f->name), "F1") != 0
#endif
)
error ("Attempt to delete the sole visible or iconified frame");
}
}
- /* Run `delete-frame-hook'. */
- if (!NILP (Vrun_hooks))
+ /* Run `delete-frame-functions' unless frame is a tooltip. */
+ if (!NILP (Vrun_hooks)
+ && NILP (Fframe_parameter (frame, intern ("tooltip"))))
{
Lisp_Object args[2];
- args[0] = intern ("delete-frame-hook");
+ args[0] = intern ("delete-frame-functions");
args[1] = frame;
Frun_hook_with_args (2, args);
}
if (EQ (f->minibuffer_window, minibuf_window))
{
Fset_window_buffer (sf->minibuffer_window,
- XWINDOW (minibuf_window)->buffer);
+ XWINDOW (minibuf_window)->buffer, Qnil);
minibuf_window = sf->minibuffer_window;
/* If the dying minibuffer window was selected,
select the new one. */
if (minibuffer_selected)
- Fselect_window (minibuf_window);
+ Fselect_window (minibuf_window, Qnil);
}
/* Don't let echo_area_window to remain on a deleted frame. */
x_clear_frame_selections (f);
#endif
- /* Free glyphs.
- This function must be called before the window tree of the
+ /* Free glyphs.
+ This function must be called before the window tree of the
frame is deleted because windows contain dynamically allocated
memory. */
free_glyphs (f);
{
struct frame *sf = XFRAME (selected_frame);
Fset_window_buffer (sf->minibuffer_window,
- XWINDOW (minibuf_window)->buffer);
+ XWINDOW (minibuf_window)->buffer, Qnil);
minibuf_window = sf->minibuffer_window;
}
{
if (NILP (frame))
frame = selected_frame;
-
+
CHECK_LIVE_FRAME (frame);
#if 0 /* This isn't logically necessary, and it can do GC. */
{
struct frame *sf = XFRAME (selected_frame);
Fset_window_buffer (sf->minibuffer_window,
- XWINDOW (minibuf_window)->buffer);
+ XWINDOW (minibuf_window)->buffer, Qnil);
minibuf_window = sf->minibuffer_window;
}
frame = selected_frame;
CHECK_LIVE_FRAME (frame);
-
+
if (frame_raise_lower_hook)
(*frame_raise_lower_hook) (XFRAME (frame), 0);
if (frame_rehighlight_hook)
(*frame_rehighlight_hook) (XFRAME (frame));
-
+
return Qnil;
}
}
}
-/* Move BUFFER to the end of the buffer-list of each frame. */
-
-void
-frames_bury_buffer (buffer)
- Lisp_Object buffer;
-{
- Lisp_Object frame, tail;
-
- FOR_EACH_FRAME (tail, frame)
- {
- struct frame *f = XFRAME (frame);
- Lisp_Object found;
-
- found = Fmemq (buffer, f->buffer_list);
- if (!NILP (found))
- f->buffer_list = nconc2 (Fdelq (buffer, f->buffer_list),
- Fcons (buffer, Qnil));
- }
-}
-
/* Modify the alist in *ALISTPTR to associate PROP with VAL.
If the alist already has an element for PROP, we change it. */
/* Check for no change needed in this very common case
before we do any consing. */
- if (frame_name_fnn_p (XSTRING (f->name)->data,
- STRING_BYTES (XSTRING (f->name))))
+ if (frame_name_fnn_p (SDATA (f->name),
+ SBYTES (f->name)))
return;
terminal_frame_count++;
/* Don't allow the user to set the frame name to F<num>, so it
doesn't clash with the names we generate for terminal frames. */
- if (frame_name_fnn_p (XSTRING (name)->data, STRING_BYTES (XSTRING (name))))
+ if (frame_name_fnn_p (SDATA (name), SBYTES (name)))
error ("Frame names of the form F<num> are usurped by Emacs");
}
/* Update some other special parameters in their special places
in addition to the alist. */
-
+
if (EQ (prop, Qbuffer_predicate))
f->buffer_predicate = val;
alist = Fcopy_alist (f->param_alist);
GCPRO1 (alist);
-
+
if (!FRAME_WINDOW_P (f))
{
int fg = FRAME_FOREGROUND_PIXEL (f);
elt = Fassq (Qforeground_color, alist);
if (!NILP (elt) && CONSP (elt) && STRINGP (XCDR (elt)))
{
- if (strncmp (XSTRING (XCDR (elt))->data,
+ if (strncmp (SDATA (XCDR (elt)),
unspecified_bg,
- XSTRING (XCDR (elt))->size) == 0)
+ SCHARS (XCDR (elt))) == 0)
store_in_alist (&alist, Qforeground_color, tty_color_name (f, bg));
- else if (strncmp (XSTRING (XCDR (elt))->data,
+ else if (strncmp (SDATA (XCDR (elt)),
unspecified_fg,
- XSTRING (XCDR (elt))->size) == 0)
+ SCHARS (XCDR (elt))) == 0)
store_in_alist (&alist, Qforeground_color, tty_color_name (f, fg));
}
else
elt = Fassq (Qbackground_color, alist);
if (!NILP (elt) && CONSP (elt) && STRINGP (XCDR (elt)))
{
- if (strncmp (XSTRING (XCDR (elt))->data,
+ if (strncmp (SDATA (XCDR (elt)),
unspecified_fg,
- XSTRING (XCDR (elt))->size) == 0)
+ SCHARS (XCDR (elt))) == 0)
store_in_alist (&alist, Qbackground_color, tty_color_name (f, fg));
- else if (strncmp (XSTRING (XCDR (elt))->data,
+ else if (strncmp (SDATA (XCDR (elt)),
unspecified_bg,
- XSTRING (XCDR (elt))->size) == 0)
+ SCHARS (XCDR (elt))) == 0)
store_in_alist (&alist, Qbackground_color, tty_color_name (f, bg));
}
else
:"tty"));
}
store_in_alist (&alist, Qname, f->name);
- height = (FRAME_NEW_HEIGHT (f) ? FRAME_NEW_HEIGHT (f) : FRAME_HEIGHT (f));
+ height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
store_in_alist (&alist, Qheight, make_number (height));
- width = (FRAME_NEW_WIDTH (f) ? FRAME_NEW_WIDTH (f) : FRAME_WIDTH (f));
+ width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
store_in_alist (&alist, Qwidth, make_number (width));
store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
store_in_alist (&alist, Qminibuffer,
else
CHECK_FRAME (frame);
CHECK_SYMBOL (parameter);
-
+
f = XFRAME (frame);
value = Qnil;
-
+
if (FRAME_LIVE_P (f))
{
/* Avoid consing in frequent cases. */
"unspecified". We need to do the same here. */
if (STRINGP (value) && !FRAME_WINDOW_P (f))
{
- char *color_name;
+ const char *color_name;
EMACS_INT csz;
if (EQ (parameter, Qbackground_color))
{
- color_name = XSTRING (value)->data;
- csz = XSTRING (value)->size;
+ color_name = SDATA (value);
+ csz = SCHARS (value);
if (strncmp (color_name, unspecified_bg, csz) == 0)
value = tty_color_name (f, FRAME_BACKGROUND_PIXEL (f));
else if (strncmp (color_name, unspecified_fg, csz) == 0)
}
else if (EQ (parameter, Qforeground_color))
{
- color_name = XSTRING (value)->data;
- csz = XSTRING (value)->size;
+ color_name = SDATA (value);
+ csz = SCHARS (value);
if (strncmp (color_name, unspecified_fg, csz) == 0)
value = tty_color_name (f, FRAME_FOREGROUND_PIXEL (f));
else if (strncmp (color_name, unspecified_bg, csz) == 0)
else
value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
}
-
+
return value;
}
-DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
+DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
Smodify_frame_parameters, 2, 2, 0,
doc: /* Modify the parameters of frame FRAME according to ALIST.
If FRAME is nil, it defaults to the selected frame.
{
FRAME_PTR f;
register Lisp_Object tail, prop, val;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
/* Bind this to t to inhibit initialization of the default face from
X resources in face-set-after-frame-default. If we don't inhibit
return make_number (1);
}
-DEFUN ("frame-pixel-height", Fframe_pixel_height,
+DEFUN ("frame-pixel-height", Fframe_pixel_height,
Sframe_pixel_height, 0, 1, 0,
doc: /* Return a FRAME's height in pixels.
This counts only the height available for text lines,
return make_number (x_pixel_height (f));
else
#endif
- return make_number (FRAME_HEIGHT (f));
+ return make_number (FRAME_LINES (f));
}
-DEFUN ("frame-pixel-width", Fframe_pixel_width,
+DEFUN ("frame-pixel-width", Fframe_pixel_width,
Sframe_pixel_width, 0, 1, 0,
doc: /* Return FRAME's width in pixels.
For a terminal frame, the result really gives the width in characters.
return make_number (x_pixel_width (f));
else
#endif
- return make_number (FRAME_WIDTH (f));
+ return make_number (FRAME_COLS (f));
}
\f
DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 3, 0,
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
{
- if (XINT (lines) != f->height)
- x_set_window_size (f, 1, f->width, XINT (lines));
+ if (XINT (lines) != FRAME_LINES (f))
+ x_set_window_size (f, 1, FRAME_COLS (f), XINT (lines));
do_pending_window_change (0);
}
else
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
{
- if (XINT (cols) != f->width)
- x_set_window_size (f, 1, XINT (cols), f->height);
+ if (XINT (cols) != FRAME_COLS (f))
+ x_set_window_size (f, 1, XINT (cols), FRAME_LINES (f));
do_pending_window_change (0);
}
else
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
{
- if (XINT (rows) != f->height || XINT (cols) != f->width
- || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
+ if (XINT (rows) != FRAME_LINES (f)
+ || XINT (cols) != FRAME_COLS (f)
+ || f->new_text_lines || f->new_text_cols)
x_set_window_size (f, 1, XINT (cols), XINT (rows));
do_pending_window_change (0);
}
return Qnil;
}
-DEFUN ("set-frame-position", Fset_frame_position,
+DEFUN ("set-frame-position", Fset_frame_position,
Sset_frame_position, 3, 3, 0,
doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET.
This is actually the position of the upper left corner of the frame.
}
\f
+/***********************************************************************
+ Frame Parameters
+ ***********************************************************************/
+
+/* Connect the frame-parameter names for X frames
+ to the ways of passing the parameter values to the window system.
+
+ The name of a parameter, as a Lisp symbol,
+ has an `x-frame-parameter' property which is an integer in Lisp
+ that is an index in this table. */
+
+struct frame_parm_table {
+ char *name;
+ Lisp_Object *variable;
+};
+
+static struct frame_parm_table frame_parms[] =
+{
+ {"auto-raise", &Qauto_raise},
+ {"auto-lower", &Qauto_lower},
+ {"background-color", 0},
+ {"border-color", &Qborder_color},
+ {"border-width", &Qborder_width},
+ {"cursor-color", &Qcursor_color},
+ {"cursor-type", &Qcursor_type},
+ {"font", 0},
+ {"foreground-color", 0},
+ {"icon-name", &Qicon_name},
+ {"icon-type", &Qicon_type},
+ {"internal-border-width", &Qinternal_border_width},
+ {"menu-bar-lines", &Qmenu_bar_lines},
+ {"mouse-color", &Qmouse_color},
+ {"name", &Qname},
+ {"scroll-bar-width", &Qscroll_bar_width},
+ {"title", &Qtitle},
+ {"unsplittable", &Qunsplittable},
+ {"vertical-scroll-bars", &Qvertical_scroll_bars},
+ {"visibility", &Qvisibility},
+ {"tool-bar-lines", &Qtool_bar_lines},
+ {"scroll-bar-foreground", &Qscroll_bar_foreground},
+ {"scroll-bar-background", &Qscroll_bar_background},
+ {"screen-gamma", &Qscreen_gamma},
+ {"line-spacing", &Qline_spacing},
+ {"left-fringe", &Qleft_fringe},
+ {"right-fringe", &Qright_fringe},
+ {"wait-for-wm", &Qwait_for_wm},
+ {"fullscreen", &Qfullscreen},
+};
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+extern Lisp_Object Qbox;
+extern Lisp_Object Qtop;
+
+/* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
+ wanted positions of the WM window (not emacs window).
+ Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
+ window (FRAME_X_WINDOW).
+ */
+
void
-syms_of_frame ()
+x_fullscreen_adjust (f, width, height, top_pos, left_pos)
+ struct frame *f;
+ int *width;
+ int *height;
+ int *top_pos;
+ int *left_pos;
{
- Qframep = intern ("framep");
- staticpro (&Qframep);
- Qframe_live_p = intern ("frame-live-p");
- staticpro (&Qframe_live_p);
- Qheight = intern ("height");
- staticpro (&Qheight);
- Qicon = intern ("icon");
- staticpro (&Qicon);
- Qminibuffer = intern ("minibuffer");
- staticpro (&Qminibuffer);
- Qmodeline = intern ("modeline");
- staticpro (&Qmodeline);
- Qname = intern ("name");
- staticpro (&Qname);
- Qonly = intern ("only");
- staticpro (&Qonly);
- Qunsplittable = intern ("unsplittable");
- staticpro (&Qunsplittable);
- Qmenu_bar_lines = intern ("menu-bar-lines");
- staticpro (&Qmenu_bar_lines);
- Qtool_bar_lines = intern ("tool-bar-lines");
- staticpro (&Qtool_bar_lines);
- Qwidth = intern ("width");
- staticpro (&Qwidth);
- Qx = intern ("x");
- staticpro (&Qx);
- Qw32 = intern ("w32");
- staticpro (&Qw32);
- Qpc = intern ("pc");
- staticpro (&Qpc);
- Qmac = intern ("mac");
- staticpro (&Qmac);
- Qvisible = intern ("visible");
- staticpro (&Qvisible);
- Qbuffer_predicate = intern ("buffer-predicate");
- staticpro (&Qbuffer_predicate);
- Qbuffer_list = intern ("buffer-list");
- staticpro (&Qbuffer_list);
- Qtitle = intern ("title");
- staticpro (&Qtitle);
- Qdisplay_type = intern ("display-type");
- staticpro (&Qdisplay_type);
- Qbackground_mode = intern ("background-mode");
- staticpro (&Qbackground_mode);
- Qleft_fringe = intern ("left-fringe");
- staticpro (&Qleft_fringe);
- Qright_fringe = intern ("right-fringe");
- staticpro (&Qright_fringe);
- Qtty_color_mode = intern ("tty-color-mode");
- staticpro (&Qtty_color_mode);
+ int newwidth = FRAME_COLS (f);
+ int newheight = FRAME_LINES (f);
- DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist,
- doc: /* Alist of default values for frame creation.
-These may be set in your init file, like this:
- (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1))
-These override values given in window system configuration data,
- including X Windows' defaults database.
-For values specific to the first Emacs frame, see `initial-frame-alist'.
-For values specific to the separate minibuffer frame, see
- `minibuffer-frame-alist'.
-The `menu-bar-lines' element of the list controls whether new frames
- have menu bars; `menu-bar-mode' works by altering this element. */);
- Vdefault_frame_alist = Qnil;
+ *top_pos = f->top_pos;
+ *left_pos = f->left_pos;
- Qinhibit_default_face_x_resources
- = intern ("inhibit-default-face-x-resources");
- staticpro (&Qinhibit_default_face_x_resources);
+ if (f->want_fullscreen & FULLSCREEN_HEIGHT)
+ {
+ int ph;
- DEFVAR_LISP ("terminal-frame", &Vterminal_frame,
- doc: /* The initial frame-object, which represents Emacs's stdout. */);
+ ph = FRAME_X_DISPLAY_INFO (f)->height;
+ newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
+ ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
+ newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
+ *top_pos = 0;
+ }
- DEFVAR_LISP ("emacs-iconified", &Vemacs_iconified,
- doc: /* Non-nil if all of emacs is iconified and frame updates are not needed. */);
- Vemacs_iconified = Qnil;
+ if (f->want_fullscreen & FULLSCREEN_WIDTH)
+ {
+ int pw;
- DEFVAR_LISP ("mouse-position-function", &Vmouse_position_function,
- doc: /* If non-nil, function to transform normal value of `mouse-position'.
-`mouse-position' calls this function, passing its usual return value as
-argument, and returns whatever this function returns.
-This abnormal hook exists for the benefit of packages like `xt-mouse.el'
-which need to do mouse handling at the Lisp level. */);
- Vmouse_position_function = Qnil;
+ pw = FRAME_X_DISPLAY_INFO (f)->width;
+ newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
+ pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
+ newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
+ *left_pos = 0;
+ }
- DEFVAR_LISP ("mouse-highlight", &Vmouse_highlight,
- doc: /* If non-nil, clickable text is highlighted when mouse is over it.
-If the value is an integer, highlighting is only shown after moving the
-mouse, while keyboard input turns off the highlight even when the mouse
-is over the clickable text. However, the mouse shape still indicates
-when the mouse is over clickable text. */);
- Vmouse_highlight = Qt;
+ *width = newwidth;
+ *height = newheight;
+}
- DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
- doc: /* Minibufferless frames use this frame's minibuffer.
-Emacs cannot create minibufferless frames unless this is set to an
-appropriate surrogate.
+/* Really try to move where we want to be in case of fullscreen. Some WMs
+ moves the window where we tell them. Some (mwm, twm) moves the outer
+ window manager window there instead.
+ Try to compensate for those WM here. */
-Emacs consults this variable only when creating minibufferless
-frames; once the frame is created, it sticks with its assigned
-minibuffer, no matter what this variable is set to. This means that
-this variable doesn't necessarily say anything meaningful about the
-current set of frames, or where the minibuffer is currently being
-displayed.
+static void
+x_fullscreen_move (f, new_top, new_left)
+ struct frame *f;
+ int new_top;
+ int new_left;
+{
+ if (new_top != f->top_pos || new_left != f->left_pos)
+ {
+ int move_x = new_left;
+ int move_y = new_top;
-This variable is local to the current terminal and cannot be buffer-local. */);
+#ifdef HAVE_X_WINDOWS
+ move_x += FRAME_X_OUTPUT (f)->x_pixels_outer_diff;
+ move_y += FRAME_X_OUTPUT (f)->y_pixels_outer_diff;
+#endif
- staticpro (&Vframe_list);
+ f->want_fullscreen |= FULLSCREEN_MOVE_WAIT;
+ x_set_offset (f, move_x, move_y, 1);
+ }
+}
- defsubr (&Sactive_minibuffer_window);
- defsubr (&Sframep);
- defsubr (&Sframe_live_p);
- defsubr (&Smake_terminal_frame);
- defsubr (&Shandle_switch_frame);
- defsubr (&Signore_event);
- defsubr (&Sselect_frame);
- defsubr (&Sselected_frame);
- defsubr (&Swindow_frame);
- defsubr (&Sframe_root_window);
- defsubr (&Sframe_first_window);
- defsubr (&Sframe_selected_window);
- defsubr (&Sset_frame_selected_window);
- defsubr (&Sframe_list);
- defsubr (&Snext_frame);
- defsubr (&Sprevious_frame);
- defsubr (&Sdelete_frame);
- defsubr (&Smouse_position);
- defsubr (&Smouse_pixel_position);
- defsubr (&Sset_mouse_position);
- defsubr (&Sset_mouse_pixel_position);
-#if 0
- defsubr (&Sframe_configuration);
- defsubr (&Srestore_frame_configuration);
+/* Change the parameters of frame F as specified by ALIST.
+ If a parameter is not specially recognized, do nothing special;
+ otherwise call the `x_set_...' function for that parameter.
+ Except for certain geometry properties, always call store_frame_param
+ to store the new value in the parameter alist. */
+
+void
+x_set_frame_parameters (f, alist)
+ FRAME_PTR f;
+ Lisp_Object alist;
+{
+ Lisp_Object tail;
+
+ /* If both of these parameters are present, it's more efficient to
+ set them both at once. So we wait until we've looked at the
+ entire list before we set them. */
+ int width, height;
+
+ /* Same here. */
+ Lisp_Object left, top;
+
+ /* Same with these. */
+ Lisp_Object icon_left, icon_top;
+
+ /* Record in these vectors all the parms specified. */
+ Lisp_Object *parms;
+ Lisp_Object *values;
+ int i, p;
+ int left_no_change = 0, top_no_change = 0;
+ int icon_left_no_change = 0, icon_top_no_change = 0;
+ int fullscreen_is_being_set = 0;
+
+ struct gcpro gcpro1, gcpro2;
+
+ i = 0;
+ for (tail = alist; CONSP (tail); tail = Fcdr (tail))
+ i++;
+
+ parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
+ values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
+
+ /* Extract parm names and values into those vectors. */
+
+ i = 0;
+ for (tail = alist; CONSP (tail); tail = Fcdr (tail))
+ {
+ Lisp_Object elt;
+
+ elt = Fcar (tail);
+ parms[i] = Fcar (elt);
+ values[i] = Fcdr (elt);
+ i++;
+ }
+ /* TAIL and ALIST are not used again below here. */
+ alist = tail = Qnil;
+
+ GCPRO2 (*parms, *values);
+ gcpro1.nvars = i;
+ gcpro2.nvars = i;
+
+ /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
+ because their values appear in VALUES and strings are not valid. */
+ top = left = Qunbound;
+ icon_left = icon_top = Qunbound;
+
+ /* Provide default values for HEIGHT and WIDTH. */
+ width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f));
+ height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f));
+
+ /* Process foreground_color and background_color before anything else.
+ They are independent of other properties, but other properties (e.g.,
+ cursor_color) are dependent upon them. */
+ /* Process default font as well, since fringe widths depends on it. */
+ /* Also, process fullscreen, width and height depend upon that */
+ for (p = 0; p < i; p++)
+ {
+ Lisp_Object prop, val;
+
+ prop = parms[p];
+ val = values[p];
+ if (EQ (prop, Qforeground_color)
+ || EQ (prop, Qbackground_color)
+ || EQ (prop, Qfont)
+ || EQ (prop, Qfullscreen))
+ {
+ register Lisp_Object param_index, old_value;
+
+ old_value = get_frame_param (f, prop);
+ fullscreen_is_being_set |= EQ (prop, Qfullscreen);
+
+ if (NILP (Fequal (val, old_value)))
+ {
+ store_frame_param (f, prop, val);
+
+ param_index = Fget (prop, Qx_frame_parameter);
+ if (NATNUMP (param_index)
+ && (XFASTINT (param_index)
+ < sizeof (frame_parms)/sizeof (frame_parms[0]))
+ && rif->frame_parm_handlers[XINT (param_index)])
+ (*(rif->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
+ }
+ }
+ }
+
+ /* Now process them in reverse of specified order. */
+ for (i--; i >= 0; i--)
+ {
+ Lisp_Object prop, val;
+
+ prop = parms[i];
+ val = values[i];
+
+ if (EQ (prop, Qwidth) && NUMBERP (val))
+ width = XFASTINT (val);
+ else if (EQ (prop, Qheight) && NUMBERP (val))
+ height = XFASTINT (val);
+ else if (EQ (prop, Qtop))
+ top = val;
+ else if (EQ (prop, Qleft))
+ left = val;
+ else if (EQ (prop, Qicon_top))
+ icon_top = val;
+ else if (EQ (prop, Qicon_left))
+ icon_left = val;
+ else if (EQ (prop, Qforeground_color)
+ || EQ (prop, Qbackground_color)
+ || EQ (prop, Qfont)
+ || EQ (prop, Qfullscreen))
+ /* Processed above. */
+ continue;
+ else
+ {
+ register Lisp_Object param_index, old_value;
+
+ old_value = get_frame_param (f, prop);
+
+ store_frame_param (f, prop, val);
+
+ param_index = Fget (prop, Qx_frame_parameter);
+ if (NATNUMP (param_index)
+ && (XFASTINT (param_index)
+ < sizeof (frame_parms)/sizeof (frame_parms[0]))
+ && rif->frame_parm_handlers[XINT (param_index)])
+ (*(rif->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
+ }
+ }
+
+ /* Don't die if just one of these was set. */
+ if (EQ (left, Qunbound))
+ {
+ left_no_change = 1;
+ if (f->left_pos < 0)
+ left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
+ else
+ XSETINT (left, f->left_pos);
+ }
+ if (EQ (top, Qunbound))
+ {
+ top_no_change = 1;
+ if (f->top_pos < 0)
+ top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
+ else
+ XSETINT (top, f->top_pos);
+ }
+
+ /* If one of the icon positions was not set, preserve or default it. */
+ if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
+ {
+ icon_left_no_change = 1;
+ icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
+ if (NILP (icon_left))
+ XSETINT (icon_left, 0);
+ }
+ if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
+ {
+ icon_top_no_change = 1;
+ icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
+ if (NILP (icon_top))
+ XSETINT (icon_top, 0);
+ }
+
+#ifndef HAVE_CARBON
+ /* MAC_TODO: fullscreen */
+ if (FRAME_VISIBLE_P (f) && fullscreen_is_being_set)
+ {
+ /* If the frame is visible already and the fullscreen parameter is
+ being set, it is too late to set WM manager hints to specify
+ size and position.
+ Here we first get the width, height and position that applies to
+ fullscreen. We then move the frame to the appropriate
+ position. Resize of the frame is taken care of in the code after
+ this if-statement. */
+ int new_left, new_top;
+
+ x_fullscreen_adjust (f, &width, &height, &new_top, &new_left);
+ x_fullscreen_move (f, new_top, new_left);
+ }
#endif
- defsubr (&Smake_frame_visible);
- defsubr (&Smake_frame_invisible);
- defsubr (&Siconify_frame);
- defsubr (&Sframe_visible_p);
- defsubr (&Svisible_frame_list);
- defsubr (&Sraise_frame);
- defsubr (&Slower_frame);
- defsubr (&Sredirect_frame_focus);
- defsubr (&Sframe_focus);
- defsubr (&Sframe_parameters);
- defsubr (&Sframe_parameter);
- defsubr (&Smodify_frame_parameters);
- defsubr (&Sframe_char_height);
- defsubr (&Sframe_char_width);
- defsubr (&Sframe_pixel_height);
- defsubr (&Sframe_pixel_width);
- defsubr (&Sset_frame_height);
- defsubr (&Sset_frame_width);
- defsubr (&Sset_frame_size);
- defsubr (&Sset_frame_position);
+
+ /* Don't set these parameters unless they've been explicitly
+ specified. The window might be mapped or resized while we're in
+ this function, and we don't want to override that unless the lisp
+ code has asked for it.
+
+ Don't set these parameters unless they actually differ from the
+ window's current parameters; the window may not actually exist
+ yet. */
+ {
+ Lisp_Object frame;
+
+ check_frame_size (f, &height, &width);
+
+ XSETFRAME (frame, f);
+
+ if (width != FRAME_COLS (f)
+ || height != FRAME_LINES (f)
+ || f->new_text_lines || f->new_text_cols)
+ Fset_frame_size (frame, make_number (width), make_number (height));
+
+ if ((!NILP (left) || !NILP (top))
+ && ! (left_no_change && top_no_change)
+ && ! (NUMBERP (left) && XINT (left) == f->left_pos
+ && NUMBERP (top) && XINT (top) == f->top_pos))
+ {
+ int leftpos = 0;
+ int toppos = 0;
+
+ /* Record the signs. */
+ f->size_hint_flags &= ~ (XNegative | YNegative);
+ if (EQ (left, Qminus))
+ f->size_hint_flags |= XNegative;
+ else if (INTEGERP (left))
+ {
+ leftpos = XINT (left);
+ if (leftpos < 0)
+ f->size_hint_flags |= XNegative;
+ }
+ else if (CONSP (left) && EQ (XCAR (left), Qminus)
+ && CONSP (XCDR (left))
+ && INTEGERP (XCAR (XCDR (left))))
+ {
+ leftpos = - XINT (XCAR (XCDR (left)));
+ f->size_hint_flags |= XNegative;
+ }
+ else if (CONSP (left) && EQ (XCAR (left), Qplus)
+ && CONSP (XCDR (left))
+ && INTEGERP (XCAR (XCDR (left))))
+ {
+ leftpos = XINT (XCAR (XCDR (left)));
+ }
+
+ if (EQ (top, Qminus))
+ f->size_hint_flags |= YNegative;
+ else if (INTEGERP (top))
+ {
+ toppos = XINT (top);
+ if (toppos < 0)
+ f->size_hint_flags |= YNegative;
+ }
+ else if (CONSP (top) && EQ (XCAR (top), Qminus)
+ && CONSP (XCDR (top))
+ && INTEGERP (XCAR (XCDR (top))))
+ {
+ toppos = - XINT (XCAR (XCDR (top)));
+ f->size_hint_flags |= YNegative;
+ }
+ else if (CONSP (top) && EQ (XCAR (top), Qplus)
+ && CONSP (XCDR (top))
+ && INTEGERP (XCAR (XCDR (top))))
+ {
+ toppos = XINT (XCAR (XCDR (top)));
+ }
+
+
+ /* Store the numeric value of the position. */
+ f->top_pos = toppos;
+ f->left_pos = leftpos;
+
+ f->win_gravity = NorthWestGravity;
+
+ /* Actually set that position, and convert to absolute. */
+ x_set_offset (f, leftpos, toppos, -1);
+ }
+
+ if ((!NILP (icon_left) || !NILP (icon_top))
+ && ! (icon_left_no_change && icon_top_no_change))
+ x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
+ }
+
+ UNGCPRO;
+}
+
+
+/* Insert a description of internally-recorded parameters of frame X
+ into the parameter alist *ALISTPTR that is to be given to the user.
+ Only parameters that are specific to the X window system
+ and whose values are not correctly recorded in the frame's
+ param_alist need to be considered here. */
+
+void
+x_report_frame_params (f, alistptr)
+ struct frame *f;
+ Lisp_Object *alistptr;
+{
+ char buf[16];
+ Lisp_Object tem;
+
+ /* Represent negative positions (off the top or left screen edge)
+ in a way that Fmodify_frame_parameters will understand correctly. */
+ XSETINT (tem, f->left_pos);
+ if (f->left_pos >= 0)
+ store_in_alist (alistptr, Qleft, tem);
+ else
+ store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
+
+ XSETINT (tem, f->top_pos);
+ if (f->top_pos >= 0)
+ store_in_alist (alistptr, Qtop, tem);
+ else
+ store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
+
+ store_in_alist (alistptr, Qborder_width,
+ make_number (f->border_width));
+ store_in_alist (alistptr, Qinternal_border_width,
+ make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
+ store_in_alist (alistptr, Qleft_fringe,
+ make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
+ store_in_alist (alistptr, Qright_fringe,
+ make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
+ store_in_alist (alistptr, Qscroll_bar_width,
+ (! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
+ ? make_number (0)
+ : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
+ ? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
+ /* nil means "use default width"
+ for non-toolkit scroll bar.
+ ruler-mode.el depends on this. */
+ : Qnil));
+ sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
+ store_in_alist (alistptr, Qwindow_id,
+ build_string (buf));
+#ifdef HAVE_X_WINDOWS
+#ifdef USE_X_TOOLKIT
+ /* Tooltip frame may not have this widget. */
+ if (FRAME_X_OUTPUT (f)->widget)
+#endif
+ sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
+ store_in_alist (alistptr, Qouter_window_id,
+ build_string (buf));
+#endif
+ store_in_alist (alistptr, Qicon_name, f->icon_name);
+ FRAME_SAMPLE_VISIBILITY (f);
+ store_in_alist (alistptr, Qvisibility,
+ (FRAME_VISIBLE_P (f) ? Qt
+ : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
+ store_in_alist (alistptr, Qdisplay,
+ XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
+
+#ifndef HAVE_CARBON
+/* A Mac Window is identified by a struct, not an integer. */
+ if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
+ tem = Qnil;
+ else
+ XSETFASTINT (tem, FRAME_X_OUTPUT (f)->parent_desc);
+ store_in_alist (alistptr, Qparent_id, tem);
+#endif
+}
+
+
+/* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
+ the previous value of that parameter, NEW_VALUE is the new value. */
+
+void
+x_set_fullscreen (f, new_value, old_value)
+ struct frame *f;
+ Lisp_Object new_value, old_value;
+{
+#ifndef HAVE_CARBON
+ if (NILP (new_value))
+ f->want_fullscreen = FULLSCREEN_NONE;
+ else if (EQ (new_value, Qfullboth))
+ f->want_fullscreen = FULLSCREEN_BOTH;
+ else if (EQ (new_value, Qfullwidth))
+ f->want_fullscreen = FULLSCREEN_WIDTH;
+ else if (EQ (new_value, Qfullheight))
+ f->want_fullscreen = FULLSCREEN_HEIGHT;
+#endif
+}
+
+
+/* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
+ the previous value of that parameter, NEW_VALUE is the new value. */
+
+void
+x_set_line_spacing (f, new_value, old_value)
+ struct frame *f;
+ Lisp_Object new_value, old_value;
+{
+ if (NILP (new_value))
+ f->extra_line_spacing = 0;
+ else if (NATNUMP (new_value))
+ f->extra_line_spacing = XFASTINT (new_value);
+ else
+ Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"),
+ Fcons (new_value, Qnil)));
+ if (FRAME_VISIBLE_P (f))
+ redraw_frame (f);
+}
+
+
+/* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
+ the previous value of that parameter, NEW_VALUE is the new value. */
+
+void
+x_set_screen_gamma (f, new_value, old_value)
+ struct frame *f;
+ Lisp_Object new_value, old_value;
+{
+ if (NILP (new_value))
+ f->gamma = 0;
+ else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
+ /* The value 0.4545 is the normal viewing gamma. */
+ f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
+ else
+ Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"),
+ Fcons (new_value, Qnil)));
+
+ clear_face_cache (0);
+}
+
+
+void
+x_set_font (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ Lisp_Object result;
+ Lisp_Object fontset_name;
+ Lisp_Object frame;
+ int old_fontset = FRAME_FONTSET(f);
+
+ 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;
+
+ 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))
+ {
+ if (STRINGP (fontset_name))
+ {
+ /* Fontset names are built from ASCII font names, so the
+ names may be equal despite there was a change. */
+ 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;
+
- store_frame_param (f, Qfont, result);
+ recompute_basic_faces (f);
+ }
+ else
+ abort ();
+
+ do_pending_window_change (0);
+
+ /* Don't call `face-set-after-frame-default' when faces haven't been
+ initialized yet. This is the case when called from
+ Fx_create_frame. In that case, the X widget or window doesn't
+ exist either, and we can end up in x_report_frame_params with a
+ null widget which gives a segfault. */
+ if (FRAME_FACE_CACHE (f))
+ {
+ XSETFRAME (frame, f);
+ call1 (Qface_set_after_frame_default, frame);
+ }
+}
+
+
+void
+x_set_fringe_width (f, new_value, old_value)
+ struct frame *f;
+ Lisp_Object new_value, old_value;
+{
+ compute_fringe_widths (f, 1);
+}
+
+void
+x_set_border_width (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ CHECK_NUMBER (arg);
+
+ if (XINT (arg) == f->border_width)
+ return;
+
+#ifndef HAVE_CARBON
+ if (FRAME_X_WINDOW (f) != 0)
+ error ("Cannot change the border width of a window");
+#endif /* MAC_TODO */
+
+ f->border_width = XINT (arg);
+}
+
+void
+x_set_internal_border_width (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ int old = FRAME_INTERNAL_BORDER_WIDTH (f);
+
+ CHECK_NUMBER (arg);
+ FRAME_INTERNAL_BORDER_WIDTH (f) = XINT (arg);
+ if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0)
+ FRAME_INTERNAL_BORDER_WIDTH (f) = 0;
+
+#ifdef USE_X_TOOLKIT
+ if (FRAME_X_OUTPUT (f)->edit_widget)
+ widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
+#endif
+
+ if (FRAME_INTERNAL_BORDER_WIDTH (f) == old)
+ return;
+
+ if (FRAME_X_WINDOW (f) != 0)
+ {
+ x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
+ SET_FRAME_GARBAGED (f);
+ do_pending_window_change (0);
+ }
+ else
+ SET_FRAME_GARBAGED (f);
+}
+
+void
+x_set_visibility (f, value, oldval)
+ struct frame *f;
+ Lisp_Object value, oldval;
+{
+ Lisp_Object frame;
+ XSETFRAME (frame, f);
+
+ if (NILP (value))
+ Fmake_frame_invisible (frame, Qt);
+ else if (EQ (value, Qicon))
+ Ficonify_frame (frame);
+ else
+ Fmake_frame_visible (frame);
+}
+
+void
+x_set_autoraise (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ f->auto_raise = !EQ (Qnil, arg);
+}
+
+void
+x_set_autolower (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ f->auto_lower = !EQ (Qnil, arg);
+}
+
+void
+x_set_unsplittable (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ f->no_split = !NILP (arg);
+}
+
+void
+x_set_vertical_scroll_bars (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
+ || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
+ || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
+ || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
+ {
+ FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
+ = (NILP (arg)
+ ? vertical_scroll_bar_none
+ : EQ (Qleft, arg)
+ ? vertical_scroll_bar_left
+ : EQ (Qright, arg)
+ ? vertical_scroll_bar_right
+#ifdef HAVE_NTGUI
+ /* MS-Windows has scroll bars on the right by default. */
+ : vertical_scroll_bar_right
+#else
+ : vertical_scroll_bar_left
+#endif
+ );
+
+ /* We set this parameter before creating the X window for the
+ frame, so we can get the geometry right from the start.
+ However, if the window hasn't been created yet, we shouldn't
+ call x_set_window_size. */
+ if (FRAME_X_WINDOW (f))
+ x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
+ do_pending_window_change (0);
+ }
+}
+
+void
+x_set_scroll_bar_width (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ int wid = FRAME_COLUMN_WIDTH (f);
+
+ if (NILP (arg))
+ {
+ x_set_scroll_bar_default_width (f);
+
+ if (FRAME_X_WINDOW (f))
+ x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
+ do_pending_window_change (0);
+ }
+ else if (INTEGERP (arg) && XINT (arg) > 0
+ && XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
+ {
+ if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
+ XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
+
+ FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
+ FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
+ if (FRAME_X_WINDOW (f))
+ x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
+ do_pending_window_change (0);
+ }
+
+ change_frame_size (f, 0, FRAME_COLS (f), 0, 0, 0);
+ XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
+ XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
+}
+
+
+
+/* Return non-nil if frame F wants a bitmap icon. */
+
+Lisp_Object
+x_icon_type (f)
+ FRAME_PTR f;
+{
+ Lisp_Object tem;
+
+ tem = assq_no_quit (Qicon_type, f->param_alist);
+ if (CONSP (tem))
+ return XCDR (tem);
+ else
+ return Qnil;
+}
+
+\f
+/* Subroutines of creating an X frame. */
+
+/* Make sure that Vx_resource_name is set to a reasonable value.
+ Fix it up, or set it to `emacs' if it is too hopeless. */
+
+void
+validate_x_resource_name ()
+{
+ int len = 0;
+ /* Number of valid characters in the resource name. */
+ int good_count = 0;
+ /* Number of invalid characters in the resource name. */
+ int bad_count = 0;
+ Lisp_Object new;
+ int i;
+
+ if (!STRINGP (Vx_resource_class))
+ Vx_resource_class = build_string (EMACS_CLASS);
+
+ if (STRINGP (Vx_resource_name))
+ {
+ unsigned char *p = SDATA (Vx_resource_name);
+ int i;
+
+ len = SBYTES (Vx_resource_name);
+
+ /* Only letters, digits, - and _ are valid in resource names.
+ Count the valid characters and count the invalid ones. */
+ for (i = 0; i < len; i++)
+ {
+ int c = p[i];
+ if (! ((c >= 'a' && c <= 'z')
+ || (c >= 'A' && c <= 'Z')
+ || (c >= '0' && c <= '9')
+ || c == '-' || c == '_'))
+ bad_count++;
+ else
+ good_count++;
+ }
+ }
+ else
+ /* Not a string => completely invalid. */
+ bad_count = 5, good_count = 0;
+
+ /* If name is valid already, return. */
+ if (bad_count == 0)
+ return;
+
+ /* If name is entirely invalid, or nearly so, use `emacs'. */
+ if (good_count == 0
+ || (good_count == 1 && bad_count > 0))
+ {
+ Vx_resource_name = build_string ("emacs");
+ return;
+ }
+
+ /* Name is partly valid. Copy it and replace the invalid characters
+ with underscores. */
+
+ Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
+
+ for (i = 0; i < len; i++)
+ {
+ int c = SREF (new, i);
+ if (! ((c >= 'a' && c <= 'z')
+ || (c >= 'A' && c <= 'Z')
+ || (c >= '0' && c <= '9')
+ || c == '-' || c == '_'))
+ SSET (new, i, '_');
+ }
+}
+
+
+extern char *x_get_string_resource P_ ((XrmDatabase, char *, char *));
+extern Display_Info *check_x_display_info P_ ((Lisp_Object));
+
+
+/* Get specified attribute from resource database RDB.
+ See Fx_get_resource below for other parameters. */
+
+static Lisp_Object
+xrdb_get_resource (rdb, attribute, class, component, subclass)
+ XrmDatabase rdb;
+ Lisp_Object attribute, class, component, subclass;
+{
+ register char *value;
+ char *name_key;
+ char *class_key;
+
+ CHECK_STRING (attribute);
+ CHECK_STRING (class);
+
+ if (!NILP (component))
+ CHECK_STRING (component);
+ if (!NILP (subclass))
+ CHECK_STRING (subclass);
+ if (NILP (component) != NILP (subclass))
+ error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
+
+ validate_x_resource_name ();
+
+ /* Allocate space for the components, the dots which separate them,
+ and the final '\0'. Make them big enough for the worst case. */
+ name_key = (char *) alloca (SBYTES (Vx_resource_name)
+ + (STRINGP (component)
+ ? SBYTES (component) : 0)
+ + SBYTES (attribute)
+ + 3);
+
+ class_key = (char *) alloca (SBYTES (Vx_resource_class)
+ + SBYTES (class)
+ + (STRINGP (subclass)
+ ? SBYTES (subclass) : 0)
+ + 3);
+
+ /* Start with emacs.FRAMENAME for the name (the specific one)
+ and with `Emacs' for the class key (the general one). */
+ strcpy (name_key, SDATA (Vx_resource_name));
+ strcpy (class_key, SDATA (Vx_resource_class));
+
+ strcat (class_key, ".");
+ strcat (class_key, SDATA (class));
+
+ if (!NILP (component))
+ {
+ strcat (class_key, ".");
+ strcat (class_key, SDATA (subclass));
+
+ strcat (name_key, ".");
+ strcat (name_key, SDATA (component));
+ }
+
+ strcat (name_key, ".");
+ strcat (name_key, SDATA (attribute));
+
+ value = x_get_string_resource (rdb, name_key, class_key);
+
+ if (value != (char *) 0)
+ return build_string (value);
+ else
+ return Qnil;
+}
+
+
+DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
+ doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
+This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
+class, where INSTANCE is the name under which Emacs was invoked, or
+the name specified by the `-name' or `-rn' command-line arguments.
+
+The optional arguments COMPONENT and SUBCLASS add to the key and the
+class, respectively. You must specify both of them or neither.
+If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
+and the class is `Emacs.CLASS.SUBCLASS'. */)
+ (attribute, class, component, subclass)
+ Lisp_Object attribute, class, component, subclass;
+{
+#ifdef HAVE_X_WINDOWS
+ check_x ();
+#endif
+
+ return xrdb_get_resource (check_x_display_info (Qnil)->xrdb,
+ attribute, class, component, subclass);
+}
+
+/* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
+
+Lisp_Object
+display_x_get_resource (dpyinfo, attribute, class, component, subclass)
+ Display_Info *dpyinfo;
+ Lisp_Object attribute, class, component, subclass;
+{
+ return xrdb_get_resource (dpyinfo->xrdb,
+ attribute, class, component, subclass);
+}
+
+/* Used when C code wants a resource value. */
+
+char *
+x_get_resource_string (attribute, class)
+ char *attribute, *class;
+{
+ char *name_key;
+ char *class_key;
+ struct frame *sf = SELECTED_FRAME ();
+
+ /* Allocate space for the components, the dots which separate them,
+ and the final '\0'. */
+ name_key = (char *) alloca (SBYTES (Vinvocation_name)
+ + strlen (attribute) + 2);
+ class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
+ + strlen (class) + 2);
+
+ sprintf (name_key, "%s.%s", SDATA (Vinvocation_name), attribute);
+ sprintf (class_key, "%s.%s", EMACS_CLASS, class);
+
+ return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
+ name_key, class_key);
+}
+
+
+/* Return the value of parameter PARAM.
+
+ First search ALIST, then Vdefault_frame_alist, then the X defaults
+ database, using ATTRIBUTE as the attribute name and CLASS as its class.
+
+ Convert the resource to the type specified by desired_type.
+
+ If no default is specified, return Qunbound. If you call
+ x_get_arg, make sure you deal with Qunbound in a reasonable way,
+ and don't let it get stored in any Lisp-visible variables! */
+
+Lisp_Object
+x_get_arg (dpyinfo, alist, param, attribute, class, type)
+ Display_Info *dpyinfo;
+ Lisp_Object alist, param;
+ char *attribute;
+ char *class;
+ enum resource_types type;
+{
+ register Lisp_Object tem;
+
+ tem = Fassq (param, alist);
+ if (EQ (tem, Qnil))
+ tem = Fassq (param, Vdefault_frame_alist);
+ if (EQ (tem, Qnil))
+ {
+ if (attribute)
+ {
+ tem = display_x_get_resource (dpyinfo,
+ build_string (attribute),
+ build_string (class),
+ Qnil, Qnil);
+
+ if (NILP (tem))
+ return Qunbound;
+
+ switch (type)
+ {
+ case RES_TYPE_NUMBER:
+ return make_number (atoi (SDATA (tem)));
+
+ case RES_TYPE_FLOAT:
+ return make_float (atof (SDATA (tem)));
+
+ case RES_TYPE_BOOLEAN:
+ tem = Fdowncase (tem);
+ if (!strcmp (SDATA (tem), "on")
+ || !strcmp (SDATA (tem), "true"))
+ return Qt;
+ else
+ return Qnil;
+
+ case RES_TYPE_STRING:
+ return tem;
+
+ case RES_TYPE_SYMBOL:
+ /* As a special case, we map the values `true' and `on'
+ to Qt, and `false' and `off' to Qnil. */
+ {
+ Lisp_Object lower;
+ lower = Fdowncase (tem);
+ if (!strcmp (SDATA (lower), "on")
+ || !strcmp (SDATA (lower), "true"))
+ return Qt;
+ else if (!strcmp (SDATA (lower), "off")
+ || !strcmp (SDATA (lower), "false"))
+ return Qnil;
+ else
+ return Fintern (tem, Qnil);
+ }
+
+ default:
+ abort ();
+ }
+ }
+ else
+ return Qunbound;
+ }
+ return Fcdr (tem);
+}
+
+Lisp_Object
+x_frame_get_arg (f, alist, param, attribute, class, type)
+ struct frame *f;
+ Lisp_Object alist, param;
+ char *attribute;
+ char *class;
+ enum resource_types type;
+{
+ return x_get_arg (FRAME_X_DISPLAY_INFO (f),
+ alist, param, attribute, class, type);
+}
+
+/* Like x_frame_get_arg, but also record the value in f->param_alist. */
+
+Lisp_Object
+x_frame_get_and_record_arg (f, alist, param, attribute, class, type)
+ struct frame *f;
+ Lisp_Object alist, param;
+ char *attribute;
+ char *class;
+ enum resource_types type;
+{
+ Lisp_Object value;
+
+ value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
+ attribute, class, type);
+ if (! NILP (value))
+ store_frame_param (f, param, value);
+
+ return value;
+}
+
+
+/* Record in frame F the specified or default value according to ALIST
+ of the parameter named PROP (a Lisp symbol).
+ If no value is specified for PROP, look for an X default for XPROP
+ on the frame named NAME.
+ If that is not found either, use the value DEFLT. */
+
+Lisp_Object
+x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
+ struct frame *f;
+ Lisp_Object alist;
+ Lisp_Object prop;
+ Lisp_Object deflt;
+ char *xprop;
+ char *xclass;
+ enum resource_types type;
+{
+ Lisp_Object tem;
+
+ tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
+ if (EQ (tem, Qunbound))
+ tem = deflt;
+ x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
+ return tem;
+}
+
+
+
+\f
+DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
+ doc: /* Parse an X-style geometry string STRING.
+Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
+The properties returned may include `top', `left', `height', and `width'.
+The value of `left' or `top' may be an integer,
+or a list (+ N) meaning N pixels relative to top/left corner,
+or a list (- N) meaning -N pixels relative to bottom/right corner. */)
+ (string)
+ Lisp_Object string;
+{
+ int geometry, x, y;
+ unsigned int width, height;
+ Lisp_Object result;
+
+ CHECK_STRING (string);
+
+ geometry = XParseGeometry ((char *) SDATA (string),
+ &x, &y, &width, &height);
+
+#if 0
+ if (!!(geometry & XValue) != !!(geometry & YValue))
+ error ("Must specify both x and y position, or neither");
+#endif
+
+ result = Qnil;
+ if (geometry & XValue)
+ {
+ Lisp_Object element;
+
+ if (x >= 0 && (geometry & XNegative))
+ element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
+ else if (x < 0 && ! (geometry & XNegative))
+ element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
+ else
+ element = Fcons (Qleft, make_number (x));
+ result = Fcons (element, result);
+ }
+
+ if (geometry & YValue)
+ {
+ Lisp_Object element;
+
+ if (y >= 0 && (geometry & YNegative))
+ element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
+ else if (y < 0 && ! (geometry & YNegative))
+ element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
+ else
+ element = Fcons (Qtop, make_number (y));
+ result = Fcons (element, result);
+ }
+
+ if (geometry & WidthValue)
+ result = Fcons (Fcons (Qwidth, make_number (width)), result);
+ if (geometry & HeightValue)
+ result = Fcons (Fcons (Qheight, make_number (height)), result);
+
+ return result;
+}
+
+/* Calculate the desired size and position of frame F.
+ Return the flags saying which aspects were specified.
+
+ Also set the win_gravity and size_hint_flags of F.
+
+ Adjust height for toolbar if TOOLBAR_P is 1.
+
+ This function does not make the coordinates positive. */
+
+#define DEFAULT_ROWS 40
+#define DEFAULT_COLS 80
+
+int
+x_figure_window_size (f, parms, toolbar_p)
+ struct frame *f;
+ Lisp_Object parms;
+ int toolbar_p;
+{
+ register Lisp_Object tem0, tem1, tem2;
+ long window_prompting = 0;
+ Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+
+ /* Default values if we fall through.
+ Actually, if that happens we should get
+ window manager prompting. */
+ SET_FRAME_COLS (f, DEFAULT_COLS);
+ FRAME_LINES (f) = DEFAULT_ROWS;
+ /* Window managers expect that if program-specified
+ positions are not (0,0), they're intentional, not defaults. */
+ f->top_pos = 0;
+ f->left_pos = 0;
+
+ /* Ensure that old new_text_cols and new_text_lines will not override the
+ values set here. */
+ /* ++KFS: This was specific to W32, but seems ok for all platforms */
+ f->new_text_cols = f->new_text_lines = 0;
+
+ tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
+ tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
+ tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
+ if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
+ {
+ if (!EQ (tem0, Qunbound))
+ {
+ CHECK_NUMBER (tem0);
+ FRAME_LINES (f) = XINT (tem0);
+ }
+ if (!EQ (tem1, Qunbound))
+ {
+ CHECK_NUMBER (tem1);
+ SET_FRAME_COLS (f, XINT (tem1));
+ }
+ if (!NILP (tem2) && !EQ (tem2, Qunbound))
+ window_prompting |= USSize;
+ else
+ window_prompting |= PSize;
+ }
+
+ f->scroll_bar_actual_width
+ = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
+
+ /* This used to be done _before_ calling x_figure_window_size, but
+ since the height is reset here, this was really a no-op. I
+ assume that moving it here does what Gerd intended (although he
+ no longer can remember what that was... ++KFS, 2003-03-25. */
+
+ /* Add the tool-bar height to the initial frame height so that the
+ user gets a text display area of the size he specified with -g or
+ via .Xdefaults. Later changes of the tool-bar height don't
+ change the frame size. This is done so that users can create
+ tall Emacs frames without having to guess how tall the tool-bar
+ will get. */
+ if (toolbar_p && FRAME_TOOL_BAR_LINES (f))
+ {
+ int margin, relief, bar_height;
+
+ relief = (tool_bar_button_relief >= 0
+ ? tool_bar_button_relief
+ : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
+
+ if (INTEGERP (Vtool_bar_button_margin)
+ && XINT (Vtool_bar_button_margin) > 0)
+ margin = XFASTINT (Vtool_bar_button_margin);
+ else if (CONSP (Vtool_bar_button_margin)
+ && INTEGERP (XCDR (Vtool_bar_button_margin))
+ && XINT (XCDR (Vtool_bar_button_margin)) > 0)
+ margin = XFASTINT (XCDR (Vtool_bar_button_margin));
+ else
+ margin = 0;
+
+ bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
+ FRAME_LINES (f) += (bar_height + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
+ }
+
+ compute_fringe_widths (f, 0);
+
+ FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, FRAME_COLS (f));
+ FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
+
+ tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
+ tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
+ tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
+ if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
+ {
+ if (EQ (tem0, Qminus))
+ {
+ f->top_pos = 0;
+ window_prompting |= YNegative;
+ }
+ else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
+ && CONSP (XCDR (tem0))
+ && INTEGERP (XCAR (XCDR (tem0))))
+ {
+ f->top_pos = - XINT (XCAR (XCDR (tem0)));
+ window_prompting |= YNegative;
+ }
+ else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
+ && CONSP (XCDR (tem0))
+ && INTEGERP (XCAR (XCDR (tem0))))
+ {
+ f->top_pos = XINT (XCAR (XCDR (tem0)));
+ }
+ else if (EQ (tem0, Qunbound))
+ f->top_pos = 0;
+ else
+ {
+ CHECK_NUMBER (tem0);
+ f->top_pos = XINT (tem0);
+ if (f->top_pos < 0)
+ window_prompting |= YNegative;
+ }
+
+ if (EQ (tem1, Qminus))
+ {
+ f->left_pos = 0;
+ window_prompting |= XNegative;
+ }
+ else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
+ && CONSP (XCDR (tem1))
+ && INTEGERP (XCAR (XCDR (tem1))))
+ {
+ f->left_pos = - XINT (XCAR (XCDR (tem1)));
+ window_prompting |= XNegative;
+ }
+ else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
+ && CONSP (XCDR (tem1))
+ && INTEGERP (XCAR (XCDR (tem1))))
+ {
+ f->left_pos = XINT (XCAR (XCDR (tem1)));
+ }
+ else if (EQ (tem1, Qunbound))
+ f->left_pos = 0;
+ else
+ {
+ CHECK_NUMBER (tem1);
+ f->left_pos = XINT (tem1);
+ if (f->left_pos < 0)
+ window_prompting |= XNegative;
+ }
+
+ if (!NILP (tem2) && ! EQ (tem2, Qunbound))
+ window_prompting |= USPosition;
+ else
+ window_prompting |= PPosition;
+ }
+
+ if (f->want_fullscreen != FULLSCREEN_NONE)
+ {
+ int left, top;
+ int width, height;
+
+ /* It takes both for some WM:s to place it where we want */
+ window_prompting = USPosition | PPosition;
+ x_fullscreen_adjust (f, &width, &height, &top, &left);
+ FRAME_COLS (f) = width;
+ FRAME_LINES (f) = height;
+ FRAME_PIXEL_WIDTH (f) = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, width);
+ FRAME_PIXEL_HEIGHT (f) = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, height);
+ f->left_pos = left;
+ f->top_pos = top;
+ }
+
+ if (window_prompting & XNegative)
+ {
+ if (window_prompting & YNegative)
+ f->win_gravity = SouthEastGravity;
+ else
+ f->win_gravity = NorthEastGravity;
+ }
+ else
+ {
+ if (window_prompting & YNegative)
+ f->win_gravity = SouthWestGravity;
+ else
+ f->win_gravity = NorthWestGravity;
+ }
+
+ f->size_hint_flags = window_prompting;
+
+ return window_prompting;
+}
+
+
+
+#endif /* HAVE_WINDOW_SYSTEM */
+
+
+\f
+/***********************************************************************
+ Initialization
+ ***********************************************************************/
+
+void
+syms_of_frame ()
+{
+ Qframep = intern ("framep");
+ staticpro (&Qframep);
+ Qframe_live_p = intern ("frame-live-p");
+ staticpro (&Qframe_live_p);
+ Qheight = intern ("height");
+ staticpro (&Qheight);
+ Qicon = intern ("icon");
+ staticpro (&Qicon);
+ Qminibuffer = intern ("minibuffer");
+ staticpro (&Qminibuffer);
+ Qmodeline = intern ("modeline");
+ staticpro (&Qmodeline);
+ Qonly = intern ("only");
+ staticpro (&Qonly);
+ Qwidth = intern ("width");
+ staticpro (&Qwidth);
+ Qgeometry = intern ("geometry");
+ staticpro (&Qgeometry);
+ Qicon_left = intern ("icon-left");
+ staticpro (&Qicon_left);
+ Qicon_top = intern ("icon-top");
+ staticpro (&Qicon_top);
+ Qleft = intern ("left");
+ staticpro (&Qleft);
+ Qright = intern ("right");
+ staticpro (&Qright);
+ Quser_position = intern ("user-position");
+ staticpro (&Quser_position);
+ Quser_size = intern ("user-size");
+ staticpro (&Quser_size);
+ Qwindow_id = intern ("window-id");
+ staticpro (&Qwindow_id);
+#ifdef HAVE_X_WINDOWS
+ Qouter_window_id = intern ("outer-window-id");
+ staticpro (&Qouter_window_id);
+#endif
+ Qparent_id = intern ("parent-id");
+ staticpro (&Qparent_id);
+ Qx = intern ("x");
+ staticpro (&Qx);
+ Qw32 = intern ("w32");
+ staticpro (&Qw32);
+ Qpc = intern ("pc");
+ staticpro (&Qpc);
+ Qmac = intern ("mac");
+ staticpro (&Qmac);
+ Qvisible = intern ("visible");
+ staticpro (&Qvisible);
+ Qbuffer_predicate = intern ("buffer-predicate");
+ staticpro (&Qbuffer_predicate);
+ Qbuffer_list = intern ("buffer-list");
+ staticpro (&Qbuffer_list);
+ Qdisplay_type = intern ("display-type");
+ staticpro (&Qdisplay_type);
+ Qbackground_mode = intern ("background-mode");
+ staticpro (&Qbackground_mode);
+ Qtty_color_mode = intern ("tty-color-mode");
+ staticpro (&Qtty_color_mode);
+
+ Qface_set_after_frame_default = intern ("face-set-after-frame-default");
+ staticpro (&Qface_set_after_frame_default);
+
+ Qfullwidth = intern ("fullwidth");
+ staticpro (&Qfullwidth);
+ Qfullheight = intern ("fullheight");
+ staticpro (&Qfullheight);
+ Qfullboth = intern ("fullboth");
+ staticpro (&Qfullboth);
+ Qx_resource_name = intern ("x-resource-name");
+ staticpro (&Qx_resource_name);
+
+ Qx_frame_parameter = intern ("x-frame-parameter");
+ staticpro (&Qx_frame_parameter);
+
+ {
+ int i;
+
+ for (i = 0; i < sizeof (frame_parms) / sizeof (frame_parms[0]); i++)
+ {
+ Lisp_Object v = intern (frame_parms[i].name);
+ if (frame_parms[i].variable)
+ {
+ *frame_parms[i].variable = v;
+ staticpro (frame_parms[i].variable);
+ }
+ Fput (v, Qx_frame_parameter, make_number (i));
+ }
+ }
+
+#ifdef HAVE_WINDOW_SYSTEM
+ DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
+ doc: /* The name Emacs uses to look up X resources.
+`x-get-resource' uses this as the first component of the instance name
+when requesting resource values.
+Emacs initially sets `x-resource-name' to the name under which Emacs
+was invoked, or to the value specified with the `-name' or `-rn'
+switches, if present.
+
+It may be useful to bind this variable locally around a call
+to `x-get-resource'. See also the variable `x-resource-class'. */);
+ Vx_resource_name = Qnil;
+
+ DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
+ doc: /* The class Emacs uses to look up X resources.
+`x-get-resource' uses this as the first component of the instance class
+when requesting resource values.
+
+Emacs initially sets `x-resource-class' to "Emacs".
+
+Setting this variable permanently is not a reasonable thing to do,
+but binding this variable locally around a call to `x-get-resource'
+is a reasonable practice. See also the variable `x-resource-name'. */);
+ Vx_resource_class = build_string (EMACS_CLASS);
+#endif
+
+ DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist,
+ doc: /* Alist of default values for frame creation.
+These may be set in your init file, like this:
+ (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1))
+These override values given in window system configuration data,
+ including X Windows' defaults database.
+For values specific to the first Emacs frame, see `initial-frame-alist'.
+For values specific to the separate minibuffer frame, see
+ `minibuffer-frame-alist'.
+The `menu-bar-lines' element of the list controls whether new frames
+ have menu bars; `menu-bar-mode' works by altering this element.
+Setting this variable does not affect existing frames, only new ones. */);
+ Vdefault_frame_alist = Qnil;
+
+ Qinhibit_default_face_x_resources
+ = intern ("inhibit-default-face-x-resources");
+ staticpro (&Qinhibit_default_face_x_resources);
+
+ DEFVAR_LISP ("terminal-frame", &Vterminal_frame,
+ doc: /* The initial frame-object, which represents Emacs's stdout. */);
+
+ DEFVAR_LISP ("emacs-iconified", &Vemacs_iconified,
+ doc: /* Non-nil if all of emacs is iconified and frame updates are not needed. */);
+ Vemacs_iconified = Qnil;
+
+ DEFVAR_LISP ("mouse-position-function", &Vmouse_position_function,
+ doc: /* If non-nil, function to transform normal value of `mouse-position'.
+`mouse-position' calls this function, passing its usual return value as
+argument, and returns whatever this function returns.
+This abnormal hook exists for the benefit of packages like `xt-mouse.el'
+which need to do mouse handling at the Lisp level. */);
+ Vmouse_position_function = Qnil;
+
+ DEFVAR_LISP ("mouse-highlight", &Vmouse_highlight,
+ doc: /* If non-nil, clickable text is highlighted when mouse is over it.
+If the value is an integer, highlighting is only shown after moving the
+mouse, while keyboard input turns off the highlight even when the mouse
+is over the clickable text. However, the mouse shape still indicates
+when the mouse is over clickable text. */);
+ Vmouse_highlight = Qt;
+
+ DEFVAR_LISP ("delete-frame-functions", &Vdelete_frame_functions,
+ doc: /* Functions to be run before deleting a frame.
+The functions are run with one arg, the frame to be deleted.
+See `delete-frame'. */);
+ Vdelete_frame_functions = Qnil;
+
+ DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
+ doc: /* Minibufferless frames use this frame's minibuffer.
+
+Emacs cannot create minibufferless frames unless this is set to an
+appropriate surrogate.
+
+Emacs consults this variable only when creating minibufferless
+frames; once the frame is created, it sticks with its assigned
+minibuffer, no matter what this variable is set to. This means that
+this variable doesn't necessarily say anything meaningful about the
+current set of frames, or where the minibuffer is currently being
+displayed.
+
+This variable is local to the current terminal and cannot be buffer-local. */);
+
+ staticpro (&Vframe_list);
+
+ defsubr (&Sactive_minibuffer_window);
+ defsubr (&Sframep);
+ defsubr (&Sframe_live_p);
+ defsubr (&Smake_terminal_frame);
+ defsubr (&Shandle_switch_frame);
+ defsubr (&Signore_event);
+ defsubr (&Sselect_frame);
+ defsubr (&Sselected_frame);
+ defsubr (&Swindow_frame);
+ defsubr (&Sframe_root_window);
+ defsubr (&Sframe_first_window);
+ defsubr (&Sframe_selected_window);
+ defsubr (&Sset_frame_selected_window);
+ defsubr (&Sframe_list);
+ defsubr (&Snext_frame);
+ defsubr (&Sprevious_frame);
+ defsubr (&Sdelete_frame);
+ defsubr (&Smouse_position);
+ defsubr (&Smouse_pixel_position);
+ defsubr (&Sset_mouse_position);
+ defsubr (&Sset_mouse_pixel_position);
+#if 0
+ defsubr (&Sframe_configuration);
+ defsubr (&Srestore_frame_configuration);
+#endif
+ defsubr (&Smake_frame_visible);
+ defsubr (&Smake_frame_invisible);
+ defsubr (&Siconify_frame);
+ defsubr (&Sframe_visible_p);
+ defsubr (&Svisible_frame_list);
+ defsubr (&Sraise_frame);
+ defsubr (&Slower_frame);
+ defsubr (&Sredirect_frame_focus);
+ defsubr (&Sframe_focus);
+ defsubr (&Sframe_parameters);
+ defsubr (&Sframe_parameter);
+ defsubr (&Smodify_frame_parameters);
+ defsubr (&Sframe_char_height);
+ defsubr (&Sframe_char_width);
+ defsubr (&Sframe_pixel_height);
+ defsubr (&Sframe_pixel_width);
+ defsubr (&Sset_frame_height);
+ defsubr (&Sset_frame_width);
+ defsubr (&Sset_frame_size);
+ defsubr (&Sset_frame_position);
+
+#ifdef HAVE_WINDOW_SYSTEM
+ defsubr (&Sx_get_resource);
+ defsubr (&Sx_parse_geometry);
+#endif
+
}
vertical_scroll_bar_right
};
-#if !defined(MSDOS) && !defined(WINDOWSNT) && !defined(macintosh)
+enum text_cursor_kinds
+{
+ DEFAULT_CURSOR = -2,
+ NO_CURSOR = -1,
+ FILLED_BOX_CURSOR,
+ HOLLOW_BOX_CURSOR,
+ BAR_CURSOR,
+ HBAR_CURSOR
+};
+
+#if !defined(MSDOS) && !defined(WINDOWSNT) && !defined(MAC_OS)
#if !defined(HAVE_X_WINDOWS)
PIX_TYPE foreground_pixel;
};
-#define FRAME_INTERNAL_BORDER_WIDTH(f) 0
-
#endif /* ! HAVE_X_WINDOWS */
/* A structure describing a termcap frame display. */
extern struct x_output tty_display;
-#endif /* ! MSDOS && ! WINDOWSNT && ! macintosh */
+#endif /* ! MSDOS && ! WINDOWSNT && ! MAC_OS */
struct frame
{
or modified with modify-frame-parameters. */
Lisp_Object param_alist;
- /* List of scroll bars on this frame.
+ /* List of scroll bars on this frame.
Actually, we don't specify exactly what is stored here at all; the
scroll bar implementation code can use it to store anything it likes.
This field is marked by the garbage collector. It is here
be used for output. */
unsigned glyphs_initialized_p : 1;
+#if defined (USE_GTK)
+ /* Nonzero means using a tool bar that comes from the toolkit. */
+ int external_tool_bar;
+#endif
+
/* Margin at the top of the frame. Used to display the tool-bar. */
int tool_bar_lines;
int n_tool_bar_items;
-
+
/* A buffer for decode_mode_line. */
char *decode_mode_spec_buffer;
/* Cost of deleting n lines on this frame */
int *delete_n_lines_cost;
- /* Size of this frame, in units of characters. */
- EMACS_INT height;
- EMACS_INT width;
- EMACS_INT window_width;
- EMACS_INT window_height;
+ /* Size of this frame, excluding fringes, scroll bars etc.,
+ in units of canonical characters. */
+ EMACS_INT text_lines, text_cols;
+
+ /* Total size of this frame (i.e. its native window), in units of
+ canonical characters. */
+ EMACS_INT total_lines, total_cols;
+
+ /* New text height and width for pending size change.
+ 0 if no change pending. */
+ int new_text_lines, new_text_cols;
+
+ /* Pixel position of the frame window (x and y offsets in root window). */
+ int left_pos, top_pos;
+
+ /* Size of the frame window in pixels. */
+ int pixel_height, pixel_width;
+
+ /* 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;
+
+ /* This is the gravity value for the specified window position. */
+ int win_gravity;
+
+ /* The geometry flags for this window. */
+ int size_hint_flags;
+
+ /* Border width of the frame window as known by the (X) window system. */
+ int border_width;
- /* New height and width for pending size change. 0 if no change pending. */
- int new_height, new_width;
+ /* Width of the internal border. This is a line of background color
+ just inside the window's border. When the frame is selected,
+ a highlighting is displayed inside the internal border. */
+ int internal_border_width;
+
+ /* Canonical X unit. Width of default font, in pixels. */
+ int column_width;
+
+ /* Canonical Y unit. Height of a line, in pixels. */
+ int line_height;
/* The output method says how the contents of this frame
are displayed. It could be using termcap, or using an X window. */
/* A structure of auxiliary data used for displaying the contents.
struct x_output is used for X window frames;
- it is defined in xterm.h.
+ it is defined in xterm.h.
struct w32_output is used for W32 window frames;
it is defined in w32term.h. */
union output_data
}
output_data;
+ /* 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
+ sizes aren't pixel values. If it weren't the case, we wouldn't be
+ able to split windows horizontally nicely. */
+ int fringe_cols;
+
+ /* The extra width (in pixels) currently allotted for fringes. */
+ int left_fringe_width, right_fringe_width;
+
#ifdef MULTI_KBOARD
/* A pointer to the kboard structure associated with this frame.
For termcap frames, this points to initial_kboard. For X frames,
struct kboard *kboard;
#endif
+ /* See FULLSCREEN_ enum below */
+ int want_fullscreen;
+
/* Number of lines of menu bar. */
int menu_bar_lines;
-#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
+#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (MAC_OS) \
+ || defined (USE_GTK)
/* Nonzero means using a menu bar that comes from the X toolkit. */
int external_menu_bar;
#endif
/* True if frame actually has a minibuffer window on it.
0 if using a minibuffer window that isn't on this frame. */
char has_minibuffer;
-
+
/* 0 means, if this frame has just one window,
show no modeline for that window. */
char wants_modeline;
actually display them on this frame. */
enum vertical_scroll_bar_type vertical_scroll_bar_type;
+ /* What kind of text cursor should we draw in the future?
+ This should always be filled_box_cursor or bar_cursor. */
+ enum text_cursor_kinds desired_cursor;
+
+ /* Width of bar cursor (if we are using that). */
+ int cursor_width;
+
+ /* What kind of text cursor should we draw when the cursor blinks off?
+ This can be filled_box_cursor or bar_cursor or no_cursor. */
+ enum text_cursor_kinds blink_off_cursor;
+
+ /* Width of bar cursor (if we are using that) for blink-off state. */
+ int blink_off_cursor_width;
+
/* Non-0 means raise this frame to the top of the heap when selected. */
char auto_raise;
for lines beyond a certain vpos. This is the vpos. */
int scroll_bottom_vpos;
- /* Width of the scroll bar, in pixels and in characters.
- scroll_bar_cols tracks scroll_bar_pixel_width if the latter is positive;
- a zero value in scroll_bar_pixel_width means to compute the actual width
- on the fly, using scroll_bar_cols and the current font width. */
- int scroll_bar_pixel_width;
- int scroll_bar_cols;
+ /* Configured width of the scroll bar, in pixels and in characters.
+ config_scroll_bar_cols tracks config_scroll_bar_width if the
+ latter is positive; a zero value in config_scroll_bar_width means
+ to compute the actual width on the fly, using config_scroll_bar_cols
+ and the current font width. */
+ int config_scroll_bar_width;
+ int config_scroll_bar_cols;
+
+ /* The size of the extra width currently allotted for vertical
+ scroll bars in this frame, in pixels. */
+ int scroll_bar_actual_width;
/* The baud rate that was used to calculate costs for this frame. */
int cost_calculation_baud_rate;
/* Set to non-zero in change_frame_size when size of frame changed
Clear the frame in clear_garbaged_frames if set. */
unsigned resized_p : 1;
+
+ /* Set to non-zero if the default face for the frame has been
+ realized. Reset to zero whenever the default face changes.
+ Used to see the difference between a font change and face change. */
+ unsigned default_face_done_p : 1;
};
#ifdef MULTI_KBOARD
#ifdef HAVE_NTGUI
#define FRAME_WINDOW_P(f) FRAME_W32_P (f)
#endif
-#ifdef macintosh
+#ifdef MAC_OS
#define FRAME_WINDOW_P(f) FRAME_MAC_P (f)
#endif
#ifndef FRAME_WINDOW_P
/* Nonzero if frame F contains a minibuffer window.
(If this is 0, F must use some other minibuffer window.) */
#define FRAME_HAS_MINIBUF_P(f) ((f)->has_minibuffer)
-#define FRAME_HEIGHT(f) (f)->height
-/* Width of frame F, measured in character columns,
+/* Pixel height of frame F, including non-toolkit menu bar and
+ non-toolkit tool bar lines. */
+#define FRAME_PIXEL_HEIGHT(f) ((f)->pixel_height)
+
+/* Pixel width of frame F. */
+#define FRAME_PIXEL_WIDTH(f) ((f)->pixel_width)
+
+/* Height of frame F, measured in canonical lines, including
+ non-toolkit menu bar and non-toolkit tool bar lines. */
+#define FRAME_LINES(f) (f)->text_lines
+
+/* Width of frame F, measured in canonical character columns,
not including scroll bars if any. */
-#define FRAME_WIDTH(f) (f)->width
+#define FRAME_COLS(f) (f)->text_cols
/* Number of lines of frame F used for menu bar.
This is relevant on terminal frames and on
X Windows when not using the X toolkit.
- These lines are counted in FRAME_HEIGHT. */
+ These lines are counted in FRAME_LINES. */
#define FRAME_MENU_BAR_LINES(f) (f)->menu_bar_lines
+/* Nonzero if this frame should display a tool bar
+ in a way that does not use any text lines. */
+#if defined (USE_GTK)
+#define FRAME_EXTERNAL_TOOL_BAR(f) (f)->external_tool_bar
+#else
+#define FRAME_EXTERNAL_TOOL_BAR(f) 0
+#endif
+
/* Number of lines of frame F used for the tool-bar. */
#define FRAME_TOOL_BAR_LINES(f) (f)->tool_bar_lines
+
/* Lines above the top-most window in frame F. */
#define FRAME_TOP_MARGIN(F) \
/* Nonzero if this frame should display a menu bar
in a way that does not use any text lines. */
-#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
+#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (MAC_OS) \
+ || defined (USE_GTK)
#define FRAME_EXTERNAL_MENU_BAR(f) (f)->external_menu_bar
#else
#define FRAME_EXTERNAL_MENU_BAR(f) 0
but not yet really put into effect. This can be true temporarily
when an X event comes in at a bad time. */
#define FRAME_WINDOW_SIZES_CHANGED(f) (f)->window_sizes_changed
-/* When a size change is pending, these are the requested new sizes. */
-#define FRAME_NEW_HEIGHT(f) (f)->new_height
-#define FRAME_NEW_WIDTH(f) (f)->new_width
/* The minibuffer window of frame F, if it has one; otherwise nil. */
#define FRAME_MINIBUF_WINDOW(f) (f)->minibuffer_window
/* The currently selected window of the window tree of frame F. */
#define FRAME_SELECTED_WINDOW(f) (f)->selected_window
-#define FRAME_INSERT_COST(f) (f)->insert_line_cost
-#define FRAME_DELETE_COST(f) (f)->delete_line_cost
+#define FRAME_INSERT_COST(f) (f)->insert_line_cost
+#define FRAME_DELETE_COST(f) (f)->delete_line_cost
#define FRAME_INSERTN_COST(f) (f)->insert_n_lines_cost
#define FRAME_DELETEN_COST(f) (f)->delete_n_lines_cost
#define FRAME_MESSAGE_BUF(f) (f)->message_buf
/* Width that a scroll bar in frame F should have, if there is one.
Measured in pixels.
If scroll bars are turned off, this is still nonzero. */
-#define FRAME_SCROLL_BAR_PIXEL_WIDTH(f) ((f)->scroll_bar_pixel_width)
+#define FRAME_CONFIG_SCROLL_BAR_WIDTH(f) ((f)->config_scroll_bar_width)
/* Width that a scroll bar in frame F should have, if there is one.
Measured in columns (characters).
If scroll bars are turned off, this is still nonzero. */
-#define FRAME_SCROLL_BAR_COLS(f) ((f)->scroll_bar_cols)
+#define FRAME_CONFIG_SCROLL_BAR_COLS(f) ((f)->config_scroll_bar_cols)
/* Width of a scroll bar in frame F, measured in columns (characters),
but only if scroll bars are on the left. If scroll bars are on
the right in this frame, or there are no scroll bars, value is 0. */
-#define FRAME_LEFT_SCROLL_BAR_WIDTH(f) \
+#define FRAME_LEFT_SCROLL_BAR_COLS(f) \
(FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f) \
- ? FRAME_SCROLL_BAR_COLS (f) \
+ ? FRAME_CONFIG_SCROLL_BAR_COLS (f) \
: 0)
+/* Width of a left scroll bar in frame F, measured in pixels */
+
+#define FRAME_LEFT_SCROLL_BAR_AREA_WIDTH(f) \
+ (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f) \
+ ? (FRAME_CONFIG_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f)) \
+ : 0)
+
/* Width of a scroll bar in frame F, measured in columns (characters),
but only if scroll bars are on the right. If scroll bars are on
the left in this frame, or there are no scroll bars, value is 0. */
-#define FRAME_RIGHT_SCROLL_BAR_WIDTH(f) \
+#define FRAME_RIGHT_SCROLL_BAR_COLS(f) \
(FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f) \
- ? FRAME_SCROLL_BAR_COLS (f) \
+ ? FRAME_CONFIG_SCROLL_BAR_COLS (f) \
: 0)
-/* Width of a scroll bar in frame F, measured in columns (characters). */
-#define FRAME_SCROLL_BAR_WIDTH(f) \
- (FRAME_HAS_VERTICAL_SCROLL_BARS (f) \
- ? FRAME_SCROLL_BAR_COLS (f) \
+/* Width of a right scroll bar area in frame F, measured in pixels */
+
+#define FRAME_RIGHT_SCROLL_BAR_AREA_WIDTH(f) \
+ (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f) \
+ ? (FRAME_CONFIG_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f)) \
+ : 0)
+
+/* Actual width of a scroll bar in frame F, measured in columns. */
+
+#define FRAME_SCROLL_BAR_COLS(f) \
+ (FRAME_HAS_VERTICAL_SCROLL_BARS (f) \
+ ? FRAME_CONFIG_SCROLL_BAR_COLS (f) \
: 0)
+/* Actual width of a scroll bar area in frame F, measured in pixels. */
+
+#define FRAME_SCROLL_BAR_AREA_WIDTH(f) \
+ (FRAME_HAS_VERTICAL_SCROLL_BARS (f) \
+ ? (FRAME_CONFIG_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f)) \
+ : 0)
+
/* Total width of frame F, in columns (characters),
including the width used by scroll bars if any. */
-#define FRAME_WINDOW_WIDTH(f) ((f)->window_width)
+
+#define FRAME_TOTAL_COLS(f) ((f)->total_cols)
/* Set the width of frame F to VAL.
VAL is the width of a full-frame window,
- not including scroll bars. */
-#define SET_FRAME_WIDTH(f, val) \
- ((f)->width = (val), \
- (f)->window_width = FRAME_WINDOW_WIDTH_ARG (f, (f)->width))
+ not including scroll bars and fringes. */
+
+#define SET_FRAME_COLS(f, val) \
+ (FRAME_COLS (f) = (val), \
+ (f)->total_cols = FRAME_TOTAL_COLS_ARG (f, FRAME_COLS (f)))
/* Given a value WIDTH for frame F's nominal width,
- return the value that FRAME_WINDOW_WIDTH should have. */
-#define FRAME_WINDOW_WIDTH_ARG(f, width) \
+ return the value that FRAME_TOTAL_COLS should have. */
+
+#define FRAME_TOTAL_COLS_ARG(f, width) \
((width) \
- + FRAME_SCROLL_BAR_WIDTH (f) \
+ + FRAME_SCROLL_BAR_COLS (f) \
+ FRAME_FRINGE_COLS (f))
/* Maximum + 1 legitimate value for FRAME_CURSOR_X. */
+
#define FRAME_CURSOR_X_LIMIT(f) \
- (FRAME_WIDTH (f) + FRAME_LEFT_SCROLL_BAR_WIDTH (f))
+ (FRAME_COLS (f) + FRAME_LEFT_SCROLL_BAR_COLS (f))
/* Nonzero if frame F has scroll bars. */
+
#define FRAME_SCROLL_BARS(f) ((f)->scroll_bars)
#define FRAME_CONDEMNED_SCROLL_BARS(f) ((f)->condemned_scroll_bars)
#define FRAME_MENU_BAR_ITEMS(f) ((f)->menu_bar_items)
#define FRAME_COST_BAUD_RATE(f) ((f)->cost_calculation_baud_rate)
+#define FRAME_DESIRED_CURSOR(f) ((f)->desired_cursor)
+#define FRAME_BLINK_OFF_CURSOR(f) ((f)->blink_off_cursor)
+#define FRAME_CURSOR_WIDTH(f) ((f)->cursor_width)
+#define FRAME_BLINK_OFF_CURSOR_WIDTH(f) ((f)->blink_off_cursor_width)
+
/* Return a pointer to the face cache of frame F. */
#define FRAME_FACE_CACHE(F) (F)->face_cache
/* Return the size of message_buf of the frame F. We multiply the
width of the frame by 4 because multi-byte form may require at most
4-byte for a character. */
-
-#define FRAME_MESSAGE_BUF_SIZE(f) (((int) (f)->width) * 4)
+
+#define FRAME_MESSAGE_BUF_SIZE(f) (((int) FRAME_COLS (f)) * 4)
/* Emacs's redisplay code could become confused if a frame's
visibility changes at arbitrary times. For example, if a frame is
Also, if a frame used to be invisible, but has just become visible,
it must be marked as garbaged, since redisplay hasn't been keeping
up its contents. */
-
+
#define FRAME_SAMPLE_VISIBILITY(f) \
(((f)->async_visible && (f)->visible != (f)->async_visible) ? \
SET_FRAME_GARBAGED (f) : 0, \
loop will set FRAME_VAR, a Lisp_Object, to each frame in
Vframe_list in succession and execute the statement. LIST_VAR
should be a Lisp_Object too; it is used to iterate through the
- Vframe_list.
+ Vframe_list.
This macro is a holdover from a time when multiple frames weren't always
supported. An alternate definition of the macro would expand to
list_var = XCDR (list_var))
-extern Lisp_Object Qframep, Qframe_live_p, Qicon;
-extern Lisp_Object Qleft_fringe, Qright_fringe;
+extern Lisp_Object Qframep, Qframe_live_p;
extern struct frame *last_nonminibuf_frame;
extern Lisp_Object Vterminal_frame;
extern Lisp_Object Vmouse_highlight;
-\f
-/* Device-independent scroll bar stuff. */
-
-/* Return the starting column (zero-based) of the vertical scroll bar
- for window W. The column before this one is the last column we can
- use for text. If the window touches the right edge of the frame,
- we have extra space allocated for it. Otherwise, the scroll bar
- takes over the window's rightmost columns. */
-
-#define WINDOW_VERTICAL_SCROLL_BAR_COLUMN(w) \
- (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (XFRAME (WINDOW_FRAME (w))) ? \
- (((XINT ((w)->left) + XINT ((w)->width)) \
- < FRAME_WIDTH (XFRAME (WINDOW_FRAME (w)))) \
- ? (XINT ((w)->left) + XINT ((w)->width) \
- - FRAME_SCROLL_BAR_COLS (XFRAME (WINDOW_FRAME (w)))) \
- : FRAME_WIDTH (XFRAME (WINDOW_FRAME (w)))) \
- : XINT ((w)->left))
-
-/* Return the height in lines of the vertical scroll bar in w. If the
- window has a mode line, don't make the scroll bar extend that far. */
-
-#define WINDOW_VERTICAL_SCROLL_BAR_HEIGHT(w) (window_internal_height (w))
+enum text_cursor_kinds get_specified_cursor_type P_ ((Lisp_Object, int *));
+enum text_cursor_kinds get_window_cursor_type P_ ((struct window *, int *, int *));
+\f
/* The currently selected frame. */
extern Lisp_Object selected_frame;
Display-related Macros
***********************************************************************/
-/* Canonical y-unit on frame F. This value currently equals the line
- height of the frame. Terminal specific header files are expected
- to define the macro FRAME_LINE_HEIGHT. */
+/* Canonical y-unit on frame F.
+ This value currently equals the line height of the frame (which is
+ the height of the default font of F). */
+
+#define FRAME_LINE_HEIGHT(F) ((F)->line_height)
-#define CANON_Y_UNIT(F) \
- (FRAME_WINDOW_P (F) ? FRAME_LINE_HEIGHT (F) : 1)
+/* Canonical x-unit on frame F.
+ This value currently equals the width of the default font of F. */
-/* Canonical x-unit on frame F. This is currently equal to the width
- of the default font of F. Terminal specific headers are expected
- to define the macro FRAME_DEFAULT_FONT_WIDTH. */
+#define FRAME_COLUMN_WIDTH(F) ((F)->column_width)
-#define CANON_X_UNIT(F) \
- (FRAME_WINDOW_P (F) ? FRAME_DEFAULT_FONT_WIDTH (F) : 1)
/* Pixel width of areas used to display truncation marks, continuation
marks, overlay arrows. This is 0 for terminal frames. */
#ifdef HAVE_WINDOW_SYSTEM
-#define FRAME_FRINGE_COLS(F) \
- (FRAME_WINDOW_P (F) ? FRAME_X_FRINGE_COLS (F) : 0)
-#define FRAME_FRINGE_WIDTH(F) \
- (FRAME_WINDOW_P (F) ? FRAME_X_FRINGE_WIDTH (F) : 0)
-#define FRAME_LEFT_FRINGE_WIDTH(F) \
- (FRAME_WINDOW_P (F) ? FRAME_X_LEFT_FRINGE_WIDTH (F) : 0)
-#define FRAME_RIGHT_FRINGE_WIDTH(F) \
- (FRAME_WINDOW_P (F) ? FRAME_X_RIGHT_FRINGE_WIDTH (F) : 0)
-
+/* 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
+ sizes aren't pixel values. If it weren't the case, we wouldn't be
+ able to split windows horizontally nicely. */
+
+#define FRAME_FRINGE_COLS(F) ((F)->fringe_cols)
+
+/* Pixel-width of the left and right fringe. */
+
+#define FRAME_LEFT_FRINGE_WIDTH(F) ((F)->left_fringe_width)
+#define FRAME_RIGHT_FRINGE_WIDTH(F) ((F)->right_fringe_width)
+
+/* Total width of fringes in pixels. */
+
+#define FRAME_TOTAL_FRINGE_WIDTH(F) \
+ (FRAME_LEFT_FRINGE_WIDTH (F) + FRAME_RIGHT_FRINGE_WIDTH (F))
+
+
+/* Pixel-width of internal border lines */
+
+#define FRAME_INTERNAL_BORDER_WIDTH(F) ((F)->internal_border_width)
+
#else /* not HAVE_WINDOW_SYSTEM */
-#define FRAME_FRINGE_WIDTH(F) 0
#define FRAME_FRINGE_COLS(F) 0
+#define FRAME_TOTAL_FRINGE_WIDTH(F) 0
#define FRAME_LEFT_FRINGE_WIDTH(F) 0
#define FRAME_RIGHT_FRINGE_WIDTH(F) 0
+#define FRAME_INTERNAL_BORDER_WIDTH(F) 0
#endif /* not HAVE_WINDOW_SYSTEM */
-
+
\f
Conversion between canonical units and pixels
***********************************************************************/
-/* Canonical x-values are fractions of CANON_X_UNIT, canonical y-unit
- are fractions of CANON_Y_UNIT of a frame. Both are represented as
- Lisp numbers, i.e. integers or floats. */
+/* Canonical x-values are fractions of FRAME_COLUMN_WIDTH, canonical
+ y-unit are fractions of FRAME_LINE_HEIGHT of a frame. Both are
+ represented as Lisp numbers, i.e. integers or floats. */
/* Convert canonical value X to pixels. F is the frame whose
canonical char width is to be used. X must be a Lisp integer or
float. Value is a C integer. */
-
-#define PIXEL_X_FROM_CANON_X(F, X) \
+
+#define FRAME_PIXEL_X_FROM_CANON_X(F, X) \
(INTEGERP (X) \
- ? XINT (X) * CANON_X_UNIT (F) \
- : (int) (XFLOAT_DATA (X) * CANON_X_UNIT (F)))
-
+ ? XINT (X) * FRAME_COLUMN_WIDTH (F) \
+ : (int) (XFLOAT_DATA (X) * FRAME_COLUMN_WIDTH (F)))
+
/* Convert canonical value Y to pixels. F is the frame whose
canonical character height is to be used. X must be a Lisp integer
or float. Value is a C integer. */
-
-#define PIXEL_Y_FROM_CANON_Y(F, Y) \
+
+#define FRAME_PIXEL_Y_FROM_CANON_Y(F, Y) \
(INTEGERP (Y) \
- ? XINT (Y) * CANON_Y_UNIT (F) \
- : (int) (XFLOAT_DATA (Y) * CANON_Y_UNIT (F)))
+ ? XINT (Y) * FRAME_LINE_HEIGHT (F) \
+ : (int) (XFLOAT_DATA (Y) * FRAME_LINE_HEIGHT (F)))
/* Convert pixel-value X to canonical units. F is the frame whose
canonical character width is to be used. X is a C integer. Result
is a Lisp float if X is not a multiple of the canon width,
otherwise it's a Lisp integer. */
-#define CANON_X_FROM_PIXEL_X(F, X) \
- ((X) % CANON_X_UNIT (F) != 0 \
- ? make_float ((double) (X) / CANON_X_UNIT (F)) \
- : make_number ((X) / CANON_X_UNIT (F)))
+#define FRAME_CANON_X_FROM_PIXEL_X(F, X) \
+ ((X) % FRAME_COLUMN_WIDTH (F) != 0 \
+ ? make_float ((double) (X) / FRAME_COLUMN_WIDTH (F)) \
+ : make_number ((X) / FRAME_COLUMN_WIDTH (F)))
/* Convert pixel-value Y to canonical units. F is the frame whose
canonical character height is to be used. Y is a C integer.
Result is a Lisp float if Y is not a multiple of the canon width,
otherwise it's a Lisp integer. */
-#define CANON_Y_FROM_PIXEL_Y(F, Y) \
- ((Y) % CANON_Y_UNIT (F) \
- ? make_float ((double) (Y) / CANON_Y_UNIT (F)) \
- : make_number ((Y) / CANON_Y_UNIT (F)))
-
+#define FRAME_CANON_Y_FROM_PIXEL_Y(F, Y) \
+ ((Y) % FRAME_LINE_HEIGHT (F) \
+ ? make_float ((double) (Y) / FRAME_LINE_HEIGHT (F)) \
+ : make_number ((Y) / FRAME_LINE_HEIGHT (F)))
+
+
+\f
+/* Manipulating pixel sizes and character sizes.
+ Knowledge of which factors affect the overall size of the window should
+ be hidden in these macros, if that's possible.
+
+ Return the upper/left pixel position of the character cell on frame F
+ at ROW/COL. */
+
+#define FRAME_LINE_TO_PIXEL_Y(f, row) \
+ (FRAME_INTERNAL_BORDER_WIDTH (f) \
+ + (row) * FRAME_LINE_HEIGHT (f))
+
+#define FRAME_COL_TO_PIXEL_X(f, col) \
+ (FRAME_INTERNAL_BORDER_WIDTH (f) \
+ + (col) * FRAME_COLUMN_WIDTH (f))
+
+/* Return the pixel width/height of frame F if it has
+ COLS columns/LINES rows. */
+
+#define FRAME_TEXT_COLS_TO_PIXEL_WIDTH(f, cols) \
+ (FRAME_COL_TO_PIXEL_X (f, cols) \
+ + (f)->scroll_bar_actual_width \
+ + FRAME_TOTAL_FRINGE_WIDTH (f) \
+ + FRAME_INTERNAL_BORDER_WIDTH (f))
+
+#define FRAME_TEXT_LINES_TO_PIXEL_HEIGHT(f, lines) \
+ (FRAME_LINE_TO_PIXEL_Y (f, lines) \
+ + FRAME_INTERNAL_BORDER_WIDTH (f))
+
+
+/* Return the row/column (zero-based) of the character cell containing
+ the pixel on FRAME at Y/X. */
+
+#define FRAME_PIXEL_Y_TO_LINE(f, y) \
+ (((y) - FRAME_INTERNAL_BORDER_WIDTH (f)) \
+ / FRAME_LINE_HEIGHT (f))
+
+#define FRAME_PIXEL_X_TO_COL(f, x) \
+ (((x) - FRAME_INTERNAL_BORDER_WIDTH (f)) \
+ / FRAME_COLUMN_WIDTH (f))
+
+/* How many columns/rows of text can we fit in WIDTH/HEIGHT pixels on
+ frame F? */
+
+#define FRAME_PIXEL_WIDTH_TO_TEXT_COLS(f, width) \
+ (FRAME_PIXEL_X_TO_COL (f, ((width) \
+ - FRAME_INTERNAL_BORDER_WIDTH (f) \
+ - FRAME_TOTAL_FRINGE_WIDTH (f) \
+ - (f)->scroll_bar_actual_width)))
+
+#define FRAME_PIXEL_HEIGHT_TO_TEXT_LINES(f, height) \
+ (FRAME_PIXEL_Y_TO_LINE (f, ((height) \
+ - FRAME_INTERNAL_BORDER_WIDTH (f))))
+
+
+/***********************************************************************
+ Frame Parameters
+ ***********************************************************************/
+
+extern Lisp_Object Qauto_raise, Qauto_lower;
+extern Lisp_Object Qborder_color, Qborder_width;
+extern Lisp_Object Qbuffer_predicate, Qbuffer_list;
+extern Lisp_Object Qcursor_color, Qcursor_type;
+extern Lisp_Object Qfont;
+extern Lisp_Object Qbackground_color, Qforeground_color;
+extern Lisp_Object Qicon, Qicon_name, Qicon_type, Qicon_left, Qicon_top;
+extern Lisp_Object Qinternal_border_width;
+extern Lisp_Object Qmenu_bar_lines, Qtool_bar_lines;
+extern Lisp_Object Qmouse_color;
+extern Lisp_Object Qname, Qtitle;
+extern Lisp_Object Qparent_id;
+extern Lisp_Object Qunsplittable, Qvisibility;
+extern Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
+extern Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
+extern Lisp_Object Qscreen_gamma;
+extern Lisp_Object Qline_spacing;
+extern Lisp_Object Qwait_for_wm;
+extern Lisp_Object Qfullscreen;
+
+extern Lisp_Object Qleft_fringe, Qright_fringe;
+extern Lisp_Object Qheight, Qwidth;
+extern Lisp_Object Qminibuffer, Qmodeline;
+extern Lisp_Object Qonly;
+extern Lisp_Object Qx, Qw32, Qmac, Qpc;
+extern Lisp_Object Qvisible;
+extern Lisp_Object Qdisplay_type;
+extern Lisp_Object Qbackground_mode;
+
+extern Lisp_Object Qx_resource_name;
+
+extern Lisp_Object Qleft, Qright, Qtop, Qbox;
+extern Lisp_Object Qdisplay;
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* The class of this X application. */
+#define EMACS_CLASS "Emacs"
+
+enum
+{
+ /* Values used as a bit mask, BOTH == WIDTH | HEIGHT. */
+ FULLSCREEN_NONE = 0,
+ FULLSCREEN_WIDTH = 1,
+ FULLSCREEN_HEIGHT = 2,
+ FULLSCREEN_BOTH = 3,
+ FULLSCREEN_WAIT = 4,
+ FULLSCREEN_MOVE_WAIT = 8,
+};
+
+
+/* These are in xterm.c, w32term.c, etc. */
+
+extern void x_set_scroll_bar_default_width P_ ((struct frame *));
+extern void x_set_offset P_ ((struct frame *, int, int, int));
+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));
+
+
+/* These are in frame.c */
+
+extern Lisp_Object Vx_resource_name;
+extern Lisp_Object Vx_resource_class;
+
+
+extern Lisp_Object Qface_set_after_frame_default;
+
+extern void x_fullscreen_adjust P_ ((struct frame *f, int *, int *,
+ int *, int *));
+
+extern void x_set_frame_parameters P_ ((struct frame *, Lisp_Object));
+extern void x_report_frame_params P_ ((struct frame *, Lisp_Object *));
+
+extern void x_set_fullscreen P_ ((struct frame *, Lisp_Object, Lisp_Object));
+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_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,
+ Lisp_Object));
+extern void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
+extern void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
+extern void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
+extern void x_set_unsplittable P_ ((struct frame *, Lisp_Object, Lisp_Object));
+extern void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
+ Lisp_Object));
+extern void x_set_scroll_bar_width P_ ((struct frame *, Lisp_Object,
+ Lisp_Object));
+
+extern Lisp_Object x_icon_type P_ ((struct frame *));
+
+extern int x_figure_window_size P_ ((struct frame *, Lisp_Object, int));
+
+
+extern void validate_x_resource_name P_ ((void));
+
+#endif /* HAVE_WINDOW_SYSTEM */
+
#endif /* not EMACS_FRAME_H */
/* Indentation functions.
- Copyright (C) 1985,86,87,88,93,94,95,98, 2000, 2001
+ Copyright (C) 1985,86,87,88,93,94,95,98,2000,01,02,2003
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 "category.h"
#include "indent.h"
#include "keyboard.h"
Some things in set last_known_column_point to -1
to mark the memorized value as invalid. */
-int last_known_column;
+double last_known_column;
/* Value of point when current_column was called. */
int last_known_column_modified;
-static int current_column_1 P_ ((void));
-static int position_indentation P_ ((int));
+static double current_column_1 P_ ((void));
+static double position_indentation P_ ((int));
/* Cache of beginning of line found by the last call of
current_column. */
{
Lisp_Object prop, position, overlay_limit, proplimit;
Lisp_Object buffer;
- int end;
+ int end, inv_p;
XSETFASTINT (position, pos);
XSETBUFFER (buffer, current_buffer);
}
/* if the `invisible' property is set, we can skip to
the next property change */
- if (!NILP (window) && EQ (XWINDOW (window)->buffer, buffer))
- prop = Fget_char_property (position, Qinvisible, window);
- else
- prop = Fget_char_property (position, Qinvisible, buffer);
- if (TEXT_PROP_MEANS_INVISIBLE (prop) > NILP (window))
+ prop = Fget_char_property (position, Qinvisible,
+ (!NILP (window)
+ && EQ (XWINDOW (window)->buffer, buffer))
+ ? window : buffer);
+ inv_p = TEXT_PROP_MEANS_INVISIBLE (prop);
+ /* When counting columns (window == nil), don't skip over ellipsis text. */
+ if (NILP (window) ? inv_p == 1 : inv_p)
return *next_boundary_p;
return pos;
}
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; \
} \
} while (0)
+
DEFUN ("current-column", Fcurrent_column, Scurrent_column, 0, 0, 0,
doc: /* Return the horizontal position of point. Beginning of line is column 0.
This is calculated by adding together the widths of all the displayed
()
{
Lisp_Object temp;
- XSETFASTINT (temp, current_column ());
+ XSETFASTINT (temp, (int) current_column ()); /* iftc */
return temp;
}
last_known_column_point = 0;
}
-int
+double
current_column ()
{
register int col;
/* If the buffer has overlays, text properties,
or multibyte characters, use a more general algorithm. */
if (BUF_INTERVALS (current_buffer)
- || !NILP (current_buffer->overlays_before)
- || !NILP (current_buffer->overlays_after)
+ || current_buffer->overlays_before
+ || current_buffer->overlays_after
|| Z != Z_BYTE)
return current_column_1 ();
{
EMACS_INT i, n;
Lisp_Object charvec;
-
+
if (ptr == stop)
{
/* We stopped either for the beginning of the buffer
or for the gap. */
if (ptr == BEGV_ADDR)
break;
-
+
/* It was the gap. Jump back over it. */
stop = BEGV_ADDR;
ptr = GPT_ADDR;
-
+
/* Check whether that brings us to beginning of buffer. */
if (BEGV >= GPT)
break;
}
c = *--ptr;
-
+
if (dp && VECTORP (DISP_CHAR_VECTOR (dp, c)))
{
charvec = DISP_CHAR_VECTOR (dp, c);
charvec = Qnil;
n = 1;
}
-
+
for (i = n - 1; i >= 0; --i)
{
if (VECTORP (charvec))
/* This should be handled the same as
next_element_from_display_vector does it. */
Lisp_Object entry = AREF (charvec, i);
-
+
if (INTEGERP (entry)
&& GLYPH_CHAR_VALID_P (XFASTINT (entry)))
c = FAST_GLYPH_CHAR (XFASTINT (entry));
else
c = ' ';
}
-
+
if (c >= 040 && c < 0177)
col++;
else if (c == '\n'
{
if (tab_seen)
col = ((col + tab_width) / tab_width) * tab_width;
-
+
post_tab += col;
col = 0;
tab_seen = 1;
This function handles characters that are invisible
due to text properties or overlays. */
-static int
+static double
current_column_1 ()
{
register int tab_width = XINT (current_buffer->tab_width);
/* Start the scan at the beginning of this line with column number 0. */
register int col = 0;
int scan, scan_byte;
- int next_boundary, next_boundary_byte;
+ int next_boundary;
int opoint = PT, opoint_byte = PT_BYTE;
scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, 1);
scan = PT, scan_byte = PT_BYTE;
SET_PT_BOTH (opoint, opoint_byte);
next_boundary = scan;
- next_boundary_byte = scan_byte;
if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
goto endloop;
if (scan != old_scan)
scan_byte = CHAR_TO_BYTE (scan);
- next_boundary_byte = CHAR_TO_BYTE (next_boundary);
}
/* Check composition sequence. */
{
unsigned char *ptr;
int bytes, width, wide_column;
-
+
ptr = BYTE_POS_ADDR (scan_byte);
MULTIBYTE_BYTES_WIDTH (ptr, dp);
scan_byte += bytes;
If BEG is nil, that stands for the beginning of STRING.
If END is nil, that stands for the end of STRING. */
-static int
+static double
string_display_width (string, beg, end)
Lisp_Object string, beg, end;
{
int b, e;
if (NILP (end))
- e = XSTRING (string)->size;
+ e = SCHARS (string);
else
{
CHECK_NUMBER (end);
}
/* Make a pointer for decrementing through the chars before point. */
- ptr = XSTRING (string)->data + e;
+ ptr = SDATA (string) + e;
/* Make a pointer to where consecutive chars leave off,
going backwards from point. */
- stop = XSTRING (string)->data + b;
+ stop = SDATA (string) + b;
if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
}
\f
-static int position_indentation P_ ((int));
+static double position_indentation P_ ((int));
DEFUN ("current-indentation", Fcurrent_indentation, Scurrent_indentation,
0, 0, 0,
scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, 1);
- XSETFASTINT (val, position_indentation (PT_BYTE));
+ XSETFASTINT (val, (int) position_indentation (PT_BYTE)); /* iftc */
SET_PT_BOTH (opoint, opoint_byte);
return val;
}
-static int
+static double
position_indentation (pos_byte)
register int pos_byte;
{
/* The -1 and +1 arrange to point at the first byte of gap
(if STOP_POS_BYTE is the position of the gap)
rather than at the data after the gap. */
-
+
stop = BYTE_POS_ADDR (stop_pos_byte - 1) + 1;
p = BYTE_POS_ADDR (pos_byte);
}
int
indented_beyond_p (pos, pos_byte, column)
- int pos, pos_byte, column;
+ int pos, pos_byte;
+ double column;
{
- int val;
+ double val;
int opoint = PT, opoint_byte = PT_BYTE;
SET_PT_BOTH (pos, pos_byte);
val = position_indentation (PT_BYTE);
SET_PT_BOTH (opoint, opoint_byte);
- return val >= column;
+ return val >= column; /* hmm, float comparison */
}
\f
DEFUN ("move-to-column", Fmove_to_column, Smove_to_column, 1, 2, "p",
Lisp_Object val;
int prev_col = 0;
int c = 0;
- int next_boundary;
-
- int pos_byte, end_byte, next_boundary_byte;
+ int next_boundary, pos_byte;
if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
CHECK_NATNUM (column);
pos = PT;
pos_byte = PT_BYTE;
end = ZV;
- end_byte = ZV_BYTE;
next_boundary = pos;
- next_boundary_byte = PT_BYTE;
/* If we're starting past the desired column,
back up to beginning of line and scan from there. */
pos = skip_invisible (pos, &next_boundary, end, Qnil);
if (pos != prev)
pos_byte = CHAR_TO_BYTE (pos);
- next_boundary_byte = CHAR_TO_BYTE (next_boundary);
if (pos >= end)
goto endloop;
}
goal_pt_byte = PT_BYTE;
Findent_to (make_number (col), Qnil);
SET_PT_BOTH (goal_pt, goal_pt_byte);
-
+
/* Set the last_known... vars consistently. */
col = goal;
}
window_width - 1
- (has_vertical_scroll_bars
- ? FRAME_SCROLL_BAR_COLS (XFRAME (window->frame))
- : (window_width + window_left != frame_width))
+ ? WINDOW_CONFIG_SCROLL_BAR_COLS (window)
+ : (window_width + window_left != frame_cols))
where
- window_width is XFASTINT (w->width),
- window_left is XFASTINT (w->left),
+ window_width is XFASTINT (w->total_cols),
+ window_left is XFASTINT (w->left_col),
has_vertical_scroll_bars is
- FRAME_HAS_VERTICAL_SCROLL_BARS (XFRAME (WINDOW_FRAME (window)))
- and frame_width = FRAME_WIDTH (XFRAME (window->frame))
+ WINDOW_HAS_VERTICAL_SCROLL_BAR (window)
+ and frame_cols = FRAME_COLS (XFRAME (window->frame))
- Or you can let window_internal_width do this all for you, and write:
- window_internal_width (w) - 1
+ Or you can let window_box_text_cols do this all for you, and write:
+ window_box_text_cols (w) - 1
The `-1' accounts for the continuation-line backslashes; the rest
accounts for window borders if the window is split horizontally, and
W_ ^---- next after the point
^---- next char. after the point.
----------
- In case of wide-column character
+ In case of wide-column character
The problem here is continuation at a wide-column character.
In this case, the line may shorter less than WIDTH.
{
if (hscroll
|| (truncate_partial_width_windows
- && width + 1 < FRAME_WIDTH (XFRAME (WINDOW_FRAME (win))))
+ && width + 1 < FRAME_COLS (XFRAME (WINDOW_FRAME (win))))
|| !NILP (current_buffer->truncate_lines))
{
/* Truncating: skip to newline, unless we are already past
{
EMACS_INT i, n;
Lisp_Object charvec;
-
+
c = FETCH_BYTE (pos_byte);
/* Check composition sequence. */
/* This should be handled the same as
next_element_from_display_vector does it. */
Lisp_Object entry = AREF (charvec, i);
-
+
if (INTEGERP (entry)
&& GLYPH_CHAR_VALID_P (XFASTINT (entry)))
c = FAST_GLYPH_CHAR (XFASTINT (entry));
else
c = ' ';
}
-
+
if (c >= 040 && c < 0177)
hpos++;
else if (c == '\t')
else if (c == '\n')
{
if (selective > 0
- && indented_beyond_p (pos, pos_byte, selective))
+ && indented_beyond_p (pos, pos_byte,
+ (double) selective)) /* iftc */
{
/* If (pos == to), we don't have to take care of
selective display. */
pos_byte = CHAR_TO_BYTE (pos);
}
while (pos < to
- && indented_beyond_p (pos, pos_byte, selective));
+ && indented_beyond_p (pos, pos_byte,
+ (double) selective)); /* iftc */
/* Allow for the " ..." that is displayed for them. */
if (selective_rlen)
{
register int from, vtarget;
struct window *w;
{
- int width = window_internal_width (w) - 1;
+ /* We don't need to make room for continuation marks (we have fringes now),
+ so hould we really subtract 1 here if FRAME_WINDOW_P ? ++KFS */
+ int width = window_box_text_cols (w) - 1;
int hscroll = XINT (w->hscroll);
struct position pos;
/* vpos is cumulative vertical position, changed as from is changed */
&& ((selective > 0
&& indented_beyond_p (XFASTINT (prevline),
CHAR_TO_BYTE (XFASTINT (prevline)),
- selective))
+ (double) selective)) /* iftc */
/* watch out for newlines with `invisible' property */
|| (propval = Fget_char_property (prevline,
Qinvisible,
lmargin + (XFASTINT (prevline) == BEG
? start_hpos : 0),
0,
- from,
+ from,
/* Don't care for VPOS... */
1 << (BITS_PER_SHORT - 1),
/* ... nor HPOS. */
&& ((selective > 0
&& indented_beyond_p (XFASTINT (prevline),
CHAR_TO_BYTE (XFASTINT (prevline)),
- selective))
+ (double) selective)) /* iftc */
/* watch out for newlines with `invisible' property */
|| (propval = Fget_char_property (prevline, Qinvisible,
text_prop_object),
lmargin + (XFASTINT (prevline) == BEG
? start_hpos : 0),
0,
- from,
+ from,
/* Don't care for VPOS... */
1 << (BITS_PER_SHORT - 1),
/* ... nor HPOS. */
old_buffer = w->buffer;
XSETBUFFER (w->buffer, current_buffer);
}
-
+
SET_TEXT_POS (pt, PT, PT_BYTE);
start_display (&it, w, pt);
- move_it_by_lines (&it, XINT (lines), 0);
+
+ /* Move to the start of the display line containing PT. If we don't
+ do this, we start moving with IT->current_x == 0, while PT is
+ really at some x > 0. The effect is, in continuation lines, that
+ we end up with the iterator placed at where it thinks X is 0,
+ while the end position is really at some X > 0, the same X that
+ PT had. */
+ move_it_by_lines (&it, 0, 0);
+
+ if (XINT (lines) != 0)
+ move_it_by_lines (&it, XINT (lines), 0);
+
SET_PT_BOTH (IT_CHARPOS (it), IT_BYTEPOS (it));
if (BUFFERP (old_buffer))
w->buffer = old_buffer;
-
+
RETURN_UNGCPRO (make_number (it.vpos));
}
/* Buffer insertion/deletion and gap motion for GNU Emacs.
- Copyright (C) 1985, 86,93,94,95,97,98, 1999, 2000, 2001
+ Copyright (C) 1985, 86,93,94,95,97,98, 1999, 2000, 01, 2003
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"
void
check_markers ()
{
- register Lisp_Object tail;
+ register struct Lisp_Marker *tail;
int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
- tail = BUF_MARKERS (current_buffer);
-
- while (! NILP (tail))
+ for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
{
- if (XMARKER (tail)->buffer->text != current_buffer->text)
+ if (tail->buffer->text != current_buffer->text)
abort ();
- if (XMARKER (tail)->charpos > Z)
+ if (tail->charpos > Z)
abort ();
- if (XMARKER (tail)->bytepos > Z_BYTE)
+ if (tail->bytepos > Z_BYTE)
abort ();
- if (multibyte && ! CHAR_HEAD_P (FETCH_BYTE (XMARKER (tail)->bytepos)))
+ if (multibyte && ! CHAR_HEAD_P (FETCH_BYTE (tail->bytepos)))
abort ();
-
- tail = XMARKER (tail)->chain;
}
}
\f
register struct Lisp_Marker *m;
register int charpos;
- marker = BUF_MARKERS (current_buffer);
-
- while (!NILP (marker))
+ for (m = BUF_MARKERS (current_buffer); m; m = m->next)
{
- m = XMARKER (marker);
charpos = m->charpos;
if (charpos > Z)
else if (charpos > from)
{
if (! m->insertion_type)
- /* Normal markers will end up at the beginning of the
+ { /* Normal markers will end up at the beginning of the
re-inserted text after undoing a deletion, and must be
- adjusted to move them to the correct place. */
+ adjusted to move them to the correct place. */
+ XSETMISC (marker, m);
record_marker_adjustment (marker, from - charpos);
+ }
else if (charpos < to)
- /* Before-insertion markers will automatically move forward
+ { /* Before-insertion markers will automatically move forward
upon re-inserting the deleted text, so we have to arrange
for them to move backward to the correct position. */
+ XSETMISC (marker, m);
record_marker_adjustment (marker, charpos - to);
-
+ }
m->charpos = from;
m->bytepos = from_byte;
}
incorrectly make MARKER move forward, so we arrange for it
to then move backward to the correct place at the beginning
of the deleted region. */
+ XSETMISC (marker, m);
record_marker_adjustment (marker, to - from);
}
-
- marker = m->chain;
}
}
register int from, from_byte, to, to_byte;
int before_markers;
{
- Lisp_Object marker;
+ struct Lisp_Marker *m;
int adjusted = 0;
int nchars = to - from;
int nbytes = to_byte - from_byte;
- marker = BUF_MARKERS (current_buffer);
-
- while (!NILP (marker))
+ for (m = BUF_MARKERS (current_buffer); m; m = m->next)
{
- register struct Lisp_Marker *m = XMARKER (marker);
-
/* In a single-byte buffer, a marker's two positions must be
equal. */
if (Z == Z_BYTE)
m->bytepos += nbytes;
m->charpos += nchars;
}
-
- marker = m->chain;
}
/* Adjusting only markers whose insertion-type is t may result in
new_chars, new_bytes)
int from, from_byte, old_chars, old_bytes, new_chars, new_bytes;
{
- Lisp_Object marker = BUF_MARKERS (current_buffer);
+ register struct Lisp_Marker *m;
int prev_to_byte = from_byte + old_bytes;
int diff_chars = new_chars - old_chars;
int diff_bytes = new_bytes - old_bytes;
- while (!NILP (marker))
+ for (m = BUF_MARKERS (current_buffer); m; m = m->next)
{
- register struct Lisp_Marker *m = XMARKER (marker);
-
if (m->bytepos >= prev_to_byte)
{
m->charpos += diff_chars;
m->charpos = from;
m->bytepos = from_byte;
}
-
- marker = m->chain;
}
CHECK_MARKERS ();
That won't work because so many places use `int'.
Make sure we don't introduce overflows in the calculation. */
-
+
if (Z_BYTE - BEG_BYTE + GAP_SIZE
>= (((EMACS_INT) 1 << (min (VALBITS, BITS_PER_INT) - 1)) - 1
- nbytes_added))
}
-/* Make the gap NBYTES_REMOVED bytes shorted. */
+/* Make the gap NBYTES_REMOVED bytes shorter. */
void
make_gap_smaller (nbytes_removed)
int
copy_text (from_addr, to_addr, nbytes,
from_multibyte, to_multibyte)
- unsigned char *from_addr;
+ const unsigned char *from_addr;
unsigned char *to_addr;
int nbytes;
int from_multibyte, to_multibyte;
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;
int
count_size_as_multibyte (ptr, nbytes)
- unsigned char *ptr;
+ const unsigned char *ptr;
int nbytes;
{
int i;
void
insert (string, nbytes)
- register unsigned char *string;
+ register const unsigned char *string;
register int nbytes;
{
if (nbytes > 0)
void
insert_and_inherit (string, nbytes)
- register unsigned char *string;
+ register const unsigned char *string;
register int nbytes;
{
if (nbytes > 0)
void
insert_string (s)
- char *s;
+ const char *s;
{
insert (s, strlen (s));
}
void
insert_before_markers (string, nbytes)
- unsigned char *string;
+ const unsigned char *string;
register int nbytes;
{
if (nbytes > 0)
void
insert_before_markers_and_inherit (string, nbytes)
- unsigned char *string;
+ const unsigned char *string;
register int nbytes;
{
if (nbytes > 0)
void
insert_1 (string, nbytes, inherit, prepare, before_markers)
- register unsigned char *string;
+ register const unsigned char *string;
register int nbytes;
int inherit, prepare, before_markers;
{
int
count_combining_before (string, length, pos, pos_byte)
- unsigned char *string;
+ const unsigned char *string;
int length;
int pos, pos_byte;
{
int len, combining_bytes;
- unsigned char *p;
+ const unsigned char *p;
if (NILP (current_buffer->enable_multibyte_characters))
return 0;
int
count_combining_after (string, length, pos, pos_byte)
- unsigned char *string;
+ const unsigned char *string;
int length;
int pos, pos_byte;
{
void
insert_1_both (string, nchars, nbytes, inherit, prepare, before_markers)
- register unsigned char *string;
+ register const unsigned char *string;
register int nchars, nbytes;
int inherit, prepare, before_markers;
{
if (nchars == 0)
return;
-
+
if (NILP (current_buffer->enable_multibyte_characters))
nchars = nbytes;
if (GPT_BYTE < GPT)
abort ();
+ /* The insert may have been in the unchanged region, so check again. */
+ if (Z - GPT < END_UNCHANGED)
+ END_UNCHANGED = Z - GPT;
+
adjust_overlays_for_insert (PT, nchars);
adjust_markers_for_insert (PT, PT_BYTE,
PT + nchars, PT_BYTE + 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);
- adjust_markers_for_insert (GPT, GPT_BYTE,
- GPT + nchars, GPT_BYTE + nbytes,
- 0);
-
- if (BUF_INTERVALS (current_buffer) != 0)
- offset_intervals (current_buffer, GPT, nchars);
-
- if (GPT - nchars < PT)
- adjust_point (nchars, nbytes);
-
- CHECK_MARKERS ();
-}
-\f
/* Insert the part of the text of STRING, a Lisp object assumed to be
of type string, consisting of the LENGTH characters (LENGTH_BYTE bytes)
starting at position POS / POS_BYTE. If the text of STRING has properties,
outgoing_nbytes = nchars;
else if (! STRING_MULTIBYTE (string))
outgoing_nbytes
- = count_size_as_multibyte (&XSTRING (string)->data[pos_byte],
+ = count_size_as_multibyte (SDATA (string) + pos_byte,
nbytes);
GCPRO1 (string);
/* Copy the string text into the buffer, perhaps converting
between single-byte and multibyte. */
- copy_text (XSTRING (string)->data + pos_byte, GPT_ADDR, nbytes,
+ copy_text (SDATA (string) + pos_byte, GPT_ADDR, nbytes,
STRING_MULTIBYTE (string),
! NILP (current_buffer->enable_multibyte_characters));
if (GPT_BYTE < GPT)
abort ();
+ /* The insert may have been in the unchanged region, so check again. */
+ if (Z - GPT < END_UNCHANGED)
+ END_UNCHANGED = Z - GPT;
+
adjust_overlays_for_insert (PT, nchars);
adjust_markers_for_insert (PT, PT_BYTE, PT + nchars,
PT_BYTE + outgoing_nbytes,
offset_intervals (current_buffer, PT, nchars);
- intervals = XSTRING (string)->intervals;
+ intervals = STRING_INTERVALS (string);
/* Get the intervals for the part of the string we are inserting. */
- if (nbytes < STRING_BYTES (XSTRING (string)))
+ if (nbytes < SBYTES (string))
intervals = copy_intervals (intervals, pos, nchars);
-
+
/* Insert those intervals. */
graft_intervals_into_buffer (intervals, PT, nchars,
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);
++ adjust_markers_for_insert (GPT, GPT_BYTE,
++ GPT + nchars, GPT_BYTE + nbytes,
++ 0);
++
++ if (BUF_INTERVALS (current_buffer) != 0)
++ offset_intervals (current_buffer, GPT, nchars);
++
++ if (GPT - nchars < PT)
++ adjust_point (nchars, nbytes);
++
++ CHECK_MARKERS ();
}
\f
/* Insert text from BUF, NCHARS characters starting at CHARPOS, into the
if (chunk < incoming_nbytes)
outgoing_after_gap
- = count_size_as_multibyte (BUF_BYTE_ADDRESS (buf,
+ = count_size_as_multibyte (BUF_BYTE_ADDRESS (buf,
from_byte + chunk),
incoming_nbytes - chunk);
outgoing_nbytes = outgoing_before_gap + outgoing_after_gap;
}
-
+
/* Make sure point-max won't overflow after this insertion. */
XSETINT (temp, outgoing_nbytes + Z);
if (outgoing_nbytes + Z != XINT (temp))
if (GPT_BYTE < GPT)
abort ();
+ /* The insert may have been in the unchanged region, so check again. */
+ if (Z - GPT < END_UNCHANGED)
+ END_UNCHANGED = Z - GPT;
+
adjust_overlays_for_insert (PT, nchars);
adjust_markers_for_insert (PT, PT_BYTE, PT + nchars,
PT_BYTE + outgoing_nbytes,
from += nchars;
intervals = copy_intervals (intervals, from, nchars);
}
-
+
/* Insert those intervals. */
graft_intervals_into_buffer (intervals, PT, nchars, current_buffer, inherit);
if (STRINGP (prev_text))
{
- nchars_del = XSTRING (prev_text)->size;
- nbytes_del = STRING_BYTES (XSTRING (prev_text));
+ nchars_del = SCHARS (prev_text);
+ nbytes_del = SBYTES (prev_text);
}
/* Update various buffer positions for the new text. */
Lisp_Object new;
int from, to, prepare, inherit, markers;
{
- int inschars = XSTRING (new)->size;
- int insbytes = STRING_BYTES (XSTRING (new));
+ int inschars = SCHARS (new);
+ int insbytes = SBYTES (new);
int from_byte, to_byte;
int nbytes_del, nchars_del;
register Lisp_Object temp;
outgoing_insbytes = inschars;
else if (! STRING_MULTIBYTE (new))
outgoing_insbytes
- = count_size_as_multibyte (XSTRING (new)->data, insbytes);
+ = count_size_as_multibyte (SDATA (new), insbytes);
/* Make sure point-max won't overflow after this insertion. */
XSETINT (temp, Z_BYTE - nbytes_del + insbytes);
/* Copy the string text into the buffer, perhaps converting
between single-byte and multibyte. */
- copy_text (XSTRING (new)->data, GPT_ADDR, insbytes,
+ copy_text (SDATA (new), GPT_ADDR, insbytes,
STRING_MULTIBYTE (new),
! NILP (current_buffer->enable_multibyte_characters));
/* Get the intervals for the part of the string we are inserting--
not including the combined-before bytes. */
- intervals = XSTRING (new)->intervals;
+ intervals = STRING_INTERVALS (new);
/* Insert those intervals. */
graft_intervals_into_buffer (intervals, from, inschars,
current_buffer, inherit);
GCPRO1 (preserve_marker);
verify_interval_modification (current_buffer, start, end);
*preserve_ptr = marker_position (preserve_marker);
- unchain_marker (preserve_marker);
+ unchain_marker (XMARKER (preserve_marker));
UNGCPRO;
}
else
if (! NILP (preserve_marker)) \
{ \
*preserve_ptr = marker_position (preserve_marker); \
- unchain_marker (preserve_marker); \
+ unchain_marker (XMARKER (preserve_marker)); \
}
#define PRESERVE_START_END \
UNGCPRO;
}
- if (!NILP (current_buffer->overlays_before)
- || !NILP (current_buffer->overlays_after))
+ if (current_buffer->overlays_before || current_buffer->overlays_after)
{
PRESERVE_VALUE;
report_overlay_modification (FETCH_START, FETCH_END, 0,
just record the args that we were going to use. */
if (! NILP (Vcombine_after_change_calls)
&& NILP (Vbefore_change_functions)
- && NILP (current_buffer->overlays_before)
- && NILP (current_buffer->overlays_after))
+ && !current_buffer->overlays_before
+ && !current_buffer->overlays_after)
{
Lisp_Object elt;
return;
}
- if (!NILP (combine_after_change_list))
+ if (!NILP (combine_after_change_list))
Fcombine_after_change_execute ();
if (!NILP (Vafter_change_functions))
UNGCPRO;
}
- if (!NILP (current_buffer->overlays_before)
- || !NILP (current_buffer->overlays_after))
+ if (current_buffer->overlays_before || current_buffer->overlays_after)
report_overlay_modification (make_number (charpos),
make_number (charpos + lenins),
1,
doc: /* This function is for use internally in `combine-after-change-calls'. */)
()
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int beg, end, change;
int begpos, endpos;
Lisp_Object tail;
that was changed. */
begpos = BEG + beg;
endpos = Z - end;
-
+
/* We are about to handle these, so discard them. */
combine_after_change_list = Qnil;
/* Keyboard and mouse input; editor command loop.
- Copyright (C) 1985,86,87,88,89,93,94,95,96,97,99, 2000, 2001
+ Copyright (C) 1985,86,87,88,89,93,94,95,96,97,99,2000,01,02,03
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"
#include "w32term.h"
#endif /* HAVE_NTGUI */
-#ifdef macintosh
+#ifdef MAC_OS
#include "macterm.h"
#endif
#ifdef HAVE_WINDOW_SYSTEM
/* Make all keyboard buffers much bigger when using X windows. */
-#ifdef macintosh
-/* But not too big (local data > 32K error) if on macintosh. */
+#ifdef MAC_OS8
+/* But not too big (local data > 32K error) if on Mac OS Classic. */
#define KBD_BUFFER_SIZE 512
#else
#define KBD_BUFFER_SIZE 4096
Lisp_Object this_command_keys;
int this_command_key_count;
+/* 1 after calling Freset_this_command_lengths.
+ Usually it is 0. */
+int this_command_key_count_reset;
+
/* This vector is used as a buffer to record the events that were actually read
by read_key_sequence. */
Lisp_Object raw_keybuf;
before this command was read. */
static int before_command_key_count;
static int before_command_echo_length;
-/* Values of before_command_key_count and before_command_echo_length
- saved by reset-this-command-lengths. */
-static int before_command_key_count_1;
-static int before_command_echo_length_1;
-/* Flag set by reset-this-command-lengths,
- saying to reset the lengths when add_command_key is called. */
-static int before_command_restore_flag;
extern int minbuf_level;
int command_loop_level;
/* Total number of times command_loop has read a key sequence. */
-int num_input_keys;
+EMACS_INT num_input_keys;
/* Last input character read as a command. */
Lisp_Object last_command_char;
Lisp_Object Vunread_post_input_method_events;
/* If not -1, an event to be read as subsequent command input. */
-int unread_command_char;
+EMACS_INT unread_command_char;
/* If not Qnil, this is a switch-frame event which we decided to put
off until the end of a key sequence. This should be read as the
Lisp_Object unread_switch_frame;
/* A mask of extra modifier bits to put into every keyboard char. */
-int extra_keyboard_modifiers;
+EMACS_INT extra_keyboard_modifiers;
/* Char to use as prefix when a meta character is typed in.
This is bound on entry to minibuffer in case ESC is changed there. */
int num_input_events;
/* Total number of times read_char has returned, outside of macros. */
-int num_nonmacro_input_events;
+EMACS_INT num_nonmacro_input_events;
/* Auto-save automatically when this many characters have been typed
since the last time. */
-static int auto_save_interval;
+static EMACS_INT auto_save_interval;
/* Value of num_nonmacro_input_events as of last auto save. */
/* Form to evaluate (if non-nil) when Emacs is started. */
Lisp_Object Vtop_level;
-/* User-supplied string to translate input characters through. */
+/* User-supplied table to translate input characters. */
Lisp_Object Vkeyboard_translate_table;
/* Keymap mapping ASCII function key sequences onto their preferred forms. */
Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
/* Delay time in microseconds before running post-command-idle-hook. */
-int post_command_idle_delay;
+EMACS_INT post_command_idle_delay;
/* List of deferred actions to be performed at a later time.
The precise format isn't relevant here; we just check whether it is nil. */
queue. That way, they'll be dequeued as dead frames or windows,
but still valid Lisp objects.
- If kbd_buffer[i].kind != no_event, then
+ If kbd_buffer[i].kind != NO_EVENT, then
AREF (kbd_buffer_gcpro, 2 * i) == kbd_buffer[i].frame_or_window.
AREF (kbd_buffer_gcpro, 2 * i + 1) == kbd_buffer[i].arg. */
Lisp_Object Qdelete_frame;
Lisp_Object Qiconify_frame;
Lisp_Object Qmake_frame_visible;
+Lisp_Object Qselect_window;
Lisp_Object Qhelp_echo;
/* Symbols to denote kinds of events. */
Lisp_Object Qfunction_key;
Lisp_Object Qmouse_click;
#ifdef WINDOWSNT
-Lisp_Object Qmouse_wheel;
Lisp_Object Qlanguage_change;
#endif
Lisp_Object Qdrag_n_drop;
+Lisp_Object Qsave_session;
+
/* Lisp_Object Qmouse_movement; - also an event header */
/* Properties of event headers. */
Lisp_Object Qvertical_line;
Lisp_Object Qvertical_scroll_bar;
Lisp_Object Qmenu_bar;
+extern Lisp_Object Qleft_margin, Qright_margin;
Lisp_Object recursive_edit_unwind (), command_loop ();
Lisp_Object Fthis_command_keys ();
Lisp_Object Qextended_command_history;
EMACS_TIME timer_check ();
-extern Lisp_Object Vhistory_length;
+extern Lisp_Object Vhistory_length, Vtranslation_table_for_input;
extern char *x_get_keysym_name ();
static void record_menu_key ();
+static int echo_length ();
Lisp_Object Qpolling_period;
/* If we support a window system, turn on the code to poll periodically
to detect C-g. It isn't actually used when doing interrupt input. */
-#ifdef HAVE_WINDOW_SYSTEM
+#if defined(HAVE_WINDOW_SYSTEM) && !defined(USE_ASYNC_EVENTS)
#define POLL_FOR_INPUT
#endif
/* After a command is executed, if point is moved into a region that
has specific properties (e.g. composition, display), we adjust
point to the boundary of the region. But, if a command sets this
- valiable to non-nil, we suppress this point adjustment. This
+ variable to non-nil, we suppress this point adjustment. This
variable is set to nil before reading a command. */
Lisp_Object Vdisable_point_adjustment;
static EMACS_TIME timer_idleness_start_time;
+/* After Emacs stops being idle, this saves the last value
+ of timer_idleness_start_time from when it was idle. */
+
+static EMACS_TIME timer_last_idleness_start_time;
+
\f
/* Global variable declarations. */
static int read_avail_input P_ ((int));
static void get_input_pending P_ ((int *, int));
+static void get_filtered_input_pending P_ ((int *, int, int));
static int readable_events P_ ((int));
+static int readable_filtered_events P_ ((int, int));
static Lisp_Object read_char_x_menu_prompt P_ ((int, Lisp_Object *,
Lisp_Object, int *));
static Lisp_Object read_char_x_menu_prompt ();
static Lisp_Object apply_modifiers P_ ((int, Lisp_Object));
static void clear_event P_ ((struct input_event *));
static void any_kboard_state P_ ((void));
+static SIGTYPE interrupt_signal P_ ((int signalnum));
/* Nonzero means don't try to suspend even if the operating system seems
to support it. */
echo_prompt (str)
Lisp_Object str;
{
- int nbytes = STRING_BYTES (XSTRING (str));
- int multibyte_p = STRING_MULTIBYTE (str);
-
- if (nbytes > ECHOBUFSIZE - 4)
- {
- if (multibyte_p)
- {
- /* Have to find the last character that fit's into the
- echo buffer. */
- unsigned char *p = XSTRING (str)->data;
- unsigned char *pend = p + ECHOBUFSIZE - 4;
- int char_len;
-
- do
- {
- PARSE_MULTIBYTE_SEQ (p, pend - p, char_len);
- p += char_len;
- }
- while (p < pend);
-
- nbytes = p - XSTRING (str)->data - char_len;
- }
- else
- nbytes = ECHOBUFSIZE - 4;
- }
-
- nbytes = copy_text (XSTRING (str)->data, current_kboard->echobuf, nbytes,
- STRING_MULTIBYTE (str), 1);
- current_kboard->echoptr = current_kboard->echobuf + nbytes;
- *current_kboard->echoptr = '\0';
- current_kboard->echo_after_prompt = nbytes;
-
+ current_kboard->echo_string = str;
+ current_kboard->echo_after_prompt = SCHARS (str);
echo_now ();
}
{
if (current_kboard->immediate_echo)
{
- char *ptr = current_kboard->echoptr;
+ int size = KEY_DESCRIPTION_SIZE + 100;
+ char *buffer = (char *) alloca (size);
+ char *ptr = buffer;
+ Lisp_Object echo_string;
- if (ptr != current_kboard->echobuf)
- *ptr++ = ' ';
+ echo_string = current_kboard->echo_string;
/* If someone has passed us a composite event, use its head symbol. */
c = EVENT_HEAD (c);
if (INTEGERP (c))
{
- int ch = XINT (c);
-
- if (ptr - current_kboard->echobuf
- > ECHOBUFSIZE - KEY_DESCRIPTION_SIZE)
- return;
-
- ptr = push_key_description (ch, ptr, 1);
+ ptr = push_key_description (XINT (c), ptr, 1);
}
else if (SYMBOLP (c))
{
- struct Lisp_String *name = XSYMBOL (c)->name;
- if ((ptr - current_kboard->echobuf) + STRING_BYTES (name) + 4
- > ECHOBUFSIZE)
- return;
- ptr += copy_text (name->data, ptr, STRING_BYTES (name),
- name->size_byte >= 0, 1);
+ Lisp_Object name = SYMBOL_NAME (c);
+ int nbytes = SBYTES (name);
+
+ if (size - (ptr - buffer) < nbytes)
+ {
+ int offset = ptr - buffer;
+ size = max (2 * size, size + nbytes);
+ buffer = (char *) alloca (size);
+ ptr = buffer + offset;
+ }
+
+ ptr += copy_text (SDATA (name), ptr, nbytes,
+ STRING_MULTIBYTE (name), 1);
}
- if (current_kboard->echoptr == current_kboard->echobuf
+ if ((NILP (echo_string) || SCHARS (echo_string) == 0)
&& help_char_p (c))
{
- strcpy (ptr, " (Type ? for further options)");
- ptr += strlen (ptr);
+ const char *text = " (Type ? for further options)";
+ int len = strlen (text);
+
+ if (size - (ptr - buffer) < len)
+ {
+ int offset = ptr - buffer;
+ size += len;
+ buffer = (char *) alloca (size);
+ ptr = buffer + offset;
+ }
+
+ bcopy (text, ptr, len);
+ ptr += len;
}
- *ptr = 0;
- current_kboard->echoptr = ptr;
+ /* Replace a dash from echo_dash with a space, otherwise
+ add a space at the end as a separator between keys. */
+ if (STRINGP (echo_string)
+ && SCHARS (echo_string) > 1)
+ {
+ Lisp_Object last_char, prev_char, idx;
+
+ idx = make_number (SCHARS (echo_string) - 2);
+ prev_char = Faref (echo_string, idx);
+
+ idx = make_number (SCHARS (echo_string) - 1);
+ last_char = Faref (echo_string, idx);
+
+ /* We test PREV_CHAR to make sure this isn't the echoing
+ of a minus-sign. */
+ if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
+ Faset (echo_string, idx, make_number (' '));
+ else
+ echo_string = concat2 (echo_string, build_string (" "));
+ }
+
+ current_kboard->echo_string
+ = concat2 (echo_string, make_string (buffer, ptr - buffer));
echo_now ();
}
void
echo_dash ()
{
+ /* Do nothing if not echoing at all. */
+ if (NILP (current_kboard->echo_string))
+ return;
+
if (!current_kboard->immediate_echo
- && current_kboard->echoptr == current_kboard->echobuf)
+ && SCHARS (current_kboard->echo_string) == 0)
return;
+
/* Do nothing if we just printed a prompt. */
if (current_kboard->echo_after_prompt
- == current_kboard->echoptr - current_kboard->echobuf)
- return;
- /* Do nothing if not echoing at all. */
- if (current_kboard->echoptr == 0)
+ == SCHARS (current_kboard->echo_string))
return;
/* Put a dash at the end of the buffer temporarily,
but make it go away when the next character is added. */
- current_kboard->echoptr[0] = '-';
- current_kboard->echoptr[1] = 0;
-
+ current_kboard->echo_string = concat2 (current_kboard->echo_string,
+ build_string ("-"));
echo_now ();
}
for (i = 0; i < this_command_key_count; i++)
{
Lisp_Object c;
+
+ /* Set before_command_echo_length to the value that would
+ have been saved before the start of this subcommand in
+ command_loop_1, if we had already been echoing then. */
+ if (i == this_single_command_key_start)
+ before_command_echo_length = echo_length ();
+
c = XVECTOR (this_command_keys)->contents[i];
if (! (EVENT_HAS_PARAMETERS (c)
&& EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
echo_char (c);
}
+
+ /* Set before_command_echo_length to the value that would
+ have been saved before the start of this subcommand in
+ command_loop_1, if we had already been echoing then. */
+ if (this_command_key_count == this_single_command_key_start)
+ before_command_echo_length = echo_length ();
+
+ /* Put a dash at the end to invite the user to type more. */
echo_dash ();
}
echoing = 1;
- message2_nolog (current_kboard->echobuf, strlen (current_kboard->echobuf),
- 1);
+ message3_nolog (current_kboard->echo_string,
+ SBYTES (current_kboard->echo_string),
+ STRING_MULTIBYTE (current_kboard->echo_string));
echoing = 0;
/* Record in what buffer we echoed, and from which kboard. */
cancel_echoing ()
{
current_kboard->immediate_echo = 0;
- current_kboard->echoptr = current_kboard->echobuf;
current_kboard->echo_after_prompt = -1;
+ current_kboard->echo_string = Qnil;
ok_to_echo_at_next_pause = NULL;
echo_kboard = NULL;
echo_message_buffer = Qnil;
static int
echo_length ()
{
- return current_kboard->echoptr - current_kboard->echobuf;
+ return (STRINGP (current_kboard->echo_string)
+ ? SCHARS (current_kboard->echo_string)
+ : 0);
}
/* Truncate the current echo message to its first LEN chars.
switches frames while entering a key sequence. */
static void
-echo_truncate (len)
- int len;
+echo_truncate (nchars)
+ int nchars;
{
- current_kboard->echobuf[len] = '\0';
- current_kboard->echoptr = current_kboard->echobuf + len;
- truncate_echo_area (len);
+ if (STRINGP (current_kboard->echo_string))
+ current_kboard->echo_string
+ = Fsubstring (current_kboard->echo_string,
+ make_number (0), make_number (nchars));
+ truncate_echo_area (nchars);
}
\f
add_command_key (key)
Lisp_Object key;
{
+#if 0 /* Not needed after we made Freset_this_command_lengths
+ do the job immediately. */
/* If reset-this-command-length was called recently, obey it now.
See the doc string of that function for an explanation of why. */
if (before_command_restore_flag)
echo_truncate (before_command_echo_length_1);
before_command_restore_flag = 0;
}
+#endif
if (this_command_key_count >= ASIZE (this_command_keys))
this_command_keys = larger_vector (this_command_keys,
Lisp_Object
recursive_edit_1 ()
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object val;
if (command_loop_level > 0)
This function is called by the editor initialization to begin editing. */)
()
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object buffer;
command_loop_level++;
{
if (BUFFERP (XCAR (info)))
Fset_buffer (XCAR (info));
-
+
if (NILP (XCDR (info)))
any_kboard_state ();
else
single_kboard_state ();
-
+
command_loop_level--;
update_mode_lines = 1;
return Qnil;
Lisp_Object old_level, old_length;
char macroerror[50];
+#ifdef HAVE_X_WINDOWS
+ if (display_hourglass_p)
+ cancel_hourglass ();
+#endif
+
if (!NILP (executing_macro))
{
if (executing_macro_iterations == 1)
else
{
Fdiscard_input ();
+ message_log_maybe_newline ();
bitch_at_user ();
stream = Qt;
}
- if (context != 0)
- write_string_1 (context, -1, stream);
+ /* The immediate context is not interesting for Quits,
+ since they are asyncronous. */
+ if (EQ (XCAR (data), Qquit))
+ Vsignaling_function = Qnil;
- print_error_message (data, stream);
+ print_error_message (data, stream, context, Vsignaling_function);
+
+ Vsignaling_function = Qnil;
/* If the window system or terminal frame hasn't been initialized
yet, or we're in -batch mode, this error should cause Emacs to exit. */
/* Here we catch errors in execution of commands within the
editing loop, and reenter the editing loop.
When there is an error, cmd_error runs and returns a non-nil
- value to us. A value of nil means that cmd_loop_1 itself
+ value to us. A value of nil means that command_loop_1 itself
returned due to end of file (or end of kbd macro). */
Lisp_Object
static int read_key_sequence P_ ((Lisp_Object *, int, Lisp_Object,
int, int, int));
void safe_run_hooks P_ ((Lisp_Object));
-static void adjust_point_for_property P_ ((int));
+static void adjust_point_for_property P_ ((int, int));
+
+/* Cancel hourglass from protect_unwind.
+ ARG is not used. */
+#ifdef HAVE_X_WINDOWS
+static Lisp_Object
+cancel_hourglass_unwind (arg)
+ Lisp_Object arg;
+{
+ cancel_hourglass ();
+}
+#endif
Lisp_Object
command_loop_1 ()
#ifdef MULTI_KBOARD
int was_locked = single_kboard;
#endif
+ int already_adjusted;
current_kboard->Vprefix_arg = Qnil;
current_kboard->Vlast_prefix_arg = Qnil;
nonundocount = 0;
this_command_key_count = 0;
+ this_command_key_count_reset = 0;
this_single_command_key_start = 0;
- /* Make sure this hook runs after commands that get errors and
- throw to top level. */
- /* Note that the value cell will never directly contain nil
- if the symbol is a local variable. */
- if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
- safe_run_hooks (Qpost_command_hook);
+ if (NILP (Vmemory_full))
+ {
+ /* Make sure this hook runs after commands that get errors and
+ throw to top level. */
+ /* Note that the value cell will never directly contain nil
+ if the symbol is a local variable. */
+ if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
+ safe_run_hooks (Qpost_command_hook);
- /* If displaying a message, resize the echo area window to fit
- that message's size exactly. */
- if (!NILP (echo_area_buffer[0]))
- resize_echo_area_exactly ();
+ /* If displaying a message, resize the echo area window to fit
+ that message's size exactly. */
+ if (!NILP (echo_area_buffer[0]))
+ resize_echo_area_exactly ();
- if (!NILP (Vdeferred_action_list))
- call0 (Vdeferred_action_function);
+ if (!NILP (Vdeferred_action_list))
+ call0 (Vdeferred_action_function);
- if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
- {
- if (NILP (Vunread_command_events)
- && NILP (Vunread_input_method_events)
- && NILP (Vunread_post_input_method_events)
- && NILP (Vexecuting_macro)
- && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
- safe_run_hooks (Qpost_command_idle_hook);
+ if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
+ {
+ if (NILP (Vunread_command_events)
+ && NILP (Vunread_input_method_events)
+ && NILP (Vunread_post_input_method_events)
+ && NILP (Vexecuting_macro)
+ && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
+ safe_run_hooks (Qpost_command_idle_hook);
+ }
}
+ Vmemory_full = Qnil;
+
/* Do this after running Vpost_command_hook, for consistency. */
current_kboard->Vlast_command = Vthis_command;
current_kboard->Vreal_last_command = real_this_command;
{
/* Bind inhibit-quit to t so that C-g gets read in
rather than quitting back to the minibuffer. */
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
specbind (Qinhibit_quit, Qt);
Fsit_for (Vminibuffer_message_timeout, Qnil, Qnil);
{
cancel_echoing ();
this_command_key_count = 0;
+ this_command_key_count_reset = 0;
this_single_command_key_start = 0;
goto finalize;
}
if (SYMBOLP (cmd))
{
Lisp_Object cmd1;
- if (cmd1 = Fremap_command (cmd), !NILP (cmd1))
+ if (cmd1 = Fcommand_remapping (cmd), !NILP (cmd1))
cmd = cmd1;
}
if the symbol is a local variable. */
if (!NILP (Vpre_command_hook) && !NILP (Vrun_hooks))
safe_run_hooks (Qpre_command_hook);
-
+
+ already_adjusted = 0;
+
if (NILP (Vthis_command))
{
/* nil means key is undefined. */
= window_display_table (XWINDOW (selected_window));
lose = FETCH_CHAR (PT_BYTE);
SET_PT (PT + 1);
- if ((dp
- ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
- ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
- : (NILP (DISP_CHAR_VECTOR (dp, lose))
- && (lose >= 0x20 && lose < 0x7f)))
- : (lose >= 0x20 && lose < 0x7f))
+ if (! NILP (Vpost_command_hook))
+ /* Put this before calling adjust_point_for_property
+ so it will only get called once in any case. */
+ goto directly_done;
+ if (current_buffer == prev_buffer
+ && last_point_position != PT
+ && NILP (Vdisable_point_adjustment)
+ && NILP (Vglobal_disable_point_adjustment))
+ adjust_point_for_property (last_point_position, 0);
+ already_adjusted = 1;
+ if (PT == last_point_position + 1
+ && (dp
+ ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
+ ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
+ : (NILP (DISP_CHAR_VECTOR (dp, lose))
+ && (lose >= 0x20 && lose < 0x7f)))
+ : (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)
= window_display_table (XWINDOW (selected_window));
SET_PT (PT - 1);
lose = FETCH_CHAR (PT_BYTE);
- if ((dp
- ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
- ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
- : (NILP (DISP_CHAR_VECTOR (dp, lose))
- && (lose >= 0x20 && lose < 0x7f)))
- : (lose >= 0x20 && lose < 0x7f))
+ if (! NILP (Vpost_command_hook))
+ goto directly_done;
+ if (current_buffer == prev_buffer
+ && last_point_position != PT
+ && NILP (Vdisable_point_adjustment)
+ && NILP (Vglobal_disable_point_adjustment))
+ adjust_point_for_property (last_point_position, 0);
+ already_adjusted = 1;
+ if (PT == last_point_position - 1
+ && (dp
+ ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
+ ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
+ : (NILP (DISP_CHAR_VECTOR (dp, lose))
+ && (lose >= 0x20 && lose < 0x7f)))
+ : (lose >= 0x20 && lose < 0x7f))
&& (XFASTINT (XWINDOW (selected_window)->last_modified)
>= MODIFF)
&& (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
goto directly_done;
}
else if (EQ (Vthis_command, Qself_insert_command)
- /* Try this optimization only on ascii keystrokes. */
- && INTEGERP (last_command_char))
+ /* Try this optimization only on char keystrokes. */
+ && NATNUMP (last_command_char)
+ && CHAR_VALID_P (XFASTINT (last_command_char), 0))
{
- unsigned int c = XINT (last_command_char);
+ 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_macro)
&& !EQ (minibuf_window, selected_window))
}
nonundocount++;
}
-
+
lose = ((XFASTINT (XWINDOW (selected_window)->last_modified)
< MODIFF)
|| (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
|| detect_input_pending ()
|| !NILP (XWINDOW (selected_window)->column_number_displayed)
|| !NILP (Vexecuting_macro));
-
+
value = internal_self_insert (c, 0);
if (value == 2)
nonundocount = 0;
+ if (! NILP (Vpost_command_hook))
+ /* Put this before calling adjust_point_for_property
+ so it will only get called once in any case. */
+ goto directly_done;
+
/* VALUE == 1 when AFTER-CHANGE functions are
installed which is the case most of the time
because FONT-LOCK installs one. */
/* Here for a command that isn't executed directly */
+ {
#ifdef HAVE_X_WINDOWS
- if (display_hourglass_p)
- start_hourglass ();
+ int scount = SPECPDL_INDEX ();
+
+ if (display_hourglass_p
+ && NILP (Vexecuting_macro))
+ {
+ record_unwind_protect (cancel_hourglass_unwind, Qnil);
+ start_hourglass ();
+ }
#endif
- nonundocount = 0;
- if (NILP (current_kboard->Vprefix_arg))
- Fundo_boundary ();
- Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil);
+ nonundocount = 0;
+ if (NILP (current_kboard->Vprefix_arg))
+ Fundo_boundary ();
+ Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil);
#ifdef HAVE_X_WINDOWS
/* Do not check display_hourglass_p here, because
Fcommand_execute could change it, but we should cancel
- hourglass cursor anyway. */
- cancel_hourglass ();
+ hourglass cursor anyway.
+ But don't cancel the hourglass within a macro
+ just because a command in the macro finishes. */
+ if (NILP (Vexecuting_macro))
+ unbind_to (scount, Qnil);
#endif
+ }
}
directly_done: ;
current_kboard->Vlast_prefix_arg = Vcurrent_prefix_arg;
current_kboard->Vreal_last_command = real_this_command;
cancel_echoing ();
this_command_key_count = 0;
+ this_command_key_count_reset = 0;
this_single_command_key_start = 0;
}
{
if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
{
- current_buffer->mark_active = Qnil;
- call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
+ /* We could also call `deactivate'mark'. */
+ if (EQ (Vtransient_mark_mode, Qlambda))
+ Vtransient_mark_mode = Qnil;
+ else
+ {
+ current_buffer->mark_active = Qnil;
+ call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
+ }
}
else if (current_buffer != prev_buffer || MODIFF != prev_modiff)
call1 (Vrun_hooks, intern ("activate-mark-hook"));
if (current_buffer == prev_buffer
&& last_point_position != PT
&& NILP (Vdisable_point_adjustment)
- && NILP (Vglobal_disable_point_adjustment))
- adjust_point_for_property (last_point_position);
+ && NILP (Vglobal_disable_point_adjustment)
+ && !already_adjusted)
+ adjust_point_for_property (last_point_position, MODIFF != prev_modiff);
/* Install chars successfully executed in kbd macro. */
/* Adjust point to a boundary of a region that has such a property
that should be treated intangible. For the moment, we check
- `composition' and `display' property. LAST_PT is the last position
- of point. */
+ `composition', `display' and `invisible' properties.
+ LAST_PT is the last position of point. */
+
+extern Lisp_Object Qafter_string, Qbefore_string;
+extern Lisp_Object get_pos_property P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
static void
-adjust_point_for_property (last_pt)
+adjust_point_for_property (last_pt, modified)
int last_pt;
+ int modified;
{
- int start, end;
- Lisp_Object val;
- int check_composition = 1, check_display = 1;
+ int beg, end;
+ Lisp_Object val, overlay, tmp;
+ int check_composition = 1, check_display = 1, check_invisible = 1;
+ int orig_pt = PT;
- while (check_composition || check_display)
+ /* FIXME: cycling is probably not necessary because these properties
+ can't be usefully combined anyway. */
+ while (check_composition || check_display || check_invisible)
{
if (check_composition
&& PT > BEGV && PT < ZV
- && get_property_and_range (PT, Qcomposition, &val, &start, &end, Qnil)
- && COMPOSITION_VALID_P (start, end, val)
- && start < PT && end > PT
- && (last_pt <= start || last_pt >= end))
+ && get_property_and_range (PT, Qcomposition, &val, &beg, &end, Qnil)
+ && COMPOSITION_VALID_P (beg, end, val)
+ && beg < PT /* && end > PT <- It's always the case. */
+ && (last_pt <= beg || last_pt >= end))
{
- if (PT < last_pt)
- SET_PT (start);
- else
- SET_PT (end);
- check_display = 1;
+ xassert (end > PT);
+ SET_PT (PT < last_pt ? beg : end);
+ check_display = check_invisible = 1;
}
check_composition = 0;
if (check_display
&& PT > BEGV && PT < ZV
- && get_property_and_range (PT, Qdisplay, &val, &start, &end, Qnil)
+ && !NILP (val = get_char_property_and_overlay
+ (make_number (PT), Qdisplay, Qnil, &overlay))
&& display_prop_intangible_p (val)
- && start < PT && end > PT
- && (last_pt <= start || last_pt >= end))
+ && (!OVERLAYP (overlay)
+ ? get_property_and_range (PT, Qdisplay, &val, &beg, &end, Qnil)
+ : (beg = OVERLAY_POSITION (OVERLAY_START (overlay)),
+ end = OVERLAY_POSITION (OVERLAY_END (overlay))))
+ && beg < PT) /* && end > PT <- It's always the case. */
{
- if (PT < last_pt)
- SET_PT (start);
- else
- SET_PT (end);
- check_composition = 1;
+ xassert (end > PT);
+ SET_PT (PT < last_pt ? beg : end);
+ check_composition = check_invisible = 1;
}
check_display = 0;
+ if (check_invisible && PT > BEGV && PT < ZV)
+ {
+ int inv, ellipsis = 0;
+ beg = end = PT;
+
+ /* Find boundaries `beg' and `end' of the invisible area, if any. */
+ while (end < ZV
+ && !NILP (val = get_char_property_and_overlay
+ (make_number (end), Qinvisible, Qnil, &overlay))
+ && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
+ {
+ ellipsis = ellipsis || inv > 1
+ || (OVERLAYP (overlay)
+ && (!NILP (Foverlay_get (overlay, Qafter_string))
+ || !NILP (Foverlay_get (overlay, Qbefore_string))));
+ tmp = Fnext_single_char_property_change
+ (make_number (end), Qinvisible, Qnil, Qnil);
+ end = NATNUMP (tmp) ? XFASTINT (tmp) : ZV;
+ }
+ while (beg > BEGV
+ && !NILP (val = get_char_property_and_overlay
+ (make_number (beg - 1), Qinvisible, Qnil, &overlay))
+ && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
+ {
+ ellipsis = ellipsis || inv > 1
+ || (OVERLAYP (overlay)
+ && (!NILP (Foverlay_get (overlay, Qafter_string))
+ || !NILP (Foverlay_get (overlay, Qbefore_string))));
+ tmp = Fprevious_single_char_property_change
+ (make_number (beg), Qinvisible, Qnil, Qnil);
+ beg = NATNUMP (tmp) ? XFASTINT (tmp) : BEGV;
+ }
+
+ /* Move away from the inside area. */
+ if (beg < PT && end > PT)
+ {
+ SET_PT ((orig_pt == PT && (last_pt < beg || last_pt > end))
+ /* We haven't moved yet (so we don't need to fear
+ infinite-looping) and we were outside the range
+ before (so either end of the range still corresponds
+ to a move in the right direction): pretend we moved
+ less than we actually did, so that we still have
+ more freedom below in choosing which end of the range
+ to go to. */
+ ? (orig_pt = -1, PT < last_pt ? end : beg)
+ /* We either have moved already or the last point
+ was already in the range: we don't get to choose
+ which end of the range we have to go to. */
+ : (PT < last_pt ? beg : end));
+ check_composition = check_display = 1;
+ }
+ xassert (PT == beg || PT == end);
+ /* Pretend the area doesn't exist if the buffer is not
+ modified. */
+ if (!modified && !ellipsis && beg < end)
+ {
+ if (last_pt == beg && PT == end && end < ZV)
+ (check_composition = check_display = 1, SET_PT (end + 1));
+ else if (last_pt == end && PT == beg && beg > BEGV)
+ (check_composition = check_display = 1, SET_PT (beg - 1));
+ else if (PT == ((PT < last_pt) ? beg : end))
+ /* We've already moved as far as we can. Trying to go
+ to the other end would mean moving backwards and thus
+ could lead to an infinite loop. */
+ ;
+ else if (val = get_pos_property (make_number (PT),
+ Qinvisible, Qnil),
+ TEXT_PROP_MEANS_INVISIBLE (val)
+ && (val = get_pos_property
+ (make_number (PT == beg ? end : beg),
+ Qinvisible, Qnil),
+ !TEXT_PROP_MEANS_INVISIBLE (val)))
+ (check_composition = check_display = 1,
+ SET_PT (PT == beg ? end : beg));
+ }
+ }
+ check_invisible = 0;
}
}
safe_run_hooks_error (data)
Lisp_Object data;
{
+ Lisp_Object args[3];
+ args[0] = build_string ("Error in %s: %s");
+ args[1] = Vinhibit_quit;
+ args[2] = data;
+ Fmessage (3, args);
return Fset (Vinhibit_quit, Qnil);
}
safe_run_hooks (hook)
Lisp_Object hook;
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
specbind (Qinhibit_quit, hook);
internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error);
/* Number of seconds between polling for input. This is a Lisp
variable that can be bound. */
-int polling_period;
+EMACS_INT polling_period;
/* Nonzero means polling for input is temporarily suppressed. */
/* Turn alarm handling on unconditionally. It might have
been turned off in process.c. */
turn_on_atimers (1);
-
+
/* If poll timer doesn't exist, are we need one with
a different interval, start a new one. */
if (poll_timer == NULL
if (poll_timer)
cancel_atimer (poll_timer);
-
+
EMACS_SET_SECS_USECS (interval, polling_period, 0);
poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
poll_for_input, NULL);
the `display' property). POS is the position in that string under
the mouse.
- OK_TO_IVERWRITE_KEYSTROKE_ECHO non-zero means it's okay if the help
+ OK_TO_OVERWRITE_KEYSTROKE_ECHO non-zero means it's okay if the help
echo overwrites a keystroke echo currently displayed in the echo
area.
}
else
help = safe_eval (help);
-
+
if (!STRINGP (help))
return;
}
{
if (STRINGP (help))
{
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
if (!help_echo_showing_p)
Vpre_help_message = current_message ();
-
+
specbind (Qmessage_truncate_lines, Qt);
- message3_nolog (help, STRING_BYTES (XSTRING (help)),
+ message3_nolog (help, SBYTES (help),
STRING_MULTIBYTE (help));
unbind_to (count, Qnil);
}
else if (STRINGP (Vpre_help_message))
{
message3_nolog (Vpre_help_message,
- STRING_BYTES (XSTRING (Vpre_help_message)),
+ SBYTES (Vpre_help_message),
STRING_MULTIBYTE (Vpre_help_message));
Vpre_help_message = Qnil;
}
else
message (0);
}
-
+
help_echo_showing_p = STRINGP (help);
}
}
static jmp_buf wrong_kboard_jmpbuf;
#endif
+#define STOP_POLLING \
+do { if (! polling_stopped_here) stop_polling (); \
+ polling_stopped_here = 1; } while (0)
+
+#define RESUME_POLLING \
+do { if (polling_stopped_here) start_polling (); \
+ polling_stopped_here = 0; } while (0)
+
/* read a character from the keyboard; call the redisplay if needed */
/* commandflag 0 means do not do auto-saving, but do do redisplay.
-1 means do not do redisplay, but do do autosaving.
volatile int reread;
struct gcpro gcpro1, gcpro2;
EMACS_TIME last_idle_start;
+ int polling_stopped_here = 0;
also_record = Qnil;
+#if 0 /* This was commented out as part of fixing echo for C-u left. */
before_command_key_count = this_command_key_count;
before_command_echo_length = echo_length ();
+#endif
c = Qnil;
previous_echo_area_message = Qnil;
&& EQ (XCDR (c), Qdisabled)
&& (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))))
c = XCAR (c);
-
+
/* If the queued event is something that used the mouse,
set used_mouse_menu accordingly. */
if (used_mouse_menu
&& (EQ (c, Qtool_bar) || EQ (c, Qmenu_bar)))
*used_mouse_menu = 1;
-
+
reread = 1;
goto reread_for_input_method;
}
goto reread_for_input_method;
}
- /* If there is no function key translated before
- reset-this-command-lengths takes effect, forget about it. */
- before_command_restore_flag = 0;
+ this_command_key_count_reset = 0;
if (!NILP (Vexecuting_macro))
{
|| executing_macro_index >= XFASTINT (Flength (Vexecuting_macro)))
{
XSETINT (c, -1);
- RETURN_UNGCPRO (c);
+ goto exit;
}
c = Faref (Vexecuting_macro, make_number (executing_macro_index));
}
/* Message turns off echoing unless more keystrokes turn it on again.
-
+
The code in 20.x for the condition was
1. echo_area_glyphs && *echo_area_glyphs
3. && ok_to_echo_at_next_pause != echo_area_glyphs
(1) means there's a current message displayed
-
+
(2) means it's not the message from echoing from the current
kboard.
-
+
(3) There's only one place in 20.x where ok_to_echo_at_next_pause
is set to a non-null value. This is done in read_char and it is
set to echo_area_glyphs after a call to echo_char. That means
must be either null, or the current message isn't from echoing at
all, or it's from echoing from a different kboard than the
current one. */
-
- if (/* There currently something in the echo area */
+
+ if (/* There currently is something in the echo area. */
!NILP (echo_area_buffer[0])
&& (/* And it's either not from echoing. */
!EQ (echo_area_buffer[0], echo_message_buffer)
cancel_echoing ();
else
echo_dash ();
-
+
/* Try reading a character via menu prompting in the minibuf.
Try this before the sit-for, because the sit-for
would do the wrong thing if we are supposed to do
/* If in middle of key sequence and minibuffer not active,
start echoing if enough time elapses. */
- if (minibuf_level == 0
+ if (minibuf_level == 0
&& !current_kboard->immediate_echo
&& this_command_key_count > 0
&& ! noninteractive
|| (!echo_kboard && ok_to_echo_at_next_pause)))
{
Lisp_Object tem0;
-
+
/* After a mouse event, start echoing right away.
This is because we are probably about to display a menu,
and we don't want to delay before doing so. */
/* Now that we have read an event, Emacs is not idle. */
timer_stop_idle ();
- RETURN_UNGCPRO (c);
+ goto exit;
}
/* Maybe autosave and/or garbage collect due to idleness. */
wrong_kboard:
- stop_polling ();
+ STOP_POLLING;
/* Finally, we read from the main queue,
and if that gives us something we can't use yet, we put it on the
should the next event read be a help-echo. */
last_idle_start = timer_idleness_start_time;
timer_stop_idle ();
- start_polling ();
+ RESUME_POLLING;
if (NILP (c))
{
so don't show them to the user.
Also, don't record a key if we already did. */
if (BUFFERP (c) || key_already_recorded)
- RETURN_UNGCPRO (c);
+ goto exit;
/* Process special events within read_char
and loop around to read another event. */
last_input_char = c;
Fcommand_execute (tem, Qnil, Fvector (1, &last_input_char), Qt);
+ if (CONSP (c) && EQ (XCAR (c), Qselect_window))
+ /* We stopped being idle for this event; undo that. This
+ prevents automatic window selection (under
+ mouse_autoselect_window from acting as a real input event, for
+ example banishing the mouse under mouse-avoidance-mode. */
+ timer_idleness_start_time = last_idle_start;
+
/* Resume allowing input from any kboard, if that was true before. */
if (!was_locked)
any_kboard_state ();
{
/* If kbd_buffer_get_event gave us an EOF, return that. */
if (XINT (c) == -1)
- RETURN_UNGCPRO (c);
+ goto exit;
if ((STRINGP (Vkeyboard_translate_table)
- && XSTRING (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
+ && SCHARS (Vkeyboard_translate_table) > (unsigned) XFASTINT (c))
|| (VECTORP (Vkeyboard_translate_table)
&& XVECTOR (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
- || (CHAR_TABLE_P (Vkeyboard_translate_table)
- && CHAR_VALID_P (XINT (c), 0)))
+ || CHAR_TABLE_P (Vkeyboard_translate_table))
{
Lisp_Object d;
d = Faref (Vkeyboard_translate_table, c);
&& (unsigned) XINT (c) != 127
&& (unsigned) XINT (c) < 256)
{
- Lisp_Object keys;
- int key_count;
+ Lisp_Object keys;
+ int key_count, key_count_reset;
struct gcpro gcpro1;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
/* Save the echo status. */
int saved_immediate_echo = current_kboard->immediate_echo;
struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
int saved_echo_after_prompt = current_kboard->echo_after_prompt;
+#if 0
if (before_command_restore_flag)
{
this_command_key_count = before_command_key_count_1;
echo_truncate (before_command_echo_length_1);
before_command_restore_flag = 0;
}
+#endif
/* Save the this_command_keys status. */
key_count = this_command_key_count;
+ key_count_reset = this_command_key_count_reset;
if (key_count > 0)
keys = Fcopy_sequence (this_command_keys);
/* Clear out this_command_keys. */
this_command_key_count = 0;
+ this_command_key_count_reset = 0;
/* Now wipe the echo area. */
if (!NILP (echo_area_buffer[0]))
/* Restore the saved echoing state
and this_command_keys state. */
this_command_key_count = key_count;
+ this_command_key_count_reset = key_count_reset;
if (key_count > 0)
this_command_keys = keys;
timer_idleness_start_time = last_idle_start;
goto retry;
}
-
- if (this_command_key_count == 0 || ! reread)
+
+ if (! reread || this_command_key_count == 0
+ || this_command_key_count_reset)
{
- before_command_key_count = this_command_key_count;
- before_command_echo_length = echo_length ();
/* Don't echo mouse motion events. */
if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
if (!NILP (Vhelp_form) && help_char_p (c))
{
Lisp_Object tem0;
- count = specpdl_ptr - specpdl;
+ count = SPECPDL_INDEX ();
record_unwind_protect (Fset_window_configuration,
Fcurrent_window_configuration (Qnil));
}
}
+ exit:
+ RESUME_POLLING;
RETURN_UNGCPRO (c);
}
record_char (c);
+#if 0
before_command_key_count = this_command_key_count;
before_command_echo_length = echo_length ();
+#endif
/* Don't echo mouse motion events. */
if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
Lisp_Object ev1, ev2, ev3;
int ix1, ix2, ix3;
-
+
if ((ix1 = recent_keys_index - 1) < 0)
ix1 = NUM_RECENT_KEYS - 1;
ev1 = AREF (recent_keys, ix1);
-
+
if ((ix2 = ix1 - 1) < 0)
ix2 = NUM_RECENT_KEYS - 1;
ev2 = AREF (recent_keys, ix2);
-
+
if ((ix3 = ix2 - 1) < 0)
ix3 = NUM_RECENT_KEYS - 1;
ev3 = AREF (recent_keys, ix3);
-
+
if (EQ (XCAR (c), Qhelp_echo))
{
/* Don't record `help-echo' in recent_keys unless it shows some help
}
num_nonmacro_input_events++;
-
+
/* Write c to the dribble file. If c is a lispy event, write
the event's symbol to the dribble file, in <brackets>. Bleaugh.
If you, dear reader, have a better idea, you've got the source. :-) */
if (SYMBOLP (dribblee))
{
putc ('<', dribble);
- fwrite (XSYMBOL (dribblee)->name->data, sizeof (char),
- STRING_BYTES (XSYMBOL (dribblee)->name),
+ fwrite (SDATA (SYMBOL_NAME (dribblee)), sizeof (char),
+ SBYTES (SYMBOL_NAME (dribblee)),
dribble);
putc ('>', dribble);
}
(args)
Lisp_Object args;
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object val;
record_unwind_protect (tracking_off, do_mouse_tracking);
/* Return true iff there are any events in the queue that read-char
would return. If this returns false, a read-char would block. */
static int
-readable_events (do_timers_now)
+readable_filtered_events (do_timers_now, filter_events)
int do_timers_now;
+ int filter_events;
{
if (do_timers_now)
timer_check (do_timers_now);
+ /* If the buffer contains only FOCUS_IN_EVENT events,
+ and FILTER_EVENTS is nonzero, report it as empty. */
if (kbd_fetch_ptr != kbd_store_ptr)
- return 1;
+ {
+ int have_live_event = 1;
+
+ if (filter_events)
+ {
+ struct input_event *event;
+
+ event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
+ ? kbd_fetch_ptr
+ : kbd_buffer);
+
+ while (have_live_event && event->kind == FOCUS_IN_EVENT)
+ {
+ event++;
+ if (event == kbd_buffer + KBD_BUFFER_SIZE)
+ event = kbd_buffer;
+ if (event == kbd_store_ptr)
+ have_live_event = 0;
+ }
+ }
+ if (have_live_event) return 1;
+ }
+
#ifdef HAVE_MOUSE
if (!NILP (do_mouse_tracking) && some_mouse_moved ())
return 1;
return 0;
}
+/* Return true iff there are any events in the queue that read-char
+ would return. If this returns false, a read-char would block. */
+static int
+readable_events (do_timers_now)
+ int do_timers_now;
+{
+ return readable_filtered_events (do_timers_now, 0);
+}
+
/* Set this for debugging, to have a way to get out */
int stop_character;
kbd_buffer_store_event (event)
register struct input_event *event;
{
- if (event->kind == no_event)
+ if (event->kind == NO_EVENT)
abort ();
- if (event->kind == ascii_keystroke)
+ if (event->kind == ASCII_KEYSTROKE_EVENT)
{
register int c = event->code & 0377;
if (c == quit_char)
{
- static SIGTYPE interrupt_signal P_ ((int));
#ifdef MULTI_KBOARD
KBOARD *kb;
struct input_event *sp;
if (event_to_kboard (sp) == kb)
{
- sp->kind = no_event;
+ sp->kind = NO_EVENT;
sp->frame_or_window = Qnil;
sp->arg = Qnil;
}
return;
}
}
- /* Don't insert two buffer_switch_event's in a row.
+ /* Don't insert two BUFFER_SWITCH_EVENT's in a row.
Just ignore the second one. */
- else if (event->kind == buffer_switch_event
+ else if (event->kind == BUFFER_SWITCH_EVENT
&& kbd_fetch_ptr != kbd_store_ptr
- && kbd_store_ptr->kind == buffer_switch_event)
+ && kbd_store_ptr->kind == BUFFER_SWITCH_EVENT)
return;
if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
if (kbd_fetch_ptr - 1 != kbd_store_ptr)
{
int idx;
-
-#if 0 /* The selection_request_event case looks bogus, and it's error
+
+#if 0 /* The SELECTION_REQUEST_EVENT case looks bogus, and it's error
prone to assign individual members for other events, in case
the input_event structure is changed. --2000-07-13, gerd. */
struct input_event *sp = kbd_store_ptr;
sp->kind = event->kind;
- if (event->kind == selection_request_event)
+ if (event->kind == SELECTION_REQUEST_EVENT)
{
/* We must not use the ordinary copying code for this case,
since `part' is an enum and copying it might not copy enough
Lisp_Object help, frame, object, window;
int pos;
{
- int nevents_stored = 0;
-
- if (size >= 2)
+ if (size >= 1)
{
bufp->kind = HELP_EVENT;
bufp->frame_or_window = frame;
bufp->arg = object;
- bufp->x = make_number (pos);
- bufp->code = 0;
-
- ++bufp;
- bufp->kind = HELP_EVENT;
- bufp->frame_or_window = WINDOWP (window) ? window : frame;
- bufp->arg = help;
- bufp->code = 1;
- nevents_stored = 2;
+ bufp->x = WINDOWP (window) ? window : frame;
+ bufp->y = help;
+ bufp->code = pos;
+ return 1;
}
-
- return nevents_stored;
+ return 0;
}
event.kind = HELP_EVENT;
event.frame_or_window = frame;
event.arg = Qnil;
- event.x = make_number (0);
+ event.x = Qnil;
+ event.y = help;
event.code = 0;
kbd_buffer_store_event (&event);
-
- event.kind = HELP_EVENT;
- event.frame_or_window = frame;
- event.arg = help;
- event.x = make_number (0);
- event.code = 1;
- kbd_buffer_store_event (&event);
}
\f
/* Discard any mouse events in the event buffer by setting them to
- no_event. */
+ NO_EVENT. */
void
discard_mouse_events ()
{
if (sp == kbd_buffer + KBD_BUFFER_SIZE)
sp = kbd_buffer;
- if (sp->kind == mouse_click
+ if (sp->kind == MOUSE_CLICK_EVENT
+ || sp->kind == WHEEL_EVENT
#ifdef WINDOWSNT
- || sp->kind == w32_scroll_bar_click
+ || sp->kind == W32_SCROLL_BAR_CLICK_EVENT
#endif
- || sp->kind == scroll_bar_click)
+ || sp->kind == SCROLL_BAR_CLICK_EVENT)
{
- sp->kind = no_event;
+ sp->kind = NO_EVENT;
}
}
}
/* Return non-zero if there are any real events waiting in the event
- buffer, not counting `no_event's.
+ buffer, not counting `NO_EVENT's.
- If DISCARD is non-zero, discard no_event events at the front of
+ If DISCARD is non-zero, discard NO_EVENT events at the front of
the input queue, possibly leaving the input queue empty if there
are no real input events. */
int discard;
{
struct input_event *sp;
-
+
for (sp = kbd_fetch_ptr;
- sp != kbd_store_ptr && sp->kind == no_event;
+ sp != kbd_store_ptr && sp->kind == NO_EVENT;
++sp)
{
if (sp == kbd_buffer + KBD_BUFFER_SIZE)
if (discard)
kbd_fetch_ptr = sp;
- return sp != kbd_store_ptr && sp->kind != no_event;
+ return sp != kbd_store_ptr && sp->kind != NO_EVENT;
}
\f
int idx = 2 * (event - kbd_buffer);
ASET (kbd_buffer_gcpro, idx, Qnil);
ASET (kbd_buffer_gcpro, idx + 1, Qnil);
- event->kind = no_event;
+ event->kind = NO_EVENT;
}
/* These two kinds of events get special handling
and don't actually appear to the command loop.
We return nil for them. */
- if (event->kind == selection_request_event)
+ if (event->kind == SELECTION_REQUEST_EVENT)
{
#ifdef HAVE_X11
struct input_event copy;
#endif
}
- else if (event->kind == selection_clear_event)
+ else if (event->kind == SELECTION_CLEAR_EVENT)
{
#ifdef HAVE_X11
struct input_event copy;
abort ();
#endif
}
-#if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (macintosh)
- else if (event->kind == delete_window_event)
+#if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (MAC_OS)
+ else if (event->kind == DELETE_WINDOW_EVENT)
{
/* Make an event (delete-frame (FRAME)). */
obj = Fcons (event->frame_or_window, Qnil);
}
#endif
#if defined (HAVE_X11) || defined (HAVE_NTGUI)
- else if (event->kind == iconify_event)
+ else if (event->kind == ICONIFY_EVENT)
{
/* Make an event (iconify-frame (FRAME)). */
obj = Fcons (event->frame_or_window, Qnil);
obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
kbd_fetch_ptr = event + 1;
}
- else if (event->kind == deiconify_event)
+ else if (event->kind == DEICONIFY_EVENT)
{
/* Make an event (make-frame-visible (FRAME)). */
obj = Fcons (event->frame_or_window, Qnil);
kbd_fetch_ptr = event + 1;
}
#endif
- else if (event->kind == buffer_switch_event)
+ else if (event->kind == BUFFER_SWITCH_EVENT)
{
/* The value doesn't matter here; only the type is tested. */
XSETBUFFER (obj, current_buffer);
kbd_fetch_ptr = event + 1;
}
-#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
- else if (event->kind == menu_bar_activate_event)
+#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (MAC_OS) \
+ || defined (USE_GTK)
+ else if (event->kind == MENU_BAR_ACTIVATE_EVENT)
{
kbd_fetch_ptr = event + 1;
input_pending = readable_events (0);
}
#endif
#ifdef WINDOWSNT
- else if (event->kind == language_change_event)
+ else if (event->kind == LANGUAGE_CHANGE_EVENT)
{
/* Make an event (language-change (FRAME CHARSET LCID)). */
obj = Fcons (event->modifiers, Qnil);
kbd_fetch_ptr = event + 1;
}
#endif
+ else if (event->kind == SAVE_SESSION_EVENT)
+ {
+ obj = Fcons (Qsave_session, Qnil);
+ kbd_fetch_ptr = event + 1;
+ }
/* Just discard these, by returning nil.
With MULTI_KBOARD, these events are used as placeholders
when we need to randomly delete events from the queue.
(They shouldn't otherwise be found in the buffer,
but on some machines it appears they do show up
even without MULTI_KBOARD.) */
- /* On Windows NT/9X, no_event is used to delete extraneous
+ /* On Windows NT/9X, NO_EVENT is used to delete extraneous
mouse events during a popup-menu call. */
- else if (event->kind == no_event)
+ else if (event->kind == NO_EVENT)
kbd_fetch_ptr = event + 1;
else if (event->kind == HELP_EVENT)
{
- /* There are always two HELP_EVENTs in the input queue. */
Lisp_Object object, position, help, frame, window;
- xassert (event->code == 0);
frame = event->frame_or_window;
object = event->arg;
- position = event->x;
+ position = make_number (event->code);
+ window = event->x;
+ help = event->y;
clear_event (event);
kbd_fetch_ptr = event + 1;
- event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
- ? kbd_fetch_ptr
- : kbd_buffer);
- xassert (event->code == 1);
- help = event->arg;
- window = event->frame_or_window;
if (!WINDOWP (window))
window = Qnil;
obj = Fcons (Qhelp_echo,
list5 (frame, help, window, object, position));
- clear_event (event);
- kbd_fetch_ptr = event + 1;
}
else if (event->kind == FOCUS_IN_EVENT)
{
if (NILP (obj))
{
obj = make_lispy_event (event);
-
-#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI)
+
+#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined(MAC_OS) \
+ || defined (USE_GTK)
/* If this was a menu selection, then set the flag to inhibit
writing to last_nonmenu_event. Don't do this if the event
we're returning is (menu-bar), though; that indicates the
/* These two kinds of events get special handling
and don't actually appear to the command loop. */
- if (event->kind == selection_request_event)
+ if (event->kind == SELECTION_REQUEST_EVENT)
{
#ifdef HAVE_X11
struct input_event copy;
#endif
}
- else if (event->kind == selection_clear_event)
+ else if (event->kind == SELECTION_CLEAR_EVENT)
{
#ifdef HAVE_X11
struct input_event copy;
EMACS_GET_TIME (timer_idleness_start_time);
+ timer_last_idleness_start_time = timer_idleness_start_time;
+
/* Mark all idle-time timers as once again candidates for running. */
for (timers = Vtimer_idle_list; CONSP (timers); timers = XCDR (timers))
{
difference = idle_timer_difference;
}
vector = XVECTOR (chosen_timer)->contents;
-
+
/* If timer is ripe, run it if it hasn't been run. */
if (EMACS_TIME_NEG_P (difference)
|| (EMACS_SECS (difference) == 0
if (NILP (vector[0]))
{
int was_locked = single_kboard;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
Lisp_Object old_deactivate_mark = Vdeactivate_mark;
/* Mark the timer as triggered to prevent problems if the lisp
vector[0] = Qt;
specbind (Qinhibit_quit, Qt);
-
+
call1 (Qtimer_event_handler, chosen_timer);
Vdeactivate_mark = old_deactivate_mark;
timers_run++;
static Lisp_Object accent_key_syms;
static Lisp_Object func_key_syms;
static Lisp_Object mouse_syms;
-#ifdef WINDOWSNT
-static Lisp_Object mouse_wheel_syms;
-#endif
+static Lisp_Object wheel_syms;
static Lisp_Object drag_n_drop_syms;
/* This is a list of keysym codes for special "accent" characters.
char *lispy_function_keys[] =
{
0, /* 0 */
-
+
0, /* VK_LBUTTON 0x01 */
0, /* VK_RBUTTON 0x02 */
"cancel", /* VK_CANCEL 0x03 */
0, /* VK_MBUTTON 0x04 */
-
+
0, 0, 0, /* 0x05 .. 0x07 */
-
+
"backspace", /* VK_BACK 0x08 */
"tab", /* VK_TAB 0x09 */
-
+
0, 0, /* 0x0A .. 0x0B */
-
+
"clear", /* VK_CLEAR 0x0C */
"return", /* VK_RETURN 0x0D */
-
+
0, 0, /* 0x0E .. 0x0F */
-
+
0, /* VK_SHIFT 0x10 */
0, /* VK_CONTROL 0x11 */
0, /* VK_MENU 0x12 */
"pause", /* VK_PAUSE 0x13 */
"capslock", /* VK_CAPITAL 0x14 */
-
+
0, 0, 0, 0, 0, 0, /* 0x15 .. 0x1A */
-
+
"escape", /* VK_ESCAPE 0x1B */
-
+
0, 0, 0, 0, /* 0x1C .. 0x1F */
-
+
0, /* VK_SPACE 0x20 */
"prior", /* VK_PRIOR 0x21 */
"next", /* VK_NEXT 0x22 */
"insert", /* VK_INSERT 0x2D */
"delete", /* VK_DELETE 0x2E */
"help", /* VK_HELP 0x2F */
-
+
/* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
-
+
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
-
+
0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
-
+
/* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
-
- 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0,
+
+ 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
-
+
"lwindow", /* VK_LWIN 0x5B */
"rwindow", /* VK_RWIN 0x5C */
"apps", /* VK_APPS 0x5D */
-
+
0, 0, /* 0x5E .. 0x5F */
-
+
"kp-0", /* VK_NUMPAD0 0x60 */
"kp-1", /* VK_NUMPAD1 0x61 */
"kp-2", /* VK_NUMPAD2 0x62 */
"f22", /* VK_F22 0x85 */
"f23", /* VK_F23 0x86 */
"f24", /* VK_F24 0x87 */
-
+
0, 0, 0, 0, /* 0x88 .. 0x8B */
0, 0, 0, 0, /* 0x8C .. 0x8F */
-
+
"kp-numlock", /* VK_NUMLOCK 0x90 */
"scroll", /* VK_SCROLL 0x91 */
-
+
"kp-space", /* VK_NUMPAD_CLEAR 0x92 */
"kp-enter", /* VK_NUMPAD_ENTER 0x93 */
"kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
* No other API or message will distinguish left and right keys this way.
*/
/* 0xA0 .. 0xEF */
-
+
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
-
+
/* 0xF0 .. 0xF5 */
-
+
0, 0, 0, 0, 0, 0,
-
+
"attn", /* VK_ATTN 0xF6 */
"crsel", /* VK_CRSEL 0xF7 */
"exsel", /* VK_EXSEL 0xF8 */
0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x480 .. 0x48f */
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x490 .. 0x49f */
- 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
+ 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
"kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
"kana-i", "kana-u", "kana-e", "kana-o",
"kana-ya", "kana-yu", "kana-yo", "kana-tsu",
0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe10 */
0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe18 */
"iso-lefttab", /* 0xfe20 */
- "iso-move-line-up", "iso-move-line-down",
- "iso-partial-line-up", "iso-partial-line-down",
- "iso-partial-space-left", "iso-partial-space-right",
+ "iso-move-line-up", "iso-move-line-down",
+ "iso-partial-line-up", "iso-partial-line-down",
+ "iso-partial-space-left", "iso-partial-space-right",
"iso-set-margin-left", "iso-set-margin-right", /* 0xffe27, 28 */
"iso-release-margin-left", "iso-release-margin-right",
"iso-release-both-margins",
Lisp_Object Vlispy_mouse_stem;
-#ifdef WINDOWSNT
-/* mouse-wheel events are generated by the wheel on devices such as
- the MS Intellimouse. The wheel sits in between the left and right
- mouse buttons, and is typically used to scroll or zoom the window
- underneath the pointer. mouse-wheel events specify the object on
- which they operate, and a delta corresponding to the amount and
- direction that the wheel is rotated. Clicking the mouse-wheel
- generates a mouse-2 event. */
-static char *lispy_mouse_wheel_names[] =
-{
- "mouse-wheel"
+static char *lispy_wheel_names[] =
+{
+ "wheel-up", "wheel-down"
};
-#endif /* WINDOWSNT */
-
/* drag-n-drop events are generated when a set of selected files are
dragged from another application and dropped onto an Emacs window. */
static char *lispy_drag_n_drop_names[] =
/* Maximum number of pixels the mouse may be moved between clicks
to make a double-click. */
-int double_click_fuzz;
+EMACS_INT double_click_fuzz;
/* The number of clicks in this multiple-click. */
switch (SWITCH_ENUM_CAST (event->kind))
{
/* A simple keystroke. */
- case ascii_keystroke:
+ case ASCII_KEYSTROKE_EVENT:
{
Lisp_Object lispy_c;
int c = event->code & 0377;
return lispy_c;
}
- case multibyte_char_keystroke:
+ case MULTIBYTE_CHAR_KEYSTROKE_EVENT:
{
Lisp_Object lispy_c;
+ int c = event->code;
- XSETFASTINT (lispy_c, event->code);
+ /* Add in the other modifier bits. We took care of ctrl_modifier
+ just above, and the shift key was taken care of by the X code,
+ and applied to control characters by make_ctrl_char. */
+ c |= (event->modifiers
+ & (meta_modifier | alt_modifier
+ | hyper_modifier | super_modifier | ctrl_modifier));
+ /* What about the `shift' modifier ? */
+ button_down_time = 0;
+ XSETFASTINT (lispy_c, c);
return lispy_c;
}
/* A function key. The symbol may need to have modifier prefixes
tacked onto it. */
- case non_ascii_keystroke:
+ case NON_ASCII_KEYSTROKE_EVENT:
button_down_time = 0;
for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++)
(sizeof (lispy_accent_keys)
/ sizeof (lispy_accent_keys[0])));
- /* Handle system-specific keysyms. */
- if (event->code & (1 << 28))
- {
- /* We need to use an alist rather than a vector as the cache
- since we can't make a vector long enuf. */
- if (NILP (current_kboard->system_key_syms))
- current_kboard->system_key_syms = Fcons (Qnil, Qnil);
- return modify_event_symbol (event->code,
- event->modifiers,
- Qfunction_key,
- current_kboard->Vsystem_key_alist,
- 0, ¤t_kboard->system_key_syms,
- (unsigned)-1);
- }
-
#if 0
#ifdef XK_kana_A
if (event->code >= 0x400 && event->code < 0x500)
iso_lispy_function_keys, &func_key_syms,
(sizeof (iso_lispy_function_keys)
/ sizeof (iso_lispy_function_keys[0])));
- else
#endif
-#ifdef HAVE_X_WINDOWS
- if (event->code - FUNCTION_KEY_OFFSET < 0
+ /* Handle system-specific or unknown keysyms. */
+ if (event->code & (1 << 28)
+ || event->code - FUNCTION_KEY_OFFSET < 0
|| (event->code - FUNCTION_KEY_OFFSET
- >= sizeof lispy_function_keys / sizeof *lispy_function_keys))
+ >= sizeof lispy_function_keys / sizeof *lispy_function_keys)
+ || !lispy_function_keys[event->code - FUNCTION_KEY_OFFSET])
{
- /* EVENT->code is an unknown keysym. */
- char *name;
- Lisp_Object symbol;
-
- BLOCK_INPUT;
- /* This returns a pointer to a static area. Don't free it. */
- name = XKeysymToString (event->code);
- symbol = name ? intern (name) : Qnil;
- UNBLOCK_INPUT;
-
- if (!NILP (symbol))
- return apply_modifiers (event->modifiers, symbol);
- }
-#endif /* HAVE_X_WINDOWS */
+ /* We need to use an alist rather than a vector as the cache
+ since we can't make a vector long enuf. */
+ if (NILP (current_kboard->system_key_syms))
+ current_kboard->system_key_syms = Fcons (Qnil, Qnil);
+ return modify_event_symbol (event->code,
+ event->modifiers,
+ Qfunction_key,
+ current_kboard->Vsystem_key_alist,
+ 0, ¤t_kboard->system_key_syms,
+ (unsigned) -1);
+ }
return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
event->modifiers,
#ifdef HAVE_MOUSE
/* A mouse click. Figure out where it is, decide whether it's
a press, click or drag, and build the appropriate structure. */
- case mouse_click:
+ case MOUSE_CLICK_EVENT:
#ifndef USE_TOOLKIT_SCROLL_BARS
- case scroll_bar_click:
+ case SCROLL_BAR_CLICK_EVENT:
#endif
{
int button = event->code;
position = Qnil;
/* Build the position as appropriate for this mouse click. */
- if (event->kind == mouse_click)
+ if (event->kind == MOUSE_CLICK_EVENT)
{
- int part;
+ enum window_part part;
struct frame *f = XFRAME (event->frame_or_window);
Lisp_Object posn;
Lisp_Object string_info = Qnil;
int row, column;
+ int wx, wy;
/* Ignore mouse events that were made on frame that
have been deleted. */
pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
&column, &row, NULL, 1);
-#ifndef USE_X_TOOLKIT
+#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
/* In the non-toolkit version, clicks on the menu bar
are ordinary button events in the event buffer.
Distinguish them, and invoke the menu.
if (NILP (string))
break;
if (column >= XINT (pos)
- && column < XINT (pos) + XSTRING (string)->size)
+ && column < XINT (pos) + SCHARS (string))
{
item = AREF (items, i);
break;
return Fcons (item, Fcons (position, Qnil));
}
-#endif /* not USE_X_TOOLKIT */
+#endif /* not USE_X_TOOLKIT && not USE_GTK */
/* Set `window' to the window under frame pixel coordinates
event->x/event->y. */
window = window_from_coordinates (f, XINT (event->x),
- XINT (event->y), &part, 0);
+ XINT (event->y),
+ &part, &wx, &wy, 0);
if (!WINDOWP (window))
{
event->x/ event->y. */
struct window *w = XWINDOW (window);
- /* Get window relative coordinates. Original code
- `rounded' this to glyph boundaries. */
- int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x));
- int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y));
-
/* Set event coordinates to window-relative coordinates
for constructing the Lisp event below. */
XSETINT (event->x, wx);
XSETINT (event->y, wy);
- if (part == 1 || part == 3)
+ if (part == ON_MODE_LINE || part == ON_HEADER_LINE)
{
/* Mode line or header line. Look for a string under
the mouse that may have a `local-map' property. */
Lisp_Object string;
int charpos;
-
- posn = part == 1 ? Qmode_line : Qheader_line;
- string = mode_line_string (w, wx, wy, part == 1, &charpos);
+
+ posn = part == ON_MODE_LINE ? Qmode_line : Qheader_line;
+ string = mode_line_string (w, wx, wy, part, &charpos);
if (STRINGP (string))
string_info = Fcons (string, make_number (charpos));
}
- else if (part == 2)
+ else if (part == ON_VERTICAL_BORDER)
posn = Qvertical_line;
+ else if (part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN)
+ {
+ int charpos;
+ Lisp_Object object = marginal_area_string (w, wx, wy, part,
+ &charpos);
+ posn = (part == ON_LEFT_MARGIN) ? Qleft_margin : Qright_margin;
+ if (STRINGP (object))
+ string_info = Fcons (object, make_number (charpos));
+ }
else
{
Lisp_Object object;
button + 1, Qnil);
mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
}
-
+
start_pos_ptr = &AREF (button_down_location, button);
start_pos = *start_pos_ptr;
*start_pos_ptr = Qnil;
&& ((int)(event->timestamp - button_down_time)
< XINT (Vdouble_click_time)))));
}
-
+
last_mouse_button = button;
last_mouse_x = XINT (event->x);
last_mouse_y = XINT (event->y);
button_down_time = 0;
event->modifiers |= drag_modifier;
}
-
+
/* Don't check is_double; treat this as multiple
if the down-event was multiple. */
if (double_click_count > 1)
}
}
-#if USE_TOOLKIT_SCROLL_BARS
+ case WHEEL_EVENT:
+ {
+ Lisp_Object position;
+ Lisp_Object window;
+ Lisp_Object head;
+
+ /* Build the position as appropriate for this mouse click. */
+ enum window_part part;
+ struct frame *f = XFRAME (event->frame_or_window);
+ Lisp_Object posn;
+ Lisp_Object string_info = Qnil;
+ int row, column;
+ int wx, wy;
+ position = Qnil;
+
+ /* Ignore wheel events that were made on frame that have been
+ deleted. */
+ if (! FRAME_LIVE_P (f))
+ return Qnil;
+
+ /* EVENT->x and EVENT->y are frame-relative pixel
+ coordinates at this place. Under old redisplay, COLUMN
+ and ROW are set to frame relative glyph coordinates
+ which are then used to determine whether this click is
+ in a menu (non-toolkit version). */
+ pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
+ &column, &row, NULL, 1);
+
+ /* Set `window' to the window under frame pixel coordinates
+ event->x/event->y. */
+ window = window_from_coordinates (f, XINT (event->x),
+ XINT (event->y),
+ &part, &wx, &wy, 0);
+
+ if (!WINDOWP (window))
+ {
+ window = event->frame_or_window;
+ posn = Qnil;
+ }
+ else
+ {
+ /* It's a click in window window at frame coordinates
+ event->x/ event->y. */
+ struct window *w = XWINDOW (window);
+
+ /* Set event coordinates to window-relative coordinates
+ for constructing the Lisp event below. */
+ XSETINT (event->x, wx);
+ XSETINT (event->y, wy);
+
+ if (part == ON_MODE_LINE || part == ON_HEADER_LINE)
+ {
+ /* Mode line or header line. Look for a string under
+ the mouse that may have a `local-map' property. */
+ Lisp_Object string;
+ int charpos;
+
+ posn = part == ON_MODE_LINE ? Qmode_line : Qheader_line;
+ string = mode_line_string (w, wx, wy, part, &charpos);
+ if (STRINGP (string))
+ string_info = Fcons (string, make_number (charpos));
+ }
+ else if (part == ON_VERTICAL_BORDER)
+ posn = Qvertical_line;
+ else if (part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN)
+ {
+ int charpos;
+ Lisp_Object object = marginal_area_string (w, wx, wy, part,
+ &charpos);
+ posn = (part == ON_LEFT_MARGIN) ? Qleft_margin : Qright_margin;
+ if (STRINGP (object))
+ string_info = Fcons (object, make_number (charpos));
+ }
+ else
+ {
+ Lisp_Object object;
+ struct display_pos p;
+ buffer_posn_from_coords (w, &wx, &wy, &object, &p);
+ posn = make_number (CHARPOS (p.pos));
+ if (STRINGP (object))
+ string_info
+ = Fcons (object,
+ make_number (CHARPOS (p.string_pos)));
+ }
+ }
+
+ position
+ = Fcons (window,
+ Fcons (posn,
+ Fcons (Fcons (event->x, event->y),
+ Fcons (make_number (event->timestamp),
+ (NILP (string_info)
+ ? Qnil
+ : Fcons (string_info, Qnil))))));
+
+ /* Set double or triple modifiers to indicate the wheel speed. */
+ {
+ /* On window-system frames, use the value of
+ double-click-fuzz as is. On other frames, interpret it
+ as a multiple of 1/8 characters. */
+ struct frame *f;
+ int fuzz;
+ int is_double;
+
+ if (WINDOWP (event->frame_or_window))
+ f = XFRAME (XWINDOW (event->frame_or_window)->frame);
+ else if (FRAMEP (event->frame_or_window))
+ f = XFRAME (event->frame_or_window);
+ else
+ abort ();
+
+ if (FRAME_WINDOW_P (f))
+ fuzz = double_click_fuzz;
+ else
+ fuzz = double_click_fuzz / 8;
+
+ is_double = (last_mouse_button < 0
+ && (abs (XINT (event->x) - last_mouse_x) <= fuzz)
+ && (abs (XINT (event->y) - last_mouse_y) <= fuzz)
+ && button_down_time != 0
+ && (EQ (Vdouble_click_time, Qt)
+ || (INTEGERP (Vdouble_click_time)
+ && ((int)(event->timestamp - button_down_time)
+ < XINT (Vdouble_click_time)))));
+ if (is_double)
+ {
+ double_click_count++;
+ event->modifiers |= ((double_click_count > 2)
+ ? triple_modifier
+ : double_modifier);
+ }
+ else
+ {
+ double_click_count = 1;
+ event->modifiers |= click_modifier;
+ }
+
+ button_down_time = event->timestamp;
+ /* Use a negative value to distinguish wheel from mouse button. */
+ last_mouse_button = -1;
+ last_mouse_x = XINT (event->x);
+ last_mouse_y = XINT (event->y);
+ }
+
+ {
+ int symbol_num;
+
+ if (event->modifiers & up_modifier)
+ {
+ /* Emit a wheel-up event. */
+ event->modifiers &= ~up_modifier;
+ symbol_num = 0;
+ }
+ else if (event->modifiers & down_modifier)
+ {
+ /* Emit a wheel-down event. */
+ event->modifiers &= ~down_modifier;
+ symbol_num = 1;
+ }
+ else
+ /* Every wheel event should either have the down_modifier or
+ the up_modifier set. */
+ abort ();
+
+ /* Get the symbol we should use for the wheel event. */
+ head = modify_event_symbol (symbol_num,
+ event->modifiers,
+ Qmouse_click,
+ Qnil,
+ lispy_wheel_names,
+ &wheel_syms,
+ ASIZE (wheel_syms));
+ }
+
+ if (event->modifiers & (double_modifier | triple_modifier))
+ return Fcons (head,
+ Fcons (position,
+ Fcons (make_number (double_click_count),
+ Qnil)));
+ else
+ return Fcons (head,
+ Fcons (position,
+ Qnil));
+ }
+
+
+#ifdef USE_TOOLKIT_SCROLL_BARS
/* We don't have down and up events if using toolkit scroll bars,
so make this always a click event. Store in the `part' of
The incoming input_event contains in its `part' member an
index of type `enum scroll_bar_part' which we can use as an
index in scroll_bar_parts to get the appropriate symbol. */
-
- case scroll_bar_click:
+
+ case SCROLL_BAR_CLICK_EVENT:
{
Lisp_Object position, head, window, portion_whole, part;
/* Always treat scroll bar events as clicks. */
event->modifiers |= click_modifier;
+ event->modifiers &= ~up_modifier;
+
+ if (event->code >= ASIZE (mouse_syms))
+ mouse_syms = larger_vector (mouse_syms, event->code + 1, Qnil);
/* Get the symbol we should use for the mouse click. */
head = modify_event_symbol (event->code,
event->modifiers,
- Qmouse_click,
+ Qmouse_click,
Vlispy_mouse_stem,
NULL, &mouse_syms,
XVECTOR (mouse_syms)->size);
return Fcons (head, Fcons (position, Qnil));
}
-
+
#endif /* USE_TOOLKIT_SCROLL_BARS */
#ifdef WINDOWSNT
- case w32_scroll_bar_click:
+ case W32_SCROLL_BAR_CLICK_EVENT:
{
int button = event->code;
int is_double;
head = modify_event_symbol (button,
event->modifiers,
- Qmouse_click,
+ Qmouse_click,
Vlispy_mouse_stem,
NULL, &mouse_syms,
XVECTOR (mouse_syms)->size);
Qnil));
}
}
- case mouse_wheel:
- {
- int part;
- FRAME_PTR f = XFRAME (event->frame_or_window);
- Lisp_Object window;
- Lisp_Object posn;
- Lisp_Object head, position;
- int row, column;
-
- /* Ignore mouse events that were made on frame that
- have been deleted. */
- if (! FRAME_LIVE_P (f))
- return Qnil;
- pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
- &column, &row, NULL, 1);
- window = window_from_coordinates (f, XINT (event->x),
- XINT (event->y), &part, 0);
-
- if (!WINDOWP (window))
- {
- window = event->frame_or_window;
- posn = Qnil;
- }
- else
- {
- int pixcolumn, pixrow;
- column -= XINT (XWINDOW (window)->left);
- row -= XINT (XWINDOW (window)->top);
- glyph_to_pixel_coords (XWINDOW(window), column, row,
- &pixcolumn, &pixrow);
- XSETINT (event->x, pixcolumn);
- XSETINT (event->y, pixrow);
-
- if (part == 1)
- posn = Qmode_line;
- else if (part == 2)
- posn = Qvertical_line;
- else if (part == 3)
- posn = Qheader_line;
- else
- {
- Lisp_Object object;
- struct display_pos p;
- buffer_posn_from_coords (XWINDOW (window), &column, &row,
- &object, &p);
- posn = make_number (CHARPOS (p.pos));
- }
- }
-
- {
- Lisp_Object head, position;
-
- position
- = Fcons (window,
- Fcons (posn,
- Fcons (Fcons (event->x, event->y),
- Fcons (make_number (event->timestamp),
- Qnil))));
-
- head = modify_event_symbol (0, event->modifiers,
- Qmouse_wheel, Qnil,
- lispy_mouse_wheel_names,
- &mouse_wheel_syms, 1);
- return Fcons (head,
- Fcons (position,
- Fcons (make_number (event->code),
- Qnil)));
- }
- }
#endif /* WINDOWSNT */
- case drag_n_drop:
+ case DRAG_N_DROP_EVENT:
{
- int part;
+ enum window_part part;
FRAME_PTR f;
Lisp_Object window;
Lisp_Object posn;
Lisp_Object files;
+ int wx, wy;
/* The frame_or_window field should be a cons of the frame in
which the event occurred and a list of the filenames
return Qnil;
window = window_from_coordinates (f, XINT (event->x),
- XINT (event->y), &part, 0);
+ XINT (event->y),
+ &part, &wx, &wy, 0);
if (!WINDOWP (window))
{
event->x/ event->y. */
struct window *w = XWINDOW (window);
- /* Get window relative coordinates. */
- int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x));
- int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y));
-
/* Set event coordinates to window-relative coordinates
for constructing the Lisp event below. */
XSETINT (event->x, wx);
XSETINT (event->y, wy);
- if (part == 1)
+ if (part == ON_MODE_LINE)
posn = Qmode_line;
- else if (part == 2)
+ else if (part == ON_VERTICAL_BORDER)
posn = Qvertical_line;
- else if (part == 3)
+ else if (part == ON_HEADER_LINE)
posn = Qheader_line;
else
{
}
#endif /* HAVE_MOUSE */
-#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
+#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (MAC_OS) \
+ || defined (USE_GTK)
case MENU_BAR_EVENT:
if (EQ (event->arg, event->frame_or_window))
/* This is the prefix key. We translate this to
return event->arg;
#endif
+ case SELECT_WINDOW_EVENT:
+ /* Make an event (select-window (WINDOW)). */
+ return Fcons (Qselect_window,
+ Fcons (Fcons (event->frame_or_window, Qnil),
+ Qnil));
+
case TOOL_BAR_EVENT:
if (EQ (event->arg, event->frame_or_window))
/* This is the prefix key. We translate this to
- `(tool_bar)' because the code in keyboard.c for menu
+ `(tool_bar)' because the code in keyboard.c for tool bar
events, which we use, relies on this. */
return Fcons (Qtool_bar, Qnil);
else if (SYMBOLP (event->arg))
case USER_SIGNAL_EVENT:
/* A user signal. */
return *lispy_user_signals[event->code];
-
+
+ case SAVE_SESSION_EVENT:
+ return Qsave_session;
+
/* The 'kind' field of the event is something we don't recognize. */
default:
abort ();
/* Or is it an ordinary mouse movement? */
else
{
- int area;
+ enum window_part area;
Lisp_Object window;
Lisp_Object posn;
+ int wx, wy;
if (frame)
/* It's in a frame; which window on that frame? */
- window = window_from_coordinates (frame, XINT (x), XINT (y), &area, 0);
+ window = window_from_coordinates (frame, XINT (x), XINT (y),
+ &area, &wx, &wy, 0);
else
window = Qnil;
if (WINDOWP (window))
{
struct window *w = XWINDOW (window);
- int wx, wy;
-
- /* Get window relative coordinates. */
- wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (x));
- wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (y));
+
+ /* Set window relative coordinates. */
XSETINT (x, wx);
XSETINT (y, wy);
-
- if (area == 1)
+
+ if (area == ON_MODE_LINE)
posn = Qmode_line;
- else if (area == 2)
+ else if (area == ON_VERTICAL_BORDER)
posn = Qvertical_line;
- else if (area == 3)
+ else if (area == ON_HEADER_LINE)
posn = Qheader_line;
else
{
Lisp_Object symbol;
int *modifier_end;
{
- struct Lisp_String *name;
+ Lisp_Object name;
int i;
int modifiers;
CHECK_SYMBOL (symbol);
modifiers = 0;
- name = XSYMBOL (symbol)->name;
+ name = SYMBOL_NAME (symbol);
- for (i = 0; i+2 <= STRING_BYTES (name); )
+ for (i = 0; i+2 <= SBYTES (name); )
{
int this_mod_end = 0;
int this_mod = 0;
Check that the word appears, but don't check what follows it.
Set this_mod and this_mod_end to record what we find. */
- switch (name->data[i])
+ switch (SREF (name, i))
{
#define SINGLE_LETTER_MOD(BIT) \
(this_mod_end = i + 1, this_mod = BIT)
break;
#undef SINGLE_LETTER_MOD
+
+#define MULTI_LETTER_MOD(BIT, NAME, LEN) \
+ if (i + LEN + 1 <= SBYTES (name) \
+ && ! strncmp (SDATA (name) + i, NAME, LEN)) \
+ { \
+ this_mod_end = i + LEN; \
+ this_mod = BIT; \
+ }
+
+ case 'd':
+ MULTI_LETTER_MOD (drag_modifier, "drag", 4);
+ MULTI_LETTER_MOD (down_modifier, "down", 4);
+ MULTI_LETTER_MOD (double_modifier, "double", 6);
+ break;
+
+ case 't':
+ MULTI_LETTER_MOD (triple_modifier, "triple", 6);
+ break;
+#undef MULTI_LETTER_MOD
+
}
/* If we found no modifier, stop looking for them. */
/* Check there is a dash after the modifier, so that it
really is a modifier. */
- if (this_mod_end >= STRING_BYTES (name)
- || name->data[this_mod_end] != '-')
+ if (this_mod_end >= SBYTES (name)
+ || SREF (name, this_mod_end) != '-')
break;
/* This modifier is real; look for another. */
/* Should we include the `click' modifier? */
if (! (modifiers & (down_modifier | drag_modifier
| double_modifier | triple_modifier))
- && i + 7 == STRING_BYTES (name)
- && strncmp (name->data + i, "mouse-", 6) == 0
- && ('0' <= name->data[i + 6] && name->data[i + 6] <= '9'))
+ && i + 7 == SBYTES (name)
+ && strncmp (SDATA (name) + i, "mouse-", 6) == 0
+ && ('0' <= SREF (name, i + 6) && SREF (name, i + 6) <= '9'))
modifiers |= click_modifier;
if (modifier_end)
new_name = make_uninit_multibyte_string (mod_len + base_len,
mod_len + base_len_byte);
- bcopy (new_mods, XSTRING (new_name)->data, mod_len);
- bcopy (base, XSTRING (new_name)->data + mod_len, base_len_byte);
+ bcopy (new_mods, SDATA (new_name), mod_len);
+ bcopy (base, SDATA (new_name) + mod_len, base_len_byte);
return Fintern (new_name, Qnil);
}
Lisp_Object unmodified;
Lisp_Object mask;
- unmodified = Fintern (make_string (XSYMBOL (symbol)->name->data + end,
- STRING_BYTES (XSYMBOL (symbol)->name) - end),
+ unmodified = Fintern (make_string (SDATA (SYMBOL_NAME (symbol)) + end,
+ SBYTES (SYMBOL_NAME (symbol)) - end),
Qnil);
if (modifiers & ~VALMASK)
{
/* We have to create the symbol ourselves. */
new_symbol = apply_modifiers_uncached (modifiers,
- XSYMBOL (base)->name->data,
- XSYMBOL (base)->name->size,
- STRING_BYTES (XSYMBOL (base)->name));
+ SDATA (SYMBOL_NAME (base)),
+ SCHARS (SYMBOL_NAME (base)),
+ SBYTES (SYMBOL_NAME (base)));
/* Add the new symbol to the base's cache. */
entry = Fcons (index, new_symbol);
Fput (base, Qmodifier_cache, Fcons (entry, cache));
- /* We have the parsing info now for free, so add it to the caches. */
- XSETFASTINT (index, modifiers);
- Fput (new_symbol, Qevent_symbol_element_mask,
- Fcons (base, Fcons (index, Qnil)));
- Fput (new_symbol, Qevent_symbol_elements,
- Fcons (base, lispy_modifier_list (modifiers)));
+ /* We have the parsing info now for free, so we could add it to
+ the caches:
+ XSETFASTINT (index, modifiers);
+ Fput (new_symbol, Qevent_symbol_element_mask,
+ Fcons (base, Fcons (index, Qnil)));
+ Fput (new_symbol, Qevent_symbol_elements,
+ Fcons (base, lispy_modifier_list (modifiers)));
+ Sadly, this is only correct if `base' is indeed a base event,
+ which is not necessarily the case. -stef */
}
/* Make sure this symbol is of the same kind as BASE.
value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem));
else if (STRINGP (name_alist_or_stem))
{
- int len = STRING_BYTES (XSTRING (name_alist_or_stem));
- char *buf = (char *) alloca (len + 50);
-
+ int len = SBYTES (name_alist_or_stem);
+ char *buf = (char *) alloca (len + 50);
if (sizeof (int) == sizeof (EMACS_INT))
- sprintf (buf, "%s-%d", XSTRING (name_alist_or_stem)->data,
+ sprintf (buf, "%s-%d", SDATA (name_alist_or_stem),
XINT (symbol_int) + 1);
else if (sizeof (long) == sizeof (EMACS_INT))
- sprintf (buf, "%s-%ld", XSTRING (name_alist_or_stem)->data,
+ sprintf (buf, "%s-%ld", SDATA (name_alist_or_stem),
XINT (symbol_int) + 1);
+ else
+ abort ();
value = intern (buf);
}
else if (name_table != 0 && name_table[symbol_num])
}
/* Let the symbol A refer to the character A. */
- if (SYMBOLP (base) && XSYMBOL (base)->name->size == 1)
- XSETINT (base, XSYMBOL (base)->name->data[0]);
+ if (SYMBOLP (base) && SCHARS (SYMBOL_NAME (base)) == 1)
+ XSETINT (base, SREF (SYMBOL_NAME (base), 0));
if (INTEGERP (base))
{
parse_solitary_modifier (symbol)
Lisp_Object symbol;
{
- struct Lisp_String *name = XSYMBOL (symbol)->name;
+ Lisp_Object name = SYMBOL_NAME (symbol);
- switch (name->data[0])
+ switch (SREF (name, 0))
{
#define SINGLE_LETTER_MOD(BIT) \
- if (STRING_BYTES (name) == 1) \
+ if (SBYTES (name) == 1) \
return BIT;
#define MULTI_LETTER_MOD(BIT, NAME, LEN) \
- if (LEN == STRING_BYTES (name) \
- && ! strncmp (name->data, NAME, LEN)) \
+ if (LEN == SBYTES (name) \
+ && ! strncmp (SDATA (name), NAME, LEN)) \
return BIT;
case 'A':
but works even if FIONREAD does not exist.
(In fact, this may actually read some input.)
- If DO_TIMERS_NOW is nonzero, actually run timer events that are ripe. */
+ If DO_TIMERS_NOW is nonzero, actually run timer events that are ripe.
+ If FILTER_EVENTS is nonzero, ignore internal events (FOCUS_IN_EVENT). */
static void
-get_input_pending (addr, do_timers_now)
+get_filtered_input_pending (addr, do_timers_now, filter_events)
int *addr;
int do_timers_now;
+ int filter_events;
{
/* First of all, have we already counted some input? */
- *addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
+ *addr = (!NILP (Vquit_flag)
+ || readable_filtered_events (do_timers_now, filter_events));
/* If input is being read as it arrives, and we have none, there is none. */
if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
/* Try to read some input and see how much we get. */
gobble_input (0);
- *addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
+ *addr = (!NILP (Vquit_flag)
+ || readable_filtered_events (do_timers_now, filter_events));
+}
+
+/* Store into *addr a value nonzero if terminal input chars are available.
+ Serves the purpose of ioctl (0, FIONREAD, addr)
+ but works even if FIONREAD does not exist.
+ (In fact, this may actually read some input.)
+
+ If DO_TIMERS_NOW is nonzero, actually run timer events that are ripe. */
+
+static void
+get_input_pending (addr, do_timers_now)
+ int *addr;
+ int do_timers_now;
+{
+ get_filtered_input_pending (addr, do_timers_now, 0);
}
/* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
#endif
}
-/* Put a buffer_switch_event in the buffer
+/* Put a BUFFER_SWITCH_EVENT in the buffer
so that read_key_sequence will notice the new current buffer. */
void
{
struct input_event event;
Lisp_Object tem;
+ EVENT_INIT (event);
- event.kind = buffer_switch_event;
+ event.kind = BUFFER_SWITCH_EVENT;
event.frame_or_window = Qnil;
event.arg = Qnil;
register int i;
int nread;
+ for (i = 0; i < KBD_BUFFER_SIZE; i++)
+ EVENT_INIT (buf[i]);
+
if (read_socket_hook)
/* No need for FIONREAD or fcntl; just say don't wait. */
nread = (*read_socket_hook) (input_fd, buf, KBD_BUFFER_SIZE, expected);
/* ??? Is it really right to send the signal just to this process
rather than to the whole process group?
Perhaps on systems with FIONREAD Emacs is alone in its group. */
- kill (getpid (), SIGHUP);
+ {
+ if (! noninteractive)
+ kill (getpid (), SIGHUP);
+ else
+ n_to_read = 0;
+ }
if (n_to_read == 0)
return 0;
if (n_to_read > sizeof cbuf)
n_to_read = sizeof cbuf;
#else /* no FIONREAD */
-#if defined (USG) || defined (DGUX)
+#if defined (USG) || defined (DGUX) || defined(CYGWIN)
/* Read some input if available, but don't wait. */
n_to_read = sizeof cbuf;
fcntl (input_fd, F_SETFL, O_NDELAY);
);
#ifndef FIONREAD
-#if defined (USG) || defined (DGUX)
+#if defined (USG) || defined (DGUX) || defined (CYGWIN)
fcntl (input_fd, F_SETFL, 0);
-#endif /* USG or DGUX */
+#endif /* USG or DGUX or CYGWIN */
#endif /* no FIONREAD */
for (i = 0; i < nread; i++)
{
- buf[i].kind = ascii_keystroke;
+ buf[i].kind = ASCII_KEYSTROKE_EVENT;
buf[i].modifiers = 0;
if (meta_key == 1 && (cbuf[i] & 0x80))
buf[i].modifiers = meta_modifier;
kbd_buffer_store_event (&buf[i]);
/* Don't look at input that follows a C-g too closely.
This reduces lossage due to autorepeat on C-g. */
- if (buf[i].kind == ascii_keystroke
+ if (buf[i].kind == ASCII_KEYSTROKE_EVENT
&& buf[i].code == quit_char)
break;
}
#ifdef SIGIO /* for entire page */
/* Note SIGIO has been undef'd if FIONREAD is missing. */
-SIGTYPE
+static SIGTYPE
input_available_signal (signo)
int signo;
{
\f
-static void menu_bar_item P_ ((Lisp_Object, Lisp_Object));
-static void menu_bar_one_keymap P_ ((Lisp_Object));
+static void menu_bar_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object, void*));
+static Lisp_Object menu_bar_one_keymap_changed_items;
/* These variables hold the vector under construction within
menu_bar_items and its subroutines, and the current index
}
else
{
- /* No, so use major and minor mode keymaps.
- Don't include local-map or keymap properties, as menu-bar
- bindings are not supported in those maps (that would require
- checking for menu-bar updates after every command). */
- nmaps = current_minor_maps (NULL, &tmaps);
- maps = (Lisp_Object *) alloca ((nmaps + 2) * sizeof (maps[0]));
- bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
- maps[nmaps++] = current_buffer->keymap;
+ /* No, so use major and minor mode keymaps and keymap property.
+ Note that menu-bar bindings in the local-map and keymap
+ properties may not work reliable, as they are only
+ recognized when the menu-bar (or mode-line) is updated,
+ which does not normally happen after every command. */
+ Lisp_Object tem;
+ int nminor;
+ nminor = current_minor_maps (NULL, &tmaps);
+ maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
+ nmaps = 0;
+ if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
+ maps[nmaps++] = tem;
+ bcopy (tmaps, (void *) (maps + nmaps), nminor * sizeof (maps[0]));
+ nmaps += nminor;
+ maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
}
maps[nmaps++] = current_global_map;
}
def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1),
0, 1);
if (CONSP (def))
- menu_bar_one_keymap (def);
+ {
+ menu_bar_one_keymap_changed_items = Qnil;
+ map_keymap (def, menu_bar_item, Qnil, NULL, 1);
+ }
}
/* Move to the end those items that should be at the end. */
return menu_bar_items_vector;
}
\f
-/* Scan one map KEYMAP, accumulating any menu items it defines
- in menu_bar_items_vector. */
-
-static Lisp_Object menu_bar_one_keymap_changed_items;
-
-static void
-menu_bar_one_keymap (keymap)
- Lisp_Object keymap;
-{
- Lisp_Object tail, item;
-
- menu_bar_one_keymap_changed_items = Qnil;
-
- /* Loop over all keymap entries that have menu strings. */
- for (tail = keymap; CONSP (tail); tail = XCDR (tail))
- {
- item = XCAR (tail);
- if (CONSP (item))
- menu_bar_item (XCAR (item), XCDR (item));
- else if (VECTORP (item))
- {
- /* Loop over the char values represented in the vector. */
- int len = XVECTOR (item)->size;
- int c;
- for (c = 0; c < len; c++)
- {
- Lisp_Object character;
- XSETFASTINT (character, c);
- menu_bar_item (character, XVECTOR (item)->contents[c]);
- }
- }
- }
-}
-
/* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
If there's already an item for KEY, add this DEF to it. */
Lisp_Object item_properties;
static void
-menu_bar_item (key, item)
- Lisp_Object key, item;
+menu_bar_item (key, item, dummy1, dummy2)
+ Lisp_Object key, item, dummy1;
+ void *dummy2;
{
struct gcpro gcpro1;
int i;
{
Lisp_Object old;
old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
- XVECTOR (menu_bar_items_vector)->contents[i + 2] = Fcons (item, old);
+ /* If the new and the old items are not both keymaps,
+ the lookup will only find `item'. */
+ item = Fcons (item, KEYMAPP (item) && KEYMAPP (XCAR (old)) ? old : Qnil);
+ XVECTOR (menu_bar_items_vector)->contents[i + 2] = item;
}
}
\f
return Qnil;
}
-/* Evaluate an expression and return the result (or nil if something
+/* Evaluate an expression and return the result (or nil if something
went wrong). Used to evaluate dynamic parts of menu items. */
Lisp_Object
menu_item_eval_property (sexpr)
Lisp_Object sexpr;
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object val;
specbind (Qinhibit_redisplay, Qt);
val = internal_condition_case_1 (Feval, sexpr, Qerror,
for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
AREF (item_properties, i) = Qnil;
AREF (item_properties, ITEM_PROPERTY_ENABLE) = Qt;
-
+
/* Save the item here to protect it from GC. */
AREF (item_properties, ITEM_PROPERTY_ITEM) = item;
start = item;
item = XCDR (item);
}
-
+
/* Maybe key binding cache. */
if (CONSP (item) && CONSP (XCAR (item))
&& (NILP (XCAR (XCAR (item)))
cachelist = XCAR (item);
item = XCDR (item);
}
-
+
/* This is the real definition--the function to run. */
AREF (item_properties, ITEM_PROPERTY_DEF) = item;
return 0;
AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
}
-
+
/* If got a filter apply it on definition. */
def = AREF (item_properties, ITEM_PROPERTY_DEF);
if (!NILP (filter))
is OK in a submenu but not in the menubar. */
if (NILP (def))
return (inmenubar ? 0 : 1);
-
+
/* See if this is a separate pane or a submenu. */
def = AREF (item_properties, ITEM_PROPERTY_DEF);
tem = get_keymap (def, 0, 1);
AREF (item_properties, ITEM_PROPERTY_DEF) = tem;
return 1;
}
-
+
/* At the top level in the menu bar, do likewise for commands also.
The menu bar does not display equivalent key bindings anyway.
ITEM_PROPERTY_DEF is already set up properly. */
XSETCAR (cachelist, Qt);
}
}
-
+
tem = XCAR (cachelist);
if (!EQ (tem, Qt))
{
}
*/
- /* Handle radio buttons or toggle boxes. */
+ /* Handle radio buttons or toggle boxes. */
tem = AREF (item_properties, ITEM_PROPERTY_SELECTED);
if (!NILP (tem))
AREF (item_properties, ITEM_PROPERTY_SELECTED)
***********************************************************************/
/* A vector holding tool bar items while they are parsed in function
- tool_bar_items runs Each item occupies TOOL_BAR_ITEM_NSCLOTS elements
+ tool_bar_items. Each item occupies TOOL_BAR_ITEM_NSCLOTS elements
in the vector. */
static Lisp_Object tool_bar_items_vector;
int nmaps, i;
Lisp_Object oquit;
Lisp_Object *tmaps;
- extern Lisp_Object Voverriding_local_map_menu_flag;
- extern Lisp_Object Voverriding_local_map;
*nitems = 0;
avoids risk of specpdl overflow. */
oquit = Vinhibit_quit;
Vinhibit_quit = Qt;
-
+
/* Initialize tool_bar_items_vector and protect it from GC. */
init_tool_bar_items (reuse);
/* Build list of keymaps in maps. Set nmaps to the number of maps
to process. */
-
+
/* Should overriding-terminal-local-map and overriding-local-map apply? */
if (!NILP (Voverriding_local_map_menu_flag))
{
}
else
{
- /* No, so use major and minor mode keymaps.
- Don't include local-map or keymap properties, as tool-bar
- bindings are not supported in those maps (that would require
- checking for tool-bar updates after every command). */
- nmaps = current_minor_maps (NULL, &tmaps);
- maps = (Lisp_Object *) alloca ((nmaps + 2) * sizeof (maps[0]));
- bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
- maps[nmaps++] = current_buffer->keymap;
+ /* No, so use major and minor mode keymaps and keymap property.
+ Note that tool-bar bindings in the local-map and keymap
+ properties may not work reliable, as they are only
+ recognized when the tool-bar (or mode-line) is updated,
+ which does not normally happen after every command. */
+ Lisp_Object tem;
+ int nminor;
+ nminor = current_minor_maps (NULL, &tmaps);
+ maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
+ nmaps = 0;
+ if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
+ maps[nmaps++] = tem;
+ bcopy (tmaps, (void *) (maps + nmaps), nminor * sizeof (maps[0]));
+ nmaps += nminor;
+ maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
}
/* Add global keymap at the end. */
if (CONSP (keymap))
{
Lisp_Object tail;
-
+
/* KEYMAP is a list `(keymap (KEY . BINDING) ...)'. */
for (tail = keymap; CONSP (tail); tail = XCDR (tail))
{
for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS)
{
Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i;
-
+
if (EQ (key, v[TOOL_BAR_ITEM_KEY]))
{
if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
invalid.
ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
-
+
CAPTION is the caption of the item, If it's not a string, it is
evaluated to get a string.
-
+
BINDING is the tool bar item's binding. Tool-bar items with keymaps
as binding are currently ignored.
The following properties are recognized:
- `:enable FORM'.
-
+
FORM is evaluated and specifies whether the tool bar item is
enabled or disabled.
-
+
- `:visible FORM'
-
+
FORM is evaluated and specifies whether the tool bar item is visible.
-
+
- `:filter FUNCTION'
FUNCTION is invoked with one parameter `(quote BINDING)'. Its
result is stored as the new binding.
-
+
- `:button (TYPE SELECTED)'
TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated
and specifies whether the button is selected (pressed) or not.
-
+
- `:image IMAGES'
IMAGES is either a single image specification or a vector of four
image specifications. See enum tool_bar_item_images.
-
+
- `:help HELP-STRING'.
-
+
Gives a help string to display for the tool bar item. */
static int
else
tool_bar_item_properties
= Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil);
-
+
/* Set defaults. */
PROP (TOOL_BAR_ITEM_KEY) = key;
PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt;
-
+
/* Get the caption of the item. If the caption is not a string,
evaluate it to get a string. If we don't get a string, skip this
item. */
&& (CONSP (value)
|| (VECTORP (value) && XVECTOR (value)->size == 4)))
/* Value is either a single image specification or a vector
- of 4 such specifications for the different buttion states. */
+ of 4 such specifications for the different button states. */
PROP (TOOL_BAR_ITEM_IMAGES) = value;
}
PROP (TOOL_BAR_ITEM_ENABLED_P)
= menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P));
- /* Handle radio buttons or toggle boxes. */
+ /* Handle radio buttons or toggle boxes. */
if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
PROP (TOOL_BAR_ITEM_SELECTED_P)
= menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P));
return 1;
-
+
#undef PROP
}
append_tool_bar_item ()
{
Lisp_Object *to, *from;
-
+
/* Enlarge tool_bar_items_vector if necessary. */
if (ntool_bar_items + TOOL_BAR_ITEM_NSLOTS
>= XVECTOR (tool_bar_items_vector)->size)
int *used_mouse_menu;
{
int mapno;
- register Lisp_Object name;
+ register Lisp_Object name = Qnil;
if (used_mouse_menu)
*used_mouse_menu = 0;
}
/* If we don't have any menus, just read a character normally. */
- if (mapno >= nmaps)
+ if (!STRINGP (name))
return Qnil;
#ifdef HAVE_MENUS
int mapno;
register Lisp_Object name;
int nlength;
- int width = FRAME_WIDTH (SELECTED_FRAME ()) - 4;
+ /* FIXME: Use the minibuffer's frame width. */
+ int width = FRAME_COLS (SELECTED_FRAME ()) - 4;
int idx = -1;
int nobindings = 1;
Lisp_Object rest, vector;
}
/* If we don't have any menus, just read a character normally. */
- if (!STRINGP (name));
+ if (!STRINGP (name))
return Qnil;
/* Prompt string always starts with map's prompt, and a space. */
- strcpy (menu, XSTRING (name)->data);
- nlength = STRING_BYTES (XSTRING (name));
+ strcpy (menu, SDATA (name));
+ nlength = SBYTES (name);
menu[nlength++] = ':';
menu[nlength++] = ' ';
menu[nlength] = 0;
upcased_event = Fupcase (event);
downcased_event = Fdowncase (event);
- char_matches = (XINT (upcased_event) == XSTRING (s)->data[0]
- || XINT (downcased_event) == XSTRING (s)->data[0]);
+ char_matches = (XINT (upcased_event) == SREF (s, 0)
+ || XINT (downcased_event) == SREF (s, 0));
if (! char_matches)
desc = Fsingle_key_description (event, Qnil);
+#if 0 /* It is redundant to list the equivalent key bindings because
+ the prefix is what the user has already typed. */
tem
= XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
if (!NILP (tem))
/* Insert equivalent keybinding. */
s = concat2 (s, tem);
-
+#endif
tem
= XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
tem = build_string (NILP (selected) ? "[X] " : "[ ] ");
s = concat2 (tem, s);
}
-
+
/* If we have room for the prompt string, add it to this line.
If this is the first on the line, always add it. */
- if ((XSTRING (s)->size + i + 2
- + (char_matches ? 0 : XSTRING (desc)->size + 3))
+ if ((SCHARS (s) + i + 2
+ + (char_matches ? 0 : SCHARS (desc) + 3))
< width
|| !notfirst)
{
if (! char_matches)
{
/* Add as much of string as fits. */
- thiswidth = XSTRING (desc)->size;
+ thiswidth = SCHARS (desc);
if (thiswidth + i > width)
thiswidth = width - i;
- bcopy (XSTRING (desc)->data, menu + i, thiswidth);
+ bcopy (SDATA (desc), menu + i, thiswidth);
i += thiswidth;
strcpy (menu + i, " = ");
i += 3;
}
/* Add as much of string as fits. */
- thiswidth = XSTRING (s)->size;
+ thiswidth = SCHARS (s);
if (thiswidth + i > width)
thiswidth = width - i;
- bcopy (XSTRING (s)->data, menu + i, thiswidth);
+ bcopy (SDATA (s), menu + i, thiswidth);
i += thiswidth;
menu[i] = 0;
}
}
/* Prompt with that and read response. */
- message2_nolog (menu, strlen (menu),
+ message2_nolog (menu, strlen (menu),
! NILP (current_buffer->enable_multibyte_characters));
/* Make believe its not a keyboard macro in case the help char
int nmaps;
{
int i, first_binding;
- int did_meta = 0;
first_binding = nmaps;
for (i = nmaps - 1; i >= 0; i--)
{
if (! NILP (current[i]))
{
- Lisp_Object map;
- if (did_meta)
- map = defs[i];
- else
- map = current[i];
-
- defs[i] = access_keymap (map, key, 1, 0, 1);
+ defs[i] = access_keymap (current[i], key, 1, 0, 1);
if (! NILP (defs[i]))
first_binding = i;
}
return first_binding;
}
+/* Structure used to keep track of partial application of key remapping
+ such as Vfunction_key_map and Vkey_translation_map. */
+typedef struct keyremap
+{
+ Lisp_Object map, parent;
+ int start, end;
+} keyremap;
+
+/* Lookup KEY in MAP.
+ MAP is a keymap mapping keys to key vectors or functions.
+ If the mapping is a function and DO_FUNCTION is non-zero, then
+ the function is called with PROMPT as parameter and its return
+ value is used as the return value of this function (after checking
+ that it is indeed a vector). */
+
+static Lisp_Object
+access_keymap_keyremap (map, key, prompt, do_funcall)
+ Lisp_Object map, key, prompt;
+ int do_funcall;
+{
+ Lisp_Object next;
+
+ next = access_keymap (map, key, 1, 0, 1);
+
+ /* Handle symbol with autoload definition. */
+ if (SYMBOLP (next) && !NILP (Ffboundp (next))
+ && CONSP (XSYMBOL (next)->function)
+ && EQ (XCAR (XSYMBOL (next)->function), Qautoload))
+ do_autoload (XSYMBOL (next)->function, next);
+
+ /* Handle a symbol whose function definition is a keymap
+ or an array. */
+ if (SYMBOLP (next) && !NILP (Ffboundp (next))
+ && (!NILP (Farrayp (XSYMBOL (next)->function))
+ || KEYMAPP (XSYMBOL (next)->function)))
+ next = XSYMBOL (next)->function;
+
+ /* If the keymap gives a function, not an
+ array, then call the function with one arg and use
+ its value instead. */
+ if (SYMBOLP (next) && !NILP (Ffboundp (next)) && do_funcall)
+ {
+ Lisp_Object tem;
+ tem = next;
+
+ next = call1 (next, prompt);
+ /* If the function returned something invalid,
+ barf--don't ignore it.
+ (To ignore it safely, we would need to gcpro a bunch of
+ other variables.) */
+ if (! (VECTORP (next) || STRINGP (next)))
+ error ("Function %s returns invalid key sequence", tem);
+ }
+ return next;
+}
+
+/* Do one step of the key remapping used for function-key-map and
+ key-translation-map:
+ KEYBUF is the buffer holding the input events.
+ BUFSIZE is its maximum size.
+ FKEY is a pointer to the keyremap structure to use.
+ INPUT is the index of the last element in KEYBUF.
+ DOIT if non-zero says that the remapping can actually take place.
+ DIFF is used to return the number of keys added/removed by the remapping.
+ PARENT is the root of the keymap.
+ PROMPT is the prompt to use if the remapping happens through a function.
+ The return value is non-zero if the remapping actually took place. */
+
+static int
+keyremap_step (keybuf, bufsize, fkey, input, doit, diff, prompt)
+ Lisp_Object *keybuf, prompt;
+ keyremap *fkey;
+ int input, doit, *diff, bufsize;
+{
+ Lisp_Object next, key;
+
+ key = keybuf[fkey->end++];
+ next = access_keymap_keyremap (fkey->map, key, prompt, doit);
+
+ /* If keybuf[fkey->start..fkey->end] is bound in the
+ map and we're in a position to do the key remapping, replace it with
+ the binding and restart with fkey->start at the end. */
+ if ((VECTORP (next) || STRINGP (next)) && doit)
+ {
+ int len = XFASTINT (Flength (next));
+ int i;
+
+ *diff = len - (fkey->end - fkey->start);
+
+ if (input + *diff >= bufsize)
+ error ("Key sequence too long");
+
+ /* Shift the keys that follow fkey->end. */
+ if (*diff < 0)
+ for (i = fkey->end; i < input; i++)
+ keybuf[i + *diff] = keybuf[i];
+ else if (*diff > 0)
+ for (i = input - 1; i >= fkey->end; i--)
+ keybuf[i + *diff] = keybuf[i];
+ /* Overwrite the old keys with the new ones. */
+ for (i = 0; i < len; i++)
+ keybuf[fkey->start + i]
+ = Faref (next, make_number (i));
+
+ fkey->start = fkey->end += *diff;
+ fkey->map = fkey->parent;
+
+ return 1;
+ }
+
+ fkey->map = get_keymap (next, 0, 1);
+
+ /* If we no longer have a bound suffix, try a new position for
+ fkey->start. */
+ if (!CONSP (fkey->map))
+ {
+ fkey->end = ++fkey->start;
+ fkey->map = fkey->parent;
+ }
+ return 0;
+}
+
/* Read a sequence of keys that ends with a non prefix character,
storing it in KEYBUF, a buffer of size BUFSIZE.
Prompt with PROMPT.
int fix_current_buffer;
{
volatile Lisp_Object from_string;
- volatile int count = specpdl_ptr - specpdl;
+ volatile int count = SPECPDL_INDEX ();
/* How many keys there are in the current key sequence. */
volatile int t;
defs[i] is non-nil. */
volatile int first_binding;
/* Index of the first key that has no binding.
- It is useless to try fkey_start larger than that. */
+ It is useless to try fkey.start larger than that. */
volatile int first_unbound;
/* If t < mock_input, then KEYBUF[t] should be read as the next
volatile int mock_input = 0;
/* If the sequence is unbound in submaps[], then
- keybuf[fkey_start..fkey_end-1] is a prefix in Vfunction_key_map,
- and fkey_map is its binding.
+ keybuf[fkey.start..fkey.end-1] is a prefix in Vfunction_key_map,
+ and fkey.map is its binding.
These might be > t, indicating that all function key scanning
should hold off until t reaches them. We do this when we've just
recognized a function key, to avoid searching for the function
key's again in Vfunction_key_map. */
- volatile int fkey_start = 0, fkey_end = 0;
- volatile Lisp_Object fkey_map;
+ volatile keyremap fkey;
/* Likewise, for key_translation_map. */
- volatile int keytran_start = 0, keytran_end = 0;
- volatile Lisp_Object keytran_map;
+ volatile keyremap keytran;
- /* If we receive a ``switch-frame'' event in the middle of a key sequence,
- we put it off for later. While we're reading, we keep the event here. */
+ /* If we receive a `switch-frame' or `select-window' event in the middle of
+ a key sequence, we put it off for later.
+ While we're reading, we keep the event here. */
volatile Lisp_Object delayed_switch_frame;
/* See the comment below... */
struct buffer *starting_buffer;
- /* Nonzero if we seem to have got the beginning of a binding
- in function_key_map. */
- volatile int function_key_possible = 0;
- volatile int key_translation_possible = 0;
-
/* List of events for which a fake prefix key has been generated. */
volatile Lisp_Object fake_prefixed_keys = Qnil;
- /* Save the status of key translation before each step,
- so that we can restore this after downcasing. */
- Lisp_Object prev_fkey_map;
- int prev_fkey_start;
- int prev_fkey_end;
-
- Lisp_Object prev_keytran_map;
- int prev_keytran_start;
- int prev_keytran_end;
-
#if defined (GOBBLE_FIRST_EVENT)
int junk;
#endif
last_nonmenu_event = Qnil;
delayed_switch_frame = Qnil;
- fkey_map = Vfunction_key_map;
- keytran_map = Vkey_translation_map;
-
- /* If there is no function-key-map, turn off function key scanning. */
- if (!KEYMAPP (Vfunction_key_map))
- fkey_start = fkey_end = bufsize + 1;
-
- /* If there is no key-translation-map, turn off scanning. */
- if (!KEYMAPP (Vkey_translation_map))
- keytran_start = keytran_end = bufsize + 1;
+ fkey.map = fkey.parent = Vfunction_key_map;
+ keytran.map = keytran.parent = Vkey_translation_map;
+ /* If there is no translation-map, turn off scanning. */
+ fkey.start = fkey.end = KEYMAPP (fkey.map) ? 0 : bufsize + 1;
+ keytran.start = keytran.end = KEYMAPP (keytran.map) ? 0 : bufsize + 1;
if (INTERACTIVE)
{
replay_sequence:
starting_buffer = current_buffer;
- function_key_possible = 0;
- key_translation_possible = 0;
first_unbound = bufsize + 1;
/* Build our list of keymaps.
/* If the best binding for the current key sequence is a keymap, or
we may be looking at a function key's escape sequence, keep on
reading. */
- while ((first_binding < nmaps && ! NILP (submaps[first_binding]))
- || (first_binding >= nmaps
- && fkey_start < t)
- || (first_binding >= nmaps
- && keytran_start < t && key_translation_possible)
+ while (first_binding < nmaps
+ /* Keep reading as long as there's a prefix binding. */
+ ? !NILP (submaps[first_binding])
/* Don't return in the middle of a possible function key sequence,
if the only bindings we found were via case conversion.
Thus, if ESC O a has a function-key-map translation
and ESC o has a binding, don't return after ESC O,
so that we can translate ESC O plus the next character. */
- )
+ : (fkey.start < t || keytran.start < t))
{
Lisp_Object key;
int used_mouse_menu = 0;
just one key. */
volatile int echo_local_start, keys_local_start, local_first_binding;
+ eassert (fkey.end == t || (fkey.end > t && fkey.end <= mock_input));
+ eassert (fkey.start <= fkey.end);
+ eassert (keytran.start <= keytran.end);
+ /* key-translation-map is applied *after* function-key-map. */
+ eassert (keytran.end <= fkey.start);
- if (first_unbound < fkey_start && first_unbound < keytran_start)
+ if (first_unbound < fkey.start && first_unbound < keytran.start)
{ /* The prefix upto first_unbound has no binding and has
no translation left to do either, so we know it's unbound.
If we don't stop now, we risk staying here indefinitely
for (i = first_unbound + 1; i < t; i++)
keybuf[i - first_unbound - 1] = keybuf[i];
mock_input = t - first_unbound - 1;
- fkey_end = fkey_start -= first_unbound + 1;
- fkey_map = Vfunction_key_map;
- keytran_end = keytran_start -= first_unbound + 1;
- keytran_map = Vkey_translation_map;
+ fkey.end = fkey.start -= first_unbound + 1;
+ fkey.map = fkey.parent;
+ keytran.end = keytran.start -= first_unbound + 1;
+ keytran.map = keytran.parent;
goto replay_sequence;
}
keymap may have changed, so replay the sequence. */
if (BUFFERP (key))
{
+ EMACS_TIME initial_idleness_start_time;
+ EMACS_SET_SECS_USECS (initial_idleness_start_time,
+ EMACS_SECS (timer_last_idleness_start_time),
+ EMACS_USECS (timer_last_idleness_start_time));
+
+ /* Resume idle state, using the same start-time as before. */
+ timer_start_idle ();
+ timer_idleness_start_time = initial_idleness_start_time;
+
mock_input = t;
/* Reset the current buffer from the selected window
in case something changed the former and not the latter.
Vquit_flag = Qnil;
if (EVENT_HAS_PARAMETERS (key)
+ /* Either a `switch-frame' or a `select-window' event. */
&& EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame))
{
/* If we're at the beginning of a key sequence, and the caller
orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
goto replay_sequence;
}
-
+
/* For a mouse click, get the local text-property keymap
of the place clicked on, rather than point. */
if (last_real_key_start == 0
localized_local_map = 1;
start = EVENT_START (key);
-
+
if (CONSP (start) && CONSP (XCDR (start)))
{
pos = POSN_BUFFER_POSN (start);
{
if (t + 1 >= bufsize)
error ("Key sequence too long");
-
+
keybuf[t] = posn;
keybuf[t + 1] = key;
mock_input = t + 2;
/* Record that a fake prefix key has been generated
for KEY. Don't modify the event; this would
prevent proper action when the event is pushed
- back tino unread-command-events. */
+ back into unread-command-events. */
fake_prefixed_keys = Fcons (key, fake_prefixed_keys);
/* If on a mode line string with a local keymap,
pos = XCDR (string);
string = XCAR (string);
if (XINT (pos) >= 0
- && XINT (pos) < XSTRING (string)->size)
+ && XINT (pos) < SCHARS (string))
{
map = Fget_text_property (pos, Qlocal_map, string);
if (!NILP (map))
pos = XCDR (string);
string = XCAR (string);
if (XINT (pos) >= 0
- && XINT (pos) < XSTRING (string)->size)
+ && XINT (pos) < SCHARS (string))
{
map = Fget_text_property (pos, Qlocal_map, string);
if (!NILP (map))
+ first_binding);
/* If KEY wasn't bound, we'll try some fallbacks. */
- if (first_binding >= nmaps)
+ if (first_binding < nmaps)
+ /* This is needed for the following scenario:
+ event 0: a down-event that gets dropped by calling replay_key.
+ event 1: some normal prefix like C-h.
+ After event 0, first_unbound is 0, after event 1 fkey.start
+ and keytran.start are both 1, so when we see that C-h is bound,
+ we need to update first_unbound. */
+ first_unbound = max (t + 1, first_unbound);
+ else
{
Lisp_Object head;
-
- /* Remember the position to put an upper bound on fkey_start. */
+
+ /* Remember the position to put an upper bound on fkey.start. */
first_unbound = min (t, first_unbound);
head = EVENT_HEAD (key);
generate mouse events, so it's okay to zero
mock_input in that case too.
+ FIXME: The above paragraph seems just plain
+ wrong, if you consider things like
+ xterm-mouse-mode. -stef
+
Isn't this just the most wonderful code ever? */
+
+ /* If mock_input > t + 1, the above simplification
+ will actually end up dropping keys on the floor.
+ This is probably OK for now, but even
+ if mock_input <= t + 1, we need to adjust fkey
+ and keytran.
+ Typical case [header-line down-mouse-N]:
+ mock_input = 2, t = 1, fkey.end = 1,
+ last_real_key_start = 0. */
+ if (fkey.end > last_real_key_start)
+ {
+ fkey.end = fkey.start
+ = min (last_real_key_start, fkey.start);
+ fkey.map = fkey.parent;
+ if (keytran.end > last_real_key_start)
+ {
+ keytran.end = keytran.start
+ = min (last_real_key_start, keytran.start);
+ keytran.map = keytran.parent;
+ }
+ }
if (t == last_real_key_start)
{
mock_input = 0;
/* Record what part of this_command_keys is the current key sequence. */
this_single_command_key_start = this_command_key_count - t;
- prev_fkey_map = fkey_map;
- prev_fkey_start = fkey_start;
- prev_fkey_end = fkey_end;
-
- prev_keytran_map = keytran_map;
- prev_keytran_start = keytran_start;
- prev_keytran_end = keytran_end;
-
- /* If the sequence is unbound, see if we can hang a function key
- off the end of it. We only want to scan real keyboard input
- for function key sequences, so if mock_input says that we're
- re-reading old events, don't examine it. */
- if (first_binding >= nmaps
- && t >= mock_input)
+ if (first_binding < nmaps && NILP (submaps[first_binding]))
+ /* There is a binding and it's not a prefix.
+ There is thus no function-key in this sequence.
+ Moving fkey.start is important in this case to allow keytran.start
+ to go over the sequence before we return (since we keep the
+ invariant that keytran.end <= fkey.start). */
{
- Lisp_Object fkey_next;
-
- /* Continue scan from fkey_end until we find a bound suffix.
- If we fail, increment fkey_start
- and start fkey_end from there. */
- while (fkey_end < t)
- {
- Lisp_Object key;
-
- key = keybuf[fkey_end++];
- fkey_next
- = access_keymap (fkey_map, key, 1, 0, 1);
-
- /* Handle symbol with autoload definition. */
- if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
- && CONSP (XSYMBOL (fkey_next)->function)
- && EQ (XCAR (XSYMBOL (fkey_next)->function), Qautoload))
- do_autoload (XSYMBOL (fkey_next)->function,
- fkey_next);
-
- /* Handle a symbol whose function definition is a keymap
- or an array. */
- if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
- && (!NILP (Farrayp (XSYMBOL (fkey_next)->function))
- || KEYMAPP (XSYMBOL (fkey_next)->function)))
- fkey_next = XSYMBOL (fkey_next)->function;
-
-#if 0 /* I didn't turn this on, because it might cause trouble
- for the mapping of return into C-m and tab into C-i. */
- /* Optionally don't map function keys into other things.
- This enables the user to redefine kp- keys easily. */
- if (SYMBOLP (key) && !NILP (Vinhibit_function_key_mapping))
- fkey_next = Qnil;
-#endif
-
- /* If the function key map gives a function, not an
- array, then call the function with no args and use
- its value instead. */
- if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
- && fkey_end == t)
- {
- struct gcpro gcpro1, gcpro2, gcpro3;
- Lisp_Object tem;
- tem = fkey_next;
-
- GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
- fkey_next = call1 (fkey_next, prompt);
- UNGCPRO;
- /* If the function returned something invalid,
- barf--don't ignore it.
- (To ignore it safely, we would need to gcpro a bunch of
- other variables.) */
- if (! (VECTORP (fkey_next) || STRINGP (fkey_next)))
- error ("Function in key-translation-map returns invalid key sequence");
- }
-
- function_key_possible = ! NILP (fkey_next);
-
- /* If keybuf[fkey_start..fkey_end] is bound in the
- function key map and it's a suffix of the current
- sequence (i.e. fkey_end == t), replace it with
- the binding and restart with fkey_start at the end. */
- if ((VECTORP (fkey_next) || STRINGP (fkey_next))
- && fkey_end == t)
- {
- int len = XFASTINT (Flength (fkey_next));
-
- t = fkey_start + len;
- if (t >= bufsize)
- error ("Key sequence too long");
-
- if (VECTORP (fkey_next))
- bcopy (XVECTOR (fkey_next)->contents,
- keybuf + fkey_start,
- (t - fkey_start) * sizeof (keybuf[0]));
- else if (STRINGP (fkey_next))
- {
- int i;
-
- for (i = 0; i < len; i++)
- XSETFASTINT (keybuf[fkey_start + i],
- XSTRING (fkey_next)->data[i]);
- }
-
- mock_input = t;
- fkey_start = fkey_end = t;
- fkey_map = Vfunction_key_map;
-
- /* Do pass the results through key-translation-map.
- But don't retranslate what key-translation-map
- has already translated. */
- keytran_end = keytran_start;
- keytran_map = Vkey_translation_map;
-
- goto replay_sequence;
- }
-
- fkey_map = get_keymap (fkey_next, 0, 1);
-
- /* If we no longer have a bound suffix, try a new positions for
- fkey_start. */
- if (!CONSP (fkey_map))
- {
- fkey_end = ++fkey_start;
- fkey_map = Vfunction_key_map;
- function_key_possible = 0;
- }
- }
+ if (fkey.start < t)
+ (fkey.start = fkey.end = t, fkey.map = fkey.parent);
}
-
- /* Look for this sequence in key-translation-map. */
- {
- Lisp_Object keytran_next;
-
- /* Scan from keytran_end until we find a bound suffix. */
- while (keytran_end < t)
+ else
+ /* If the sequence is unbound, see if we can hang a function key
+ off the end of it. */
+ /* Continue scan from fkey.end until we find a bound suffix. */
+ while (fkey.end < t)
{
- Lisp_Object key;
-
- key = keybuf[keytran_end++];
- keytran_next
- = access_keymap (keytran_map, key, 1, 0, 1);
-
- /* Handle symbol with autoload definition. */
- if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
- && CONSP (XSYMBOL (keytran_next)->function)
- && EQ (XCAR (XSYMBOL (keytran_next)->function), Qautoload))
- do_autoload (XSYMBOL (keytran_next)->function,
- keytran_next);
-
- /* Handle a symbol whose function definition is a keymap
- or an array. */
- if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
- && (!NILP (Farrayp (XSYMBOL (keytran_next)->function))
- || KEYMAPP (XSYMBOL (keytran_next)->function)))
- keytran_next = XSYMBOL (keytran_next)->function;
-
- /* If the key translation map gives a function, not an
- array, then call the function with one arg and use
- its value instead. */
- if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
- && keytran_end == t)
- {
- struct gcpro gcpro1, gcpro2, gcpro3;
- Lisp_Object tem;
- tem = keytran_next;
-
- GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
- keytran_next = call1 (keytran_next, prompt);
- UNGCPRO;
- /* If the function returned something invalid,
- barf--don't ignore it.
- (To ignore it safely, we would need to gcpro a bunch of
- other variables.) */
- if (! (VECTORP (keytran_next) || STRINGP (keytran_next)))
- error ("Function in key-translation-map returns invalid key sequence");
- }
-
- key_translation_possible = ! NILP (keytran_next);
-
- /* If keybuf[keytran_start..keytran_end] is bound in the
- key translation map and it's a suffix of the current
- sequence (i.e. keytran_end == t), replace it with
- the binding and restart with keytran_start at the end. */
- if ((VECTORP (keytran_next) || STRINGP (keytran_next))
- && keytran_end == t)
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ int done, diff;
+
+ GCPRO3 (fkey.map, keytran.map, delayed_switch_frame);
+ done = keyremap_step (keybuf, bufsize, &fkey,
+ max (t, mock_input),
+ /* If there's a binding (i.e.
+ first_binding >= nmaps) we don't want
+ to apply this function-key-mapping. */
+ fkey.end + 1 == t && first_binding >= nmaps,
+ &diff, prompt);
+ UNGCPRO;
+ if (done)
{
- int len = XFASTINT (Flength (keytran_next));
-
- t = keytran_start + len;
- if (t >= bufsize)
- error ("Key sequence too long");
-
- if (VECTORP (keytran_next))
- bcopy (XVECTOR (keytran_next)->contents,
- keybuf + keytran_start,
- (t - keytran_start) * sizeof (keybuf[0]));
- else if (STRINGP (keytran_next))
- {
- int i;
-
- for (i = 0; i < len; i++)
- XSETFASTINT (keybuf[keytran_start + i],
- XSTRING (keytran_next)->data[i]);
- }
-
- mock_input = t;
- keytran_start = keytran_end = t;
- keytran_map = Vkey_translation_map;
-
- /* Don't pass the results of key-translation-map
- through function-key-map. */
- fkey_start = fkey_end = t;
- fkey_map = Vfunction_key_map;
-
+ mock_input = diff + max (t, mock_input);
goto replay_sequence;
}
+ }
- keytran_map = get_keymap (keytran_next, 0, 1);
+ /* Look for this sequence in key-translation-map.
+ Scan from keytran.end until we find a bound suffix. */
+ while (keytran.end < fkey.start)
+ {
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ int done, diff;
- /* If we no longer have a bound suffix, try a new positions for
- keytran_start. */
- if (!CONSP (keytran_map))
- {
- keytran_end = ++keytran_start;
- keytran_map = Vkey_translation_map;
- key_translation_possible = 0;
- }
- }
- }
+ GCPRO3 (fkey.map, keytran.map, delayed_switch_frame);
+ done = keyremap_step (keybuf, bufsize, &keytran, max (t, mock_input),
+ 1, &diff, prompt);
+ UNGCPRO;
+ if (done)
+ {
+ mock_input = diff + max (t, mock_input);
+ /* Adjust the function-key-map counters. */
+ fkey.end += diff;
+ fkey.start += diff;
+
+ 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 an upper case letter
use the corresponding lower-case letter instead. */
- if (first_binding == nmaps && ! function_key_possible
- && ! key_translation_possible
+ if (first_binding >= nmaps
+ && fkey.start >= t && keytran.start >= t
&& INTEGERP (key)
- && ((((XINT (key) & 0x3ffff)
- < XCHAR_TABLE (current_buffer->downcase_table)->size)
- && UPPERCASEP (XINT (key) & 0x3ffff))
+ && ((CHARACTERP (make_number (XINT (key) & ~CHAR_MODIFIER_MASK))
+ && UPPERCASEP (XINT (key) & ~CHAR_MODIFIER_MASK))
|| (XINT (key) & shift_modifier)))
{
Lisp_Object new_key;
if (XINT (key) & shift_modifier)
XSETINT (new_key, XINT (key) & ~shift_modifier);
else
- XSETINT (new_key, (DOWNCASE (XINT (key) & 0x3ffff)
- | (XINT (key) & ~0x3ffff)));
+ XSETINT (new_key, (DOWNCASE (XINT (key) & ~CHAR_MODIFIER_MASK)
- | (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 = t;
-
- fkey_map = prev_fkey_map;
- fkey_start = prev_fkey_start;
- fkey_end = prev_fkey_end;
-
- keytran_map = prev_keytran_map;
- keytran_start = prev_keytran_start;
- keytran_end = prev_keytran_end;
+ mock_input = max (t, mock_input);
goto replay_sequence;
}
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 && ! function_key_possible
- && ! key_translation_possible
+ if (first_binding >= nmaps
+ && fkey.start >= t && keytran.start >= t
&& SYMBOLP (key))
{
Lisp_Object breakdown;
XCAR (breakdown));
keybuf[t - 1] = new_key;
- mock_input = t;
-
- fkey_map = prev_fkey_map;
- fkey_start = prev_fkey_start;
- fkey_end = prev_fkey_end;
-
- keytran_map = prev_keytran_map;
- keytran_start = prev_keytran_start;
- keytran_end = prev_keytran_end;
+ mock_input = max (t, mock_input);
+ fkey.start = fkey.end = KEYMAPP (fkey.map) ? 0 : bufsize + 1;
+ keytran.start = keytran.end = KEYMAPP (keytran.map) ? 0 : bufsize + 1;
goto replay_sequence;
}
add_command_key (keybuf[t]);
}
-
+
UNGCPRO;
return t;
Lisp_Object keybuf[30];
register int i;
struct gcpro gcpro1;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
if (!NILP (prompt))
CHECK_STRING (prompt);
if (NILP (continue_echo))
{
this_command_key_count = 0;
+ this_command_key_count_reset = 0;
this_single_command_key_start = 0;
}
Lisp_Object keybuf[30];
register int i;
struct gcpro gcpro1;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
if (!NILP (prompt))
CHECK_STRING (prompt);
if (NILP (continue_echo))
{
this_command_key_count = 0;
+ this_command_key_count_reset = 0;
this_single_command_key_start = 0;
}
}
}
- return Fexecute_kbd_macro (final, prefixarg);
+ return Fexecute_kbd_macro (final, prefixarg, Qnil);
}
if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
{
Lisp_Object function;
char buf[40];
- Lisp_Object saved_keys;
+ int saved_last_point_position;
+ Lisp_Object saved_keys, saved_last_point_position_buffer;
Lisp_Object bindings, value;
- struct gcpro gcpro1, gcpro2;
+ struct gcpro gcpro1, gcpro2, gcpro3;
saved_keys = Fvector (this_command_key_count,
XVECTOR (this_command_keys)->contents);
+ saved_last_point_position_buffer = last_point_position_buffer;
+ saved_last_point_position = last_point_position;
buf[0] = 0;
- GCPRO2 (saved_keys, prefixarg);
+ GCPRO3 (saved_keys, prefixarg, saved_last_point_position_buffer);
if (EQ (prefixarg, Qminus))
strcpy (buf, "- ");
Qt, Qnil, Qextended_command_history, Qnil,
Qnil);
- if (STRINGP (function) && XSTRING (function)->size == 0)
+ if (STRINGP (function) && SCHARS (function) == 0)
error ("No command name given");
/* Set this_command_keys to the concatenation of saved_keys and
function, followed by a RET. */
{
- struct Lisp_String *str;
Lisp_Object *keys;
int i;
this_command_key_count = 0;
+ this_command_key_count_reset = 0;
this_single_command_key_start = 0;
keys = XVECTOR (saved_keys)->contents;
for (i = 0; i < XVECTOR (saved_keys)->size; i++)
add_command_key (keys[i]);
- str = XSTRING (function);
- for (i = 0; i < str->size; i++)
+ for (i = 0; i < SCHARS (function); i++)
add_command_key (Faref (function, make_number (i)));
add_command_key (make_number ('\015'));
}
+ last_point_position = saved_last_point_position;
+ last_point_position_buffer = saved_last_point_position_buffer;
+
UNGCPRO;
function = Fintern (function, Qnil);
Lisp_Object binding;
char *newmessage;
int message_p = push_message ();
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
- record_unwind_protect (push_message_unwind, Qnil);
+ record_unwind_protect (pop_message_unwind, Qnil);
binding = Fkey_description (bindings);
newmessage
- = (char *) alloca (XSYMBOL (function)->name->size
- + STRING_BYTES (XSTRING (binding))
+ = (char *) alloca (SCHARS (SYMBOL_NAME (function))
+ + SBYTES (binding)
+ 100);
sprintf (newmessage, "You can run the command `%s' with %s",
- XSYMBOL (function)->name->data,
- XSTRING (binding)->data);
+ SDATA (SYMBOL_NAME (function)),
+ SDATA (binding));
message2_nolog (newmessage,
strlen (newmessage),
STRING_MULTIBYTE (binding));
/* Return nonzero if there are pending requeued events.
This isn't used yet. The hope is to make wait_reading_process_input
- call it, and return return if it runs Lisp code that unreads something.
+ call it, and return if it runs Lisp code that unreads something.
The problem is, kbd_buffer_get_event needs to be fixed to know what
to do in that case. It isn't trivial. */
if (!NILP (Vunread_command_events) || unread_command_char != -1)
return (Qt);
- get_input_pending (&input_pending, 1);
+ get_filtered_input_pending (&input_pending, 1, 1);
return input_pending > 0 ? Qt : Qnil;
}
DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
doc: /* Return the key sequence that invoked this command.
However, if the command has called `read-key-sequence', it returns
-the the last key sequence that has been read.
+the last key sequence that has been read.
The value is a string or a vector. */)
()
{
DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
doc: /* Return the key sequence that invoked this command, as a vector.
However, if the command has called `read-key-sequence', it returns
-the the last key sequence that has been read. */)
+the last key sequence that has been read. */)
()
{
return Fvector (this_command_key_count,
DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,
Sreset_this_command_lengths, 0, 0, 0,
- doc: /* Used for complicated reasons in `universal-argument-other-key'.
+ doc: /* Make the unread events replace the last command and echo.
+Used in `universal-argument-other-key'.
`universal-argument-other-key' rereads the event just typed.
It then gets translated through `function-key-map'.
-The translated event gets included in the echo area and in
-the value of `this-command-keys' in addition to the raw original event.
-That is not right.
-
-Calling this function directs the translated event to replace
-the original event, so that only one version of the event actually
-appears in the echo area and in the value of `this-command-keys'. */)
+The translated event has to replace the real events,
+both in the value of (this-command-keys) and in echoing.
+To achieve this, `universal-argument-other-key' calls
+`reset-this-command-lengths', which discards the record of reading
+these events the first time. */)
()
{
- before_command_restore_flag = 1;
- before_command_key_count_1 = before_command_key_count;
- before_command_echo_length_1 = before_command_echo_length;
+ this_command_key_count = before_command_key_count;
+ if (this_command_key_count < this_single_command_key_start)
+ this_single_command_key_start = this_command_key_count;
+
+ echo_truncate (before_command_echo_length);
+
+ /* Cause whatever we put into unread-command-events
+ to echo as if it were being freshly read from the keyboard. */
+ this_command_key_count_reset = 1;
+
return Qnil;
}
DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
- Sclear_this_command_keys, 0, 0, 0,
+ Sclear_this_command_keys, 0, 1, 0,
doc: /* Clear out the vector that `this-command-keys' returns.
-Also clear the record of the last 100 events. */)
- ()
+Also clear the record of the last 100 events, unless optional arg
+KEEP-RECORD is non-nil. */)
+ (keep_record)
+ Lisp_Object keep_record;
{
int i;
-
+
this_command_key_count = 0;
+ this_command_key_count_reset = 0;
- for (i = 0; i < XVECTOR (recent_keys)->size; ++i)
- XVECTOR (recent_keys)->contents[i] = Qnil;
- total_keys = 0;
- recent_keys_index = 0;
+ if (NILP (keep_record))
+ {
+ for (i = 0; i < XVECTOR (recent_keys)->size; ++i)
+ XVECTOR (recent_keys)->contents[i] = Qnil;
+ total_keys = 0;
+ recent_keys_index = 0;
+ }
return Qnil;
}
if (!NILP (file))
{
file = Fexpand_file_name (file, Qnil);
- dribble = fopen (XSTRING (file)->data, "w");
+ dribble = fopen (SDATA (file), "w");
if (dribble == 0)
report_file_error ("Opening dribble", Fcons (file, Qnil));
}
DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
doc: /* Discard the contents of the terminal input buffer.
-Also cancel any kbd macro being defined. */)
+Also end any kbd macro being defined. */)
()
{
- current_kboard->defining_kbd_macro = Qnil;
+ if (!NILP (current_kboard->defining_kbd_macro))
+ {
+ /* Discard the last command from the macro. */
+ Fcancel_kbd_macro_events ();
+ end_kbd_macro ();
+ }
+
update_mode_lines++;
Vunread_command_events = Qnil;
(stuffstring)
Lisp_Object stuffstring;
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int old_height, old_width;
int width, height;
struct gcpro gcpro1;
{
register int count;
- p = XSTRING (stuffstring)->data;
- count = STRING_BYTES (XSTRING (stuffstring));
+ p = SDATA (stuffstring);
+ count = SBYTES (stuffstring);
while (count-- > 0)
stuff_char (*p++);
stuff_char ('\n');
}
-
+
/* Anything we have read ahead, put back for the shell to read. */
/* ?? What should this do when we have multiple keyboards??
Should we ignore anything that was typed in at the "wrong" kboard? */
for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
{
int idx;
-
+
if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
kbd_fetch_ptr = kbd_buffer;
- if (kbd_fetch_ptr->kind == ascii_keystroke)
+ if (kbd_fetch_ptr->kind == ASCII_KEYSTROKE_EVENT)
stuff_char (kbd_fetch_ptr->code);
-
- kbd_fetch_ptr->kind = no_event;
+
+ kbd_fetch_ptr->kind = NO_EVENT;
idx = 2 * (kbd_fetch_ptr - kbd_buffer);
ASET (kbd_buffer_gcpro, idx, Qnil);
ASET (kbd_buffer_gcpro, idx + 1, Qnil);
}
-
+
input_pending = 0;
#endif
#endif /* BSD_SYSTEM and not BSD4_1 */
input_available_clear_time = 0;
}
-/* This routine is called at interrupt level in response to C-G.
-
+/* This routine is called at interrupt level in response to C-g.
+
If interrupt_input, this is the handler for SIGINT. Otherwise, it
is called from kbd_buffer_store_event, in handling SIGIO or
SIGTINT.
eval to throw, when it gets a chance. If quit-flag is already
non-nil, it stops the job right away. */
-SIGTYPE
+static SIGTYPE
interrupt_signal (signalnum) /* If we don't have an argument, */
int signalnum; /* some compilers complain in signal calls. */
{
}
while (c != '\n') c = getchar ();
}
- else
+ else
{
/* During GC, it must be safe to reenable quitting again. */
Vinhibit_quit = Qnil;
kb->kbd_queue = Qnil;
kb->kbd_queue_has_data = 0;
kb->immediate_echo = 0;
- kb->echoptr = kb->echobuf;
+ kb->echo_string = Qnil;
kb->echo_after_prompt = -1;
kb->kbd_macro_buffer = 0;
kb->kbd_macro_bufsize = 0;
KBOARD *kb;
{
KBOARD **kbp;
-
+
for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
if (*kbp == NULL)
abort ();
if (current_kboard == kb)
abort ();
}
-
+
wipe_kboard (kb);
xfree (kb);
}
poll_suppress_count = 1;
start_polling ();
#endif
+
+#ifdef MAC_OSX
+ /* At least provide an escape route since C-g doesn't work. */
+ signal (SIGINT, interrupt_signal);
+#endif
}
/* This type's only use is in syms_of_keyboard, to initialize the
{&Qswitch_frame, "switch-frame", &Qswitch_frame},
{&Qdelete_frame, "delete-frame", &Qdelete_frame},
{&Qiconify_frame, "iconify-frame", &Qiconify_frame},
- {&Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible}
+ {&Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible},
+ /* `select-window' should be handled just like `switch-frame'
+ in read_key_sequence. */
+ {&Qselect_window, "select-window", &Qswitch_frame}
};
void
{
Vpre_help_message = Qnil;
staticpro (&Vpre_help_message);
-
+
Vlispy_mouse_stem = build_string ("mouse");
staticpro (&Vlispy_mouse_stem);
Qmouse_click = intern ("mouse-click");
staticpro (&Qmouse_click);
#ifdef WINDOWSNT
- Qmouse_wheel = intern ("mouse-wheel");
- staticpro (&Qmouse_wheel);
Qlanguage_change = intern ("language-change");
staticpro (&Qlanguage_change);
#endif
Qdrag_n_drop = intern ("drag-n-drop");
staticpro (&Qdrag_n_drop);
+ Qsave_session = intern ("save-session");
+ staticpro(&Qsave_session);
+
Qusr1_signal = intern ("usr1-signal");
staticpro (&Qusr1_signal);
Qusr2_signal = intern ("usr2-signal");
staticpro (&button_down_location);
mouse_syms = Fmake_vector (make_number (1), Qnil);
staticpro (&mouse_syms);
+ wheel_syms = Fmake_vector (make_number (2), Qnil);
+ staticpro (&wheel_syms);
{
int i;
func_key_syms = Qnil;
staticpro (&func_key_syms);
-#ifdef WINDOWSNT
- mouse_wheel_syms = Qnil;
- staticpro (&mouse_wheel_syms);
-
drag_n_drop_syms = Qnil;
staticpro (&drag_n_drop_syms);
-#endif
unread_switch_frame = Qnil;
staticpro (&unread_switch_frame);
Vthis_command = Qnil;
DEFVAR_LISP ("this-original-command", &Vthis_original_command,
- doc: /* If non-nil, the original command bound to the current key sequence.
-The value of `this-command' is the result of looking up the original
-command in the active keymaps. */);
+ doc: /* The command bound to the current key sequence before remapping.
+It equals `this-command' if the original command was not remapped through
+any of the active keymaps. Otherwise, the value of `this-command' is the
+result of looking up the original command in the active keymaps. */);
Vthis_original_command = Qnil;
DEFVAR_INT ("auto-save-interval", &auto_save_interval,
This variable is also the threshold for motion of the mouse
to count as a drag. */);
double_click_fuzz = 3;
-
+
DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus,
doc: /* *Non-nil means inhibit local map menu bar menus. */);
inhibit_local_menu_bar_menus = 0;
The value may be a string, a vector, or a char-table.
If it is a string or vector of length N,
character codes N and up are untranslated.
-In a vector or a char-table, an element which is nil means "no translation". */);
+In a vector or a char-table, an element which is nil means "no translation".
+
+This is applied to the characters supplied to input methods, not their
+output. See also `translation-table-for-input'. */);
Vkeyboard_translate_table = Qnil;
DEFVAR_BOOL ("cannot-suspend", &cannot_suspend,
DEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook,
doc: /* Normal hook run after each command is executed, if idle.
-Errors running the hook are caught and ignored.
-This feature is obsolete; use idle timers instead. See `etc/NEWS'. */);
+Errors running the hook are caught and ignored. */);
Vpost_command_idle_hook = Qnil;
DEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay,
"ignore-event");
initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
"ignore-event");
+ /* Handling it at such a low-level causes read_key_sequence to get
+ * confused because it doesn't realize that the current_buffer was
+ * changed by read_char.
+ *
+ * initial_define_lispy_key (Vspecial_event_map, "select-window",
+ * "handle-select-window"); */
+ initial_define_lispy_key (Vspecial_event_map, "save-session",
+ "handle-save-session");
+}
+
+/* Mark the pointers in the kboard objects.
+ Called by the Fgarbage_collector. */
+void
+mark_kboards ()
+{
+ KBOARD *kb;
+ Lisp_Object *p;
+ for (kb = all_kboards; kb; kb = kb->next_kboard)
+ {
+ if (kb->kbd_macro_buffer)
+ for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
+ mark_object (*p);
+ mark_object (kb->Voverriding_terminal_local_map);
+ mark_object (kb->Vlast_command);
+ mark_object (kb->Vreal_last_command);
+ mark_object (kb->Vprefix_arg);
+ mark_object (kb->Vlast_prefix_arg);
+ mark_object (kb->kbd_queue);
+ mark_object (kb->defining_kbd_macro);
+ mark_object (kb->Vlast_kbd_macro);
+ mark_object (kb->Vsystem_key_alist);
+ mark_object (kb->system_key_syms);
+ mark_object (kb->Vdefault_minibuffer_frame);
+ mark_object (kb->echo_string);
+ }
+ {
+ struct input_event *event;
+ for (event = kbd_fetch_ptr; event != kbd_store_ptr; event++)
+ {
+ if (event == kbd_buffer + KBD_BUFFER_SIZE)
+ event = kbd_buffer;
+ mark_object (event->x);
+ mark_object (event->y);
+ mark_object (event->frame_or_window);
+ mark_object (event->arg);
+ }
+ }
}
/* Manipulation of keymaps
- Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 01, 02, 03
+ Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 2001
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 "termhooks.h"
minor mode variables and keymaps. */
Lisp_Object Vminor_mode_overriding_map_alist;
+/* List of emulation mode keymap alists. */
+Lisp_Object Vemulation_mode_map_alists;
+
/* Keymap mapping ASCII function key sequences onto their preferred forms.
Initialized by the terminal-specific lisp files. See DEFVAR for more
documentation. */
/* Alist of elements like (DEL . "\d"). */
static Lisp_Object exclude_keys;
-/* Pre-allocated 2-element vector for Fremap_command to use. */
-static Lisp_Object remap_command_vector;
+/* Pre-allocated 2-element vector for Fcommand_remapping to use. */
+static Lisp_Object command_remapping_vector;
/* A char with the CHAR_META bit set in a vector or the 0200 bit set
in a string key sequence is equivalent to prefixing with this
if (autoload)
{
struct gcpro gcpro1, gcpro2;
-
+
GCPRO2 (tem, object);
do_autoload (tem, object);
UNGCPRO;
-
+
goto autoload_retry;
}
else
return Qnil;
}
\f
-/* Return the parent map of the keymap MAP, or nil if it has none.
- We assume that MAP is a valid keymap. */
+/* Return the parent map of KEYMAP, or nil if it has none.
+ We assume that KEYMAP is a valid keymap. */
-DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
- doc: /* Return the parent keymap of KEYMAP. */)
- (keymap)
+Lisp_Object
+keymap_parent (keymap, autoload)
Lisp_Object keymap;
+ int autoload;
{
Lisp_Object list;
- keymap = get_keymap (keymap, 1, 1);
+ keymap = get_keymap (keymap, 1, autoload);
/* Skip past the initial element `keymap'. */
list = XCDR (keymap);
return list;
}
- return get_keymap (list, 0, 1);
+ return get_keymap (list, 0, autoload);
}
+DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
+ doc: /* Return the parent keymap of KEYMAP. */)
+ (keymap)
+ Lisp_Object keymap;
+{
+ return keymap_parent (keymap, 1);
+}
/* Check whether MAP is one of MAPS parents. */
int
{
if (NILP (map)) return 0;
while (KEYMAPP (maps) && !EQ (map, maps))
- maps = Fkeymap_parent (maps);
+ maps = keymap_parent (maps, 0);
return (EQ (map, maps));
}
Lisp_Object keymap, parent;
{
Lisp_Object list, prev;
- struct gcpro gcpro1;
+ struct gcpro gcpro1, gcpro2;
int i;
/* Force a keymap flush for the next call to where-is.
This is a very minor correctness (rather than safety) issue. */
where_is_cache_keymaps = Qt;
+ GCPRO2 (keymap, parent);
keymap = get_keymap (keymap, 1, 1);
- GCPRO1 (keymap);
-
+
if (!NILP (parent))
{
parent = get_keymap (parent, 1, 1);
{
Lisp_Object indices[3];
- map_char_table (fix_submap_inheritance, Qnil, XCAR (list),
- keymap, 0, indices);
+ map_char_table (fix_submap_inheritance, Qnil,
- XCAR (list), XCAR (list),
- keymap, 0, indices);
++ XCAR (list), keymap);
}
}
if (!CONSP (submap))
return;
- map_parent = Fkeymap_parent (map);
+ map_parent = keymap_parent (map, 0);
if (!NILP (map_parent))
parent_entry =
get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
{
Lisp_Object tem;
- tem = Fkeymap_parent (submap_parent);
+ tem = keymap_parent (submap_parent, 0);
if (KEYMAPP (tem))
{
\f
/* Look up IDX in MAP. IDX may be any sort of event.
Note that this does only one level of lookup; IDX must be a single
- event, not a sequence.
+ event, not a sequence.
If T_OK is non-zero, bindings for Qt are treated as default
bindings; any key left unmentioned by other tables and bindings is
- given the binding of Qt.
+ given the binding of Qt.
If T_OK is zero, bindings for Qt are not treated specially.
{
/* See if there is a meta-map. If there's none, there is
no binding for IDX, unless a default binding exists in MAP. */
- Lisp_Object meta_map =
- get_keymap (access_keymap (map, meta_prefix_char,
- t_ok, noinherit, autoload),
- 0, autoload);
+ struct gcpro gcpro1;
+ Lisp_Object meta_map;
+ GCPRO1 (map);
+ meta_map = get_keymap (access_keymap (map, meta_prefix_char,
+ t_ok, noinherit, autoload),
+ 0, autoload);
+ UNGCPRO;
if (CONSP (meta_map))
{
map = meta_map;
return Qnil;
}
+ /* t_binding is where we put a default binding that applies,
+ to use in case we do not find a binding specifically
+ for this key sequence. */
{
Lisp_Object tail;
+ Lisp_Object t_binding = Qnil;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- /* t_binding is where we put a default binding that applies,
- to use in case we do not find a binding specifically
- for this key sequence. */
-
- Lisp_Object t_binding;
- t_binding = Qnil;
+ 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 NOINHERIT, stop finding prefix definitions
after we pass a second occurrence of the `keymap' symbol. */
if (noinherit && EQ (binding, Qkeymap))
- return Qnil;
+ RETURN_UNGCPRO (Qnil);
}
else if (CONSP (binding))
{
Lisp_Object key = XCAR (binding);
-
+
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);
val = get_keyelt (val, autoload);
if (KEYMAPP (val))
fix_submap_inheritance (map, idx, val);
- return val;
+ RETURN_UNGCPRO (val);
}
QUIT;
}
-
+ UNGCPRO;
return get_keyelt (t_binding, autoload);
}
}
-
+static void
+map_keymap_item (fun, args, key, val, data)
+ map_keymap_function_t fun;
+ Lisp_Object args, key, val;
+ void *data;
+{
+ /* We should maybe try to detect bindings shadowed by previous
+ ones and things like that. */
+ if (EQ (val, Qt))
+ val = Qnil;
+ (*fun) (key, val, args, data);
+}
+
+static void
+map_keymap_char_table_item (args, key, val)
+ Lisp_Object args, key, val;
+{
+ if (!NILP (val))
+ {
+ map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer;
+ args = XCDR (args);
+ map_keymap_item (fun, XCDR (args), key, val,
+ XSAVE_VALUE (XCAR (args))->pointer);
+ }
+}
+
+/* Call FUN for every binding in MAP.
+ FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
+ AUTOLOAD if non-zero means that we can autoload keymaps if necessary. */
+void
+map_keymap (map, fun, args, data, autoload)
+ map_keymap_function_t fun;
+ Lisp_Object map, args;
+ void *data;
+ int autoload;
+{
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object tail;
+
+ GCPRO3 (map, args, tail);
+ map = get_keymap (map, 1, autoload);
+ for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
+ CONSP (tail) || (tail = get_keymap (tail, 0, autoload), CONSP (tail));
+ tail = XCDR (tail))
+ {
+ Lisp_Object binding = XCAR (tail);
- map_char_table (map_keymap_char_table_item, Qnil, binding, binding,
++
+ if (CONSP (binding))
+ map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
+ else if (VECTORP (binding))
+ {
+ /* Loop over the char values represented in the vector. */
+ int len = ASIZE (binding);
+ int c;
+ abort();
+ for (c = 0; c < len; c++)
+ {
+ Lisp_Object character;
+ XSETFASTINT (character, c);
+ map_keymap_item (fun, args, character, AREF (binding, c), data);
+ }
+ }
+ else if (CHAR_TABLE_P (binding))
+ {
+ Lisp_Object indices[3];
- args)),
- 0, indices);
++ map_char_table (map_keymap_char_table_item, Qnil, binding,
+ Fcons (make_save_value (fun, 0),
+ Fcons (make_save_value (data, 0),
++ args)));
+ }
+ }
+ UNGCPRO;
+}
+
+static void
+map_keymap_call (key, val, fun, dummy)
+ Lisp_Object key, val, fun;
+ void *dummy;
+{
+ call2 (fun, key, val);
+}
+
+DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 2, 0,
+ doc: /* Call FUNCTION for every binding in KEYMAP.
+FUNCTION is called with two arguments: the event and its binding. */)
+ (function, keymap)
+ Lisp_Object function, keymap;
+{
+ if (INTEGERP (function))
+ /* We have to stop integers early since map_keymap gives them special
+ significance. */
+ Fsignal (Qinvalid_function, Fcons (function, Qnil));
+ map_keymap (keymap, map_keymap_call, function, NULL, 1);
+ return Qnil;
+}
+
/* Given OBJECT which was found in a slot in a keymap,
trace indirect definitions to get the actual definition of that slot.
An indirect definition is a list of the form
Lisp_Object
get_keyelt (object, autoload)
- register Lisp_Object object;
+ Lisp_Object object;
int autoload;
{
while (1)
}
}
else
- /* Invalid keymap */
+ /* Invalid keymap. */
return object;
}
/* If the contents are (KEYMAP . ELEMENT), go indirect. */
else
{
+ struct gcpro gcpro1;
Lisp_Object map;
+ GCPRO1 (object);
map = get_keymap (Fcar_safe (object), 0, autoload);
+ UNGCPRO;
return (!CONSP (map) ? object /* Invalid keymap */
: access_keymap (map, Fcdr (object), 0, 0, autoload));
}
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 (insertion_point,
Fcons (Fcons (idx, def), XCDR (insertion_point)));
}
-
+
return def;
}
EXFUN (Fcopy_keymap, 1);
-void
+Lisp_Object
+copy_keymap_item (elt)
+ Lisp_Object elt;
+{
+ Lisp_Object res, tem;
+
+ if (!CONSP (elt))
+ return elt;
+
+ res = tem = elt;
+
+ /* Is this a new format menu item. */
+ if (EQ (XCAR (tem), Qmenu_item))
+ {
+ /* Copy cell with menu-item marker. */
+ res = elt = Fcons (XCAR (tem), XCDR (tem));
+ tem = XCDR (elt);
+ if (CONSP (tem))
+ {
+ /* Copy cell with menu-item name. */
+ XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
+ elt = XCDR (elt);
+ tem = XCDR (elt);
+ }
+ if (CONSP (tem))
+ {
+ /* Copy cell with binding and if the binding is a keymap,
+ copy that. */
+ XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
+ elt = XCDR (elt);
+ tem = XCAR (elt);
+ if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
+ XSETCAR (elt, Fcopy_keymap (tem));
+ tem = XCDR (elt);
+ if (CONSP (tem) && CONSP (XCAR (tem)))
+ /* Delete cache for key equivalences. */
+ XSETCDR (elt, XCDR (tem));
+ }
+ }
+ else
+ {
+ /* It may be an old fomat menu item.
+ Skip the optional menu string. */
+ if (STRINGP (XCAR (tem)))
+ {
+ /* Copy the cell, since copy-alist didn't go this deep. */
+ res = elt = Fcons (XCAR (tem), XCDR (tem));
+ tem = XCDR (elt);
+ /* Also skip the optional menu help string. */
+ if (CONSP (tem) && STRINGP (XCAR (tem)))
+ {
+ XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
+ elt = XCDR (elt);
+ tem = XCDR (elt);
+ }
+ /* There may also be a list that caches key equivalences.
+ Just delete it for the new keymap. */
+ if (CONSP (tem)
+ && CONSP (XCAR (tem))
+ && (NILP (XCAR (XCAR (tem)))
+ || VECTORP (XCAR (XCAR (tem)))))
+ {
+ XSETCDR (elt, XCDR (tem));
+ tem = XCDR (tem);
+ }
+ if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
+ XSETCDR (elt, Fcopy_keymap (tem));
+ }
+ else if (EQ (XCAR (tem), Qkeymap))
+ res = Fcopy_keymap (elt);
+ }
+ return res;
+}
+
+static void
copy_keymap_1 (chartable, idx, elt)
Lisp_Object chartable, idx, elt;
{
- Faset (chartable, idx, copy_keymap_item (elt));
- if (CONSP (elt) && EQ (XCAR (elt), Qkeymap))
- Faset (chartable, idx, Fcopy_keymap (elt));
++ Fset_char_table_range (chartable, idx, copy_keymap_item (elt));
}
DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
(keymap)
Lisp_Object keymap;
{
- /* FIXME: This doesn't properly copy menu-items in vectors. */
- /* FIXME: This also copies the parent keymap. */
-
register Lisp_Object copy, tail;
+ keymap = get_keymap (keymap, 1, 0);
+ copy = tail = Fcons (Qkeymap, Qnil);
+ keymap = XCDR (keymap); /* Skip the `keymap' symbol. */
- copy = Fcopy_alist (get_keymap (keymap, 1, 0));
-
- for (tail = copy; CONSP (tail); tail = XCDR (tail))
+ while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
{
- Lisp_Object elt;
-
- elt = XCAR (tail);
+ Lisp_Object elt = XCAR (keymap);
if (CHAR_TABLE_P (elt))
{
Lisp_Object indices[3];
-
elt = Fcopy_sequence (elt);
- map_char_table (copy_keymap_1, Qnil, elt, elt, elt, 0, indices);
- XSETCAR (tail, elt);
-
- map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices);
++ map_char_table (copy_keymap_1, Qnil, elt, elt);
}
else if (VECTORP (elt))
{
int i;
-
elt = Fcopy_sequence (elt);
- XSETCAR (tail, elt);
-
for (i = 0; i < ASIZE (elt); i++)
- if (CONSP (AREF (elt, i)) && EQ (XCAR (AREF (elt, i)), Qkeymap))
- ASET (elt, i, Fcopy_keymap (AREF (elt, i)));
- }
- else if (CONSP (elt) && CONSP (XCDR (elt)))
- {
- Lisp_Object tem;
- tem = XCDR (elt);
-
- /* Is this a new format menu item. */
- if (EQ (XCAR (tem),Qmenu_item))
- {
- /* Copy cell with menu-item marker. */
- XSETCDR (elt,
- Fcons (XCAR (tem), XCDR (tem)));
- elt = XCDR (elt);
- tem = XCDR (elt);
- if (CONSP (tem))
- {
- /* Copy cell with menu-item name. */
- XSETCDR (elt,
- Fcons (XCAR (tem), XCDR (tem)));
- elt = XCDR (elt);
- tem = XCDR (elt);
- };
- if (CONSP (tem))
- {
- /* Copy cell with binding and if the binding is a keymap,
- copy that. */
- XSETCDR (elt,
- Fcons (XCAR (tem), XCDR (tem)));
- elt = XCDR (elt);
- tem = XCAR (elt);
- if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
- XSETCAR (elt, Fcopy_keymap (tem));
- tem = XCDR (elt);
- if (CONSP (tem) && CONSP (XCAR (tem)))
- /* Delete cache for key equivalences. */
- XSETCDR (elt, XCDR (tem));
- }
- }
- else
- {
- /* It may be an old fomat menu item.
- Skip the optional menu string.
- */
- if (STRINGP (XCAR (tem)))
- {
- /* Copy the cell, since copy-alist didn't go this deep. */
- XSETCDR (elt,
- Fcons (XCAR (tem), XCDR (tem)));
- elt = XCDR (elt);
- tem = XCDR (elt);
- /* Also skip the optional menu help string. */
- if (CONSP (tem) && STRINGP (XCAR (tem)))
- {
- XSETCDR (elt,
- Fcons (XCAR (tem), XCDR (tem)));
- elt = XCDR (elt);
- tem = XCDR (elt);
- }
- /* There may also be a list that caches key equivalences.
- Just delete it for the new keymap. */
- if (CONSP (tem)
- && CONSP (XCAR (tem))
- && (NILP (XCAR (XCAR (tem)))
- || VECTORP (XCAR (XCAR (tem)))))
- XSETCDR (elt, XCDR (tem));
- }
- if (CONSP (elt)
- && CONSP (XCDR (elt))
- && EQ (XCAR (XCDR (elt)), Qkeymap))
- XSETCDR (elt, Fcopy_keymap (XCDR (elt)));
- }
-
+ ASET (elt, i, copy_keymap_item (AREF (elt, i)));
}
+ else if (CONSP (elt))
+ elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
+ XSETCDR (tail, Fcons (elt, Qnil));
+ tail = XCDR (tail);
+ keymap = XCDR (keymap);
}
-
+ XSETCDR (tail, keymap);
return copy;
}
\f
/* GC is possible in this function if it autoloads a keymap. */
DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
- doc: /* Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.
+ doc: /* In KEYMAP, define key sequence KEY as DEF.
KEYMAP is a keymap.
KEY is a string or a vector of symbols and characters meaning a
sequence of keystrokes and events. Non-ASCII characters with codes
above 127 (such as ISO Latin-1) can be included if you use a vector.
+Using [t] for KEY creates a default definition, which applies to any
+event type that has no other definition in this keymap.
DEF is anything that can be a key's definition:
nil (means key is undefined in this keymap),
(DEFN should be a valid definition in its own right),
or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
-If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at
-the front of KEYMAP. */)
+If KEYMAP is a sparse keymap with a binding for KEY, the existing
+binding is altered. If there is no binding for KEY, the new pair
+binding KEY to DEF is added at the front of KEYMAP. */)
(keymap, key, def)
Lisp_Object keymap;
Lisp_Object key;
int length;
struct gcpro gcpro1, gcpro2, gcpro3;
+ GCPRO3 (keymap, key, def);
keymap = get_keymap (keymap, 1, 1);
if (!VECTORP (key) && !STRINGP (key))
- key = wrong_type_argument (Qarrayp, key);
+ key = wrong_type_argument (Qarrayp, key);
length = XFASTINT (Flength (key));
if (length == 0)
- return Qnil;
-
- /* Check for valid [remap COMMAND] bindings. */
- if (VECTORP (key) && EQ (AREF (key, 0), Qremap)
- && (length != 2 || !SYMBOLP (AREF (key, 1))))
- wrong_type_argument (Qvectorp, key);
+ RETURN_UNGCPRO (Qnil);
if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
- GCPRO3 (keymap, key, def);
-
- if (VECTORP (key))
- meta_bit = meta_modifier;
- else
- meta_bit = 0x80;
+ meta_bit = VECTORP (key) ? meta_modifier : 0x80;
idx = 0;
while (1)
{
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 cons (FROM . TO) specifying a range of
+ characters. */
+ if (CHARACTERP (XCAR (c)))
- CHECK_CHARACTER (XCDR (c));
++ CHECK_CHARACTER_CDR (c);
+ else if (lucid_event_type_list_p (c))
+ c = Fevent_convert_list (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)
/* We must use Fkey_description rather than just passing key to
error; key might be a vector, not a string. */
error ("Key sequence %s uses invalid prefix characters",
- XSTRING (Fkey_description (key))->data);
+ SDATA (Fkey_description (key)));
}
}
/* This function may GC (it calls Fkey_binding). */
-DEFUN ("remap-command", Fremap_command, Sremap_command, 1, 1, 0,
+DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 1, 0,
doc: /* Return the remapping for command COMMAND in current keymaps.
-Returns nil if COMMAND is not remapped. */)
+Returns nil if COMMAND is not remapped (or not a symbol). */)
(command)
Lisp_Object command;
{
- /* This will GCPRO the command argument. */
- ASET (remap_command_vector, 1, command);
- return Fkey_binding (remap_command_vector, Qnil, Qt);
+ if (!SYMBOLP (command))
+ return Qnil;
+
+ ASET (command_remapping_vector, 1, command);
+ return Fkey_binding (command_remapping_vector, Qnil, Qt);
}
/* Value is number if KEY is too long; nil if valid but has no definition. */
third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
recognize the default bindings, just as `read-key-sequence' does. */)
(keymap, key, accept_default)
- register Lisp_Object keymap;
+ Lisp_Object keymap;
Lisp_Object key;
Lisp_Object accept_default;
{
register Lisp_Object c;
int length;
int t_ok = !NILP (accept_default);
- struct gcpro gcpro1;
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (keymap, key);
keymap = get_keymap (keymap, 1, 1);
- /* Perform command remapping initiated by Fremap_command directly.
- This is strictly not necessary, but it is faster and it returns
- nil instead of 1 if KEYMAP doesn't contain command remappings. */
- if (EQ (key, remap_command_vector))
- {
- /* KEY has format [remap COMMAND].
- Lookup `remap' in KEYMAP; result is nil or a keymap containing
- command remappings. Then lookup COMMAND in that keymap. */
- if ((keymap = access_keymap (keymap, Qremap, t_ok, 0, 1), !NILP (keymap))
- && (keymap = get_keymap (keymap, 0, 1), CONSP (keymap)))
- return access_keymap (keymap, AREF (key, 1), t_ok, 0, 1);
- return Qnil;
- }
-
if (!VECTORP (key) && !STRINGP (key))
key = wrong_type_argument (Qarrayp, key);
length = XFASTINT (Flength (key));
if (length == 0)
- return keymap;
-
- GCPRO1 (key);
+ RETURN_UNGCPRO (keymap);
idx = 0;
while (1)
{
Lisp_Object parsed, base, name, assoc;
int modifiers;
-
+
parsed = parse_modifiers (c);
modifiers = (int) XUINT (XCAR (XCDR (parsed)));
base = XCAR (parsed);
c = reorder_modifiers (c);
keystring = concat2 (build_string (new_mods), XCDR (assoc));
-
+
error ((modifiers & ~meta_modifier
? "To bind the key %s, use [?%s], not [%s]"
: "To bind the key %s, use \"%s\", not [%s]"),
- XSYMBOL (c)->name->data, XSTRING (keystring)->data,
- XSYMBOL (c)->name->data);
+ SDATA (SYMBOL_NAME (c)), SDATA (keystring),
+ SDATA (SYMBOL_NAME (c)));
}
}
\f
/* We can't put these variables inside current_minor_maps, since under
some systems, static gets macro-defined to be the empty string.
Ickypoo. */
-static Lisp_Object *cmm_modes, *cmm_maps;
-static int cmm_size;
+static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
+static int cmm_size = 0;
/* Error handler used in current_minor_maps. */
static Lisp_Object
int i = 0;
int list_number = 0;
Lisp_Object alist, assoc, var, val;
+ Lisp_Object emulation_alists;
Lisp_Object lists[2];
+ emulation_alists = Vemulation_mode_map_alists;
lists[0] = Vminor_mode_overriding_map_alist;
lists[1] = Vminor_mode_map_alist;
for (list_number = 0; list_number < 2; list_number++)
- for (alist = lists[list_number];
- CONSP (alist);
- alist = XCDR (alist))
- if ((assoc = XCAR (alist), CONSP (assoc))
- && (var = XCAR (assoc), SYMBOLP (var))
- && (val = find_symbol_value (var), !EQ (val, Qunbound))
- && !NILP (val))
+ {
+ if (CONSP (emulation_alists))
{
- Lisp_Object temp;
+ alist = XCAR (emulation_alists);
+ emulation_alists = XCDR (emulation_alists);
+ if (SYMBOLP (alist))
+ alist = find_symbol_value (alist);
+ list_number = -1;
+ }
+ else
+ alist = lists[list_number];
- /* If a variable has an entry in Vminor_mode_overriding_map_alist,
- and also an entry in Vminor_mode_map_alist,
- ignore the latter. */
- if (list_number == 1)
- {
- val = assq_no_quit (var, lists[0]);
- if (!NILP (val))
- continue;
- }
+ for ( ; CONSP (alist); alist = XCDR (alist))
+ if ((assoc = XCAR (alist), CONSP (assoc))
+ && (var = XCAR (assoc), SYMBOLP (var))
+ && (val = find_symbol_value (var), !EQ (val, Qunbound))
+ && !NILP (val))
+ {
+ Lisp_Object temp;
- if (i >= cmm_size)
- {
- Lisp_Object *newmodes, *newmaps;
+ /* If a variable has an entry in Vminor_mode_overriding_map_alist,
+ and also an entry in Vminor_mode_map_alist,
+ ignore the latter. */
+ if (list_number == 1)
+ {
+ val = assq_no_quit (var, lists[0]);
+ if (!NILP (val))
+ continue;
+ }
- /* Use malloc/realloc here. See the comment above
- this function. */
- if (cmm_maps)
- {
- BLOCK_INPUT;
- cmm_size *= 2;
- newmodes
- = (Lisp_Object *) realloc (cmm_modes,
- cmm_size * sizeof *newmodes);
- newmaps
- = (Lisp_Object *) realloc (cmm_maps,
- cmm_size * sizeof *newmaps);
- UNBLOCK_INPUT;
- }
- else
- {
- BLOCK_INPUT;
- cmm_size = 30;
- newmodes
- = (Lisp_Object *) malloc (cmm_size * sizeof *newmodes);
- newmaps
- = (Lisp_Object *) malloc (cmm_size * sizeof *newmaps);
- UNBLOCK_INPUT;
- }
+ if (i >= cmm_size)
+ {
+ int newsize, allocsize;
+ Lisp_Object *newmodes, *newmaps;
- if (newmodes)
- cmm_modes = newmodes;
- if (newmaps)
- cmm_maps = newmaps;
-
- if (newmodes == NULL || newmaps == NULL)
- break;
- }
+ newsize = cmm_size == 0 ? 30 : cmm_size * 2;
+ allocsize = newsize * sizeof *newmodes;
- /* Get the keymap definition--or nil if it is not defined. */
- temp = internal_condition_case_1 (Findirect_function,
- XCDR (assoc),
- Qerror, current_minor_maps_error);
- if (!NILP (temp))
- {
- cmm_modes[i] = var;
- cmm_maps [i] = temp;
- i++;
- }
- }
+ /* Use malloc here. See the comment above this function.
+ Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
+ BLOCK_INPUT;
+ newmodes = (Lisp_Object *) malloc (allocsize);
+ if (newmodes)
+ {
+ if (cmm_modes)
+ {
+ bcopy (cmm_modes, newmodes, cmm_size * sizeof cmm_modes[0]);
+ free (cmm_modes);
+ }
+ cmm_modes = newmodes;
+ }
+
+ newmaps = (Lisp_Object *) malloc (allocsize);
+ if (newmaps)
+ {
+ if (cmm_maps)
+ {
+ bcopy (cmm_maps, newmaps, cmm_size * sizeof cmm_maps[0]);
+ free (cmm_maps);
+ }
+ cmm_maps = newmaps;
+ }
+ UNBLOCK_INPUT;
+
+ if (newmodes == NULL || newmaps == NULL)
+ break;
+ cmm_size = newsize;
+ }
+
+ /* Get the keymap definition--or nil if it is not defined. */
+ temp = internal_condition_case_1 (Findirect_function,
+ XCDR (assoc),
+ Qerror, current_minor_maps_error);
+ if (!NILP (temp))
+ {
+ cmm_modes[i] = var;
+ cmm_maps [i] = temp;
+ i++;
+ }
+ }
+ }
if (modeptr) *modeptr = cmm_modes;
if (mapptr) *mapptr = cmm_maps;
if (!NILP (local))
keymaps = Fcons (local, keymaps);
}
-
+
return keymaps;
}
Like the normal command loop, `key-binding' will remap the command
resulting from looking up KEY by looking up the command in the
-currrent keymaps. However, if the optional third argument NO-REMAP
+current keymaps. However, if the optional third argument NO-REMAP
is non-nil, `key-binding' returns the unmapped command. */)
(key, accept_default, no_remap)
Lisp_Object key, accept_default, no_remap;
goto done;
}
else
- {
+ {
Lisp_Object local;
local = get_local_map (PT, current_buffer, Qkeymap);
/* If the result of the ordinary keymap lookup is an interactive
command, look for a key binding (ie. remapping) for that command. */
-
+
if (NILP (no_remap) && SYMBOLP (value))
{
Lisp_Object value1;
- if (value1 = Fremap_command (value), !NILP (value1))
+ if (value1 = Fcommand_remapping (value), !NILP (value1))
value = value1;
}
-
+
return value;
}
{
Lisp_Object tem;
- cmd = get_keyelt (cmd, 0);
+ cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
if (NILP (cmd))
return;
- tem = get_keymap (cmd, 0, 0);
- if (CONSP (tem))
- {
- cmd = tem;
- /* Ignore keymaps that are already added to maps. */
- tem = Frassq (cmd, maps);
- if (NILP (tem))
- {
- /* If the last key in thisseq is meta-prefix-char,
- turn it into a meta-ized keystroke. We know
- that the event we're about to append is an
- ascii keystroke since we're processing a
- keymap table. */
- if (is_metized)
- {
- int meta_bit = meta_modifier;
- Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
- tem = Fcopy_sequence (thisseq);
-
- Faset (tem, last, make_number (XINT (key) | meta_bit));
-
- /* This new sequence is the same length as
- thisseq, so stick it in the list right
- after this one. */
- XSETCDR (tail,
- Fcons (Fcons (tem, cmd), XCDR (tail)));
- }
- else
- {
- tem = append_key (thisseq, key);
- nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
- }
+ /* Look for and break cycles. */
+ while (!NILP (tem = Frassq (cmd, maps)))
+ {
+ Lisp_Object prefix = XCAR (tem);
+ int lim = XINT (Flength (XCAR (tem)));
+ if (lim <= XINT (Flength (thisseq)))
+ { /* This keymap was already seen with a smaller prefix. */
+ int i = 0;
+ while (i < lim && EQ (Faref (prefix, make_number (i)),
+ Faref (thisseq, make_number (i))))
+ i++;
+ if (i >= lim)
+ /* `prefix' is a prefix of `thisseq' => there's a cycle. */
+ return;
}
-
+ /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
+ but maybe `cmd' occurs again further down in `maps', so keep
+ looking. */
+ maps = XCDR (Fmemq (tem, maps));
+ }
+
+ /* If the last key in thisseq is meta-prefix-char,
+ turn it into a meta-ized keystroke. We know
+ that the event we're about to append is an
+ ascii keystroke since we're processing a
+ keymap table. */
+ if (is_metized)
+ {
+ int meta_bit = meta_modifier;
+ Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
+ tem = Fcopy_sequence (thisseq);
-
++
+ Faset (tem, last, make_number (XINT (key) | meta_bit));
++
+ /* This new sequence is the same length as
+ thisseq, so stick it in the list right
+ after this one. */
+ XSETCDR (tail,
+ Fcons (Fcons (tem, cmd), XCDR (tail)));
+ }
+ else
+ {
+ tem = append_key (thisseq, key);
+ nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
}
}
(keymap, prefix)
Lisp_Object keymap, prefix;
{
- Lisp_Object maps, good_maps, tail;
+ Lisp_Object maps, tail;
int prefixlen = 0;
/* no need for gcpro because we don't autoload any keymaps. */
int i, i_byte, c;
Lisp_Object copy;
- copy = Fmake_vector (make_number (XSTRING (prefix)->size), Qnil);
- for (i = 0, i_byte = 0; i < XSTRING (prefix)->size;)
+ copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
+ for (i = 0, i_byte = 0; i < SCHARS (prefix);)
{
int i_before = i;
{
Lisp_Object indices[3];
- map_char_table (accessible_keymaps_char_table, Qnil, elt,
+ map_char_table (accessible_keymaps_char_table, Qnil,
elt, Fcons (Fcons (maps, make_number (is_metized)),
-- Fcons (tail, thisseq)),
-- 0, indices);
++ Fcons (tail, thisseq)));
}
else if (VECTORP (elt))
{
for (i = 0; i < ASIZE (elt); i++)
accessible_keymaps_1 (make_number (i), AREF (elt, i),
maps, tail, thisseq, is_metized);
-
+
}
else if (CONSP (elt))
accessible_keymaps_1 (XCAR (elt), XCDR (elt),
maps, tail, thisseq,
is_metized && INTEGERP (XCAR (elt)));
-
- }
- }
-
- if (NILP (prefix))
- return maps;
-
- /* Now find just the maps whose access prefixes start with PREFIX. */
- good_maps = Qnil;
- for (; CONSP (maps); maps = XCDR (maps))
- {
- Lisp_Object elt, thisseq;
- elt = XCAR (maps);
- thisseq = XCAR (elt);
- /* The access prefix must be at least as long as PREFIX,
- and the first elements must match those of PREFIX. */
- if (XINT (Flength (thisseq)) >= prefixlen)
- {
- int i;
- for (i = 0; i < prefixlen; i++)
- {
- Lisp_Object i1;
- XSETFASTINT (i1, i);
- if (!EQ (Faref (thisseq, i1), Faref (prefix, i1)))
- break;
- }
- if (i == prefixlen)
- good_maps = Fcons (elt, good_maps);
}
}
- return Fnreverse (good_maps);
+ return maps;
}
\f
Lisp_Object Qsingle_key_description, Qkey_description;
{
Lisp_Object vector;
vector = Fmake_vector (Flength (keys), Qnil);
- for (i = 0, i_byte = 0; i < XSTRING (keys)->size; )
+ for (i = 0, i_byte = 0; i < SCHARS (keys); )
{
int c;
int i_before = i;
int force_multibyte;
{
unsigned c2;
-
+
/* Clear all the meaningless bits above the meta bit. */
c &= meta_modifier | ~ - meta_modifier;
c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
{
*p++ = c;
}
+ else if (CHARACTERP (make_number (c)))
+ {
+ if (NILP (current_buffer->enable_multibyte_characters)
+ && ! force_multibyte)
+ *p++ = multibyte_char_to_unibyte (c, Qnil);
+ else
+ p += CHAR_STRING (c, (unsigned char *) p);
+ }
else
{
- int valid_p = SINGLE_BYTE_CHAR_P (c) || char_valid_p (c, 0);
-
- if (force_multibyte && valid_p)
+ int bit_offset;
+ *p++ = '\\';
+ /* The biggest character code uses 22 bits. */
+ for (bit_offset = 21; bit_offset >= 0; bit_offset -= 3)
{
- 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)
- || valid_p)
- {
- 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';
- }
+ if (c >= (1 << bit_offset))
+ *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
}
- else
- p += CHAR_STRING (c, 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);
+ char tem[KEY_DESCRIPTION_SIZE];
- if (charset
- && CHARSET_DEFINED_P (charset)
- && ((c1 >= 0 && c1 < 32)
- || (c2 >= 0 && c2 < 32)))
- {
- /* Handle a generic character. */
- Lisp_Object name;
- name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX);
- CHECK_STRING (name);
- return concat2 (build_string ("Character set "), name);
- }
- else
- {
- char tem[KEY_DESCRIPTION_SIZE], *end;
- int nbytes, nchars;
- Lisp_Object string;
-
- 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 */
{
if (NILP (no_angles))
{
char *buffer
- = (char *) alloca (STRING_BYTES (XSYMBOL (key)->name) + 5);
- sprintf (buffer, "<%s>", XSYMBOL (key)->name->data);
+ = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
+ sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
return build_string (buffer);
}
else
CHECK_NUMBER (character);
c = XINT (character);
- if (!SINGLE_BYTE_CHAR_P (c))
+ if (!ASCII_CHAR_P (c))
{
int len = CHAR_STRING (c, str);
return Qnil;
}
+static Lisp_Object Vmenu_events;
+
/* This function can GC if Flookup_key autoloads any keymaps. */
static Lisp_Object
if (NILP (no_remap) && SYMBOLP (definition))
{
Lisp_Object tem;
- if (tem = Fremap_command (definition), !NILP (tem))
+ if (tem = Fcommand_remapping (definition), !NILP (tem))
return Qnil;
}
Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
found = XCDR (found);
}
-
+
GCPRO5 (definition, keymaps, maps, found, sequences);
found = Qnil;
sequences = Qnil;
for (; !NILP (maps); maps = Fcdr (maps))
{
/* Key sequence to reach map, and the map that it reaches */
- register Lisp_Object this, map;
+ register Lisp_Object this, map, tem;
/* In order to fold [META-PREFIX-CHAR CHAR] sequences into
[M-CHAR] sequences, check if last character of the sequence
/* if (nomenus && !ascii_sequence_p (this)) */
if (nomenus && XINT (last) >= 0
- && !INTEGERP (Faref (this, make_number (0))))
+ && SYMBOLP (tem = Faref (this, make_number (0)))
+ && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmenu_events)))
/* If no menu entries should be returned, skip over the
keymaps bound to `menu-bar' and `tool-bar' and other
non-ascii prefixes like `C-down-mouse-2'. */
continue;
-
+
QUIT;
while (CONSP (map))
Fcons (Fcons (this, last),
Fcons (make_number (nomenus),
make_number (last_is_meta))));
- map_char_table (where_is_internal_2, Qnil, elt, elt, args,
- map_char_table (where_is_internal_2, Qnil, elt, args,
-- 0, indices);
++ map_char_table (where_is_internal_2, Qnil, elt, args);
sequences = XCDR (XCAR (args));
}
else if (CONSP (elt))
return the best we could find. */
if (!NILP (firstonly))
return Fcar (found);
-
+
return found;
}
Lisp_Object *defns;
int i, j, n;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-
+
/* Check heuristic-consistency of the cache. */
if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
where_is_cache = Qnil;
Lisp_Object args[2];
where_is_cache = Fmake_hash_table (0, args);
where_is_cache_keymaps = Qt;
-
+
/* Fill in the cache. */
GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
defns = (Lisp_Object *) alloca (n * sizeof *defns);
for (i = 0; CONSP (sequences); sequences = XCDR (sequences))
defns[i++] = XCAR (sequences);
-
+
/* Verify that the key bindings are not shadowed. Note that
the following can GC. */
GCPRO2 (definition, keymaps);
if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
{
int c;
- unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
- int translate_len = XSTRING (Vkeyboard_translate_table)->size;
+ const unsigned char *translate = SDATA (Vkeyboard_translate_table);
+ int translate_len = SCHARS (Vkeyboard_translate_table);
for (c = 0; c < translate_len; c++)
if (translate[c] != c)
if (!SYMBOLP (modes[i]))
abort();
- p = title = (char *) alloca (42 + XSYMBOL (modes[i])->name->size);
+ p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
*p++ = '\f';
*p++ = '\n';
*p++ = '`';
- bcopy (XSYMBOL (modes[i])->name->data, p,
- XSYMBOL (modes[i])->name->size);
- p += XSYMBOL (modes[i])->name->size;
+ bcopy (SDATA (SYMBOL_NAME (modes[i])), p,
+ SCHARS (SYMBOL_NAME (modes[i])));
+ p += SCHARS (SYMBOL_NAME (modes[i]));
*p++ = '\'';
bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
p += sizeof (" Minor Mode Bindings") - 1;
/* If the sequence by which we reach this keymap is zero-length,
then the shadow map for this keymap is just SHADOW. */
- if ((STRINGP (prefix) && XSTRING (prefix)->size == 0)
+ if ((STRINGP (prefix) && SCHARS (prefix) == 0)
|| (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
;
/* If the sequence by which we reach this keymap actually has
Lisp_Object definition, args;
{
register Lisp_Object tem1;
- int column = current_column ();
+ int column = (int) current_column (); /* iftc */
int description_column;
/* If column 16 is no good, go to col 32;
if (SYMBOLP (definition))
{
- XSETSTRING (tem1, XSYMBOL (definition)->name);
+ tem1 = SYMBOL_NAME (definition);
insert1 (tem1);
insert_string ("\n");
}
if (SYMBOLP (definition))
{
- XSETSTRING (tem1, XSYMBOL (definition)->name);
+ tem1 = SYMBOL_NAME (definition);
insert1 (tem1);
insert_string ("\n");
}
(vector, describer)
Lisp_Object vector, describer;
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
if (NILP (describer))
describer = intern ("princ");
specbind (Qstandard_output, Fcurrent_buffer ());
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.
- 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. */
void
describe_vector (vector, elt_prefix, args, elt_describer,
{
Lisp_Object definition;
Lisp_Object tem2;
- register int i;
+ int i;
Lisp_Object suppress;
Lisp_Object kludge;
- int first = 1;
struct gcpro gcpro1, gcpro2, gcpro3;
/* 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;
+ int first = 1;
suppress = Qnil;
- if (indices == 0)
- indices = (int *) alloca (3 * sizeof (int));
-
definition = Qnil;
/* This vector gets used to present single keys to Flookup_key. Since
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++)
{
- 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;
+ character = make_number (starting_i);
/* If this binding is shadowed by some other map, ignore it. */
- if (!NILP (shadow) && complete_char)
+ if (!NILP (shadow))
{
Lisp_Object tem;
-
+
- ASET (kludge, 0, make_number (character));
+ ASET (kludge, 0, character);
tem = shadow_lookup (shadow, kludge, Qt);
if (!NILP (tem)) continue;
/* 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;
- ASET (kludge, 0, make_number (character));
+ ASET (kludge, 0, character);
tem = Flookup_key (entire_map, kludge, Qt);
if (!EQ (tem, definition))
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 (Fsingle_key_description (make_number (character), Qnil));
- 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 (Fsingle_key_description (make_number (character), Qnil));
- }
-
- /* 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, elt_prefix, args, elt_describer,
- partial, shadow, entire_map,
- indices, char_table_depth + 1);
- continue;
- }
-
- starting_i = i;
+ insert1 (Fsingle_key_description (character, Qnil));
/* 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 (Fsingle_key_description (make_number (i), Qnil));
- }
- 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 (Fsingle_key_description (make_number (i), Qnil));
- }
+
+ insert1 (Fsingle_key_description (make_number (i), Qnil));
}
/* Print a description of the definition of this character.
(*elt_describer) (definition, args);
}
- /* For (sub) char-table, print `defalt' slot at last. */
- if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
- {
- insert (" ", char_table_depth * 2);
- insert_string ("<<default>>");
- (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
- }
-
UNGCPRO;
}
-
\f
/* Apropos - finding all symbols whose names match a regexp. */
static Lisp_Object apropos_predicate;
apropos_accumulate = Fcons (symbol, apropos_accumulate);
}
-DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
- doc: /* Find all symbols whose names contain match for REGEXP.
+DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
+ doc: /* Show all symbols whose names contain match for REGEXP.
If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
for each symbol and a symbol is mentioned only if that returns non-nil.
Return list of symbols found. */)
(regexp, predicate)
Lisp_Object regexp, predicate;
{
- struct gcpro gcpro1;
- Lisp_Object result;
+ Lisp_Object tem;
CHECK_STRING (regexp);
- apropos_predicate = predicate; /* predicate protected by the call */
- apropos_accumulate = Qnil; /* staticpro'd */
+ apropos_predicate = predicate;
+ apropos_accumulate = Qnil;
map_obarray (Vobarray, apropos_accum, regexp);
- result = Fsort (apropos_accumulate, Qstring_lessp);
- apropos_accumulate = Qnil; /* Allow the result to be GCed. */
+ tem = Fsort (apropos_accumulate, Qstring_lessp);
+ apropos_accumulate = Qnil;
apropos_predicate = Qnil;
- return result;
+ return tem;
}
\f
void
{
Qkeymap = intern ("keymap");
staticpro (&Qkeymap);
+ staticpro (&apropos_predicate);
+ staticpro (&apropos_accumulate);
+ apropos_predicate = Qnil;
+ apropos_accumulate = Qnil;
/* Now we are ready to set up this property, so we can
create char tables. */
DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
doc: /* Alist of keymaps to use for minor modes, in current major mode.
-This variable is a alist just like `minor-mode-map-alist', and it is
+This variable is an alist just like `minor-mode-map-alist', and it is
used the same way (and before `minor-mode-map-alist'); however,
it is provided for major modes to bind locally. */);
Vminor_mode_overriding_map_alist = Qnil;
+ DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists,
+ doc: /* List of keymap alists to use for emulations modes.
+It is intended for modes or packages using multiple minor-mode keymaps.
+Each element is a keymap alist just like `minor-mode-map-alist', or a
+symbol with a variable binding which is a keymap alist, and it is used
+the same way. The "active" keymaps in each alist are used before
+`minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
+ Vemulation_mode_map_alists = Qnil;
+
+
DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
doc: /* Keymap mapping ASCII function key sequences onto their preferred forms.
This allows Emacs to recognize function keys sent from ASCII
and applies even for keys that have ordinary bindings. */);
Vkey_translation_map = Qnil;
+ staticpro (&Vmenu_events);
+ Vmenu_events = Fcons (intern ("menu-bar"),
+ Fcons (intern ("tool-bar"),
+ Fcons (intern ("mouse-1"),
+ Fcons (intern ("mouse-2"),
+ Fcons (intern ("mouse-3"),
+ Qnil)))));
+
+
Qsingle_key_description = intern ("single-key-description");
staticpro (&Qsingle_key_description);
Qremap = intern ("remap");
staticpro (&Qremap);
- remap_command_vector = Fmake_vector (make_number (2), Qremap);
- staticpro (&remap_command_vector);
+ command_remapping_vector = Fmake_vector (make_number (2), Qremap);
+ staticpro (&command_remapping_vector);
where_is_cache_keymaps = Qt;
where_is_cache = Qnil;
staticpro (&where_is_cache);
staticpro (&where_is_cache_keymaps);
- apropos_accumulate = Qnil;
- staticpro (&apropos_accumulate);
defsubr (&Skeymapp);
defsubr (&Skeymap_parent);
defsubr (&Sset_keymap_parent);
defsubr (&Smake_keymap);
defsubr (&Smake_sparse_keymap);
+ defsubr (&Smap_keymap);
defsubr (&Scopy_keymap);
- defsubr (&Sremap_command);
+ defsubr (&Scommand_remapping);
defsubr (&Skey_binding);
defsubr (&Slocal_key_binding);
defsubr (&Sglobal_key_binding);
/* Fundamental definitions for GNU Emacs Lisp interpreter.
- Copyright (C) 1985,86,87,93,94,95,97,98,1999,2000, 2001
+ Copyright (C) 1985,86,87,93,94,95,97,98,1999,2000, 2001, 2002, 2003
Free Software Foundation, Inc.
This file is part of GNU Emacs.
be compared to the sizes recorded in Lisp strings. */
#define GC_CHECK_STRING_BYTES 1
-#endif /* 0*/
+#endif /* 0 */
+
/* These are default choices for the types to use. */
#ifdef _LP64
#ifdef ENABLE_CHECKING
-#define CHECK(check,msg) ((check || suppress_checking \
+#define CHECK(check,msg) (((check) || suppress_checking \
? (void) 0 \
- : die (msg, __FILE__, __LINE__)), \
+ : die ((msg), __FILE__, __LINE__)), \
0)
/* Let's get some compile-time checking too. */
Lisp_Misc_Some_Buffer_Local_Value,
Lisp_Misc_Overlay,
Lisp_Misc_Kboard_Objfwd,
+ Lisp_Misc_Save_Value,
/* Currently floats are not a misc type,
but let's define this in case we want to change that. */
Lisp_Misc_Float,
Lisp_Misc_Limit
};
-/* These values are overridden by the m- file on some machines. */
-#ifndef VALBITS
-#define VALBITS (BITS_PER_EMACS_INT - 4)
-#endif
-
#ifndef GCTYPEBITS
#define GCTYPEBITS 3
#endif
+/* These values are overridden by the m- file on some machines. */
+#ifndef VALBITS
+/* The -1 is for the markbit. */
+#define VALBITS (BITS_PER_EMACS_INT - GCTYPEBITS - 1)
+#endif
+
#ifndef NO_UNION_TYPE
#ifndef WORDS_BIG_ENDIAN
return o;
}
#else
-#define LISP_MAKE_RVALUE(o) (o) /* XXX - keeps arg as rvalue. */
+/* This isn't quite right - it keeps the argument as an lvalue.
+ Making it const via casting would help avoid code actually
+ modifying the location in question, but the casting could cover
+ other type-related bugs. */
+#define LISP_MAKE_RVALUE(o) (o)
#endif
#endif /* NO_UNION_TYPE */
/* Two flags that are set during GC. On some machines, these flags
are defined differently by the m- file. */
-/* This is set in the car of a cons and in the plist slot of a symbol
- to indicate it is marked. Likewise in the plist slot of an interval,
- the chain slot of a marker, the type slot of a float, and the name
- slot of a buffer.
-
- In strings, this bit in the size field indicates that the string
- is a "large" one, one which was separately malloc'd
- rather than being part of a string block. */
+/* This is set in the car of a cons to indicate it is marked.
+ Likewise in the type slot of a float and in the size slot of strings. */
#ifndef MARKBIT
#define MARKBIT ((EMACS_INT) ((EMACS_UINT) 1 << (VALBITS + GCTYPEBITS)))
#endif /*MARKBIT */
-/* In the size word of a vector, this bit means the vector has been marked.
- In the size word of a large string, likewise. */
+/* In the size word of a vector, this bit means the vector has been marked. */
#ifndef ARRAY_MARK_FLAG
#define ARRAY_MARK_FLAG ((MARKBIT >> 1) & ~MARKBIT)
PVEC_BOOL_VECTOR = 0x10000,
PVEC_BUFFER = 0x20000,
PVEC_HASH_TABLE = 0x40000,
- PVEC_TYPE_MASK = 0x7fe00
+ PVEC_SUB_CHAR_TABLE = 0x80000,
+ PVEC_TYPE_MASK = 0x0ffe00
-
+
#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
emacs.c. */
/* For integers known to be positive, XFASTINT provides fast retrieval
and XSETFASTINT provides fast storage. This takes advantage of the
- fact that Lisp_Int is 0. */
+ fact that Lisp_Int is 0.
+ Beware: XFASTINT applied to a non-positive integer or to something
+ else than an integer should return something that preserves all the
+ info that was in the Lisp_Object, because it is used in EQ. */
#define XFASTINT(a) ((a) + 0)
#define XSETFASTINT(a, b) ((a) = (b))
#define XUINT(a) ((EMACS_UINT) ((a) & VALMASK))
#endif
-#ifndef XPNTR
-#ifdef HAVE_SHM
-/* In this representation, data is found in two widely separated segments. */
-extern size_t pure_size;
-#define XPNTR(a) \
- (XUINT (a) | (XUINT (a) > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS))
-#else /* not HAVE_SHM */
-#ifdef DATA_SEG_BITS
-/* This case is used for the rt-pc.
- In the diffs I was given, it checked for ptr = 0
- and did not adjust it in that case.
- But I don't think that zero should ever be found
- in a Lisp object whose data type says it points to something. */
-#define XPNTR(a) (XUINT (a) | DATA_SEG_BITS)
-#else
-#define XPNTR(a) XUINT (a)
-#endif
-#endif /* not HAVE_SHM */
-#endif /* no XPNTR */
-
#ifndef XSET
#define XSET(var, type, ptr) \
((var) = ((EMACS_INT)(type) << VALBITS) + ((EMACS_INT) (ptr) & VALMASK))
#define XMARKBIT(a) ((a) & MARKBIT)
#endif
-#ifndef XSETMARKBIT
-#define XSETMARKBIT(a,b) ((a) = ((a) & ~MARKBIT) | ((b) ? MARKBIT : 0))
-#endif
-
#ifndef XMARK
#define XMARK(a) ((a) |= MARKBIT)
#endif
#endif /* EXPLICIT_SIGN_EXTEND */
#define XUINT(a) ((a).u.val)
-#define XPNTR(a) ((a).u.val)
#define XSET(var, vartype, ptr) \
(((var).s.val = ((EMACS_INT) (ptr))), ((var).s.type = ((char) (vartype))))
#define XGCTYPE(a) ((a).gu.type)
#define XMARKBIT(a) ((a).gu.markbit)
-#define XSETMARKBIT(a,b) (XMARKBIT(a) = (b))
#define XMARK(a) (XMARKBIT(a) = 1)
#define XUNMARK(a) (XMARKBIT(a) = 0)
#endif /* NO_UNION_TYPE */
+#ifndef XPNTR
+#ifdef HAVE_SHM
+/* In this representation, data is found in two widely separated segments. */
+extern size_t pure_size;
+#define XPNTR(a) \
+ (XUINT (a) | (XUINT (a) > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS))
+#else /* not HAVE_SHM */
+#ifdef DATA_SEG_BITS
+/* This case is used for the rt-pc.
+ In the diffs I was given, it checked for ptr = 0
+ and did not adjust it in that case.
+ But I don't think that zero should ever be found
+ in a Lisp object whose data type says it points to something. */
+#define XPNTR(a) (XUINT (a) | DATA_SEG_BITS)
+#else
+#define XPNTR(a) XUINT (a)
+#endif
+#endif /* not HAVE_SHM */
+#endif /* no XPNTR */
+
/* Largest and smallest representable fixnum values. These are the C
values. */
#define XBUFFER_LOCAL_VALUE(a) (&(XMISC(a)->u_buffer_local_value))
#define XOVERLAY(a) (&(XMISC(a)->u_overlay))
#define XKBOARD_OBJFWD(a) (&(XMISC(a)->u_kboard_objfwd))
+#define XSAVE_VALUE(a) (&(XMISC(a)->u_save_value))
/* Pseudovector types. */
#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) ((struct Lisp_Char_Table *) XPNTR(a))
+ #define XSUB_CHAR_TABLE(a) ((struct Lisp_Sub_Char_Table *) XPNTR(a))
#define XBOOL_VECTOR(a) ((struct Lisp_Bool_Vector *) XPNTR(a))
/* Construct a Lisp_Object from a value or address. */
-#define XSETINT(a, b) XSET (a, Lisp_Int, b)
+#define XSETINT(a, b) (a) = make_number (b)
#define XSETCONS(a, b) XSET (a, Lisp_Cons, b)
#define XSETVECTOR(a, b) XSET (a, Lisp_Vectorlike, b)
#define XSETSTRING(a, b) XSET (a, Lisp_String, b)
#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. */
#define ASET(ARRAY, IDX, VAL) (AREF ((ARRAY), (IDX)) = (VAL))
#define ASIZE(ARRAY) XVECTOR ((ARRAY))->size
-\f
-/* Basic data type for use of intervals. See the macros in intervals.h. */
+/* Convenience macros for dealing with Lisp strings. */
-struct interval
-{
- /* The first group of entries deal with the tree structure. */
-
- unsigned int total_length; /* Length of myself and both children. */
- unsigned int position; /* Cache of interval's character position. */
- /* This field is usually updated
- simultaneously with an interval
- traversal, there is no guarantee
- that it is valid for a random
- interval. */
- struct interval *left; /* Intervals which precede me. */
- struct interval *right; /* Intervals which succeed me. */
-
- /* Parent in the tree, or the Lisp_Object containing this interval tree.
-
- The mark bit on the root interval of an interval tree says
- whether we have started (and possibly finished) marking the
- tree. If GC comes across an interval tree whose root's parent
- field has its markbit set, it leaves the tree alone.
-
- You'd think we could store this information in the parent object
- somewhere (after all, that should be visited once and then
- ignored too, right?), but strings are GC'd strangely. */
- union
- {
- struct interval *interval;
- Lisp_Object obj;
- } up;
- unsigned int up_obj : 1;
-
- /* The remaining components are `properties' of the interval.
- The first four are duplicates for things which can be on the list,
- for purposes of speed. */
-
- unsigned int write_protect : 1; /* Non-zero means can't modify. */
- unsigned int visible : 1; /* Zero means don't display. */
- unsigned int front_sticky : 1; /* Non-zero means text inserted just
- before this interval goes into it. */
- unsigned int rear_sticky : 1; /* Likewise for just after it. */
-
- /* Properties of this interval.
- The mark bit on this field says whether this particular interval
- tree node has been visited. Since intervals should never be
- shared, GC aborts if it seems to have visited an interval twice. */
- Lisp_Object plist;
-};
+#define SREF(string, index) (XSTRING (string)->data[index] + 0)
+#define SSET(string, index, new) (XSTRING (string)->data[index] = (new))
+#define SDATA(string) (XSTRING (string)->data + 0)
+#define SCHARS(string) (XSTRING (string)->size + 0)
+#define SBYTES(string) (STRING_BYTES (XSTRING (string)) + 0)
+
+#define STRING_SET_CHARS(string, newsize) \
+ (XSTRING (string)->size = (newsize))
+
+#define STRING_COPYIN(string, index, new, count) \
+ bcopy (new, XSTRING (string)->data + index, count)
+
+\f
+/* See the macros in intervals.h. */
typedef struct interval *INTERVAL;
#define XCDR_AS_LVALUE(c) (XCONS ((c))->cdr)
#endif
-/* Okay, we're not quite ready to turn this on yet. A few files still
- need to be updated and tested. */
-#undef LISP_MAKE_RVALUE
-#define LISP_MAKE_RVALUE(x) (x)
-
/* Use these from normal code. */
#define XCAR(c) LISP_MAKE_RVALUE(XCAR_AS_LVALUE(c))
#define XCDR(c) LISP_MAKE_RVALUE(XCDR_AS_LVALUE(c))
#endif /* not GC_CHECK_STRING_BYTES */
-/* Set the length in bytes of STR. */
-#define SET_STRING_BYTES(STR, SIZE) ((STR)->size_byte = (SIZE))
+/* Mark STR as a unibyte string. */
+#define STRING_SET_UNIBYTE(STR) (XSTRING (STR)->size_byte = -1)
+
+/* Get text properties. */
+#define STRING_INTERVALS(STR) (XSTRING (STR)->intervals + 0)
+
+/* Set text properties. */
+#define STRING_SET_INTERVALS(STR, INT) (XSTRING (STR)->intervals = (INT))
/* In a string or vector, the sign bit of the `size' is the gc mark bit */
Lisp_Object contents[1];
};
- /* 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
-
- /* 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,
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 defalt, parent, purpose, ascii, contents, and extras
- slots. */
- EMACS_INT size;
- struct Lisp_Vector *next;
+ {
+ /* 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. */
++ pseudovector type information. It holds the size, too. The size
++ counts the defalt, parent, purpose, ascii, contents, and extras
++ slots. */
+ EMACS_INT 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 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 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;
++ /* 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;
++ /* 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)];
++ Lisp_Object contents[(1 << CHARTAB_SIZE_BITS_0)];
+
- /* These hold additional data. It is a vector. */
- Lisp_Object extras[1];
-};
++ /* These hold additional data. It is a vector. */
+ Lisp_Object extras[1];
+ };
-{
- /* 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;
+ struct Lisp_Sub_Char_Table
- /* 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;
++ {
++ /* 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;
+
- /* Minimum character covered by the sub char-table. */
- Lisp_Object min_char;
++ /* 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;
+
- Lisp_Object contents[1];
-};
++ /* 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
{
struct Lisp_Symbol
{
+ unsigned gcmarkbit : 1;
+
/* Non-zero means symbol serves as a variable alias. The symbol
holding the real value is found in the value slot. */
unsigned indirect_variable : 1;
enum symbol_interned. */
unsigned interned : 2;
- /* The symbol's name. This should become a Lisp_Object
- some day; there's no need for the Lisp_String pointer nowadays. */
- struct Lisp_String *name;
+ /* The symbol's name, as a Lisp string.
+
+ The name "xname" is used to intentionally break code referring to
+ the old field "name" of type pointer to struct Lisp_String. */
+ Lisp_Object xname;
/* Value of the symbol or Qunbound if unbound. If this symbol is a
defvaralias, `value' contains the symbol for which it is an
/* The symbol's property list. */
Lisp_Object plist;
-
+
/* Next symbol in obarray bucket, if the symbol is interned. */
struct Lisp_Symbol *next;
};
+/* Value is name of symbol. */
+
+#define SYMBOL_NAME(sym) \
+ LISP_MAKE_RVALUE (XSYMBOL (sym)->xname)
+
/* Value is non-zero if SYM is an interned symbol. */
#define SYMBOL_INTERNED_P(sym) \
else \
XSYMBOL (sym)->value = (val); \
} while (0)
-
+
\f
/***********************************************************************
Hash Tables
/* Vector fields. The hash table code doesn't refer to these. */
EMACS_INT size;
struct Lisp_Vector *vec_next;
-
+
/* Function used to compare keys. */
Lisp_Object test;
/* Nil if table is non-weak. Otherwise a symbol describing the
weakness of the table. */
Lisp_Object weak;
-
+
/* When the table is resized, and this is an integer, compute the
new size by adding this to the old size. If a float, compute the
new size by multiplying the old size with this factor. */
} \
while (0)
+/* Value is the key part of entry IDX in hash table H. */
+
+#define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX))
+
+/* Value is the value part of entry IDX in hash table H. */
+
+#define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1)
+
+/* Value is the index of the next entry following the one at IDX
+ in hash table H. */
+
+#define HASH_NEXT(H, IDX) AREF ((H)->next, (IDX))
+
+/* Value is the hash code computed for entry IDX in hash table H. */
+
+#define HASH_HASH(H, IDX) AREF ((H)->hash, (IDX))
+
+/* Value is the index of the element in hash table H that is the
+ start of the collision list at index IDX in the index vector of H. */
+
+#define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX))
+
+/* Value is the size of hash table H. */
+
+#define HASH_TABLE_SIZE(H) XVECTOR ((H)->next)->size
+
/* Default size for hash tables if not specified. */
#define DEFAULT_HASH_SIZE 65
#define DEFAULT_REHASH_SIZE 1.5
-/* Value is the key part of entry IDX in hash table H. */
-
-#define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX))
-
-/* Value is the value part of entry IDX in hash table H. */
-
-#define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1)
-
\f
/* These structures are used for various misc types. */
struct Lisp_Free
{
int type : 16; /* = Lisp_Misc_Free */
- int spacer : 16;
+ unsigned gcmarkbit : 1;
+ int spacer : 15;
union Lisp_Misc *chain;
};
-/* In a marker, the markbit of the chain field is used as the gc mark bit. */
struct Lisp_Marker
{
int type : 16; /* = Lisp_Misc_Marker */
- int spacer : 15;
+ unsigned gcmarkbit : 1;
+ int spacer : 14;
/* 1 means normal insertion at the marker's position
leaves the marker after the inserted text. */
unsigned int insertion_type : 1;
/* For markers that point somewhere,
this is used to chain of all the markers in a given buffer. */
- Lisp_Object chain;
+ struct Lisp_Marker *next;
/* This is the char position where the marker points. */
- int charpos;
+ EMACS_INT charpos;
/* This is the byte position. */
- int bytepos;
+ EMACS_INT bytepos;
};
/* Forwarding pointer to an int variable.
struct Lisp_Intfwd
{
int type : 16; /* = Lisp_Misc_Intfwd */
- int spacer : 16;
- int *intvar;
+ unsigned gcmarkbit : 1;
+ int spacer : 15;
+ EMACS_INT *intvar;
};
/* Boolean forwarding pointer to an int variable.
struct Lisp_Boolfwd
{
int type : 16; /* = Lisp_Misc_Boolfwd */
- int spacer : 16;
+ unsigned gcmarkbit : 1;
+ int spacer : 15;
int *boolvar;
};
struct Lisp_Objfwd
{
int type : 16; /* = Lisp_Misc_Objfwd */
- int spacer : 16;
+ unsigned gcmarkbit : 1;
+ int spacer : 15;
Lisp_Object *objvar;
};
struct Lisp_Buffer_Objfwd
{
int type : 16; /* = Lisp_Misc_Buffer_Objfwd */
- int spacer : 16;
+ unsigned gcmarkbit : 1;
+ int spacer : 15;
int offset;
};
one that corresponds to the loaded binding. To read or set the
variable, you must first make sure the right binding is loaded;
then you can access the value in (or through) `realvalue'.
-
+
`buffer' and `frame' are the buffer and frame for which the loaded
binding was found. If those have changed, to make sure the right
binding is loaded it is necessary to find which binding goes with
{
int type : 16; /* = Lisp_Misc_Buffer_Local_Value
or Lisp_Misc_Some_Buffer_Local_Value */
- int spacer : 13;
+ unsigned gcmarkbit : 1;
+ int spacer : 12;
/* 1 means this variable is allowed to have frame-local bindings,
so check for them when looking for the proper binding. */
Lisp_Object cdr;
};
-/* In an overlay object, the mark bit of the plist is used as the GC mark.
- START and END are markers in the overlay's buffer, and
+/* START and END are markers in the overlay's buffer, and
PLIST is the overlay's property list. */
struct Lisp_Overlay
{
int type : 16; /* = Lisp_Misc_Overlay */
- int spacer : 16;
+ unsigned gcmarkbit : 1;
+ int spacer : 15;
+ struct Lisp_Overlay *next;
Lisp_Object start, end, plist;
};
struct Lisp_Kboard_Objfwd
{
int type : 16; /* = Lisp_Misc_Kboard_Objfwd */
- int spacer : 16;
+ unsigned gcmarkbit : 1;
+ int spacer : 15;
int offset;
};
+/* Hold a C pointer for later use.
+ This type of object is used in the arg to record_unwind_protect. */
+struct Lisp_Save_Value
+ {
+ int type : 16; /* = Lisp_Misc_Save_Value */
+ unsigned gcmarkbit : 1;
+ int spacer : 15;
+ void *pointer;
+ int integer;
+ };
+
/* To get the type field of a union Lisp_Misc, use XMISCTYPE.
It uses one of these struct subtypes to get the type field. */
struct Lisp_Buffer_Local_Value u_buffer_local_value;
struct Lisp_Overlay u_overlay;
struct Lisp_Kboard_Objfwd u_kboard_objfwd;
+ struct Lisp_Save_Value u_save_value;
};
\f
/* Lisp floating point type */
struct Lisp_Float
{
- Lisp_Object type; /* essentially used for mark-bit
- and chaining when on free-list */
#ifdef HIDE_LISP_IMPLEMENTATION
double data_;
#else
(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
++#define CHARACTERBITS 2
/* 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 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. */
#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 GC_SUB_CHAR_TABLE_P(x) GC_PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE)
+#define GC_CHAR_TABLE_P(x) GC_PSEUDOVECTORP (x, PVEC_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))
\f
#define EQ(x, y) (XFASTINT (x) == XFASTINT (y))
#define GC_EQ(x, y) (XGCTYPE (x) == XGCTYPE (y) && XPNTR (x) == XPNTR (y))
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
#if (!defined (__STDC__) && !defined (PROTOTYPES)) \
|| defined (USE_NONANSI_DEFUN)
-#define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, args) \
+#define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc) \
Lisp_Object fnname (); \
struct Lisp_Subr sname = \
{ PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \
|| (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \
|| COMPILEDP (OBJ) \
|| SUBRP (OBJ))
-
+
/* defsubr (Sname);
is how we define the symbol for function `name' at start-up time. */
extern void defsubr P_ ((struct Lisp_Subr *));
extern void defvar_lisp P_ ((char *, Lisp_Object *));
extern void defvar_lisp_nopro P_ ((char *, Lisp_Object *));
extern void defvar_bool P_ ((char *, int *));
-extern void defvar_int P_ ((char *, int *));
+extern void defvar_int P_ ((char *, EMACS_INT *));
extern void defvar_per_buffer P_ ((char *, Lisp_Object *, Lisp_Object, char *));
extern void defvar_kboard P_ ((char *, int));
If func is non-zero, undoing this binding applies func to old_value;
This implements record_unwind_protect.
- If func is zero and symbol is nil, undoing this binding evaluates
- the list of forms in old_value; this implements Lisp's unwind-protect
- form.
Otherwise, the element is a variable binding.
-
+
If the symbol field is a symbol, it is an ordinary variable binding.
-
+
Otherwise, it should be a structure (SYMBOL WHERE
. CURRENT-BUFFER), which means having bound a local value while
CURRENT-BUFFER was active. If WHERE is nil this means we saw the
means we saw a buffer-local or frame-local value. Other values of
WHERE mean an internal error. */
+typedef Lisp_Object (*specbinding_func) P_ ((Lisp_Object));
+
struct specbinding
{
- Lisp_Object symbol, old_value;
- Lisp_Object (*func) P_ ((Lisp_Object));
+ volatile Lisp_Object symbol, old_value;
+ volatile specbinding_func func;
Lisp_Object unused; /* Dividing by 16 is faster than by 12 */
};
extern struct specbinding *specpdl;
-extern struct specbinding *specpdl_ptr;
+extern volatile struct specbinding *specpdl_ptr;
extern int specpdl_size;
-extern int max_specpdl_size;
+extern EMACS_INT max_specpdl_size;
-#define BINDING_STACK_SIZE() (specpdl_ptr - specpdl)
+#define SPECPDL_INDEX() (specpdl_ptr - specpdl)
/* Everything needed to describe an active condition case. */
struct handler
{
/* The handler clauses and variable from the condition-case form. */
+ /* For a handler set up in Lisp code, this is always a list.
+ For an internal handler set up by internal_condition_case*,
+ this can instead be the symbol t or `error'.
+ t: handle all conditions.
+ error: handle all conditions, and errors can run the debugger
+ or display a backtrace. */
Lisp_Object handler;
Lisp_Object var;
/* Fsignal stores here the condition-case clause that applies,
/* Threshold for doing another gc. */
-extern int gc_cons_threshold;
+extern EMACS_INT gc_cons_threshold;
/* Structure for recording stack slots that need marking. */
struct gcpro
{
struct gcpro *next;
-
+
/* Address of first protected variable. */
volatile Lisp_Object *var;
-
+
/* Number of consecutive protected variables. */
int nvars;
-
+
#ifdef DEBUG_GCPRO
int level;
#endif
#if GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS
/* Do something silly with gcproN vars just so gcc shuts up. */
+/* You get warnings from MIPSPro... */
#define GCPRO1(varname) ((void) gcpro1)
-#define GCPRO2(varname1, varname2)(((void) gcpro2, (void) gcpro1))
+#define GCPRO2(varname1, varname2)(((void) gcpro2, (void) gcpro1))
#define GCPRO3(varname1, varname2, varname3) \
(((void) gcpro3, (void) gcpro2, (void) gcpro1))
#define GCPRO4(varname1, varname2, varname3, varname4) \
(((void) gcpro4, (void) gcpro3, (void) gcpro2, (void) gcpro1))
#define GCPRO5(varname1, varname2, varname3, varname4, varname5) \
(((void) gcpro5, (void) gcpro4, (void) gcpro3, (void) gcpro2, (void) gcpro1))
+#define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \
+ (((void) gcpro6, (void) gcpro5, (void) gcpro4, (void) gcpro3, (void) gcpro2, (void) gcpro1))
#define UNGCPRO ((void) 0)
#else /* GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS */
gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
gcprolist = &gcpro5; }
+#define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \
+ {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
+ gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
+ gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
+ gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
+ gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
+ gcpro6.next = &gcpro5; gcpro6.var = &varname6; gcpro6.nvars = 1; \
+ gcprolist = &gcpro6; }
+
#define UNGCPRO (gcprolist = gcpro1.next)
#else
gcpro5.level = gcpro_level++; \
gcprolist = &gcpro5; }
+#define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \
+ {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
+ gcpro1.level = gcpro_level; \
+ gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
+ gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
+ gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
+ gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
+ gcpro6.next = &gcpro5; gcpro6.var = &varname6; gcpro6.nvars = 1; \
+ gcpro6.level = gcpro_level++; \
+ gcprolist = &gcpro6; }
+
#define UNGCPRO \
((--gcpro_level != gcpro1.level) \
? (abort (), 0) \
EXFUN (Fend_of_line, 1);
EXFUN (Fforward_char, 1);
EXFUN (Fforward_line, 1);
-extern int forward_point P_ ((int));
extern int internal_self_insert P_ ((int, int));
extern void syms_of_cmds P_ ((void));
extern void keys_of_cmds P_ ((void));
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);
+ EXFUN (Fencode_coding_string, 4);
+ EXFUN (Fdecode_coding_string, 4);
-extern Lisp_Object detect_coding_system P_ ((unsigned char *, int, int, int,
- Lisp_Object));
+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));
/* 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_ ((unsigned char *, int));
-extern int multibyte_chars_in_text P_ ((unsigned char *, int));
+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 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);
EXFUN (Fstring_make_unibyte, 1);
EXFUN (Fstring_as_multibyte, 1);
EXFUN (Fstring_as_unibyte, 1);
+EXFUN (Fstring_to_multibyte, 1);
EXFUN (Fsubstring, 3);
extern Lisp_Object substring_both P_ ((Lisp_Object, int, int, int, int));
EXFUN (Fnth, 2);
EXFUN (Fcopy_alist, 1);
EXFUN (Fplist_get, 2);
EXFUN (Fplist_put, 3);
- EXFUN (Fset_char_table_parent, 2);
- EXFUN (Fchar_table_extra_slot, 2);
- EXFUN (Fset_char_table_extra_slot, 3);
+EXFUN (Fplist_member, 2);
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,
- Lisp_Object *));
- 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 move_gap P_ ((int));
extern void move_gap_both P_ ((int, int));
extern void make_gap P_ ((int));
-extern int copy_text P_ ((unsigned char *, unsigned char *, int, int, int));
-extern int count_size_as_multibyte P_ ((unsigned char *, int));
-extern int count_combining_before P_ ((unsigned char *, int, int, int));
-extern int count_combining_after P_ ((unsigned char *, int, int, int));
-extern void insert P_ ((unsigned char *, int));
-extern void insert_and_inherit P_ ((unsigned char *, int));
-extern void insert_1 P_ ((unsigned char *, int, int, int, int));
-extern void insert_1_both P_ ((unsigned char *, int, int, int, int, int));
+extern int copy_text P_ ((const unsigned char *, unsigned char *, int, int, int));
+extern int count_size_as_multibyte P_ ((const unsigned char *, int));
+extern int count_combining_before P_ ((const unsigned char *, int, int, int));
+extern int count_combining_after P_ ((const unsigned char *, int, int, int));
+extern void insert P_ ((const unsigned char *, int));
+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));
-extern void insert_string P_ ((char *));
-extern void insert_before_markers P_ ((unsigned char *, int));
-extern void insert_before_markers_and_inherit P_ ((unsigned char *, int));
+extern void insert_string P_ ((const char *));
+extern void insert_before_markers P_ ((const unsigned char *, int));
+extern void insert_before_markers_and_inherit P_ ((const unsigned char *, int));
extern void insert_from_string_before_markers P_ ((Lisp_Object, int, int, int, int, int));
extern void del_range P_ ((int, int));
extern Lisp_Object del_range_1 P_ ((int, int, int, int));
/* Defined in dispnew.c */
extern Lisp_Object selected_frame;
+extern EMACS_INT baud_rate;
EXFUN (Fding, 1);
EXFUN (Fredraw_frame, 1);
EXFUN (Fredraw_display, 0);
extern Lisp_Object sit_for P_ ((int, int, int, int, int));
extern void init_display P_ ((void));
extern void syms_of_display P_ ((void));
-extern void safe_bcopy P_ ((char *, char *, int));
+extern void safe_bcopy P_ ((const char *, char *, int));
/* Defined in xdisp.c */
extern Lisp_Object Qinhibit_point_motion_hooks;
extern Lisp_Object Qinhibit_redisplay, Qdisplay;
extern Lisp_Object Qinhibit_eval_during_redisplay;
extern Lisp_Object Qmessage_truncate_lines;
-extern Lisp_Object Qcursor_in_non_selected_windows;
extern Lisp_Object Vmessage_log_max;
extern int message_enable_multibyte;
extern Lisp_Object echo_area_buffer[2];
extern void check_message_stack P_ ((void));
extern void setup_echo_area_for_printing P_ ((int));
extern int push_message P_ ((void));
-extern Lisp_Object push_message_unwind P_ ((Lisp_Object));
+extern Lisp_Object pop_message_unwind P_ ((Lisp_Object));
+extern Lisp_Object restore_message_unwind P_ ((Lisp_Object));
extern void pop_message P_ ((void));
extern void restore_message P_ ((void));
extern Lisp_Object current_message P_ ((void));
-extern void set_message P_ ((char *s, Lisp_Object, int, int));
+extern void set_message P_ ((const char *s, Lisp_Object, int, int));
extern void clear_message P_ ((int, int));
extern void message P_ ((/* char *, ... */));
extern void message_nolog P_ ((/* char *, ... */));
extern void message1 P_ ((char *));
extern void message1_nolog P_ ((char *));
-extern void message2 P_ ((char *, int, int));
-extern void message2_nolog P_ ((char *, int, int));
+extern void message2 P_ ((const char *, int, int));
+extern void message2_nolog P_ ((const char *, int, int));
extern void message3 P_ ((Lisp_Object, int, int));
extern void message3_nolog P_ ((Lisp_Object, int, int));
-extern void message_dolog P_ ((char *, int, int, int));
+extern void message_dolog P_ ((const char *, int, int, int));
extern void message_with_string P_ ((char *, Lisp_Object, int));
extern void message_log_maybe_newline P_ ((void));
extern void update_echo_area P_ ((void));
extern void redisplay_preserve_echo_area P_ ((int));
extern void mark_window_display_accurate P_ ((Lisp_Object, int));
extern void prepare_menu_bars P_ ((void));
+
+void set_frame_cursor_types P_ ((struct frame *, Lisp_Object));
extern void syms_of_xdisp P_ ((void));
extern void init_xdisp P_ ((void));
extern Lisp_Object safe_eval P_ ((Lisp_Object));
extern void memory_full P_ ((void));
extern void buffer_memory_full P_ ((void));
extern int survives_gc_p P_ ((Lisp_Object));
-extern void mark_object P_ ((Lisp_Object *));
+extern void mark_object P_ ((Lisp_Object));
extern Lisp_Object Vpurify_flag;
+extern Lisp_Object Vmemory_full;
EXFUN (Fcons, 2);
EXFUN (list2, 2);
EXFUN (list3, 3);
EXFUN (Fmake_symbol, 1);
EXFUN (Fmake_marker, 0);
EXFUN (Fmake_string, 2);
-extern Lisp_Object build_string P_ ((char *));
-extern Lisp_Object make_string P_ ((char *, int));
-extern Lisp_Object make_unibyte_string P_ ((char *, int));
-extern Lisp_Object make_multibyte_string P_ ((char *, int, int));
+extern Lisp_Object build_string P_ ((const char *));
+extern Lisp_Object make_string P_ ((const char *, int));
+extern Lisp_Object make_unibyte_string P_ ((const char *, int));
+extern Lisp_Object make_multibyte_string P_ ((const char *, int, int));
extern Lisp_Object make_event_array P_ ((int, Lisp_Object *));
extern Lisp_Object make_uninit_string P_ ((int));
extern Lisp_Object make_uninit_multibyte_string P_ ((int, int));
-extern Lisp_Object make_string_from_bytes P_ ((char *, int, int));
-extern Lisp_Object make_specified_string P_ ((char *, int, int, int));
+extern Lisp_Object make_string_from_bytes P_ ((const char *, int, int));
+extern Lisp_Object make_specified_string P_ ((const char *, int, int, int));
EXFUN (Fpurecopy, 1);
extern Lisp_Object make_pure_string P_ ((char *, int, int, int));
extern Lisp_Object pure_cons P_ ((Lisp_Object, Lisp_Object));
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_other_vector P_ ((EMACS_INT));
extern struct frame *allocate_frame P_ ((void));
extern struct Lisp_Process *allocate_process P_ ((void));
extern int gc_in_progress;
+extern int abort_on_gc;
extern Lisp_Object make_float P_ ((double));
extern void display_malloc_warning P_ ((void));
extern int inhibit_garbage_collection P_ ((void));
+extern Lisp_Object make_save_value P_ ((void *, int));
extern void free_marker P_ ((Lisp_Object));
extern void free_cons P_ ((struct Lisp_Cons *));
extern void init_alloc_once P_ ((void));
extern void syms_of_alloc P_ ((void));
extern struct buffer * allocate_buffer P_ ((void));
- Lisp_Object, Lisp_Object, Lisp_Object, int,
- 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));
EXFUN (Ferror_message_string, 1);
extern Lisp_Object Vstandard_output, Qstandard_output;
extern Lisp_Object Qexternal_debugging_output;
-extern void temp_output_buffer_setup P_ ((char *));
+extern void temp_output_buffer_setup P_ ((const char *));
extern int print_level, print_escape_newlines;
extern Lisp_Object Qprint_escape_newlines;
extern void write_string P_ ((char *, int));
extern void write_string_1 P_ ((char *, int, Lisp_Object));
-extern void print_error_message P_ ((Lisp_Object, Lisp_Object));
+extern void print_error_message P_ ((Lisp_Object, Lisp_Object, char *, Lisp_Object));
extern Lisp_Object internal_with_output_to_temp_buffer
- P_ ((char *, Lisp_Object (*) (Lisp_Object), Lisp_Object));
+ P_ ((const char *, Lisp_Object (*) (Lisp_Object), Lisp_Object));
extern void float_to_string P_ ((unsigned char *, double));
extern void syms_of_print P_ ((void));
EXFUN (Fread_event, 2);
extern Lisp_Object read_filtered_event P_ ((int, int, int, int));
EXFUN (Feval_region, 4);
-extern Lisp_Object intern P_ ((char *));
+extern Lisp_Object intern P_ ((const char *));
extern Lisp_Object make_symbol P_ ((char *));
-extern Lisp_Object oblookup P_ ((Lisp_Object, char *, int, int));
+extern Lisp_Object oblookup P_ ((Lisp_Object, const char *, int, int));
#define LOADHIST_ATTACH(x) \
if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list)
extern Lisp_Object Vcurrent_load_list;
extern Lisp_Object Vload_history, Vload_suffixes;
extern int openp P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object *, int));
+ Lisp_Object *, Lisp_Object));
extern int isfloat_string P_ ((char *));
extern void map_obarray P_ ((Lisp_Object, void (*) (Lisp_Object, Lisp_Object),
Lisp_Object));
EXFUN (Fcondition_case, UNEVALLED);
EXFUN (Fsignal, 2);
EXFUN (Fautoload, 5);
-EXFUN (Fcommandp, 1);
+EXFUN (Fcommandp, 2);
EXFUN (Feval, 1);
EXFUN (Fapply, MANY);
EXFUN (Ffuncall, MANY);
extern void syms_of_eval P_ ((void));
/* Defined in editfns.c */
+EXFUN (Fpropertize, MANY);
EXFUN (Fcurrent_message, 0);
EXFUN (Fgoto_char, 1);
EXFUN (Fpoint_min_marker, 0);
EXFUN (Fbobp, 0);
EXFUN (Fformat, MANY);
EXFUN (Fmessage, MANY);
-extern Lisp_Object format1 P_ ((/* char *, ... */));
+extern Lisp_Object format2 P_ ((char *, Lisp_Object, Lisp_Object));
extern Lisp_Object make_buffer_string P_ ((int, int, int));
EXFUN (Fbuffer_substring, 2);
EXFUN (Fbuffer_string, 0);
extern int mouse_face_overlay_overlaps P_ ((Lisp_Object));
extern void nsberror P_ ((Lisp_Object));
extern char *no_switch_window P_ ((Lisp_Object window));
-EXFUN (Fset_buffer_multibyte, 2);
+EXFUN (Fset_buffer_multibyte, 1);
EXFUN (Foverlay_start, 1);
EXFUN (Foverlay_end, 1);
-extern void adjust_overlays_for_insert P_ ((int, int));
-extern void adjust_overlays_for_delete P_ ((int, int));
+extern void adjust_overlays_for_insert P_ ((EMACS_INT, EMACS_INT));
+extern void adjust_overlays_for_delete P_ ((EMACS_INT, EMACS_INT));
extern void fix_overlays_in_range P_ ((int, int));
extern void report_overlay_modification P_ ((Lisp_Object, Lisp_Object, int,
Lisp_Object, Lisp_Object, 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);
extern int charpos_to_bytepos P_ ((int));
extern int buf_charpos_to_bytepos P_ ((struct buffer *, int));
extern int buf_bytepos_to_charpos P_ ((struct buffer *, int));
-extern void unchain_marker P_ ((Lisp_Object));
+extern void unchain_marker P_ ((struct Lisp_Marker *marker));
extern Lisp_Object set_marker_restricted P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
extern Lisp_Object set_marker_both P_ ((Lisp_Object, Lisp_Object, int, int));
extern Lisp_Object set_marker_restricted_both P_ ((Lisp_Object, Lisp_Object,
EXFUN (Fwrite_region, 7);
EXFUN (Ffile_readable_p, 1);
EXFUN (Ffile_executable_p, 1);
-EXFUN (Fread_file_name, 5);
+EXFUN (Fread_file_name, 6);
extern Lisp_Object close_file_unwind P_ ((Lisp_Object));
-extern void report_file_error P_ ((char *, Lisp_Object));
+extern void report_file_error P_ ((const char *, Lisp_Object));
extern int internal_delete_file P_ ((Lisp_Object));
extern void syms_of_fileio P_ ((void));
EXFUN (Fmake_temp_name, 1);
/* Defined in abbrev.c */
-extern Lisp_Object Vfundamental_mode_abbrev_table;
extern void syms_of_abbrev P_ ((void));
/* defined in search.c */
EXFUN (Fmatch_end, 1);
EXFUN (Flooking_at, 1);
extern int fast_string_match P_ ((Lisp_Object, Lisp_Object));
-extern int fast_c_string_match_ignore_case P_ ((Lisp_Object, char *));
+extern int fast_c_string_match_ignore_case P_ ((Lisp_Object, const char *));
extern int scan_buffer P_ ((int, int, int, int, int *, int));
extern int scan_newline P_ ((int, int, int, int, int, int));
extern int find_next_newline P_ ((int, int));
EXFUN (Fread_string, 5);
EXFUN (Fread_no_blanks_input, 3);
extern Lisp_Object get_minibuffer P_ ((int));
-extern void temp_echo_area_glyphs P_ ((char *));
+extern void temp_echo_area_glyphs P_ ((Lisp_Object));
extern void init_minibuf_once P_ ((void));
extern void syms_of_minibuf P_ ((void));
extern void keys_of_minibuf P_ ((void));
EXFUN (Findent_to, 2);
EXFUN (Fcurrent_column, 0);
EXFUN (Fmove_to_column, 2);
-extern int current_column P_ ((void));
+extern double current_column P_ ((void));
extern void invalidate_current_column P_ ((void));
-extern int indented_beyond_p P_ ((int, int, int));
+extern int indented_beyond_p P_ ((int, int, double));
extern void syms_of_indent P_ ((void));
-/* defined in window.c */
-extern Lisp_Object Qwindowp, Qwindow_live_p;
-extern Lisp_Object Vwindow_list;
-EXFUN (Fwindow_end, 2);
-EXFUN (Fselected_window, 0);
-EXFUN (Fnext_window, 3);
-EXFUN (Fdelete_window, 1);
-EXFUN (Fselect_window, 1);
-EXFUN (Fset_window_buffer, 2);
-EXFUN (Fwindow_buffer, 1);
-EXFUN (Fget_buffer_window, 2);
-EXFUN (Fsave_window_excursion, UNEVALLED);
-EXFUN (Fsplit_window, 3);
-EXFUN (Fset_window_configuration, 1);
-EXFUN (Fcurrent_window_configuration, 1);
-extern int compare_window_configurations P_ ((Lisp_Object, Lisp_Object, int));
-EXFUN (Fcoordinates_in_window_p, 2);
-EXFUN (Fwindow_at, 3);
-EXFUN (Fpos_visible_in_window_p, 3);
-extern void mark_window_cursors_off P_ ((struct window *));
-extern int window_internal_height P_ ((struct window *));
-extern int window_internal_width P_ ((struct window *));
-EXFUN (Frecenter, 1);
-EXFUN (Fscroll_other_window, 1);
-EXFUN (Fset_window_start, 3);
-extern void temp_output_buffer_show P_ ((Lisp_Object));
-extern void replace_buffer_in_all_windows P_ ((Lisp_Object));
-extern void init_window_once P_ ((void));
-extern void init_window P_ ((void));
-extern void syms_of_window P_ ((void));
-extern void keys_of_window P_ ((void));
-
/* defined in frame.c */
extern Lisp_Object Qvisible;
extern void store_frame_param P_ ((struct frame *, Lisp_Object, Lisp_Object));
extern int read_process_output P_ ((Lisp_Object, int));
extern void init_process P_ ((void));
extern void syms_of_process P_ ((void));
+extern void setup_process_coding_systems P_ ((Lisp_Object));
/* defined in callproc.c */
extern Lisp_Object Vexec_path, Vexec_suffixes,
/* defined in macros.c */
extern Lisp_Object Qexecute_kbd_macro;
-EXFUN (Fexecute_kbd_macro, 2);
+EXFUN (Fexecute_kbd_macro, 3);
+EXFUN (Fcancel_kbd_macro_events, 0);
extern void init_macros P_ ((void));
extern void syms_of_macros P_ ((void));
extern void syms_of_undo P_ ((void));
/* defined in textprop.c */
-extern Lisp_Object Qmodification_hooks;
-extern Lisp_Object Qrear_nonsticky, Qfont, Qmouse_face;
+extern Lisp_Object Qfont, Qmouse_face;
extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks;
-EXFUN (Fnext_property_change, 3);
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 (Fset_text_properties, 4);
-EXFUN (Ftext_property_not_all, 5);
EXFUN (Fprevious_char_property_change, 2);
EXFUN (Fnext_char_property_change, 2);
extern void report_interval_modification P_ ((Lisp_Object, Lisp_Object));
-extern void syms_of_textprop P_ ((void));
extern Lisp_Object next_single_char_property_change P_ ((Lisp_Object,
Lisp_Object,
Lisp_Object,
Lisp_Object));
-extern Lisp_Object set_text_properties P_ ((Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object,
- Lisp_Object));
/* defined in xmenu.c */
EXFUN (Fx_popup_menu, 2);
extern void create_process P_ ((Lisp_Object, char **, Lisp_Object));
extern int tabs_safe_p P_ ((void));
extern void init_baud_rate P_ ((void));
-extern int emacs_open P_ ((char *, int, int));
+extern int emacs_open P_ ((const char *, int, int));
extern int emacs_close P_ ((int));
extern int emacs_read P_ ((int, char *, unsigned int));
-extern int emacs_write P_ ((int, char *, unsigned int));
+extern int emacs_write P_ ((int, const char *, unsigned int));
/* defined in filelock.c */
EXFUN (Funlock_buffer, 0);
/* 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_X_WINDOWS
/* 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);
#endif
/* Defined in xfaces.c */
extern void syms_of_xfns P_ ((void));
extern void init_xfns P_ ((void));
extern Lisp_Object Vx_resource_name;
+extern Lisp_Object Vx_resource_class;
EXFUN (Fxw_display_color_p, 1);
EXFUN (Fx_file_dialog, 4);
#endif /* HAVE_X_WINDOWS */
+/* Defined in xsmfns.c */
+extern void syms_of_xsmfns P_ ((void));
+
/* Defined in xselect.c */
extern void syms_of_xselect P_ ((void));
extern POINTER_TYPE *xrealloc P_ ((POINTER_TYPE *, size_t));
extern void xfree P_ ((POINTER_TYPE *));
-extern char *xstrdup P_ ((char *));
+extern char *xstrdup P_ ((const char *));
#ifndef USE_CRT_DLL
extern char *egetenv P_ ((char *));
/* Loop over Lisp list LIST. Signal an error if LIST is not a proper
list, or if it contains circles.
-
+
HARE and TORTOISE should be the names of Lisp_Object variables, and
N should be the name of an EMACS_INT variable declared in the
function where the macro is used. Each nested loop should use
/* Lisp parsing and input streams.
- Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 01, 02
+ Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 01, 2003
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"
#include "termhooks.h"
+#include "coding.h"
#ifdef lint
#include <sys/inode.h>
#include <locale.h>
#endif /* HAVE_SETLOCALE */
+#ifdef HAVE_FCNTL_H
+#include <fcntl.h>
+#endif
#ifndef O_RDONLY
#define O_RDONLY 0
#endif
Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
Lisp_Object Qinhibit_file_name_operation;
+ /* 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;
/* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
Lisp_Object Vbyte_boolean_vars;
+/* Whether or not to add a `read-positions' property to symbols
+ read. */
+Lisp_Object Vread_with_symbol_positions;
+
+/* List of (SYMBOL . POSITION) accumulated so far. */
+Lisp_Object Vread_symbol_positions_list;
+
/* List of descriptors now open for Fload. */
static Lisp_Object load_descriptor_list;
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;
+
/* This contains the last string skipped with #@. */
static char *saved_doc_string;
/* Length of buffer allocated in saved_doc_string. */
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,
+static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
Lisp_Object (*) (), int,
Lisp_Object, Lisp_Object));
static Lisp_Object load_unwind P_ ((Lisp_Object));
static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));
\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.
-
- [ 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 ]
- */
+ These macros correctly read/unread multibyte characters. */
#define READCHAR readchar (readcharfun)
#define UNREAD(c) unreadchar (readcharfun, c)
- Qlambda, or a cons, we use this to keep unread character because a
- file stream can't handle multibyte-char unreading. The value -1
+ /* 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)
Lisp_Object readcharfun;
{
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;
+ readchar_count++;
+
if (BUFFERP (readcharfun))
{
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. */
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. */
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))
{
- c = getc (instream);
- #ifdef EINTR
- /* Interrupted reads have been observed while reading over the network */
- while (c == EOF && ferror (instream) && errno == EINTR)
- {
- clearerr (instream);
- c = getc (instream);
- }
- #endif
- return c;
+ readbyte = readbyte_from_file;
+ goto read_multibyte;
}
+
if (STRINGP (readcharfun))
{
if (read_from_string_index >= read_from_string_limit)
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 || ASCII_BYTE_P (c) || load_each_byte)
+ 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.
If the stream is a user function, call it with the char as argument. */
Lisp_Object readcharfun;
int c;
{
+ readchar_count--;
if (c == -1)
/* Don't back up the pointer if we're unreading the end-of-input mark,
since readchar didn't advance it when we read it. */
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))
- ungetc (c, instream);
+ {
+ unread_char = c;
+ }
+ else if (EQ (readcharfun, Qget_file_char)
+ || EQ (readcharfun, Qget_emacs_mule_file_char))
+ {
+ if (load_each_byte)
+ ungetc (c, instream);
+ 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)
+ {
+ ungetc (c, instream);
+ return 0;
+ }
+
+ c = getc (instream);
+ #ifdef EINTR
+ /* Interrupted reads have been observed while reading over the network */
+ while (c == EOF && ferror (instream) && errno == EINTR)
+ {
+ clearerr (instream);
+ c = getc (instream);
+ }
+ #endif
+ 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);
+ }
- code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
++
+ if (read_from_string_index >= read_from_string_limit)
+ c = -1;
+ else
+ 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]];
-static Lisp_Object read0 (), read1 (), read_list (), read_vector ();
-static Lisp_Object substitute_object_recurse ();
-static void substitute_object_in_subtree (), substitute_in_interval ();
++ 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 int read_multibyte P_ ((int, Lisp_Object));
+static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
+ Lisp_Object));
+static Lisp_Object read0 P_ ((Lisp_Object));
+static Lisp_Object read1 P_ ((Lisp_Object, int *, int));
+
+static Lisp_Object read_list P_ ((int, Lisp_Object));
+static Lisp_Object read_vector P_ ((Lisp_Object, int));
+
+static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,
+ Lisp_Object));
+static void substitute_object_in_subtree P_ ((Lisp_Object,
+ Lisp_Object));
+static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));
\f
/* Get a character from the tty. */
if (display_hourglass_p)
cancel_hourglass ();
#endif
-
+
delayed_switch_frame = Qnil;
/* Read until we get an acceptable event. */
XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
}
}
-
+
/* If we don't have a character now, deal with it appropriately. */
if (!INTEGERP (val))
{
if (! NILP (delayed_switch_frame))
unread_switch_frame = delayed_switch_frame;
+#if 0
+
#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
start_hourglass ();
#endif
+
+#endif
+
return val;
}
\f
- /* Value is non-zero if the file asswociated 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
++ asswociated 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, version = 0;
+ 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;
return Vloads_in_progress = old;
}
+/* This handler function is used via internal_condition_case_1. */
+
+static Lisp_Object
+load_error_handler (data)
+ Lisp_Object data;
+{
+ return Qnil;
+}
DEFUN ("load", Fload, Sload, 1, 5, 0,
doc: /* Execute a file of Lisp code named FILE.
First try FILE with `.elc' appended, then try with `.el',
- then try FILE unmodified. Environment variable references in FILE
+ then try FILE unmodified (the exact suffixes are determined by
+`load-suffixes'). Environment variable references in FILE
are replaced with their values by calling `substitute-in-file-name'.
This function searches the directories in `load-path'.
If optional second arg NOERROR is non-nil,
register FILE *stream;
register int fd = -1;
register Lisp_Object lispstream;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object temp;
struct gcpro gcpro1;
- Lisp_Object found;
+ Lisp_Object found, efound;
/* 1 means we printed the ".el is newer" message. */
int newer = 0;
/* 1 means we are loading a compiled file. */
Lisp_Object handler;
int safe_p = 1;
char *fmode = "r";
+ int version;
+
#ifdef DOS_NT
fmode = "rt";
#endif /* DOS_NT */
everywhere, it accidentally stayed here. Since then, enough people
supposedly have things like (load "$PROJECT/foo.el") in their .emacs
that it seemed risky to remove. */
- file = Fsubstitute_in_file_name (file);
+ if (! NILP (noerror))
+ {
+ file = internal_condition_case_1 (Fsubstitute_in_file_name, file,
+ Qt, load_error_handler);
+ if (NILP (file))
+ return Qnil;
+ }
+ else
+ file = Fsubstitute_in_file_name (file);
+
/* Avoid weird lossage with null string as arg,
since it would try to load a directory as a Lisp file */
- if (XSTRING (file)->size > 0)
+ if (SCHARS (file) > 0)
{
- int size = STRING_BYTES (XSTRING (file));
+ int size = SBYTES (file);
Lisp_Object tmp[2];
GCPRO1 (file);
{
/* Don't insist on adding a suffix if FILE already ends with one. */
if (size > 3
- && !strcmp (XSTRING (file)->data + size - 3, ".el"))
+ && !strcmp (SDATA (file) + size - 3, ".el"))
must_suffix = Qnil;
else if (size > 4
- && !strcmp (XSTRING (file)->data + size - 4, ".elc"))
+ && !strcmp (SDATA (file) + size - 4, ".elc"))
must_suffix = Qnil;
/* Don't insist on adding a suffix
if the argument includes a directory name. */
: Fappend (2, (tmp[0] = Vload_suffixes,
tmp[1] = default_suffixes,
tmp))),
- &found, 0);
+ &found, Qnil);
UNGCPRO;
}
if (fd == -1)
{
if (NILP (noerror))
- while (1)
- Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"),
- Fcons (file, Qnil)));
+ Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"),
+ Fcons (file, Qnil)));
else
return Qnil;
}
Vloads_in_progress = Fcons (found, Vloads_in_progress);
}
- if (!bcmp (&(XSTRING (found)->data[STRING_BYTES (XSTRING (found)) - 4]),
+ version = -1;
- ".elc", 4))
+ if (!bcmp (SDATA (found) + SBYTES (found) - 4,
+ ".elc", 4)
+ || (version = safe_to_load_p (fd)) > 0)
/* Load .elc files directly, but not when they are
remote and have no handler! */
{
struct stat s1, s2;
int result;
- if (!safe_to_load_p (fd))
+ if (version < 0
+ && ! (version = safe_to_load_p (fd)))
{
safe_p = 0;
if (!load_dangerous_libraries)
{
- emacs_close (fd);
+ if (fd >= 0)
+ emacs_close (fd);
error ("File `%s' was not compiled in Emacs",
- XSTRING (found)->data);
+ SDATA (found));
}
else if (!NILP (nomessage))
message_with_string ("File `%s' not compiled in Emacs", found, 1);
compiled = 1;
+ GCPRO1 (efound);
+ efound = ENCODE_FILE (found);
+
#ifdef DOS_NT
fmode = "rb";
#endif /* DOS_NT */
- stat ((char *)XSTRING (found)->data, &s1);
- XSTRING (found)->data[STRING_BYTES (XSTRING (found)) - 1] = 0;
- result = stat ((char *)XSTRING (found)->data, &s2);
+ stat ((char *)SDATA (efound), &s1);
+ SSET (efound, SBYTES (efound) - 1, 0);
+ result = stat ((char *)SDATA (efound), &s2);
+ SSET (efound, SBYTES (efound) - 1, 'c');
+ UNGCPRO;
+
if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
{
/* Make the progress messages mention that source is newer. */
newer = 1;
/* If we won't print another message, mention this anyway. */
- if (! NILP (nomessage))
- message_with_string ("Source file `%s' newer than byte-compiled file",
- found, 1);
+ if (!NILP (nomessage))
+ {
+ Lisp_Object file;
+ file = Fsubstring (found, make_number (0), make_number (-1));
+ message_with_string ("Source file `%s' newer than byte-compiled file",
+ file, 1);
+ }
}
- XSTRING (found)->data[STRING_BYTES (XSTRING (found)) - 1] = 'c';
}
}
else
#ifdef WINDOWSNT
emacs_close (fd);
- stream = fopen ((char *) XSTRING (found)->data, fmode);
+ GCPRO1 (efound);
+ efound = ENCODE_FILE (found);
+ stream = fopen ((char *) SDATA (efound), fmode);
+ UNGCPRO;
#else /* not WINDOWSNT */
stream = fdopen (fd, fmode);
#endif /* not WINDOWSNT */
if (stream == 0)
{
emacs_close (fd);
- error ("Failure to create stdio stream for %s", XSTRING (file)->data);
+ error ("Failure to create stdio stream for %s", SDATA (file));
}
if (! NILP (Vpurify_flag))
load_descriptor_list
= Fcons (make_number (fileno (stream)), load_descriptor_list);
load_in_progress++;
- readevalloop (Qget_file_char, stream, file, Feval, 0, Qnil, Qnil);
+ if (! version || version >= 22)
+ readevalloop (Qget_file_char, stream, file, Feval, 0, 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, file, Feval, 0,
+ Qnil, Qnil);
+ }
unbind_to (count, Qnil);
/* Run any load-hooks for this file. */
message_with_string ("Loading %s...done", file, 1);
}
+ if (!NILP (Fequal (build_string ("obsolete"),
+ Ffile_name_nondirectory
+ (Fdirectory_file_name (Ffile_name_directory (found))))))
+ message_with_string ("Package %s is obsolete", file, 1);
+
return Qt;
}
complete_filename_p (pathname)
Lisp_Object pathname;
{
- register unsigned char *s = XSTRING (pathname)->data;
+ register const unsigned char *s = SDATA (pathname);
return (IS_DIRECTORY_SEP (s[0])
- || (XSTRING (pathname)->size > 2
+ || (SCHARS (pathname) > 2
&& IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
#ifdef ALTOS
|| *s == '@'
);
}
+DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
+ doc: /* Search for FILENAME through PATH.
+If SUFFIXES is non-nil, it should be a list of suffixes to append to
+file name when searching.
+If non-nil, PREDICATE is used instead of `file-readable-p'.
+PREDICATE can also be an integer to pass to the access(2) function,
+in which case file-name-handlers are ignored. */)
+ (filename, path, suffixes, predicate)
+ Lisp_Object filename, path, suffixes, predicate;
+{
+ Lisp_Object file;
+ int fd = openp (path, filename, suffixes, &file, predicate);
+ if (NILP (predicate) && fd > 0)
+ close (fd);
+ return file;
+}
+
+
/* Search for a file whose name is STR, looking in directories
in the Lisp list PATH, and trying suffixes from SUFFIX.
On success, returns a file descriptor. On failure, returns -1.
SUFFIXES is a list of strings containing possible suffixes.
The empty suffix is automatically added iff the list is empty.
- EXEC_ONLY nonzero means don't open the files,
- just look for one that is executable. In this case,
- returns 1 on success.
+ PREDICATE non-nil means don't open the files,
+ just look for one that satisfies the predicate. In this case,
+ returns 1 on success. The predicate can be a lisp function or
+ an integer to pass to `access' (in which case file-name-handlers
+ are ignored).
If STOREPTR is nonzero, it points to a slot where the name of
the file actually found should be stored as a Lisp string.
nil is stored there on failure.
If the file we find is remote, return -2
- but store the found remote file name in *STOREPTR.
- We do not check for remote files if EXEC_ONLY is nonzero. */
+ but store the found remote file name in *STOREPTR. */
int
-openp (path, str, suffixes, storeptr, exec_only)
+openp (path, str, suffixes, storeptr, predicate)
Lisp_Object path, str;
Lisp_Object suffixes;
Lisp_Object *storeptr;
- int exec_only;
+ Lisp_Object predicate;
{
register int fd;
int fn_size = 100;
int want_size;
Lisp_Object filename;
struct stat st;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
- Lisp_Object string, tail;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
+ Lisp_Object string, tail, encoded_fn;
int max_suffix_len = 0;
+ CHECK_STRING (str);
+
for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
{
CHECK_STRING_CAR (tail);
max_suffix_len = max (max_suffix_len,
- STRING_BYTES (XSTRING (XCAR (tail))));
+ SBYTES (XCAR (tail)));
}
string = filename = Qnil;
- GCPRO5 (str, string, filename, path, suffixes);
-
+ GCPRO6 (str, string, filename, path, suffixes, encoded_fn);
+
if (storeptr)
*storeptr = Qnil;
/* Calculate maximum size of any filename made from
this path element/specified file name and any possible suffix. */
- want_size = max_suffix_len + STRING_BYTES (XSTRING (filename)) + 1;
+ want_size = max_suffix_len + SBYTES (filename) + 1;
if (fn_size < want_size)
fn = (char *) alloca (fn_size = 100 + want_size);
for (tail = NILP (suffixes) ? default_suffixes : suffixes;
CONSP (tail); tail = XCDR (tail))
{
- int lsuffix = STRING_BYTES (XSTRING (XCAR (tail)));
+ int lsuffix = SBYTES (XCAR (tail));
Lisp_Object handler;
+ int exists;
/* Concatenate path element/specified name with the suffix.
If the directory starts with /:, remove that. */
- if (XSTRING (filename)->size > 2
- && XSTRING (filename)->data[0] == '/'
- && XSTRING (filename)->data[1] == ':')
+ if (SCHARS (filename) > 2
+ && SREF (filename, 0) == '/'
+ && SREF (filename, 1) == ':')
{
- strncpy (fn, XSTRING (filename)->data + 2,
- STRING_BYTES (XSTRING (filename)) - 2);
- fn[STRING_BYTES (XSTRING (filename)) - 2] = 0;
+ strncpy (fn, SDATA (filename) + 2,
+ SBYTES (filename) - 2);
+ fn[SBYTES (filename) - 2] = 0;
}
else
{
- strncpy (fn, XSTRING (filename)->data,
- STRING_BYTES (XSTRING (filename)));
- fn[STRING_BYTES (XSTRING (filename))] = 0;
+ strncpy (fn, SDATA (filename),
+ SBYTES (filename));
+ fn[SBYTES (filename)] = 0;
}
if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
- strncat (fn, XSTRING (XCAR (tail))->data, lsuffix);
-
+ strncat (fn, SDATA (XCAR (tail)), lsuffix);
+
/* Check that the file exists and is not a directory. */
/* We used to only check for handlers on non-absolute file names:
if (absolute)
handler = Ffind_file_name_handler (filename, Qfile_exists_p);
It's not clear why that was the case and it breaks things like
(load "/bar.el") where the file is actually "/bar.el.gz". */
- handler = Ffind_file_name_handler (filename, Qfile_exists_p);
- if (!NILP (handler) && !exec_only)
- {
- int exists;
-
- string = build_string (fn);
- exists = !NILP (Ffile_readable_p (string));
- if (exists && !NILP (Ffile_directory_p (build_string (fn))))
+ string = build_string (fn);
+ handler = Ffind_file_name_handler (string, Qfile_exists_p);
+ if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
+ {
+ if (NILP (predicate))
+ exists = !NILP (Ffile_readable_p (string));
+ else
+ exists = !NILP (call1 (predicate, string));
+ if (exists && !NILP (Ffile_directory_p (string)))
exists = 0;
if (exists)
{
/* We succeeded; return this descriptor and filename. */
if (storeptr)
- *storeptr = build_string (fn);
+ *storeptr = string;
UNGCPRO;
return -2;
}
}
else
{
- int exists = (stat (fn, &st) >= 0
- && (st.st_mode & S_IFMT) != S_IFDIR);
+ const char *pfn;
+
+ encoded_fn = ENCODE_FILE (string);
+ pfn = SDATA (encoded_fn);
+ exists = (stat (pfn, &st) >= 0
+ && (st.st_mode & S_IFMT) != S_IFDIR);
if (exists)
{
/* Check that we can access or open it. */
- if (exec_only)
- fd = (access (fn, X_OK) == 0) ? 1 : -1;
+ if (NATNUMP (predicate))
+ fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
else
- fd = emacs_open (fn, O_RDONLY, 0);
+ fd = emacs_open (pfn, O_RDONLY, 0);
if (fd >= 0)
{
/* We succeeded; return this descriptor and filename. */
if (storeptr)
- *storeptr = build_string (fn);
+ *storeptr = string;
UNGCPRO;
return fd;
}
tail = Vload_history;
prev = Qnil;
foundit = 0;
- while (!NILP (tail))
+ while (CONSP (tail))
{
- tem = Fcar (tail);
+ tem = XCAR (tail);
/* Find the feature's previous assoc list... */
if (!NILP (Fequal (source, Fcar (tem))))
/* If we're loading, remove it. */
if (loading)
- {
+ {
if (NILP (prev))
- Vload_history = Fcdr (tail);
+ Vload_history = XCDR (tail);
else
- Fsetcdr (prev, Fcdr (tail));
+ Fsetcdr (prev, XCDR (tail));
}
/* Otherwise, cons on new symbols that are not already members. */
while (CONSP (tem2))
{
- newelt = Fcar (tem2);
+ newelt = XCAR (tem2);
- if (NILP (Fmemq (newelt, tem)))
- Fsetcar (tail, Fcons (Fcar (tem),
- Fcons (newelt, Fcdr (tem))));
+ if (NILP (Fmember (newelt, tem)))
+ Fsetcar (tail, Fcons (XCAR (tem),
+ Fcons (newelt, XCDR (tem))));
- tem2 = Fcdr (tem2);
+ tem2 = XCDR (tem2);
QUIT;
}
}
}
else
prev = tail;
- tail = Fcdr (tail);
+ tail = XCDR (tail);
QUIT;
}
{
register int c;
register Lisp_Object val;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
struct gcpro gcpro1;
struct buffer *b = 0;
int continue_reading_p;
record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
load_convert_to_unibyte = !NILP (unibyte);
- readchar_backlog = -1;
-
GCPRO1 (sourcename);
LOADHIST_ATTACH (sourcename);
if (!NILP (Vpurify_flag) && c == '(')
{
- int count1 = specpdl_ptr - specpdl;
+ int count1 = SPECPDL_INDEX ();
record_unwind_protect (unreadpure, Qnil);
val = read_list (-1, readcharfun);
unbind_to (count1, Qnil);
else if (! NILP (Vload_read_function))
val = call1 (Vload_read_function, readcharfun);
else
- val = read0 (readcharfun);
+ val = read_internal_start (readcharfun, Qnil, Qnil);
}
val = (*evalfun) (val);
The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
for this invocation.
-The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that
+The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
`print' and related functions should work normally even if PRINTFLAG is nil.
This function preserves the position of point. */)
(buffer, printflag, filename, unibyte, do_allow_print)
Lisp_Object buffer, printflag, filename, unibyte, do_allow_print;
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object tem, buf;
if (NILP (buffer))
(start, end, printflag, read_function)
Lisp_Object start, end, printflag, read_function;
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object tem, cbuf;
cbuf = Fcurrent_buffer ();
(stream)
Lisp_Object stream;
{
- extern Lisp_Object Fread_minibuffer ();
-
if (NILP (stream))
stream = Vstandard_input;
if (EQ (stream, Qt))
stream = Qread_char;
-
- new_backquote_flag = 0;
- read_objects = Qnil;
-
if (EQ (stream, Qread_char))
return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
- if (STRINGP (stream) || ((CONSP (stream) && STRINGP (XCAR (stream)))))
- return Fcar (Fread_from_string (stream, Qnil, Qnil));
-
- return read0 (stream);
+ return read_internal_start (stream, Qnil, Qnil);
}
DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
(string, start, end)
Lisp_Object string, start, end;
{
- int startval, endval;
- Lisp_Object str;
- Lisp_Object tem;
+ Lisp_Object ret;
+ CHECK_STRING (string);
+ /* read_internal_start sets read_from_string_index. */
+ ret = read_internal_start (string, start, end);
+ return Fcons (ret, make_number (read_from_string_index));
+}
- if (CONSP (string))
- str = XCAR (string);
- else
- str = string;
- CHECK_STRING (str);
+/* Function to set up the global context we need in toplevel read
+ calls. */
+static Lisp_Object
+read_internal_start (stream, start, end)
+ Lisp_Object stream;
+ Lisp_Object start; /* Only used when stream is a string. */
+ Lisp_Object end; /* Only used when stream is a string. */
+{
+ Lisp_Object retval;
- readchar_backlog = -1;
- if (NILP (end))
- endval = XSTRING (str)->size;
- else
- {
- CHECK_NUMBER (end);
- endval = XINT (end);
- if (endval < 0 || endval > XSTRING (str)->size)
- args_out_of_range (str, end);
- }
+ readchar_count = 0;
+ new_backquote_flag = 0;
+ read_objects = Qnil;
+ if (EQ (Vread_with_symbol_positions, Qt)
+ || EQ (Vread_with_symbol_positions, stream))
+ Vread_symbol_positions_list = Qnil;
- if (STRINGP (stream))
- if (NILP (start))
- startval = 0;
- else
++ if (STRINGP (stream)
++ || ((CONSP (stream) && STRINGP (XCAR (stream)))))
{
- CHECK_NUMBER (start);
- startval = XINT (start);
- if (startval < 0 || startval > endval)
- args_out_of_range (str, start);
- }
+ int startval, endval;
++ Lisp_Object string;
+
- read_from_string_index = startval;
- read_from_string_index_byte = string_char_to_byte (str, startval);
- read_from_string_limit = endval;
++ if (STRINGP (stream))
++ string = stream;
++ else
++ string = XCAR (stream);
+
- new_backquote_flag = 0;
- read_objects = Qnil;
+ 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))
+ startval = 0;
+ else
+ {
+ 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;
+ }
- tem = read0 (string);
- return Fcons (tem, make_number (read_from_string_index));
+ retval = read0 (stream);
+ if (EQ (Vread_with_symbol_positions, Qt)
+ || EQ (Vread_with_symbol_positions, stream))
+ Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
+ return retval;
}
\f
/* Use this for recursive reads, in contexts where internal tokens
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. */
++ 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;
- *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':
+ if (stringp)
+ return ' ';
c = READCHAR;
- if (c != '-')
- error ("Invalid escape character syntax");
+ if (c != '-') {
+ UNREAD (c);
+ return ' ';
+ }
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)))
break;
}
}
-
- if (! ASCII_BYTE_P (i))
+
- *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;
}
default:
- if (BASE_LEADING_CODE_P (c))
- c = read_multibyte (c, readcharfun);
return c;
}
}
}
else if (c == '+')
c = READCHAR;
-
+
while (c >= 0)
{
int digit;
-
+
if (c >= '0' && c <= '9')
digit = c - '0';
else if (c >= 'a' && c <= 'z')
}
- /* 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.
int uninterned_symbol = 0;
*pch = 0;
+ load_each_byte = 0;
retry:
{
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 != VECSIZE (struct Lisp_Char_Table))
error ("Invalid size char-table");
XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));
- 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");
- XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));
- XCHAR_TABLE (tmp)->top = Qnil;
+ XSETSUB_CHAR_TABLE (tmp, XSUB_CHAR_TABLE (tmp));
return tmp;
}
Fsignal (Qinvalid_read_syntax,
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) * BITS_PER_CHAR))
+ if (STRING_MULTIBYTE (tmp)
- || (size_in_chars != XSTRING (tmp)->size
++ || (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)
- == (XSTRING (tmp)->size - 1) * BITS_PER_CHAR)))
++ == (SCHARS (tmp) - 1) * BITS_PER_CHAR)))
Fsignal (Qinvalid_read_syntax,
Fcons (make_string ("#&...", 5), Qnil));
-
+
val = Fmake_bool_vector (length, Qnil);
- bcopy (XSTRING (tmp)->data, XBOOL_VECTOR (val)->data,
+ bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
size_in_chars);
/* Clear the extraneous bits in the last byte. */
if (XINT (length) != size_in_chars * BITS_PER_CHAR)
UNGCPRO;
return tmp;
}
-
+
/* #@NUMBER is used to skip NUMBER following characters.
That's used in .elc files to skip over doc strings
and function definitions. */
{
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 == '!')
+ {
+ /* #! appears at the beginning of an executable file.
+ Skip the first line. */
+ while (c != '\n' && c >= 0)
+ c = READCHAR;
+ goto retry;
+ }
if (c == '$')
return Vload_file_name;
if (c == '\'')
/* ...and #n# will use the real value from now on. */
Fsetcdr (cell, tem);
-
+
return tem;
}
/* #n# returns a previously read object. */
}
else if (c == 'r' || c == 'R')
return read_integer (readcharfun, n);
-
+
/* Fall through to error message. */
}
else if (c == 'x' || c == 'X')
case '?':
{
- int discard;
+ int modifiers;
+ int next_char;
+ int ok;
c = READCHAR;
if (c < 0)
end_of_file_error ();
+
+ /* Accept `single space' syntax like (list ? x) where the
+ whitespace character is SPC or TAB.
+ Other literal whitespace like NL, CR, and FF are not accepted,
+ as there are well-established escape sequences for these. */
+ if (c == ' ' || c == '\t')
+ 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 == '.')
+ {
+ /* Only a dotted-pair dot is valid after a char constant. */
+ int next_next_char = READCHAR;
+ UNREAD (next_next_char);
+
+ ok = (next_next_char <= 040
+ || (next_next_char < 0200
+ && (index ("\"';([#?", next_next_char)
+ || (!first_in_list && next_next_char == '`')
+ || (new_backquote_flag && next_next_char == ','))));
+ }
+ else
+ {
+ ok = (next_char <= 040
+ || (next_char < 0200
+ && (index ("\"';()[]#?", next_char)
+ || (!first_in_list && next_char == '`')
+ || (new_backquote_flag && next_char == ','))));
+ }
+ UNREAD (next_char);
+ if (!ok)
+ Fsignal (Qinvalid_read_syntax, Fcons (make_string ("?", 1), Qnil));
+
return make_number (c);
}
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 (c < 0)
end_of_file_error ();
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
+ bytes. Hence we adjust for multibyte characters in the
+ string. ... But it doesn't seem to be necessary, because
+ READCHAR *does* read multibyte characters from buffers. */
+ /* 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 '.':
UNREAD (next_char);
if (next_char <= 040
- || index ("\"'`,(", next_char))
+ || (next_char < 0200
+ && index ("\"';([#?", next_char)
+ || (!first_in_list && next_char == '`')
+ || (new_backquote_flag && next_char == ',')))
{
*pch = c;
return Qnil;
char *end = read_buffer + read_buffer_size;
while (c > 040
- && !(c == '\"' || c == '\'' || c == ';'
- || c == '(' || c == ')'
- || c == '[' || c == ']' || c == '#'))
+ && (c >= 0200
+ || (!index ("\"';()[]#", c)
+ && !(!first_in_list && c == '`')
+ && !(new_backquote_flag && c == ','))))
{
if (end - p < MAX_MULTIBYTE_LENGTH)
{
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
-
+
if (c == '\\')
{
c = READCHAR;
quoted = 1;
}
- if (! SINGLE_BYTE_CHAR_P (c))
- p += CHAR_STRING (c, p);
- else
- *p++ = c;
-
+ p += CHAR_STRING (c, p);
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))
return make_float (negative ? - value : value);
}
}
-
- if (uninterned_symbol)
- return make_symbol (read_buffer);
- else
- return intern (read_buffer);
+ {
+ Lisp_Object result = uninterned_symbol ? make_symbol (read_buffer)
+ : intern (read_buffer);
+ if (EQ (Vread_with_symbol_positions, Qt)
+ || EQ (Vread_with_symbol_positions, readcharfun))
+ Vread_symbol_positions_list =
+ /* Kind of a hack; this will probably fail if characters
+ in the symbol name were escaped. Not really a big
+ deal, though. */
+ Fcons (Fcons (result,
+ make_number (readchar_count
+ - XFASTINT (Flength (Fsymbol_name (result))))),
+ Vread_symbol_positions_list);
+ return result;
+ }
}
}
}
/* Make all the substitutions. */
check_object
= substitute_object_recurse (object, placeholder, object);
-
+
/* Clear seen_list because we're done with it. */
seen_list = Qnil;
read_objects. */
if (!EQ (Qnil, Frassq (subtree, read_objects)))
seen_list = Fcons (subtree, seen_list);
-
+
/* Recurse according to subtree's type.
Every branch must return a Lisp_Object. */
switch (XTYPE (subtree))
{
Lisp_Object idx = make_number (i);
SUBSTITUTE (Faref (subtree, idx),
- Faset (subtree, idx, true_value));
+ Faset (subtree, idx, true_value));
}
return subtree;
}
/* Check for text properties in each interval.
substitute_in_interval contains part of the logic. */
- INTERVAL root_interval = XSTRING (subtree)->intervals;
+ INTERVAL root_interval = STRING_INTERVALS (subtree);
Lisp_Object arg = Fcons (object, placeholder);
-
+
traverse_intervals_noorder (root_interval,
&substitute_in_interval, arg);
register char *cp;
{
register int state;
-
+
char *start = cp;
state = 0;
/* Coerce string to unibyte (like string-as-unibyte,
but without generating extra garbage and
guaranteeing no change in the contents). */
- XSTRING (bytestr)->size = STRING_BYTES (XSTRING (bytestr));
- SET_STRING_BYTES (XSTRING (bytestr), -1);
+ 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);
}
return vector;
}
-
+
/* FLAG = 1 means check for ] to terminate rather than ) and .
FLAG = -1 means check for starting with defun
and make structure pure. */
struct gcpro gcpro1, gcpro2;
/* 0 is the normal case.
1 means this list is a doc reference; replace it with the number 0.
- 2 means this list is a doc reference; replace it with the doc string. */
+ 2 means this list is a doc reference; replace it with the doc string. */
int doc_reference = 0;
/* Initialize this to 1 if we are reading a list. */
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;
int oblookup_last_bucket_number;
static int hash_string ();
-Lisp_Object oblookup ();
/* Get an error if OBARRAY is not an obarray.
If it is one, return it. */
Lisp_Object
intern (str)
- char *str;
+ const char *str;
{
Lisp_Object tem;
int len = strlen (str);
CHECK_STRING (string);
- tem = oblookup (obarray, XSTRING (string)->data,
- XSTRING (string)->size,
- STRING_BYTES (XSTRING (string)));
+ tem = oblookup (obarray, SDATA (string),
+ SCHARS (string),
+ SBYTES (string));
if (!INTEGERP (tem))
return tem;
else
XSYMBOL (sym)->interned = SYMBOL_INTERNED;
- if ((XSTRING (string)->data[0] == ':')
+ if ((SREF (string, 0) == ':')
&& EQ (obarray, initial_obarray))
{
XSYMBOL (sym)->constant = 1;
(name, obarray)
Lisp_Object name, obarray;
{
- register Lisp_Object tem;
- struct Lisp_String *string;
+ register Lisp_Object tem, string;
if (NILP (obarray)) obarray = Vobarray;
obarray = check_obarray (obarray);
if (!SYMBOLP (name))
{
CHECK_STRING (name);
- string = XSTRING (name);
+ string = name;
}
else
- string = XSYMBOL (name)->name;
+ string = SYMBOL_NAME (name);
- tem = oblookup (obarray, string->data, string->size, STRING_BYTES (string));
+ tem = oblookup (obarray, SDATA (string), SCHARS (string), SBYTES (string));
if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
return Qnil;
else
obarray = check_obarray (obarray);
if (SYMBOLP (name))
- XSETSTRING (string, XSYMBOL (name)->name);
+ string = SYMBOL_NAME (name);
else
{
CHECK_STRING (name);
string = name;
}
- tem = oblookup (obarray, XSTRING (string)->data,
- XSTRING (string)->size,
- STRING_BYTES (XSTRING (string)));
+ tem = oblookup (obarray, SDATA (string),
+ SCHARS (string),
+ SBYTES (string));
if (INTEGERP (tem))
return Qnil;
/* If arg was a symbol, don't delete anything but that symbol itself. */
Lisp_Object
oblookup (obarray, ptr, size, size_byte)
Lisp_Object obarray;
- register char *ptr;
+ register const char *ptr;
int size, size_byte;
{
int hash;
else
for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
{
- if (STRING_BYTES (XSYMBOL (tail)->name) == size_byte
- && XSYMBOL (tail)->name->size == size
- && !bcmp (XSYMBOL (tail)->name->data, ptr, size_byte))
+ if (SBYTES (SYMBOL_NAME (tail)) == size_byte
+ && SCHARS (SYMBOL_NAME (tail)) == size
+ && !bcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
return tail;
else if (XSYMBOL (tail)->next == 0)
break;
static int
hash_string (ptr, len)
- unsigned char *ptr;
+ const unsigned char *ptr;
int len;
{
- register unsigned char *p = ptr;
- register unsigned char *end = p + len;
+ register const unsigned char *p = ptr;
+ register const unsigned char *end = p + len;
register unsigned char c;
register int hash = 0;
/* Intern nil in the obarray */
XSYMBOL (Qnil)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
XSYMBOL (Qnil)->constant = 1;
-
+
/* These locals are to kludge around a pyramid compiler bug. */
hash = hash_string ("nil", 3);
/* Separate statement here to avoid VAXC bug. */
void
defvar_int (namestring, address)
char *namestring;
- int *address;
+ EMACS_INT *address;
{
Lisp_Object sym, val;
sym = intern (namestring);
SET_SYMBOL_VALUE (sym, val);
PER_BUFFER_SYMBOL (offset) = sym;
PER_BUFFER_TYPE (offset) = type;
-
+
if (PER_BUFFER_IDX (offset) == 0)
/* Did a DEFVAR_PER_BUFFER without initializing the corresponding
slot of buffer_local_flags */
#endif
#ifndef WINDOWSNT
- /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
- almost never correct, thereby causing a warning to be printed out that
+ /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
+ almost never correct, thereby causing a warning to be printed out that
confuses users. Since PATH_LOADSEARCH is always overridden by the
EMACSLOADPATH environment variable below, disable the warning on NT. */
if (STRINGP (dirfile))
{
dirfile = Fdirectory_file_name (dirfile);
- if (access (XSTRING (dirfile)->data, 0) < 0)
+ if (access (SDATA (dirfile), 0) < 0)
dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
XCAR (path_tail));
}
Lisp_Object dirname;
{
char *buffer
- = (char *) alloca (XSTRING (dirname)->size + strlen (format) + 5);
+ = (char *) alloca (SCHARS (dirname) + strlen (format) + 5);
- fprintf (stderr, format, XSTRING (dirname)->data);
- sprintf (buffer, format, XSTRING (dirname)->data);
+ fprintf (stderr, format, SDATA (dirname));
+ sprintf (buffer, format, SDATA (dirname));
/* Don't log the warning before we've initialized!! */
if (initialized)
message_dolog (buffer, strlen (buffer), 0, STRING_MULTIBYTE (dirname));
defsubr (&Sread_event);
defsubr (&Sget_file_char);
defsubr (&Smapatoms);
+ defsubr (&Slocate_file_internal);
DEFVAR_LISP ("obarray", &Vobarray,
doc: /* Symbol table for use by `intern' and `read'.
See documentation of `read' for possible values. */);
Vstandard_input = Qt;
+ DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions,
+ doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
+
+If this variable is a buffer, then only forms read from that buffer
+will be added to `read-symbol-positions-list'.
+If this variable is t, then all read forms will be added.
+The effect of all other values other than nil are not currently
+defined, although they may be in the future.
+
+The positions are relative to the last call to `read' or
+`read-from-string'. It is probably a bad idea to set this variable at
+the toplevel; bind it instead. */);
+ Vread_with_symbol_positions = Qnil;
+
+ DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list,
+ doc: /* A list mapping read symbols to their positions.
+This variable is modified during calls to `read' or
+`read-from-string', but only when `read-with-symbol-positions' is
+non-nil.
+
+Each element of the list looks like (SYMBOL . CHAR-POSITION), where
+CHAR-POSITION is an integer giving the offset of that occurrence of the
+symbol from the position where `read' or `read-from-string' started.
+
+Note that a symbol will appear multiple times in this list, if it was
+read multiple times. The list is in the same order as the symbols
+were read in. */);
+ Vread_symbol_positions_list = Qnil;
+
DEFVAR_LISP ("load-path", &Vload_path,
doc: /* *List of directories to search for files to load.
Each element is a string (directory name) or nil (try default directory).
Each alist element is a list that starts with a file name,
except for one element (optional) that starts with nil and describes
definitions evaluated from buffers not visiting files.
-The remaining elements of each list are symbols defined as functions
-or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',
-and `(autoload . SYMBOL)'. */);
+The remaining elements of each list are symbols defined as functions,
+and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
+`(defvar . VARIABLE), `(autoload . SYMBOL)', and `(t . SYMBOL)'.
+An element `(t . SYMBOL)' precedes an entry that is just SYMBOL,
+and means that SYMBOL was an autoload before this file redefined it
+as a function. */);
Vload_history = Qnil;
DEFVAR_LISP ("load-file-name", &Vload_file_name,
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 (",");
staticpro (&read_objects);
read_objects = Qnil;
staticpro (&seen_list);
-
+
Vloads_in_progress = Qnil;
staticpro (&Vloads_in_progress);
}
/* Markers: examining, setting and deleting.
- Copyright (C) 1985, 1997, 1998 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1997, 1998, 2003 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. */
/* Converting between character positions and byte positions. */
/* There are several places in the buffer where we know
- the corrspondence: BEG, BEGV, PT, GPT, ZV and Z,
+ the correspondence: BEG, BEGV, PT, GPT, ZV and Z,
and everywhere there is a marker. So we find the one of these places
that is closest to the specified position, and scan from there. */
struct buffer *b;
int charpos;
{
- Lisp_Object tail;
+ struct Lisp_Marker *tail;
int best_above, best_above_byte;
int best_below, best_below_byte;
if (best_above == best_above_byte)
return charpos;
- best_below = 1;
- best_below_byte = 1;
+ best_below = BEG;
+ best_below_byte = BEG_BYTE;
/* We find in best_above and best_above_byte
the closest known point above CHARPOS,
if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
CONSIDER (cached_charpos, cached_bytepos);
- tail = BUF_MARKERS (b);
- while (! NILP (tail))
+ for (tail = BUF_MARKERS (b); tail; tail = tail->next)
{
- CONSIDER (XMARKER (tail)->charpos, XMARKER (tail)->bytepos);
+ CONSIDER (tail->charpos, tail->bytepos);
/* If we are down to a range of 50 chars,
don't bother checking any other markers;
scan the intervening chars directly now. */
if (best_above - best_below < 50)
break;
-
- tail = XMARKER (tail)->chain;
}
/* We get here if we did not exactly hit one of the known places.
}
#undef CONSIDER
+
+/* Used for debugging: recompute the bytepos corresponding to CHARPOS
+ in the simplest, most reliable way. */
+
+int
+verify_bytepos (charpos)
+{
+ int below = 1;
+ int below_byte = 1;
+
+ while (below != charpos)
+ {
+ below++;
+ BUF_INC_POS (current_buffer, below_byte);
+ }
+
+ return below_byte;
+}
\f
/* bytepos_to_charpos returns the char position corresponding to BYTEPOS. */
struct buffer *b;
int bytepos;
{
- Lisp_Object tail;
+ struct Lisp_Marker *tail;
int best_above, best_above_byte;
int best_below, best_below_byte;
if (best_above == best_above_byte)
return bytepos;
- best_below = 1;
- best_below_byte = 1;
+ best_below = BEG;
+ best_below_byte = BEG_BYTE;
CONSIDER (BUF_PT_BYTE (b), BUF_PT (b));
CONSIDER (BUF_GPT_BYTE (b), BUF_GPT (b));
if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
CONSIDER (cached_bytepos, cached_charpos);
- tail = BUF_MARKERS (b);
- while (! NILP (tail))
+ for (tail = BUF_MARKERS (b); tail; tail = tail->next)
{
- CONSIDER (XMARKER (tail)->bytepos, XMARKER (tail)->charpos);
+ CONSIDER (tail->bytepos, tail->charpos);
/* If we are down to a range of 50 chars,
don't bother checking any other markers;
scan the intervening chars directly now. */
if (best_above - best_below < 50)
break;
-
- tail = XMARKER (tail)->chain;
}
/* We get here if we did not exactly hit one of the known places.
It will last until the next GC.
But don't do it if BUF_MARKERS is nil;
that is a signal from Fset_buffer_multibyte. */
- if (record && ! NILP (BUF_MARKERS (b)))
+ if (record && BUF_MARKERS (b))
{
Lisp_Object marker, buffer;
marker = Fmake_marker ();
It will last until the next GC.
But don't do it if BUF_MARKERS is nil;
that is a signal from Fset_buffer_multibyte. */
- if (record && ! NILP (BUF_MARKERS (b)))
+ if (record && BUF_MARKERS (b))
{
Lisp_Object marker, buffer;
marker = Fmake_marker ();
register struct Lisp_Marker *m;
CHECK_MARKER (marker);
+ m = XMARKER (marker);
+
/* If position is nil or a marker that points nowhere,
make this marker point nowhere. */
if (NILP (position)
|| (MARKERP (position) && !XMARKER (position)->buffer))
{
- unchain_marker (marker);
+ unchain_marker (m);
return marker;
}
/* If buffer is dead, set marker to point nowhere. */
if (EQ (b->name, Qnil))
{
- unchain_marker (marker);
+ unchain_marker (m);
return marker;
}
}
- m = XMARKER (marker);
-
/* Optimize the special case where we are copying the position
of an existing marker, and MARKER is already in the same buffer. */
if (MARKERP (position) && b == XMARKER (position)->buffer
if (m->buffer != b)
{
- unchain_marker (marker);
+ unchain_marker (m);
m->buffer = b;
- m->chain = BUF_MARKERS (b);
- BUF_MARKERS (b) = marker;
+ m->next = BUF_MARKERS (b);
+ BUF_MARKERS (b) = m;
}
-
+
return marker;
}
/* This version of Fset_marker won't let the position
be outside the visible part. */
-Lisp_Object
+Lisp_Object
set_marker_restricted (marker, pos, buffer)
Lisp_Object marker, pos, buffer;
{
register struct Lisp_Marker *m;
CHECK_MARKER (marker);
+ m = XMARKER (marker);
+
/* If position is nil or a marker that points nowhere,
make this marker point nowhere. */
if (NILP (pos)
|| (MARKERP (pos) && !XMARKER (pos)->buffer))
{
- unchain_marker (marker);
+ unchain_marker (m);
return marker;
}
/* If buffer is dead, set marker to point nowhere. */
if (EQ (b->name, Qnil))
{
- unchain_marker (marker);
+ unchain_marker (m);
return marker;
}
}
- m = XMARKER (marker);
-
/* Optimize the special case where we are copying the position
of an existing marker, and MARKER is already in the same buffer. */
if (MARKERP (pos) && b == XMARKER (pos)->buffer
if (m->buffer != b)
{
- unchain_marker (marker);
+ unchain_marker (m);
m->buffer = b;
- m->chain = BUF_MARKERS (b);
- BUF_MARKERS (b) = marker;
+ m->next = BUF_MARKERS (b);
+ BUF_MARKERS (b) = m;
}
-
+
return marker;
}
\f
/* Set the position of MARKER, specifying both the
character position and the corresponding byte position. */
-Lisp_Object
+Lisp_Object
set_marker_both (marker, buffer, charpos, bytepos)
Lisp_Object marker, buffer;
int charpos, bytepos;
register struct Lisp_Marker *m;
CHECK_MARKER (marker);
+ m = XMARKER (marker);
if (NILP (buffer))
b = current_buffer;
/* If buffer is dead, set marker to point nowhere. */
if (EQ (b->name, Qnil))
{
- unchain_marker (marker);
+ unchain_marker (m);
return marker;
}
}
- m = XMARKER (marker);
-
/* In a single-byte buffer, the two positions must be equal. */
if (BUF_Z (b) == BUF_Z_BYTE (b)
&& charpos != bytepos)
if (m->buffer != b)
{
- unchain_marker (marker);
+ unchain_marker (m);
m->buffer = b;
- m->chain = BUF_MARKERS (b);
- BUF_MARKERS (b) = marker;
+ m->next = BUF_MARKERS (b);
+ BUF_MARKERS (b) = m;
}
-
+
return marker;
}
/* This version of set_marker_both won't let the position
be outside the visible part. */
-Lisp_Object
+Lisp_Object
set_marker_restricted_both (marker, buffer, charpos, bytepos)
Lisp_Object marker, buffer;
int charpos, bytepos;
register struct Lisp_Marker *m;
CHECK_MARKER (marker);
+ m = XMARKER (marker);
if (NILP (buffer))
b = current_buffer;
/* If buffer is dead, set marker to point nowhere. */
if (EQ (b->name, Qnil))
{
- unchain_marker (marker);
+ unchain_marker (m);
return marker;
}
}
- m = XMARKER (marker);
-
if (charpos < BUF_BEGV (b))
charpos = BUF_BEGV (b);
if (charpos > BUF_ZV (b))
if (m->buffer != b)
{
- unchain_marker (marker);
+ unchain_marker (m);
m->buffer = b;
- m->chain = BUF_MARKERS (b);
- BUF_MARKERS (b) = marker;
+ m->next = BUF_MARKERS (b);
+ BUF_MARKERS (b) = m;
}
-
+
return marker;
}
\f
void
unchain_marker (marker)
- register Lisp_Object marker;
+ register struct Lisp_Marker *marker;
{
- register Lisp_Object tail, prev, next;
- register EMACS_INT omark;
+ register struct Lisp_Marker *tail, *prev, *next;
register struct buffer *b;
- b = XMARKER (marker)->buffer;
+ b = marker->buffer;
if (b == 0)
return;
if (EQ (b->name, Qnil))
abort ();
- XMARKER (marker)->buffer = 0;
+ marker->buffer = 0;
tail = BUF_MARKERS (b);
- prev = Qnil;
- while (! GC_NILP (tail))
+ prev = NULL;
+ while (tail)
{
- next = XMARKER (tail)->chain;
- XUNMARK (next);
+ next = tail->next;
- if (XMARKER (marker) == XMARKER (tail))
+ if (marker == tail)
{
- if (NILP (prev))
+ if (!prev)
{
BUF_MARKERS (b) = next;
/* Deleting first marker from the buffer's chain. Crash
if new first marker in chain does not say it belongs
to the same buffer, or at least that they have the same
base buffer. */
- if (!NILP (next) && b->text != XMARKER (next)->buffer->text)
+ if (next && b->text != next->buffer->text)
abort ();
}
else
- {
- omark = XMARKBIT (XMARKER (prev)->chain);
- XMARKER (prev)->chain = next;
- XSETMARKBIT (XMARKER (prev)->chain, omark);
- }
+ prev->next = next;
/* We have removed the marker from the chain;
no need to scan the rest of the chain. */
return;
(position)
Lisp_Object position;
{
- register Lisp_Object tail;
+ register struct Lisp_Marker *tail;
register int charno;
charno = XINT (position);
if (charno > Z)
charno = Z;
- for (tail = BUF_MARKERS (current_buffer);
- !NILP (tail);
- tail = XMARKER (tail)->chain)
- if (XMARKER (tail)->charpos == charno)
+ for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
+ if (tail->charpos == charno)
return Qt;
return Qnil;
}
+
+/* For debugging -- count the markers in buffer BUF. */
+
+int
+count_markers (buf)
+ struct buffer *buf;
+{
+ int total = 0;
+ struct Lisp_Marker *tail;
+
+ for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
+ total++;
+
+ return total;
+}
\f
void
syms_of_marker ()
/* Minibuffer input and completion.
- Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- 2000, 2001 Free Software Foundation, Inc.
+ Copyright (C) 1985,86,93,94,95,96,97,98,99,2000,01,03
+ 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"
Lisp_Object last_minibuf_string;
-/* Nonzero means let functions called when within a minibuffer
+/* Nonzero means let functions called when within a minibuffer
invoke recursive minibuffers (to read arguments, or whatever) */
int enable_recursive_minibuffers;
Lisp_Object Qminibuffer_exit_hook, Vminibuffer_exit_hook;
/* Function to call to read a buffer name. */
-Lisp_Object Vread_buffer_function;
+Lisp_Object Vread_buffer_function;
/* Nonzero means completion ignores case. */
{
struct frame *sf = XFRAME (selected_frame);
Lisp_Object buffer;
-
+
/* I don't think that any frames may validly have a null minibuffer
window anymore. */
if (NILP (sf->minibuffer_window))
init_window_once. That window doesn't have a buffer. */
buffer = XWINDOW (minibuf_window)->buffer;
if (BUFFERP (buffer))
- Fset_window_buffer (sf->minibuffer_window, buffer);
+ Fset_window_buffer (sf->minibuffer_window, buffer, Qnil);
minibuf_window = sf->minibuffer_window;
}
struct gcpro gcpro1, gcpro2;
Lisp_Object expr_and_pos;
int pos;
-
+
GCPRO2 (val, defalt);
-
- if (STRINGP (val) && XSTRING (val)->size == 0
+
+ if (STRINGP (val) && SCHARS (val) == 0
&& STRINGP (defalt))
val = defalt;
-
+
expr_and_pos = Fread_from_string (val, Qnil, Qnil);
pos = XINT (Fcdr (expr_and_pos));
- if (pos != XSTRING (val)->size)
+ if (pos != SCHARS (val))
{
/* Ignore trailing whitespace; any other trailing junk
is an error. */
int i;
pos = string_char_to_byte (val, pos);
- for (i = pos; i < STRING_BYTES (XSTRING (val)); i++)
+ for (i = pos; i < SBYTES (val); i++)
{
- int c = XSTRING (val)->data[i];
+ int c = SREF (val, i);
if (c != ' ' && c != '\t' && c != '\n')
error ("Trailing garbage following expression");
}
}
-
+
val = Fcar (expr_and_pos);
RETURN_UNGCPRO (val);
}
char *line, *s;
Lisp_Object val;
- fprintf (stdout, "%s", XSTRING (prompt)->data);
+ fprintf (stdout, "%s", SDATA (prompt));
fflush (stdout);
val = Qnil;
if (s)
{
len = strlen (line);
-
+
if (len > 0 && line[len - 1] == '\n')
line[--len] = '\0';
-
+
val = build_string (line);
xfree (line);
}
xfree (line);
error ("Error reading from stdin");
}
-
+
/* If Lisp form desired instead of string, parse it. */
if (expflag)
val = string_to_object (val, defalt);
-
+
return val;
}
+\f
+DEFUN ("minibufferp", Fminibufferp,
+ Sminibufferp, 0, 1, 0,
+ doc: /* Return t if BUFFER is a minibuffer.
+No argument or nil as argument means use current buffer as BUFFER.*/)
+ (buffer)
+ Lisp_Object buffer;
+{
+ Lisp_Object tem;
+
+ if (NILP (buffer))
+ buffer = Fcurrent_buffer ();
+ else if (STRINGP (buffer))
+ buffer = Fget_buffer (buffer);
+ else
+ CHECK_BUFFER (buffer);
+ tem = Fmemq (buffer, Vminibuffer_list);
+ return ! NILP (tem) ? Qt : Qnil;
+}
DEFUN ("minibuffer-prompt-end", Fminibuffer_prompt_end,
Sminibuffer_prompt_end, 0, 0, 0,
()
{
/* This function is written to be most efficient when there's a prompt. */
- Lisp_Object beg = make_number (BEGV);
- Lisp_Object end = Ffield_end (beg, Qnil, Qnil);
-
+ Lisp_Object beg, end, tem;
+ beg = make_number (BEGV);
+
+ tem = Fmemq (Fcurrent_buffer (), Vminibuffer_list);
+ if (NILP (tem))
+ return beg;
+
+ end = Ffield_end (beg, Qnil, Qnil);
+
if (XINT (end) == ZV && NILP (Fget_char_property (beg, Qfield, Qnil)))
return beg;
else
return Qnil;
}
+/* Get the text in the minibuffer before point.
+ That is what completion commands operate on. */
+Lisp_Object
+minibuffer_completion_contents ()
+{
+ int prompt_end = XINT (Fminibuffer_prompt_end ());
+ if (PT < prompt_end)
+ error ("Cannot do completion in the prompt");
+ return make_buffer_string (prompt_end, PT, 1);
+}
+\f
/* Read from the minibuffer using keymap MAP, initial contents INITIAL
(a string), putting point minus BACKUP_N bytes from the end of INITIAL,
prompting with PROMPT (a string), using history list HISTVAR
match the front of that history list exactly. The value is pushed onto
the list as the string that was read.
- DEFALT specifies te default value for the sake of history commands.
+ DEFALT specifies the default value for the sake of history commands.
If ALLOW_PROPS is nonzero, we do not throw away text properties.
int inherit_input_method;
{
Lisp_Object val;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
Lisp_Object enable_multibyte;
+
+ /* String to add to the history. */
+ Lisp_Object histstring;
+
extern Lisp_Object Qfront_sticky;
extern Lisp_Object Qrear_nonsticky;
GCPRO5 (map, initial, val, ambient_dir, input_method);
if (!STRINGP (prompt))
- prompt = build_string ("");
+ prompt = empty_string;
if (!enable_recursive_minibuffers
&& minibuf_level > 0)
val = read_minibuf_noninteractive (map, initial, prompt, backup_n,
expflag, histvar, histpos, defalt,
allow_props, inherit_input_method);
+ UNGCPRO;
return unbind_to (count, val);
}
Vminibuf_scroll_window = selected_window;
if (minibuf_level == 1 || !EQ (minibuf_window, selected_window))
- Vminibuf_selected_window = selected_window;
- Fset_window_buffer (minibuf_window, Fcurrent_buffer ());
- Fselect_window (minibuf_window);
+ minibuf_selected_window = selected_window;
+ Fset_window_buffer (minibuf_window, Fcurrent_buffer (), Qnil);
+ Fselect_window (minibuf_window, Qnil);
XSETFASTINT (XWINDOW (minibuf_window)->hscroll, 0);
Fmake_local_variable (Qprint_escape_newlines);
/* Erase the buffer. */
{
- int count1 = BINDING_STACK_SIZE ();
+ int count1 = SPECPDL_INDEX ();
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
Ferase_buffer ();
Fadd_text_properties (make_number (BEG), make_number (PT),
Vminibuffer_prompt_properties, Qnil);
}
-
- minibuf_prompt_width = current_column ();
-
+
+ minibuf_prompt_width = (int) current_column (); /* iftc */
+
/* If appropriate, copy enable-multibyte-characters into the minibuffer. */
if (inherit_input_method)
current_buffer->enable_multibyte_characters = enable_multibyte;
last_minibuf_string = val;
- /* Add the value to the appropriate history list unless it is empty. */
- if (XSTRING (val)->size != 0
- && SYMBOLP (Vminibuffer_history_variable))
+ /* Choose the string to add to the history. */
+ if (SCHARS (val) != 0)
+ histstring = val;
+ else if (STRINGP (defalt))
+ histstring = defalt;
+ else
+ histstring = Qnil;
+
+ /* Add the value to the appropriate history list, if any. */
+ if (SYMBOLP (Vminibuffer_history_variable)
+ && !NILP (histstring))
{
/* If the caller wanted to save the value read on a history list,
then do so if the value is not already the front of the list. */
/* The value of the history variable must be a cons or nil. Other
values are unacceptable. We silently ignore these values. */
+
if (NILP (histval)
|| (CONSP (histval)
- && NILP (Fequal (last_minibuf_string, Fcar (histval)))))
+ /* Don't duplicate the most recent entry in the history. */
+ && NILP (Fequal (histstring, Fcar (histval)))))
{
Lisp_Object length;
- histval = Fcons (last_minibuf_string, histval);
+ histval = Fcons (histstring, histval);
Fset (Vminibuffer_history_variable, histval);
/* Truncate if requested. */
/* The appropriate frame will get selected
in set-window-configuration. */
- RETURN_UNGCPRO (unbind_to (count, val));
+ UNGCPRO;
+ return unbind_to (count, val);
}
/* Return a buffer to be used as the minibuffer at depth `depth'.
}
else
{
- int count = specpdl_ptr - specpdl;
-
+ int count = SPECPDL_INDEX ();
+ /* `reset_buffer' blindly sets the list of overlays to NULL, so we
+ have to empty the list, otherwise we end up with overlays that
+ think they belong to this buffer while the buffer doesn't know about
+ them any more. */
+ delete_all_overlays (XBUFFER (buf));
reset_buffer (XBUFFER (buf));
record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
Fset_buffer (buf);
/* Erase the minibuffer we were using at this level. */
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
/* Prevent error in erase-buffer. */
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
/* Convert to distance from end of input. */
if (XINT (position) < 1)
/* A number too small means the beginning of the string. */
- pos = - XSTRING (initial_contents)->size;
+ pos = - SCHARS (initial_contents);
else
- pos = XINT (position) - 1 - XSTRING (initial_contents)->size;
+ pos = XINT (position) - 1 - SCHARS (initial_contents);
}
}
val = Fread_from_minibuffer (prompt, initial_input, Qnil,
Qnil, history, default_value,
inherit_input_method);
- if (STRINGP (val) && XSTRING (val)->size == 0 && ! NILP (default_value))
+ if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (default_value))
val = default_value;
return val;
}
if (NILP (default_value))
default_string = Qnil;
else if (SYMBOLP (default_value))
- XSETSTRING (default_string, XSYMBOL (default_value)->name);
+ default_string = SYMBOL_NAME (default_value);
else
default_string = default_value;
-
+
name = Fcompleting_read (prompt, Vobarray, Qcommandp, Qt,
Qnil, Qnil, default_string, Qnil);
if (NILP (name))
DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 2, 0,
doc: /* Read the name of a user variable and return it as a symbol.
Prompt with PROMPT. By default, return DEFAULT-VALUE.
-A user variable is one whose documentation starts with a `*' character. */)
+A user variable is one for which `user-variable-p' returns non-nil. */)
(prompt, default_value)
Lisp_Object prompt, default_value;
{
if (NILP (default_value))
default_string = Qnil;
else if (SYMBOLP (default_value))
- XSETSTRING (default_string, XSYMBOL (default_value)->name);
+ default_string = SYMBOL_NAME (default_value);
else
default_string = default_value;
-
+
name = Fcompleting_read (prompt, Vobarray,
Quser_variable_p, Qt,
Qnil, Qnil, default_string, Qnil);
Lisp_Object prompt, def, require_match;
{
Lisp_Object args[4];
-
+
if (BUFFERP (def))
def = XBUFFER (def)->name;
DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
doc: /* Return common substring of all completions of STRING in ALIST.
-Each car of each element of ALIST is tested to see if it begins with STRING.
+Each car of each element of ALIST (or each element if it is not a cons cell)
+is tested to see if it begins with STRING.
All that match are compared together; the longest initial sequence
common to all matches is returned as a string.
If there is no match at all, nil is returned.
For a unique match which is exact, t is returned.
-ALIST can be an obarray instead of an alist.
-Then the print names of all symbols in the obarray are the possible matches.
+If ALIST is a hash-table, all the string keys are the possible matches.
+If ALIST is an obarray, the names of all symbols in the obarray
+are the possible matches.
ALIST can also be a function to do the completion itself.
It receives three arguments: the values STRING, PREDICATE and nil.
it is used to test each possible match.
The match is a candidate only if PREDICATE returns non-nil.
The argument given to PREDICATE is the alist element
-or the symbol from the obarray.
+or the symbol from the obarray. If ALIST is a hash-table,
+predicate is called with two arguments: the key and the value.
Additionally to this predicate, `completion-regexp-list'
is used to further constrain the set of candidates. */)
(string, alist, predicate)
int bestmatchsize = 0;
/* These are in bytes, too. */
int compare, matchsize;
- int list = CONSP (alist) || NILP (alist);
+ int type = HASH_TABLE_P (alist) ? 3
+ : VECTORP (alist) ? 2
+ : NILP (alist) || (CONSP (alist)
+ && (!SYMBOLP (XCAR (alist))
+ || NILP (XCAR (alist))));
int index = 0, obsize = 0;
int matchcount = 0;
Lisp_Object bucket, zero, end, tem;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
CHECK_STRING (string);
- if (!list && !VECTORP (alist))
+ if (type == 0)
return call3 (alist, string, predicate, Qnil);
bestmatch = bucket = Qnil;
/* If ALIST is not a list, set TAIL just for gc pro. */
tail = alist;
- if (! list)
+ if (type == 2)
{
- index = 0;
obsize = XVECTOR (alist)->size;
bucket = XVECTOR (alist)->contents[index];
}
while (1)
{
- /* Get the next element of the alist or obarray. */
+ /* Get the next element of the alist, obarray, or hash-table. */
/* Exit the loop if the elements are all used up. */
/* elt gets the alist element or symbol.
eltstring gets the name to check as a completion. */
- if (list)
+ if (type == 1)
{
- if (NILP (tail))
+ if (!CONSP (tail))
break;
- elt = Fcar (tail);
- eltstring = Fcar (elt);
- tail = Fcdr (tail);
+ elt = XCAR (tail);
+ eltstring = CONSP (elt) ? XCAR (elt) : elt;
+ tail = XCDR (tail);
}
- else
+ else if (type == 2)
{
if (XFASTINT (bucket) != 0)
{
continue;
}
}
+ else /* if (type == 3) */
+ {
+ while (index < HASH_TABLE_SIZE (XHASH_TABLE (alist))
+ && NILP (HASH_HASH (XHASH_TABLE (alist), index)))
+ index++;
+ if (index >= HASH_TABLE_SIZE (XHASH_TABLE (alist)))
+ break;
+ else
+ elt = eltstring = HASH_KEY (XHASH_TABLE (alist), index++);
+ }
/* Is this element a possible completion? */
if (STRINGP (eltstring)
- && XSTRING (string)->size <= XSTRING (eltstring)->size
+ && SCHARS (string) <= SCHARS (eltstring)
&& (tem = Fcompare_strings (eltstring, make_number (0),
- make_number (XSTRING (string)->size),
+ make_number (SCHARS (string)),
string, make_number (0), Qnil,
completion_ignore_case ?Qt : Qnil),
EQ (Qt, tem)))
if (!NILP (predicate))
{
if (EQ (predicate, Qcommandp))
- tem = Fcommandp (elt);
+ tem = Fcommandp (elt, Qnil);
else
{
GCPRO4 (tail, string, eltstring, bestmatch);
- tem = call1 (predicate, elt);
+ tem = type == 3
+ ? call2 (predicate, elt,
+ HASH_VALUE (XHASH_TABLE (alist), index - 1))
+ : call1 (predicate, elt);
UNGCPRO;
}
if (NILP (tem)) continue;
/* Update computation of how much all possible completions match */
- matchcount++;
if (NILP (bestmatch))
{
+ matchcount = 1;
bestmatch = eltstring;
- bestmatchsize = XSTRING (eltstring)->size;
+ bestmatchsize = SCHARS (eltstring);
}
else
{
- compare = min (bestmatchsize, XSTRING (eltstring)->size);
+ compare = min (bestmatchsize, SCHARS (eltstring));
tem = Fcompare_strings (bestmatch, make_number (0),
make_number (compare),
eltstring, make_number (0),
matchsize = XINT (tem) - 1;
if (matchsize < 0)
+ /* When can this happen ? -stef */
matchsize = compare;
if (completion_ignore_case)
{
use it as the best match rather than one that is not an
exact match. This way, we get the case pattern
of the actual match. */
- if ((matchsize == XSTRING (eltstring)->size
- && matchsize < XSTRING (bestmatch)->size)
+ if ((matchsize == SCHARS (eltstring)
+ && matchsize < SCHARS (bestmatch))
||
/* If there is more than one exact match ignoring case,
and one of them is exact including case,
/* If there is no exact match ignoring case,
prefer a match that does not change the case
of the input. */
- ((matchsize == XSTRING (eltstring)->size)
+ ((matchsize == SCHARS (eltstring))
==
- (matchsize == XSTRING (bestmatch)->size)
+ (matchsize == SCHARS (bestmatch))
&& (tem = Fcompare_strings (eltstring, make_number (0),
- make_number (XSTRING (string)->size),
+ make_number (SCHARS (string)),
string, make_number (0),
Qnil,
Qnil),
EQ (Qt, tem))
&& (tem = Fcompare_strings (bestmatch, make_number (0),
- make_number (XSTRING (string)->size),
+ make_number (SCHARS (string)),
string, make_number (0),
Qnil,
Qnil),
! EQ (Qt, tem))))
bestmatch = eltstring;
}
+ if (bestmatchsize != SCHARS (eltstring)
+ || bestmatchsize != matchsize)
+ /* Don't count the same string multiple times. */
+ matchcount++;
bestmatchsize = matchsize;
+ if (matchsize <= SCHARS (string)
+ && matchcount > 1)
+ /* No need to look any further. */
+ break;
}
}
}
/* If we are ignoring case, and there is no exact match,
and no additional text was supplied,
don't change the case of what the user typed. */
- if (completion_ignore_case && bestmatchsize == XSTRING (string)->size
- && XSTRING (bestmatch)->size > bestmatchsize)
+ if (completion_ignore_case && bestmatchsize == SCHARS (string)
+ && SCHARS (bestmatch) > bestmatchsize)
return minibuf_conform_representation (string, bestmatch);
/* Return t if the supplied string is an exact match (counting case);
it does not require any change to be made. */
- if (matchcount == 1 && bestmatchsize == XSTRING (string)->size
+ if (matchcount == 1 && bestmatchsize == SCHARS (string)
&& (tem = Fcompare_strings (bestmatch, make_number (0),
make_number (bestmatchsize),
string, make_number (0),
\f
DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
doc: /* Search for partial matches to STRING in ALIST.
-Each car of each element of ALIST is tested to see if it begins with STRING.
+Each car of each element of ALIST (or each element if it is not a cons cell)
+is tested to see if it begins with STRING.
The value is a list of all the strings from ALIST that match.
-ALIST can be an obarray instead of an alist.
-Then the print names of all symbols in the obarray are the possible matches.
+If ALIST is a hash-table, all the string keys are the possible matches.
+If ALIST is an obarray, the names of all symbols in the obarray
+are the possible matches.
ALIST can also be a function to do the completion itself.
It receives three arguments: the values STRING, PREDICATE and t.
it is used to test each possible match.
The match is a candidate only if PREDICATE returns non-nil.
The argument given to PREDICATE is the alist element
-or the symbol from the obarray.
+or the symbol from the obarray. If ALIST is a hash-table,
+predicate is called with two arguments: the key and the value.
Additionally to this predicate, `completion-regexp-list'
is used to further constrain the set of candidates.
{
Lisp_Object tail, elt, eltstring;
Lisp_Object allmatches;
- int list = CONSP (alist) || NILP (alist);
+ int type = HASH_TABLE_P (alist) ? 3
+ : VECTORP (alist) ? 2
+ : NILP (alist) || (CONSP (alist)
+ && (!SYMBOLP (XCAR (alist))
+ || NILP (XCAR (alist))));
int index = 0, obsize = 0;
Lisp_Object bucket, tem;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
CHECK_STRING (string);
- if (!list && !VECTORP (alist))
- {
- return call3 (alist, string, predicate, Qt);
- }
+ if (type == 0)
+ return call3 (alist, string, predicate, Qt);
allmatches = bucket = Qnil;
/* If ALIST is not a list, set TAIL just for gc pro. */
tail = alist;
- if (! list)
+ if (type == 2)
{
- index = 0;
obsize = XVECTOR (alist)->size;
bucket = XVECTOR (alist)->contents[index];
}
while (1)
{
- /* Get the next element of the alist or obarray. */
+ /* Get the next element of the alist, obarray, or hash-table. */
/* Exit the loop if the elements are all used up. */
/* elt gets the alist element or symbol.
eltstring gets the name to check as a completion. */
- if (list)
+ if (type == 1)
{
- if (NILP (tail))
+ if (!CONSP (tail))
break;
- elt = Fcar (tail);
- eltstring = Fcar (elt);
- tail = Fcdr (tail);
+ elt = XCAR (tail);
+ eltstring = CONSP (elt) ? XCAR (elt) : elt;
+ tail = XCDR (tail);
}
- else
+ else if (type == 2)
{
if (XFASTINT (bucket) != 0)
{
continue;
}
}
+ else /* if (type == 3) */
+ {
+ while (index < HASH_TABLE_SIZE (XHASH_TABLE (alist))
+ && NILP (HASH_HASH (XHASH_TABLE (alist), index)))
+ index++;
+ if (index >= HASH_TABLE_SIZE (XHASH_TABLE (alist)))
+ break;
+ else
+ elt = eltstring = HASH_KEY (XHASH_TABLE (alist), index++);
+ }
/* Is this element a possible completion? */
if (STRINGP (eltstring)
- && XSTRING (string)->size <= XSTRING (eltstring)->size
+ && SCHARS (string) <= SCHARS (eltstring)
/* If HIDE_SPACES, reject alternatives that start with space
unless the input starts with space. */
- && ((STRING_BYTES (XSTRING (string)) > 0
- && XSTRING (string)->data[0] == ' ')
- || XSTRING (eltstring)->data[0] != ' '
+ && ((SBYTES (string) > 0
+ && SREF (string, 0) == ' ')
+ || SREF (eltstring, 0) != ' '
|| NILP (hide_spaces))
&& (tem = Fcompare_strings (eltstring, make_number (0),
- make_number (XSTRING (string)->size),
+ make_number (SCHARS (string)),
string, make_number (0),
- make_number (XSTRING (string)->size),
+ make_number (SCHARS (string)),
completion_ignore_case ? Qt : Qnil),
EQ (Qt, tem)))
{
if (!NILP (predicate))
{
if (EQ (predicate, Qcommandp))
- tem = Fcommandp (elt);
+ tem = Fcommandp (elt, Qnil);
else
{
GCPRO4 (tail, eltstring, allmatches, string);
- tem = call1 (predicate, elt);
+ tem = type == 3
+ ? call2 (predicate, elt,
+ HASH_VALUE (XHASH_TABLE (alist), index - 1))
+ : call1 (predicate, elt);
UNGCPRO;
}
if (NILP (tem)) continue;
This feature is deprecated--it is best to pass nil for INITIAL-INPUT
and supply the default value DEF instead. The user can yank the
default value into the minibuffer easily using \\[next-history-element].
-
+
HIST, if non-nil, specifies a history list
and optionally the initial position in the list.
It can be a symbol, which is the history list variable to use,
and HISTPOS is the initial position (the position in the list
which INITIAL-INPUT corresponds to).
Positions are counted starting from 1 at the beginning of the list.
+ The variable `history-length' controls the maximum length of a
+ history list.
+
DEF, if non-nil, is the default value.
If INHERIT-INPUT-METHOD is non-nil, the minibuffer inherits
Lisp_Object val, histvar, histpos, position;
Lisp_Object init;
int pos = 0;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
struct gcpro gcpro1;
init = initial_input;
specbind (Qminibuffer_completion_table, table);
specbind (Qminibuffer_completion_predicate, predicate);
specbind (Qminibuffer_completion_confirm,
- EQ (require_match, Qt) ? Qnil : Qt);
+ EQ (require_match, Qt) ? Qnil : require_match);
last_exact_completion = Qnil;
position = Qnil;
{
CHECK_NUMBER (position);
/* Convert to distance from end of input. */
- pos = XINT (position) - XSTRING (init)->size;
+ pos = XINT (position) - SCHARS (init);
}
}
histvar, histpos, def, 0,
!NILP (inherit_input_method));
- if (STRINGP (val) && XSTRING (val)->size == 0 && ! NILP (def))
+ if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (def))
val = def;
RETURN_UNGCPRO (unbind_to (count, val));
}
\f
Lisp_Object Fminibuffer_completion_help ();
-Lisp_Object assoc_for_completion ();
+Lisp_Object Fassoc_string ();
/* Test whether TXT is an exact completion. */
-Lisp_Object
-test_completion (txt)
- Lisp_Object txt;
+DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
+ doc: /* Return non-nil if STRING is a valid completion.
+Takes the same arguments as `all-completions' and `try-completion'.
+If ALIST is a function, it is called with three arguments:
+the values STRING, PREDICATE and `lambda'. */)
+ (string, alist, predicate)
+ Lisp_Object string, alist, predicate;
{
- Lisp_Object tem;
+ Lisp_Object regexps, tem = Qnil;
+ int i = 0;
+
+ CHECK_STRING (string);
- if (CONSP (Vminibuffer_completion_table)
- || NILP (Vminibuffer_completion_table))
- return assoc_for_completion (txt, Vminibuffer_completion_table);
- else if (VECTORP (Vminibuffer_completion_table))
+ if ((CONSP (alist) && (!SYMBOLP (XCAR (alist)) || NILP (XCAR (alist))))
+ || NILP (alist))
{
- /* Bypass intern-soft as that loses for nil */
- tem = oblookup (Vminibuffer_completion_table,
- XSTRING (txt)->data,
- XSTRING (txt)->size,
- STRING_BYTES (XSTRING (txt)));
+ tem = Fassoc_string (string, alist, completion_ignore_case ? Qt : Qnil);
+ if NILP (tem)
+ return Qnil;
+ }
+ else if (VECTORP (alist))
+ {
+ /* Bypass intern-soft as that loses for nil. */
+ tem = oblookup (alist,
+ SDATA (string),
+ SCHARS (string),
+ SBYTES (string));
if (!SYMBOLP (tem))
{
- if (STRING_MULTIBYTE (txt))
- txt = Fstring_make_unibyte (txt);
+ if (STRING_MULTIBYTE (string))
+ string = Fstring_make_unibyte (string);
else
- txt = Fstring_make_multibyte (txt);
+ string = Fstring_make_multibyte (string);
tem = oblookup (Vminibuffer_completion_table,
- XSTRING (txt)->data,
- XSTRING (txt)->size,
- STRING_BYTES (XSTRING (txt)));
+ SDATA (string),
+ SCHARS (string),
+ SBYTES (string));
if (!SYMBOLP (tem))
return Qnil;
}
- if (!NILP (Vminibuffer_completion_predicate))
- return call1 (Vminibuffer_completion_predicate, tem);
+ }
+ else if (HASH_TABLE_P (alist))
+ {
+ i = hash_lookup (XHASH_TABLE (alist), string, NULL);
+ if (i >= 0)
+ tem = HASH_KEY (XHASH_TABLE (alist), i);
else
- return Qt;
+ return Qnil;
+ }
+ else
+ return call3 (alist, string, predicate, Qlambda);
+
+ /* Reject this element if it fails to match all the regexps. */
+ for (regexps = Vcompletion_regexp_list; CONSP (regexps);
+ regexps = XCDR (regexps))
+ {
+ if (NILP (Fstring_match (XCAR (regexps),
+ SYMBOLP (tem) ? string : tem,
+ Qnil)))
+ return Qnil;
}
+
+ /* Finally, check the predicate. */
+ if (!NILP (predicate))
+ return HASH_TABLE_P (alist)
+ ? call2 (predicate, tem, HASH_VALUE (XHASH_TABLE (alist), i))
+ : call1 (predicate, tem);
else
- return call3 (Vminibuffer_completion_table, txt,
- Vminibuffer_completion_predicate, Qlambda);
+ return Qt;
}
/* returns:
Lisp_Object last;
struct gcpro gcpro1, gcpro2;
- completion = Ftry_completion (Fminibuffer_contents (),
+ completion = Ftry_completion (minibuffer_completion_contents (),
Vminibuffer_completion_table,
Vminibuffer_completion_predicate);
last = last_exact_completion;
if (NILP (completion))
{
bitch_at_user ();
- temp_echo_area_glyphs (" [No match]");
+ temp_echo_area_glyphs (build_string (" [No match]"));
UNGCPRO;
return 0;
}
return 1;
}
- string = Fminibuffer_contents ();
+ string = minibuffer_completion_contents ();
/* COMPLETEDP should be true if some completion was done, which
doesn't include simply changing the case of the entered string.
if (!EQ (tem, Qt))
/* Rewrite the user's input. */
{
- Fdelete_minibuffer_contents (); /* Some completion happened */
+ int prompt_end = XINT (Fminibuffer_prompt_end ());
+ /* Some completion happened */
+
+ if (! NILP (Vminibuffer_completing_file_name)
+ && SREF (completion, SBYTES (completion) - 1) == '/'
+ && PT < ZV
+ && FETCH_CHAR (PT_BYTE) == '/')
+ {
+ del_range (prompt_end, PT + 1);
+ }
+ else
+ del_range (prompt_end, PT);
+
Finsert (1, &completion);
if (! completedp)
}
/* It did find a match. Do we match some possibility exactly now? */
- tem = test_completion (Fminibuffer_contents ());
+ tem = Ftest_completion (Fminibuffer_contents (),
+ Vminibuffer_completion_table,
+ Vminibuffer_completion_predicate);
if (NILP (tem))
{
/* not an exact match */
else if (!NILP (Vcompletion_auto_help))
Fminibuffer_completion_help ();
else
- temp_echo_area_glyphs (" [Next char not unique]");
+ temp_echo_area_glyphs (build_string (" [Next char not unique]"));
return 6;
}
else if (completedp)
last_exact_completion = completion;
if (!NILP (last))
{
- tem = Fminibuffer_contents ();
+ tem = minibuffer_completion_contents ();
if (!NILP (Fequal (tem, last)))
Fminibuffer_completion_help ();
}
/* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
-Lisp_Object
-assoc_for_completion (key, list)
+DEFUN ("assoc-string", Fassoc_string, Sassoc_string, 2, 3, 0,
+ doc: /* Like `assoc' but specifically for strings.
+Unibyte strings are converted to multibyte for comparison.
+And case is ignored if CASE-FOLD is non-nil.
+As opposed to `assoc', it will also match an entry consisting of a single
+string rather than a cons cell whose car is a string. */)
+ (key, list, case_fold)
register Lisp_Object key;
- Lisp_Object list;
+ Lisp_Object list, case_fold;
{
register Lisp_Object tail;
{
register Lisp_Object elt, tem, thiscar;
elt = Fcar (tail);
- if (!CONSP (elt)) continue;
- thiscar = Fcar (elt);
+ thiscar = CONSP (elt) ? XCAR (elt) : elt;
if (!STRINGP (thiscar))
continue;
tem = Fcompare_strings (thiscar, make_number (0), Qnil,
key, make_number (0), Qnil,
- completion_ignore_case ? Qt : Qnil);
+ case_fold);
if (EQ (tem, Qt))
return elt;
QUIT;
case 1:
if (PT != ZV)
Fgoto_char (make_number (ZV));
- temp_echo_area_glyphs (" [Sole completion]");
+ temp_echo_area_glyphs (build_string (" [Sole completion]"));
break;
case 3:
if (PT != ZV)
Fgoto_char (make_number (ZV));
- temp_echo_area_glyphs (" [Complete, but not unique]");
+ temp_echo_area_glyphs (build_string (" [Complete, but not unique]"));
break;
}
if (XINT (Fminibuffer_prompt_end ()) == ZV)
goto exit;
- if (!NILP (test_completion (Fminibuffer_contents ())))
+ if (!NILP (Ftest_completion (Fminibuffer_contents (),
+ Vminibuffer_completion_table,
+ Vminibuffer_completion_predicate)))
goto exit;
/* Call do_completion, but ignore errors. */
+ SET_PT (ZV);
val = internal_condition_case (complete_and_exit_1, Qerror,
complete_and_exit_2);
case 4:
if (!NILP (Vminibuffer_completion_confirm))
{
- temp_echo_area_glyphs (" [Confirm]");
+ temp_echo_area_glyphs (build_string (" [Confirm]"));
return Qnil;
}
else
{
Lisp_Object completion, tem, tem1;
register int i, i_byte;
- register unsigned char *completion_string;
+ register const unsigned char *completion_string;
struct gcpro gcpro1, gcpro2;
- int prompt_end_charpos;
+ int prompt_end_charpos = XINT (Fminibuffer_prompt_end ());
/* We keep calling Fbuffer_string rather than arrange for GC to
hold onto a pointer to one of the strings thus made. */
- completion = Ftry_completion (Fminibuffer_contents (),
+ completion = Ftry_completion (minibuffer_completion_contents (),
Vminibuffer_completion_table,
Vminibuffer_completion_predicate);
if (NILP (completion))
{
bitch_at_user ();
- temp_echo_area_glyphs (" [No match]");
+ temp_echo_area_glyphs (build_string (" [No match]"));
return Qnil;
}
if (EQ (completion, Qt))
#if 0 /* How the below code used to look, for reference. */
tem = Fminibuffer_contents ();
- b = XSTRING (tem)->data;
- i = ZV - 1 - XSTRING (completion)->size;
- p = XSTRING (completion)->data;
+ b = SDATA (tem);
+ i = ZV - 1 - SCHARS (completion);
+ p = SDATA (completion);
if (i > 0 ||
0 <= scmp (b, p, ZV - 1))
{
int buffer_nchars, completion_nchars;
CHECK_STRING (completion);
- tem = Fminibuffer_contents ();
+ tem = minibuffer_completion_contents ();
GCPRO2 (completion, tem);
/* If reading a file name,
expand any $ENVVAR refs in the buffer and in TEM. */
if (! EQ (substituted, tem))
{
tem = substituted;
- Fdelete_minibuffer_contents ();
- insert_from_string (tem, 0, 0, XSTRING (tem)->size,
- STRING_BYTES (XSTRING (tem)), 0);
+ del_range (prompt_end_charpos, PT);
+ Finsert (1, &tem);
}
}
- buffer_nchars = XSTRING (tem)->size; /* ie ZV - BEGV */
- completion_nchars = XSTRING (completion)->size;
+ buffer_nchars = SCHARS (tem); /* # chars in what we completed. */
+ completion_nchars = SCHARS (completion);
i = buffer_nchars - completion_nchars;
if (i > 0
||
{
int start_pos;
- /* Set buffer to longest match of buffer tail and completion head. */
+ /* Make buffer (before point) contain the longest match
+ of TEM's tail and COMPLETION's head. */
if (i <= 0) i = 1;
start_pos= i;
buffer_nchars -= i;
i++;
buffer_nchars--;
}
- del_range (1, i + 1);
- SET_PT_BOTH (ZV, ZV_BYTE);
+ del_range (start_pos, start_pos + buffer_nchars);
}
UNGCPRO;
}
#endif /* Rewritten code */
-
- prompt_end_charpos = XINT (Fminibuffer_prompt_end ());
{
int prompt_end_bytepos;
prompt_end_bytepos = CHAR_TO_BYTE (prompt_end_charpos);
- i = ZV - prompt_end_charpos;
- i_byte = ZV_BYTE - prompt_end_bytepos;
+ i = PT - prompt_end_charpos;
+ i_byte = PT_BYTE - prompt_end_bytepos;
}
/* If completion finds next char not unique,
consider adding a space or a hyphen. */
- if (i == XSTRING (completion)->size)
+ if (i == SCHARS (completion))
{
GCPRO1 (completion);
- tem = Ftry_completion (concat2 (Fminibuffer_contents (), build_string (" ")),
+ tem = Ftry_completion (concat2 (minibuffer_completion_contents (),
+ build_string (" ")),
Vminibuffer_completion_table,
Vminibuffer_completion_predicate);
UNGCPRO;
{
GCPRO1 (completion);
tem =
- Ftry_completion (concat2 (Fminibuffer_contents (), build_string ("-")),
+ Ftry_completion (concat2 (minibuffer_completion_contents (),
+ build_string ("-")),
Vminibuffer_completion_table,
Vminibuffer_completion_predicate);
UNGCPRO;
if (STRINGP (tem))
completion = tem;
}
- }
+ }
/* 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);
- 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 < STRING_BYTES (XSTRING (completion)))
++ 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. */
- if (i == ZV - prompt_end_charpos)
+ if (i == PT - prompt_end_charpos)
{
if (!NILP (Vcompletion_auto_help))
Fminibuffer_completion_help ();
/* Otherwise insert in minibuffer the chars we got */
- Fdelete_minibuffer_contents ();
+ if (! NILP (Vminibuffer_completing_file_name)
+ && SREF (completion, SBYTES (completion) - 1) == '/'
+ && PT < ZV
+ && FETCH_CHAR (PT_BYTE) == '/')
+ {
+ del_range (prompt_end_charpos, PT + 1);
+ }
+ else
+ del_range (prompt_end_charpos, PT);
+
insert_from_string (completion, 0, 0, i, i_byte, 1);
return Qt;
}
{
tem = XCAR (elt);
CHECK_STRING (tem);
- length = XSTRING (tem)->size;
+ length = SCHARS (tem);
tem = Fcar (XCDR (elt));
CHECK_STRING (tem);
- length += XSTRING (tem)->size;
+ length += SCHARS (tem);
}
else
{
CHECK_STRING (elt);
- length = XSTRING (elt)->size;
+ length = SCHARS (elt);
}
/* This does a bad job for narrower than usual windows.
if (BUFFERP (Vstandard_output))
{
tem = Findent_to (make_number (35), make_number (2));
-
+
column = XINT (tem);
}
else
Lisp_Object completions;
message ("Making completion list...");
- completions = Fall_completions (Fminibuffer_contents (),
+ completions = Fall_completions (minibuffer_completion_contents (),
Vminibuffer_completion_table,
Vminibuffer_completion_predicate,
Qt);
if (NILP (completions))
{
bitch_at_user ();
- temp_echo_area_glyphs (" [No completions]");
+ temp_echo_area_glyphs (build_string (" [No completions]"));
}
else
internal_with_output_to_temp_buffer ("*Completions*",
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 ();
}
\f
-/* Temporarily display the string M at the end of the current
+/* Temporarily display STRING at the end of the current
minibuffer contents. This is used to display things like
"[No Match]" when the user requests a completion for a prefix
that has no possible completions, and other quick, unobtrusive
messages. */
void
-temp_echo_area_glyphs (m)
- char *m;
+temp_echo_area_glyphs (string)
+ Lisp_Object string;
{
int osize = ZV;
int osize_byte = ZV_BYTE;
message (0);
SET_PT_BOTH (osize, osize_byte);
- insert_string (m);
+ insert_from_string (string, 0, 0, SCHARS (string), SBYTES (string), 0);
SET_PT_BOTH (opoint, opoint_byte);
Vinhibit_quit = Qt;
Fsit_for (make_number (2), Qnil, Qnil);
(string)
Lisp_Object string;
{
- temp_echo_area_glyphs (XSTRING (string)->data);
+ CHECK_STRING (string);
+ temp_echo_area_glyphs (string);
return Qnil;
}
\f
defsubr (&Sminibuffer_depth);
defsubr (&Sminibuffer_prompt);
+ defsubr (&Sminibufferp);
defsubr (&Sminibuffer_prompt_end);
defsubr (&Sminibuffer_contents);
defsubr (&Sminibuffer_contents_no_properties);
defsubr (&Stry_completion);
defsubr (&Sall_completions);
+ defsubr (&Stest_completion);
+ defsubr (&Sassoc_string);
defsubr (&Scompleting_read);
defsubr (&Sminibuffer_complete);
defsubr (&Sminibuffer_complete_word);
/* MS-DOS specific C utilities. -*- coding: raw-text -*-
- Copyright (C) 1993, 94, 95, 96, 97, 1999, 2000, 2001
+ Copyright (C) 1993, 94, 95, 96, 97, 1999, 2000, 01, 2003
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"
{
struct time t;
unsigned long s;
-
+
gettime (&t);
s = t.ti_min;
s *= 60;
s += t.ti_sec;
s *= 1000;
s += t.ti_hund * 10;
-
+
return s;
}
/* A flag to control how to display unibyte 8-bit characters. */
extern int unibyte_display_via_language_environment;
-Lisp_Object Qbar;
+Lisp_Object Qbar, Qhbar;
-/* The screen colors of the curent frame, which serve as the default
+/* The screen colors of the current frame, which serve as the default
colors for newly-created frames. */
static int initial_screen_colors[2];
static void
dos_direct_output (y, x, buf, len)
- int y;
- int x;
+ int x, y;
char *buf;
int len;
{
int *rows, *cols;
{
char video_name[30];
- Lisp_Object video_mode;
- int video_mode_value;
- int have_vga = 0;
union REGS regs;
+ Lisp_Object video_mode;
+ int video_mode_value, have_vga = 0;
int current_rows = ScreenRows (), current_cols = ScreenCols ();
if (*rows == current_rows && *cols == current_cols)
else
{
static struct {
- int rows;
- int need_vga;
+ int rows, need_vga;
} std_dimension[] = {
{25, 0},
{28, 1},
mouse_off_maybe ()
{
int x, y;
-
+
if (!mouse_visible)
return;
-
+
mouse_get_xy (&x, &y);
if (y != new_pos_Y || x < new_pos_X)
return;
-
+
mouse_off ();
}
static void
IT_set_cursor_type (struct frame *f, Lisp_Object cursor_type)
{
- if (EQ (cursor_type, Qbar))
+ if (EQ (cursor_type, Qbar) || EQ (cursor_type, Qhbar))
{
/* Just BAR means the normal EGA/VGA cursor. */
msdos_set_cursor_shape (f, DEFAULT_CURSOR_START, DEFAULT_CURSOR_WIDTH);
}
- else if (CONSP (cursor_type) && EQ (XCAR (cursor_type), Qbar))
+ else if (CONSP (cursor_type)
+ && (EQ (XCAR (cursor_type), Qbar)
+ || EQ (XCAR (cursor_type), Qhbar)))
{
Lisp_Object bar_parms = XCDR (cursor_type);
int width;
int conversion_buffer_size = sizeof conversion_buffer;
if (str_len <= 0) return;
-
+
screen_buf = screen_bp = alloca (str_len * 2);
screen_buf_end = screen_buf + str_len * 2;
sf = SELECTED_FRAME();
face of the frame, before writing glyphs, and let the glyphs
set the right face if it's different from the default. */
IT_set_face (DEFAULT_FACE_ID);
-
+
/* The mode bit CODING_MODE_LAST_BLOCK should be set to 1 only at
the tail. */
terminal_coding.mode &= ~CODING_MODE_LAST_BLOCK;
Mouse Highlight (and friends..)
************************************************************************/
-/* If non-nil, dos_rawgetc generates an event to display that string.
- (The display is done in keyboard.c:read_char, by calling
- show_help_echo.) */
-static Lisp_Object help_echo;
-static Lisp_Object previous_help_echo; /* a helper temporary variable */
-
-/* These record the window, the object and the position where the help
- echo string was generated. */
-static Lisp_Object help_echo_window;
-static Lisp_Object help_echo_object;
-static int help_echo_pos;
-
-/* Non-zero means automatically select any window when the mouse
- cursor moves into it. */
-int x_autoselect_window_p;
-
-/* Last window where we saw the mouse. Used by x-autoselect-window. */
+/* Last window where we saw the mouse. Used by mouse-autoselect-window. */
static Lisp_Object last_mouse_window;
static int mouse_preempted = 0; /* non-zero when XMenu gobbles mouse events */
int i;
struct face *fp;
-
+
/* If window is in the process of being destroyed, don't bother
doing anything. */
if (w->current_matrix == NULL)
row->mouse_face_p = hl > 0;
if (hl > 0)
{
- int vpos = row->y + WINDOW_DISPLAY_TOP_EDGE_PIXEL_Y (w);
- int kstart = start_hpos + WINDOW_DISPLAY_LEFT_EDGE_PIXEL_X (w);
+ int vpos = row->y + WINDOW_TOP_EDGE_Y (w);
+ int kstart = start_hpos + WINDOW_LEFT_EDGE_X (w);
int nglyphs = end_hpos - start_hpos;
int offset = ScreenPrimary + 2*(vpos*screen_size_X + kstart) + 1;
int start_offset = offset;
/* IT_write_glyphs writes at cursor position, so we need to
temporarily move cursor coordinates to the beginning of
the highlight region. */
- new_pos_X = start_hpos + WINDOW_DISPLAY_LEFT_EDGE_PIXEL_X (w);
- new_pos_Y = row->y + WINDOW_DISPLAY_TOP_EDGE_PIXEL_Y (w);
+ new_pos_X = start_hpos + WINDOW_LEFT_EDGE_X (w);
+ new_pos_Y = row->y + WINDOW_TOP_EDGE_Y (w);
if (termscript)
fprintf (termscript, "<MH- %d-%d:%d>",
}
set_cursor_shape:
-
/* Change the mouse pointer shape. */
IT_set_mouse_pointer (hl);
}
static int
fast_find_position (struct window *w, int pos, int *hpos, int *vpos)
{
- int i;
- int lastcol;
- int maybe_next_line_p = 0;
- int line_start_position;
+ int i, lastcol, line_start_position, maybe_next_line_p = 0;
int yb = window_text_bottom_y (w);
- struct glyph_row *row = MATRIX_ROW (w->current_matrix, 0);
- struct glyph_row *best_row = row;
+ struct glyph_row *row = MATRIX_ROW (w->current_matrix, 0), *best_row = row;
while (row->y < yb)
{
never-never land... */
if (row->y + 1 >= yb)
break;
-
+
++row;
}
-
+
/* Find the right column within BEST_ROW. */
lastcol = 0;
row = best_row;
row = MATRIX_MODE_LINE_ROW (w->current_matrix);
else
row = MATRIX_HEADER_LINE_ROW (w->current_matrix);
-
+
if (row->enabled_p)
{
extern Lisp_Object Qhelp_echo;
struct glyph *glyph, *end;
Lisp_Object help, map;
-
+
/* Find the glyph under X. */
- glyph = row->glyphs[TEXT_AREA]
- + x - FRAME_LEFT_SCROLL_BAR_WIDTH (f) * CANON_X_UNIT (f);
+ glyph = (row->glyphs[TEXT_AREA]
+ + x
+ /* Does MS-DOG really support scroll-bars?? ++KFS */
+ - WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (w));
end = glyph + row->used[TEXT_AREA];
if (glyph < end
&& STRINGP (glyph->object)
- && XSTRING (glyph->object)->intervals
+ && STRING_INTERVALS (glyph->object)
&& glyph->charpos >= 0
- && glyph->charpos < XSTRING (glyph->object)->size)
+ && glyph->charpos < SCHARS (glyph->object))
{
/* If we're on a string with `help-echo' text property,
arrange for the help to be displayed. This is done by
Qhelp_echo, glyph->object);
if (!NILP (help))
{
- help_echo = help;
+ help_echo_string = help;
XSETWINDOW (help_echo_window, w);
help_echo_object = glyph->object;
help_echo_pos = glyph->charpos;
IT_note_mouse_highlight (struct frame *f, int x, int y)
{
struct display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
- int portion = -1;
+ enum window_part part = ON_NOTHING;
Lisp_Object window;
struct window *w;
}
/* Which window is that in? */
- window = window_from_coordinates (f, x, y, &portion, 0);
+ window = window_from_coordinates (f, x, y, &part, &x, &y, 0);
/* If we were displaying active text in another window, clear that. */
if (! EQ (window, dpyinfo->mouse_face_window))
/* Convert to window-relative coordinates. */
w = XWINDOW (window);
- x -= WINDOW_DISPLAY_LEFT_EDGE_PIXEL_X (w);
- y -= WINDOW_DISPLAY_TOP_EDGE_PIXEL_Y (w);
- if (portion == 1 || portion == 3)
+ if (part == ON_MODE_LINE || part == ON_HEADER_LINE)
{
/* Mouse is on the mode or top line. */
- IT_note_mode_line_highlight (w, x, portion == 1);
+ IT_note_mode_line_highlight (w, x, part == ON_MODE_LINE);
return;
}
- else
- IT_set_mouse_pointer (0);
+
+ IT_set_mouse_pointer (0);
/* Are we in a window whose display is up to date?
And verify the buffer's text has not changed. */
- if (/* Within text portion of the window. */
- portion == 0
+ if (part == ON_TEXT
&& EQ (w->window_end_valid, w->buffer)
&& XFASTINT (w->last_modified) == BUF_MODIFF (XBUFFER (w->buffer))
&& (XFASTINT (w->last_overlay_modified)
== BUF_OVERLAY_MODIFF (XBUFFER (w->buffer))))
{
- int pos, i;
+ int pos, i, nrows = w->current_matrix->nrows;
struct glyph_row *row;
struct glyph *glyph;
- int nrows = w->current_matrix->nrows;
/* Find the glyph under X/Y. */
glyph = NULL;
/* Check for mouse-face and help-echo. */
{
extern Lisp_Object Qmouse_face;
- Lisp_Object mouse_face, overlay, position;
- Lisp_Object *overlay_vec;
- int len, noverlays;
+ Lisp_Object mouse_face, overlay, position, *overlay_vec;
+ int len, noverlays, obegv, ozv;;
struct buffer *obuf;
- int obegv, ozv;
/* If we get an out-of-range value, return now; avoid an error. */
if (pos > BUF_Z (XBUFFER (w->buffer)))
noverlays = overlays_at (pos,
0, &overlay_vec, &len, NULL, NULL, 0);
}
-
+
/* Sort overlays into increasing priority order. */
noverlays = sort_overlays (overlay_vec, noverlays, w);
dpyinfo->mouse_face_window = window;
dpyinfo->mouse_face_face_id
= face_at_buffer_position (w, pos, 0, 0,
- &ignore, pos + 1, 1);
+ &ignore, pos + 1,
+ !dpyinfo->mouse_face_hidden);
/* Display it as active. */
show_mouse_face (dpyinfo, 1);
dpyinfo->mouse_face_window = window;
dpyinfo->mouse_face_face_id
= face_at_buffer_position (w, pos, 0, 0,
- &ignore, pos + 1, 1);
+ &ignore, pos + 1,
+ !dpyinfo->mouse_face_hidden);
/* Display it as active. */
show_mouse_face (dpyinfo, 1);
overlay = overlay_vec[i];
help = Foverlay_get (overlay, Qhelp_echo);
}
-
+
if (!NILP (help))
{
- help_echo = help;
+ help_echo_string = help;
help_echo_window = window;
help_echo_object = overlay;
help_echo_pos = pos;
else if (NILP (help)
&& ((STRINGP (glyph->object)
&& glyph->charpos >= 0
- && glyph->charpos < XSTRING (glyph->object)->size)
+ && glyph->charpos < SCHARS (glyph->object))
|| (BUFFERP (glyph->object)
&& glyph->charpos >= BEGV
&& glyph->charpos < ZV)))
Qhelp_echo, glyph->object);
if (!NILP (help))
{
- help_echo = help;
+ help_echo_string = help;
help_echo_window = window;
help_echo_object = glyph->object;
help_echo_pos = glyph->charpos;
}
}
}
-
+
BEGV = obegv;
ZV = ozv;
current_buffer = obuf;
IT_clear_end_of_line (int first_unused)
{
char *spaces, *sp;
- int i, j;
- int offset = 2 * (new_pos_X + screen_size_X * new_pos_Y);
+ int i, j, offset = 2 * (new_pos_X + screen_size_X * new_pos_Y);
extern int fatal_error_in_progress;
if (new_pos_X >= first_unused || fatal_error_in_progress)
if (termscript)
fprintf (termscript, "<CLR:EOL[%d..%d)>", new_pos_X, first_unused);
spaces = sp = alloca (i);
-
+
while (--j >= 0)
{
*sp++ = ' ';
/* If we are in the echo area, put the cursor at the
end of the echo area message. */
if (!update_cursor_pos
- && XFASTINT (XWINDOW (FRAME_MINIBUF_WINDOW (f))->top) <= new_pos_Y)
+ && WINDOW_TOP_EDGE_LINE (XWINDOW (FRAME_MINIBUF_WINDOW (f))) <= new_pos_Y)
{
int tem_X = current_pos_X, dummy;
screen_size_X = ScreenCols ();
screen_size_Y = ScreenRows ();
screen_size = screen_size_X * screen_size_Y;
-
+
new_pos_X = new_pos_Y = 0;
current_pos_X = current_pos_Y = -1;
if (term_setup_done)
return;
term_setup_done = 1;
-
+
startup_screen_size_X = screen_size_X;
startup_screen_size_Y = screen_size_Y;
startup_screen_attrib = ScreenAttrib;
{
int display_row_start = (int) ScreenPrimary;
int saved_row_len = startup_screen_size_X * 2;
- int update_row_len = ScreenCols () * 2;
- int current_rows = ScreenRows ();
+ int update_row_len = ScreenCols () * 2, current_rows = ScreenRows ();
int to_next_row = update_row_len;
unsigned char *saved_row = startup_screen_buffer;
- int cursor_pos_X = ScreenCols () - 1;
- int cursor_pos_Y = ScreenRows () - 1;
+ int cursor_pos_X = ScreenCols () - 1, cursor_pos_Y = ScreenRows () - 1;
if (termscript)
fprintf (termscript, "\n<RESET_TERM>");
if (!term_setup_done)
return;
-
+
mouse_off ();
/* Leave the video system in the same state as we found it,
Lisp_Object alist;
{
Lisp_Object tail;
- int length = XINT (Flength (alist));
- int i, j;
+ int i, j, length = XINT (Flength (alist));
Lisp_Object *parms
= (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
Lisp_Object *values
= (Lisp_Object *) alloca (length * sizeof (Lisp_Object));
/* Do we have to reverse the foreground and background colors? */
int reverse = EQ (Fcdr (Fassq (Qreverse, f->param_alist)), Qt);
- int was_reverse = reverse;
+ int need_to_reverse, was_reverse = reverse;
int redraw = 0, fg_set = 0, bg_set = 0;
- int need_to_reverse;
- unsigned long orig_fg;
- unsigned long orig_bg;
+ unsigned long orig_fg, orig_bg;
Lisp_Object frame_bg, frame_fg;
extern Lisp_Object Qdefault, QCforeground, QCbackground;
/* Now process the alist elements in reverse of specified order. */
for (i--; i >= 0; i--)
{
- Lisp_Object prop, val;
- Lisp_Object frame;
+ Lisp_Object prop, val, frame;
prop = parms[i];
val = values[i];
{
x_set_title (f, val);
if (termscript)
- fprintf (termscript, "<TITLE: %s>\n", XSTRING (val)->data);
+ fprintf (termscript, "<TITLE: %s>\n", SDATA (val));
}
else if (EQ (prop, Qcursor_type))
{
IT_set_cursor_type (f, val);
if (termscript)
fprintf (termscript, "<CTYPE: %s>\n",
- EQ (val, Qbar) || CONSP (val) && EQ (XCAR (val), Qbar)
+ EQ (val, Qbar) || EQ (val, Qhbar)
+ || CONSP (val) && (EQ (XCAR (val), Qbar)
+ || EQ (XCAR (val), Qhbar))
? "bar" : "box");
}
store_frame_param (f, prop, val);
void
internal_terminal_init ()
{
- char *term = getenv ("TERM");
- char *colors;
+ char *term = getenv ("TERM"), *colors;
struct frame *sf = SELECTED_FRAME();
#ifdef HAVE_X_WINDOWS
if (getenv ("EMACSTEST"))
termscript = fopen (getenv ("EMACSTEST"), "wt");
-
+
#ifndef HAVE_X_WINDOWS
if (!internal_terminal || inhibit_window_system)
{
if (colors[1] >= 0 && colors[1] < 16)
the_only_x_display.background_pixel = colors[1];
}
- the_only_x_display.line_height = 1;
the_only_x_display.font = (XFontStruct *)1; /* must *not* be zero */
the_only_x_display.display_info.mouse_face_mouse_frame = NULL;
the_only_x_display.display_info.mouse_face_deferred_gc = 0;
return *screen != (char *)0;
#else
return 0;
-#endif
+#endif
}
#ifndef HAVE_X_WINDOWS
keyboard = keyboard_layout_list[0].keyboard_map;
keyboard_map_all = always;
dos_keyboard_layout = 1;
-
+
for (i = 0; i < (sizeof (keyboard_layout_list)/sizeof (struct keyboard_layout_list)); i++)
if (code == keyboard_layout_list[i].country_code)
{
Map | 23, /* 'o' */
Map | 24, /* 'p' */
Map | 25, /* '[' */
- Map | 26, /* ']' */
+ Map | 26, /* ']' */
ModFct | 0x0d, /* Return */
Ignore, /* Ctrl */
Map | 30, /* 'a' */
int *keymask;
{
union REGS regs;
- int mask;
- int modifiers = 0;
-
+ int mask, modifiers = 0;
+
/* Calculate modifier bits */
regs.h.ah = extended_kbd ? 0x12 : 0x02;
int86 (0x16, ®s, ®s);
if (!extended_kbd)
{
- mask = regs.h.al & (SHIFT_P | CTRL_P | ALT_P |
+ mask = regs.h.al & (SHIFT_P | CTRL_P | ALT_P |
SCRLOCK_P | NUMLOCK_P | CAPSLOCK_P);
}
else
{
mask = regs.h.al & (SHIFT_P |
SCRLOCK_P | NUMLOCK_P | CAPSLOCK_P);
-
+
/* Do not break international keyboard support. */
/* When Keyb.Com is loaded, the right Alt key is */
/* used for accessing characters like { and } */
mask |= ALT_P;
}
}
-
+
if (regs.h.ah & 1) /* Left CTRL pressed ? */
mask |= CTRL_P;
and then the scan code. */)
()
{
- Lisp_Object *keys = XVECTOR (recent_doskeys)->contents;
- Lisp_Object val;
+ Lisp_Object val, *keys = XVECTOR (recent_doskeys)->contents;
if (total_doskeys < NUM_RECENT_DOSKEYS)
return Fvector (total_doskeys, keys);
struct input_event event;
union REGS regs;
struct display_info *dpyinfo = FRAME_X_DISPLAY_INFO (SELECTED_FRAME());
+ EVENT_INIT (event);
#ifndef HAVE_X_WINDOWS
/* Maybe put the cursor where it should be. */
{
union REGS regs;
register unsigned char c;
- int sc, code = -1, mask, kp_mode;
- int modifiers;
+ int modifiers, sc, code = -1, mask, kp_mode;
regs.h.ah = extended_kbd ? 0x10 : 0x00;
int86 (0x16, ®s, ®s);
recent_doskeys_index = 0;
modifiers = dos_get_modifiers (&mask);
-
+
#ifndef HAVE_X_WINDOWS
if (!NILP (Vdos_display_scancodes))
{
continue;
}
}
-
+
if (c == 0)
{
/* We only look at the keyboard Ctrl/Shift/Alt keys when
if (code & Shift)
modifiers |= shift_modifier;
}
-
+
switch (code & 0xf000)
{
case ModFct:
if (c && !(mask & (SHIFT_P | ALT_P | CTRL_P | HYPER_P | SUPER_P)))
return c;
c = 0; /* Special */
-
+
case FctKey:
if (c != 0)
return c;
-
+
case Special:
code |= 0xff00;
break;
-
+
case Normal:
if (sc == 0)
{
code = c;
break;
}
-
+
case Map:
if (c && !(mask & ALT_P) && !((mask & SHIFT_P) && (mask & CTRL_P)))
if (!keyboard_map_all)
code &= 0xff;
if (mask & ALT_P && code <= 10 && code > 0 && dos_keypad_mode & 0x200)
mask |= SHIFT_P; /* ALT-1 => M-! etc. */
-
+
if (mask & SHIFT_P)
{
code = keyboard->shifted[code];
kp_mode = dos_keypad_mode & 0x03;
else
kp_mode = (dos_keypad_mode >> 4) & 0x03;
-
+
switch (kp_mode)
{
case 0:
code = keypad_translate_map[code].meta_code;
modifiers = meta_modifier;
break;
-
+
case 3:
code = 0xff00 | keypad_translate_map[code].editkey_code;
break;
}
break;
-
+
case Grey:
code &= 0xff;
kp_mode = ((mask & (NUMLOCK_P|CTRL_P|SHIFT_P|ALT_P)) == NUMLOCK_P) ? 0x04 : 0x40;
code = grey_key_translate_map[code].char_code;
break;
}
-
+
make_event:
if (code == 0)
continue;
}
if (code >= 0x100)
- event.kind = non_ascii_keystroke;
+ event.kind = NON_ASCII_KEYSTROKE_EVENT;
else
- event.kind = ascii_keystroke;
+ event.kind = ASCII_KEYSTROKE_EVENT;
event.code = code;
event.modifiers = modifiers;
event.frame_or_window = selected_frame;
{
int but, press, x, y, ok;
int mouse_prev_x = mouse_last_x, mouse_prev_y = mouse_last_y;
+ Lisp_Object mouse_window = Qnil;
/* Check for mouse movement *before* buttons. */
mouse_check_moved ();
clear_mouse_face (dpyinfo);
}
- if (x_autoselect_window_p)
+ /* Generate SELECT_WINDOW_EVENTs when needed. */
+ if (mouse_autoselect_window)
{
- int mouse_area;
- Lisp_Object mouse_window;
-
mouse_window = window_from_coordinates (SELECTED_FRAME(),
mouse_last_x,
mouse_last_y,
- &mouse_area, 0);
+ 0, 0, 0, 0);
/* A window will be selected only when it is not
- selected now. A minubuffer window will be selected
- iff it is active. */
- if (!EQ (mouse_window, last_mouse_window)
- && !EQ (mouse_window, selected_window)
- && (!MINI_WINDOW_P (XWINDOW (mouse_window))
- || (EQ (mouse_window, minibuf_window)
- && minibuf_level > 0)))
+ selected now, and the last mouse movement event was
+ not in it. A minibuffer window will be selected iff
+ it is active. */
+ if (WINDOWP (mouse_window)
+ && !EQ (mouse_window, last_mouse_window)
+ && !EQ (mouse_window, selected_window))
{
- Fselect_window (mouse_window);
+ event.kind = SELECT_WINDOW_EVENT;
+ event.frame_or_window = mouse_window;
+ event.arg = Qnil;
+ event.timestamp = event_timestamp ();
+ kbd_buffer_store_event (&event);
}
last_mouse_window = mouse_window;
}
else
last_mouse_window = Qnil;
- previous_help_echo = help_echo;
- help_echo = help_echo_object = help_echo_window = Qnil;
+ previous_help_echo_string = help_echo_string;
+ help_echo_string = help_echo_object = help_echo_window = Qnil;
help_echo_pos = -1;
IT_note_mouse_highlight (SELECTED_FRAME(),
mouse_last_x, mouse_last_y);
/* If the contents of the global variable help_echo has
changed, generate a HELP_EVENT. */
- if (!NILP (help_echo) || !NILP (previous_help_echo))
+ if (!NILP (help_echo_string) || !NILP (previous_help_echo_string))
{
- /* HELP_EVENT takes 2 events in the event loop. */
event.kind = HELP_EVENT;
event.frame_or_window = selected_frame;
event.arg = help_echo_object;
- event.x = make_number (help_echo_pos);
+ event.x = WINDOWP (help_echo_window)
+ ? help_echo_window : selected_frame;
+ event.y = help_echo_string;
event.timestamp = event_timestamp ();
- event.code = 0;
- kbd_buffer_store_event (&event);
- if (WINDOWP (help_echo_window))
- event.frame_or_window = help_echo_window;
- event.arg = help_echo;
- event.code = 1;
+ event.code = help_echo_pos;
kbd_buffer_store_event (&event);
}
}
}
}
- event.kind = mouse_click;
+ event.kind = MOUSE_CLICK_EVENT;
event.code = button_num;
event.modifiers = dos_get_modifiers (0)
| (press ? down_modifier : up_modifier);
}
\f
#ifndef HAVE_X_WINDOWS
-/* See xterm.c for more info. */
-void
-pixel_to_glyph_coords (f, pix_x, pix_y, x, y, bounds, noclip)
- FRAME_PTR f;
- register int pix_x, pix_y;
- register int *x, *y;
- XRectangle *bounds;
- int noclip;
-{
- if (bounds) abort ();
-
- /* Ignore clipping. */
-
- *x = pix_x;
- *y = pix_y;
-}
-void
-glyph_to_pixel_coords (f, x, y, pix_x, pix_y)
- FRAME_PTR f;
- register int x, y;
- register int *pix_x, *pix_y;
-{
- *pix_x = x;
- *pix_y = y;
-}
-\f
/* Simulation of X's menus. Nothing too fancy here -- just make it work
for now.
static void
IT_menu_display (XMenu *menu, int y, int x, int pn, int *faces, int disp_help)
{
- int i, j, face, width;
+ int i, j, face, width, mx, my, enabled, mousehere, row, col;
struct glyph *text, *p;
char *q;
- int mx, my;
- int enabled, mousehere;
- int row, col;
struct frame *sf = SELECTED_FRAME();
menu_help_message = NULL;
/* Report availability of menus. */
int
-have_menus_p ()
-{
- return 1;
-}
+have_menus_p () { return 1; }
/* Create a brand new menu structure. */
void (*help_callback)(char *, int, int))
{
struct IT_menu_state *state;
- int statecount;
- int x, y, i, b;
- int screensize;
- int faces[4];
- Lisp_Object selectface;
- int leave, result, onepane;
+ int statecount, x, y, i, b, screensize, leave, result, onepane;
int title_faces[4]; /* face to display the menu title */
- int buffers_num_deleted = 0;
+ int faces[4], buffers_num_deleted = 0;
struct frame *sf = SELECTED_FRAME();
- Lisp_Object saved_echo_area_message;
+ Lisp_Object saved_echo_area_message, selectface;
/* Just in case we got here without a mouse present... */
if (have_mouse <= 0)
screensize = screen_size * 2;
faces[0]
= lookup_derived_face (sf, intern ("msdos-menu-passive-face"),
- 0, DEFAULT_FACE_ID);
+ DEFAULT_FACE_ID);
faces[1]
= lookup_derived_face (sf, intern ("msdos-menu-active-face"),
- 0, DEFAULT_FACE_ID);
+ DEFAULT_FACE_ID);
selectface = intern ("msdos-menu-select-face");
faces[2] = lookup_derived_face (sf, selectface,
- 0, faces[0]);
+ faces[0]);
faces[3] = lookup_derived_face (sf, selectface,
- 0, faces[1]);
+ faces[1]);
/* Make sure the menu title is always displayed with
`msdos-menu-active-face', no matter where the mouse pointer is. */
/* Don't let the title for the "Buffers" popup menu include a
digit (which is ugly).
-
+
This is a terrible kludge, but I think the "Buffers" case is
the only one where the title includes a number, so it doesn't
seem to be necessary to make this more general. */
state[statecount].x
= state[i].x + state[i].menu->width + 2;
state[statecount].y = y;
- statecount++;
+ statecount++;
}
}
}
int
x_pixel_width (struct frame *f)
{
- return FRAME_WIDTH (f);
+ return FRAME_COLS (f);
}
int
x_pixel_height (struct frame *f)
{
- return FRAME_HEIGHT (f);
+ return FRAME_LINES (f);
}
#endif /* !HAVE_X_WINDOWS */
\f
int drive;
char *dst;
{
- char in_path[4], *p = in_path;
- int e = errno;
+ char in_path[4], *p = in_path, e = errno;;
/* Generate "X:." (when drive is X) or "." (when drive is 0). */
if (drive != 0)
register int n;
register unsigned char *buf;
{
- unsigned char *np = buf;
- unsigned char *startp = buf;
- unsigned char *endp = buf + n;
+ unsigned char *np = buf, *startp = buf, *endp = buf + n;
if (n == 0)
return n;
used when you compile with DJGPP v2.0. */
#include <io.h>
-
+
int _rename(const char *old, const char *new)
{
__dpmi_regs r;
return Qnil;
tem = Fcopy_sequence (filename);
- msdos_downcase_filename (XSTRING (tem)->data);
+ msdos_downcase_filename (SDATA (tem));
return tem;
}
\f
int skip_args;
{
char *s, *t, *root;
- int len;
+ int len, i;
static const char * const tempdirs[] = {
"$TMPDIR", "$TEMP", "$TMP", "c:/"
};
- int i;
const int imax = sizeof (tempdirs) / sizeof (tempdirs[0]);
/* Make sure they have a usable $TMPDIR. Many Emacs functions use
{
union REGS inregs, outregs;
static int first_time = 1;
-
+
break_stat = getcbrk ();
setcbrk (0);
#if __DJGPP__ < 2
inregs.h.ah = 0xc0;
int86 (0x15, &inregs, &outregs);
extended_kbd = (!outregs.x.cflag) && (outregs.h.ah == 0);
-
+
have_mouse = 0;
if (internal_terminal
{
char *saveargv1, *saveargv2, *lowcase_argv0, *pa, *pl;
char oldwd[MAXPATHLEN + 1]; /* Fixed size is safe on MSDOS. */
- int msshell, result = -1;
- int inbak, outbak, errbak;
- int x, y;
+ int msshell, result = -1, inbak, outbak, errbak, x, y;
Lisp_Object cmd;
/* Get current directory as MSDOS cwd is not per-process. */
mouse_get_xy (&x, &y);
dos_ttcooked (); /* do it here while 0 = stdin */
-
+
dup2 (tempin, 0);
dup2 (tempout, 1);
dup2 (temperr, 2);
#endif /* __DJGPP__ > 1 */
result = spawnve (P_WAIT, argv[0], argv, envv);
-
+
dup2 (inbak, 0);
dup2 (outbak, 1);
dup2 (errbak, 2);
text attribute byte, so we get blinking characters instead of the
bright background colors. Restore that. */
bright_bg ();
-
+
done:
chdir (oldwd);
if (msshell)
return result;
}
+void
croak (badfunc)
char *badfunc;
{
/* When time zones are set from Ms-Dos too many C-libraries are playing
tricks with time values. We solve this by defining our own version
of `gettimeofday' bypassing GO32. Our version needs to be initialized
- once and after each call to `tzset' with TZ changed. That is
+ once and after each call to `tzset' with TZ changed. That is
accomplished by aliasing tzset to init_gettimeofday. */
static struct tm time_rec;
{
struct time t;
struct tm tm;
-
+
gettime (&t);
if (t.ti_hour < time_rec.tm_hour) /* midnight wrap */
{
time_rec.tm_mon = d.da_mon - 1;
time_rec.tm_mday = d.da_day;
}
-
+
time_rec.tm_hour = t.ti_hour;
time_rec.tm_min = t.ti_min;
time_rec.tm_sec = t.ti_sec;
tm = time_rec;
tm.tm_gmtoff = dos_timezone_offset;
-
+
tp->tv_sec = mktime (&tm); /* may modify tm */
tp->tv_usec = t.ti_hund * (1000000 / 100);
}
nice (p) int p; {}
void volatile pause () {}
sigsetmask (x) int x; { return 0; }
-sigblock (mask) int mask; { return 0; }
+sigblock (mask) int mask; { return 0; }
#endif
void request_sigio (void) {}
void unrequest_sigio (void) {}
#if __DJGPP__ > 1
+#if __DJGPP_MINOR__ < 2
#ifdef POSIX_SIGNALS
typedef void (*sighandler_t)(int);
static sighandler_t prev_handlers[320];
-/* A signal handler which just records that a signal occured
+/* A signal handler which just records that a signal occurred
(it will be raised later, if and when the signal is unblocked). */
static void
sig_suspender (signo)
#else /* not POSIX_SIGNALS */
sigsetmask (x) int x; { return 0; }
-sigblock (mask) int mask; { return 0; }
+sigblock (mask) int mask; { return 0; }
#endif /* not POSIX_SIGNALS */
+#endif /* not __DJGPP_MINOR__ < 2 */
#endif /* __DJGPP__ > 1 */
#ifndef HAVE_SELECT
if (nfds != 1)
abort ();
-
+
/* If we are looking only for the terminal, with no timeout,
just read it and wait -- that's more efficient. */
if (!timeout)
dos_yield_time_slice ();
}
}
-
+
FD_SET (0, rfds);
return 1;
}
tmp += 2; /* strip drive: KFS 1995-07-06 */
len -= 2;
}
-
+
if (len > 1 && (tmp[len - 1] == '/'))
{
char *tmp1 = (char *) alloca (len + 1);
{
char buffer1[200], buffer2[400];
int i, j;
-
+
sprintf (buffer1, "<EMACS FATAL ERROR IN %s LINE %d>", file, line);
for (i = j = 0; buffer1[i]; i++) {
buffer2[j++] = buffer1[i];
{
recent_doskeys = Fmake_vector (make_number (NUM_RECENT_DOSKEYS), Qnil);
staticpro (&recent_doskeys);
+
#ifndef HAVE_X_WINDOWS
- help_echo = Qnil;
- staticpro (&help_echo);
- help_echo_object = Qnil;
- staticpro (&help_echo_object);
- help_echo_window = Qnil;
- staticpro (&help_echo_window);
- previous_help_echo = Qnil;
- staticpro (&previous_help_echo);
- help_echo_pos = -1;
/* The following two are from xfns.c: */
Qbar = intern ("bar");
staticpro (&Qbar);
+ Qhbar = intern ("hbar");
+ staticpro (&Qhbar);
Qcursor_type = intern ("cursor-type");
staticpro (&Qcursor_type);
Qreverse = intern ("reverse");
This variable is used only by MSDOS terminals. */);
Vdos_unsupported_char_glyph = '\177';
- DEFVAR_BOOL ("x-autoselect-window", &x_autoselect_window_p,
- doc: /* *Non-nil means autoselect window with mouse pointer. */);
- x_autoselect_window_p = 0;
#endif
#ifndef subprocesses
DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
}
#endif /* MSDOS */
-
/* Lisp object printing and output streams.
- Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 01, 2002
+ Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 01, 2003
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <stdio.h>
#include "lisp.h"
#include "buffer.h"
- #include "charset.h"
+ #include "character.h"
#include "keyboard.h"
#include "frame.h"
#include "window.h"
/* Avoid actual stack overflow in print. */
int print_depth;
+/* Nonzero if inside outputting backquote in old style. */
+int old_backquote_output;
+
/* Detect most circularities to print finite output. */
#define PRINT_CIRCLE 200
Lisp_Object being_printed[PRINT_CIRCLE];
and must start with PRINTPREPARE, end with PRINTFINISH,
and use PRINTDECLARE to declare common variables.
Use PRINTCHAR to output one character,
- or call strout to output a block of characters. */
+ or call strout to output a block of characters. */
#define PRINTDECLARE \
struct buffer *old = current_buffer; \
int old_point = -1, start_point = -1; \
int old_point_byte = -1, start_point_byte = -1; \
- int specpdl_count = specpdl_ptr - specpdl; \
+ int specpdl_count = SPECPDL_INDEX (); \
int free_print_buffer = 0; \
int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
Lisp_Object original
print_unwind (saved_text)
Lisp_Object saved_text;
{
- bcopy (XSTRING (saved_text)->data, print_buffer, XSTRING (saved_text)->size);
+ bcopy (SDATA (saved_text), print_buffer, SCHARS (saved_text));
return Qnil;
}
int len = CHAR_STRING (ch, str);
QUIT;
-
+
if (NILP (fun))
{
if (print_buffer_pos_byte + len >= print_buffer_size)
{
int multibyte_p
= !NILP (current_buffer->enable_multibyte_characters);
-
+
setup_echo_area_for_printing (multibyte_p);
insert_char (ch);
message_dolog (str, len, 0, multibyte_p);
int i;
int multibyte_p
= !NILP (current_buffer->enable_multibyte_characters);
-
+
setup_echo_area_for_printing (multibyte_p);
message_dolog (ptr, size_byte, 0, multibyte_p);
-
+
if (size == size_byte)
{
for (i = 0; i < size; ++i)
insert_char (ch);
}
}
-
+
#ifdef MAX_PRINT_CHARS
if (max_print)
print_chars += size;
{
int chars;
+ if (print_escape_nonascii)
+ string = string_escape_byte8 (string);
+
if (STRING_MULTIBYTE (string))
- chars = XSTRING (string)->size;
+ 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
Lisp_Object newstr;
int bytes;
- chars = STRING_BYTES (XSTRING (string));
- bytes = parse_str_to_multibyte (XSTRING (string)->data, chars);
+ chars = SBYTES (string);
+ bytes = parse_str_to_multibyte (SDATA (string), chars);
if (chars < bytes)
{
newstr = make_uninit_multibyte_string (chars, bytes);
- bcopy (XSTRING (string)->data, XSTRING (newstr)->data, chars);
- str_to_multibyte (XSTRING (newstr)->data, bytes, chars);
+ bcopy (SDATA (string), SDATA (newstr), chars);
+ str_to_multibyte (SDATA (newstr), bytes, chars);
string = newstr;
}
}
else
- chars = STRING_BYTES (XSTRING (string));
+ chars = SBYTES (string);
/* strout is safe for output to a frame (echo area) or to print_buffer. */
- strout (XSTRING (string)->data,
- chars, STRING_BYTES (XSTRING (string)),
+ strout (SDATA (string),
+ chars, SBYTES (string),
printcharfun, STRING_MULTIBYTE (string));
}
else
/* Otherwise, string may be relocated by printing one char.
So re-fetch the string address for each character. */
int i;
- int size = XSTRING (string)->size;
- int size_byte = STRING_BYTES (XSTRING (string));
+ int size = SCHARS (string);
+ int size_byte = SBYTES (string);
struct gcpro gcpro1;
GCPRO1 (string);
if (size == size_byte)
for (i = 0; i < size; i++)
- PRINTCHAR (XSTRING (string)->data[i]);
+ PRINTCHAR (SREF (string, i));
else
for (i = 0; i < size_byte; i++)
{
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to PRINTCHAR. */
int len;
- int ch = STRING_CHAR_AND_LENGTH (XSTRING (string)->data + i,
+ 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;
}
void
temp_output_buffer_setup (bufname)
- char *bufname;
+ const char *bufname;
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
register struct buffer *old = current_buffer;
register Lisp_Object buf;
Fset_buffer (Fget_buffer_create (build_string (bufname)));
+ Fkill_all_local_variables ();
+ delete_all_overlays (current_buffer);
current_buffer->directory = old->directory;
current_buffer->read_only = Qnil;
current_buffer->filename = Qnil;
current_buffer->undo_list = Qt;
- current_buffer->overlays_before = Qnil;
- current_buffer->overlays_after = Qnil;
+ eassert (current_buffer->overlays_before == NULL);
+ eassert (current_buffer->overlays_after == NULL);
current_buffer->enable_multibyte_characters
= buffer_defaults.enable_multibyte_characters;
Ferase_buffer ();
Lisp_Object
internal_with_output_to_temp_buffer (bufname, function, args)
- char *bufname;
+ const char *bufname;
Lisp_Object (*function) P_ ((Lisp_Object));
Lisp_Object args;
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object buf, val;
struct gcpro gcpro1;
If variable `temp-buffer-show-function' is non-nil, call it at the end
to get the buffer displayed instead of just displaying the non-selected
-buffer and calling the hook. It gets one argument, the buffer to display.
+buffer and calling the hook. It gets one argument, the buffer to display.
usage: (with-output-to-temp-buffer BUFFNAME BODY ...) */)
(args)
{
struct gcpro gcpro1;
Lisp_Object name;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object buf, val;
GCPRO1(args);
name = Feval (Fcar (args));
CHECK_STRING (name);
- temp_output_buffer_setup (XSTRING (name)->data);
+ temp_output_buffer_setup (SDATA (name));
buf = Vstandard_output;
UNGCPRO;
{
PRINTDECLARE;
Lisp_Object printcharfun;
- struct gcpro gcpro1, gcpro2;
- Lisp_Object tem;
+ /* struct gcpro gcpro1, gcpro2; */
+ Lisp_Object save_deactivate_mark;
+ int count = specpdl_ptr - specpdl;
+
+ specbind (Qinhibit_modification_hooks, Qt);
/* Save and restore this--we are altering a buffer
but we don't want to deactivate the mark just for that.
No need for specbind, since errors deactivate the mark. */
- tem = Vdeactivate_mark;
- GCPRO2 (object, tem);
+ save_deactivate_mark = Vdeactivate_mark;
+ /* GCPRO2 (object, save_deactivate_mark); */
+ abort_on_gc++;
printcharfun = Vprin1_to_string_buffer;
PRINTPREPARE;
PRINTFINISH;
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
object = Fbuffer_string ();
+ if (SBYTES (object) == SCHARS (object))
+ STRING_SET_UNIBYTE (object);
Ferase_buffer ();
set_buffer_internal (old);
- Vdeactivate_mark = tem;
- UNGCPRO;
+ Vdeactivate_mark = save_deactivate_mark;
+ /* UNGCPRO; */
- return object;
+ abort_on_gc--;
+ return unbind_to (count, object);
}
DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
&& NILP (XCDR (XCDR (obj))))
return XCAR (XCDR (obj));
- print_error_message (obj, Vprin1_to_string_buffer);
+ print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil);
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
value = Fbuffer_string ();
STREAM (suitable for the print functions). */
void
-print_error_message (data, stream)
+print_error_message (data, stream, context, caller)
Lisp_Object data, stream;
+ char *context;
+ Lisp_Object caller;
{
Lisp_Object errname, errmsg, file_error, tail;
struct gcpro gcpro1;
int i;
+ if (context != 0)
+ write_string_1 (context, -1, stream);
+
+ /* If we know from where the error was signaled, show it in
+ *Messages*. */
+ if (!NILP (caller) && SYMBOLP (caller))
+ {
+ const char *name = SDATA (SYMBOL_NAME (caller));
+ message_dolog (name, strlen (name), 0, 0);
+ message_dolog (": ", 2, 0, 0);
+ }
+
errname = Fcar (data);
if (EQ (errname, Qerror))
tail = Fcdr_safe (data);
GCPRO1 (tail);
- /* If we know from where the error was signaled, show it in
- *Messages*. */
- if (!NILP (Vsignaling_function) && SYMBOLP (Vsignaling_function))
- {
- char *name = XSYMBOL (Vsignaling_function)->name->data;
- message_dolog (name, strlen (name), 0, 0);
- message_dolog (": ", 2, 0, 0);
- Vsignaling_function = Qnil;
- }
-
/* For file-error, make error message by concatenating
all the data items. They are all strings. */
if (!NILP (file_error) && CONSP (tail))
else
Fprin1 (obj, stream);
}
-
+
UNGCPRO;
}
* largest float, printed in the biggest notation. This is undoubtedly
* 20d float_output_format, with the negative of the C-constant "HUGE"
* from <math.h>.
- *
+ *
* On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
- *
+ *
* I assume that IEEE-754 format numbers can take 329 bytes for the worst
* case of -1e307 in 20d float_output_format. What is one to do (short of
* re-writing _doprnt to be more sane)?
{
unsigned char *cp;
int width;
-
+
/* Check for plus infinity in a way that won't lose
if there is no plus infinity. */
if (data == data / 2 && data > 1.0)
*buf++ = '-';
break;
}
-
+
strcpy (buf, "0.0e+NaN");
return;
}
/* Check that the spec we have is fully valid.
This means not only valid for printf,
but meant for floats, and reasonable. */
- cp = XSTRING (Vfloat_output_format)->data;
+ cp = SDATA (Vfloat_output_format);
if (cp[0] != '%')
goto lose;
if (cp[1] != 0)
goto lose;
- sprintf (buf, XSTRING (Vfloat_output_format)->data, data);
+ sprintf (buf, SDATA (Vfloat_output_format), data);
}
/* Make sure there is a decimal point with digit after, or an
int escapeflag;
{
print_depth = 0;
+ old_backquote_output = 0;
/* Reset print_number_index and Vprint_number_table only when
the variable Vprint_continuous_numbering is nil. Otherwise,
if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
{
int i, start, index;
- /* Construct Vprint_number_table. */
start = index = print_number_index;
+ /* Construct Vprint_number_table.
+ This increments print_number_index for the objects added. */
print_preprocess (obj);
+
/* Remove unnecessary objects, which appear only once in OBJ;
- that is, whose status is Qnil. */
+ that is, whose status is Qnil. Compactify the necessary objects. */
for (i = start; i < print_number_index; i++)
if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
{
PRINT_NUMBER_OBJECT (Vprint_number_table, index)
= PRINT_NUMBER_OBJECT (Vprint_number_table, i);
- /* Reset the status field for the next print step. Now this
- field means whether the object has already been printed. */
- PRINT_NUMBER_STATUS (Vprint_number_table, index) = Qnil;
index++;
}
+
+ /* Clear out objects outside the active part of the table. */
+ for (i = index; i < print_number_index; i++)
+ PRINT_NUMBER_OBJECT (Vprint_number_table, i) = Qnil;
+
+ /* Reset the status field for the next print step. Now this
+ field means whether the object has already been printed. */
+ for (i = start; i < print_number_index; i++)
+ PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qnil;
+
print_number_index = index;
}
{
case Lisp_String:
/* A string may have text properties, which can be circular. */
- traverse_intervals_noorder (XSTRING (obj)->intervals,
+ traverse_intervals_noorder (STRING_INTERVALS (obj),
print_preprocess_string, Qnil);
break;
GCPRO1 (obj);
- if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))
+ if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
{
PRINTCHAR ('#');
PRINTCHAR ('(');
}
PRINTCHAR ('\"');
- str = XSTRING (obj)->data;
- size_byte = STRING_BYTES (XSTRING (obj));
+ str = SDATA (obj);
+ size_byte = SBYTES (obj);
for (i = 0, i_byte = 0; i_byte < size_byte;)
{
{
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 ('\\');
PRINTCHAR ('f');
}
- else if (multibyte && ! ASCII_BYTE_P (c)
- && (print_escape_multibyte || CHAR_BYTE8_P (c)))
+ else if (multibyte
- && ! ASCII_BYTE_P (c)
- && (SINGLE_BYTE_CHAR_P (c) || print_escape_multibyte))
++ && (CHAR_BYTE8_P (c) || print_escape_multibyte))
{
/* When multibyte is disabled,
- print multibyte string chars using hex escapes. */
+ print multibyte string chars using hex escapes.
+ For a char code that could be in a unibyte string,
+ 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);
++ {
++ 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)
}
PRINTCHAR ('\"');
- if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))
+ if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
{
- traverse_intervals (XSTRING (obj)->intervals,
+ traverse_intervals (STRING_INTERVALS (obj),
0, print_interval, printcharfun);
PRINTCHAR (')');
}
case Lisp_Symbol:
{
register int confusing;
- register unsigned char *p = XSYMBOL (obj)->name->data;
- register unsigned char *end = p + STRING_BYTES (XSYMBOL (obj)->name);
+ register unsigned char *p = SDATA (SYMBOL_NAME (obj));
+ register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
register int c;
int i, i_byte, size_byte;
Lisp_Object name;
- XSETSTRING (name, XSYMBOL (obj)->name);
+ name = SYMBOL_NAME (obj);
if (p != end && (*p == '-' || *p == '+')) p++;
if (p == end)
PRINTCHAR (':');
}
- size_byte = STRING_BYTES (XSTRING (name));
+ size_byte = SBYTES (name);
for (i = 0, i_byte = 0; i_byte < size_byte;)
{
print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
}
else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
+ && ! old_backquote_output
&& ((EQ (XCAR (obj), Qbackquote)
|| EQ (XCAR (obj), Qcomma)
|| EQ (XCAR (obj), Qcomma_at)
else
{
PRINTCHAR ('(');
+
+ /* If the first element is a backquote form,
+ print it old-style so it won't be misunderstood. */
+ if (print_quoted && CONSP (XCAR (obj))
+ && CONSP (XCDR (XCAR (obj)))
+ && NILP (XCDR (XCDR (XCAR (obj))))
+ && EQ (XCAR (XCAR (obj)), Qbackquote))
+ {
+ Lisp_Object tem;
+ tem = XCAR (obj);
+ PRINTCHAR ('(');
+
+ print_object (Qbackquote, printcharfun, 0);
+ PRINTCHAR (' ');
+
+ ++old_backquote_output;
+ print_object (XCAR (XCDR (tem)), printcharfun, 0);
+ --old_backquote_output;
+ PRINTCHAR (')');
+
+ obj = XCDR (obj);
+ }
+
{
int print_length, i;
Lisp_Object halftail = obj;
}
}
}
-
+
if (i++)
PRINTCHAR (' ');
-
+
if (print_length && i > print_length)
{
strout ("...", 3, 3, printcharfun, 0);
goto end_of_list;
}
-
+
print_object (XCAR (obj), printcharfun, escapeflag);
-
+
obj = XCDR (obj);
if (!(i & 1))
halftail = XCDR (halftail);
strout (" . ", 3, 3, printcharfun, 0);
print_object (obj, printcharfun, escapeflag);
}
-
+
end_of_list:
PRINTCHAR (')');
}
PRINTCHAR ('#');
PRINTCHAR ('&');
- sprintf (buf, "%d", XBOOL_VECTOR (obj)->size);
+ if (sizeof (int) == sizeof (EMACS_INT))
+ sprintf (buf, "%d", XBOOL_VECTOR (obj)->size);
+ else if (sizeof (long) == sizeof (EMACS_INT))
+ sprintf (buf, "%ld", XBOOL_VECTOR (obj)->size);
+ else
+ abort ();
strout (buf, -1, -1, printcharfun, 0);
PRINTCHAR ('\"');
{
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 (' ');
PRINTCHAR ('\'');
- strout (XSYMBOL (h->test)->name->data, -1, -1, printcharfun, 0);
+ strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun, 0);
PRINTCHAR (' ');
- strout (XSYMBOL (h->weak)->name->data, -1, -1, printcharfun, 0);
+ strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0);
PRINTCHAR (' ');
sprintf (buf, "%d/%d", XFASTINT (h->count),
XVECTOR (h->next)->size);
? "#<frame " : "#<dead frame "),
-1, -1, printcharfun, 0);
print_string (XFRAME (obj)->name, printcharfun);
- sprintf (buf, " 0x%lx\\ ", (unsigned long) (XFRAME (obj)));
+ sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj)));
strout (buf, -1, -1, printcharfun, 0);
PRINTCHAR ('>');
}
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
DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii,
doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
\(OOO is the octal representation of the character code.)
-Only single-byte characters are affected, and only in `prin1'. */);
+Only single-byte characters are affected, and only in `prin1'.
+When the output goes in a multibyte buffer, this feature is
+enabled regardless of the value of the variable. */);
print_escape_nonascii = 0;
DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte,
DEFVAR_LISP ("print-number-table", &Vprint_number_table,
doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
The Lisp printer uses this vector to detect Lisp objects referenced more
-than once. When `print-continuous-numbering' is bound to t, you should
-probably also bind `print-number-table' to nil. This ensures that the
-value of `print-number-table' can be garbage-collected once the printing
-is done. */);
+than once.
+
+When you bind `print-continuous-numbering' to t, you should probably
+also bind `print-number-table' to nil. This ensures that the value of
+`print-number-table' can be garbage-collected once the printing is
+done. If all elements of `print-number-table' are nil, it means that
+the printing done so far has not found any shared structure or objects
+that need to be recorded in the table. */);
Vprint_number_table = Qnil;
/* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
/* Asynchronous subprocess control for GNU Emacs.
- Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999, 2001
- Free Software Foundation, Inc.
+ Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999,
+ 2001, 2002, 2003 Free Software Foundation, Inc.
This file is part of GNU Emacs.
Boston, MA 02111-1307, USA. */
-#define _GNU_SOURCE /* to get strsignal declared with glibc 2 */
#include <config.h>
#include <signal.h>
#ifdef NEED_NET_ERRNO_H
#include <net/errno.h>
#endif /* NEED_NET_ERRNO_H */
+
+/* Are local (unix) sockets supported? */
+#if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM)
+#if !defined (AF_LOCAL) && defined (AF_UNIX)
+#define AF_LOCAL AF_UNIX
+#endif
+#ifdef AF_LOCAL
+#define HAVE_LOCAL_SOCKETS
+#include <sys/un.h>
+#endif
+#endif
#endif /* HAVE_SOCKETS */
/* TERM is a poor-man's SLIP, used on GNU/Linux. */
#include "lisp.h"
#include "window.h"
#include "buffer.h"
- #include "charset.h"
+ #include "character.h"
#include "coding.h"
#include "process.h"
#include "termhooks.h"
#include "atimer.h"
Lisp_Object Qprocessp;
-Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed;
+Lisp_Object Qrun, Qstop, Qsignal;
+Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
+Lisp_Object Qlocal, Qdatagram;
+Lisp_Object QCname, QCbuffer, QChost, QCservice, QCtype;
+Lisp_Object QClocal, QCremote, QCcoding;
+Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
+Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
+Lisp_Object QCfilter_multibyte;
Lisp_Object Qlast_nonmenu_event;
+/* QCfamily is declared and initialized in xfaces.c,
+ QCfilter in keyboard.c. */
+extern Lisp_Object QCfamily, QCfilter;
+
/* Qexit is declared and initialized in eval.c. */
+/* QCfamily is defined in xfaces.c. */
+extern Lisp_Object QCfamily;
+/* QCfilter is defined in keyboard.c. */
+extern Lisp_Object QCfilter;
+
/* a process object is a network connection when its childp field is neither
- Qt nor Qnil but is instead a cons cell (HOSTNAME PORTNUM). */
+ 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))
#else
#define NETCONN_P(p) 0
+#define NETCONN1_P(p) 0
#endif /* HAVE_SOCKETS */
/* Define first descriptor number available for subprocesses. */
/* Number of events for which the user or sentinel has been notified. */
int update_tick;
+/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
+
+#ifdef BROKEN_NON_BLOCKING_CONNECT
+#undef NON_BLOCKING_CONNECT
+#else
+#ifndef NON_BLOCKING_CONNECT
+#ifdef HAVE_SOCKETS
+#ifdef HAVE_SELECT
+#if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
+#if defined (O_NONBLOCK) || defined (O_NDELAY)
+#if defined (EWOULDBLOCK) || defined (EINPROGRESS)
+#define NON_BLOCKING_CONNECT
+#endif /* EWOULDBLOCK || EINPROGRESS */
+#endif /* O_NONBLOCK || O_NDELAY */
+#endif /* HAVE_GETPEERNAME || GNU_LINUX */
+#endif /* HAVE_SELECT */
+#endif /* HAVE_SOCKETS */
+#endif /* NON_BLOCKING_CONNECT */
+#endif /* BROKEN_NON_BLOCKING_CONNECT */
+
+/* Define DATAGRAM_SOCKETS if datagrams can be used safely on
+ this system. We need to read full packets, so we need a
+ "non-destructive" select. So we require either native select,
+ or emulation of select using FIONREAD. */
+
+#ifdef BROKEN_DATAGRAM_SOCKETS
+#undef DATAGRAM_SOCKETS
+#else
+#ifndef DATAGRAM_SOCKETS
+#ifdef HAVE_SOCKETS
+#if defined (HAVE_SELECT) || defined (FIONREAD)
+#if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
+#define DATAGRAM_SOCKETS
+#endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
+#endif /* HAVE_SELECT || FIONREAD */
+#endif /* HAVE_SOCKETS */
+#endif /* DATAGRAM_SOCKETS */
+#endif /* BROKEN_DATAGRAM_SOCKETS */
+
+#ifdef TERM
+#undef NON_BLOCKING_CONNECT
+#undef DATAGRAM_SOCKETS
+#endif
+
+
#include "sysselect.h"
extern int keyboard_bit_set P_ ((SELECT_TYPE *));
static SELECT_TYPE non_process_wait_mask;
+/* Mask of bits indicating the descriptors that we wait for connect to
+ complete on. Once they complete, they are removed from this mask
+ and added to the input_wait_mask and non_keyboard_wait_mask. */
+
+static SELECT_TYPE connect_wait_mask;
+
+/* Number of bits set in connect_wait_mask. */
+static int num_pending_connects;
+
/* The largest descriptor currently in use for a process object. */
static int max_process_desc;
static struct coding_system *proc_decode_coding_system[MAXDESC];
static struct coding_system *proc_encode_coding_system[MAXDESC];
+#ifdef DATAGRAM_SOCKETS
+/* Table of `partner address' for datagram sockets. */
+struct sockaddr_and_len {
+ struct sockaddr *sa;
+ int len;
+} datagram_address[MAXDESC];
+#define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
+#define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
+#else
+#define DATAGRAM_CHAN_P(chan) (0)
+#define DATAGRAM_CONN_P(proc) (0)
+#endif
+
static Lisp_Object get_process ();
+static void exec_sentinel ();
extern EMACS_TIME timer_check ();
extern int timers_run;
p->raw_status_high = Qnil;
}
-/* Convert a process status word in Unix format to
+/* Convert a process status word in Unix format to
the list that we use internally. */
Lisp_Object
/* Return a string describing a process status list. */
-Lisp_Object
+Lisp_Object
status_message (status)
Lisp_Object status;
{
signame = "unknown";
string = build_string (signame);
string2 = build_string (coredump ? " (core dumped)\n" : "\n");
- XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
+ SSET (string, 0, DOWNCASE (SREF (string, 0)));
return concat2 (string, string2);
}
else if (EQ (symbol, Qexit))
return build_string ("finished\n");
string = Fnumber_to_string (make_number (code));
string2 = build_string (coredump ? " (core dumped)\n" : "\n");
- return concat2 (build_string ("exited abnormally with code "),
- concat2 (string, string2));
+ return concat3 (build_string ("exited abnormally with code "),
+ string, string2);
+ }
+ else if (EQ (symbol, Qfailed))
+ {
+ string = Fnumber_to_string (make_number (code));
+ string2 = build_string ("\n");
+ return concat3 (build_string ("failed with code "),
+ string, string2);
}
else
return Fcopy_sequence (Fsymbol_name (symbol));
int
allocate_pty ()
{
- struct stat stb;
register int c, i;
int fd;
- /* Some systems name their pseudoterminals so that there are gaps in
- the usual sequence - for example, on HP9000/S700 systems, there
- are no pseudoterminals with names ending in 'f'. So we wait for
- three failures in a row before deciding that we've reached the
- end of the ptys. */
- int failed_count = 0;
-
#ifdef PTY_ITERATION
PTY_ITERATION
#else
for (i = 0; i < 16; i++)
#endif
{
+ struct stat stb; /* Used in some PTY_OPEN. */
#ifdef PTY_NAME_SPRINTF
PTY_NAME_SPRINTF
#else
#ifdef PTY_OPEN
PTY_OPEN;
#else /* no PTY_OPEN */
-#ifdef IRIS
- /* Unusual IRIS code */
- *ptyv = emacs_open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
- if (fd < 0)
- return -1;
- if (fstat (fd, &stb) < 0)
- return -1;
-#else /* not IRIS */
- if (stat (pty_name, &stb) < 0)
- {
- failed_count++;
- if (failed_count >= 3)
- return -1;
+ {
+# ifdef IRIS
+ /* Unusual IRIS code */
+ *ptyv = emacs_open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
+ if (fd < 0)
+ return -1;
+ if (fstat (fd, &stb) < 0)
+ return -1;
+# else /* not IRIS */
+ { /* Some systems name their pseudoterminals so that there are gaps in
+ the usual sequence - for example, on HP9000/S700 systems, there
+ are no pseudoterminals with names ending in 'f'. So we wait for
+ three failures in a row before deciding that we've reached the
+ end of the ptys. */
+ int failed_count = 0;
+
+ if (stat (pty_name, &stb) < 0)
+ {
+ failed_count++;
+ if (failed_count >= 3)
+ return -1;
+ }
+ else
+ failed_count = 0;
}
- else
- failed_count = 0;
-#ifdef O_NONBLOCK
- fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
-#else
- fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
-#endif
-#endif /* not IRIS */
+# ifdef O_NONBLOCK
+ fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
+# else
+ fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
+# endif
+# endif /* not IRIS */
+ }
#endif /* no PTY_OPEN */
if (fd >= 0)
if (access (pty_name, 6) != 0)
{
emacs_close (fd);
-#if !defined(IRIS) && !defined(__sgi)
+# if !defined(IRIS) && !defined(__sgi)
continue;
-#else
+# else
return -1;
-#endif /* IRIS */
+# endif /* IRIS */
}
#endif /* not UNIPLUS */
setup_pty (fd);
deactivate_process (proc);
}
- setup_coding_system (p->decode_coding_system,
- proc_decode_coding_system[inch]);
+
+/* Setup coding systems of PROCESS. */
+
+void
+setup_process_coding_systems (process)
+ Lisp_Object process;
+{
+ struct Lisp_Process *p = XPROCESS (process);
+ int inch = XINT (p->infd);
+ int outch = XINT (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_raw_text_coding_system (proc_decode_coding_system[inch]);
++ coding_system = p->decode_coding_system;
+ if (! NILP (p->filter))
+ {
+ if (NILP (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))
++ 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]);
+}
\f
DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
doc: /* Return t if OBJECT is a process. */)
if (NILP (obj))
obj = Fget_buffer (name);
if (NILP (obj))
- error ("Process %s does not exist", XSTRING (name)->data);
+ error ("Process %s does not exist", SDATA (name));
}
else if (NILP (name))
obj = Fcurrent_buffer ();
{
proc = Fget_buffer_process (obj);
if (NILP (proc))
- error ("Buffer %s has no process", XSTRING (XBUFFER (obj)->name)->data);
+ error ("Buffer %s has no process", SDATA (XBUFFER (obj)->name));
}
else
{
{
Fkill_process (process, Qnil);
/* Do this now, since remove_process will make sigchld_handler do nothing. */
- XPROCESS (process)->status
+ XPROCESS (process)->status
= Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
XSETINT (XPROCESS (process)->tick, ++process_tick);
status_notify ();
exit -- for a process that has exited.
signal -- for a process that has got a fatal signal.
open -- for a network stream connection that is open.
+listen -- for a network stream server that is listening.
closed -- for a network stream connection that is closed.
+connect -- when waiting for a non-blocking connection to complete.
+failed -- when a non-blocking connection has failed.
nil -- if arg is a process name and no such process exists.
PROCESS may be a process, a buffer, the name of a process, or
nil, indicating the current buffer's process. */)
status = p->status;
if (CONSP (status))
status = XCAR (status);
- if (NETCONN_P (process))
+ if (NETCONN1_P (p))
{
- if (EQ (status, Qrun))
- status = Qopen;
- else if (EQ (status, Qexit))
+ if (EQ (status, Qexit))
status = Qclosed;
+ else if (EQ (p->command, Qt))
+ status = Qstop;
+ else if (EQ (status, Qrun))
+ status = Qopen;
}
return status;
}
(process, buffer)
register Lisp_Object process, buffer;
{
+ struct Lisp_Process *p;
+
CHECK_PROCESS (process);
if (!NILP (buffer))
CHECK_BUFFER (buffer);
- XPROCESS (process)->buffer = buffer;
+ p = XPROCESS (process);
+ p->buffer = buffer;
+ if (NETCONN1_P (p))
+ p->childp = Fplist_put (p->childp, QCbuffer, buffer);
+ setup_process_coding_systems (process);
return buffer;
}
2, 2, 0,
doc: /* Give PROCESS the filter function FILTER; nil means no filter.
t means stop accepting output from the process.
-When a process has a filter, each time it does output
-the entire string of output is passed to the filter.
+
+When a process has a filter, its buffer is not used for output.
+Instead, each time it does output, the entire string of output is
+passed to the filter.
+
The filter gets two arguments: the process and the string of output.
-If the process has a filter, its buffer is not used for output. */)
+The string argument is normally a multibyte string, except:
+- if the process' input coding system is no-conversion or raw-text,
+ it is a unibyte string (the non-converted input), or else
+- if `default-enable-multibyte-characters' is nil, it is a unibyte
+ string (the result of converting the decoded input multibyte
+ string to unibyte with `string-make-unibyte'). */)
(process, filter)
register Lisp_Object process, filter;
{
struct Lisp_Process *p;
-
+
CHECK_PROCESS (process);
p = XPROCESS (process);
(setq process (start-process ...))
(debug)
(set-process-filter process ...) */
-
+
if (XINT (p->infd) >= 0)
{
- if (EQ (filter, Qt))
+ if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
{
FD_CLR (XINT (p->infd), &input_wait_mask);
FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
}
- else if (EQ (XPROCESS (process)->filter, Qt))
+ else if (EQ (p->filter, Qt)
+ && !EQ (p->command, Qt)) /* Network process not stopped. */
{
FD_SET (XINT (p->infd), &input_wait_mask);
FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
}
}
-
+
p->filter = filter;
+ if (NETCONN1_P (p))
+ p->childp = Fplist_put (p->childp, QCfilter, filter);
+ setup_process_coding_systems (process);
return filter;
}
CHECK_PROCESS (process);
CHECK_NATNUM (height);
CHECK_NATNUM (width);
-
+
if (XINT (XPROCESS (process)->infd) < 0
|| set_window_size (XINT (XPROCESS (process)->infd),
XINT (height), XINT (width)) <= 0)
return XPROCESS (process)->inherit_coding_system_flag;
}
-DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
- Sprocess_kill_without_query, 1, 2, 0,
- doc: /* Say no query needed if PROCESS is running when Emacs is exited.
-Optional second argument if non-nil says to require a query.
-Value is t if a query was formerly required. */)
- (process, value)
- register Lisp_Object process, value;
+DEFUN ("set-process-query-on-exit-flag",
+ Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
+ 2, 2, 0,
+ doc: /* Specify if query is needed for PROCESS when Emacs is exited.
+If the second argument FLAG is non-nil, emacs will query the user before
+exiting if PROCESS is running. */)
+ (process, flag)
+ register Lisp_Object process, flag;
{
- Lisp_Object tem;
-
CHECK_PROCESS (process);
- tem = XPROCESS (process)->kill_without_query;
- XPROCESS (process)->kill_without_query = Fnull (value);
+ XPROCESS (process)->kill_without_query = Fnull (flag);
+ return flag;
+}
- return Fnull (tem);
+DEFUN ("process-query-on-exit-flag",
+ Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
+ 1, 1, 0,
+ doc: /* Return the current value of query on exit flag for PROCESS. */)
+ (process)
+ register Lisp_Object process;
+{
+ CHECK_PROCESS (process);
+ return Fnull (XPROCESS (process)->kill_without_query);
}
+#ifdef DATAGRAM_SOCKETS
+Lisp_Object Fprocess_datagram_address ();
+#endif
+
DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
- 1, 1, 0,
+ 1, 2, 0,
doc: /* Return the contact info of PROCESS; t for a real child.
-For a net connection, the value is a cons cell of the form (HOST SERVICE). */)
+For a net connection, the value depends on the optional KEY arg.
+If KEY is nil, value is a cons cell of the form (HOST SERVICE),
+if KEY is t, the complete contact information for the connection is
+returned, else the specific value for the keyword KEY is returned.
+See `make-network-process' for a list of keywords. */)
+ (process, key)
+ register Lisp_Object process, key;
+{
+ Lisp_Object contact;
+
+ CHECK_PROCESS (process);
+ contact = XPROCESS (process)->childp;
+
+#ifdef DATAGRAM_SOCKETS
+ if (DATAGRAM_CONN_P (process)
+ && (EQ (key, Qt) || EQ (key, QCremote)))
+ contact = Fplist_put (contact, QCremote,
+ Fprocess_datagram_address (process));
+#endif
+
+ if (!NETCONN_P (process) || EQ (key, Qt))
+ return contact;
+ if (NILP (key))
+ return Fcons (Fplist_get (contact, QChost),
+ Fcons (Fplist_get (contact, QCservice), Qnil));
+ return Fplist_get (contact, key);
+}
+
+DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
+ 1, 1, 0,
+ doc: /* Return the plist of PROCESS. */)
(process)
register Lisp_Object process;
{
CHECK_PROCESS (process);
- return XPROCESS (process)->childp;
+ return XPROCESS (process)->plist;
+}
+
+DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
+ 2, 2, 0,
+ doc: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
+ (process, plist)
+ register Lisp_Object process, plist;
+{
+ CHECK_PROCESS (process);
+ CHECK_LIST (plist);
+
+ XPROCESS (process)->plist = plist;
+ return plist;
}
#if 0 /* Turned off because we don't currently record this info
return XPROCESS (process)->type;
}
#endif
+
+#ifdef HAVE_SOCKETS
+DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
+ 1, 2, 0,
+ doc: /* Convert network ADDRESS from internal format to a string.
+If optional second argument OMIT-PORT is non-nil, don't include a port
+number in the string; in this case, interpret a 4 element vector as an
+IP address. Returns nil if format of ADDRESS is invalid. */)
+ (address, omit_port)
+ Lisp_Object address, omit_port;
+{
+ if (NILP (address))
+ return Qnil;
+
+ if (STRINGP (address)) /* AF_LOCAL */
+ return address;
+
+ if (VECTORP (address)) /* AF_INET */
+ {
+ register struct Lisp_Vector *p = XVECTOR (address);
+ Lisp_Object args[6];
+ int nargs, i;
+
+ if (!NILP (omit_port) && (p->size == 4 || p->size == 5))
+ {
+ args[0] = build_string ("%d.%d.%d.%d");
+ nargs = 4;
+ }
+ else if (p->size == 5)
+ {
+ args[0] = build_string ("%d.%d.%d.%d:%d");
+ nargs = 5;
+ }
+ else
+ return Qnil;
+
+ for (i = 0; i < nargs; i++)
+ args[i+1] = p->contents[i];
+ return Fformat (nargs+1, args);
+ }
+
+ if (CONSP (address))
+ {
+ Lisp_Object args[2];
+ args[0] = build_string ("<Family %d>");
+ args[1] = Fcar (address);
+ return Fformat (2, args);
+
+ }
+
+ return Qnil;
+}
+#endif
\f
Lisp_Object
-list_processes_1 ()
+list_processes_1 (query_only)
+ Lisp_Object query_only;
{
register Lisp_Object tail, tem;
Lisp_Object proc, minspace, tem1;
register struct Lisp_Process *p;
- char tembuf[80];
+ char tembuf[300];
+ int w_proc, w_buffer, w_tty;
+ Lisp_Object i_status, i_buffer, i_tty, i_command;
+
+ w_proc = 4; /* Proc */
+ w_buffer = 6; /* Buffer */
+ w_tty = 0; /* Omit if no ttys */
+
+ for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
+ {
+ int i;
+
+ proc = Fcdr (Fcar (tail));
+ p = XPROCESS (proc);
+ if (NILP (p->childp))
+ continue;
+ if (!NILP (query_only) && !NILP (p->kill_without_query))
+ continue;
+ if (STRINGP (p->name)
+ && ( i = SCHARS (p->name), (i > w_proc)))
+ w_proc = i;
+ if (!NILP (p->buffer))
+ {
+ if (NILP (XBUFFER (p->buffer)->name) && w_buffer < 8)
+ w_buffer = 8; /* (Killed) */
+ else if ((i = SCHARS (XBUFFER (p->buffer)->name), (i > w_buffer)))
+ w_buffer = i;
+ }
+ if (STRINGP (p->tty_name)
+ && (i = SCHARS (p->tty_name), (i > w_tty)))
+ w_tty = i;
+ }
+
+ XSETFASTINT (i_status, w_proc + 1);
+ XSETFASTINT (i_buffer, XFASTINT (i_status) + 9);
+ if (w_tty)
+ {
+ XSETFASTINT (i_tty, XFASTINT (i_buffer) + w_buffer + 1);
+ XSETFASTINT (i_command, XFASTINT (i_buffer) + w_tty + 1);
+ } else {
+ i_tty = Qnil;
+ XSETFASTINT (i_command, XFASTINT (i_buffer) + w_buffer + 1);
+ }
XSETFASTINT (minspace, 1);
current_buffer->truncate_lines = Qt;
- write_string ("\
-Proc Status Buffer Tty Command\n\
----- ------ ------ --- -------\n", -1);
+ write_string ("Proc", -1);
+ Findent_to (i_status, minspace); write_string ("Status", -1);
+ Findent_to (i_buffer, minspace); write_string ("Buffer", -1);
+ if (!NILP (i_tty))
+ {
+ Findent_to (i_tty, minspace); write_string ("Tty", -1);
+ }
+ Findent_to (i_command, minspace); write_string ("Command", -1);
+ write_string ("\n", -1);
+
+ write_string ("----", -1);
+ Findent_to (i_status, minspace); write_string ("------", -1);
+ Findent_to (i_buffer, minspace); write_string ("------", -1);
+ if (!NILP (i_tty))
+ {
+ Findent_to (i_tty, minspace); write_string ("---", -1);
+ }
+ Findent_to (i_command, minspace); write_string ("-------", -1);
+ write_string ("\n", -1);
for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
{
p = XPROCESS (proc);
if (NILP (p->childp))
continue;
+ if (!NILP (query_only) && !NILP (p->kill_without_query))
+ continue;
Finsert (1, &p->name);
- Findent_to (make_number (13), minspace);
+ Findent_to (i_status, minspace);
if (!NILP (p->raw_status_low))
update_status (p);
if (CONSP (p->status))
symbol = XCAR (p->status);
-
+
if (EQ (symbol, Qsignal))
{
Lisp_Object tem;
#endif
Fprinc (symbol, Qnil);
}
- else if (NETCONN_P (proc))
+ else if (NETCONN1_P (p))
{
- if (EQ (symbol, Qrun))
- write_string ("open", -1);
- else if (EQ (symbol, Qexit))
+ if (EQ (symbol, Qexit))
write_string ("closed", -1);
+ else if (EQ (p->command, Qt))
+ write_string ("stopped", -1);
+ else if (EQ (symbol, Qrun))
+ write_string ("open", -1);
else
Fprinc (symbol, Qnil);
}
if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
remove_process (proc);
- Findent_to (make_number (22), minspace);
+ Findent_to (i_buffer, minspace);
if (NILP (p->buffer))
insert_string ("(none)");
else if (NILP (XBUFFER (p->buffer)->name))
else
Finsert (1, &XBUFFER (p->buffer)->name);
- Findent_to (make_number (37), minspace);
-
- if (STRINGP (p->tty_name))
- Finsert (1, &p->tty_name);
- else
- insert_string ("(none)");
+ if (!NILP (i_tty))
+ {
+ Findent_to (i_tty, minspace);
+ if (STRINGP (p->tty_name))
+ Finsert (1, &p->tty_name);
+ }
- Findent_to (make_number (49), minspace);
+ Findent_to (i_command, minspace);
- if (NETCONN_P (proc))
+ if (EQ (p->status, Qlisten))
+ {
+ Lisp_Object port = Fplist_get (p->childp, QCservice);
+ if (INTEGERP (port))
+ port = Fnumber_to_string (port);
+ if (NILP (port))
+ port = Fformat_network_address (Fplist_get (p->childp, QClocal), Qnil);
+ sprintf (tembuf, "(network %s server on %s)\n",
+ (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
+ (STRINGP (port) ? (char *)SDATA (port) : "?"));
+ insert_string (tembuf);
+ }
+ else if (NETCONN1_P (p))
{
- sprintf (tembuf, "(network stream connection to %s)\n",
- XSTRING (XCAR (p->childp))->data);
+ /* For a local socket, there is no host name,
+ so display service instead. */
+ Lisp_Object host = Fplist_get (p->childp, QChost);
+ if (!STRINGP (host))
+ {
+ host = Fplist_get (p->childp, QCservice);
+ if (INTEGERP (host))
+ host = Fnumber_to_string (host);
+ }
+ if (NILP (host))
+ host = Fformat_network_address (Fplist_get (p->childp, QCremote), Qnil);
+ sprintf (tembuf, "(network %s connection to %s)\n",
+ (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
+ (STRINGP (host) ? (char *)SDATA (host) : "?"));
insert_string (tembuf);
}
- else
+ else
{
tem = p->command;
while (1)
return Qnil;
}
-DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",
+DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 1, "P",
doc: /* Display a list of all processes.
+If optional argument QUERY-ONLY is non-nil, only processes with
+the query-on-exit flag set will be listed.
Any process listed as exited or signaled is actually eliminated
after the listing is made. */)
- ()
+ (query_only)
+ Lisp_Object query_only;
{
internal_with_output_to_temp_buffer ("*Process List*",
- list_processes_1, Qnil);
+ list_processes_1, query_only);
return Qnil;
}
with any buffer.
Third arg is program file name. It is searched for in PATH.
Remaining arguments are strings to give program as arguments.
+
usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
(nargs, args)
int nargs;
register unsigned char **new_argv;
#endif
register int i;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
buffer = args[1];
if (!NILP (buffer))
GCPRO2 (buffer, current_dir);
- current_dir
+ current_dir
= expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
Qnil);
if (NILP (Ffile_accessible_directory_p (current_dir)))
record_unwind_protect (start_process_unwind, proc);
XPROCESS (proc)->childp = Qt;
+ XPROCESS (proc)->plist = Qnil;
XPROCESS (proc)->command_channel_p = Qnil;
XPROCESS (proc)->buffer = buffer;
XPROCESS (proc)->sentinel = Qnil;
XPROCESS (proc)->filter = Qnil;
+ XPROCESS (proc)->filter_multibyte
+ = buffer_defaults.enable_multibyte_characters;
XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
/* Make the process marker point into the process buffer (if any). */
#ifdef VMS
/* Make a one member argv with all args concatenated
together separated by a blank. */
- len = STRING_BYTES (XSTRING (program)) + 2;
+ len = SBYTES (program) + 2;
for (i = 3; i < nargs; i++)
{
tem = args[i];
CHECK_STRING (tem);
- len += STRING_BYTES (XSTRING (tem)) + 1; /* count the blank */
+ len += SBYTES (tem) + 1; /* count the blank */
}
new_argv = (unsigned char *) alloca (len);
- strcpy (new_argv, XSTRING (program)->data);
+ strcpy (new_argv, SDATA (program));
for (i = 3; i < nargs; i++)
{
tem = args[i];
CHECK_STRING (tem);
strcat (new_argv, " ");
- strcat (new_argv, XSTRING (tem)->data);
+ strcat (new_argv, SDATA (tem));
}
/* Need to add code here to check for program existence on VMS */
-
+
#else /* not VMS */
new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
- /* If program file name is not absolute, search our path for it */
- if (!IS_DIRECTORY_SEP (XSTRING (program)->data[0])
- && !(XSTRING (program)->size > 1
- && IS_DEVICE_SEP (XSTRING (program)->data[1])))
+ /* If program file name is not absolute, search our path for it.
+ Put the name we will really use in TEM. */
+ if (!IS_DIRECTORY_SEP (SREF (program, 0))
+ && !(SCHARS (program) > 1
+ && IS_DEVICE_SEP (SREF (program, 1))))
{
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
tem = Qnil;
GCPRO4 (name, program, buffer, current_dir);
- openp (Vexec_path, program, Vexec_suffixes, &tem, 1);
+ openp (Vexec_path, program, Vexec_suffixes, &tem, make_number (X_OK));
UNGCPRO;
if (NILP (tem))
report_file_error ("Searching for program", Fcons (program, Qnil));
tem = Fexpand_file_name (tem, Qnil);
- tem = ENCODE_FILE (tem);
- new_argv[0] = XSTRING (tem)->data;
}
else
{
if (!NILP (Ffile_directory_p (program)))
error ("Specified program for new process is a directory");
-
- tem = ENCODE_FILE (program);
- new_argv[0] = XSTRING (tem)->data;
+ tem = program;
}
+ /* If program file name starts with /: for quoting a magic name,
+ discard that. */
+ if (SBYTES (tem) > 2 && SREF (tem, 0) == '/'
+ && SREF (tem, 1) == ':')
+ tem = Fsubstring (tem, make_number (2), Qnil);
+
+ /* Encode the file name and put it in NEW_ARGV.
+ That's where the child will use it to execute the program. */
+ tem = ENCODE_FILE (tem);
+ new_argv[0] = SDATA (tem);
+
/* Here we encode arguments by the coding system used for sending
data to the process. We don't support using different coding
systems for encoding arguments and for encoding data sent to the
if (STRING_MULTIBYTE (tem))
tem = (code_convert_string_norecord
(tem, XPROCESS (proc)->encode_coding_system, 1));
- new_argv[i - 2] = XSTRING (tem)->data;
+ new_argv[i - 2] = SDATA (tem);
}
new_argv[i - 2] = 0;
#endif /* not VMS */
if (inchannel >= 0)
{
-#ifndef USG
- /* On USG systems it does not work to open the pty's tty here
- and then close and reopen it in the child. */
+#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
+ /* On most USG systems it does not work to open the pty's tty here,
+ then close it and reopen it in the child. */
#ifdef O_NOCTTY
/* Don't let this terminal become our controlling terminal
(in case we don't have one). */
report_file_error ("Opening pty", Qnil);
#else
forkin = forkout = -1;
-#endif /* not USG */
+#endif /* not USG, or USG_SUBTTY_WORKS */
pty_flag = 1;
}
else
chan_process[inchannel] = process;
XSETINT (XPROCESS (process)->infd, inchannel);
XSETINT (XPROCESS (process)->outfd, outchannel);
- /* Record the tty descriptor used in the subprocess. */
- if (forkin < 0)
- XPROCESS (process)->subtty = Qnil;
- else
- XSETFASTINT (XPROCESS (process)->subtty, forkin);
+
+ /* Previously we recorded the tty descriptor used in the subprocess.
+ It was only used for getting the foreground tty process, so now
+ we just reopen the device (see emacs_get_tty_pgrp) as this is
+ more portable (see USG_SUBTTY_WORKS above). */
+
XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
XPROCESS (process)->status = Qrun;
- if (!proc_decode_coding_system[inchannel])
- proc_decode_coding_system[inchannel]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (XPROCESS (process)->decode_coding_system,
- proc_decode_coding_system[inchannel]);
- if (!proc_encode_coding_system[outchannel])
- proc_encode_coding_system[outchannel]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (XPROCESS (process)->encode_coding_system,
- proc_encode_coding_system[outchannel]);
+ setup_process_coding_systems (process);
/* Delay interrupts until we have a chance to store
the new fork's pid in its process structure */
XSETINT (XPROCESS (process)->pid, -1);
BLOCK_INPUT;
-
+
{
/* child_setup must clobber environ on systems with true vfork.
Protect it from permanent change. */
}
#endif
#endif
-#ifdef TIOCNOTTY
+#ifdef TIOCNOTTY
/* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
can do TIOCSPGRP only to the process's controlling tty. */
if (pty_flag)
{
- /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
+ /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
I can't test it since I don't have 4.3. */
int j = emacs_open ("/dev/tty", O_RDWR, 0);
ioctl (j, TIOCNOTTY, 0);
#ifdef WINDOWSNT
pid = child_setup (xforkin, xforkout, xforkout,
new_argv, 1, current_dir);
-#else /* not WINDOWSNT */
+#else /* not WINDOWSNT */
child_setup (xforkin, xforkout, xforkout,
new_argv, 1, current_dir);
#endif /* not WINDOWSNT */
{
struct atimer *timer;
EMACS_TIME offset;
-
+
stop_polling ();
EMACS_SET_SECS_USECS (offset, 1, 0);
timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0);
-
- XPROCESS (process)->subtty = Qnil;
+
if (forkin >= 0)
emacs_close (forkin);
cancel_atimer (timer);
start_polling ();
}
-
+
if (forkin != forkout && forkout >= 0)
emacs_close (forkout);
}
#endif /* not VMS */
+\f
#ifdef HAVE_SOCKETS
-/* open a TCP network connection to a given HOST/SERVICE. Treated
- exactly like a normal process when reading and writing. Only
- differences are in status display and process deletion. A network
- connection has no PID; you cannot signal it. All you can do is
- deactivate and close it via delete-process */
-
-DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,
- 4, 4, 0,
- doc: /* Open a TCP connection for a service to a host.
-Returns a subprocess-object to represent the connection.
-Input and output work as for subprocesses; `delete-process' closes it.
-Args are NAME BUFFER HOST SERVICE.
-NAME is name for process. It is modified if necessary to make it unique.
-BUFFER is the buffer (or buffer-name) to associate with the process.
- Process output goes at end of that buffer, unless you specify
- an output stream or filter function to handle the output.
- BUFFER may be also nil, meaning that this process is not associated
- with any buffer
-Third arg is name of the host to connect to, or its IP address.
-Fourth arg SERVICE is name of the service desired, or an integer
-specifying a port number to connect to. */)
- (name, buffer, host, service)
- Lisp_Object name, buffer, host, service;
+/* Convert an internal struct sockaddr to a lisp object (vector or string).
+ The address family of sa is not included in the result. */
+
+static Lisp_Object
+conv_sockaddr_to_lisp (sa, len)
+ struct sockaddr *sa;
+ int len;
{
- Lisp_Object proc;
-#ifdef HAVE_GETADDRINFO
- struct addrinfo hints, *res, *lres;
- int ret = 0;
- int xerrno = 0;
- char *portstring, portbuf[128];
-#else /* HAVE_GETADDRINFO */
- struct sockaddr_in address;
- struct servent *svc_info;
- struct hostent *host_info_ptr, host_info;
- char *(addr_list[2]);
- IN_ADDR numeric_addr;
- int port;
-#endif /* HAVE_GETADDRINFO */
- int s = -1, outch, inch;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- int retry = 0;
- int count = specpdl_ptr - specpdl;
- int count1;
+ Lisp_Object address;
+ int i;
+ unsigned char *cp;
+ register struct Lisp_Vector *p;
-#ifdef WINDOWSNT
- /* Ensure socket support is loaded if available. */
- init_winsock (TRUE);
+ switch (sa->sa_family)
+ {
+ case AF_INET:
+ {
+ struct sockaddr_in *sin = (struct sockaddr_in *) sa;
+ len = sizeof (sin->sin_addr) + 1;
+ address = Fmake_vector (make_number (len), Qnil);
+ p = XVECTOR (address);
+ p->contents[--len] = make_number (ntohs (sin->sin_port));
+ cp = (unsigned char *)&sin->sin_addr;
+ break;
+ }
+#ifdef HAVE_LOCAL_SOCKETS
+ case AF_LOCAL:
+ {
+ struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
+ for (i = 0; i < sizeof (sockun->sun_path); i++)
+ if (sockun->sun_path[i] == 0)
+ break;
+ return make_unibyte_string (sockun->sun_path, i);
+ }
#endif
+ default:
+ len -= sizeof (sa->sa_family);
+ address = Fcons (make_number (sa->sa_family),
+ Fmake_vector (make_number (len), Qnil));
+ p = XVECTOR (XCDR (address));
+ cp = (unsigned char *) sa + sizeof (sa->sa_family);
+ break;
+ }
- GCPRO4 (name, buffer, host, service);
- CHECK_STRING (name);
- CHECK_STRING (host);
+ i = 0;
+ while (i < len)
+ p->contents[i++] = make_number (*cp++);
-#ifdef HAVE_GETADDRINFO
- /* SERVICE can either be a string or int.
- Convert to a C string for later use by getaddrinfo. */
- if (INTEGERP (service))
+ return address;
+}
+
+
+/* Get family and required size for sockaddr structure to hold ADDRESS. */
+
+static int
+get_lisp_to_sockaddr_size (address, familyp)
+ Lisp_Object address;
+ int *familyp;
+{
+ register struct Lisp_Vector *p;
+
+ if (VECTORP (address))
{
- sprintf (portbuf, "%ld", (long) XINT (service));
- portstring = portbuf;
+ p = XVECTOR (address);
+ if (p->size == 5)
+ {
+ *familyp = AF_INET;
+ return sizeof (struct sockaddr_in);
+ }
}
- else
+#ifdef HAVE_LOCAL_SOCKETS
+ else if (STRINGP (address))
{
- CHECK_STRING (service);
- portstring = XSTRING (service)->data;
+ *familyp = AF_LOCAL;
+ return sizeof (struct sockaddr_un);
}
-#else /* HAVE_GETADDRINFO */
- if (INTEGERP (service))
- port = htons ((unsigned short) XINT (service));
- else
+#endif
+ else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address)))
{
- CHECK_STRING (service);
- svc_info = getservbyname (XSTRING (service)->data, "tcp");
- if (svc_info == 0)
- error ("Unknown service \"%s\"", XSTRING (service)->data);
- port = svc_info->s_port;
+ struct sockaddr *sa;
+ *familyp = XINT (XCAR (address));
+ p = XVECTOR (XCDR (address));
+ return p->size + sizeof (sa->sa_family);
}
-#endif /* HAVE_GETADDRINFO */
-
+ return 0;
+}
- /* Slow down polling to every ten seconds.
- Some kernels have a bug which causes retrying connect to fail
- after a connect. Polling can interfere with gethostbyname too. */
-#ifdef POLL_FOR_INPUT
- record_unwind_protect (unwind_stop_other_atimers, Qnil);
- bind_polling_period (10);
-#endif
+/* Convert an address object (vector or string) to an internal sockaddr.
+ Format of address has already been validated by size_lisp_to_sockaddr. */
-#ifndef TERM
-#ifdef HAVE_GETADDRINFO
- immediate_quit = 1;
- QUIT;
- memset (&hints, 0, sizeof (hints));
- hints.ai_flags = 0;
- hints.ai_family = AF_UNSPEC;
- hints.ai_socktype = SOCK_STREAM;
- hints.ai_protocol = 0;
- ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);
- if (ret)
-#ifdef HAVE_GAI_STRERROR
- error ("%s/%s %s", XSTRING (host)->data, portstring, gai_strerror(ret));
-#else
- error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring,
- ret);
-#endif
- immediate_quit = 0;
+static void
+conv_lisp_to_sockaddr (family, address, sa, len)
+ int family;
+ Lisp_Object address;
+ struct sockaddr *sa;
+ int len;
+{
+ register struct Lisp_Vector *p;
+ register unsigned char *cp = NULL;
+ register int i;
- /* Do this in case we never enter the for-loop below. */
- count1 = specpdl_ptr - specpdl;
- s = -1;
+ bzero (sa, len);
+ sa->sa_family = family;
- for (lres = res; lres; lres = lres->ai_next)
+ if (VECTORP (address))
{
- s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
- if (s < 0)
+ p = XVECTOR (address);
+ if (family == AF_INET)
{
- xerrno = errno;
- continue;
+ struct sockaddr_in *sin = (struct sockaddr_in *) sa;
+ len = sizeof (sin->sin_addr) + 1;
+ i = XINT (p->contents[--len]);
+ sin->sin_port = htons (i);
+ cp = (unsigned char *)&sin->sin_addr;
+ }
+ }
+ else if (STRINGP (address))
+ {
+#ifdef HAVE_LOCAL_SOCKETS
+ if (family == AF_LOCAL)
+ {
+ struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
+ cp = SDATA (address);
+ for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
+ sockun->sun_path[i] = *cp++;
}
+#endif
+ return;
+ }
+ else
+ {
+ p = XVECTOR (XCDR (address));
+ cp = (unsigned char *)sa + sizeof (sa->sa_family);
+ }
- /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
- when connect is interrupted. So let's not let it get interrupted.
- Note we do not turn off polling, because polling is only used
- when not interrupt_input, and thus not normally used on the systems
- which have this bug. On systems which use polling, there's no way
- to quit if polling is turned off. */
- if (interrupt_input)
- unrequest_sigio ();
+ for (i = 0; i < len; i++)
+ if (INTEGERP (p->contents[i]))
+ *cp++ = XFASTINT (p->contents[i]) & 0xff;
+}
- /* Make us close S if quit. */
- count1 = specpdl_ptr - specpdl;
- record_unwind_protect (close_file_unwind, make_number (s));
+#ifdef DATAGRAM_SOCKETS
+DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
+ 1, 1, 0,
+ doc: /* Get the current datagram address associated with PROCESS. */)
+ (process)
+ Lisp_Object process;
+{
+ int channel;
- loop:
+ CHECK_PROCESS (process);
- immediate_quit = 1;
- QUIT;
+ if (!DATAGRAM_CONN_P (process))
+ return Qnil;
- /* This turns off all alarm-based interrupts; the
- bind_polling_period call above doesn't always turn all the
- short-interval ones off, especially if interrupt_input is
- set.
+ channel = XINT (XPROCESS (process)->infd);
+ return conv_sockaddr_to_lisp (datagram_address[channel].sa,
+ datagram_address[channel].len);
+}
- It'd be nice to be able to control the connect timeout
- though. Would non-blocking connect calls be portable? */
- turn_on_atimers (0);
- ret = connect (s, lres->ai_addr, lres->ai_addrlen);
- xerrno = errno;
- turn_on_atimers (1);
+DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
+ 2, 2, 0,
+ doc: /* Set the datagram address for PROCESS to ADDRESS.
+Returns nil upon error setting address, ADDRESS otherwise. */)
+ (process, address)
+ Lisp_Object process, address;
+{
+ int channel;
+ int family, len;
- if (ret == 0 || xerrno == EISCONN)
- /* The unwind-protect will be discarded afterwards.
- Likewise for immediate_quit. */
- break;
+ CHECK_PROCESS (process);
- immediate_quit = 0;
+ if (!DATAGRAM_CONN_P (process))
+ return Qnil;
- if (xerrno == EINTR)
- goto loop;
- if (xerrno == EADDRINUSE && retry < 20)
+ channel = XINT (XPROCESS (process)->infd);
+
+ len = get_lisp_to_sockaddr_size (address, &family);
+ if (datagram_address[channel].len != len)
+ return Qnil;
+ conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
+ return address;
+}
+#endif
+\f
+
+static struct socket_options {
+ /* The name of this option. Should be lowercase version of option
+ name without SO_ prefix. */
+ char *name;
+ /* Length of name. */
+ int nlen;
+ /* Option level SOL_... */
+ int optlevel;
+ /* Option number SO_... */
+ int optnum;
+ enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_STR, SOPT_LINGER } opttype;
+} socket_options[] =
+ {
+#ifdef SO_BINDTODEVICE
+ { "bindtodevice", 12, SOL_SOCKET, SO_BINDTODEVICE, SOPT_STR },
+#endif
+#ifdef SO_BROADCAST
+ { "broadcast", 9, SOL_SOCKET, SO_BROADCAST, SOPT_BOOL },
+#endif
+#ifdef SO_DONTROUTE
+ { "dontroute", 9, SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL },
+#endif
+#ifdef SO_KEEPALIVE
+ { "keepalive", 9, SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL },
+#endif
+#ifdef SO_LINGER
+ { "linger", 6, SOL_SOCKET, SO_LINGER, SOPT_LINGER },
+#endif
+#ifdef SO_OOBINLINE
+ { "oobinline", 9, SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL },
+#endif
+#ifdef SO_PRIORITY
+ { "priority", 8, SOL_SOCKET, SO_PRIORITY, SOPT_INT },
+#endif
+#ifdef SO_REUSEADDR
+ { "reuseaddr", 9, SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL },
+#endif
+ { 0, 0, 0, 0, SOPT_UNKNOWN }
+ };
+
+/* Process list of socket options OPTS on socket S.
+ Only check if options are supported is S < 0.
+ If NO_ERROR is non-zero, continue silently if an option
+ cannot be set.
+
+ Each element specifies one option. An element is either a string
+ "OPTION=VALUE" or a cons (OPTION . VALUE) where OPTION is a string
+ or a symbol. */
+
+static int
+set_socket_options (s, opts, no_error)
+ int s;
+ Lisp_Object opts;
+ int no_error;
+{
+ if (!CONSP (opts))
+ opts = Fcons (opts, Qnil);
+
+ while (CONSP (opts))
+ {
+ Lisp_Object opt;
+ Lisp_Object val;
+ char *name, *arg;
+ struct socket_options *sopt;
+ int ret = 0;
+
+ opt = XCAR (opts);
+ opts = XCDR (opts);
+
+ name = 0;
+ val = Qt;
+ if (CONSP (opt))
{
- /* A delay here is needed on some FreeBSD systems,
- and it is harmless, since this retrying takes time anyway
- and should be infrequent. */
- Fsleep_for (make_number (1), Qnil);
- retry++;
- goto loop;
+ val = XCDR (opt);
+ opt = XCAR (opt);
}
+ if (STRINGP (opt))
+ name = (char *) SDATA (opt);
+ else if (SYMBOLP (opt))
+ name = (char *) SDATA (SYMBOL_NAME (opt));
+ else {
+ error ("Mal-formed option list");
+ return 0;
+ }
- /* Discard the unwind protect closing S. */
- specpdl_ptr = specpdl + count1;
- count1 = specpdl_ptr - specpdl;
-
- emacs_close (s);
- s = -1;
+ if (strncmp (name, "no", 2) == 0)
+ {
+ val = Qnil;
+ name += 2;
+ }
+
+ arg = 0;
+ for (sopt = socket_options; sopt->name; sopt++)
+ if (strncmp (name, sopt->name, sopt->nlen) == 0)
+ {
+ if (name[sopt->nlen] == 0)
+ break;
+ if (name[sopt->nlen] == '=')
+ {
+ arg = name + sopt->nlen + 1;
+ break;
+ }
+ }
+
+ switch (sopt->opttype)
+ {
+ case SOPT_BOOL:
+ {
+ int optval;
+ if (s < 0)
+ return 1;
+ if (arg)
+ optval = (*arg == '0' || *arg == 'n') ? 0 : 1;
+ else if (INTEGERP (val))
+ optval = XINT (val) == 0 ? 0 : 1;
+ else
+ optval = NILP (val) ? 0 : 1;
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ &optval, sizeof (optval));
+ break;
+ }
+
+ case SOPT_INT:
+ {
+ int optval;
+ if (arg)
+ optval = atoi(arg);
+ else if (INTEGERP (val))
+ optval = XINT (val);
+ else
+ error ("Bad option argument for %s", name);
+ if (s < 0)
+ return 1;
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ &optval, sizeof (optval));
+ break;
+ }
+
+ case SOPT_STR:
+ {
+ if (!arg)
+ {
+ if (NILP (val))
+ arg = "";
+ else if (STRINGP (val))
+ arg = (char *) SDATA (val);
+ else if (XSYMBOL (val))
+ arg = (char *) SDATA (SYMBOL_NAME (val));
+ else
+ error ("Invalid argument to %s option", name);
+ }
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ arg, strlen (arg));
+ }
+
+#ifdef SO_LINGER
+ case SOPT_LINGER:
+ {
+ struct linger linger;
+
+ linger.l_onoff = 1;
+ linger.l_linger = 0;
+
+ if (s < 0)
+ return 1;
+
+ if (arg)
+ {
+ if (*arg == 'n' || *arg == 't' || *arg == 'y')
+ linger.l_onoff = (*arg == 'n') ? 0 : 1;
+ else
+ linger.l_linger = atoi(arg);
+ }
+ else if (INTEGERP (val))
+ linger.l_linger = XINT (val);
+ else
+ linger.l_onoff = NILP (val) ? 0 : 1;
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ &linger, sizeof (linger));
+ break;
+ }
+#endif
+ default:
+ if (s < 0)
+ return 0;
+ if (no_error)
+ continue;
+ error ("Unsupported option: %s", name);
+ }
+ if (ret < 0 && ! no_error)
+ report_file_error ("Cannot set network option: %s", opt);
+ }
+ return 1;
+}
+
+DEFUN ("set-network-process-options",
+ Fset_network_process_options, Sset_network_process_options,
+ 1, MANY, 0,
+ doc: /* Set one or more options for network process PROCESS.
+Each option is either a string "OPT=VALUE" or a cons (OPT . VALUE).
+A boolean value is false if it either zero or nil, true otherwise.
+
+The following options are known. Consult the relevant system manual
+pages for more information.
+
+bindtodevice=NAME -- bind to interface NAME, or remove binding if nil.
+broadcast=BOOL -- Allow send and receive of datagram broadcasts.
+dontroute=BOOL -- Only send to directly connected hosts.
+keepalive=BOOL -- Send keep-alive messages on network stream.
+linger=BOOL or TIMEOUT -- Send queued messages before closing.
+oobinline=BOOL -- Place out-of-band data in receive data stream.
+priority=INT -- Set protocol defined priority for sent packets.
+reuseaddr=BOOL -- Allow reusing a recently used address.
+
+usage: (set-network-process-options PROCESS &rest OPTIONS) */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object process;
+ Lisp_Object opts;
+
+ process = args[0];
+ CHECK_PROCESS (process);
+ if (nargs > 1 && XINT (XPROCESS (process)->infd) >= 0)
+ {
+ opts = Flist (nargs, args);
+ set_socket_options (XINT (XPROCESS (process)->infd), opts, 0);
+ }
+ return process;
+}
+\f
+/* A version of request_sigio suitable for a record_unwind_protect. */
+
+Lisp_Object
+unwind_request_sigio (dummy)
+ Lisp_Object dummy;
+{
+ if (interrupt_input)
+ request_sigio ();
+ return Qnil;
+}
+
+/* Create a network stream/datagram client/server process. Treated
+ exactly like a normal process when reading and writing. Primary
+ differences are in status display and process deletion. A network
+ connection has no PID; you cannot signal it. All you can do is
+ stop/continue it and deactivate/close it via delete-process */
+
+DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
+ 0, MANY, 0,
+ doc: /* Create and return a network server or client process.
+
+In Emacs, network connections are represented by process objects, so
+input and output work as for subprocesses and `delete-process' closes
+a network connection. However, a network process has no process id,
+it cannot be signalled, and the status codes are different from normal
+processes.
+
+Arguments are specified as keyword/argument pairs. The following
+arguments are defined:
+
+:name NAME -- NAME is name for process. It is modified if necessary
+to make it unique.
+
+:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
+with the process. Process output goes at end of that buffer, unless
+you specify an output stream or filter function to handle the output.
+BUFFER may be also nil, meaning that this process is not associated
+with any buffer.
+
+:host HOST -- HOST is name of the host to connect to, or its IP
+address. The symbol `local' specifies the local host. If specified
+for a server process, it must be a valid name or address for the local
+host, and only clients connecting to that address will be accepted.
+
+:service SERVICE -- SERVICE is name of the service desired, or an
+integer specifying a port number to connect to. If SERVICE is t,
+a random port number is selected for the server.
+
+:type TYPE -- TYPE is the type of connection. The default (nil) is a
+stream type connection, `datagram' creates a datagram type connection.
+
+:family FAMILY -- FAMILY is the address (and protocol) family for the
+service specified by HOST and SERVICE. The default address family is
+Inet (or IPv4) for the host and port number specified by HOST and
+SERVICE. Other address families supported are:
+ local -- for a local (i.e. UNIX) address specified by SERVICE.
+
+:local ADDRESS -- ADDRESS is the local address used for the connection.
+This parameter is ignored when opening a client process. When specified
+for a server process, the FAMILY, HOST and SERVICE args are ignored.
+
+:remote ADDRESS -- ADDRESS is the remote partner's address for the
+connection. This parameter is ignored when opening a stream server
+process. For a datagram server process, it specifies the initial
+setting of the remote datagram address. When specified for a client
+process, the FAMILY, HOST, and SERVICE args are ignored.
+
+The format of ADDRESS depends on the address family:
+- An IPv4 address is represented as an vector of integers [A B C D P]
+corresponding to numeric IP address A.B.C.D and port number P.
+- A local address is represented as a string with the address in the
+local address space.
+- An "unsupported family" address is represented by a cons (F . AV)
+where F is the family number and AV is a vector containing the socket
+address data with one element per address data byte. Do not rely on
+this format in portable code, as it may depend on implementation
+defined constants, data sizes, and data structure alignment.
+
+:coding CODING -- CODING is coding system for this process.
+
+:options OPTIONS -- Set the specified options for the network process.
+See `set-network-process-options' for details.
+
+:nowait BOOL -- If BOOL is non-nil for a stream type client process,
+return without waiting for the connection to complete; instead, the
+sentinel function will be called with second arg matching "open" (if
+successful) or "failed" when the connect completes. Default is to use
+a blocking connect (i.e. wait) for stream type connections.
+
+:noquery BOOL -- Query the user unless BOOL is non-nil, and process is
+running when emacs is exited.
+
+:stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
+In the stopped state, a server process does not accept new
+connections, and a client process does not handle incoming traffic.
+The stopped state is cleared by `continue-process' and set by
+`stop-process'.
+
+:filter FILTER -- Install FILTER as the process filter.
+
+:filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
+process filter are multibyte, otherwise they are unibyte.
+If this keyword is not specified, the strings are multibyte iff
+`default-enable-multibyte-characters' is non-nil.
+
+:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
+
+:log LOG -- Install LOG as the server process log function. This
+function is called when the server accepts a network connection from a
+client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
+is the server process, CLIENT is the new process for the connection,
+and MESSAGE is a string.
+
+:plist PLIST -- Install PLIST as the new process' initial plist.
+
+:server BOOL -- if BOOL is non-nil, create a server process for the
+specified FAMILY, SERVICE, and connection type (stream or datagram).
+Default is a client process.
+
+A server process will listen for and accept connections from
+clients. When a client connection is accepted, a new network process
+is created for the connection with the following parameters:
+- The client's process name is constructed by concatenating the server
+process' NAME and a client identification string.
+- If the FILTER argument is non-nil, the client process will not get a
+separate process buffer; otherwise, the client's process buffer is a newly
+created buffer named after the server process' BUFFER name or process
+NAME concatenated with the client identification string.
+- The connection type and the process filter and sentinel parameters are
+inherited from the server process' TYPE, FILTER and SENTINEL.
+- The client process' contact info is set according to the client's
+addressing information (typically an IP address and a port number).
+- The client process' plist is initialized from the server's plist.
+
+Notice that the FILTER and SENTINEL args are never used directly by
+the server process. Also, the BUFFER argument is not used directly by
+the server process, but via the optional :log function, accepted (and
+failed) connections may be logged in the server process' buffer.
+
+The original argument list, modified with the actual connection
+information, is available via the `process-contact' function.
+
+usage: (make-network-process &rest ARGS) */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object proc;
+ Lisp_Object contact;
+ struct Lisp_Process *p;
+#ifdef HAVE_GETADDRINFO
+ struct addrinfo ai, *res, *lres;
+ struct addrinfo hints;
+ char *portstring, portbuf[128];
+#else /* HAVE_GETADDRINFO */
+ struct _emacs_addrinfo
+ {
+ int ai_family;
+ int ai_socktype;
+ int ai_protocol;
+ int ai_addrlen;
+ struct sockaddr *ai_addr;
+ struct _emacs_addrinfo *ai_next;
+ } ai, *res, *lres;
+#endif /* HAVE_GETADDRINFO */
+ struct sockaddr_in address_in;
+#ifdef HAVE_LOCAL_SOCKETS
+ struct sockaddr_un address_un;
+#endif
+ int port;
+ int ret = 0;
+ int xerrno = 0;
+ int s = -1, outch, inch;
+ struct gcpro gcpro1;
+ int retry = 0;
+ int count = SPECPDL_INDEX ();
+ int count1;
+ Lisp_Object QCaddress; /* one of QClocal or QCremote */
+ Lisp_Object tem;
+ Lisp_Object name, buffer, host, service, address;
+ Lisp_Object filter, sentinel;
+ int is_non_blocking_client = 0;
+ int is_server = 0;
+ int socktype;
+ int family = -1;
+
+ if (nargs == 0)
+ return Qnil;
+
+ /* Save arguments for process-contact and clone-process. */
+ contact = Flist (nargs, args);
+ GCPRO1 (contact);
+
+#ifdef WINDOWSNT
+ /* Ensure socket support is loaded if available. */
+ init_winsock (TRUE);
+#endif
+
+ /* :type TYPE (nil: stream, datagram */
+ tem = Fplist_get (contact, QCtype);
+ if (NILP (tem))
+ socktype = SOCK_STREAM;
+#ifdef DATAGRAM_SOCKETS
+ else if (EQ (tem, Qdatagram))
+ socktype = SOCK_DGRAM;
+#endif
+ else
+ error ("Unsupported connection type");
+
+ /* :server BOOL */
+ tem = Fplist_get (contact, QCserver);
+ if (!NILP (tem))
+ {
+ /* Don't support network sockets when non-blocking mode is
+ not available, since a blocked Emacs is not useful. */
+#if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
+ error ("Network servers not supported");
+#else
+ is_server = 1;
+#endif
+ }
+
+ /* Make QCaddress an alias for :local (server) or :remote (client). */
+ QCaddress = is_server ? QClocal : QCremote;
+
+ /* :wait BOOL */
+ if (!is_server && socktype == SOCK_STREAM
+ && (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
+ {
+#ifndef NON_BLOCKING_CONNECT
+ error ("Non-blocking connect not supported");
+#else
+ is_non_blocking_client = 1;
+#endif
+ }
+
+ name = Fplist_get (contact, QCname);
+ buffer = Fplist_get (contact, QCbuffer);
+ filter = Fplist_get (contact, QCfilter);
+ sentinel = Fplist_get (contact, QCsentinel);
+
+ CHECK_STRING (name);
+
+#ifdef TERM
+ /* Let's handle TERM before things get complicated ... */
+ host = Fplist_get (contact, QChost);
+ CHECK_STRING (host);
+
+ service = Fplist_get (contact, QCservice);
+ if (INTEGERP (service))
+ port = htons ((unsigned short) XINT (service));
+ else
+ {
+ struct servent *svc_info;
+ CHECK_STRING (service);
+ svc_info = getservbyname (SDATA (service), "tcp");
+ if (svc_info == 0)
+ error ("Unknown service: %s", SDATA (service));
+ port = svc_info->s_port;
}
- freeaddrinfo (res);
+ s = connect_server (0);
if (s < 0)
+ report_file_error ("error creating socket", Fcons (name, Qnil));
+ send_command (s, C_PORT, 0, "%s:%d", SDATA (host), ntohs (port));
+ send_command (s, C_DUMB, 1, 0);
+
+#else /* not TERM */
+
+ /* Initialize addrinfo structure in case we don't use getaddrinfo. */
+ ai.ai_socktype = socktype;
+ ai.ai_protocol = 0;
+ ai.ai_next = NULL;
+ res = &ai;
+
+ /* :local ADDRESS or :remote ADDRESS */
+ address = Fplist_get (contact, QCaddress);
+ if (!NILP (address))
{
- if (interrupt_input)
- request_sigio ();
+ host = service = Qnil;
+
+ if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family)))
+ error ("Malformed :address");
+ ai.ai_family = family;
+ ai.ai_addr = alloca (ai.ai_addrlen);
+ conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen);
+ goto open_socket;
+ }
- errno = xerrno;
- report_file_error ("connection failed",
- Fcons (host, Fcons (name, Qnil)));
+ /* :family FAMILY -- nil (for Inet), local, or integer. */
+ tem = Fplist_get (contact, QCfamily);
+ if (INTEGERP (tem))
+ family = XINT (tem);
+ else
+ {
+ if (NILP (tem))
+ family = AF_INET;
+#ifdef HAVE_LOCAL_SOCKETS
+ else if (EQ (tem, Qlocal))
+ family = AF_LOCAL;
+#endif
}
-
-#else /* not HAVE_GETADDRINFO */
+ if (family < 0)
+ error ("Unknown address family");
+ ai.ai_family = family;
- while (1)
+ /* :service SERVICE -- string, integer (port number), or t (random port). */
+ service = Fplist_get (contact, QCservice);
+
+#ifdef HAVE_LOCAL_SOCKETS
+ if (family == AF_LOCAL)
{
-#if 0
-#ifdef TRY_AGAIN
- h_errno = 0;
+ /* Host is not used. */
+ host = Qnil;
+ CHECK_STRING (service);
+ bzero (&address_un, sizeof address_un);
+ address_un.sun_family = AF_LOCAL;
+ strncpy (address_un.sun_path, SDATA (service), sizeof address_un.sun_path);
+ ai.ai_addr = (struct sockaddr *) &address_un;
+ ai.ai_addrlen = sizeof address_un;
+ goto open_socket;
+ }
#endif
+
+ /* :host HOST -- hostname, ip address, or 'local for localhost. */
+ host = Fplist_get (contact, QChost);
+ if (!NILP (host))
+ {
+ if (EQ (host, Qlocal))
+ host = build_string ("localhost");
+ CHECK_STRING (host);
+ }
+
+ /* Slow down polling to every ten seconds.
+ Some kernels have a bug which causes retrying connect to fail
+ after a connect. Polling can interfere with gethostbyname too. */
+#ifdef POLL_FOR_INPUT
+ if (socktype == SOCK_STREAM)
+ {
+ record_unwind_protect (unwind_stop_other_atimers, Qnil);
+ bind_polling_period (10);
+ }
#endif
+
+#ifdef HAVE_GETADDRINFO
+ /* If we have a host, use getaddrinfo to resolve both host and service.
+ Otherwise, use getservbyname to lookup the service. */
+ if (!NILP (host))
+ {
+
+ /* SERVICE can either be a string or int.
+ Convert to a C string for later use by getaddrinfo. */
+ if (EQ (service, Qt))
+ portstring = "0";
+ else if (INTEGERP (service))
+ {
+ sprintf (portbuf, "%ld", (long) XINT (service));
+ portstring = portbuf;
+ }
+ else
+ {
+ CHECK_STRING (service);
+ portstring = SDATA (service);
+ }
+
immediate_quit = 1;
QUIT;
- host_info_ptr = gethostbyname (XSTRING (host)->data);
- immediate_quit = 0;
-#if 0
-#ifdef TRY_AGAIN
- if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN))
-#endif
+ memset (&hints, 0, sizeof (hints));
+ hints.ai_flags = 0;
+ hints.ai_family = NILP (Fplist_member (contact, QCfamily)) ? AF_UNSPEC : family;
+ hints.ai_socktype = socktype;
+ hints.ai_protocol = 0;
+ ret = getaddrinfo (SDATA (host), portstring, &hints, &res);
+ if (ret)
+#ifdef HAVE_GAI_STRERROR
+ error ("%s/%s %s", SDATA (host), portstring, gai_strerror(ret));
+#else
+ error ("%s/%s getaddrinfo error %d", SDATA (host), portstring, ret);
#endif
- break;
- Fsleep_for (make_number (1), Qnil);
+ immediate_quit = 0;
+
+ goto open_socket;
}
-
- if (host_info_ptr == 0)
- /* Attempt to interpret host as numeric inet address */
+#endif /* HAVE_GETADDRINFO */
+
+ /* We end up here if getaddrinfo is not defined, or in case no hostname
+ has been specified (e.g. for a local server process). */
+
+ if (EQ (service, Qt))
+ port = 0;
+ else if (INTEGERP (service))
+ port = htons ((unsigned short) XINT (service));
+ else
{
- numeric_addr = inet_addr ((char *) XSTRING (host)->data);
- if (NUMERIC_ADDR_ERROR)
- error ("Unknown host \"%s\"", XSTRING (host)->data);
-
- host_info_ptr = &host_info;
- host_info.h_name = 0;
- host_info.h_aliases = 0;
- host_info.h_addrtype = AF_INET;
-#ifdef h_addr
- /* Older machines have only one address slot called h_addr.
- Newer machines have h_addr_list, but #define h_addr to
- be its first element. */
- host_info.h_addr_list = &(addr_list[0]);
-#endif
- host_info.h_addr = (char*)(&numeric_addr);
- addr_list[1] = 0;
- /* numeric_addr isn't null-terminated; it has fixed length. */
- host_info.h_length = sizeof (numeric_addr);
+ struct servent *svc_info;
+ CHECK_STRING (service);
+ svc_info = getservbyname (SDATA (service),
+ (socktype == SOCK_DGRAM ? "udp" : "tcp"));
+ if (svc_info == 0)
+ error ("Unknown service: %s", SDATA (service));
+ port = svc_info->s_port;
}
- bzero (&address, sizeof address);
- bcopy (host_info_ptr->h_addr, (char *) &address.sin_addr,
- host_info_ptr->h_length);
- address.sin_family = host_info_ptr->h_addrtype;
- address.sin_port = port;
+ bzero (&address_in, sizeof address_in);
+ address_in.sin_family = family;
+ address_in.sin_addr.s_addr = INADDR_ANY;
+ address_in.sin_port = port;
- s = socket (host_info_ptr->h_addrtype, SOCK_STREAM, 0);
- if (s < 0)
- report_file_error ("error creating socket", Fcons (name, Qnil));
+#ifndef HAVE_GETADDRINFO
+ if (!NILP (host))
+ {
+ struct hostent *host_info_ptr;
+
+ /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
+ as it may `hang' emacs for a very long time. */
+ immediate_quit = 1;
+ QUIT;
+ host_info_ptr = gethostbyname (SDATA (host));
+ immediate_quit = 0;
+
+ if (host_info_ptr)
+ {
+ bcopy (host_info_ptr->h_addr, (char *) &address_in.sin_addr,
+ host_info_ptr->h_length);
+ family = host_info_ptr->h_addrtype;
+ address_in.sin_family = family;
+ }
+ else
+ /* Attempt to interpret host as numeric inet address */
+ {
+ IN_ADDR numeric_addr;
+ numeric_addr = inet_addr ((char *) SDATA (host));
+ if (NUMERIC_ADDR_ERROR)
+ error ("Unknown host \"%s\"", SDATA (host));
+
+ bcopy ((char *)&numeric_addr, (char *) &address_in.sin_addr,
+ sizeof (address_in.sin_addr));
+ }
- count1 = specpdl_ptr - specpdl;
- record_unwind_protect (close_file_unwind, make_number (s));
+ }
+#endif /* not HAVE_GETADDRINFO */
+
+ ai.ai_family = family;
+ ai.ai_addr = (struct sockaddr *) &address_in;
+ ai.ai_addrlen = sizeof address_in;
+
+ open_socket:
/* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
when connect is interrupted. So let's not let it get interrupted.
when not interrupt_input, and thus not normally used on the systems
which have this bug. On systems which use polling, there's no way
to quit if polling is turned off. */
- if (interrupt_input)
- unrequest_sigio ();
-
- loop:
+ if (interrupt_input
+ && !is_server && socktype == SOCK_STREAM)
+ {
+ /* Comment from KFS: The original open-network-stream code
+ didn't unwind protect this, but it seems like the proper
+ thing to do. In any case, I don't see how it could harm to
+ do this -- and it makes cleanup (using unbind_to) easier. */
+ record_unwind_protect (unwind_request_sigio, Qnil);
+ unrequest_sigio ();
+ }
- immediate_quit = 1;
- QUIT;
+ /* Do this in case we never enter the for-loop below. */
+ count1 = SPECPDL_INDEX ();
+ s = -1;
- if (connect (s, (struct sockaddr *) &address, sizeof address) == -1
- && errno != EISCONN)
+ for (lres = res; lres; lres = lres->ai_next)
{
- int xerrno = errno;
+ s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
+ if (s < 0)
+ {
+ xerrno = errno;
+ continue;
+ }
+
+#ifdef DATAGRAM_SOCKETS
+ if (!is_server && socktype == SOCK_DGRAM)
+ break;
+#endif /* DATAGRAM_SOCKETS */
+
+#ifdef NON_BLOCKING_CONNECT
+ if (is_non_blocking_client)
+ {
+#ifdef O_NONBLOCK
+ ret = fcntl (s, F_SETFL, O_NONBLOCK);
+#else
+ ret = fcntl (s, F_SETFL, O_NDELAY);
+#endif
+ if (ret < 0)
+ {
+ xerrno = errno;
+ emacs_close (s);
+ s = -1;
+ continue;
+ }
+ }
+#endif
+
+ /* Make us close S if quit. */
+ record_unwind_protect (close_file_unwind, make_number (s));
+
+ if (is_server)
+ {
+ /* Configure as a server socket. */
+#ifdef HAVE_LOCAL_SOCKETS
+ if (family != AF_LOCAL)
+#endif
+ {
+ int optval = 1;
+ if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
+ report_file_error ("Cannot set reuse option on server socket.", Qnil);
+ }
+
+ if (bind (s, lres->ai_addr, lres->ai_addrlen))
+ report_file_error ("Cannot bind server socket", Qnil);
+
+#ifdef HAVE_GETSOCKNAME
+ if (EQ (service, Qt))
+ {
+ struct sockaddr_in sa1;
+ int len1 = sizeof (sa1);
+ if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
+ {
+ ((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port;
+ service = make_number (ntohs (sa1.sin_port));
+ contact = Fplist_put (contact, QCservice, service);
+ }
+ }
+#endif
+
+ if (socktype == SOCK_STREAM && listen (s, 5))
+ report_file_error ("Cannot listen on server socket", Qnil);
+
+ break;
+ }
+
+ retry_connect:
+
+ immediate_quit = 1;
+ QUIT;
+
+ /* This turns off all alarm-based interrupts; the
+ bind_polling_period call above doesn't always turn all the
+ short-interval ones off, especially if interrupt_input is
+ set.
+
+ It'd be nice to be able to control the connect timeout
+ though. Would non-blocking connect calls be portable?
+
+ This used to be conditioned by HAVE_GETADDRINFO. Why? */
+
+ turn_on_atimers (0);
+
+ ret = connect (s, lres->ai_addr, lres->ai_addrlen);
+ xerrno = errno;
+
+ turn_on_atimers (1);
+
+ if (ret == 0 || xerrno == EISCONN)
+ {
+ /* The unwind-protect will be discarded afterwards.
+ Likewise for immediate_quit. */
+ break;
+ }
+
+#ifdef NON_BLOCKING_CONNECT
+#ifdef EINPROGRESS
+ if (is_non_blocking_client && xerrno == EINPROGRESS)
+ break;
+#else
+#ifdef EWOULDBLOCK
+ if (is_non_blocking_client && xerrno == EWOULDBLOCK)
+ break;
+#endif
+#endif
+#endif
immediate_quit = 0;
- if (errno == EINTR)
- goto loop;
- if (errno == EADDRINUSE && retry < 20)
+ if (xerrno == EINTR)
+ goto retry_connect;
+ if (xerrno == EADDRINUSE && retry < 20)
{
/* A delay here is needed on some FreeBSD systems,
and it is harmless, since this retrying takes time anyway
and should be infrequent. */
Fsleep_for (make_number (1), Qnil);
retry++;
- goto loop;
+ goto retry_connect;
}
- /* Discard the unwind protect. */
+ /* Discard the unwind protect closing S. */
specpdl_ptr = specpdl + count1;
-
emacs_close (s);
+ s = -1;
+ }
- if (interrupt_input)
- request_sigio ();
-
- errno = xerrno;
- report_file_error ("connection failed",
- Fcons (host, Fcons (name, Qnil)));
+ if (s >= 0)
+ {
+#ifdef DATAGRAM_SOCKETS
+ if (socktype == SOCK_DGRAM)
+ {
+ if (datagram_address[s].sa)
+ abort ();
+ datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen);
+ datagram_address[s].len = lres->ai_addrlen;
+ if (is_server)
+ {
+ Lisp_Object remote;
+ bzero (datagram_address[s].sa, lres->ai_addrlen);
+ if (remote = Fplist_get (contact, QCremote), !NILP (remote))
+ {
+ int rfamily, rlen;
+ rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
+ if (rfamily == lres->ai_family && rlen == lres->ai_addrlen)
+ conv_lisp_to_sockaddr (rfamily, remote,
+ datagram_address[s].sa, rlen);
+ }
+ }
+ else
+ bcopy (lres->ai_addr, datagram_address[s].sa, lres->ai_addrlen);
+ }
+#endif
+ contact = Fplist_put (contact, QCaddress,
+ conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
+#ifdef HAVE_GETSOCKNAME
+ if (!is_server)
+ {
+ struct sockaddr_in sa1;
+ int len1 = sizeof (sa1);
+ if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
+ contact = Fplist_put (contact, QClocal,
+ conv_sockaddr_to_lisp (&sa1, len1));
+ }
+#endif
}
-
-#endif /* not HAVE_GETADDRINFO */
+
+#ifdef HAVE_GETADDRINFO
+ if (res != &ai)
+ freeaddrinfo (res);
+#endif
immediate_quit = 0;
- /* Discard the unwind protect, if any. */
+ /* Discard the unwind protect for closing S, if any. */
specpdl_ptr = specpdl + count1;
-#ifdef POLL_FOR_INPUT
+ /* Unwind bind_polling_period and request_sigio. */
unbind_to (count, Qnil);
-#endif
-
- if (interrupt_input)
- request_sigio ();
-#else /* TERM */
- s = connect_server (0);
if (s < 0)
- report_file_error ("error creating socket", Fcons (name, Qnil));
- send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port));
- send_command (s, C_DUMB, 1, 0);
-#endif /* TERM */
+ {
+ /* If non-blocking got this far - and failed - assume non-blocking is
+ not supported after all. This is probably a wrong assumption, but
+ the normal blocking calls to open-network-stream handles this error
+ better. */
+ if (is_non_blocking_client)
+ return Qnil;
+
+ errno = xerrno;
+ if (is_server)
+ report_file_error ("make server process failed", contact);
+ else
+ report_file_error ("make client process failed", contact);
+ }
+
+ tem = Fplist_get (contact, QCoptions);
+ if (!NILP (tem))
+ set_socket_options (s, tem, 1);
+
+#endif /* not TERM */
inch = s;
outch = s;
#endif
#endif
- XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil));
- XPROCESS (proc)->command_channel_p = Qnil;
- XPROCESS (proc)->buffer = buffer;
- XPROCESS (proc)->sentinel = Qnil;
- XPROCESS (proc)->filter = Qnil;
- XPROCESS (proc)->command = Qnil;
- XPROCESS (proc)->pid = Qnil;
- XSETINT (XPROCESS (proc)->infd, inch);
- XSETINT (XPROCESS (proc)->outfd, outch);
- XPROCESS (proc)->status = Qrun;
- FD_SET (inch, &input_wait_mask);
- FD_SET (inch, &non_keyboard_wait_mask);
+ p = XPROCESS (proc);
+
+ p->childp = contact;
+ p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
+
+ p->buffer = buffer;
+ p->sentinel = sentinel;
+ p->filter = filter;
+ p->filter_multibyte = buffer_defaults.enable_multibyte_characters;
+ /* Override the above only if :filter-multibyte is specified. */
+ if (! NILP (Fplist_member (contact, QCfilter_multibyte)))
+ p->filter_multibyte = Fplist_get (contact, QCfilter_multibyte);
+ p->log = Fplist_get (contact, QClog);
+ if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
+ p->kill_without_query = Qt;
+ if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
+ p->command = Qt;
+ p->pid = Qnil;
+ XSETINT (p->infd, inch);
+ XSETINT (p->outfd, outch);
+ if (is_server && socktype == SOCK_STREAM)
+ p->status = Qlisten;
+
+#ifdef NON_BLOCKING_CONNECT
+ if (is_non_blocking_client)
+ {
+ /* We may get here if connect did succeed immediately. However,
+ in that case, we still need to signal this like a non-blocking
+ connection. */
+ p->status = Qconnect;
+ if (!FD_ISSET (inch, &connect_wait_mask))
+ {
+ FD_SET (inch, &connect_wait_mask);
+ num_pending_connects++;
+ }
+ }
+ else
+#endif
+ /* A server may have a client filter setting of Qt, but it must
+ still listen for incoming connects unless it is stopped. */
+ if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
+ || (EQ (p->status, Qlisten) && NILP (p->command)))
+ {
+ FD_SET (inch, &input_wait_mask);
+ FD_SET (inch, &non_keyboard_wait_mask);
+ }
+
if (inch > max_process_desc)
max_process_desc = inch;
+ tem = Fplist_member (contact, QCcoding);
+ if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
+ tem = Qnil; /* No error message (too late!). */
+
{
/* Setup coding systems for communicating with the network stream. */
struct gcpro gcpro1;
Lisp_Object coding_systems = Qt;
Lisp_Object args[5], val;
- if (!NILP (Vcoding_system_for_read))
+ if (!NILP (tem))
+ val = XCAR (XCDR (tem));
+ else if (!NILP (Vcoding_system_for_read))
val = Vcoding_system_for_read;
else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
|| (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
val = Qnil;
else
{
- args[0] = Qopen_network_stream, args[1] = name,
- args[2] = buffer, args[3] = host, args[4] = service;
- GCPRO1 (proc);
- coding_systems = Ffind_operation_coding_system (5, args);
- UNGCPRO;
+ if (NILP (host) || NILP (service))
+ coding_systems = Qnil;
+ else
+ {
+ args[0] = Qopen_network_stream, args[1] = name,
+ args[2] = buffer, args[3] = host, args[4] = service;
+ GCPRO1 (proc);
+ coding_systems = Ffind_operation_coding_system (5, args);
+ UNGCPRO;
+ }
if (CONSP (coding_systems))
val = XCAR (coding_systems);
else if (CONSP (Vdefault_process_coding_system))
else
val = Qnil;
}
- XPROCESS (proc)->decode_coding_system = val;
+ p->decode_coding_system = val;
- if (!NILP (Vcoding_system_for_write))
+ if (!NILP (tem))
+ val = XCAR (XCDR (tem));
+ else if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
else if (NILP (current_buffer->enable_multibyte_characters))
val = Qnil;
{
if (EQ (coding_systems, Qt))
{
- args[0] = Qopen_network_stream, args[1] = name,
- args[2] = buffer, args[3] = host, args[4] = service;
- GCPRO1 (proc);
- coding_systems = Ffind_operation_coding_system (5, args);
- UNGCPRO;
+ if (NILP (host) || NILP (service))
+ coding_systems = Qnil;
+ else
+ {
+ args[0] = Qopen_network_stream, args[1] = name,
+ args[2] = buffer, args[3] = host, args[4] = service;
+ GCPRO1 (proc);
+ coding_systems = Ffind_operation_coding_system (5, args);
+ UNGCPRO;
+ }
}
if (CONSP (coding_systems))
val = XCDR (coding_systems);
else
val = Qnil;
}
- XPROCESS (proc)->encode_coding_system = val;
+ p->encode_coding_system = val;
}
+ setup_process_coding_systems (proc);
- if (!proc_decode_coding_system[inch])
- proc_decode_coding_system[inch]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (XPROCESS (proc)->decode_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 (XPROCESS (proc)->encode_coding_system,
- proc_encode_coding_system[outch]);
-
- XPROCESS (proc)->decoding_buf = make_uninit_string (0);
- XPROCESS (proc)->decoding_carryover = make_number (0);
- XPROCESS (proc)->encoding_buf = make_uninit_string (0);
- XPROCESS (proc)->encoding_carryover = make_number (0);
+ p->decoding_buf = make_uninit_string (0);
+ p->decoding_carryover = make_number (0);
+ p->encoding_buf = make_uninit_string (0);
+ p->encoding_carryover = make_number (0);
- XPROCESS (proc)->inherit_coding_system_flag
- = (NILP (buffer) || !inherit_process_coding_system
+ p->inherit_coding_system_flag
+ = (!NILP (tem) || NILP (buffer) || !inherit_process_coding_system
? Qnil : Qt);
UNGCPRO;
XSETINT (p->infd, -1);
XSETINT (p->outfd, -1);
+#ifdef DATAGRAM_SOCKETS
+ if (DATAGRAM_CHAN_P (inchannel))
+ {
+ xfree (datagram_address[inchannel].sa);
+ datagram_address[inchannel].sa = 0;
+ datagram_address[inchannel].len = 0;
+ }
+#endif
chan_process[inchannel] = Qnil;
FD_CLR (inchannel, &input_wait_mask);
FD_CLR (inchannel, &non_keyboard_wait_mask);
+ if (FD_ISSET (inchannel, &connect_wait_mask))
+ {
+ FD_CLR (inchannel, &connect_wait_mask);
+ if (--num_pending_connects < 0)
+ abort ();
+ }
if (inchannel == max_process_desc)
{
int i;
seconds = -1;
}
else
- {
- if (NILP (process))
- seconds = -1;
- else
- seconds = 0;
- }
+ seconds = NILP (process) ? -1 : 0;
if (NILP (process))
XSETFASTINT (process, 0);
? Qt : Qnil);
}
+/* Accept a connection for server process SERVER on CHANNEL. */
+
+static int connect_counter = 0;
+
+static void
+server_accept_connection (server, channel)
+ Lisp_Object server;
+ int channel;
+{
+ Lisp_Object proc, caller, name, buffer;
+ Lisp_Object contact, host, service;
+ struct Lisp_Process *ps= XPROCESS (server);
+ struct Lisp_Process *p;
+ int s;
+ union u_sockaddr {
+ struct sockaddr sa;
+ struct sockaddr_in in;
+#ifdef HAVE_LOCAL_SOCKETS
+ struct sockaddr_un un;
+#endif
+ } saddr;
+ int len = sizeof saddr;
+
+ s = accept (channel, &saddr.sa, &len);
+
+ if (s < 0)
+ {
+ int code = errno;
+
+ if (code == EAGAIN)
+ return;
+#ifdef EWOULDBLOCK
+ if (code == EWOULDBLOCK)
+ return;
+#endif
+
+ if (!NILP (ps->log))
+ call3 (ps->log, server, Qnil,
+ concat3 (build_string ("accept failed with code"),
+ Fnumber_to_string (make_number (code)),
+ build_string ("\n")));
+ return;
+ }
+
+ connect_counter++;
+
+ /* Setup a new process to handle the connection. */
+
+ /* Generate a unique identification of the caller, and build contact
+ information for this process. */
+ host = Qt;
+ service = Qnil;
+ switch (saddr.sa.sa_family)
+ {
+ case AF_INET:
+ {
+ Lisp_Object args[5];
+ unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
+ args[0] = build_string ("%d.%d.%d.%d");
+ args[1] = make_number (*ip++);
+ args[2] = make_number (*ip++);
+ args[3] = make_number (*ip++);
+ args[4] = make_number (*ip++);
+ host = Fformat (5, args);
+ service = make_number (ntohs (saddr.in.sin_port));
+
+ args[0] = build_string (" <%s:%d>");
+ args[1] = host;
+ args[2] = service;
+ caller = Fformat (3, args);
+ }
+ break;
+
+#ifdef HAVE_LOCAL_SOCKETS
+ case AF_LOCAL:
+#endif
+ default:
+ caller = Fnumber_to_string (make_number (connect_counter));
+ caller = concat3 (build_string (" <*"), caller, build_string ("*>"));
+ break;
+ }
+
+ /* Create a new buffer name for this process if it doesn't have a
+ filter. The new buffer name is based on the buffer name or
+ process name of the server process concatenated with the caller
+ identification. */
+
+ if (!NILP (ps->filter) && !EQ (ps->filter, Qt))
+ buffer = Qnil;
+ else
+ {
+ buffer = ps->buffer;
+ if (!NILP (buffer))
+ buffer = Fbuffer_name (buffer);
+ else
+ buffer = ps->name;
+ if (!NILP (buffer))
+ {
+ buffer = concat2 (buffer, caller);
+ buffer = Fget_buffer_create (buffer);
+ }
+ }
+
+ /* Generate a unique name for the new server process. Combine the
+ server process name with the caller identification. */
+
+ name = concat2 (ps->name, caller);
+ proc = make_process (name);
+
+ chan_process[s] = proc;
+
+#ifdef O_NONBLOCK
+ fcntl (s, F_SETFL, O_NONBLOCK);
+#else
+#ifdef O_NDELAY
+ fcntl (s, F_SETFL, O_NDELAY);
+#endif
+#endif
+
+ p = XPROCESS (proc);
+
+ /* Build new contact information for this setup. */
+ contact = Fcopy_sequence (ps->childp);
+ contact = Fplist_put (contact, QCserver, Qnil);
+ contact = Fplist_put (contact, QChost, host);
+ if (!NILP (service))
+ contact = Fplist_put (contact, QCservice, service);
+ contact = Fplist_put (contact, QCremote,
+ conv_sockaddr_to_lisp (&saddr.sa, len));
+#ifdef HAVE_GETSOCKNAME
+ len = sizeof saddr;
+ if (getsockname (s, &saddr.sa, &len) == 0)
+ contact = Fplist_put (contact, QClocal,
+ conv_sockaddr_to_lisp (&saddr.sa, len));
+#endif
+
+ p->childp = contact;
+ p->plist = Fcopy_sequence (ps->plist);
+
+ p->buffer = buffer;
+ p->sentinel = ps->sentinel;
+ p->filter = ps->filter;
+ p->command = Qnil;
+ p->pid = Qnil;
+ XSETINT (p->infd, s);
+ XSETINT (p->outfd, s);
+ p->status = Qrun;
+
+ /* Client processes for accepted connections are not stopped initially. */
+ if (!EQ (p->filter, Qt))
+ {
+ FD_SET (s, &input_wait_mask);
+ FD_SET (s, &non_keyboard_wait_mask);
+ }
+
+ if (s > max_process_desc)
+ max_process_desc = s;
+
+ /* Setup coding system for new process based on server process.
+ This seems to be the proper thing to do, as the coding system
+ of the new process should reflect the settings at the time the
+ server socket was opened; not the current settings. */
+
+ p->decode_coding_system = ps->decode_coding_system;
+ p->encode_coding_system = ps->encode_coding_system;
+ setup_process_coding_systems (proc);
+
+ p->decoding_buf = make_uninit_string (0);
+ p->decoding_carryover = make_number (0);
+ p->encoding_buf = make_uninit_string (0);
+ p->encoding_carryover = make_number (0);
+
+ p->inherit_coding_system_flag
+ = (NILP (buffer) ? Qnil : ps->inherit_coding_system_flag);
+
+ if (!NILP (ps->log))
+ call3 (ps->log, server, proc,
+ concat3 (build_string ("accept from "),
+ (STRINGP (host) ? host : build_string ("-")),
+ build_string ("\n")));
+
+ if (!NILP (p->sentinel))
+ exec_sentinel (proc,
+ concat3 (build_string ("open from "),
+ (STRINGP (host) ? host : build_string ("-")),
+ build_string ("\n")));
+}
+
/* This variable is different from waiting_for_input in keyboard.c.
It is used to communicate to a lisp process-filter/sentinel (via the
function Fwaiting_for_user_input_p below) whether emacs was waiting
{
register int channel, nfds;
static SELECT_TYPE Available;
+ static SELECT_TYPE Connecting;
+ int check_connect, no_avail;
int xerrno;
Lisp_Object proc;
EMACS_TIME timeout, end_time;
- SELECT_TYPE Atemp;
int wait_channel = -1;
struct Lisp_Process *wait_proc = 0;
int got_some_input = 0;
Lisp_Object wait_for_cell = Qnil;
FD_ZERO (&Available);
+ FD_ZERO (&Connecting);
/* If read_kbd is a process to watch, set wait_proc and wait_channel
accordingly. */
EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
EMACS_ADD_TIME (end_time, end_time, timeout);
}
-#ifdef hpux
+#ifdef POLL_INTERRUPTED_SYS_CALL
/* AlainF 5-Jul-1996
HP-UX 10.10 seem to have problems with signals coming in
Causes "poll: interrupted system call" messages when Emacs is run
in an X window
- Turn off periodic alarms (in case they are in use) */
+ Turn off periodic alarms (in case they are in use),
+ and then turn off any other atimers. */
+ stop_polling ();
turn_on_atimers (0);
-#endif
+#endif /* POLL_INTERRUPTED_SYS_CALL */
while (1)
{
{
int old_timers_run = timers_run;
struct buffer *old_buffer = current_buffer;
-
+
timer_delay = timer_check (1);
/* If a timer has run, this might have changed buffers
&& old_buffer != current_buffer
&& waiting_for_user_input_p == -1)
record_asynch_buffer_change ();
-
+
if (timers_run != old_timers_run && do_display)
/* We must retry, since a timer may have requeued itself
and that could alter the time_delay. */
timeout to get our attention. */
if (update_tick != process_tick && do_display)
{
+ SELECT_TYPE Atemp, Ctemp;
+
Atemp = input_wait_mask;
+#ifdef MAC_OSX
+ /* On Mac OS X, the SELECT system call always says input is
+ present (for reading) at stdin, even when none is. This
+ causes the call to SELECT below to return 1 and
+ status_notify not to be called. As a result output of
+ subprocesses are incorrectly discarded. */
+ FD_CLR (0, &Atemp);
+#endif
+ Ctemp = connect_wait_mask;
EMACS_SET_SECS_USECS (timeout, 0, 0);
if ((select (max (max_process_desc, max_keyboard_desc) + 1,
- &Atemp, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
- &timeout)
+ &Atemp,
+ (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0),
+ (SELECT_TYPE *)0, &timeout)
<= 0))
{
/* It's okay for us to do this and then continue with
}
}
- /* Don't wait for output from a non-running process. */
+ /* Don't wait for output from a non-running process. Just
+ read whatever data has already been received. */
if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
update_status (wait_proc);
if (wait_proc != 0
- && ! EQ (wait_proc->status, Qrun))
+ && ! EQ (wait_proc->status, Qrun)
+ && ! EQ (wait_proc->status, Qconnect))
{
int nread, total_nread = 0;
if (nread == 0)
break;
- if (0 < nread)
+ if (0 < nread)
total_nread += nread;
#ifdef EIO
else if (nread == -1 && EIO == errno)
/* Wait till there is something to do */
if (!NILP (wait_for_cell))
- Available = non_process_wait_mask;
- else if (! XINT (read_kbd))
- Available = non_keyboard_wait_mask;
+ {
+ Available = non_process_wait_mask;
+ check_connect = 0;
+ }
else
- Available = input_wait_mask;
+ {
+ if (! XINT (read_kbd))
+ Available = non_keyboard_wait_mask;
+ else
+ Available = input_wait_mask;
+ check_connect = (num_pending_connects > 0);
+ }
/* If frame size has changed or the window is newly mapped,
redisplay now, before we start to wait. There is a race
set_waiting_for_input (&timeout);
}
+ no_avail = 0;
if (XINT (read_kbd) && detect_input_pending ())
{
nfds = 0;
- FD_ZERO (&Available);
+ no_avail = 1;
}
else
- nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
- &Available, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
- &timeout);
+ {
+ if (check_connect)
+ Connecting = connect_wait_mask;
+ nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
+ &Available,
+ (check_connect ? &Connecting : (SELECT_TYPE *)0),
+ (SELECT_TYPE *)0, &timeout);
+ }
xerrno = errno;
if (nfds < 0)
{
if (xerrno == EINTR)
- FD_ZERO (&Available);
+ no_avail = 1;
#ifdef ultrix
/* Ultrix select seems to return ENOMEM when it is
interrupted. Treat it just like EINTR. Bleah. Note
"__ultrix__"; the latter is only defined under GCC, but
not by DEC's bundled CC. -JimB */
else if (xerrno == ENOMEM)
- FD_ZERO (&Available);
+ no_avail = 1;
#endif
#ifdef ALLIANT
/* This happens for no known reason on ALLIANT.
I am guessing that this is the right response. -- RMS. */
else if (xerrno == EFAULT)
- FD_ZERO (&Available);
+ no_avail = 1;
#endif
else if (xerrno == EBADF)
{
So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
in m/ibmrt-aix.h), and here we just ignore the select error.
Cleanup occurs c/o status_notify after SIGCLD. */
- FD_ZERO (&Available); /* Cannot depend on values returned */
+ no_avail = 1; /* Cannot depend on values returned */
#else
abort ();
#endif
else
error ("select error: %s", emacs_strerror (xerrno));
}
+
+ if (no_avail)
+ {
+ FD_ZERO (&Available);
+ check_connect = 0;
+ }
+
#if defined(sun) && !defined(USG5_4)
- else if (nfds > 0 && keyboard_bit_set (&Available)
- && interrupt_input)
+ if (nfds > 0 && keyboard_bit_set (&Available)
+ && interrupt_input)
/* System sometimes fails to deliver SIGIO.
David J. Mackenzie says that Emacs doesn't compile under
int old_timers_run = timers_run;
struct buffer *old_buffer = current_buffer;
int leave = 0;
-
+
if (detect_input_pending_run_timers (do_display))
{
swallow_events (do_display);
if (leave)
break;
- }
-
+ }
+
/* If there is unread keyboard input, also return. */
if (XINT (read_kbd) != 0
&& requeued_events_pending_p ())
but select says there is input. */
if (XINT (read_kbd) && interrupt_input
- && keyboard_bit_set (&Available))
+ && keyboard_bit_set (&Available) && ! noninteractive)
kill (getpid (), SIGIO);
#endif
do_pending_window_change (0);
/* Check for data from a process. */
+ if (no_avail || nfds == 0)
+ continue;
+
/* Really FIRST_PROC_DESC should be 0 on Unix,
but this is safer in the short run. */
for (channel = 0; channel <= max_process_desc; channel++)
if (NILP (proc))
continue;
+ /* If this is a server stream socket, accept connection. */
+ if (EQ (XPROCESS (proc)->status, Qlisten))
+ {
+ server_accept_connection (proc, channel);
+ continue;
+ }
+
/* Read data from the process, starting with our
buffered-ahead character if we have one. */
= Fcons (Qexit, Fcons (make_number (256), Qnil));
}
}
+#ifdef NON_BLOCKING_CONNECT
+ if (check_connect && FD_ISSET (channel, &Connecting))
+ {
+ struct Lisp_Process *p;
+
+ FD_CLR (channel, &connect_wait_mask);
+ if (--num_pending_connects < 0)
+ abort ();
+
+ proc = chan_process[channel];
+ if (NILP (proc))
+ continue;
+
+ p = XPROCESS (proc);
+
+#ifdef GNU_LINUX
+ /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
+ So only use it on systems where it is known to work. */
+ {
+ int xlen = sizeof(xerrno);
+ if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
+ xerrno = errno;
+ }
+#else
+ {
+ struct sockaddr pname;
+ int pnamelen = sizeof(pname);
+
+ /* If connection failed, getpeername will fail. */
+ xerrno = 0;
+ if (getpeername(channel, &pname, &pnamelen) < 0)
+ {
+ /* Obtain connect failure code through error slippage. */
+ char dummy;
+ xerrno = errno;
+ if (errno == ENOTCONN && read(channel, &dummy, 1) < 0)
+ xerrno = errno;
+ }
+ }
+#endif
+ if (xerrno)
+ {
+ XSETINT (p->tick, ++process_tick);
+ p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil));
+ deactivate_process (proc);
+ }
+ else
+ {
+ p->status = Qrun;
+ /* Execute the sentinel here. If we had relied on
+ status_notify to do it later, it will read input
+ from the process before calling the sentinel. */
+ exec_sentinel (proc, build_string ("open\n"));
+ if (!EQ (p->filter, Qt) && !EQ (p->command, Qt))
+ {
+ FD_SET (XINT (p->infd), &input_wait_mask);
+ FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
+ }
+ }
+ }
+#endif /* NON_BLOCKING_CONNECT */
} /* end for each file descriptor */
} /* end while exit conditions not met */
clear_input_pending ();
QUIT;
}
-#ifdef hpux
+#ifdef POLL_INTERRUPTED_SYS_CALL
/* AlainF 5-Jul-1996
HP-UX 10.10 seems to have problems with signals coming in
Causes "poll: interrupted system call" messages when Emacs is run
in an X window
Turn periodic alarms back on */
start_polling ();
-#endif
+#endif /* POLL_INTERRUPTED_SYS_CALL */
return got_some_input;
}
Lisp_Object proc;
register int channel;
{
-- register int nchars, nbytes;
++ register int nbytes;
char *chars;
register Lisp_Object outstream;
register struct buffer *old = current_buffer;
register int opoint;
struct coding_system *coding = proc_decode_coding_system[channel];
int carryover = XINT (p->decoding_carryover);
+ int readmax = 1024;
#ifdef VMS
VMS_PROC_STUFF *vs, *get_vms_process_pointer();
the tail of decoding buffer) should be prepended to the new
data read to decode all together. */
chars = (char *) alloca (nbytes + carryover);
- bcopy (XSTRING (p->decoding_buf)->data, buf, carryover);
+ bcopy (SDATA (p->decoding_buf), buf, carryover);
bcopy (vs->inputBuffer, chars + carryover, nbytes);
}
#else /* not VMS */
- chars = (char *) alloca (carryover + 1024);
+
+#ifdef DATAGRAM_SOCKETS
+ /* A datagram is one packet; allow at least 1500+ bytes of data
+ corresponding to the typical Ethernet frame size. */
+ if (DATAGRAM_CHAN_P (channel))
+ {
+ /* carryover = 0; */ /* Does carryover make sense for datagrams? */
+ readmax += 1024;
+ }
+#endif
+
+ chars = (char *) alloca (carryover + readmax);
if (carryover)
/* See the comment above. */
- bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
+ bcopy (SDATA (p->decoding_buf), chars, carryover);
+#ifdef DATAGRAM_SOCKETS
+ /* We have a working select, so proc_buffered_char is always -1. */
+ if (DATAGRAM_CHAN_P (channel))
+ {
+ int len = datagram_address[channel].len;
+ nbytes = recvfrom (channel, chars + carryover, readmax - carryover,
+ 0, datagram_address[channel].sa, &len);
+ }
+ else
+#endif
if (proc_buffered_char[channel] < 0)
- nbytes = emacs_read (channel, chars + carryover, 1024 - carryover);
+ nbytes = emacs_read (channel, chars + carryover, readmax - carryover);
else
{
chars[carryover] = proc_buffered_char[channel];
proc_buffered_char[channel] = -1;
- nbytes = emacs_read (channel, chars + carryover + 1, 1023 - carryover);
+ nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1 - carryover);
if (nbytes < 0)
nbytes = 1;
else
outstream = p->filter;
if (!NILP (outstream))
{
- /* We inhibit quit here instead of just catching it so that
+ /* We inhibit quit here instead of just catching it so that
hitting ^G when a filter happens to be running won't screw
it up. */
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
Lisp_Object odeactivate;
Lisp_Object obuffer, okeymap;
Lisp_Object text;
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;
- if (NILP (buffer_defaults.enable_multibyte_characters))
- /* We had better return unibyte string. */
- text = string_make_unibyte (text);
-
+ 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[XINT (p->outfd)])
{
- p->encode_coding_system = coding->symbol;
- setup_coding_system (coding->symbol,
+ p->encode_coding_system = Vlast_coding_system_used;
+ setup_coding_system (p->encode_coding_system,
proc_encode_coding_system[XINT (p->outfd)]);
}
}
- carryover = nbytes - coding->consumed;
- bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
- carryover);
- XSETINT (p->decoding_carryover, carryover);
+ if (coding->carryover_bytes > 0)
+ {
- bcopy (coding->carryover, XSTRING (p->decoding_buf)->data,
++ bcopy (coding->carryover, SDATA (p->decoding_buf),
+ coding->carryover_bytes);
+ XSETINT (p->decoding_carryover, coding->carryover_bytes);
+ }
- nbytes = STRING_BYTES (XSTRING (text));
- nchars = XSTRING (text)->size;
- if (nbytes > 0)
+ /* Adjust the multibyteness of TEXT to that of the filter. */
+ if (NILP (p->filter_multibyte) != ! STRING_MULTIBYTE (text))
+ text = (STRING_MULTIBYTE (text)
+ ? Fstring_as_unibyte (text)
+ : Fstring_to_multibyte (text));
+ if (SBYTES (text) > 0)
internal_condition_case_1 (read_process_output_call,
Fcons (outstream,
Fcons (proc, Fcons (text, Qnil))),
start_vms_process_read (vs);
#endif
unbind_to (count, Qnil);
- return nchars;
+ return nbytes;
}
/* If no filter, write into buffer if it isn't dead. */
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[XINT (p->outfd)])
{
- p->encode_coding_system = coding->symbol;
- setup_coding_system (coding->symbol,
+ p->encode_coding_system = Vlast_coding_system_used;
+ setup_coding_system (p->encode_coding_system,
proc_encode_coding_system[XINT (p->outfd)]);
}
}
- carryover = nbytes - coding->consumed;
- bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
- carryover);
- XSETINT (p->decoding_carryover, carryover);
+ if (coding->carryover_bytes > 0)
+ {
- bcopy (coding->carryover, XSTRING (p->decoding_buf)->data,
++ bcopy (coding->carryover, SDATA (p->decoding_buf),
+ coding->carryover_bytes);
+ XSETINT (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))
text = (STRING_MULTIBYTE (text)
? Fstring_as_unibyte (text)
- : Fstring_as_multibyte (text));
- nbytes = STRING_BYTES (XSTRING (text));
- nchars = XSTRING (text)->size;
+ : Fstring_to_multibyte (text));
/* Insert before markers in case we are inserting where
the buffer's mark is, and the user's next command is Meta-y. */
- insert_from_string_before_markers (text, 0, 0, nchars, nbytes, 0);
+ insert_from_string_before_markers (text, 0, 0,
+ SCHARS (text), SBYTES (text), 0);
/* Make sure the process marker's position is valid when the
process buffer is changed in the signal_after_change above.
update_status (XPROCESS (proc));
if (! EQ (XPROCESS (proc)->status, Qrun))
error ("Process %s not running",
- XSTRING (XPROCESS (proc)->name)->data);
+ SDATA (XPROCESS (proc)->name));
if (XINT (XPROCESS (proc)->outfd) < 0)
error ("Output file descriptor of %s is closed",
- XSTRING (XPROCESS (proc)->name)->data);
+ SDATA (XPROCESS (proc)->name));
coding = proc_encode_coding_system[XINT (XPROCESS (proc)->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, XPROCESS (proc)->encode_coding_system))
+ if (!EQ (Vlast_coding_system_used,
+ XPROCESS (proc)->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 (XPROCESS (proc)->encode_coding_system, coding);
- /* 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;
++ coding->mode &= CODING_MODE_LAST_BLOCK;
}
coding->src_multibyte = 0;
- setup_raw_text_coding_system (coding);
+ setup_coding_system (raw_text_coding_system
+ (Vlast_coding_system_used),
+ 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;
- unsigned char *temp_buf = NULL;
-
+ 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 (XPROCESS (proc)->encoding_buf) < require)
- XPROCESS (proc)->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 = XPROCESS (proc)->encoding_buf;
- encode_coding (coding, (char *) buf, SDATA (object),
- len, SBYTES (object));
len = coding->produced;
- buf = SDATA (object);
- if (temp_buf)
- xfree (temp_buf);
- buf = XSTRING (coding->dst_object)->data;
++ buf = SDATA (coding->dst_object);
}
#ifdef VMS
/* Send this batch, using one or more write calls. */
while (this > 0)
{
+ int outfd = XINT (XPROCESS (proc)->outfd);
old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
- rv = emacs_write (XINT (XPROCESS (proc)->outfd),
- (char *) buf, this);
+#ifdef DATAGRAM_SOCKETS
+ if (DATAGRAM_CHAN_P (outfd))
+ {
+ rv = sendto (outfd, (char *) buf, this,
+ 0, datagram_address[outfd].sa,
+ datagram_address[outfd].len);
+ if (rv < 0 && errno == EMSGSIZE)
+ report_file_error ("sending datagram", Fcons (proc, Qnil));
+ }
+ else
+#endif
+ rv = emacs_write (outfd, (char *) buf, this);
signal (SIGPIPE, old_sigpipe);
if (rv < 0)
|| errno == EAGAIN
#endif
)
- /* Buffer is full. Wait, accepting input;
+ /* Buffer is full. Wait, accepting input;
that may allow the program
to finish doing output and read more. */
{
the terminal is set up that way which it is
here). The same bytes will be seen again in a
later read(2), without the CRs. */
-
+
if (errno == EAGAIN)
{
int flags = FWRITE;
&flags);
}
#endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
-
+
/* Running filters might relocate buffers or strings.
Arrange to relocate BUF. */
if (BUFFERP (object))
offset = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
else if (STRINGP (object))
- offset = buf - XSTRING (object)->data;
+ offset = buf - SDATA (object);
XSETFASTINT (zero, 0);
#ifdef EMACS_HAS_USECS
if (BUFFERP (object))
buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset);
else if (STRINGP (object))
- buf = offset + XSTRING (object)->data;
+ buf = offset + SDATA (object);
rv = 0;
}
XSETINT (XPROCESS (proc)->tick, ++process_tick);
deactivate_process (proc);
#ifdef VMS
- error ("Error writing to process %s; closed it",
- XSTRING (XPROCESS (proc)->name)->data);
+ error ("Error writing to process %s; closed it",
+ SDATA (XPROCESS (proc)->name));
#else
error ("SIGPIPE raised on process %s; closed it",
- XSTRING (XPROCESS (proc)->name)->data);
+ SDATA (XPROCESS (proc)->name));
#endif
}
Lisp_Object proc;
CHECK_STRING (string);
proc = get_process (process);
- send_process (proc, XSTRING (string)->data,
- STRING_BYTES (XSTRING (string)), string);
+ send_process (proc, SDATA (string),
+ SBYTES (string), string);
return Qnil;
}
\f
+/* Return the foreground process group for the tty/pty that
+ the process P uses. */
+static int
+emacs_get_tty_pgrp (p)
+ struct Lisp_Process *p;
+{
+ int gid = -1;
+
+#ifdef TIOCGPGRP
+ if (ioctl (XINT (p->infd), TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
+ {
+ int fd;
+ /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
+ master side. Try the slave side. */
+ fd = emacs_open (XSTRING (p->tty_name)->data, O_RDONLY, 0);
+
+ if (fd != -1)
+ {
+ ioctl (fd, TIOCGPGRP, &gid);
+ emacs_close (fd);
+ }
+ }
+#endif /* defined (TIOCGPGRP ) */
+
+ return gid;
+}
+
DEFUN ("process-running-child-p", Fprocess_running_child_p,
Sprocess_running_child_p, 0, 1, 0,
doc: /* Return t if PROCESS has given the terminal to a child.
{
/* Initialize in case ioctl doesn't exist or gives an error,
in a way that will cause returning t. */
- int gid = 0;
+ int gid;
Lisp_Object proc;
struct Lisp_Process *p;
if (!EQ (p->childp, Qt))
error ("Process %s is not a subprocess",
- XSTRING (p->name)->data);
+ SDATA (p->name));
if (XINT (p->infd) < 0)
error ("Process %s is not active",
- XSTRING (p->name)->data);
+ SDATA (p->name));
-#ifdef TIOCGPGRP
- if (!NILP (p->subtty))
- ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
- else
- ioctl (XINT (p->infd), TIOCGPGRP, &gid);
-#endif /* defined (TIOCGPGRP ) */
+ gid = emacs_get_tty_pgrp (p);
if (gid == XFASTINT (p->pid))
return Qnil;
if (!EQ (p->childp, Qt))
error ("Process %s is not a subprocess",
- XSTRING (p->name)->data);
+ SDATA (p->name));
if (XINT (p->infd) < 0)
error ("Process %s is not active",
- XSTRING (p->name)->data);
+ SDATA (p->name));
if (NILP (p->pty_flag))
current_group = Qnil;
/* If we are using pgrps, get a pgrp number and make it negative. */
- if (!NILP (current_group))
+ if (NILP (current_group))
+ /* Send the signal to the shell's process group. */
+ gid = XFASTINT (p->pid);
+ else
{
#ifdef SIGNALS_VIA_CHARACTERS
/* If possible, send signals to the entire pgrp
#endif /* ! defined (TCGETA) */
#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
#endif /* ! defined HAVE_TERMIOS */
-#endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
+ abort ();
+ /* The code above always returns from the function. */
+#endif /* defined (SIGNALS_VIA_CHARACTERS) */
-#ifdef TIOCGPGRP
- /* Get the pgrp using the tty itself, if we have that.
+#ifdef TIOCGPGRP
+ /* Get the current pgrp using the tty itself, if we have that.
Otherwise, use the pty to get the pgrp.
On pfa systems, saka@pfu.fujitsu.co.JP writes:
"TIOCGPGRP symbol defined in sys/ioctl.h at E50.
But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
His patch indicates that if TIOCGPGRP returns an error, then
we should just assume that p->pid is also the process group id. */
- {
- int err;
- if (!NILP (p->subtty))
- err = ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
- else
- err = ioctl (XINT (p->infd), TIOCGPGRP, &gid);
+ gid = emacs_get_tty_pgrp (p);
+
+ if (gid == -1)
+ /* If we can't get the information, assume
+ the shell owns the tty. */
+ gid = XFASTINT (p->pid);
-#ifdef pfa
- if (err == -1)
- gid = - XFASTINT (p->pid);
-#endif /* ! defined (pfa) */
- }
+ /* It is not clear whether anything really can set GID to -1.
+ Perhaps on some system one of those ioctls can or could do so.
+ Or perhaps this is vestigial. */
if (gid == -1)
no_pgrp = 1;
- else
- gid = - gid;
#else /* ! defined (TIOCGPGRP ) */
/* Can't select pgrps on this system, so we know that
the child itself heads the pgrp. */
- gid = - XFASTINT (p->pid);
+ gid = XFASTINT (p->pid);
#endif /* ! defined (TIOCGPGRP ) */
/* If current_group is lambda, and the shell owns the terminal,
don't send any signal. */
- if (EQ (current_group, Qlambda) && gid == - XFASTINT (p->pid))
+ if (EQ (current_group, Qlambda) && gid == XFASTINT (p->pid))
return;
}
- else
- gid = - XFASTINT (p->pid);
switch (signo)
{
/* gid may be a pid, or minus a pgrp's number */
#ifdef TIOCSIGSEND
if (!NILP (current_group))
- ioctl (XINT (p->infd), TIOCSIGSEND, signo);
+ {
+ if (ioctl (XINT (p->infd), TIOCSIGSEND, signo) == -1)
+ EMACS_KILLPG (gid, signo);
+ }
else
{
gid = - XFASTINT (p->pid);
kill (gid, signo);
}
#else /* ! defined (TIOCSIGSEND) */
- EMACS_KILLPG (-gid, signo);
+ EMACS_KILLPG (gid, signo);
#endif /* ! defined (TIOCSIGSEND) */
}
DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
doc: /* Stop process PROCESS. May be process or name of one.
-See function `interrupt-process' for more details on usage. */)
+See function `interrupt-process' for more details on usage.
+If PROCESS is a network process, inhibit handling of incoming traffic. */)
(process, current_group)
Lisp_Object process, current_group;
{
+#ifdef HAVE_SOCKETS
+ if (PROCESSP (process) && NETCONN_P (process))
+ {
+ struct Lisp_Process *p;
+
+ p = XPROCESS (process);
+ if (NILP (p->command)
+ && XINT (p->infd) >= 0)
+ {
+ FD_CLR (XINT (p->infd), &input_wait_mask);
+ FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
+ }
+ p->command = Qt;
+ return process;
+ }
+#endif
#ifndef SIGTSTP
error ("no SIGTSTP support");
#else
DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
doc: /* Continue process PROCESS. May be process or name of one.
-See function `interrupt-process' for more details on usage. */)
+See function `interrupt-process' for more details on usage.
+If PROCESS is a network process, resume handling of incoming traffic. */)
(process, current_group)
Lisp_Object process, current_group;
{
+#ifdef HAVE_SOCKETS
+ if (PROCESSP (process) && NETCONN_P (process))
+ {
+ struct Lisp_Process *p;
+
+ p = XPROCESS (process);
+ if (EQ (p->command, Qt)
+ && XINT (p->infd) >= 0
+ && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
+ {
+ FD_SET (XINT (p->infd), &input_wait_mask);
+ FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
+ }
+ p->command = Qnil;
+ return process;
+ }
+#endif
#ifdef SIGCONT
process_send_signal (process, SIGCONT, current_group, 0);
#else
}
DEFUN ("signal-process", Fsignal_process, Ssignal_process,
- 2, 2, "nProcess number: \nnSignal code: ",
- doc: /* Send the process with process id PID the signal with code SIGCODE.
-PID must be an integer. The process need not be a child of this Emacs.
+ 2, 2, "sProcess (name or number): \nnSignal code: ",
+ doc: /* Send PROCESS the signal with code SIGCODE.
+PROCESS may also be an integer specifying the process id of the
+process to signal; in this case, the process need not be a child of
+this Emacs.
SIGCODE may be an integer, or a symbol whose name is a signal name. */)
- (pid, sigcode)
- Lisp_Object pid, sigcode;
+ (process, sigcode)
+ Lisp_Object process, sigcode;
{
- CHECK_NUMBER (pid);
+ Lisp_Object pid;
+
+ if (INTEGERP (process))
+ {
+ pid = process;
+ goto got_it;
+ }
+
+ if (STRINGP (process))
+ {
+ Lisp_Object tem;
+ if (tem = Fget_process (process), NILP (tem))
+ {
+ pid = Fstring_to_number (process, make_number (10));
+ if (XINT (pid) != 0)
+ goto got_it;
+ }
+ process = tem;
+ }
+ else
+ process = get_process (process);
+
+ if (NILP (process))
+ return process;
+
+ CHECK_PROCESS (process);
+ pid = XPROCESS (process)->pid;
+ if (!INTEGERP (pid) || XINT (pid) <= 0)
+ error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
+
+ got_it:
#define handle_signal(NAME, VALUE) \
else if (!strcmp (name, NAME)) \
unsigned char *name;
CHECK_SYMBOL (sigcode);
- name = XSYMBOL (sigcode)->name->data;
+ name = SDATA (SYMBOL_NAME (sigcode));
if (0)
;
Lisp_Object proc;
struct coding_system *coding;
+ if (DATAGRAM_CONN_P (process))
+ return process;
+
proc = get_process (process);
coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
if (! NILP (XPROCESS (proc)->raw_status_low))
update_status (XPROCESS (proc));
if (! EQ (XPROCESS (proc)->status, Qrun))
- error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data);
+ error ("Process %s not running", SDATA (XPROCESS (proc)->name));
if (CODING_REQUIRE_FLUSHING (coding))
{
/* On receipt of a signal that a child status has changed, loop asking
about children with changed statuses until the system says there
are no more.
-
+
All we do is change the status; we do not run sentinels or print
notifications. That is saved for the next time keyboard input is
done, in order to avoid timing errors.
#define WUNTRACED 0
#endif /* no WUNTRACED */
/* Keep trying to get a status until we get a definitive result. */
- do
+ do
{
errno = 0;
pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
break;
p = 0;
}
-
+
/* Change the status of the process that was found. */
if (p != 0)
{
union { int i; WAITTYPE wt; } u;
int clear_desc_flag = 0;
-
+
XSETINT (p->tick, ++process_tick);
u.wt = w;
XSETINT (p->raw_status_low, u.i & 0xffff);
XSETINT (p->raw_status_high, u.i >> 16);
-
+
/* If process has terminated, stop waiting for its output. */
if ((WIFSIGNALED (w) || WIFEXITED (w))
&& XINT (p->infd) >= 0)
{
Lisp_Object sentinel, obuffer, odeactivate, okeymap;
register struct Lisp_Process *p = XPROCESS (proc);
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int outer_running_asynch_code = running_asynch_code;
int waiting = waiting_for_user_input_p;
/* Report all recent events of a change in process status
(either run the sentinel or output a message).
- This is done while Emacs is waiting for keyboard input. */
+ This is usually done while Emacs is waiting for keyboard input
+ but can be done at other times. */
void
status_notify ()
/* If process is still active, read any output that remains. */
while (! EQ (p->filter, Qt)
+ && ! EQ (p->status, Qconnect)
+ && ! EQ (p->status, Qlisten)
+ && ! EQ (p->command, Qt) /* Network process not stopped. */
&& XINT (p->infd) >= 0
&& read_process_output (proc, XINT (p->infd)) > 0);
CHECK_PROCESS (proc);
p = XPROCESS (proc);
if (XINT (p->infd) < 0)
- error ("Input file descriptor of %s closed", XSTRING (p->name)->data);
+ error ("Input file descriptor of %s closed", SDATA (p->name));
if (XINT (p->outfd) < 0)
- error ("Output file descriptor of %s closed", XSTRING (p->name)->data);
+ error ("Output file descriptor of %s closed", SDATA (p->name));
+ Fcheck_coding_system (decoding);
+ Fcheck_coding_system (encoding);
- p->decode_coding_system = Fcheck_coding_system (decoding);
- p->encode_coding_system = Fcheck_coding_system (encoding);
- setup_coding_system (decoding,
- proc_decode_coding_system[XINT (p->infd)]);
- setup_coding_system (encoding,
- proc_encode_coding_system[XINT (p->outfd)]);
+ p->decode_coding_system = decoding;
+ p->encode_coding_system = encoding;
+ setup_process_coding_systems (proc);
return Qnil;
}
return Fcons (XPROCESS (proc)->decode_coding_system,
XPROCESS (proc)->encode_coding_system);
}
+
+DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte,
+ Sset_process_filter_multibyte, 2, 2, 0,
+ doc: /* Set multibyteness of the strings given to PROCESS's filter.
+If FLAG is non-nil, the filter is given multibyte strings.
+If FLAG is nil, the filter is given unibyte strings. In this case,
+all character code conversion except for end-of-line conversion is
+suppressed. */)
+ (proc, flag)
+ Lisp_Object proc, flag;
+{
+ register struct Lisp_Process *p;
+
+ CHECK_PROCESS (proc);
+ p = XPROCESS (proc);
+ p->filter_multibyte = flag;
+ setup_process_coding_systems (proc);
+
+ return Qnil;
+}
+
+DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
+ Sprocess_filter_multibyte_p, 1, 1, 0,
+ doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
+ (proc)
+ Lisp_Object proc;
+{
+ register struct Lisp_Process *p;
+
+ CHECK_PROCESS (proc);
+ p = XPROCESS (proc);
+
+ return (NILP (p->filter_multibyte) ? Qnil : Qt);
+}
+
+
\f
/* The first time this is called, assume keyboard input comes from DESC
instead of from where we used to expect it.
}
bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
+#ifdef DATAGRAM_SOCKETS
+ bzero (datagram_address, sizeof datagram_address);
+#endif
+
+#ifdef HAVE_SOCKETS
+ {
+ Lisp_Object subfeatures = Qnil;
+#define ADD_SUBFEATURE(key, val) \
+ subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
+
+#ifdef NON_BLOCKING_CONNECT
+ ADD_SUBFEATURE (QCnowait, Qt);
+#endif
+#ifdef DATAGRAM_SOCKETS
+ ADD_SUBFEATURE (QCtype, Qdatagram);
+#endif
+#ifdef HAVE_LOCAL_SOCKETS
+ ADD_SUBFEATURE (QCfamily, Qlocal);
+#endif
+#ifdef HAVE_GETSOCKNAME
+ ADD_SUBFEATURE (QCservice, Qt);
+#endif
+#if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
+ ADD_SUBFEATURE (QCserver, Qt);
+#endif
+#ifdef SO_BINDTODEVICE
+ ADD_SUBFEATURE (QCoptions, intern ("bindtodevice"));
+#endif
+#ifdef SO_BROADCAST
+ ADD_SUBFEATURE (QCoptions, intern ("broadcast"));
+#endif
+#ifdef SO_DONTROUTE
+ ADD_SUBFEATURE (QCoptions, intern ("dontroute"));
+#endif
+#ifdef SO_KEEPALIVE
+ ADD_SUBFEATURE (QCoptions, intern ("keepalive"));
+#endif
+#ifdef SO_LINGER
+ ADD_SUBFEATURE (QCoptions, intern ("linger"));
+#endif
+#ifdef SO_OOBINLINE
+ ADD_SUBFEATURE (QCoptions, intern ("oobinline"));
+#endif
+#ifdef SO_PRIORITY
+ ADD_SUBFEATURE (QCoptions, intern ("priority"));
+#endif
+#ifdef SO_REUSEADDR
+ ADD_SUBFEATURE (QCoptions, intern ("reuseaddr"));
+#endif
+ Fprovide (intern ("make-network-process"), subfeatures);
+ }
+#endif /* HAVE_SOCKETS */
}
void
staticpro (&Qopen);
Qclosed = intern ("closed");
staticpro (&Qclosed);
+ Qconnect = intern ("connect");
+ staticpro (&Qconnect);
+ Qfailed = intern ("failed");
+ staticpro (&Qfailed);
+ Qlisten = intern ("listen");
+ staticpro (&Qlisten);
+ Qlocal = intern ("local");
+ staticpro (&Qlocal);
+ Qdatagram = intern ("datagram");
+ staticpro (&Qdatagram);
+
+ QCname = intern (":name");
+ staticpro (&QCname);
+ QCbuffer = intern (":buffer");
+ staticpro (&QCbuffer);
+ QChost = intern (":host");
+ staticpro (&QChost);
+ QCservice = intern (":service");
+ staticpro (&QCservice);
+ QCtype = intern (":type");
+ staticpro (&QCtype);
+ QClocal = intern (":local");
+ staticpro (&QClocal);
+ QCremote = intern (":remote");
+ staticpro (&QCremote);
+ QCcoding = intern (":coding");
+ staticpro (&QCcoding);
+ QCserver = intern (":server");
+ staticpro (&QCserver);
+ QCnowait = intern (":nowait");
+ staticpro (&QCnowait);
+ QCsentinel = intern (":sentinel");
+ staticpro (&QCsentinel);
+ QClog = intern (":log");
+ staticpro (&QClog);
+ QCnoquery = intern (":noquery");
+ staticpro (&QCnoquery);
+ QCstop = intern (":stop");
+ staticpro (&QCstop);
+ QCoptions = intern (":options");
+ staticpro (&QCoptions);
+ QCplist = intern (":plist");
+ staticpro (&QCplist);
+ QCfilter_multibyte = intern (":filter-multibyte");
+ staticpro (&QCfilter_multibyte);
Qlast_nonmenu_event = intern ("last-nonmenu-event");
staticpro (&Qlast_nonmenu_event);
defsubr (&Sset_process_window_size);
defsubr (&Sset_process_inherit_coding_system_flag);
defsubr (&Sprocess_inherit_coding_system_flag);
- defsubr (&Sprocess_kill_without_query);
+ defsubr (&Sset_process_query_on_exit_flag);
+ defsubr (&Sprocess_query_on_exit_flag);
defsubr (&Sprocess_contact);
+ defsubr (&Sprocess_plist);
+ defsubr (&Sset_process_plist);
defsubr (&Slist_processes);
defsubr (&Sprocess_list);
defsubr (&Sstart_process);
#ifdef HAVE_SOCKETS
- defsubr (&Sopen_network_stream);
+ defsubr (&Sset_network_process_options);
+ defsubr (&Smake_network_process);
+ defsubr (&Sformat_network_address);
#endif /* HAVE_SOCKETS */
+#ifdef DATAGRAM_SOCKETS
+ defsubr (&Sprocess_datagram_address);
+ defsubr (&Sset_process_datagram_address);
+#endif
defsubr (&Saccept_process_output);
defsubr (&Sprocess_send_region);
defsubr (&Sprocess_send_string);
/* defsubr (&Sprocess_connection); */
defsubr (&Sset_process_coding_system);
defsubr (&Sprocess_coding_system);
+ defsubr (&Sset_process_filter_multibyte);
+ defsubr (&Sprocess_filter_multibyte_p);
}
\f
#include "lisp.h"
#include "systime.h"
- #include "charset.h"
+ #include "character.h"
#include "coding.h"
#include "termopts.h"
#include "sysselect.h"
extern EMACS_TIME timer_check ();
extern int timers_run;
+Lisp_Object QCtype;
+
/* As described above, except assuming that there are no subprocesses:
Wait for timeout to elapse and/or keyboard input to be available.
int xerrno;
/* Either nil or a cons cell, the car of which is of interest and
may be changed outside of this routine. */
- Lisp_Object wait_for_cell = Qnil;
+ Lisp_Object wait_for_cell;
+
+ wait_for_cell = Qnil;
/* If waiting for non-nil in a cell, record where. */
if (CONSP (read_kbd))
}
/* Turn off periodic alarms (in case they are in use)
+ and then turn off any other atimers,
because the select emulator uses alarms. */
+ stop_polling ();
turn_on_atimers (0);
while (1)
void
syms_of_process ()
{
+ QCtype = intern (":type");
+ staticpro (&QCtype);
+
defsubr (&Sget_buffer_process);
defsubr (&Sprocess_inherit_coding_system_flag);
}
#endif
#ifndef BASE_PURESIZE
- #define BASE_PURESIZE (920000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA)
-#define BASE_PURESIZE (900000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA)
++#define BASE_PURESIZE (1100000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA)
#endif
/* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */
#else /* not VIRT_ADDRESS_VARIES, not PNTR_COMPARISON_TYPE */
extern char my_edata[];
-
+
#define PURE_P(obj) \
(XPNTR (obj) < (unsigned int) my_edata)
#pragma alloca
#endif
-#undef _GNU_SOURCE
-#define _GNU_SOURCE
-
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
# define SYNTAX_ENTRY_VIA_PROPERTY
# include "syntax.h"
- # include "charset.h"
+ # include "character.h"
# include "category.h"
# ifdef malloc
# define POS_AS_IN_BUFFER(p) ((p) + (NILP (re_match_object) || BUFFERP (re_match_object)))
# define RE_MULTIBYTE_P(bufp) ((bufp)->multibyte)
+ # define RE_TARGET_MULTIBYTE_P(bufp) ((bufp)->target_multibyte)
# define RE_STRING_CHAR(p, s) \
(multibyte ? (STRING_CHAR (p, s)) : (*(p)))
# define RE_STRING_CHAR_AND_LENGTH(p, s, len) \
(multibyte ? (STRING_CHAR_AND_LENGTH (p, s, len)) : ((len) = 1, *(p)))
- /* Set C a (possibly multibyte) character before P. P points into a
- string which is the virtual concatenation of STR1 (which ends at
- END1) or STR2 (which ends at END2). */
- # define GET_CHAR_BEFORE_2(c, p, str1, end1, str2, end2) \
- do { \
- if (multibyte) \
- { \
- re_char *dtemp = (p) == (str2) ? (end1) : (p); \
- re_char *dlimit = ((p) > (str2) && (p) <= (end2)) ? (str2) : (str1); \
- re_char *d0 = dtemp; \
- PREV_CHAR_BOUNDARY (d0, dlimit); \
- c = STRING_CHAR (d0, dtemp - d0); \
- } \
- else \
- (c = ((p) == (str2) ? (end1) : (p))[-1]); \
+ /* Set C a (possibly converted to multibyte) character before P. P
+ points into a string which is the virtual concatenation of STR1
+ (which ends at END1) or STR2 (which ends at END2). */
+ # define GET_CHAR_BEFORE_2(c, p, str1, end1, str2, end2) \
+ do { \
+ if (multibyte) \
+ { \
+ re_char *dtemp = (p) == (str2) ? (end1) : (p); \
+ re_char *dlimit = ((p) > (str2) && (p) <= (end2)) ? (str2) : (str1); \
+ while (dtemp-- > dlimit && !CHAR_HEAD_P (*dtemp)); \
+ c = STRING_CHAR (dtemp, (p) - dtemp); \
+ } \
+ else \
+ { \
+ (c = ((p) == (str2) ? (end1) : (p))[-1]); \
+ MAKE_CHAR_MULTIBYTE (c); \
+ } \
} while (0)
- } while (0)
-
+ /* Set C a (possibly converted to multibyte) character at P, and set
+ LEN to the byte length of that character. */
+ # define GET_CHAR_AFTER(c, p, len) \
+ do { \
+ if (multibyte) \
+ c = STRING_CHAR_AND_LENGTH (p, 0, len); \
+ else \
+ { \
+ c = *p; \
+ len = 1; \
+ MAKE_CHAR_MULTIBYTE (c); \
+ } \
++ } while (0)
#else /* not emacs */
# define CHARSET_LEADING_CODE_BASE(c) 0
# define MAX_MULTIBYTE_LENGTH 1
# define RE_MULTIBYTE_P(x) 0
+ # define RE_TARGET_MULTIBYTE_P(x) 0
# define WORD_BOUNDARY_P(c1, c2) (0)
# define CHAR_HEAD_P(p) (1)
# define SINGLE_BYTE_CHAR_P(c) (1)
# define SAME_CHARSET_P(c1, c2) (1)
# define MULTIBYTE_FORM_LENGTH(p, s) (1)
+# define PREV_CHAR_BOUNDARY(p, limit) ((p)--)
# define STRING_CHAR(p, s) (*(p))
# define RE_STRING_CHAR STRING_CHAR
# define CHAR_STRING(c, s) (*(s) = (c), 1)
# define RE_STRING_CHAR_AND_LENGTH STRING_CHAR_AND_LENGTH
# define GET_CHAR_BEFORE_2(c, p, str1, end1, str2, end2) \
(c = ((p) == (str2) ? *((end1) - 1) : *((p) - 1)))
+ # define GET_CHAR_AFTER(c, p, len) \
+ (c = *p, len = 1)
# define MAKE_CHAR(charset, c1, c2) (c1)
+ # define BYTE8_TO_CHAR(c) (c)
+ # define CHAR_BYTE8_P(c) (0)
+ # define MAKE_CHAR_MULTIBYTE(c) (c)
+ # define MAKE_CHAR_UNIBYTE(c) (c)
+ # define CHAR_LEADING_CODE(c) (c)
++
#endif /* not emacs */
#ifndef RE_TRANSLATE
# ifdef __GNUC__
# define alloca __builtin_alloca
# else /* not __GNUC__ */
- # if HAVE_ALLOCA_H
+ # ifdef HAVE_ALLOCA_H
# include <alloca.h>
# endif /* HAVE_ALLOCA_H */
# endif /* not __GNUC__ */
if (start == NULL)
{
- printf ("(null)\n");
+ fprintf (stderr, "(null)\n");
return;
}
/* Loop over pattern commands. */
while (p < pend)
{
- printf ("%d:\t", p - start);
+ fprintf (stderr, "%d:\t", p - start);
switch ((re_opcode_t) *p++)
{
case no_op:
- printf ("/no_op");
+ fprintf (stderr, "/no_op");
break;
case succeed:
- printf ("/succeed");
+ fprintf (stderr, "/succeed");
break;
case exactn:
mcnt = *p++;
- printf ("/exactn/%d", mcnt);
+ fprintf (stderr, "/exactn/%d", mcnt);
do
{
- putchar ('/');
- putchar (*p++);
+ fprintf (stderr, "/%c", *p++);
}
while (--mcnt);
break;
case start_memory:
- printf ("/start_memory/%d", *p++);
+ fprintf (stderr, "/start_memory/%d", *p++);
break;
case stop_memory:
- printf ("/stop_memory/%d", *p++);
+ fprintf (stderr, "/stop_memory/%d", *p++);
break;
case duplicate:
- printf ("/duplicate/%d", *p++);
+ fprintf (stderr, "/duplicate/%d", *p++);
break;
case anychar:
- printf ("/anychar");
+ fprintf (stderr, "/anychar");
break;
case charset:
int length = CHARSET_BITMAP_SIZE (p - 1);
int has_range_table = CHARSET_RANGE_TABLE_EXISTS_P (p - 1);
- printf ("/charset [%s",
+ fprintf (stderr, "/charset [%s",
(re_opcode_t) *(p - 1) == charset_not ? "^" : "");
assert (p + *p < pend);
/* Are we starting a range? */
if (last + 1 == c && ! in_range)
{
- putchar ('-');
+ fprintf (stderr, "-");
in_range = 1;
}
/* Have we broken a range? */
else if (last + 1 != c && in_range)
{
- putchar (last);
+ fprintf (stderr, "%c", last);
in_range = 0;
}
if (! in_range)
- putchar (c);
+ fprintf (stderr, "%c", c);
last = c;
}
if (in_range)
- putchar (last);
+ fprintf (stderr, "%c", last);
- putchar (']');
+ fprintf (stderr, "]");
p += 1 + length;
if (has_range_table)
{
int count;
- printf ("has-range-table");
+ fprintf (stderr, "has-range-table");
/* ??? Should print the range table; for now, just skip it. */
p += 2; /* skip range table bits */
break;
case begline:
- printf ("/begline");
+ fprintf (stderr, "/begline");
break;
case endline:
- printf ("/endline");
+ fprintf (stderr, "/endline");
break;
case on_failure_jump:
extract_number_and_incr (&mcnt, &p);
- printf ("/on_failure_jump to %d", p + mcnt - start);
+ fprintf (stderr, "/on_failure_jump to %d", p + mcnt - start);
break;
case on_failure_keep_string_jump:
extract_number_and_incr (&mcnt, &p);
- printf ("/on_failure_keep_string_jump to %d", p + mcnt - start);
+ fprintf (stderr, "/on_failure_keep_string_jump to %d", p + mcnt - start);
break;
case on_failure_jump_nastyloop:
extract_number_and_incr (&mcnt, &p);
- printf ("/on_failure_jump_nastyloop to %d", p + mcnt - start);
+ fprintf (stderr, "/on_failure_jump_nastyloop to %d", p + mcnt - start);
break;
case on_failure_jump_loop:
extract_number_and_incr (&mcnt, &p);
- printf ("/on_failure_jump_loop to %d", p + mcnt - start);
+ fprintf (stderr, "/on_failure_jump_loop to %d", p + mcnt - start);
break;
case on_failure_jump_smart:
extract_number_and_incr (&mcnt, &p);
- printf ("/on_failure_jump_smart to %d", p + mcnt - start);
+ fprintf (stderr, "/on_failure_jump_smart to %d", p + mcnt - start);
break;
case jump:
extract_number_and_incr (&mcnt, &p);
- printf ("/jump to %d", p + mcnt - start);
+ fprintf (stderr, "/jump to %d", p + mcnt - start);
break;
case succeed_n:
extract_number_and_incr (&mcnt, &p);
extract_number_and_incr (&mcnt2, &p);
- printf ("/succeed_n to %d, %d times", p - 2 + mcnt - start, mcnt2);
+ fprintf (stderr, "/succeed_n to %d, %d times", p - 2 + mcnt - start, mcnt2);
break;
case jump_n:
extract_number_and_incr (&mcnt, &p);
extract_number_and_incr (&mcnt2, &p);
- printf ("/jump_n to %d, %d times", p - 2 + mcnt - start, mcnt2);
+ fprintf (stderr, "/jump_n to %d, %d times", p - 2 + mcnt - start, mcnt2);
break;
case set_number_at:
extract_number_and_incr (&mcnt, &p);
extract_number_and_incr (&mcnt2, &p);
- printf ("/set_number_at location %d to %d", p - 2 + mcnt - start, mcnt2);
+ fprintf (stderr, "/set_number_at location %d to %d", p - 2 + mcnt - start, mcnt2);
break;
case wordbound:
- printf ("/wordbound");
+ fprintf (stderr, "/wordbound");
break;
case notwordbound:
- printf ("/notwordbound");
+ fprintf (stderr, "/notwordbound");
break;
case wordbeg:
- printf ("/wordbeg");
+ fprintf (stderr, "/wordbeg");
break;
case wordend:
- printf ("/wordend");
+ fprintf (stderr, "/wordend");
case syntaxspec:
- printf ("/syntaxspec");
+ fprintf (stderr, "/syntaxspec");
mcnt = *p++;
- printf ("/%d", mcnt);
+ fprintf (stderr, "/%d", mcnt);
break;
case notsyntaxspec:
- printf ("/notsyntaxspec");
+ fprintf (stderr, "/notsyntaxspec");
mcnt = *p++;
- printf ("/%d", mcnt);
+ fprintf (stderr, "/%d", mcnt);
break;
# ifdef emacs
case before_dot:
- printf ("/before_dot");
+ fprintf (stderr, "/before_dot");
break;
case at_dot:
- printf ("/at_dot");
+ fprintf (stderr, "/at_dot");
break;
case after_dot:
- printf ("/after_dot");
+ fprintf (stderr, "/after_dot");
break;
case categoryspec:
- printf ("/categoryspec");
+ fprintf (stderr, "/categoryspec");
mcnt = *p++;
- printf ("/%d", mcnt);
+ fprintf (stderr, "/%d", mcnt);
break;
case notcategoryspec:
- printf ("/notcategoryspec");
+ fprintf (stderr, "/notcategoryspec");
mcnt = *p++;
- printf ("/%d", mcnt);
+ fprintf (stderr, "/%d", mcnt);
break;
# endif /* emacs */
case begbuf:
- printf ("/begbuf");
+ fprintf (stderr, "/begbuf");
break;
case endbuf:
- printf ("/endbuf");
+ fprintf (stderr, "/endbuf");
break;
default:
- printf ("?%d", *(p-1));
+ fprintf (stderr, "?%d", *(p-1));
}
- putchar ('\n');
+ fprintf (stderr, "\n");
}
- printf ("%d:\tend of pattern.\n", p - start);
+ fprintf (stderr, "%d:\tend of pattern.\n", p - start);
}
/* Check that we are not stuck in an infinite loop. */
#define CHECK_INFINITE_LOOP(pat_cur, string_place) \
do { \
- int failure = TOP_FAILURE_HANDLE(); \
+ int failure = TOP_FAILURE_HANDLE (); \
/* Check for infinite matching loops */ \
- while (failure > 0 && \
- (FAILURE_STR (failure) == string_place \
- || FAILURE_STR (failure) == NULL)) \
+ while (failure > 0 \
+ && (FAILURE_STR (failure) == string_place \
+ || FAILURE_STR (failure) == NULL)) \
{ \
assert (FAILURE_PAT (failure) >= bufp->buffer \
&& FAILURE_PAT (failure) <= bufp->buffer + bufp->used); \
if (FAILURE_PAT (failure) == pat_cur) \
- goto fail; \
+ { \
+ cycle = 1; \
+ break; \
+ } \
DEBUG_PRINT2 (" Other pattern: %p\n", FAILURE_PAT (failure)); \
failure = NEXT_FAILURE_HANDLE(failure); \
} \
DEBUG_PRINT2 (" Other string: %p\n", FAILURE_STR (failure)); \
} while (0)
-
+
/* Push the information about the state we will need
if we ever fail back to it.
static int analyse_first _RE_ARGS ((re_char *p, re_char *pend,
char *fastmap, const int multibyte));
-/* Fetch the next character in the uncompiled pattern---translating it
- if necessary. */
-#define PATFETCH(c) \
- do { \
- PATFETCH_RAW (c); \
- if (! multibyte) \
- MAKE_CHAR_MULTIBYTE (c); \
- c = TRANSLATE (c); \
- if (! target_multibyte) \
- MAKE_CHAR_UNIBYTE (c); \
- } while (0)
-
/* Fetch the next character in the uncompiled pattern, with no
translation. */
-#define PATFETCH_RAW(c) \
+#define PATFETCH(c) \
do { \
int len; \
if (p == pend) return REG_EEND; \
/* But patterns can have more than `MAX_REGNUM' registers. We just
ignore the excess. */
-typedef unsigned regnum_t;
+typedef int regnum_t;
/* Macros for the compile stack. */
/* The next available element. */
#define COMPILE_STACK_TOP (compile_stack.stack[compile_stack.avail])
-
+/* Explicit quit checking is only used on NTemacs. */
+#if defined WINDOWSNT && defined emacs && defined QUIT
+extern int immediate_quit;
+# define IMMEDIATE_QUIT_CHECK \
+ do { \
+ if (immediate_quit) QUIT; \
+ } while (0)
+#else
+# define IMMEDIATE_QUIT_CHECK ((void)0)
+#endif
+\f
/* Structure to manage work area for range table. */
struct range_table_work_area
{
int bits; /* flag to record character classes */
};
-/* Make sure that WORK_AREA can hold more N multibyte characters. */
-#define EXTEND_RANGE_TABLE_WORK_AREA(work_area, n) \
- do { \
- if (((work_area).used + (n)) * sizeof (int) > (work_area).allocated) \
- { \
- (work_area).allocated += 16 * sizeof (int); \
- if ((work_area).table) \
- (work_area).table \
- = (int *) realloc ((work_area).table, (work_area).allocated); \
- else \
- (work_area).table \
- = (int *) malloc ((work_area).allocated); \
- if ((work_area).table == 0) \
- FREE_STACK_RETURN (REG_ESPACE); \
- } \
+/* Make sure that WORK_AREA can hold more N multibyte characters.
+ This is used only in set_image_of_range and set_image_of_range_1.
+ It expects WORK_AREA to be a pointer.
+ If it can't get the space, it returns from the surrounding function. */
+
+#define EXTEND_RANGE_TABLE(work_area, n) \
+ do { \
- if (((work_area)->used + (n)) * sizeof (int) > (work_area)->allocated) \
++ if (((work_area).used + (n)) * sizeof (int) > (work_area).allocated) \
+ { \
- extend_range_table_work_area (work_area); \
- if ((work_area)->table == 0) \
++ extend_range_table_work_area (&work_area); \
++ if ((work_area).table == 0) \
+ return (REG_ESPACE); \
+ } \
} while (0)
#define SET_RANGE_TABLE_WORK_AREA_BIT(work_area, bit) \
#define BIT_UPPER 0x10
#define BIT_MULTIBYTE 0x20
- /* Set a range START..END to WORK_AREA.
- The range is passed through TRANSLATE, so START and END
- should be untranslated. */
- #define SET_RANGE_TABLE_WORK_AREA(work_area, start, end) \
+ /* Set a range (RANGE_START, RANGE_END) to WORK_AREA. */
+ #define SET_RANGE_TABLE_WORK_AREA(work_area, range_start, range_end) \
do { \
- int tem; \
- tem = set_image_of_range (&work_area, start, end, translate); \
- if (tem > 0) \
- FREE_STACK_RETURN (tem); \
- EXTEND_RANGE_TABLE_WORK_AREA ((work_area), 2); \
++ EXTEND_RANGE_TABLE ((work_area), 2); \
+ (work_area).table[(work_area).used++] = (range_start); \
+ (work_area).table[(work_area).used++] = (range_end); \
} while (0)
/* Free allocated memory for WORK_AREA. */
#define RANGE_TABLE_WORK_USED(work_area) ((work_area).used)
#define RANGE_TABLE_WORK_BITS(work_area) ((work_area).bits)
#define RANGE_TABLE_WORK_ELT(work_area, i) ((work_area).table[i])
-
+\f
/* Set the bit for character C in a list. */
#define SET_LIST_BIT(c) (b[((c)) / BYTEWIDTH] |= 1 << ((c) % BYTEWIDTH))
-/* It is better to implement this jumbo macro by a function, but it's
- not that easy because macros called within it assumes various
- variables being defined. */
+ #ifdef emacs
+
- n = 1; \
++/* Store characters in the rage range C0 to C1 in WORK_AREA while
++ translating them and paying attention to the continuity of
++ translated characters.
++
++ Implementation note: It is better to implement this fairly big
++ macro by a function, but it's not that easy because macros called
++ in this macro assume various local variables already declared. */
+
+ #define SETUP_MULTIBYTE_RANGE(work_area, c0, c1) \
+ do { \
+ re_wchar_t c, t, t_last; \
+ int n; \
+ \
+ c = (c0); \
+ t_last = multibyte ? TRANSLATE (c) : TRANSLATE (MAKE_CHAR_MULTIBYTE (c)); \
+ for (c++, n = 1; c <= (c1); c++, n++) \
+ { \
+ t = multibyte ? TRANSLATE (c) : TRANSLATE (MAKE_CHAR_MULTIBYTE (c)); \
+ if (t_last + n == t) \
+ continue; \
+ SET_RANGE_TABLE_WORK_AREA ((work_area), t_last, t_last + n - 1); \
+ t_last = t; \
-
++ n = 0; \
+ } \
+ if (n > 0) \
+ SET_RANGE_TABLE_WORK_AREA ((work_area), t_last, t_last + n - 1); \
+ } while (0)
+
+ #endif /* emacs */
+
/* Get the next unsigned number in the uncompiled pattern. */
#define GET_UNSIGNED_NUMBER(num) \
do { if (p != pend) \
{ \
PATFETCH (c); \
+ if (c == ' ') \
+ FREE_STACK_RETURN (REG_BADBR); \
while ('0' <= c && c <= '9') \
{ \
+ int prev; \
if (num < 0) \
- num = 0; \
+ num = 0; \
+ prev = num; \
num = num * 10 + c - '0'; \
+ if (num / 10 != prev) \
+ FREE_STACK_RETURN (REG_BADBR); \
if (p == pend) \
- break; \
+ break; \
PATFETCH (c); \
} \
+ if (c == ' ') \
+ FREE_STACK_RETURN (REG_BADBR); \
} \
} while (0)
-
+\f
#if WIDE_CHAR_SUPPORT
/* The GNU C library provides support for user-defined character classes
and the functions from ISO C amendement 1. */
}
}
#endif
+\f
+/* Filling in the work area of a range. */
-/* Explicit quit checking is only used on NTemacs. */
-#if defined WINDOWSNT && defined emacs && defined QUIT
-extern int immediate_quit;
-# define IMMEDIATE_QUIT_CHECK \
- do { \
- if (immediate_quit) QUIT; \
- } while (0)
-#else
-# define IMMEDIATE_QUIT_CHECK ((void)0)
+/* Actually extend the space in WORK_AREA. */
+
+static void
+extend_range_table_work_area (work_area)
+ struct range_table_work_area *work_area;
+{
+ work_area->allocated += 16 * sizeof (int);
+ if (work_area->table)
+ work_area->table
+ = (int *) realloc (work_area->table, work_area->allocated);
+ else
+ work_area->table
+ = (int *) malloc (work_area->allocated);
+}
+
++#if 0
+#ifdef emacs
+
+/* Carefully find the ranges of codes that are equivalent
+ under case conversion to the range start..end when passed through
+ TRANSLATE. Handle the case where non-letters can come in between
+ two upper-case letters (which happens in Latin-1).
+ Also handle the case of groups of more than 2 case-equivalent chars.
+
+ The basic method is to look at consecutive characters and see
+ if they can form a run that can be handled as one.
+
+ Returns -1 if successful, REG_ESPACE if ran out of space. */
+
+static int
+set_image_of_range_1 (work_area, start, end, translate)
+ RE_TRANSLATE_TYPE translate;
+ struct range_table_work_area *work_area;
+ re_wchar_t start, end;
+{
+ /* `one_case' indicates a character, or a run of characters,
+ each of which is an isolate (no case-equivalents).
+ This includes all ASCII non-letters.
+
+ `two_case' indicates a character, or a run of characters,
+ each of which has two case-equivalent forms.
+ This includes all ASCII letters.
+
+ `strange' indicates a character that has more than one
+ case-equivalent. */
+
+ enum case_type {one_case, two_case, strange};
+
+ /* Describe the run that is in progress,
+ which the next character can try to extend.
+ If run_type is strange, that means there really is no run.
+ If run_type is one_case, then run_start...run_end is the run.
+ If run_type is two_case, then the run is run_start...run_end,
+ and the case-equivalents end at run_eqv_end. */
+
+ enum case_type run_type = strange;
+ int run_start, run_end, run_eqv_end;
+
+ Lisp_Object eqv_table;
+
+ if (!RE_TRANSLATE_P (translate))
+ {
+ EXTEND_RANGE_TABLE (work_area, 2);
+ work_area->table[work_area->used++] = (start);
+ work_area->table[work_area->used++] = (end);
+ return -1;
+ }
+
+ eqv_table = XCHAR_TABLE (translate)->extras[2];
+
+ for (; start <= end; start++)
+ {
+ enum case_type this_type;
+ int eqv = RE_TRANSLATE (eqv_table, start);
+ int minchar, maxchar;
+
+ /* Classify this character */
+ if (eqv == start)
+ this_type = one_case;
+ else if (RE_TRANSLATE (eqv_table, eqv) == start)
+ this_type = two_case;
+ else
+ this_type = strange;
+
+ if (start < eqv)
+ minchar = start, maxchar = eqv;
+ else
+ minchar = eqv, maxchar = start;
+
+ /* Can this character extend the run in progress? */
+ if (this_type == strange || this_type != run_type
+ || !(minchar == run_end + 1
+ && (run_type == two_case
+ ? maxchar == run_eqv_end + 1 : 1)))
+ {
+ /* No, end the run.
+ Record each of its equivalent ranges. */
+ if (run_type == one_case)
+ {
+ EXTEND_RANGE_TABLE (work_area, 2);
+ work_area->table[work_area->used++] = run_start;
+ work_area->table[work_area->used++] = run_end;
+ }
+ else if (run_type == two_case)
+ {
+ EXTEND_RANGE_TABLE (work_area, 4);
+ work_area->table[work_area->used++] = run_start;
+ work_area->table[work_area->used++] = run_end;
+ work_area->table[work_area->used++]
+ = RE_TRANSLATE (eqv_table, run_start);
+ work_area->table[work_area->used++]
+ = RE_TRANSLATE (eqv_table, run_end);
+ }
+ run_type = strange;
+ }
+
+ if (this_type == strange)
+ {
+ /* For a strange character, add each of its equivalents, one
+ by one. Don't start a range. */
+ do
+ {
+ EXTEND_RANGE_TABLE (work_area, 2);
+ work_area->table[work_area->used++] = eqv;
+ work_area->table[work_area->used++] = eqv;
+ eqv = RE_TRANSLATE (eqv_table, eqv);
+ }
+ while (eqv != start);
+ }
+
+ /* Add this char to the run, or start a new run. */
+ else if (run_type == strange)
+ {
+ /* Initialize a new range. */
+ run_type = this_type;
+ run_start = start;
+ run_end = start;
+ run_eqv_end = RE_TRANSLATE (eqv_table, run_end);
+ }
+ else
+ {
+ /* Extend a running range. */
+ run_end = minchar;
+ run_eqv_end = RE_TRANSLATE (eqv_table, run_end);
+ }
+ }
+
+ /* If a run is still in progress at the end, finish it now
+ by recording its equivalent ranges. */
+ if (run_type == one_case)
+ {
+ EXTEND_RANGE_TABLE (work_area, 2);
+ work_area->table[work_area->used++] = run_start;
+ work_area->table[work_area->used++] = run_end;
+ }
+ else if (run_type == two_case)
+ {
+ EXTEND_RANGE_TABLE (work_area, 4);
+ work_area->table[work_area->used++] = run_start;
+ work_area->table[work_area->used++] = run_end;
+ work_area->table[work_area->used++]
+ = RE_TRANSLATE (eqv_table, run_start);
+ work_area->table[work_area->used++]
+ = RE_TRANSLATE (eqv_table, run_end);
+ }
+
+ return -1;
+}
+
+#endif /* emacs */
+
+/* Record the the image of the range start..end when passed through
+ TRANSLATE. This is not necessarily TRANSLATE(start)..TRANSLATE(end)
+ and is not even necessarily contiguous.
+ Normally we approximate it with the smallest contiguous range that contains
+ all the chars we need. However, for Latin-1 we go to extra effort
+ to do a better job.
+
+ This function is not called for ASCII ranges.
+
+ Returns -1 if successful, REG_ESPACE if ran out of space. */
+
+static int
+set_image_of_range (work_area, start, end, translate)
+ RE_TRANSLATE_TYPE translate;
+ struct range_table_work_area *work_area;
+ re_wchar_t start, end;
+{
+ re_wchar_t cmin, cmax;
+
+#ifdef emacs
+ /* For Latin-1 ranges, use set_image_of_range_1
+ to get proper handling of ranges that include letters and nonletters.
+ For a range that includes the whole of Latin-1, this is not necessary.
+ For other character sets, we don't bother to get this right. */
+ if (RE_TRANSLATE_P (translate) && start < 04400
+ && !(start < 04200 && end >= 04377))
+ {
+ int newend;
+ int tem;
+ newend = end;
+ if (newend > 04377)
+ newend = 04377;
+ tem = set_image_of_range_1 (work_area, start, newend, translate);
+ if (tem > 0)
+ return tem;
+
+ start = 04400;
+ if (end < 04400)
+ return -1;
+ }
#endif
+
+ EXTEND_RANGE_TABLE (work_area, 2);
+ work_area->table[work_area->used++] = (start);
+ work_area->table[work_area->used++] = (end);
+
+ cmin = -1, cmax = -1;
+
+ if (RE_TRANSLATE_P (translate))
+ {
+ int ch;
+
+ for (ch = start; ch <= end; ch++)
+ {
+ re_wchar_t c = TRANSLATE (ch);
+ if (! (start <= c && c <= end))
+ {
+ if (cmin == -1)
+ cmin = c, cmax = c;
+ else
+ {
+ cmin = MIN (cmin, c);
+ cmax = MAX (cmax, c);
+ }
+ }
+ }
+
+ if (cmin != -1)
+ {
+ EXTEND_RANGE_TABLE (work_area, 2);
+ work_area->table[work_area->used++] = (cmin);
+ work_area->table[work_area->used++] = (cmax);
+ }
+ }
+
+ return -1;
+}
++#endif /* 0 */
\f
#ifndef MATCH_MAY_ALLOCATE
/* If the object matched can contain multibyte characters. */
const boolean multibyte = RE_MULTIBYTE_P (bufp);
- /* If a target can contain multibyte characters. */
++ /* If a target of matching can contain multibyte characters. */
+ const boolean target_multibyte = RE_TARGET_MULTIBYTE_P (bufp);
+
#ifdef DEBUG
debug++;
DEBUG_PRINT1 ("\nCompiling pattern: ");
/* Loop through the uncompiled pattern until we're at the end. */
while (p != pend)
{
- PATFETCH_RAW (c);
+ PATFETCH (c);
switch (c)
{
if (p+1 == pend)
FREE_STACK_RETURN (REG_EESCAPE);
if (p[1] == '+' || p[1] == '?')
- PATFETCH_RAW (c); /* Gobble up the backslash. */
+ PATFETCH (c); /* Gobble up the backslash. */
else
break;
}
else
break;
/* If we get here, we found another repeat character. */
- PATFETCH_RAW (c);
- }
+ PATFETCH (c);
+ }
/* Star, etc. applied to an empty pattern is equivalent
to an empty pattern. */
unsigned int startoffset = 0;
re_opcode_t ofj =
/* Check if the loop can match the empty string. */
- (simple || !analyse_first (laststart, b, NULL, 0)) ?
- on_failure_jump : on_failure_jump_loop;
+ (simple || !analyse_first (laststart, b, NULL, 0))
+ ? on_failure_jump : on_failure_jump_loop;
assert (skip_one_char (laststart) <= b);
-
+
if (!zero_times_ok && simple)
{ /* Since simple * loops can be made faster by using
on_failure_keep_string_jump, we turn simple P+
{
boolean emptyp = analyse_first (laststart, b, NULL, 0);
- /* The non-greedy multiple match looks like a repeat..until:
- we only need a conditional jump at the end of the loop */
+ /* The non-greedy multiple match looks like
+ a repeat..until: we only need a conditional jump
+ at the end of the loop. */
if (emptyp) BUF_PUSH (no_op);
STORE_JUMP (emptyp ? on_failure_jump_nastyloop
: on_failure_jump, b, laststart);
{
/* The repeat...until naturally matches one or more.
To also match zero times, we need to first jump to
- the end of the loop (its conditional jump). */
+ the end of the loop (its conditional jump). */
INSERT_JUMP (jump, laststart, b);
b += 3;
}
if (p == pend) FREE_STACK_RETURN (REG_EBRACK);
- PATFETCH_RAW (c);
+ /* Don't translate yet. The range TRANSLATE(X..Y) cannot
+ always be determined from TRANSLATE(X) and TRANSLATE(Y)
+ So the translation is done later in a loop. Example:
+ (let ((case-fold-search t)) (string-match "[A-_]" "A")) */
+ PATFETCH (c);
/* \ might escape characters inside [...] and [^...]. */
if ((syntax & RE_BACKSLASH_ESCAPE_IN_LISTS) && c == '\\')
{
if (p == pend) FREE_STACK_RETURN (REG_EESCAPE);
- PATFETCH_RAW (c);
+ PATFETCH (c);
escaped_char = true;
}
else
break;
}
- /* What should we do for the character which is
- greater than 0x7F, but not BASE_LEADING_CODE_P?
- XXX */
-
/* See if we're at the beginning of a possible character
class. */
unsigned char str[CHAR_CLASS_MAX_LENGTH + 1];
const unsigned char *class_beg;
- PATFETCH_RAW (c);
+ PATFETCH (c);
c1 = 0;
class_beg = p;
for (;;)
{
- PATFETCH_RAW (c);
+ PATFETCH (c);
if ((c == ':' && *p == ']') || p == pend)
break;
if (c1 < CHAR_CLASS_MAX_LENGTH)
them). */
if (c == ':' && *p == ']')
{
- int ch;
+ re_wchar_t ch;
re_wctype_t cc;
++ int limit;
cc = re_wctype (str);
/* Throw away the ] at the end of the character
class. */
- PATFETCH_RAW (c);
+ PATFETCH (c);
if (p == pend) FREE_STACK_RETURN (REG_EBRACK);
is_digit, is_cntrl, and is_xdigit, since
they can only match ASCII characters. We
don't need to handle them for multibyte.
- They are distinguished by a negative wctype.
- We need this only for Emacs. */
-#ifdef emacs
- SET_RANGE_TABLE_WORK_AREA_BIT (range_table_work,
- re_wctype_to_bit (cc));
-#endif
+ They are distinguished by a negative wctype. */
- if (multibyte)
- SET_RANGE_TABLE_WORK_AREA_BIT (range_table_work,
- re_wctype_to_bit (cc));
- for (ch = 0; ch < 1 << BYTEWIDTH; ++ch)
++ for (ch = 0; ch < 128; ++ch)
++ if (re_iswctype (btowc (ch), cc))
++ {
++ c = TRANSLATE (ch);
++ SET_LIST_BIT (c);
++ }
+
- for (ch = 0; ch < 1 << BYTEWIDTH; ++ch)
++ if (target_multibyte)
+ {
- MAKE_CHAR_MULTIBYTE (ch);
- ch = TRANSLATE (ch);
- if (IS_REAL_ASCII (ch)
- & re_iswctype (btowc (ch), cc))
- SET_LIST_BIT (ch);
++ SET_RANGE_TABLE_WORK_AREA_BIT
++ (range_table_work, re_wctype_to_bit (cc));
++ }
++ else
+ {
- int translated = TRANSLATE (ch);
- if (re_iswctype (btowc (ch), cc))
- SET_LIST_BIT (translated);
++ for (ch = 0; ch < (1 << BYTEWIDTH); ++ch)
++ {
++ c = ch;
++ MAKE_CHAR_MULTIBYTE (c);
++ if (re_iswctype (btowc (c), cc))
++ {
++ c = TRANSLATE (c);
++ MAKE_CHAR_UNIBYTE (c);
++ SET_LIST_BIT (c);
++ }
++ }
}
/* Repeat the loop. */
{
/* Discard the `-'. */
- PATFETCH_RAW (c1);
+ PATFETCH (c1);
/* Fetch the character which ends the range. */
- PATFETCH_RAW (c1);
+ PATFETCH (c1);
-
- if (SINGLE_BYTE_CHAR_P (c))
+ if (c > c1)
{
- if (! SINGLE_BYTE_CHAR_P (c1))
- {
- /* 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 C1 and ending at C1. */
- int charset = CHAR_CHARSET (c1);
- re_wchar_t c2 = MAKE_CHAR (charset, 0, 0);
-
- SET_RANGE_TABLE_WORK_AREA (range_table_work,
- c2, c1);
- c1 = 0377;
- }
+ if (syntax & RE_NO_EMPTY_RANGES)
+ FREE_STACK_RETURN (REG_ERANGE);
+ /* Else, repeat the loop. */
}
- else if (!SAME_CHARSET_P (c, c1))
- FREE_STACK_RETURN (REG_ERANGE);
}
else
+ /* Range from C to C. */
c1 = c;
- /* Set the range ... */
- if (SINGLE_BYTE_CHAR_P (c))
- /* ... into bitmap. */
+
+ #ifndef emacs
+ c = TRANSLATE (c);
+ c1 = TRANSLATE (c1);
++ /* Set the range into bitmap */
++ for (; c <= c1; c++)
++ SET_LIST_BIT (TRANSLATE (c));
+ #else /* not emacs */
+ if (target_multibyte)
{
- re_wchar_t this_char;
- re_wchar_t range_start = c, range_end = c1;
-
- /* If the start is after the end, the range is empty. */
- if (range_start > range_end)
- if (! IS_REAL_ASCII (c1))
++ if (c1 >= 128)
{
- if (syntax & RE_NO_EMPTY_RANGES)
- FREE_STACK_RETURN (REG_ERANGE);
- /* Else, repeat the loop. */
+ re_wchar_t c0 = MAX (c, 128);
+
+ SETUP_MULTIBYTE_RANGE (range_table_work, c0, c1);
- c1 = MIN (127, c1);
++ c1 = 127;
}
- else
++ for (; c <= c1; c++)
++ SET_LIST_BIT (TRANSLATE (c));
+ }
+ else
+ {
- if (multibyte)
++ re_wchar_t c0;
++
++ for (; c <= c1; c++)
{
- for (this_char = range_start; this_char <= range_end;
- this_char++)
- SET_LIST_BIT (TRANSLATE (this_char));
- MAKE_CHAR_UNIBYTE (c);
- MAKE_CHAR_UNIBYTE (c1);
++ c0 = c;
++ if (! multibyte)
++ MAKE_CHAR_MULTIBYTE (c0);
++ c0 = TRANSLATE (c0);
++ MAKE_CHAR_UNIBYTE (c0);
++ SET_LIST_BIT (c0);
}
}
- else
- /* ... into range table. */
- SET_RANGE_TABLE_WORK_AREA (range_table_work, c, c1);
+ #endif /* not emacs */
- /* Set the range into bitmap */
- for (; c <= c1; c++)
- SET_LIST_BIT (TRANSLATE (c));
}
/* Discard any (non)matching list bytes that are all 0 at the
/* Do not translate the character after the \, so that we can
distinguish, e.g., \B from \b, even if we normally would
translate, e.g., B to b. */
- PATFETCH_RAW (c);
+ PATFETCH (c);
switch (c)
{
/* Look for a special (?...) construct */
if ((syntax & RE_SHY_GROUPS) && *p == '?')
{
- PATFETCH_RAW (c); /* Gobble up the '?'. */
+ PATFETCH (c); /* Gobble up the '?'. */
PATFETCH (c);
switch (c)
{
goto unfetch_interval;
}
- if (upper_bound == 0)
- /* If the upper bound is zero, just drop the sub pattern
- altogether. */
- b = laststart;
- else if (lower_bound == 1 && upper_bound == 1)
- /* Just match it once: nothing to do here. */
- ;
-
- /* Otherwise, we have a nontrivial interval. When
- we're all done, the pattern will look like:
- set_number_at <jump count> <upper bound>
- set_number_at <succeed_n count> <lower bound>
-
succeed_n <after jump addr> <succeed_n count>
- <body of loop>
- jump_n <succeed_n addr> <jump count>
- (The upper bound and `jump_n' are omitted if
- `upper_bound' is 1, though.) */
- else
- { /* If the upper bound is > 1, we need to insert
- more at the end of the loop. */
- unsigned int nbytes = (upper_bound < 0 ? 3
- : upper_bound > 1 ? 5 : 0);
- unsigned int startoffset = 0;
-
- GET_BUFFER_SPACE (20); /* We might use less. */
-
- if (lower_bound == 0)
- {
- /* A succeed_n that starts with 0 is really a
- a simple on_failure_jump_loop. */
- INSERT_JUMP (on_failure_jump_loop, laststart,
- b + 3 + nbytes);
- b += 3;
- }
- else
- {
- /* Initialize lower bound of the `succeed_n', even
- though it will be set during matching by its
- attendant `set_number_at' (inserted next),
- because `re_compile_fastmap' needs to know.
- Jump to the `jump_n' we might insert below. */
- INSERT_JUMP2 (succeed_n, laststart,
- b + 5 + nbytes,
- lower_bound);
- b += 5;
-
- /* Code to initialize the lower bound. Insert
- before the `succeed_n'. The `5' is the last two
- bytes of this `set_number_at', plus 3 bytes of
- the following `succeed_n'. */
- insert_op2 (set_number_at, laststart, 5, lower_bound, b);
- b += 5;
- startoffset += 5;
- }
-
- if (upper_bound < 0)
- {
- /* A negative upper bound stands for infinity,
- in which case it degenerates to a plain jump. */
- STORE_JUMP (jump, b, laststart + startoffset);
- b += 3;
- }
- else if (upper_bound > 1)
- { /* More than one repetition is allowed, so
- append a backward jump to the `succeed_n'
- that starts this interval.
-
- When we've reached this during matching,
- we'll have matched the interval once, so
- jump back only `upper_bound - 1' times. */
- STORE_JUMP2 (jump_n, b, laststart + startoffset,
- upper_bound - 1);
- b += 5;
-
- /* The location we want to set is the second
- parameter of the `jump_n'; that is `b-2' as
- an absolute address. `laststart' will be
- the `set_number_at' we're about to insert;
- `laststart+3' the number to set, the source
- for the relative address. But we are
- inserting into the middle of the pattern --
- so everything is getting moved up by 5.
- Conclusion: (b - 2) - (laststart + 3) + 5,
- i.e., b - laststart.
-
- We insert this at the beginning of the loop
- so that if we fail during matching, we'll
- reinitialize the bounds. */
- insert_op2 (set_number_at, laststart, b - laststart,
- upper_bound - 1, b);
- b += 5;
- }
- }
+ if (upper_bound == 0)
+ /* If the upper bound is zero, just drop the sub pattern
+ altogether. */
+ b = laststart;
+ else if (lower_bound == 1 && upper_bound == 1)
+ /* Just match it once: nothing to do here. */
+ ;
+
+ /* Otherwise, we have a nontrivial interval. When
+ we're all done, the pattern will look like:
+ set_number_at <jump count> <upper bound>
+ set_number_at <succeed_n count> <lower bound>
+ succeed_n <after jump addr> <succeed_n count>
+ <body of loop>
+ jump_n <succeed_n addr> <jump count>
+ (The upper bound and `jump_n' are omitted if
+ `upper_bound' is 1, though.) */
+ else
+ { /* If the upper bound is > 1, we need to insert
+ more at the end of the loop. */
+ unsigned int nbytes = (upper_bound < 0 ? 3
+ : upper_bound > 1 ? 5 : 0);
+ unsigned int startoffset = 0;
+
+ GET_BUFFER_SPACE (20); /* We might use less. */
+
+ if (lower_bound == 0)
+ {
+ /* A succeed_n that starts with 0 is really a
+ a simple on_failure_jump_loop. */
+ INSERT_JUMP (on_failure_jump_loop, laststart,
+ b + 3 + nbytes);
+ b += 3;
+ }
+ else
+ {
+ /* Initialize lower bound of the `succeed_n', even
+ though it will be set during matching by its
+ attendant `set_number_at' (inserted next),
+ because `re_compile_fastmap' needs to know.
+ Jump to the `jump_n' we might insert below. */
+ INSERT_JUMP2 (succeed_n, laststart,
+ b + 5 + nbytes,
+ lower_bound);
+ b += 5;
+
+ /* Code to initialize the lower bound. Insert
+ before the `succeed_n'. The `5' is the last two
+ bytes of this `set_number_at', plus 3 bytes of
+ the following `succeed_n'. */
+ insert_op2 (set_number_at, laststart, 5, lower_bound, b);
+ b += 5;
+ startoffset += 5;
+ }
+
+ if (upper_bound < 0)
+ {
+ /* A negative upper bound stands for infinity,
+ in which case it degenerates to a plain jump. */
+ STORE_JUMP (jump, b, laststart + startoffset);
+ b += 3;
+ }
+ else if (upper_bound > 1)
+ { /* More than one repetition is allowed, so
+ append a backward jump to the `succeed_n'
+ that starts this interval.
+
+ When we've reached this during matching,
+ we'll have matched the interval once, so
+ jump back only `upper_bound - 1' times. */
+ STORE_JUMP2 (jump_n, b, laststart + startoffset,
+ upper_bound - 1);
+ b += 5;
+
+ /* The location we want to set is the second
+ parameter of the `jump_n'; that is `b-2' as
+ an absolute address. `laststart' will be
+ the `set_number_at' we're about to insert;
+ `laststart+3' the number to set, the source
+ for the relative address. But we are
+ inserting into the middle of the pattern --
+ so everything is getting moved up by 5.
+ Conclusion: (b - 2) - (laststart + 3) + 5,
+ i.e., b - laststart.
+
+ We insert this at the beginning of the loop
+ so that if we fail during matching, we'll
+ reinitialize the bounds. */
+ insert_op2 (set_number_at, laststart, b - laststart,
+ upper_bound - 1, b);
+ b += 5;
+ }
+ }
pending_exact = 0;
beg_interval = NULL;
}
case 'c':
laststart = b;
- PATFETCH_RAW (c);
+ PATFETCH (c);
BUF_PUSH_2 (categoryspec, c);
break;
case 'C':
laststart = b;
- PATFETCH_RAW (c);
+ PATFETCH (c);
BUF_PUSH_2 (notcategoryspec, c);
break;
#endif /* emacs */
/* You might think it would be useful for \ to mean
not to translate; but if we don't translate it
it will never match anything. */
- /* Actually we don't have to translate it now, because
- it is anyway translated later. */
-#if 0
- c = TRANSLATE (c);
-#endif
goto normal_char;
}
break;
default:
/* Expects the character in `c'. */
normal_char:
- /* If no exactn currently being built. */
+ /* If no exactn currently being built. */
if (!pending_exact
/* If last exactn not at current position. */
{
int len;
+ if (! multibyte)
+ MAKE_CHAR_MULTIBYTE (c);
c = TRANSLATE (c);
- if (multibyte)
- len = CHAR_STRING (c, b);
+ if (target_multibyte)
+ {
+ len = CHAR_STRING (c, b);
+ b += len;
+ }
else
- *b = c, len = 1;
- b += len;
+ {
+ MAKE_CHAR_UNIBYTE (c);
+ *b++ = c;
+ len = 1;
+ }
(*pending_exact) += len;
}
/* We have succeeded; set the length of the buffer. */
bufp->used = b - bufp->buffer;
+ #ifdef emacs
+ /* Now the buffer is adjusted for the multibyteness of a target. */
+ bufp->multibyte = bufp->target_multibyte;
+ #endif
+
#ifdef DEBUG
if (debug > 0)
{
case exactn:
if (fastmap)
- {
- int c = RE_STRING_CHAR (p + 1, pend - p);
-
- if (SINGLE_BYTE_CHAR_P (c))
- fastmap[c] = 1;
- else
- fastmap[p[1]] = 1;
- }
+ /* If multibyte is nonzero, the first byte of each
+ character is an ASCII or a leading code. Otherwise,
+ each byte is a character. Thus, this works in both
+ cases. */
+ fastmap[p[1]] = 1;
break;
case charset_not:
- /* Chars beyond end of bitmap are possible matches.
- All the single-byte codes can occur in multibyte buffers.
- So any that are not listed in the charset
- are possible matches, even in multibyte buffers. */
if (!fastmap) break;
- for (j = CHARSET_BITMAP_SIZE (&p[-1]) * BYTEWIDTH;
- j < (1 << BYTEWIDTH); j++)
- fastmap[j] = 1;
+ {
+ /* Chars beyond end of bitmap are possible matches. */
+ /* In a multibyte case, the bitmap is used only for ASCII
+ characters. */
+ int limit = multibyte ? 128 : (1 << BYTEWIDTH);
+
+ for (j = CHARSET_BITMAP_SIZE (&p[-1]) * BYTEWIDTH;
+ j < limit; j++)
+ fastmap[j] = 1;
+ }
+
/* Fallthrough */
case charset:
if (!fastmap) break;
fastmap[j] = 1;
if ((not && multibyte)
- /* Any character set can possibly contain a character
+ /* Any leading code can possibly start a character
which doesn't match the specified set of characters. */
|| (CHARSET_RANGE_TABLE_EXISTS_P (&p[-2])
&& CHARSET_RANGE_TABLE_BITS (&p[-2]) != 0))
/* If we can match a character class, we can match
- any character set. */
+ any multibyte characters. */
{
- set_fastmap_for_multibyte_characters:
if (match_any_multibyte_characters == false)
{
- for (j = 0x80; j < 0xA0; j++) /* XXX */
- if (BASE_LEADING_CODE_P (j))
- fastmap[j] = 1;
+ for (j = 0x80; j < (1 << BYTEWIDTH); j++)
+ fastmap[j] = 1;
match_any_multibyte_characters = true;
}
}
else if (!not && CHARSET_RANGE_TABLE_EXISTS_P (&p[-2])
&& match_any_multibyte_characters == false)
{
- /* Set fastmap[I] 1 where I is a base leading code of each
- multibyte character in the range table. */
+ /* Set fastmap[I] to 1 where I is a leading code of each
+ multibyte characer in the range table. */
int c, count;
+ unsigned char lc1, lc2;
/* Make P points the range table. `+ 2' is to skip flag
bits for a character class. */
EXTRACT_NUMBER_AND_INCR (count, p);
for (; count > 0; count--, p += 2 * 3) /* XXX */
{
- /* Extract the start of each range. */
+ /* Extract the start and end of each range. */
+ EXTRACT_CHARACTER (c, p);
+ lc1 = CHAR_LEADING_CODE (c);
+ p += 3;
EXTRACT_CHARACTER (c, p);
- j = CHAR_CHARSET (c);
- fastmap[CHARSET_LEADING_CODE_BASE (j)] = 1;
+ lc2 = CHAR_LEADING_CODE (c);
+ for (j = lc1; j <= lc2; j++)
+ fastmap[j] = 1;
}
}
break;
if (!fastmap) break;
not = (re_opcode_t)p[-1] == notcategoryspec;
k = *p++;
- for (j = 0; j < (1 << BYTEWIDTH); j++)
+ for (j = (multibyte ? 127 : (1 << BYTEWIDTH)); j >= 0; j--)
if ((CHAR_HAS_CATEGORY (j, k)) ^ not)
fastmap[j] = 1;
if (multibyte)
- /* Any character set can possibly contain a character
- whose category is K (or not). */
- goto set_fastmap_for_multibyte_characters;
+ {
+ /* Any character set can possibly contain a character
+ whose category is K (or not). */
+ if (match_any_multibyte_characters == false)
+ {
+ for (j = 0x80; j < (1 << BYTEWIDTH); j++)
+ fastmap[j] = 1;
+ match_any_multibyte_characters = true;
+ }
+ }
break;
/* All cases after this match the empty string. These end with
case has already been handled, so we only need to look at the
fallthrough case. */
continue;
-
+
case succeed_n:
/* If N == 0, it should be an on_failure_jump_loop instead. */
DEBUG_STATEMENT (EXTRACT_NUMBER (j, p + 2); assert (j > 0));
bufp->fastmap_accurate = 1; /* It will be when we're done. */
analysis = analyse_first (bufp->buffer, bufp->buffer + bufp->used,
- fastmap,
-#ifdef emacs
- /* The compiled pattern buffer is always
- setup for multibyte characters. */
- 1
-#else
- 0
-#endif
- );
+ fastmap, RE_MULTIBYTE_P (bufp));
bufp->can_be_null = (analysis != 0);
return 0;
} /* re_compile_fastmap */
}
WEAK_ALIAS (__re_search, re_search)
+/* Head address of virtual concatenation of string. */
+#define HEAD_ADDR_VSTRING(P) \
+ (((P) >= size1 ? string2 : string1))
+
/* End address of virtual concatenation of string. */
#define STOP_ADDR_VSTRING(P) \
(((P) >= size1 ? string2 + size2 : string1 + size1))
int total_size = size1 + size2;
int endpos = startpos + range;
boolean anchored_start;
-
- /* Nonzero if we have to concern multibyte character. */
+ /* Nonzero if BUFP is setup for multibyte characters. We are sure
+ that it is the same as RE_TARGET_MULTIBYTE_P (bufp). */
const boolean multibyte = RE_MULTIBYTE_P (bufp);
/* Check for out-of-range STARTPOS. */
buf_ch = STRING_CHAR_AND_LENGTH (d, range - lim,
buf_charlen);
-
buf_ch = RE_TRANSLATE (translate, buf_ch);
- if (buf_ch >= 0400
- || fastmap[buf_ch])
+ if (fastmap[CHAR_LEADING_CODE (buf_ch)])
break;
+
range -= buf_charlen;
d += buf_charlen;
}
else
- while (range > lim
- && !fastmap[RE_TRANSLATE (translate, *d)])
+ while (range > lim)
{
-#ifdef emacs
+ buf_ch = *d;
-#endif
+ MAKE_CHAR_MULTIBYTE (buf_ch);
-#ifdef emacs
+ buf_ch = RE_TRANSLATE (translate, buf_ch);
-#endif
+ MAKE_CHAR_UNIBYTE (buf_ch);
+ if (fastmap[buf_ch])
+ break;
d++;
range--;
}
}
else
- while (range > lim && !fastmap[*d])
- {
- d++;
- range--;
- }
+ {
+ if (multibyte)
+ while (range > lim)
+ {
+ int buf_charlen;
+ buf_ch = STRING_CHAR_AND_LENGTH (d, range - lim,
+ buf_charlen);
+ if (fastmap[CHAR_LEADING_CODE (buf_ch)])
+ break;
+ range -= buf_charlen;
+ d += buf_charlen;
+ }
+ else
+ while (range > lim && !fastmap[*d])
+ {
+ d++;
+ range--;
+ }
+ }
startpos += irange - range;
}
else /* Searching backwards. */
int room = (startpos >= size1
? size2 + size1 - startpos
: size1 - startpos);
- buf_ch = RE_STRING_CHAR (d, room);
- buf_ch = TRANSLATE (buf_ch);
--
- if (! (buf_ch >= 0400
- || fastmap[buf_ch]))
- goto advance;
+ if (multibyte)
+ {
+ buf_ch = STRING_CHAR (d, room);
+ buf_ch = TRANSLATE (buf_ch);
+ if (! fastmap[CHAR_LEADING_CODE (buf_ch)])
+ goto advance;
+ }
+ else
+ {
+ if (! fastmap[TRANSLATE (*d)])
+ goto advance;
+ }
}
}
/* Update STARTPOS to the previous character boundary. */
if (multibyte)
{
- re_char *p = POS_ADDR_VSTRING (startpos);
- int len = 0;
+ re_char *p = POS_ADDR_VSTRING (startpos) + 1;
+ re_char *p0 = p;
+ re_char *phead = HEAD_ADDR_VSTRING (startpos);
/* Find the head of multibyte form. */
- while (!CHAR_HEAD_P (*p))
- p--, len++;
- range += len;
+ PREV_CHAR_BOUNDARY (p, phead);
+ range += p0 - 1 - p;
if (range > 0)
break;
- startpos -= len;
+
+ startpos -= p0 - 1 - p;
}
}
}
{
case anychar:
break;
-
+
case exactn:
p += *p + 1;
break;
else
p += 1 + CHARSET_BITMAP_SIZE (p - 1);
break;
-
+
case syntaxspec:
case notsyntaxspec:
#ifdef emacs
return 1;
}
break;
-
+
case endline:
case exactn:
{
/* Test if C is listed in charset (or charset_not)
at `p1'. */
- if (SINGLE_BYTE_CHAR_P (c))
+ if (! multibyte || IS_REAL_ASCII (c))
{
if (c < CHARSET_BITMAP_SIZE (p1) * BYTEWIDTH
&& p1[2 + c / BYTEWIDTH] & (1 << (c % BYTEWIDTH)))
size of bitmap table of P1 is extracted by
using macro `CHARSET_BITMAP_SIZE'.
- Since we know that all the character listed in
- P2 is ASCII, it is enough to test only bitmap
- table of P1. */
+ In a multibyte case, we know that all the character
+ listed in P2 is ASCII. In a unibyte case, P1 has only a
+ bitmap table. So, in both cases, it is enough to test
+ only the bitmap table of P1. */
if ((re_opcode_t) *p1 == charset)
{
}
}
break;
-
+
case charset_not:
switch (SWITCH_ENUM_CAST (*p1))
{
they don't overlap. The union of the two sets of excluded
chars should cover all possible chars, which, as a matter of
fact, is virtually impossible in multibyte buffers. */
- ;
+ break;
}
break;
}
WEAK_ALIAS (__re_match_2, re_match_2)
+ #ifdef emacs
+ #define TRANSLATE_VIA_MULTIBYTE(c) \
+ do { \
+ if (multibyte) \
+ (c) = TRANSLATE (c); \
+ else \
+ { \
+ MAKE_CHAR_MULTIBYTE (c); \
+ (c) = TRANSLATE (c); \
+ MAKE_CHAR_UNIBYTE (c); \
+ } \
+ } while (0)
+
+ #else
+ #define TRANSLATE_VIA_MULTIBYTE(c) ((c) = TRANSLATE (c))
+ #endif
+
+
/* This is a separate function so that we can force an alloca cleanup
afterwards. */
static int
/* We use this to map every character in the string. */
RE_TRANSLATE_TYPE translate = bufp->translate;
- /* Nonzero if we have to concern multibyte character. */
+ /* Nonzero if BUFP is setup for multibyte characters. We are sure
+ that it is the same as RE_TARGET_MULTIBYTE_P (bufp). */
const boolean multibyte = RE_MULTIBYTE_P (bufp);
/* Failure point stack. Each place that can handle a failure further
/* Remember the start point to rollback upon failure. */
dfail = d;
+ #ifndef emacs
/* This is written out as an if-else so we don't waste time
testing `translate' inside the loop. */
if (RE_TRANSLATE_P (translate))
- {
- if (multibyte)
- do
+ do
+ {
+ PREFETCH ();
+ if (RE_TRANSLATE (translate, *d) != *p++)
{
- int pat_charlen, buf_charlen;
- unsigned int pat_ch, buf_ch;
-
- PREFETCH ();
- pat_ch = STRING_CHAR_AND_LENGTH (p, pend - p, pat_charlen);
- buf_ch = STRING_CHAR_AND_LENGTH (d, dend - d, buf_charlen);
+ d = dfail;
+ goto fail;
+ }
+ d++;
+ }
+ while (--mcnt);
+ else
+ do
+ {
+ PREFETCH ();
+ if (*d++ != *p++)
+ {
+ d = dfail;
+ goto fail;
+ }
+ }
+ while (--mcnt);
+ #else /* emacs */
+ /* The cost of testing `translate' is comparatively small. */
+ if (multibyte)
+ do
+ {
+ int pat_charlen, buf_charlen;
+ unsigned int pat_ch, buf_ch;
- if (RE_TRANSLATE (translate, buf_ch)
- != pat_ch)
- {
- d = dfail;
- goto fail;
- }
+ PREFETCH ();
+ pat_ch = STRING_CHAR_AND_LENGTH (p, pend - p, pat_charlen);
+ buf_ch = STRING_CHAR_AND_LENGTH (d, dend - d, buf_charlen);
- p += pat_charlen;
- d += buf_charlen;
- mcnt -= pat_charlen;
- }
- while (mcnt > 0);
- else
- do
+ if (TRANSLATE (buf_ch) != pat_ch)
{
- PREFETCH ();
- if (RE_TRANSLATE (translate, *d) != *p++)
- {
- d = dfail;
- goto fail;
- }
- d++;
+ d = dfail;
+ goto fail;
}
- while (--mcnt);
- }
+
+ p += pat_charlen;
+ d += buf_charlen;
+ mcnt -= pat_charlen;
+ }
+ while (mcnt > 0);
else
- {
- do
- {
- PREFETCH ();
- if (*d++ != *p++)
- {
- d = dfail;
- goto fail;
- }
- }
- while (--mcnt);
- }
+ do
+ {
+ unsigned int buf_ch;
+
+ PREFETCH ();
+ buf_ch = *d++;
+ TRANSLATE_VIA_MULTIBYTE (buf_ch);
+ if (buf_ch != *p++)
+ {
+ d = dfail;
+ goto fail;
+ }
+ }
+ while (--mcnt);
+ #endif
break;
+
/* Match any character except possibly a newline or a null. */
case anychar:
{
PREFETCH ();
buf_ch = RE_STRING_CHAR_AND_LENGTH (d, dend - d, buf_charlen);
+ buf_ch = TRANSLATE (buf_ch);
if ((!(bufp->syntax & RE_DOT_NEWLINE)
&& buf_ch == '\n')
PREFETCH ();
c = RE_STRING_CHAR_AND_LENGTH (d, dend - d, len);
- c = TRANSLATE (c); /* The character to match. */
+ TRANSLATE_VIA_MULTIBYTE (c); /* The character to match. */
- if (SINGLE_BYTE_CHAR_P (c))
+ if (! multibyte || IS_REAL_ASCII (c))
{ /* Lookup bitmap. */
/* Cast to `unsigned' instead of `unsigned char' in
case the bit list is a full 32 bytes long. */
assert (!REG_UNSET (regstart[*p]));
/* Strictly speaking, there should be code such as:
-
+
assert (REG_UNSET (regend[*p]));
PUSH_FAILURE_REGSTOP ((unsigned int)*p);
}
else
{
- unsigned char c;
+ unsigned c;
GET_CHAR_BEFORE_2 (c, d, string1, end1, string2, end2);
if (c == '\n')
break;
cycle detection cannot work. Worse yet, such a detection
can not only fail to detect a cycle, but it can also wrongly
detect a cycle (between different instantiations of the same
- loop.
+ loop).
So the method used for those nasty loops is a little different:
We use a special cycle-detection-stack-frame which is pushed
when the on_failure_jump_nastyloop failure-point is *popped*.
mcnt, p + mcnt);
assert ((re_opcode_t)p[-4] == no_op);
- CHECK_INFINITE_LOOP (p - 4, d);
- PUSH_FAILURE_POINT (p - 3, d);
+ {
+ int cycle = 0;
+ CHECK_INFINITE_LOOP (p - 4, d);
+ if (!cycle)
+ /* If there's a cycle, just continue without pushing
+ this failure point. The failure point is the "try again"
+ option, which shouldn't be tried.
+ We want (x?)*?y\1z to match both xxyz and xxyxz. */
+ PUSH_FAILURE_POINT (p - 3, d);
+ }
break;
-
/* Simple loop detecting on_failure_jump: just check on the
failure stack if the same spot was already hit earlier. */
case on_failure_jump_loop:
EXTRACT_NUMBER_AND_INCR (mcnt, p);
DEBUG_PRINT3 ("EXECUTING on_failure_jump_loop %d (to %p):\n",
mcnt, p + mcnt);
-
- CHECK_INFINITE_LOOP (p - 3, d);
- PUSH_FAILURE_POINT (p - 3, d);
+ {
+ int cycle = 0;
+ CHECK_INFINITE_LOOP (p - 3, d);
+ if (cycle)
+ /* If there's a cycle, get out of the loop, as if the matching
+ had failed. We used to just `goto fail' here, but that was
+ aborting the search a bit too early: we want to keep the
+ empty-loop-match and keep matching after the loop.
+ We want (x?)*y\1z to match both xxyz and xxyxz. */
+ p += mcnt;
+ else
+ PUSH_FAILURE_POINT (p - 3, d);
+ }
break;
is the character at D, and S2 is the syntax of C2. */
re_wchar_t c1, c2;
int s1, s2;
+ int dummy;
#ifdef emacs
int offset = PTR_TO_OFFSET (d - 1);
int charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset);
UPDATE_SYNTAX_TABLE_FORWARD (charpos + 1);
#endif
PREFETCH_NOLIMIT ();
- c2 = RE_STRING_CHAR (d, dend - d);
+ GET_CHAR_AFTER (c2, d, dummy);
s2 = SYNTAX (c2);
if (/* Case 2: Only one of S1 and S2 is Sword. */
is the character at D, and S2 is the syntax of C2. */
re_wchar_t c1, c2;
int s1, s2;
+ int dummy;
#ifdef emacs
int offset = PTR_TO_OFFSET (d);
int charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset);
UPDATE_SYNTAX_TABLE (charpos);
#endif
PREFETCH ();
- c2 = RE_STRING_CHAR (d, dend - d);
+ GET_CHAR_AFTER (c2, d, dummy);
s2 = SYNTAX (c2);
-
+
/* Case 2: S2 is not Sword. */
if (s2 != Sword)
goto fail;
is the character at D, and S2 is the syntax of C2. */
re_wchar_t c1, c2;
int s1, s2;
+ int dummy;
#ifdef emacs
int offset = PTR_TO_OFFSET (d) - 1;
int charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset);
if (!AT_STRINGS_END (d))
{
PREFETCH_NOLIMIT ();
- c2 = RE_STRING_CHAR (d, dend - d);
+ GET_CHAR_AFTER (c2, d, dummy);
#ifdef emacs
UPDATE_SYNTAX_TABLE_FORWARD (charpos);
#endif
int len;
re_wchar_t c;
- c = RE_STRING_CHAR_AND_LENGTH (d, dend - d, len);
-
+ GET_CHAR_AFTER (c, d, len);
if ((SYNTAX (c) != (enum syntaxcode) mcnt) ^ not)
goto fail;
d += len;
int len;
re_wchar_t c;
- c = RE_STRING_CHAR_AND_LENGTH (d, dend - d, len);
-
+ GET_CHAR_AFTER (c, d, len);
-
if ((!CHAR_HAS_CATEGORY (c, mcnt)) ^ not)
goto fail;
d += len;
int p1_charlen, p2_charlen;
re_wchar_t p1_ch, p2_ch;
- p1_ch = RE_STRING_CHAR_AND_LENGTH (p1, p1_end - p1, p1_charlen);
- p2_ch = RE_STRING_CHAR_AND_LENGTH (p2, p2_end - p2, p2_charlen);
+ GET_CHAR_AFTER (p1_ch, p1, p1_charlen);
+ GET_CHAR_AFTER (p2_ch, p2, p2_charlen);
if (RE_TRANSLATE (translate, p1_ch)
!= RE_TRANSLATE (translate, p2_ch))
const regex_t *__restrict preg;
const char *__restrict string;
size_t nmatch;
- regmatch_t pmatch[];
+ regmatch_t pmatch[__restrict_arr];
int eflags;
{
int ret;
unsigned not_eol : 1;
#ifdef emacs
- /* If true, multi-byte form in the `buffer' should be recognized as a
- multibyte character. */
+ /* If true, multi-byte form in the regexp pattern should be
- recognized as a multibyte character. */
++ recognized as a multibyte character. When the pattern is
++ compiled, this is set to the same value as target_multibyte
++ below. */
unsigned multibyte : 1;
+
+ /* If true, multi-byte form in the target of match should be
+ recognized as a multibyte character. */
+ unsigned target_multibyte : 1;
#endif
/* [[[end pattern_buffer]]] */
# endif
# endif
#endif
-/* For now unconditionally define __restrict_arr to expand to nothing.
+/* For now conditionally define __restrict_arr to expand to nothing.
Ideally we would have a test for the compiler which allows defining
it to restrict. */
-#define __restrict_arr
+#ifndef __restrict_arr
+# define __restrict_arr
+#endif
/* POSIX compatibility. */
extern int regcomp _RE_ARGS ((regex_t *__restrict __preg,
#include "syntax.h"
#include "category.h"
#include "buffer.h"
- #include "charset.h"
+ #include "character.h"
#include "region-cache.h"
#include "commands.h"
#include "blockinput.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
- the target. 0 means all multibyte characters are recognized just as
-- sequences of binary data. */
++ MULTIBYTE is nonzero iff a target of match is a multibyte buffer or
++ string. */
static void
compile_pattern_1 (cp, pattern, translate, regp, posix, multibyte)
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.target_multibyte = multibyte;
BLOCK_INPUT;
old = re_set_syntax (RE_SYNTAX_EMACS
| (posix ? 0 : RE_NO_POSIX_BACKTRACKING));
- val = (char *) re_compile_pattern ((char *)raw_pattern,
- raw_pattern_size, &cp->buf);
- val = (char *) re_compile_pattern ((char *) (XSTRING (pattern)->data),
- STRING_BYTES (XSTRING (pattern)),
- &cp->buf);
++ val = (char *) re_compile_pattern ((char *) SDATA (pattern),
++ SBYTES (pattern), &cp->buf);
re_set_syntax (old);
UNBLOCK_INPUT;
if (val)
{
cp->buf.allocated = cp->buf.used;
cp->buf.buffer
- = (unsigned char *) realloc (cp->buf.buffer, cp->buf.used);
+ = (unsigned char *) xrealloc (cp->buf.buffer, cp->buf.used);
}
}
cp = *cpp;
/* Entries are initialized to nil, and may be set to nil by
compile_pattern_1 if the pattern isn't valid. Don't apply
- XSTRING in those cases. However, compile_pattern_1 is only
- applied to the cache entry we pick here to reuse. So nil
- should never appear before a non-nil entry. */
+ string accessors in those cases. However, compile_pattern_1
+ is only applied to the cache entry we pick here to reuse. So
+ nil should never appear before a non-nil entry. */
if (NILP (cp->regexp))
goto compile_it;
- if (XSTRING (cp->regexp)->size == XSTRING (pattern)->size
+ if (SCHARS (cp->regexp) == SCHARS (pattern)
&& STRING_MULTIBYTE (cp->regexp) == STRING_MULTIBYTE (pattern)
&& !NILP (Fstring_equal (cp->regexp, pattern))
&& EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0)))
&& cp->posix == posix
- && cp->buf.multibyte == multibyte)
+ && cp->buf.target_multibyte == multibyte)
break;
/* If we're at the end of the cache, compile into the nil cell
}
re_match_object = Qnil;
-
+
i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2,
PT_BYTE - BEGV_BYTE, &search_regs,
ZV_BYTE - BEGV_BYTE);
immediate_quit = 0;
-
+
if (i == -2)
matcher_overflow ();
pos = 0, pos_byte = 0;
else
{
- int len = XSTRING (string)->size;
+ int len = SCHARS (string);
CHECK_NUMBER (start);
pos = XINT (start);
STRING_MULTIBYTE (string));
immediate_quit = 1;
re_match_object = string;
-
- val = re_search (bufp, (char *) XSTRING (string)->data,
- STRING_BYTES (XSTRING (string)), pos_byte,
- STRING_BYTES (XSTRING (string)) - pos_byte,
+
+ val = re_search (bufp, (char *) SDATA (string),
+ SBYTES (string), pos_byte,
+ SBYTES (string) - pos_byte,
&search_regs);
immediate_quit = 0;
last_thing_searched = Qt;
If third arg START is non-nil, start search at that index in STRING.
For index of first char beyond the match, do (match-end 0).
`match-end' and `match-beginning' also give indices of substrings
-matched by parenthesis constructs in the pattern. */)
+matched by parenthesis constructs in the pattern.
+
+You can use the function `match-string' to extract the substrings
+matched by the parenthesis constructions in REGEXP. */)
(regexp, string, start)
Lisp_Object regexp, string, start;
{
0, STRING_MULTIBYTE (string));
immediate_quit = 1;
re_match_object = string;
-
- val = re_search (bufp, (char *) XSTRING (string)->data,
- STRING_BYTES (XSTRING (string)), 0,
- STRING_BYTES (XSTRING (string)), 0);
+
+ val = re_search (bufp, (char *) SDATA (string),
+ SBYTES (string), 0,
+ SBYTES (string), 0);
immediate_quit = 0;
return val;
}
int
fast_c_string_match_ignore_case (regexp, string)
Lisp_Object regexp;
- char *string;
+ const char *string;
{
int val;
struct re_pattern_buffer *bufp;
int allow_quit;
{
struct region_cache *newline_cache;
- int direction;
+ int direction;
if (count > 0)
{
ceiling_byte = min (tem, ceiling_byte);
{
- /* The termination address of the dumb loop. */
+ /* The termination address of the dumb loop. */
register unsigned char *ceiling_addr
= BYTE_POS_ADDR (ceiling_byte) + 1;
register unsigned char *cursor
if (shortage == 0)
pos--;
-
+
return pos;
}
\f
trivial_regexp_p (regexp)
Lisp_Object regexp;
{
- int len = STRING_BYTES (XSTRING (regexp));
- unsigned char *s = XSTRING (regexp)->data;
+ int len = SBYTES (regexp);
+ unsigned char *s = SDATA (regexp);
while (--len >= 0)
{
switch (*s++)
Lisp_Object inverse_trt;
int posix;
{
- int len = XSTRING (string)->size;
- int len_byte = STRING_BYTES (XSTRING (string));
+ int len = SCHARS (string);
+ int len_byte = SBYTES (string);
register int i;
if (running_asynch_code)
s2 = 0;
}
re_match_object = Qnil;
-
+
while (n < 0)
{
int val;
int raw_pattern_size_byte;
unsigned char *patbuf;
int multibyte = !NILP (current_buffer->enable_multibyte_characters);
- unsigned char *base_pat = XSTRING (string)->data;
- /* High bits of char, calculated by (CHAR & 0x3F). Characters
- of the same high bits have the same sequence of bytes but
- last. To do the BM search, all characters in STRING must
- have the same high bits (including their case
- translations). */
+ unsigned char *base_pat = SDATA (string);
- int charset_base = -1;
++ /* High bits of char; 0 for ASCII characters, (CHAR & ~0x3F)
++ otherwise. Characters of the same high bits have the same
++ sequence of bytes but last. To do the BM search, all
++ characters in STRING must have the same high bits (including
++ their case translations). */
+ int char_high_bits = -1;
int boyer_moore_ok = 1;
/* MULTIBYTE says whether the text to be searched is multibyte.
if (multibyte == STRING_MULTIBYTE (string))
{
- raw_pattern = (unsigned char *) XSTRING (string)->data;
- raw_pattern_size = XSTRING (string)->size;
- raw_pattern_size_byte = STRING_BYTES (XSTRING (string));
+ raw_pattern = (unsigned char *) SDATA (string);
+ raw_pattern_size = SCHARS (string);
+ raw_pattern_size_byte = SBYTES (string);
}
else if (multibyte)
{
- raw_pattern_size = XSTRING (string)->size;
+ raw_pattern_size = SCHARS (string);
raw_pattern_size_byte
- = count_size_as_multibyte (XSTRING (string)->data,
+ = count_size_as_multibyte (SDATA (string),
raw_pattern_size);
raw_pattern = (unsigned char *) alloca (raw_pattern_size_byte + 1);
- copy_text (XSTRING (string)->data, raw_pattern,
- XSTRING (string)->size, 0, 1);
+ copy_text (SDATA (string), raw_pattern,
+ SCHARS (string), 0, 1);
}
else
{
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 = XSTRING (string)->size;
- raw_pattern_size_byte = XSTRING (string)->size;
+ raw_pattern_size = SCHARS (string);
+ raw_pattern_size_byte = SCHARS (string);
raw_pattern = (unsigned char *) alloca (raw_pattern_size + 1);
- copy_text (XSTRING (string)->data, raw_pattern,
- STRING_BYTES (XSTRING (string)), 1, 0);
+ copy_text (SDATA (string), raw_pattern,
+ SBYTES (string), 1, 0);
}
/* 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)
{
while (--len >= 0)
{
- unsigned char str[MAX_MULTIBYTE_LENGTH];
int c, translated, inverse;
- int in_charlen, charlen;
+ int in_charlen;
/* If we got here and the RE flag is set, it's because we're
dealing with a regexp known to be trivial, so the backslash
/* Translate the character, if requested. */
TRANSLATE (translated, trt, c);
- /* If translation changed the byte-length, go back
- to the original character. */
- charlen = CHAR_STRING (translated, str);
- if (in_charlen != charlen)
- {
- translated = c;
- charlen = CHAR_STRING (c, str);
- }
-
- /* If we are searching for something strange,
- an invalid multibyte code, don't use boyer-moore. */
- if (! ASCII_BYTE_P (translated)
- && (charlen == 1 /* 8bit code */
- || charlen != in_charlen /* invalid multibyte code */
- ))
- boyer_moore_ok = 0;
-
TRANSLATE (inverse, inverse_trt, c);
/* Did this char actually get translated?
{
/* Keep track of which character set row
contains the characters that need translation. */
- int charset_base_code = c & ~CHAR_FIELD3_MASK;
- int inverse_charset_base = inverse & ~CHAR_FIELD3_MASK;
- int this_high_bit = c & ~0x3F;
- int trt_high_bit = ((inverse != c ? inverse : translated)
- & ~0x3F);
-
++ int this_high_bit = ASCII_CHAR_P (c) ? 0 : (c & ~0x3F);
++ int c1 = inverse != c ? inverse : translated;
++ int trt_high_bit = ASCII_CHAR_P (c1) ? 0 : (c1 & ~0x3F);
+
- if (charset_base_code != inverse_charset_base)
+ if (this_high_bit != trt_high_bit)
boyer_moore_ok = 0;
- else if (charset_base == -1)
- charset_base = charset_base_code;
- else if (charset_base != charset_base_code)
+ else if (char_high_bits == -1)
+ char_high_bits = this_high_bit;
+ else if (char_high_bits != this_high_bit)
/* If two different rows appear, needing translation,
then we cannot use boyer_moore search. */
boyer_moore_ok = 0;
}
/* Store this character into the translated pattern. */
- bcopy (str, pat, charlen);
- pat += charlen;
+ CHAR_STRING_ADVANCE (translated, pat);
base_pat += in_charlen;
len_byte -= in_charlen;
}
else
{
/* Unibyte buffer. */
- charset_base = 0;
+ char_high_bits = 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_high_bits);
else
return simple_search (n, pat, len, len_byte, trt,
pos, pos_byte, lim, lim_byte);
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_high_bits)
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_high_bits;
{
int direction = ((n > 0) ? 1 : -1);
register int dirlen;
int infinity, limit, stride_for_teases = 0;
register int *BM_tab;
int *BM_tab_base;
- register unsigned char *cursor, *p_limit;
+ register unsigned char *cursor, *p_limit;
register int i, j;
unsigned char *pat, *pat_end;
int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
/* a single test, a test for having gone past the end of the */
/* permissible match region, to test for both possible matches (when */
/* the stride goes past the end immediately) and failure to */
- /* match (where you get nudged past the end one stride at a time). */
+ /* match (where you get nudged past the end one stride at a time). */
/* Here we make a "mickey mouse" BM table. The stride of the search */
/* is determined only by the last character of the putative match. */
/* If that character does not match, we will stride the proper */
/* distance to propose a match that superimposes it on the last */
/* instance of a character that matches it (per trt), or misses */
- /* it entirely if there is none. */
+ /* it entirely if there is none. */
dirlen = len_byte * direction;
infinity = dirlen - (lim_byte + pos_byte + len_byte + len_byte) * direction;
while (! CHAR_HEAD_P (*charstart))
charstart--;
untranslated = STRING_CHAR (charstart, ptr - charstart + 1);
- if (charset_base == (untranslated & ~CHAR_FIELD3_MASK))
- if (char_high_bits == (untranslated & ~0x3F))
++ if (char_high_bits
++ == (ASCII_CHAR_P (untranslated) ? 0 : untranslated & ~0x3F))
{
TRANSLATE (ch, trt, untranslated);
if (! CHAR_HEAD_P (*ptr))
this_translated = 0;
}
- if (ch > 0400)
- j = ((unsigned char) ch) | 0200;
+ if (this_translated
+ && ch >= 0200)
+ j = (ch & 0x3F) | 0200;
else
j = (unsigned char) ch;
BM_tab[j] = dirlen - i;
/* A translation table is accompanied by its inverse -- see */
- /* comment following downcase_table for details */
+ /* comment following downcase_table for details */
if (this_translated)
{
int starting_ch = ch;
while (1)
{
TRANSLATE (ch, inverse_trt, ch);
- if (ch > 0400)
- j = ((unsigned char) ch) | 0200;
+ if (ch > 0200)
+ j = (ch & 0x3F) | 0200;
else
j = (unsigned char) ch;
/* This loop can be coded for space rather than */
/* speed because it will usually run only once. */
/* (the reach is at most len + 21, and typically */
- /* does not exceed len) */
+ /* does not exceed len) */
while ((limit - pos_byte) * direction >= 0)
pos_byte += BM_tab[FETCH_BYTE (pos_byte)];
/* now run the same tests to distinguish going off the */
int adjust;
CHECK_STRING (string);
- p = XSTRING (string)->data;
- len = XSTRING (string)->size;
+ p = SDATA (string);
+ len = SCHARS (string);
for (i = 0, i_byte = 0; i < len; )
{
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)
{
adjust = - punct_count + 5 * (word_count - 1) + 4;
if (STRING_MULTIBYTE (string))
val = make_uninit_multibyte_string (len + adjust,
- STRING_BYTES (XSTRING (string))
+ SBYTES (string)
+ adjust);
else
val = make_uninit_string (len + adjust);
- o = XSTRING (val)->data;
+ o = SDATA (val);
*o++ = '\\';
*o++ = 'b';
prev_c = 0;
{
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)
{
- bcopy (&XSTRING (string)->data[i_byte_orig], o,
+ bcopy (SDATA (string) + i_byte_orig, o,
i_byte - i_byte_orig);
o += i_byte - i_byte_orig;
}
\f
DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 5, 0,
doc: /* Replace text matched by last search with NEWTEXT.
+Leave point at the end of the replacement text.
+
If second arg FIXEDCASE is non-nil, do not alter case of replacement text.
Otherwise maybe capitalize the whole text, or maybe just word initials,
based on the replaced text.
If the replaced text has only capital letters
and has at least one multiletter word, convert NEWTEXT to all caps.
-If the replaced text has at least one word starting with a capital letter,
-then capitalize each word in NEWTEXT.
+Otherwise if all words are capitalized in the replaced text,
+capitalize each word in NEWTEXT.
If third arg LITERAL is non-nil, insert NEWTEXT literally.
Otherwise treat `\\' as special:
`\\N' means substitute what matched the Nth `\\(...\\)'.
If Nth parens didn't match, substitute nothing.
`\\\\' means insert one `\\'.
+Case conversion does not apply to these substitutions.
+
FIXEDCASE and LITERAL are optional arguments.
-Leaves point at end of replacement text.
The optional fourth argument STRING can be a string to modify.
This is meaningful when the previous match was done against STRING,
{
if (search_regs.start[sub] < 0
|| search_regs.start[sub] > search_regs.end[sub]
- || search_regs.end[sub] > XSTRING (string)->size)
+ || search_regs.end[sub] > SCHARS (string))
args_out_of_range (make_number (search_regs.start[sub]),
make_number (search_regs.end[sub]));
}
{
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))
{
/* We build up the substituted string in ACCUM. */
Lisp_Object accum;
Lisp_Object middle;
- int length = STRING_BYTES (XSTRING (newtext));
+ int length = SBYTES (newtext);
accum = Qnil;
if (c == '\\')
{
FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
-
+
if (c == '&')
{
substart = search_regs.start[sub];
perform substitution on the replacement string. */
if (NILP (literal))
{
- int length = STRING_BYTES (XSTRING (newtext));
+ int length = SBYTES (newtext);
unsigned char *substed;
int substed_alloc_size, substed_len;
int buf_multibyte = !NILP (current_buffer->enable_multibyte_characters);
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;
++ rev_tbl = Qnil;
substed_alloc_size = length * 2 + 100;
substed = (unsigned char *) xmalloc (substed_alloc_size + 1);
else
{
/* Note that we don't have to increment POS. */
- c = XSTRING (newtext)->data[pos_byte++];
+ c = SREF (newtext, pos_byte++);
if (buf_multibyte)
c = unibyte_char_to_multibyte (c);
}
{
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
{
- c = XSTRING (newtext)->data[pos_byte++];
+ c = SREF (newtext, pos_byte++);
if (buf_multibyte)
c = unibyte_char_to_multibyte (c);
}
/* Replace the old text with the new in the cleanest possible way. */
replace_range (search_regs.start[sub], search_regs.end[sub],
newtext, 1, 0, 1);
- newpoint = search_regs.start[sub] + XSTRING (newtext)->size;
+ newpoint = search_regs.start[sub] + SCHARS (newtext);
if (case_action == all_caps)
Fupcase_region (make_number (search_regs.start[sub]),
Fupcase_initials_region (make_number (search_regs.start[sub]),
make_number (newpoint));
+ /* Adjust search data for this change. */
+ {
+ int oldend = search_regs.end[sub];
+ int change = newpoint - search_regs.end[sub];
+ int i;
+
+ for (i = 0; i < search_regs.num_regs; i++)
+ {
+ if (search_regs.start[i] > oldend)
+ search_regs.start[i] += change;
+ if (search_regs.end[i] > oldend)
+ search_regs.end[i] += change;
+ }
+ }
+
/* Put point back where it was in the text. */
if (opoint <= 0)
TEMP_SET_PT (opoint + ZV);
/* Now move point "officially" to the start of the inserted replacement. */
move_if_not_intangible (newpoint);
-
+
return Qnil;
}
\f
Lisp_Object subexp;
{
return match_limit (subexp, 0);
-}
+}
DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 2, 0,
doc: /* Return a list containing all info on what the last search matched.
If INTEGERS (the optional first argument) is non-nil, always use integers
\(rather than markers) to represent buffer positions.
If REUSE is a list, reuse it as part of the value. If REUSE is long enough
-to hold all the values, and if INTEGERS is non-nil, no consing is done. */)
+to hold all the values, and if INTEGERS is non-nil, no consing is done.
+
+Return value is undefined if the last search failed. */)
(integers, reuse)
Lisp_Object integers, reuse;
{
last_thing_searched);
data[2 * i + 1] = Fmake_marker ();
Fset_marker (data[2 * i + 1],
- make_number (search_regs.end[i]),
+ make_number (search_regs.end[i]),
last_thing_searched);
}
else
if (!CONSP (list) && !NILP (list))
list = wrong_type_argument (Qconsp, list);
- /* Unless we find a marker with a buffer in LIST, assume that this
+ /* Unless we find a marker with a buffer in LIST, assume that this
match data came from a string. */
last_thing_searched = Qt;
list = Fcdr (list);
}
- return Qnil;
+ return Qnil;
}
/* If non-zero the match data have been saved in saved_search_regs
CHECK_STRING (string);
- temp = (unsigned char *) alloca (STRING_BYTES (XSTRING (string)) * 2);
+ temp = (unsigned char *) alloca (SBYTES (string) * 2);
/* Now copy the data into the new string, inserting escapes. */
- in = XSTRING (string)->data;
- end = in + STRING_BYTES (XSTRING (string));
- out = temp;
+ in = SDATA (string);
+ end = in + SBYTES (string);
+ out = temp;
for (; in != end; in++)
{
}
return make_specified_string (temp,
- XSTRING (string)->size + backslashes_added,
+ SCHARS (string) + backslashes_added,
out - temp,
STRING_MULTIBYTE (string));
}
-\f
+\f
void
syms_of_search ()
{
for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
{
searchbufs[i].buf.allocated = 100;
- searchbufs[i].buf.buffer = (unsigned char *) malloc (100);
+ searchbufs[i].buf.buffer = (unsigned char *) xmalloc (100);
searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
searchbufs[i].regexp = Qnil;
staticpro (&searchbufs[i].regexp);
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
- #include "charset.h"
+ #include "character.h"
#include "keymap.h"
/* Make syntax table lookup grant data in gl_state. */
static int find_defun_start P_ ((int, int));
static int back_comment P_ ((int, int, int, int, int, int *, int *));
static int char_quoted P_ ((int, int));
- static Lisp_Object skip_chars P_ ((int, int, Lisp_Object, Lisp_Object));
+ static Lisp_Object skip_chars P_ ((int, Lisp_Object, Lisp_Object));
+ static Lisp_Object skip_syntaxes P_ ((int, Lisp_Object, Lisp_Object));
static Lisp_Object scan_lists P_ ((int, int, int, int));
static void scan_sexps_forward P_ ((struct lisp_parse_state *,
int, int, int, int,
if (invalidate)
invalidate = !EQ (tmp_table, gl_state.old_prop); /* Need to invalidate? */
-
+
if (invalidate) /* Did not get to adjacent interval. */
{ /* with the same table => */
/* invalidate the old range. */
if (EQ (Fsyntax_table_p (tmp_table), Qt))
{
gl_state.use_global = 0;
- }
+ }
else if (CONSP (tmp_table))
{
gl_state.use_global = 1;
gl_state.global_code = tmp_table;
}
- else
+ else
{
gl_state.use_global = 0;
gl_state.current_syntax_table = current_buffer->syntax_table;
}
return;
}
- else if (cnt == INTERVALS_AT_ONCE)
+ else if (cnt == INTERVALS_AT_ONCE)
{
if (count > 0)
{
while (bytepos >= beg)
{
UPDATE_SYNTAX_TABLE_BACKWARD (charpos);
- code = SYNTAX (FETCH_CHAR (bytepos));
+ code = SYNTAX (FETCH_CHAR_AS_MULTIBYTE (bytepos));
if (! (code == Scharquote || code == Sescape))
break;
It should be the last one before POS, or nearly the last.
When open_paren_in_column_0_is_defun_start is nonzero,
- the beginning of every line is treated as a defun-start.
+ only the beginning of the buffer is treated as a defun-start.
We record the information about where the scan started
and what its result was, so that another call in the same area
{
int opoint = PT, opoint_byte = PT_BYTE;
+ if (!open_paren_in_column_0_is_defun_start)
+ {
+ find_start_value_byte = BEGV_BYTE;
+ return BEGV;
+ }
+
/* Use previous finding, if it's valid and applies to this inquiry. */
if (current_buffer == find_start_buffer
/* Reuse the defun-start even if POS is a little farther on.
syntax-tables. */
gl_state.current_syntax_table = current_buffer->syntax_table;
gl_state.use_global = 0;
- if (open_paren_in_column_0_is_defun_start)
+ while (PT > BEGV)
{
- while (PT > BEGV)
+ /* Open-paren at start of line means we may have found our
+ defun-start. */
- if (SYNTAX (FETCH_CHAR (PT_BYTE)) == Sopen)
++ if (SYNTAX (FETCH_CHAR_AS_MULTIBYTE (PT_BYTE)) == Sopen)
{
- /* Open-paren at start of line means we may have found our
- defun-start. */
+ SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */
- if (SYNTAX (FETCH_CHAR (PT_BYTE)) == Sopen)
+ if (SYNTAX (FETCH_CHAR_AS_MULTIBYTE (PT_BYTE)) == Sopen)
- {
- SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */
- if (SYNTAX (FETCH_CHAR_AS_MULTIBYTE (PT_BYTE)) == Sopen)
- break;
- /* Now fallback to the default value. */
- gl_state.current_syntax_table = current_buffer->syntax_table;
- gl_state.use_global = 0;
- }
- /* Move to beg of previous line. */
- scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -2, 1);
+ break;
+ /* Now fallback to the default value. */
+ gl_state.current_syntax_table = current_buffer->syntax_table;
+ gl_state.use_global = 0;
}
+ /* Move to beg of previous line. */
+ scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -2, 1);
}
/* Record what we found, for the next try. */
* int pos, pos_byte;
* {
* int c, val;
- *
+ *
* DEC_BOTH (pos, pos_byte);
* UPDATE_SYNTAX_TABLE_BACKWARD (pos);
* c = FETCH_CHAR (pos_byte);
int string_style = -1; /* Presumed outside of any string. */
int string_lossage = 0;
/* Not a real lossage: indicates that we have passed a matching comment
- starter plus an non-matching comment-ender, meaning that any matching
+ starter plus a non-matching comment-ender, meaning that any matching
comment-starter we might see later could be a false positive (hidden
inside another comment).
Test case: { a (* b } c (* d *) */
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)
There's no way to grok this scanning backwards. */
string_lossage = 1;
break;
-
+
case Scomment:
/* We've already checked that it is the relevant comstyle. */
if (string_style != -1 || comment_lossage || string_lossage)
case Sendcomment:
if (SYNTAX_FLAGS_COMMENT_STYLE (syntax) == comstyle
- && (SYNTAX_FLAGS_COMMENT_NESTED (prev_syntax)
+ && ((com2end && SYNTAX_FLAGS_COMMENT_NESTED (prev_syntax))
|| SYNTAX_FLAGS_COMMENT_NESTED (syntax)) == comnested)
/* This is the same style of comment ender as ours. */
{
from_byte = CHAR_TO_BYTE (from);
UPDATE_SYNTAX_TABLE_FORWARD (from - 1);
}
-
+
done:
*charpos_ptr = from;
*bytepos_ptr = from_byte;
if (!(CHAR_TABLE_P (obj)
&& EQ (XCHAR_TABLE (obj)->purpose, Qsyntax_table)))
wrong_type_argument (Qsyntax_table_p, obj);
-}
+}
DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0,
doc: /* Return the current syntax table.
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,
(string)
Lisp_Object string;
{
- register unsigned char *p;
+ register const unsigned char *p;
register enum syntaxcode code;
int val;
Lisp_Object match;
CHECK_STRING (string);
- p = XSTRING (string)->data;
+ p = SDATA (string);
code = (enum syntaxcode) syntax_spec_code[*p++];
if (((int) code & 0377) == 0377)
error ("invalid syntax description letter: %c", p[-1]);
{
int len;
int character = (STRING_CHAR_AND_LENGTH
- (p, STRING_BYTES (XSTRING (string)) - 1, len));
+ (p, SBYTES (string) - 1, len));
XSETINT (match, character);
if (XFASTINT (match) == ' ')
match = Qnil;
val |= 1 << 22;
break;
}
-
+
if (val < XVECTOR (Vsyntax_code_object)->size && NILP (match))
return XVECTOR (Vsyntax_code_object)->contents[val];
else
/* I really don't know why this is interactive
help-form should at least be made useful whilst reading the second arg. */
-DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3,
+DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3,
"cSet syntax for character: \nsSet syntax for %s to: ",
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 (XCAR (c));
- CHECK_CHARACTER (XCDR (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);
return Qnil;
}
\f
\f
int parse_sexp_ignore_comments;
-Lisp_Object Vnext_word_boundary_function_table;
++/* 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;
while (count > 0)
{
- Lisp_Object func;
-
while (1)
{
if (from == end)
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 (Vnext_word_boundary_function_table, ch0);
++ 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;
- Lisp_Object pos;
-
+ pos = call2 (func, make_number (from - 1), make_number (end));
- from = XINT (pos);
- from_byte = CHAR_TO_BYTE (from);
++ if (INTEGERP (pos) && XINT (pos) > from)
++ {
++ from = XINT (pos);
++ from_byte = CHAR_TO_BYTE (from);
++ }
+ }
+ else
+ {
- Lisp_Object script;
-
+ 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--;
}
while (count < 0)
{
- Lisp_Object func;
-
while (1)
{
if (from == beg)
}
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 (Vnext_word_boundary_function_table, ch1);
++ func = CHAR_TABLE_REF (Vfind_word_boundary_function_table, ch1);
+ if (! NILP (Ffboundp (func)))
- {
- Lisp_Object pos;
-
++ {
+ pos = call2 (func, make_number (from), make_number (beg));
- from = XINT (pos);
- from_byte = CHAR_TO_BYTE (from);
++ if (INTEGERP (pos) && XINT (pos) < from)
++ {
++ from = XINT (pos);
++ from_byte = CHAR_TO_BYTE (from);
++ }
+ }
+ else
{
- int temp_byte;
- Lisp_Object script;
-
+ script = CHAR_TABLE_REF (Vchar_script_table, ch1);
+ while (1)
+ {
+ int temp_byte;
- if (from == beg)
- break;
- temp_byte = dec_bytepos (from_byte);
- UPDATE_SYNTAX_TABLE_BACKWARD (from);
- ch0 = FETCH_CHAR (temp_byte);
- code = SYNTAX (ch0);
- if (!(words_include_escapes
- && (code == Sescape || code == Scharquote)))
- if (code != Sword || WORD_BOUNDARY_P (ch0, ch1))
- break;
- DEC_BOTH (from, from_byte);
- ch1 = ch0;
+ if (from == beg)
+ break;
+ temp_byte = dec_bytepos (from_byte);
+ UPDATE_SYNTAX_TABLE_BACKWARD (from);
+ ch0 = FETCH_CHAR_AS_MULTIBYTE (temp_byte);
+ code = SYNTAX (ch0);
+ if ((code != Sword
+ && (! words_include_escapes
+ || (code != Sescape && code != Scharquote)))
+ || ! EQ (CHAR_TABLE_REF (Vchar_script_table, ch0), script))
+ break;
+ DEC_BOTH (from, from_byte);
+ ch1 = ch0;
+ }
}
count++;
}
/* Avoid jumping out of an input field. */
val = XFASTINT (Fconstrain_to_field (make_number (val), make_number (PT),
Qt, Qnil, Qnil));
-
+
SET_PT (val);
return val == orig_val ? Qt : Qnil;
}
(but not as the end of a range; quoting is never needed there).
Thus, with arg "a-zA-Z", this skips letters stopping before first nonletter.
With arg "^a-zA-Z", skips nonletters stopping before first letter.
-Returns the distance traveled, either zero or positive. */)
+Returns the distance traveled, either zero or positive.
+Note that char classes, e.g. `[:alpha:]', are not currently supported;
+they will be treated as literals. */)
(string, lim)
Lisp_Object string, lim;
{
- return skip_chars (1, 0, string, lim);
+ return skip_chars (1, string, lim);
}
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);
+ return skip_chars (0, string, lim);
}
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);
+ 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);
+ return skip_syntaxes (0, syntax, lim);
}
static Lisp_Object
- skip_chars (forwardp, syntaxp, string, lim)
- int forwardp, syntaxp;
+ skip_chars (forwardp, string, lim)
+ int forwardp;
Lisp_Object string, lim;
{
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;
- unsigned char *str;
+ const unsigned char *str;
int len;
CHECK_STRING (string);
- char_ranges = (int *) alloca (SCHARS (string) * (sizeof (int)) * 2);
- string_multibyte = STRING_MULTIBYTE (string);
- str = SDATA (string);
- size_byte = SBYTES (string);
-
- /* 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);
if (XINT (lim) < BEGV)
XSETFASTINT (lim, BEGV);
- string_multibyte = STRING_BYTES (XSTRING (string)) > XSTRING (string)->size;
+ 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);
- char_ranges = (int *) alloca (XSTRING (string)->size * (sizeof (int)) * 2);
+ if (multibyte)
++ char_ranges = (int *) alloca (SCHARS (string) * (sizeof (int)) * 2);
- i_byte = 0;
- str = XSTRING (string)->data;
- size_byte = STRING_BYTES (XSTRING (string));
++ str = SDATA (string);
++ size_byte = SBYTES (string);
+ i_byte = 0;
if (i_byte < size_byte
- && XSTRING (string)->data[0] == '^')
+ && SREF (string, 0) == '^')
{
negate = 1; i_byte++;
}
/* 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 (c == '\\')
+ {
+ if (i_byte == size_byte)
+ break;
+
+ c = str[i_byte++];
+ }
+ if (i_byte < size_byte
+ && str[i_byte] == '-')
+ {
+ unsigned int c2;
+
+ /* Skip over the dash. */
+ i_byte++;
+
+ if (i_byte == size_byte)
+ break;
+
+ /* Get the end of the range. */
+ c2 = str[i_byte++];
+ if (c2 == '\\'
+ && i_byte < size_byte)
+ c2 = str[i_byte++];
+
- while (c <= c2)
- fastmap[c++] = 1;
- if (! ASCII_CHAR_P (c2))
- string_has_eight_bit = 1;
++ 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;
+ 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
+ {
+ 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 (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++;
break;
/* Get the end of the range. */
- c2 =STRING_CHAR_AND_LENGTH (str+i_byte, size_byte-i_byte, len);
+ 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 (ASCII_CHAR_P (c))
{
- if (! SINGLE_BYTE_CHAR_P (c2))
+ while (c <= c2 && c < 0x80)
+ fastmap[c++] = 1;
+ leading_code = CHAR_LEADING_CODE (c);
+ }
+ if (! ASCII_CHAR_P (c))
+ {
+ 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;
int pos = PT;
int pos_byte = PT_BYTE;
- endp = (XINT (lim) == GPT) ? GPT_ADDR : CHAR_POS_ADDR (XINT (lim));
- stop = (pos < GPT && GPT < XINT (lim)) ? GPT_ADDR : endp;
+ unsigned char *p = PT_ADDR, *endp, *stop;
+
+ if (forwardp)
+ {
- endp = CHAR_POS_ADDR (XINT (lim));
- stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp;
++ 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;
+ }
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 (pos < XINT (lim))
++ while (1)
+ {
- c = FETCH_BYTE (pos_byte);
- if (! fastmap[c])
++ 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 >= stop)
- {
- if (p >= endp)
- break;
- p = GAP_END_ADDR;
- stop = endp;
- }
- if (! fastmap[(int) SYNTAX (*p)])
++ if (p >= endp)
+ break;
- p++, pos++;
- UPDATE_SYNTAX_TABLE_FORWARD (pos);
++ p = GAP_END_ADDR;
++ stop = endp;
+ }
- }
- else
- {
- if (multibyte)
- while (1)
++ if (! fastmap[*p])
+ break;
++ c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes);
+ if (! ASCII_CHAR_P (c))
{
- 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;
- c = FETCH_MULTIBYTE_CHAR (pos_byte);
+ /* 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)
- /* Since we already checked for multibyteness, avoid
- using INC_BOTH which checks again. */
- INC_POS (pos_byte);
- pos++;
++ p += nbytes, pos++, pos_byte += nbytes;
+ }
+ else
- {
- while (pos < XINT (lim) && fastmap[FETCH_BYTE (pos_byte)])
- pos++, pos_byte++;
- }
++ while (1)
++ {
++ if (p >= stop)
+ {
- if (p <= stop)
- {
- if (p <= endp)
- break;
- p = GPT_ADDR;
- stop = endp;
- }
- if (! fastmap[(int) SYNTAX (p[-1])])
++ if (p >= endp)
+ break;
- p--, pos--;
- UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1);
++ p = GAP_END_ADDR;
++ stop = endp;
+ }
- }
++ if (!fastmap[*p])
++ break;
++ p++, pos++, pos_byte++;
++ }
}
else
{
- if (forwardp)
- {
- if (multibyte)
- while (1)
- {
- int nbytes;
+ if (multibyte)
- while (pos > XINT (lim))
++ while (1)
+ {
- int prev_pos_byte = pos_byte;
++ unsigned char *prev_p;
- if (p >= stop)
- {
- if (p >= endp)
- break;
- p = GAP_END_ADDR;
- stop = endp;
- }
- c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes);
- if (SINGLE_BYTE_CHAR_P (c))
- {
- if (!fastmap[c])
- 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;
- }
- p += nbytes, pos++, pos_byte += nbytes;
- }
- else
- while (1)
- DEC_POS (prev_pos_byte);
- c = FETCH_BYTE (prev_pos_byte);
- if (! fastmap[c])
++ if (p <= stop)
+ {
- if (p >= stop)
- {
- if (p >= endp)
- break;
- p = GAP_END_ADDR;
- stop = endp;
- }
- if (!fastmap[*p])
++ if (p <= endp)
+ break;
- p++, pos++;
++ p = GPT_ADDR;
++ stop = endp;
+ }
- }
- else
- {
- if (multibyte)
- while (1)
++ prev_p = p;
++ while (--p >= stop && ! CHAR_HEAD_P (*p));
++ if (! fastmap[*p])
+ break;
++ c = STRING_CHAR (p, MAX_MULTIBYTE_LENGTH);
+ if (! ASCII_CHAR_P (c))
{
- 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);
- 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;
- }
- pos--, pos_byte -= nbytes;
- c = FETCH_MULTIBYTE_CHAR (prev_pos_byte);
+ /* 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;
}
- else
- while (1)
- pos--;
- pos_byte = prev_pos_byte;
++ pos--, pos_byte -= prev_p - p;
+ }
+ else
- {
- while (pos > XINT (lim) && fastmap[FETCH_BYTE (pos_byte - 1)])
- pos--, pos_byte--;
- }
++ while (1)
++ {
++ if (p <= stop)
+ {
- if (p <= stop)
- {
- if (p <= endp)
- break;
- p = GPT_ADDR;
- stop = endp;
- }
- if (!fastmap[p[-1]])
++ if (p <= endp)
+ break;
- p--, pos--;
++ p = GPT_ADDR;
++ stop = endp;
+ }
- }
++ if (!fastmap[p[-1]])
++ break;
++ p--, pos--, pos_byte--;
++ }
}
- #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
+ SET_PT_BOTH (pos, pos_byte);
+ immediate_quit = 0;
+
+ return make_number (PT - start_point);
+ }
+ }
- if (! multibyte)
- pos_byte = 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 Qnil;
+
+ multibyte = (!NILP (current_buffer->enable_multibyte_characters)
+ && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE));
+
+ bzero (fastmap, sizeof fastmap);
+
- if (STRING_BYTES (XSTRING (string)) > XSTRING (string)->size)
- /* As this is very rare case, don't consider efficiency. */
++ 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 = XSTRING (string)->data;
- size_byte = STRING_BYTES (XSTRING (string));
++ str = SDATA (string);
++ size_byte = SBYTES (string);
+
+ i_byte = 0;
+ if (i_byte < size_byte
- && XSTRING (string)->data[0] == '^')
++ && 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;
++ 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;
++ }
+
+ immediate_quit = 1;
+ SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
+ if (forwardp)
+ {
+ if (multibyte)
+ {
- while (fastmap[(int) SYNTAX (FETCH_CHAR (pos_byte))])
++ while (1)
+ {
- /* Since we already checked for multibyteness,
- avoid using INC_BOTH which checks again. */
- INC_POS (pos_byte);
- pos++;
- if (pos >= XINT (lim))
++ 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)
+ {
- c = FETCH_BYTE (pos_byte);
- MAKE_CHAR_MULTIBYTE (c);
- if (! fastmap[(int) SYNTAX (c)])
- break;
- pos++, pos_byte++;
- if (pos >= XINT (lim))
++ 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)
+ {
- int savepos = pos_byte;
- /* Since we already checked for multibyteness,
- avoid using DEC_BOTH which checks again. */
- pos--;
- DEC_POS (pos_byte);
- if (pos <= XINT (lim))
- break;
- UPDATE_SYNTAX_TABLE_BACKWARD (pos);
- if (!fastmap[(int) SYNTAX (FETCH_CHAR (pos_byte))])
++ unsigned char *prev_p;
++
++ if (p <= stop)
+ {
- pos++;
- pos_byte = savepos;
- break;
++ 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 (! fastmap[(int) SYNTAX (c)])
++ break;
++ pos--, pos_byte -= prev_p - p;
++ UPDATE_SYNTAX_TABLE_BACKWARD (pos);
+ }
+ }
+ else
+ {
+ while (1)
+ {
- c = FETCH_BYTE (pos_byte - 1);
- MAKE_CHAR_MULTIBYTE (c);
- if (! fastmap[(int) SYNTAX (c)])
- break;
- pos--, pos_byte--;
- if (pos <= XINT (lim))
++ if (p <= stop)
++ {
++ if (p <= endp)
++ break;
++ p = GPT_ADDR;
++ stop = endp;
++ }
++ if (! fastmap[(int) SYNTAX (p[-1])])
+ break;
++ p--, pos--, pos_byte--;
+ UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1);
+ }
+ }
+ }
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
nesting++;
INC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
-
+
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) ||
}
DEFUN ("forward-comment", Fforward_comment, Sforward_comment, 1, 1, 0,
- doc: /* Move forward across up to N comments. If N is negative, move backward.
+ doc: /*
+Move forward across up to COUNT comments. If COUNT is negative, move backward.
Stop scanning if we find something other than a comment or whitespace.
Set point to where scanning stops.
-If N comments are found as expected, with nothing except whitespace
+If COUNT comments are found as expected, with nothing except whitespace
between them, return t; otherwise return nil. */)
(count)
Lisp_Object count;
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
+ /* We have encountered a comment start sequence and we
are ignoring all text inside comments. We must record
the comment style this sequence begins so that later,
only a comment end of the same style actually ends
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);
}
{
/* Skip until first preceding unquoted comment_fence. */
int found = 0, ini = from, ini_byte = from_byte;
-
+
while (1)
{
DEC_BOTH (from, from_byte);
if (from == stop)
break;
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))
+ && !char_quoted (from, from_byte))
{
- found = 1;
+ found = 1;
break;
}
}
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
- && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from_byte))
+ && SYNTAX_COMSTART_SECOND (FETCH_CHAR_AS_MULTIBYTE (from_byte))
&& parse_sexp_ignore_comments)
{
- /* we have encountered a comment start sequence and we
+ /* we have encountered a comment start sequence and we
are ignoring all text inside comments. We must record
the comment style this sequence begins so that later,
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);
}
-
+
if (prefix)
continue;
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)
INC_BOTH (from, from_byte);
if (!depth && sexpflag) goto done;
break;
+ default:
+ /* Ignore whitespace, punctuation, quote, endcomment. */
+ break;
}
}
{
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);
}
-
+
/* Quoting turns anything except a comment-ender
into a word character. Note that this cannot be true
if we decremented FROM in the if-statement above. */
if (code != Sendcomment && char_quoted (from, from_byte))
- code = Sword;
+ {
+ DEC_BOTH (from, from_byte);
+ code = Sword;
+ }
else if (SYNTAX_PREFIX (c))
continue;
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);
if (from == stop) goto lose;
UPDATE_SYNTAX_TABLE_BACKWARD (from);
- if (!char_quoted (from, from_byte)
+ 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;
}
if (code == Sstring_fence && !depth && sexpflag) goto done2;
break;
-
+
case Sstring:
- stringterm = FETCH_CHAR (from_byte);
+ stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte);
while (1)
{
if (from == stop) goto lose;
temp_pos--;
UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
if (!char_quoted (from - 1, temp_pos)
- && stringterm == (c = FETCH_CHAR (temp_pos))
+ && stringterm == (c = FETCH_CHAR_AS_MULTIBYTE (temp_pos))
&& SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring)
break;
DEC_BOTH (from, from_byte);
DEC_BOTH (from, from_byte);
if (!depth && sexpflag) goto done2;
break;
+ default:
+ /* Ignore whitespace, punctuation, quote, endcomment. */
+ break;
}
}
int pos_byte = PT_BYTE;
int c;
- if (pos <= beg)
+ if (pos <= beg)
{
SET_PT_BOTH (opoint, opoint_byte);
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;
{
do { prev_from = from; \
prev_from_byte = from_byte; \
prev_from_syntax \
-- = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte)); \
++ = SYNTAX_WITH_FLAGS (FETCH_CHAR_AS_MULTIBYTE (prev_from_byte)); \
INC_BOTH (from, from_byte); \
- UPDATE_SYNTAX_TABLE_FORWARD (from); \
+ if (from < end) \
+ UPDATE_SYNTAX_TABLE_FORWARD (from); \
} while (0)
immediate_quit = 1;
oldstate = Fcdr (oldstate);
tem = Fcar (oldstate);
/* Check whether we are inside string_fence-style string: */
- state.instring = (!NILP (tem)
- ? (INTEGERP (tem) ? XINT (tem) : ST_STRING_STYLE)
+ state.instring = (!NILP (tem)
+ ? (INTEGERP (tem) ? XINT (tem) : ST_STRING_STYLE)
: -1);
oldstate = Fcdr (oldstate);
oldstate = Fcdr (oldstate);
oldstate = Fcdr (oldstate);
tem = Fcar (oldstate);
- state.comstyle = NILP (tem) ? 0 : (EQ (tem, Qsyntax_table)
+ state.comstyle = NILP (tem) ? 0 : (EQ (tem, Qsyntax_table)
? ST_COMMENT_STYLE : 1);
oldstate = Fcdr (oldstate);
else if (start_quoted)
goto startquoted;
-#if 0 /* This seems to be redundant with the identical code above. */
- SETUP_SYNTAX_TABLE (prev_from, 1);
- prev_from_syntax = SYNTAX_WITH_FLAGS (FETCH_CHAR (prev_from_byte));
- UPDATE_SYNTAX_TABLE_FORWARD (from);
-#endif
-
while (from < end)
{
INC_FROM;
}
else if (from < end)
if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax))
-- if (c1 = FETCH_CHAR (from_byte),
++ if (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte),
SYNTAX_COMSTART_SECOND (c1))
/* Duplicate code to avoid a complex if-expression
which causes trouble for the SGI compiler. */
/* Record the comment style we have entered so that only
the comment-end sequence of the same style actually
terminates the comment section. */
- state.comstyle = SYNTAX_COMMENT_STYLE (FETCH_CHAR (from_byte));
+ state.comstyle = SYNTAX_COMMENT_STYLE (c1);
comnested = SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax);
comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
state.incomment = comnested ? 1 : -1;
while (from < end)
{
/* Some compilers can't handle this inside the switch. */
- temp = SYNTAX (FETCH_CHAR (from_byte));
+ temp = SYNTAX (FETCH_CHAR_AS_MULTIBYTE (from_byte));
switch (temp)
{
case Scharquote:
curlevel->prev = curlevel->last;
break;
+ case Scomment_fence: /* Can't happen because it's handled above. */
case Scomment:
if (commentstop || boundary_stop) goto done;
startincomment:
state.comstr_start = from - 1;
if (stopbefore) goto stop; /* this arg means stop at sexp start */
curlevel->last = prev_from;
- state.instring = (code == Sstring
+ 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:
{
nofence = state.instring != ST_STRING_STYLE;
-
+
while (1)
{
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);
break;
case Smath:
+ /* FIXME: We should do something with it. */
+ break;
+ default:
+ /* Ignore whitespace, punctuation, quote, endcomment. */
break;
}
}
3. non-nil if inside a string.
(it is the character that will terminate the string,
or t if the string should be terminated by a generic string delimiter.)
- 4. nil if outside a comment, t if inside a non-nestable comment,
+ 4. nil if outside a comment, t if inside a non-nestable comment,
else an integer (the current comment nesting).
5. t if following a quote character.
6. the minimum paren-depth encountered during this scan.
scan_sexps_forward (&state, XINT (from), CHAR_TO_BYTE (XINT (from)),
XINT (to),
target, !NILP (stopbefore), oldstate,
- (NILP (commentstop)
+ (NILP (commentstop)
? 0 : (EQ (commentstop, Qsyntax_table) ? -1 : 1)));
SET_PT (state.location);
-
+
return Fcons (make_number (state.depth),
Fcons (state.prevlevelstart < 0 ? Qnil : make_number (state.prevlevelstart),
Fcons (state.thislevelstart < 0 ? Qnil : make_number (state.thislevelstart),
- Fcons (state.instring >= 0
- ? (state.instring == ST_STRING_STYLE
+ Fcons (state.instring >= 0
+ ? (state.instring == ST_STRING_STYLE
? Qt : make_number (state.instring)) : Qnil,
Fcons (state.incomment < 0 ? Qt :
(state.incomment == 0 ? Qnil :
make_number (state.incomment)),
Fcons (state.quoted ? Qt : Qnil,
Fcons (make_number (state.mindepth),
- Fcons ((state.comstyle
+ Fcons ((state.comstyle
? (state.comstyle == ST_COMMENT_STYLE
? Qsyntax_table : Qt) :
Qnil),
/* 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 `forward-word', etc., should treat escape chars part of words. */);
DEFVAR_BOOL ("multibyte-syntax-as-symbol", &multibyte_syntax_as_symbol,
- doc: /* Non-nil means `scan-sexps' treats all multibyte characters as symbol constituents. */);
+ doc: /* Non-nil means `scan-sexps' treats all multibyte characters as symbol. */);
multibyte_syntax_as_symbol = 0;
DEFVAR_BOOL ("open-paren-in-column-0-is-defun-start",
&open_paren_in_column_0_is_defun_start,
- doc: /* Non-nil means an open paren in column 0 denotes the start of a defun. */);
+ 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 ("next-word-boundary-function-table",
- &Vnext_word_boundary_function_table,
++
++ DEFVAR_LISP ("find-word-boundary-function-table",
++ &Vfind_word_boundary_function_table,
+ doc: /*
-Char table of functions to search for the next word boundary.
++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. */);
- Vnext_word_boundary_function_table = Fmake_char_table (Qnil, Qnil);
++ 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, 93, 94, 97, 1998, 2002 Free Software Foundation, Inc.
+ Copyright (C) 1985, 93, 94, 97, 1998 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) < CHAR_TABLE_SINGLE_BYTE_SLOTS \
- ? (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 tbl = table; \
- Lisp_Object temp = XCHAR_TABLE (tbl)->contents[(c)]; \
- while (NILP (temp)) \
- { \
- tbl = XCHAR_TABLE (tbl)->parent; \
- if (NILP (tbl)) \
- break; \
- temp = XCHAR_TABLE (tbl)->contents[(c)]; \
- } \
- 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).
+ in syntax table TABLE, or from globally kept data (gl_state).
Does inheritance. */
/* CURRENT_SYNTAX_TABLE gives the syntax table valid for current
position, it is either the buffer's syntax table, or syntax table
# define CURRENT_SYNTAX_TABLE current_buffer->syntax_table
#endif
- #define SYNTAX_ENTRY_INT(c) \
- ((c) < CHAR_TABLE_SINGLE_BYTE_SLOTS \
- ? 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 (temp) \
: Qnil); })
#else
+ extern Lisp_Object syntax_temp;
#define SYNTAX(c) \
(syntax_temp = SYNTAX_ENTRY ((c)), \
(CONSP (syntax_temp) \
search, or after the last position of the backward search. It
makes sure that the first char is picked up with correct table, so
one does not need to call UPDATE_SYNTAX_TABLE immediately after the
- call.
+ call.
Sign of COUNT gives the direction of the search.
*/
else \
{ \
gl_state.b_property = 0; \
- gl_state.e_property = 1 + XSTRING (gl_state.object)->size; \
+ gl_state.e_property = 1 + SCHARS (gl_state.object); \
gl_state.offset = 0; \
} \
gl_state.use_global = 0; \
/* Terminal control module for terminals described by TERMCAP
- Copyright (C) 1985, 86, 87, 93, 94, 95, 98, 2000, 2001
+ Copyright (C) 1985, 86, 87, 93, 94, 95, 98, 2000, 2001, 2002
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "termchar.h"
#include "termopts.h"
#include "lisp.h"
+ #include "buffer.h"
+ #include "character.h"
#include "charset.h"
#include "coding.h"
#include "keyboard.h"
#ifdef HAVE_X_WINDOWS
#include "xterm.h"
#endif
-#ifdef macintosh
+#ifdef MAC_OS
#include "macterm.h"
#endif
static void tty_hide_cursor P_ ((void));
#define OUTPUT(a) \
- tputs (a, (int) (FRAME_HEIGHT (XFRAME (selected_frame)) - curY), cmputc)
+ tputs (a, (int) (FRAME_LINES (XFRAME (selected_frame)) - curY), cmputc)
#define OUTPUT1(a) tputs (a, 1, cmputc)
#define OUTPUTL(a, lines) tputs (a, lines, cmputc)
#define OUTPUT_IF(a) \
do { \
if (a) \
- tputs (a, (int) (FRAME_HEIGHT (XFRAME (selected_frame)) \
+ tputs (a, (int) (FRAME_LINES (XFRAME (selected_frame)) \
- curY), cmputc); \
} while (0)
-
+
#define OUTPUT1_IF(a) do { if (a) tputs (a, 1, cmputc); } while (0)
/* Function to use to ring the bell. */
/* Arrange for all scroll bars on FRAME to be removed at the next call
to `*judge_scroll_bars_hook'. A scroll bar may be spared if
- `*redeem_scroll_bar_hook' is applied to its window before the judgment.
+ `*redeem_scroll_bar_hook' is applied to its window before the judgment.
This should be applied to each frame each time its window tree is
redisplayed, even if it is not displaying scroll bars at the moment;
void (*redeem_scroll_bar_hook) P_ ((struct window *window));
/* Remove all scroll bars on FRAME that haven't been saved since the
- last call to `*condemn_scroll_bars_hook'.
+ last call to `*condemn_scroll_bars_hook'.
This should be applied to each frame after each time its window
tree is redisplayed, even if it is not displaying scroll bars at the
void (*judge_scroll_bars_hook) P_ ((FRAME_PTR FRAME));
-/* Hook to call in estimate_mode_line_height, if any. */
-
-int (* estimate_mode_line_height_hook) P_ ((struct frame *f, enum face_id));
-
-
/* Strings, numbers and flags taken from the termcap entry. */
char *TS_ins_line; /* "al" */
/* The largest frame width in any call to calculate_costs. */
-int max_frame_width;
+int max_frame_cols;
/* The largest frame height in any call to calculate_costs. */
-int max_frame_height;
+int max_frame_lines;
static int costs_set; /* Nonzero if costs have been calculated. */
This is the number of lines, from the top of frame downwards,
which can participate in insert-line/delete-line operations.
- Effectively it excludes the bottom frame_height - specified_window_size
+ Effectively it excludes the bottom frame_lines - specified_window_size
lines from those operations. */
int specified_window;
We don't specbind it, because that would carefully
restore the bad value if there's an error
and make the loop of errors happen anyway. */
-
+
function = Vring_bell_function;
Vring_bell_function = Qnil;
}
else
update_end_hook (f);
-
+
updating_frame = NULL;
}
{
if (FRAME_TERMCAP_P (updating_frame))
{
- specified_window = size ? size : FRAME_HEIGHT (updating_frame);
+ specified_window = size ? size : FRAME_LINES (updating_frame);
if (scroll_region_ok)
set_scroll_region (0, specified_window);
}
{
char *buf;
struct frame *sf = XFRAME (selected_frame);
-
+
if (TS_set_scroll_region)
buf = tparam (TS_set_scroll_region, 0, 0, start, stop - 1);
else if (TS_set_scroll_region_1)
buf = tparam (TS_set_scroll_region_1, 0, 0,
- FRAME_HEIGHT (sf), start,
- FRAME_HEIGHT (sf) - stop,
- FRAME_HEIGHT (sf));
+ FRAME_LINES (sf), start,
+ FRAME_LINES (sf) - stop,
+ FRAME_LINES (sf));
else
- buf = tparam (TS_set_window, 0, 0, start, 0, stop, FRAME_WIDTH (sf));
-
+ buf = tparam (TS_set_window, 0, 0, start, 0, stop, FRAME_COLS (sf));
+
OUTPUT (buf);
xfree (buf);
losecursor ();
int vpos, hpos;
{
struct frame *f = updating_frame ? updating_frame : XFRAME (selected_frame);
-
+
if (! FRAME_TERMCAP_P (f) && cursor_to_hook)
{
(*cursor_to_hook) (vpos, hpos);
}
else
{
- for (i = curY; i < FRAME_HEIGHT (XFRAME (selected_frame)); i++)
+ for (i = curY; i < FRAME_LINES (XFRAME (selected_frame)); i++)
{
cursor_to (i, 0);
- clear_end_of_line (FRAME_WIDTH (XFRAME (selected_frame)));
+ clear_end_of_line (FRAME_COLS (XFRAME (selected_frame)));
}
}
}
clear_frame ()
{
struct frame *sf = XFRAME (selected_frame);
-
+
if (clear_frame_hook
&& ! FRAME_TERMCAP_P ((updating_frame ? updating_frame : sf)))
{
turn_off_insert ();
/* Do not write in last row last col with Auto-wrap on. */
- if (AutoWrap && curY == FRAME_HEIGHT (sf) - 1
- && first_unused_hpos == FRAME_WIDTH (sf))
+ if (AutoWrap && curY == FRAME_LINES (sf) - 1
+ && first_unused_hpos == FRAME_COLS (sf))
first_unused_hpos--;
for (i = curX; i < first_unused_hpos; i++)
struct glyph *src_start = src, *src_end = src + src_len;
unsigned char *dst_start = dst, *dst_end = dst + dst_len;
register GLYPH g;
- unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *buf;
+ unsigned char workbuf[MAX_MULTIBYTE_LENGTH];
+ const unsigned char *buf;
int len;
register int tlen = GLYPH_TABLE_LENGTH;
register Lisp_Object *tbase = GLYPH_TABLE_BASE;
- int result;
struct coding_system *coding;
/* If terminal_coding does any conversion, use it, otherwise use
if (g < 0 || g >= tlen)
{
- /* This glyph doesn't has an entry in Vglyph_table. */
+ /* This glyph doesn't have an entry in Vglyph_table. */
if (! CHAR_VALID_P (src->u.ch, 0))
{
len = 1;
coding->src_multibyte = STRING_MULTIBYTE (tbase[g]);
}
}
-
+
- result = encode_coding (coding, buf, dst, len, dst_end - dst);
+ coding->source = buf;
+ coding->destination = dst;
+ coding->dst_bytes = dst_end - dst;
+ encode_coding_object (coding, Qnil, 0, 0, 1, len, Qnil);
len -= coding->consumed;
dst += coding->produced;
- if (result == CODING_FINISH_INSUFFICIENT_DST
- || (result == CODING_FINISH_INSUFFICIENT_SRC
- && len > dst_end - dst))
+ if (coding->result == CODING_RESULT_INSUFFICIENT_DST)
/* The remaining output buffer is too short. We must
break the loop here without increasing SRC so that the
next call of this function starts from the same glyph. */
}
src++;
}
-
+
*consumed = src - src_start;
return (dst - dst_start);
}
since that would scroll the whole frame on some terminals. */
if (AutoWrap
- && curY + 1 == FRAME_HEIGHT (sf)
- && (curX + len) == FRAME_WIDTH (sf))
+ && curY + 1 == FRAME_LINES (sf)
+ && (curX + len) == FRAME_COLS (sf))
len --;
if (len <= 0)
return;
cmplus (len);
-
+
/* The mode bit CODING_MODE_LAST_BLOCK should be set to 1 only at
the tail. */
terminal_coding.mode &= ~CODING_MODE_LAST_BLOCK;
-
+
while (len > 0)
{
/* Identify a run of glyphs with the same face. */
int face_id = string->face_id;
int n;
-
+
for (n = 1; n < len; ++n)
if (string[n].face_id != face_id)
break;
turn_off_face (f, face_id);
turn_off_highlight ();
}
-
+
/* We may have to output some codes to terminate the writing. */
if (CODING_REQUIRE_FLUSHING (&terminal_coding))
{
terminal_coding.mode |= CODING_MODE_LAST_BLOCK;
- encode_coding (&terminal_coding, "", conversion_buffer,
- 0, conversion_buffer_size);
+ terminal_coding.source = (unsigned char *) "";
+ terminal_coding.destination = conversion_buffer;
+ terminal_coding.dst_bytes = conversion_buffer_size;
+ encode_coding_object (&terminal_coding, Qnil, 0, 0, 0, 0, Qnil);
if (terminal_coding.produced > 0)
{
fwrite (conversion_buffer, 1, terminal_coding.produced, stdout);
termscript);
}
}
-
+
cmcheckmagic ();
}
/* If start is zero, insert blanks instead of a string at start */
-
+
void
insert_glyphs (start, len)
register struct glyph *start;
turn_off_highlight ();
}
}
-
+
cmcheckmagic ();
}
}
sf = XFRAME (selected_frame);
-
+
/* If the lines below the insertion are being pushed
into the end of the window, this is the same as clearing;
and we know the lines are already clear, since the matching
as there will be a matching inslines later that will flush them. */
if (scroll_region_ok && vpos + i >= specified_window)
return;
- if (!memory_below_frame && vpos + i >= FRAME_HEIGHT (sf))
+ if (!memory_below_frame && vpos + i >= FRAME_LINES (sf))
return;
if (multi)
if (!scroll_region_ok && memory_below_frame && n < 0)
{
- cursor_to (FRAME_HEIGHT (sf) + n, 0);
+ cursor_to (FRAME_LINES (sf) + n, 0);
clear_to_end ();
}
}
#ifndef old
/* char_ins_del_cost[n] is cost of inserting N characters.
char_ins_del_cost[-n] is cost of deleting N characters.
- The length of this vector is based on max_frame_width. */
+ The length of this vector is based on max_frame_cols. */
int *char_ins_del_vector;
-#define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_WIDTH ((f))])
+#define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_COLS ((f))])
#endif
/* ARGSUSED */
/* Delete costs are at negative offsets */
p = &char_ins_del_cost (frame)[0];
- for (i = FRAME_WIDTH (frame); --i >= 0;)
+ for (i = FRAME_COLS (frame); --i >= 0;)
*--p = (del_startup_cost += del_cost_per_char);
/* Doing nothing is free */
*p++ = 0;
/* Insert costs are at positive offsets */
- for (i = FRAME_WIDTH (frame); --i >= 0;)
+ for (i = FRAME_COLS (frame); --i >= 0;)
*p++ = (ins_startup_cost += ins_cost_per_char);
}
char_ins_del_vector (i.e., char_ins_del_cost) isn't used because
X turns off char_ins_del_ok. */
- max_frame_height = max (max_frame_height, FRAME_HEIGHT (frame));
- max_frame_width = max (max_frame_width, FRAME_WIDTH (frame));
+ max_frame_lines = max (max_frame_lines, FRAME_LINES (frame));
+ max_frame_cols = max (max_frame_cols, FRAME_COLS (frame));
costs_set = 1;
char_ins_del_vector
= (int *) xrealloc (char_ins_del_vector,
(sizeof (int)
- + 2 * max_frame_width * sizeof (int)));
+ + 2 * max_frame_cols * sizeof (int)));
else
char_ins_del_vector
= (int *) xmalloc (sizeof (int)
- + 2 * max_frame_width * sizeof (int));
+ + 2 * max_frame_cols * sizeof (int));
bzero (char_ins_del_vector, (sizeof (int)
- + 2 * max_frame_width * sizeof (int)));
+ + 2 * max_frame_cols * sizeof (int)));
if (f && (!TS_ins_line && !TS_del_line))
do_line_insertion_deletion_costs (frame,
if (TS_repeat && per_line_cost (TS_repeat) * baud_rate < 9000)
RPov = string_cost (TS_repeat);
else
- RPov = FRAME_WIDTH (frame) * 2;
+ RPov = FRAME_COLS (frame) * 2;
cmcostinit (); /* set up cursor motion costs */
}
static Lisp_Object term_get_fkeys_1 ();
/* Find the escape codes sent by the function keys for Vfunction_key_map.
- This function scans the termcap function key sequence entries, and
+ This function scans the termcap function key sequence entries, and
adds entries to Vfunction_key_map for each function key it finds. */
void
Fmake_vector (make_number (1), \
intern (sym))); \
}
-
+
/* if there's no key_next keycap, map key_npage to `next' keysym */
CONDITIONAL_REASSIGN ("%5", "kN", "next");
/* if there's no key_prev keycap, map key_ppage to `previous' keysym */
for which to produce glyphs; IT->face_id contains the character's
face. Padding glyphs are appended if IT->c has a IT->pixel_width >
1. */
-
+
static void
append_glyph (it)
struct it *it;
+ it->glyph_row->used[it->area]);
end = it->glyph_row->glyphs[1 + it->area];
- for (i = 0;
- i < it->pixel_width && glyph < end;
+ for (i = 0;
+ i < it->pixel_width && glyph < end;
++i)
{
glyph->type = CHAR_GLYPH;
glyph->padding_p = i > 0;
glyph->charpos = CHARPOS (it->position);
glyph->object = it->object;
-
+
++it->glyph_row->used[it->area];
++glyph;
}
}
-/* Produce glyphs for the display element described by IT. The
- function fills output fields of IT with pixel information like the
- pixel width and height of a character, and maybe produces glyphs at
+/* Produce glyphs for the display element described by IT. *IT
+ specifies what we want to produce a glyph for (character, image, ...),
+ and where in the glyph matrix we currently are (glyph row and hpos).
+ produce_glyphs fills in output fields of *IT with information such as the
+ pixel width and height of a character, and maybe output actual glyphs at
the same time if IT->glyph_row is non-null. See the explanation of
- struct display_iterator in dispextern.h for an overview. */
+ struct display_iterator in dispextern.h for an overview.
+
+ produce_glyphs also stores the result of glyph width, ascent
+ etc. computations in *IT.
-void
+ IT->glyph_row may be null, in which case produce_glyphs does not
+ actually fill in the glyphs. This is used in the move_* functions
+ in xdisp.c for text width and height computations.
+
+ Callers usually don't call produce_glyphs directly;
+ instead they use the macro PRODUCE_GLYPHS. */
+
+void
produce_glyphs (it)
struct it *it;
{
|| it->what == IT_COMPOSITION
|| it->what == IT_IMAGE
|| it->what == IT_STRETCH);
-
+
/* Nothing but characters are supported on terminal frames. For a
composition sequence, it->c is the first character of the
sequence. */
{
int absolute_x = (it->current_x
+ it->continuation_lines_width);
- int next_tab_x
- = (((1 + absolute_x + it->tab_width - 1)
+ int next_tab_x
+ = (((1 + absolute_x + it->tab_width - 1)
/ it->tab_width)
* it->tab_width);
int nspaces;
continued line. So, we will get the right number of spaces
here. */
nspaces = next_tab_x - absolute_x;
-
+
if (it->glyph_row)
{
int n = nspaces;
-
+
it->c = ' ';
it->pixel_width = it->len = 1;
-
+
while (n--)
append_glyph (it);
-
+
it->c = '\t';
}
}
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_glyph (it);
}
- /* Advance current_x by the pixel width as a convenience for
+ /* Advance current_x by the pixel width as a convenience for
the caller. */
if (it->area == TEXT_AREA)
it->current_x += it->pixel_width;
enum display_element_type what;
{
struct it temp_it;
-
+
temp_it = *it;
temp_it.dp = NULL;
temp_it.what = IT_CHARACTER;
}
else
temp_it.c = '\\';
-
+
produce_glyphs (&temp_it);
it->pixel_width = temp_it.pixel_width;
it->nglyphs = temp_it.pixel_width;
}
else
temp_it.c = '$';
-
+
produce_glyphs (&temp_it);
it->pixel_width = temp_it.pixel_width;
it->nglyphs = temp_it.pixel_width;
}
-/* Return an estimation of the pixel height of mode or top lines on
- frame F. FACE_ID specifies what line's height to estimate. */
-
-int
-estimate_mode_line_height (f, face_id)
- struct frame *f;
- enum face_id face_id;
-{
- if (estimate_mode_line_height_hook)
- return estimate_mode_line_height_hook (f, face_id);
- else
- return 1;
-}
-
-
\f
/***********************************************************************
Faces
if (TN_max_colors > 0)
{
char *p;
-
+
if (fg >= 0 && TS_set_foreground)
{
p = tparam (TS_set_foreground, NULL, 0, (int) fg);
}
}
}
-
+
/* Turn off appearances of face FACE_ID on tty frame F. */
&& face->background != FACE_TTY_DEFAULT_BG_COLOR)))
OUTPUT1_IF (TS_orig_pair);
}
-
-
+
+
+/* Return non-zero if the terminal on frame F supports all of the
+ capabilities in CAPS simultaneously, with foreground and background
+ colors FG and BG. */
+
+int
+tty_capable_p (f, caps, fg, bg)
+ struct frame *f;
+ unsigned caps;
+ unsigned long fg, bg;
+{
+#define TTY_CAPABLE_P_TRY(cap, TS, NC_bit) \
+ if ((caps & (cap)) && (!(TS) || !MAY_USE_WITH_COLORS_P(NC_bit))) \
+ return 0;
+
+ TTY_CAPABLE_P_TRY (TTY_CAP_INVERSE, TS_standout_mode, NC_REVERSE);
+ TTY_CAPABLE_P_TRY (TTY_CAP_UNDERLINE, TS_enter_underline_mode, NC_UNDERLINE);
+ TTY_CAPABLE_P_TRY (TTY_CAP_BOLD, TS_enter_bold_mode, NC_BOLD);
+ TTY_CAPABLE_P_TRY (TTY_CAP_DIM, TS_enter_dim_mode, NC_DIM);
+ TTY_CAPABLE_P_TRY (TTY_CAP_BLINK, TS_enter_blink_mode, NC_BLINK);
+ TTY_CAPABLE_P_TRY (TTY_CAP_ALT_CHARSET, TS_enter_alt_charset_mode, NC_ALT_CHARSET);
+
+ /* We can do it! */
+ return 1;
+}
+
+
/* Return non-zero if the terminal is capable to display colors. */
DEFUN ("tty-display-color-p", Ftty_display_color_p, Stty_display_color_p,
if (area == 0)
abort ();
- FrameRows = FRAME_HEIGHT (sf);
- FrameCols = FRAME_WIDTH (sf);
- specified_window = FRAME_HEIGHT (sf);
+ FrameRows = FRAME_LINES (sf);
+ FrameCols = FRAME_COLS (sf);
+ specified_window = FRAME_LINES (sf);
delete_in_insert_mode = 1;
TS_cursor_visible = tgetstr ("vs", address);
TS_cursor_invisible = tgetstr ("vi", address);
TS_set_window = tgetstr ("wi", address);
-
+
TS_enter_underline_mode = tgetstr ("us", address);
TS_exit_underline_mode = tgetstr ("ue", address);
TS_enter_bold_mode = tgetstr ("md", address);
TS_enter_alt_charset_mode = tgetstr ("as", address);
TS_exit_alt_charset_mode = tgetstr ("ae", address);
TS_exit_attribute_mode = tgetstr ("me", address);
-
+
MultiUp = tgetstr ("UP", address);
MultiDown = tgetstr ("DO", address);
MultiLeft = tgetstr ("LE", address);
TS_set_foreground = tgetstr ("Sf", address);
TS_set_background = tgetstr ("Sb", address);
}
-
+
TN_max_colors = tgetnum ("Co");
TN_max_pairs = tgetnum ("pa");
-
+
TN_no_color_video = tgetnum ("NC");
if (TN_no_color_video == -1)
TN_no_color_video = 0;
{
int height, width;
get_frame_size (&width, &height);
- FRAME_WIDTH (sf) = width;
- FRAME_HEIGHT (sf) = height;
+ FRAME_COLS (sf) = width;
+ FRAME_LINES (sf) = height;
}
- if (FRAME_WIDTH (sf) <= 0)
- SET_FRAME_WIDTH (sf, tgetnum ("co"));
+ if (FRAME_COLS (sf) <= 0)
+ SET_FRAME_COLS (sf, tgetnum ("co"));
else
/* Keep width and external_width consistent */
- SET_FRAME_WIDTH (sf, FRAME_WIDTH (sf));
- if (FRAME_HEIGHT (sf) <= 0)
- FRAME_HEIGHT (sf) = tgetnum ("li");
-
- if (FRAME_HEIGHT (sf) < 3 || FRAME_WIDTH (sf) < 3)
+ SET_FRAME_COLS (sf, FRAME_COLS (sf));
+ if (FRAME_LINES (sf) <= 0)
+ FRAME_LINES (sf) = tgetnum ("li");
+
+ if (FRAME_LINES (sf) < 3 || FRAME_COLS (sf) < 3)
fatal ("Screen size %dx%d is too small",
- FRAME_HEIGHT (sf), FRAME_WIDTH (sf));
+ FRAME_LINES (sf), FRAME_COLS (sf));
min_padding_speed = tgetnum ("pb");
TabWidth = tgetnum ("tw");
if (TabWidth < 0)
TabWidth = 8;
-
+
/* Turned off since /etc/termcap seems to have :ta= for most terminals
and newer termcap doc does not seem to say there is a default.
if (!Wcm.cm_tab)
}
}
- FrameRows = FRAME_HEIGHT (sf);
- FrameCols = FRAME_WIDTH (sf);
- specified_window = FRAME_HEIGHT (sf);
+ FrameRows = FRAME_LINES (sf);
+ FrameCols = FRAME_COLS (sf);
+ specified_window = FRAME_LINES (sf);
if (Wcm_init () == -1) /* can't do cursor motion */
#ifdef VMS
terminal_type);
# endif /* TERMINFO */
#endif /*VMS */
- if (FRAME_HEIGHT (sf) <= 0
- || FRAME_WIDTH (sf) <= 0)
+ if (FRAME_LINES (sf) <= 0
+ || FRAME_COLS (sf) <= 0)
fatal ("The frame size has not been specified");
delete_in_insert_mode
/* 16-bit Windows Selection processing for emacs on MS-Windows
Copyright (C) 1996, 1997, 2001 Free Software Foundation.
-
+
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
#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"
/* If ever some function outside this file will need to call any
clipboard-related function, the following prototypes and constants
empty_clipboard ()
{
__dpmi_regs regs;
-
+
/* Calls Int 2Fh/AX=1702h
Return Values AX == 0: Error occurred
<> 0: OK, Clipboard emptied */
the next loop by an additional test. */
register unsigned char *lcdp =
last_clipboard_text == NULL ? &null_char : last_clipboard_text;
-
+
/* Copy data from low memory, remove CR
characters before LF if needed. */
_farsetsel (_dos_ds);
Lisp_Object string, frame;
{
unsigned ok = 1, put_status = 0;
- int nbytes;
+ int nbytes, charset_info, no_crlf_conversion;
unsigned char *src, *dst = NULL;
- int charset_info;
- int no_crlf_conversion;
CHECK_STRING (string);
BLOCK_INPUT;
- nbytes = STRING_BYTES (XSTRING (string));
- src = XSTRING (string)->data;
+ nbytes = SBYTES (string);
+ src = SDATA (string);
/* Since we are now handling multilingual text, we must consider
encoding text for the clipboard. */
- charset_info = find_charset_in_text (src, XSTRING (string)->size, nbytes,
+ charset_info = find_charset_in_text (src, SCHARS (string), nbytes,
NULL, Qnil);
if (charset_info == 0)
&& !NILP (Ffboundp (coding.pre_write_conversion)))
{
string = run_pre_post_conversion_on_str (string, &coding, 1);
- src = XSTRING (string)->data;
- nbytes = STRING_BYTES (XSTRING (string));
+ src = SDATA (string);
+ nbytes = SBYTES (string);
}
coding.src_multibyte = 1;
coding.dst_multibyte = 0;
unsigned data_size, truelen;
unsigned char *htext;
Lisp_Object ret = Qnil;
- int no_crlf_conversion;
- int require_encoding = 0;
+ int no_crlf_conversion, require_encoding = 0;
if (NILP (frame))
frame = Fselected_frame ();
coding.dst_multibyte = 1;
Vnext_selection_coding_system = Qnil;
coding.mode |= CODING_MODE_LAST_BLOCK;
+ /* We explicitely disable composition handling because selection
+ data should not contain any composition sequence. */
+ coding.composing = COMPOSITION_DISABLED;
truelen = get_clipboard_data (CF_OEMTEXT, htext, data_size, 1);
bufsize = decoding_buffer_size (&coding, truelen);
buf = (unsigned char *) xmalloc (bufsize);
unblock:
UNBLOCK_INPUT;
-
+
done:
-
+
return (ret);
}
return Qnil;
}
-void
+void
syms_of_win16select ()
{
defsubr (&Sw16_set_clipboard_data);
doc: /* Coding system for communicating with other X clients.
When sending or receiving text via cut_buffer, selection, and clipboard,
the text is encoded or decoded by this coding system.
-A default value is `iso-latin-1-dos'. */);
- Vselection_coding_system=intern ("iso-latin-1-dos");
+The default value is `iso-latin-1-dos'. */);
+ Vselection_coding_system = intern ("iso-latin-1-dos");
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
+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;
#endif
#include "lisp.h"
- #include "charset.h"
+ #include "character.h"
#include "keyboard.h"
#include "frame.h"
#include "dispextern.h"
#define FONT_CACHE_SLOT_OVER_P(p) ((p) >= cached_bitmap_slots + BDF_FONT_CACHE_SIZE)
-static int
+static int
search_file_line(char *key, char *start, int len, char **val, char **next)
{
unsigned int linelen;
*val = start + strlen(key);
return 1;
}
-
+
return 0;
}
}
bdffontp = (bdffont *) xmalloc(sizeof(bdffont));
-
+
for(i = 0;i < BDF_FIRST_OFFSET_TABLE;i++)
bdffontp->chtbl[i] = NULL;
bdffontp->size = fileinfo.nFileSizeLow;
bdffontp->hfilemap = hfilemap;
bdffontp->filename = (char*) xmalloc(strlen(filename) + 1);
strcpy(bdffontp->filename, filename);
-
+
if (!set_bdf_font_info(bdffontp))
{
w32_free_bdf_font(bdffontp);
{
pch = fontp->chtbl[BDF_FIRST_OFFSET(index)] =
(font_char*) HeapAlloc(hbdf_cp_heap,
- HEAP_ZERO_MEMORY,
+ HEAP_ZERO_MEMORY,
sizeof(font_char) *
BDF_SECOND_OFFSET_TABLE);
if (!pch) return NULL;
pcb->row_byte_size = glyph.row_byte_size;
pch->pcbmp = pcb;
-
+
pcached_bitmap_latest++;
if (FONT_CACHE_SLOT_OVER_P(pcached_bitmap_latest))
pcached_bitmap_latest = cached_bitmap_slots;
return 0;
textalign = GetTextAlign(hdc);
-
+
hFgBrush = CreateSolidBrush(GetTextColor(hdc));
hOrgBrush = SelectObject(hdc, hFgBrush);
{
width = pcb->metric.bbw;
height = pcb->metric.bbh;
-
+
if (!(hBMP
&& (DIBsection_hdc == hdc)
&& (DIBsection_width == width)
#include <string.h>
#include "lisp.h"
- #include "charset.h"
+ #include "character.h"
#include "coding.h"
#include "disptab.h"
#include "termhooks.h"
{
cursor_coords.X = col;
cursor_coords.Y = row;
-
+
if (updating_frame == (struct frame *) NULL)
{
SetConsoleCursorPosition (cur_screen, cursor_coords);
clear_to_end (void)
{
struct frame * f = PICK_FRAME ();
-
- clear_end_of_line (FRAME_WIDTH (f) - 1);
- ins_del_lines (cursor_coords.Y, FRAME_HEIGHT (f) - cursor_coords.Y - 1);
+
+ clear_end_of_line (FRAME_COLS (f) - 1);
+ ins_del_lines (cursor_coords.Y, FRAME_LINES (f) - cursor_coords.Y - 1);
}
/* Clear the frame. */
GetConsoleScreenBufferInfo (GetStdHandle (STD_OUTPUT_HANDLE), &info);
/* Remember that the screen buffer might be wider than the window. */
- n = FRAME_HEIGHT (f) * info.dwSize.X;
+ n = FRAME_LINES (f) * info.dwSize.X;
dest.X = dest.Y = 0;
FillConsoleOutputAttribute (cur_screen, char_attr_normal, n, dest, &r);
if (n < 0)
{
scroll.Top = vpos - n;
- scroll.Bottom = FRAME_HEIGHT (f);
+ scroll.Bottom = FRAME_LINES (f);
dest.Y = vpos;
}
else
{
scroll.Top = vpos;
- scroll.Bottom = FRAME_HEIGHT (f) - n;
+ scroll.Bottom = FRAME_LINES (f) - n;
dest.Y = vpos + n;
}
scroll.Left = 0;
- scroll.Right = FRAME_WIDTH (f);
-
+ scroll.Right = FRAME_COLS (f);
+
dest.X = 0;
-
+
fill.Char.AsciiChar = 0x20;
fill.Attributes = char_attr_normal;
-
+
ScrollConsoleScreenBuffer (cur_screen, &scroll, NULL, dest, &fill);
/* Here we have to deal with a w32 console flake: If the scroll
for (i = scroll.Bottom; i < dest.Y; i++)
{
move_cursor (i, 0);
- clear_end_of_line (FRAME_WIDTH (f));
+ clear_end_of_line (FRAME_COLS (f));
}
}
}
nb = dest.Y + (scroll.Bottom - scroll.Top) + 1;
if (nb < scroll.Top)
- {
+ {
for (i = nb; i < scroll.Top; i++)
{
move_cursor (i, 0);
- clear_end_of_line (FRAME_WIDTH (f));
+ clear_end_of_line (FRAME_COLS (f));
}
}
}
-
+
cursor_coords.X = 0;
cursor_coords.Y = vpos;
}
COORD dest;
CHAR_INFO fill;
struct frame * f = PICK_FRAME ();
-
+
scroll.Top = cursor_coords.Y;
scroll.Bottom = cursor_coords.Y;
-
+
if (direction == LEFT)
{
scroll.Left = cursor_coords.X + dist;
- scroll.Right = FRAME_WIDTH (f) - 1;
+ scroll.Right = FRAME_COLS (f) - 1;
}
else
{
scroll.Left = cursor_coords.X;
- scroll.Right = FRAME_WIDTH (f) - dist - 1;
+ scroll.Right = FRAME_COLS (f) - dist - 1;
}
-
+
dest.X = cursor_coords.X;
dest.Y = cursor_coords.Y;
-
+
fill.Char.AsciiChar = 0x20;
fill.Attributes = char_attr_normal;
{
/* Print the first len characters of start, cursor_coords.X adjusted
by write_glyphs. */
-
+
write_glyphs (start, len);
}
else
/* Identify a run of glyphs with the same face. */
int face_id = string->face_id;
int n;
-
+
for (n = 1; n < len; ++n)
if (string[n].face_id != face_id)
break;
{
/* Set the attribute for these characters. */
if (!FillConsoleOutputAttribute (cur_screen, char_attr,
- produced, cursor_coords, &r))
+ produced, cursor_coords, &r))
{
printf ("Failed writing console attributes: %d\n",
GetLastError ());
cursor_coords.X += produced;
move_cursor (cursor_coords.Y, cursor_coords.X);
- }
+ }
len -= consumed;
n -= consumed;
string += consumed;
{
if (!FillConsoleOutputAttribute (cur_screen, char_attr_normal,
terminal_coding.produced,
- cursor_coords, &r))
+ cursor_coords, &r))
{
printf ("Failed writing console attributes: %d\n",
GetLastError ());
void
delete_glyphs (int n)
{
- /* delete chars means scroll chars from cursor_coords.X + n to
- cursor_coords.X, anything beyond the edge of the screen should
+ /* delete chars means scroll chars from cursor_coords.X + n to
+ cursor_coords.X, anything beyond the edge of the screen should
come out empty... */
scroll_line (n, LEFT);
void
w32_sys_ring_bell (void)
{
- if (sound_type == 0xFFFFFFFF)
+ if (sound_type == 0xFFFFFFFF)
{
Beep (666, 100);
}
{
CHECK_SYMBOL (sound);
- if (NILP (sound))
+ if (NILP (sound))
sound_type = 0xFFFFFFFF;
else if (EQ (sound, intern ("asterisk")))
sound_type = MB_ICONASTERISK;
- else if (EQ (sound, intern ("exclamation")))
+ else if (EQ (sound, intern ("exclamation")))
sound_type = MB_ICONEXCLAMATION;
- else if (EQ (sound, intern ("hand")))
+ else if (EQ (sound, intern ("hand")))
sound_type = MB_ICONHAND;
- else if (EQ (sound, intern ("question")))
+ else if (EQ (sound, intern ("question")))
sound_type = MB_ICONQUESTION;
- else if (EQ (sound, intern ("ok")))
+ else if (EQ (sound, intern ("ok")))
sound_type = MB_OK;
else if (EQ (sound, intern ("silent")))
sound_type = MB_EMACS_SILENT;
return sound;
}
-
+
void
reset_terminal_modes (void)
{
/* hmmm... perhaps these let us bracket screen changes so that we can flush
clumps rather than one-character-at-a-time...
-
+
we'll start with not moving the cursor while an update is in progress. */
void
update_begin (struct frame * f)
if (face->background != FACE_TTY_DEFAULT_BG_COLOR
&& face->background != FACE_TTY_DEFAULT_COLOR)
- char_attr = (char_attr & 0xff0f) + ((face->background % 16) << 4);
+ char_attr = (char_attr & 0xff0f) + ((face->background % 16) << 4);
/* NTEMACS_TODO: Faces defined during startup get both foreground
initialize_w32_display (void)
{
CONSOLE_SCREEN_BUFFER_INFO info;
-
+
cursor_to_hook = move_cursor;
raw_cursor_to_hook = move_cursor;
clear_to_end_hook = clear_to_end;
set_terminal_window_hook = set_terminal_window;
update_begin_hook = update_begin;
update_end_hook = update_end;
-
+
read_socket_hook = w32_console_read_socket;
mouse_position_hook = w32_console_mouse_position;
- estimate_mode_line_height_hook = 0;
/* Initialize interrupt_handle. */
init_crit ();
GetConsoleMode (keyboard_handle, &prev_console_mode);
prev_screen = GetStdHandle (STD_OUTPUT_HANDLE);
-
+
#ifdef USE_SEPARATE_SCREEN
cur_screen = CreateConsoleScreenBuffer (GENERIC_READ | GENERIC_WRITE,
0, NULL,
}
GetConsoleScreenBufferInfo (cur_screen, &info);
-
+
meta_key = 1;
char_attr_normal = info.wAttributes;
if (w32_use_full_screen_buffer)
{
- FRAME_HEIGHT (SELECTED_FRAME ()) = info.dwSize.Y; /* lines per page */
- SET_FRAME_WIDTH (SELECTED_FRAME (), info.dwSize.X); /* characters per line */
+ FRAME_LINES (SELECTED_FRAME ()) = info.dwSize.Y; /* lines per page */
+ SET_FRAME_COLS (SELECTED_FRAME (), info.dwSize.X); /* characters per line */
}
else
{
/* Lines per page. Use buffer coords instead of buffer size. */
- FRAME_HEIGHT (SELECTED_FRAME ()) = 1 + info.srWindow.Bottom -
- info.srWindow.Top;
+ FRAME_LINES (SELECTED_FRAME ()) = 1 + info.srWindow.Bottom -
+ info.srWindow.Top;
/* Characters per line. Use buffer coords instead of buffer size. */
- SET_FRAME_WIDTH (SELECTED_FRAME (), 1 + info.srWindow.Right -
+ SET_FRAME_COLS (SELECTED_FRAME (), 1 + info.srWindow.Right -
info.srWindow.Left);
}
cci.dwSize = XFASTINT (size);
cci.bVisible = TRUE;
(void) SetConsoleCursorInfo (cur_screen, &cci);
-
- return Qt;
-}
-#ifndef HAVE_NTGUI
-void
-pixel_to_glyph_coords (struct frame * f, int pix_x, int pix_y, int *x, int *y,
- void *bounds, int noclip)
-{
- *x = pix_x;
- *y = pix_y;
-}
-
-void
-glyph_to_pixel_coords (struct window * f, int x, int y, int *pix_x, int *pix_y)
-{
- *pix_x = x;
- *pix_y = y;
+ return Qt;
}
-#endif /* !HAVE_NTGUI */
void
syms_of_ntterm ()
#define abs(x) ((x) < 0 ? -(x) : (x))
-#define BETWEEN(X, LOWER, UPPER) ((X) >= (LOWER) && (X) < (UPPER))
-
\f
/* Fringe bitmaps. */
-enum fringe_bitmap_type
-{
- NO_FRINGE_BITMAP,
- LEFT_TRUNCATION_BITMAP,
- RIGHT_TRUNCATION_BITMAP,
- OVERLAY_ARROW_BITMAP,
- CONTINUED_LINE_BITMAP,
- CONTINUATION_LINE_BITMAP,
- ZV_LINE_BITMAP
-};
-
-/* Bitmaps are all unsigned short, as Windows requires bitmap data to
- be Word aligned. For some reason they are horizontally reflected
- compared to how they appear on X, so changes in xterm.c should be
- reflected here. */
-
-/* Bitmap drawn to indicate lines not displaying text if
- `indicate-empty-lines' is non-nil. */
-
-#define zv_width 8
-#define zv_height 72
-#define zv_period 3
-static unsigned char zv_bits[] = {
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00};
-static HBITMAP zv_bmp;
-
-/* An arrow like this: `<-'. */
-
-#define left_width 8
-#define left_height 8
-static unsigned short left_bits[] = {
- 0x18, 0x30, 0x60, 0xfc, 0xfc, 0x60, 0x30, 0x18};
-static HBITMAP left_bmp;
-
-/* Right truncation arrow bitmap `->'. */
-
-#define right_width 8
-#define right_height 8
-static unsigned short right_bits[] = {
- 0x18, 0x0c, 0x06, 0x3f, 0x3f, 0x06, 0x0c, 0x18};
-static HBITMAP right_bmp;
-
-/* Marker for continued lines. */
-
-#define continued_width 8
-#define continued_height 8
-static unsigned short continued_bits[] = {
- 0x3c, 0x3e, 0x03, 0x27, 0x3f, 0x3e, 0x3c, 0x3e};
-static HBITMAP continued_bmp;
-
-/* Marker for continuation lines. */
-
-#define continuation_width 8
-#define continuation_height 8
-static unsigned short continuation_bits[] = {
- 0x3c, 0x7c, 0xc0, 0xe4, 0xfc, 0x7c, 0x3c, 0x7c};
-static HBITMAP continuation_bmp;
-
-/* Overlay arrow bitmap. */
-
-#if 0
-/* A bomb. */
-#define ov_width 8
-#define ov_height 8
-static unsigned short ov_bits[] = {
- 0x0c, 0x10, 0x3c, 0x7e, 0x5e, 0x5e, 0x46, 0x3c};
-#else
-/* A triangular arrow. */
-#define ov_width 8
-#define ov_height 8
-static unsigned short ov_bits[] = {
- 0xc0, 0xf0, 0xf8, 0xfc, 0xfc, 0xf8, 0xf0, 0xc0};
-#endif
-static HBITMAP ov_bmp;
-
-extern Lisp_Object Qhelp_echo;
+static HBITMAP fringe_bmp[MAX_FRINGE_BITMAPS];
-\f
/* Non-nil means Emacs uses toolkit scroll bars. */
Lisp_Object Vx_toolkit_scroll_bars;
-/* If a string, w32_read_socket generates an event to display that string.
- (The display is done in read_char.) */
-
-static Lisp_Object help_echo;
-static Lisp_Object help_echo_window;
-static Lisp_Object help_echo_object;
-static int help_echo_pos;
+/* Temporary variables for w32_read_socket. */
-/* Temporary variable for w32_read_socket. */
+static int last_mousemove_x = 0;
+static int last_mousemove_y = 0;
-static Lisp_Object previous_help_echo;
+/* Define GET_WHEEL_DELTA_WPARAM macro if system headers don't. */
+#ifndef GET_WHEEL_DELTA_WPARAM
+#define GET_WHEEL_DELTA_WPARAM(wparam) ((short)HIWORD (wparam))
+#endif
/* Non-zero means that a HELP_EVENT has been generated since Emacs
start. */
static int any_help_event_p;
-/* Non-zero means autoselect window with the mouse cursor. */
-
-int x_autoselect_window_p;
-
-/* Non-zero means draw block and hollow cursor as wide as the glyph
- under it. For example, if a block cursor is over a tab, it will be
- drawn as wide as that tab on the display. */
-
-int x_stretch_cursor_p;
-
-/* Non-zero means make use of UNDERLINE_POSITION font properties. */
-
-int x_use_underline_position_properties;
+/* Last window where we saw the mouse. Used by mouse-autoselect-window. */
+static Lisp_Object last_window;
extern unsigned int msh_mousewheel;
extern void free_frame_menubar ();
extern int w32_codepage_for_font (char *fontname);
+extern Cursor w32_load_cursor (LPCTSTR name);
extern glyph_metric *w32_BDF_TextMetric(bdffont *fontp,
unsigned char *text, int dim);
/* This is a frame waiting to be autoraised, within w32_read_socket. */
struct frame *pending_autoraise_frame;
-/* Nominal cursor position -- where to draw output.
- HPOS and VPOS are window relative glyph matrix coordinates.
- X and Y are window relative pixel coordinates. */
-
-struct cursor_pos output_cursor;
-
/* The handle of the frame that currently owns the system caret. */
HWND w32_system_caret_hwnd;
int w32_system_caret_height;
/* Where the mouse was last time we reported a mouse event. */
-FRAME_PTR last_mouse_frame;
static RECT last_mouse_glyph;
static Lisp_Object last_mouse_press_frame;
/* A mask of extra modifier bits to put into every keyboard char. */
-extern int extra_keyboard_modifiers;
-
-/* Enumeration for overriding/changing the face to use for drawing
- glyphs in x_draw_glyphs. */
-
-enum draw_glyphs_face
-{
- DRAW_NORMAL_TEXT,
- DRAW_INVERSE_VIDEO,
- DRAW_CURSOR,
- DRAW_MOUSE_FACE,
- DRAW_IMAGE_RAISED,
- DRAW_IMAGE_SUNKEN
-};
+extern EMACS_INT extra_keyboard_modifiers;
static void x_update_window_end P_ ((struct window *, int, int));
-static void frame_to_window_pixel_xy P_ ((struct window *, int *, int *));
void w32_delete_display P_ ((struct w32_display_info *));
-static int fast_find_position P_ ((struct window *, int, int *, int *,
- int *, int *, Lisp_Object));
-static int fast_find_string_pos P_ ((struct window *, int, Lisp_Object,
- int *, int *, int *, int *, int));
-static void set_output_cursor P_ ((struct cursor_pos *));
-static struct glyph *x_y_to_hpos_vpos P_ ((struct window *, int, int,
- int *, int *, int *, int));
-static void note_mode_line_highlight P_ ((struct window *, int, int));
-static void note_mouse_highlight P_ ((struct frame *, int, int));
-static void note_tool_bar_highlight P_ ((struct frame *f, int, int));
static void w32_handle_tool_bar_click P_ ((struct frame *,
struct input_event *));
-static void show_mouse_face P_ ((struct w32_display_info *,
- enum draw_glyphs_face));
-static int cursor_in_mouse_face_p P_ ((struct window *));
-static int clear_mouse_face P_ ((struct w32_display_info *));
+void w32_define_cursor P_ ((Window, Cursor));
void x_lower_frame P_ ((struct frame *));
void x_scroll_bar_clear P_ ((struct frame *));
void w32_initialize P_ ((void));
static void x_font_min_bounds P_ ((XFontStruct *, int *, int *));
int x_compute_min_glyph_bounds P_ ((struct frame *));
-static void x_draw_phys_cursor_glyph P_ ((struct window *,
- struct glyph_row *,
- enum draw_glyphs_face));
static void x_update_end P_ ((struct frame *));
static void w32_frame_up_to_date P_ ((struct frame *));
static void w32_set_terminal_modes P_ ((void));
static void w32_reset_terminal_modes P_ ((void));
-static void w32_cursor_to P_ ((int, int, int, int));
-static void x_write_glyphs P_ ((struct glyph *, int));
-static void x_clear_end_of_line P_ ((int));
static void x_clear_frame P_ ((void));
-static void x_clear_cursor P_ ((struct window *));
static void frame_highlight P_ ((struct frame *));
static void frame_unhighlight P_ ((struct frame *));
static void x_new_focus_frame P_ ((struct w32_display_info *,
static void w32_frame_rehighlight P_ ((struct frame *));
static void x_frame_rehighlight P_ ((struct w32_display_info *));
static void x_draw_hollow_cursor P_ ((struct window *, struct glyph_row *));
-static void x_draw_bar_cursor P_ ((struct window *, struct glyph_row *, int));
-static void expose_frame P_ ((struct frame *, int, int, int, int));
-static int expose_window_tree P_ ((struct window *, RECT *));
-static int expose_window P_ ((struct window *, RECT *));
-static void expose_area P_ ((struct window *, struct glyph_row *,
- RECT *, enum glyph_row_area));
-static int expose_line P_ ((struct window *, struct glyph_row *,
- RECT *));
-void x_update_cursor P_ ((struct frame *, int));
-static void x_update_cursor_in_window_tree P_ ((struct window *, int));
-static void x_update_window_cursor P_ ((struct window *, int));
-static void x_erase_phys_cursor P_ ((struct window *));
-void x_display_cursor P_ ((struct window *w, int, int, int, int, int));
-void x_display_and_set_cursor P_ ((struct window *, int, int, int, int, int));
-static void w32_draw_fringe_bitmap P_ ((struct window *, HDC hdc,
- struct glyph_row *,
- enum fringe_bitmap_type, int left_p));
-static void w32_clip_to_row P_ ((struct window *, struct glyph_row *,
- HDC, int));
-static int x_phys_cursor_in_rect_p P_ ((struct window *, RECT *));
-static void x_draw_row_fringe_bitmaps P_ ((struct window *,
- struct glyph_row *));
-static void notice_overwritten_cursor P_ ((struct window *,
- enum glyph_row_area,
- int, int, int, int));
+static void x_draw_bar_cursor P_ ((struct window *, struct glyph_row *, int,
+ enum text_cursor_kinds));
+static void w32_clip_to_row P_ ((struct window *, struct glyph_row *, HDC));
static Lisp_Object Qvendor_specific_keysyms;
/* This is a function useful for recording debugging information about
the sequence of occurrences in this file. */
-struct record
+struct record
{
char *locus;
int type;
#endif /* 0 */
\f
-void XChangeGC (void * ignore, XGCValues* gc, unsigned long mask,
- XGCValues *xgcv)
+void
+XChangeGC (void * ignore, XGCValues* gc, unsigned long mask,
+ XGCValues *xgcv)
{
if (mask & GCForeground)
gc->foreground = xgcv->foreground;
return gc;
}
-void XGetGCValues (void* ignore, XGCValues *gc,
+void
+XGetGCValues (void* ignore, XGCValues *gc,
unsigned long mask, XGCValues *xgcv)
{
XChangeGC (ignore, xgcv, mask, gc);
}
/* Draw a filled rectangle at the specified position. */
-void
+void
w32_fill_rect (f, hdc, pix, lprect)
FRAME_PTR f;
HDC hdc;
DeleteObject (hb);
}
-void
+void
w32_clear_window (f)
FRAME_PTR f;
{
/***********************************************************************
Starting and ending an update
***********************************************************************/
-
+
/* Start an update of frame F. This function is installed as a hook
for update_begin, i.e. it is called when update_begin is called.
This function is called prior to calls to x_update_window_begin for
struct w32_display_info *display_info = FRAME_W32_DISPLAY_INFO (f);
/* Hide the system caret during an update. */
- if (w32_use_visible_system_caret)
- SendMessage (w32_system_caret_hwnd, WM_EMACS_HIDE_CARET, 0, 0);
+ if (w32_use_visible_system_caret && w32_system_caret_hwnd)
+ {
+ SendMessage (w32_system_caret_hwnd, WM_EMACS_HIDE_CARET, 0, 0);
+ }
updated_window = w;
set_output_cursor (&w->cursor);
flag set. So, rows containing mouse-face glyphs are never
scrolled, and we don't have to switch the mouse highlight off
here to prevent it from being scrolled. */
-
+
/* Can we tell that this update does not affect the window
where the mouse highlight is? If so, no need to turn off.
Likewise, don't do anything if the frame is garbaged;
UNBLOCK_INPUT;
}
-
-/* Draw a vertical window border to the right of window W if W doesn't
- have vertical scroll bars. */
+/* Draw a vertical window border from (x,y0) to (x,y1) */
static void
-x_draw_vertical_border (w)
+w32_draw_vertical_window_border (w, x, y0, y1)
struct window *w;
+ int x, y0, y1;
{
struct frame *f = XFRAME (WINDOW_FRAME (w));
-
- /* Redraw borders between horizontally adjacent windows. Don't
- do it for frames with vertical scroll bars because either the
- right scroll bar of a window, or the left scroll bar of its
- neighbor will suffice as a border. */
- if (!WINDOW_RIGHTMOST_P (w)
- && !FRAME_HAS_VERTICAL_SCROLL_BARS (f))
- {
- RECT r;
- HDC hdc;
+ RECT r;
+ HDC hdc;
- window_box_edges (w, -1, (int *) &r.left, (int *) &r.top,
- (int *) &r.right, (int *) &r.bottom);
- r.left = r.right + FRAME_X_RIGHT_FRINGE_WIDTH (f);
- r.right = r.left + 1;
- r.bottom -= 1;
+ r.left = x;
+ r.right = x + 1;
+ r.top = y0;
+ r.bottom = y1;
- hdc = get_frame_dc (f);
- w32_fill_rect (f, hdc, FRAME_FOREGROUND_PIXEL (f), &r);
- release_frame_dc (f, hdc);
- }
+ hdc = get_frame_dc (f);
+ w32_fill_rect (f, hdc, FRAME_FOREGROUND_PIXEL (f), &r);
+ release_frame_dc (f, hdc);
}
-
+
/* End update of window W (which is equal to updated_window).
Draw vertical borders between horizontally adjacent windows, and
struct window *w;
int cursor_on_p, mouse_face_overwritten_p;
{
- struct w32_display_info *dpyinfo
- = FRAME_W32_DISPLAY_INFO (XFRAME (w->frame));
+ struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (XFRAME (w->frame));
if (!w->pseudo_window_p)
{
BLOCK_INPUT;
if (cursor_on_p)
- x_display_and_set_cursor (w, 1, output_cursor.hpos,
- output_cursor.vpos,
- output_cursor.x, output_cursor.y);
-
+ display_and_set_cursor (w, 1, output_cursor.hpos,
+ output_cursor.vpos,
+ output_cursor.x, output_cursor.y);
+
x_draw_vertical_border (w);
UNBLOCK_INPUT;
}
/* Unhide the caret. This won't actually show the cursor, unless it
was visible before the corresponding call to HideCaret in
x_update_window_begin. */
- if (w32_use_visible_system_caret)
- SendMessage (w32_system_caret_hwnd, WM_EMACS_SHOW_CARET, 0, 0);
+ if (w32_use_visible_system_caret && w32_system_caret_hwnd)
+ {
+ SendMessage (w32_system_caret_hwnd, WM_EMACS_SHOW_CARET, 0, 0);
+ }
updated_window = NULL;
}
if (FRAME_W32_P (f))
{
struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
+
if (dpyinfo->mouse_face_deferred_gc
|| f == dpyinfo->mouse_face_mouse_frame)
{
int width, height;
xassert (w);
-
+
if (!desired_row->mode_line_p && !w->pseudo_window_p)
{
BLOCK_INPUT;
- x_draw_row_fringe_bitmaps (w, desired_row);
+ draw_row_fringe_bitmaps (w, desired_row);
UNBLOCK_INPUT;
}
height > 0))
{
int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y));
+
/* Internal border is drawn below the tool bar. */
if (WINDOWP (f->tool_bar_window)
&& w == XWINDOW (f->tool_bar_window))
{
HDC hdc = get_frame_dc (f);
w32_clear_area (f, hdc, 0, y, width, height);
- w32_clear_area (f, hdc, f->output_data.w32->pixel_width - width,
+ w32_clear_area (f, hdc, FRAME_PIXEL_WIDTH (f) - width,
y, width, height);
release_frame_dc (f, hdc);
}
drawn. */
static void
-w32_draw_fringe_bitmap (w, hdc, row, which, left_p)
+w32_draw_fringe_bitmap (w, row, p)
struct window *w;
- HDC hdc;
struct glyph_row *row;
- enum fringe_bitmap_type which;
- int left_p;
+ struct draw_fringe_bitmap_params *p;
{
struct frame *f = XFRAME (WINDOW_FRAME (w));
- Window window = FRAME_W32_WINDOW (f);
- HDC compat_hdc;
- int x, y, wd, h, dy;
- int b1, b2;
- HBITMAP pixmap;
- HANDLE horig_obj;
- struct face *face;
-
- /* Must clip because of partially visible lines. */
- w32_clip_to_row (w, row, hdc, 1);
-
- /* Convert row to frame coordinates. */
- y = WINDOW_TO_FRAME_PIXEL_Y (w, row->y);
-
- switch (which)
- {
- case NO_FRINGE_BITMAP:
- wd = 0;
- h = 0;
- break;
-
- case LEFT_TRUNCATION_BITMAP:
- wd = left_width;
- h = left_height;
- pixmap = left_bmp;
- break;
-
- case OVERLAY_ARROW_BITMAP:
- wd = ov_width;
- h = ov_height;
- pixmap = ov_bmp;
- break;
-
- case RIGHT_TRUNCATION_BITMAP:
- wd = right_width;
- h = right_height;
- pixmap = right_bmp;
- break;
-
- case CONTINUED_LINE_BITMAP:
- wd = continued_width;
- h = continued_height;
- pixmap = continued_bmp;
- break;
-
- case CONTINUATION_LINE_BITMAP:
- wd = continuation_width;
- h = continuation_height;
- pixmap = continuation_bmp;
- break;
-
- case ZV_LINE_BITMAP:
- wd = zv_width;
- h = zv_height - (y % zv_period);
- pixmap = zv_bmp;
- break;
-
- default:
- abort ();
- }
-
- /* Clip bitmap if too high. */
- if (h > row->height)
- h = row->height;
-
- /* Set dy to the offset in the row to start drawing the bitmap. */
- dy = (row->height - h) / 2;
+ HDC hdc;
+ struct face *face = p->face;
- /* Draw the bitmap. */
- face = FACE_FROM_ID (f, FRINGE_FACE_ID);
- PREPARE_FACE_FOR_DISPLAY (f, face);
+ hdc = get_frame_dc (f);
- /* Clear left fringe if no bitmap to draw or if bitmap doesn't fill
- the fringe. */
- b1 = -1;
- if (left_p)
- {
- if (wd > FRAME_X_LEFT_FRINGE_WIDTH (f))
- wd = FRAME_X_LEFT_FRINGE_WIDTH (f);
- x = (WINDOW_TO_FRAME_PIXEL_X (w, 0)
- - wd
- - (FRAME_X_LEFT_FRINGE_WIDTH (f) - wd) / 2);
- if (wd < FRAME_X_LEFT_FRINGE_WIDTH (f) || row->height > h)
- {
- /* If W has a vertical border to its left, don't draw over it. */
- int border = ((XFASTINT (w->left) > 0
- && !FRAME_HAS_VERTICAL_SCROLL_BARS (f))
- ? 1 : 0);
- b1 = (window_box_left (w, -1)
- - FRAME_X_LEFT_FRINGE_WIDTH (f)
- + border);
- b2 = (FRAME_X_LEFT_FRINGE_WIDTH (f) - border);
- }
- }
- else
- {
- if (wd > FRAME_X_RIGHT_FRINGE_WIDTH (f))
- wd = FRAME_X_RIGHT_FRINGE_WIDTH (f);
- x = (window_box_right (w, -1)
- + (FRAME_X_RIGHT_FRINGE_WIDTH (f) - wd) / 2);
- /* Clear right fringe if no bitmap to draw of if bitmap doesn't fill
- the fringe. */
- if (wd < FRAME_X_RIGHT_FRINGE_WIDTH (f) || row->height > h)
- {
- b1 = window_box_right (w, -1);
- b2 = FRAME_X_RIGHT_FRINGE_WIDTH (f);
- }
- }
+ /* Must clip because of partially visible lines. */
+ w32_clip_to_row (w, row, hdc);
- if (b1 >= 0)
+ if (p->bx >= 0)
{
- int header_line_height = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w);
-
w32_fill_area (f, hdc, face->background,
- b1,
- WINDOW_TO_FRAME_PIXEL_Y (w, max (header_line_height,
- row->y)),
- b2,
- row->visible_height);
+ p->bx, p->by, p->nx, p->ny);
}
- if (which == NO_FRINGE_BITMAP)
- return;
-
- compat_hdc = CreateCompatibleDC (hdc);
- SaveDC (hdc);
-
- horig_obj = SelectObject (compat_hdc, pixmap);
- SetTextColor (hdc, face->background);
- SetBkColor (hdc, face->foreground);
-
- BitBlt (hdc, x, y + dy, wd, h, compat_hdc, 0,
- (which == ZV_LINE_BITMAP ? (row->y % zv_period) : 0),
- SRCCOPY);
-
- SelectObject (compat_hdc, horig_obj);
- DeleteDC (compat_hdc);
- RestoreDC (hdc, -1);
-}
-
-
-/* Draw fringe bitmaps for glyph row ROW on window W. Call this
- function with input blocked. */
-
-static void
-x_draw_row_fringe_bitmaps (w, row)
- struct window *w;
- struct glyph_row *row;
-{
- struct frame *f = XFRAME (w->frame);
- enum fringe_bitmap_type bitmap;
- HDC hdc;
-
- xassert (interrupt_input_blocked);
+ if (p->which != NO_FRINGE_BITMAP)
+ {
+ HBITMAP pixmap = fringe_bmp[p->which];
+ HDC compat_hdc;
+ HANDLE horig_obj;
- /* If row is completely invisible, because of vscrolling, we
- don't have to draw anything. */
- if (row->visible_height <= 0)
- return;
+ compat_hdc = CreateCompatibleDC (hdc);
+ SaveDC (hdc);
- hdc = get_frame_dc (f);
+ horig_obj = SelectObject (compat_hdc, pixmap);
+ SetTextColor (hdc, face->background);
+ SetBkColor (hdc, face->foreground);
- if (FRAME_X_LEFT_FRINGE_WIDTH (f) != 0)
- {
- /* Decide which bitmap to draw in the left fringe. */
- if (row->overlay_arrow_p)
- bitmap = OVERLAY_ARROW_BITMAP;
- else if (row->truncated_on_left_p)
- bitmap = LEFT_TRUNCATION_BITMAP;
- else if (MATRIX_ROW_CONTINUATION_LINE_P (row))
- bitmap = CONTINUATION_LINE_BITMAP;
- else if (row->indicate_empty_line_p)
- bitmap = ZV_LINE_BITMAP;
- else
- bitmap = NO_FRINGE_BITMAP;
+ BitBlt (hdc, p->x, p->y, p->wd, p->h,
+ compat_hdc, 0, p->dh,
+ SRCCOPY);
- w32_draw_fringe_bitmap (w, hdc, row, bitmap, 1);
+ SelectObject (compat_hdc, horig_obj);
+ DeleteDC (compat_hdc);
+ RestoreDC (hdc, -1);
}
- if (FRAME_X_RIGHT_FRINGE_WIDTH (f) != 0)
- {
- /* Decide which bitmap to draw in the right fringe. */
- if (row->truncated_on_right_p)
- bitmap = RIGHT_TRUNCATION_BITMAP;
- else if (row->continued_p)
- bitmap = CONTINUED_LINE_BITMAP;
- else if (row->indicate_empty_line_p && FRAME_X_LEFT_FRINGE_WIDTH (f) == 0)
- bitmap = ZV_LINE_BITMAP;
- else
- bitmap = NO_FRINGE_BITMAP;
-
- w32_draw_fringe_bitmap (w, hdc, row, bitmap, 0);
- }
+ w32_set_clip_rectangle (hdc, NULL);
release_frame_dc (f, hdc);
}
}
-\f
-/***********************************************************************
- Output Cursor
- ***********************************************************************/
-
-/* Set the global variable output_cursor to CURSOR. All cursor
- positions are relative to updated_window. */
-
-static void
-set_output_cursor (cursor)
- struct cursor_pos *cursor;
-{
- output_cursor.hpos = cursor->hpos;
- output_cursor.vpos = cursor->vpos;
- output_cursor.x = cursor->x;
- output_cursor.y = cursor->y;
-}
-
-
-/* Set a nominal cursor position.
-
- HPOS and VPOS are column/row positions in a window glyph matrix. X
- and Y are window text area relative pixel positions.
-
- If this is done during an update, updated_window will contain the
- window that is being updated and the position is the future output
- cursor position for that window. If updated_window is null, use
- selected_window and display the cursor at the given position. */
-
-static void
-w32_cursor_to (vpos, hpos, y, x)
- int vpos, hpos, y, x;
-{
- struct window *w;
-
- /* If updated_window is not set, work on selected_window. */
- if (updated_window)
- w = updated_window;
- else
- w = XWINDOW (selected_window);
-
- /* Set the output cursor. */
- output_cursor.hpos = hpos;
- output_cursor.vpos = vpos;
- output_cursor.x = x;
- output_cursor.y = y;
-
- /* If not called as part of an update, really display the cursor.
- This will also set the cursor position of W. */
- if (updated_window == NULL)
- {
- BLOCK_INPUT;
- x_display_cursor (w, 1, hpos, vpos, x, y);
- UNBLOCK_INPUT;
- }
-}
-
-
\f
/***********************************************************************
Display Iterator
/* Function prototypes of this page. */
-static struct face *x_get_glyph_face_and_encoding P_ ((struct frame *,
- struct glyph *,
- wchar_t *,
- int *));
-static struct face *x_get_char_face_and_encoding P_ ((struct frame *, int,
- int, wchar_t *, int));
static XCharStruct *w32_per_char_metric P_ ((XFontStruct *,
- wchar_t *,
- enum w32_char_font_type));
-static enum w32_char_font_type
- w32_encode_char P_ ((int, wchar_t *, struct font_info *, int *));
-static void x_append_glyph P_ ((struct it *));
-static void x_append_composite_glyph P_ ((struct it *));
-static void x_append_stretch_glyph P_ ((struct it *it, Lisp_Object,
- int, int, double));
-static void x_produce_glyphs P_ ((struct it *));
-static void x_produce_image_glyph P_ ((struct it *it));
-
-
-/* Dealing with bits of wchar_t as if they were an XChar2B. */
-#define BUILD_WCHAR_T(byte1, byte2) \
- ((wchar_t)((((byte1) & 0x00ff) << 8) | ((byte2) & 0x00ff)))
-
-
-#define BYTE1(ch) \
- (((ch) & 0xff00) >> 8)
-
-#define BYTE2(ch) \
- ((ch) & 0x00ff)
+ wchar_t *, int));
+static int w32_encode_char P_ ((int, wchar_t *, struct font_info *, int *));
/* Get metrics of character CHAR2B in FONT. Value is always non-null.
buf[0] = (char)(*char2b);
else
{
- buf[0] = BYTE1 (*char2b);
- buf[1] = BYTE2 (*char2b);
+ buf[0] = XCHAR2B_BYTE1 (char2b);
+ buf[1] = XCHAR2B_BYTE2 (char2b);
}
bdf_metric = w32_BDF_TextMetric (font->bdf, buf, dim);
w32_per_char_metric (font, char2b, font_type)
XFontStruct *font;
wchar_t *char2b;
- enum w32_char_font_type font_type;
+ int /* enum w32_char_font_type */ font_type;
{
/* The result metric information. */
XCharStruct *pcm;
}
-static BOOL
+static BOOL
w32_use_unicode_for_codepage (codepage)
int codepage;
{
/* Encode CHAR2B using encoding information from FONT_INFO. CHAR2B is
the two-byte form of C. Encoding is returned in *CHAR2B. */
-static INLINE enum w32_char_font_type
+static int /* enum w32_char_font_type */
w32_encode_char (c, char2b, font_info, two_byte_p)
int c;
wchar_t *char2b;
struct font_info *font_info;
int * two_byte_p;
{
-- int charset = CHAR_CHARSET (c);
++ struct charset *charset = CHAR_CHARSET (c);
int codepage;
int unicode_p = 0;
+ int internal_two_byte_p = 0;
XFontStruct *font = font_info->font;
- xassert (two_byte_p);
-
- *two_byte_p = w32_font_is_double_byte (font);
+ internal_two_byte_p = w32_font_is_double_byte (font);
/* 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
if (CHARSET_DIMENSION (charset) == 1)
{
-- ccl->reg[0] = charset;
- ccl->reg[1] = BYTE2 (*char2b);
++ ccl->reg[0] = CHARSET_ID (charset);
+ ccl->reg[1] = XCHAR2B_BYTE2 (char2b);
+ ccl->reg[2] = -1;
}
else
{
-- ccl->reg[0] = charset;
- ccl->reg[1] = BYTE1 (*char2b);
- ccl->reg[2] = BYTE2 (*char2b);
++ 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, NULL, Qnil);
++ ccl_driver (ccl, NULL, NULL, 0, 0, Qnil);
/* We assume that MSBs are appropriately set/reset by CCL
program. */
- if (!*two_byte_p) /* 1-byte font */
- *char2b = BUILD_WCHAR_T (0, ccl->reg[1]);
+ if (!internal_two_byte_p) /* 1-byte font */
+ STORE_XCHAR2B (char2b, 0, ccl->reg[1]);
else
- *char2b = BUILD_WCHAR_T (ccl->reg[1], ccl->reg[2]);
+ STORE_XCHAR2B (char2b, ccl->reg[1], ccl->reg[2]);
}
else if (font_info->encoding[charset])
{
/* Fixed encoding scheme. See fontset.h for the meaning of the
encoding numbers. */
int enc = font_info->encoding[charset];
-
+
if ((enc == 1 || enc == 2)
&& CHARSET_DIMENSION (charset) == 2)
- *char2b = BUILD_WCHAR_T (BYTE1 (*char2b) | 0x80, BYTE2 (*char2b));
-
+ STORE_XCHAR2B (char2b, XCHAR2B_BYTE1 (char2b) | 0x80, XCHAR2B_BYTE2 (char2b));
+
if (enc == 1 || enc == 3
|| (enc == 4 && CHARSET_DIMENSION (charset) == 1))
- *char2b = BUILD_WCHAR_T (BYTE1 (*char2b), BYTE2 (*char2b) | 0x80);
+ 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),
- ENCODE_SJIS (BYTE1 (*char2b), BYTE2 (*char2b),
-- sjis1, sjis2);
- STORE_XCHAR2B (char2b, sjis1, sjis2);
- *char2b = BUILD_WCHAR_T (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)
++ && c >= 0x100)
{
char temp[3];
- temp[0] = BYTE1 (*char2b);
- temp[1] = BYTE2 (*char2b);
+ temp[0] = XCHAR2B_BYTE1 (char2b);
+ temp[1] = XCHAR2B_BYTE2 (char2b);
temp[2] = '\0';
if (codepage != CP_UNICODE)
{
MultiByteToWideChar (codepage, 0, temp+1, 1, char2b, 1);
}
unicode_p = 1;
- *two_byte_p = 1;
+ internal_two_byte_p = 1;
}
+
+ if (two_byte_p)
+ *two_byte_p = internal_two_byte_p;
+
if (!font)
return UNKNOWN_FONT;
else if (font->bdf && CHARSET_DIMENSION (charset) == 1)
}
-/* 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. Value is a pointer to a
- realized face that is ready for display. */
+\f
+/***********************************************************************
+ Glyph display
+ ***********************************************************************/
-static INLINE struct face *
-x_get_char_face_and_encoding (f, c, face_id, char2b, multibyte_p)
- struct frame *f;
- int c, face_id;
- wchar_t *char2b;
- int multibyte_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. */
- *char2b = BUILD_WCHAR_T (0, c);
- face_id = FACE_FOR_CHAR (f, face, c);
- face = FACE_FROM_ID (f, face_id);
- }
- else if (c < 128 && face_id < BASIC_FACE_ID_SENTINEL)
- {
- /* Case of ASCII in a face known to fit ASCII. */
- *char2b = BUILD_WCHAR_T (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)
- *char2b = BUILD_WCHAR_T (c1, c2);
- else
- *char2b = BUILD_WCHAR_T (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)
- w32_encode_char (c, char2b, font_info, &multibyte_p);
- }
- }
+/* Encapsulate the different ways of displaying text under W32. */
- /* Make sure X resources of the face are allocated. */
- xassert (face != NULL);
- PREPARE_FACE_FOR_DISPLAY (f, face);
-
- return face;
+static void
+w32_text_out (s, x, y,chars,nchars)
+ struct glyph_string * s;
+ int x, y;
+ wchar_t * chars;
+ int nchars;
+{
+ int charset_dim = w32_font_is_double_byte (s->gc->font) ? 2 : 1;
+ if (s->gc->font->bdf)
+ w32_BDF_TextOut (s->gc->font->bdf, s->hdc,
+ x, y, (char *) chars, charset_dim,
+ nchars * charset_dim, 0);
+ else if (s->first_glyph->font_type == UNICODE_FONT)
+ ExtTextOutW (s->hdc, x, y, 0, NULL, chars, nchars, NULL);
+ else
+ ExtTextOutA (s->hdc, x, y, 0, NULL, (char *) chars,
+ nchars * charset_dim, NULL);
}
-/* 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. */
-static INLINE struct face *
-x_get_glyph_face_and_encoding (f, glyph, char2b, two_byte_p)
- struct frame *f;
- struct glyph *glyph;
- wchar_t *char2b;
- int *two_byte_p;
-{
- struct face *face;
- int dummy = 0;
+static void x_set_glyph_string_clipping P_ ((struct glyph_string *));
+static void x_set_glyph_string_gc P_ ((struct glyph_string *));
+static void x_draw_glyph_string_background P_ ((struct glyph_string *,
+ int));
+static void x_draw_glyph_string_foreground P_ ((struct glyph_string *));
+static void x_draw_composite_glyph_string_foreground P_ ((struct glyph_string *));
+static void x_draw_glyph_string_box P_ ((struct glyph_string *));
+static void x_draw_glyph_string P_ ((struct glyph_string *));
+static void x_set_cursor_gc P_ ((struct glyph_string *));
+static void x_set_mode_line_face_gc P_ ((struct glyph_string *));
+static void x_set_mouse_face_gc P_ ((struct glyph_string *));
+static int w32_alloc_lighter_color (struct frame *, COLORREF *, double, int);
+static void w32_setup_relief_color P_ ((struct frame *, struct relief *,
+ double, int, COLORREF));
+static void x_setup_relief_colors P_ ((struct glyph_string *));
+static void x_draw_image_glyph_string P_ ((struct glyph_string *));
+static void x_draw_image_relief P_ ((struct glyph_string *));
+static void x_draw_image_foreground P_ ((struct glyph_string *));
+static void w32_draw_image_foreground_1 P_ ((struct glyph_string *, HBITMAP));
+static void x_clear_glyph_string_rect P_ ((struct glyph_string *, int,
+ int, int, int));
+static void w32_draw_relief_rect P_ ((struct frame *, int, int, int, int,
+ int, int, int, int, RECT *));
+static void w32_draw_box_rect P_ ((struct glyph_string *, int, int, int, int,
+ int, int, int, RECT *));
- xassert (glyph->type == CHAR_GLYPH);
- face = FACE_FROM_ID (f, glyph->face_id);
+#if GLYPH_DEBUG
+static void x_check_font P_ ((struct frame *, XFontStruct *));
+#endif
- if (two_byte_p)
- *two_byte_p = 0;
- else
- two_byte_p = &dummy;
- if (!glyph->multibyte_p)
- {
- /* Unibyte case. We don't have to encode, but we have to make
- sure to use a face suitable for unibyte. */
- *char2b = BUILD_WCHAR_T (0, glyph->u.ch);
- }
- else if (glyph->u.ch < 128
- && glyph->face_id < BASIC_FACE_ID_SENTINEL)
- {
- /* Case of ASCII in a face known to fit ASCII. */
- *char2b = BUILD_WCHAR_T (0, glyph->u.ch);
- }
+/* Set S->gc to a suitable GC for drawing glyph string S in cursor
+ face. */
+
+static void
+x_set_cursor_gc (s)
+ struct glyph_string *s;
+{
+ if (s->font == FRAME_FONT (s->f)
+ && s->face->background == FRAME_BACKGROUND_PIXEL (s->f)
+ && s->face->foreground == FRAME_FOREGROUND_PIXEL (s->f)
+ && !s->cmp)
+ s->gc = s->f->output_data.w32->cursor_gc;
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 (glyph->u.ch, charset, c1, c2);
- if (c2 > 0)
- *char2b = BUILD_WCHAR_T (c1, c2);
- else
- *char2b = BUILD_WCHAR_T (0, c1);
+ /* Cursor on non-default face: must merge. */
+ XGCValues xgcv;
+ unsigned long mask;
+
+ xgcv.background = s->f->output_data.w32->cursor_pixel;
+ xgcv.foreground = s->face->background;
+
+ /* If the glyph would be invisible, try a different foreground. */
+ if (xgcv.foreground == xgcv.background)
+ xgcv.foreground = s->face->foreground;
+ if (xgcv.foreground == xgcv.background)
+ xgcv.foreground = s->f->output_data.w32->cursor_foreground_pixel;
+ if (xgcv.foreground == xgcv.background)
+ xgcv.foreground = s->face->foreground;
- /* Maybe encode the character in *CHAR2B. */
- if (charset != CHARSET_ASCII)
+ /* Make sure the cursor is distinct from text in this face. */
+ if (xgcv.background == s->face->background
+ && xgcv.foreground == s->face->foreground)
{
- struct font_info *font_info
- = FONT_INFO_FROM_ID (f, face->font_info_id);
- if (font_info)
- {
- glyph->w32_font_type
- = w32_encode_char (glyph->u.ch, char2b, font_info, two_byte_p);
- }
+ xgcv.background = s->face->foreground;
+ xgcv.foreground = s->face->background;
}
- }
-
- /* Make sure X resources of the face are allocated. */
- xassert (face != NULL);
- PREPARE_FACE_FOR_DISPLAY (f, face);
- return face;
-}
+ IF_DEBUG (x_check_font (s->f, s->font));
+ xgcv.font = s->font;
+ mask = GCForeground | GCBackground | GCFont;
-/* Store one glyph for IT->char_to_display in IT->glyph_row.
- Called from x_produce_glyphs when IT->glyph_row is non-null. */
+ if (FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc)
+ XChangeGC (NULL, FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc,
+ mask, &xgcv);
+ else
+ FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc
+ = XCreateGC (NULL, s->window, mask, &xgcv);
-static INLINE void
-x_append_glyph (it)
- struct it *it;
-{
- struct glyph *glyph;
- enum glyph_row_area area = it->area;
-
- xassert (it->glyph_row);
- xassert (it->char_to_display != '\n' && it->char_to_display != '\t');
-
- glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
- if (glyph < it->glyph_row->glyphs[area + 1])
- {
- glyph->charpos = CHARPOS (it->position);
- glyph->object = it->object;
- glyph->pixel_width = it->pixel_width;
- glyph->voffset = it->voffset;
- glyph->type = CHAR_GLYPH;
- glyph->multibyte_p = it->multibyte_p;
- glyph->left_box_line_p = it->start_of_box_run_p;
- glyph->right_box_line_p = it->end_of_box_run_p;
- glyph->overlaps_vertically_p = (it->phys_ascent > it->ascent
- || it->phys_descent > it->descent);
- glyph->padding_p = 0;
- glyph->glyph_not_available_p = it->glyph_not_available_p;
- glyph->face_id = it->face_id;
- glyph->u.ch = it->char_to_display;
- glyph->w32_font_type = UNKNOWN_FONT;
- ++it->glyph_row->used[area];
+ s->gc = FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc;
}
}
-/* Store one glyph for the composition IT->cmp_id in IT->glyph_row.
- Called from x_produce_glyphs when IT->glyph_row is non-null. */
-static INLINE void
-x_append_composite_glyph (it)
- struct it *it;
-{
- struct glyph *glyph;
- enum glyph_row_area area = it->area;
-
- xassert (it->glyph_row);
-
- glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
- if (glyph < it->glyph_row->glyphs[area + 1])
- {
- glyph->charpos = CHARPOS (it->position);
- glyph->object = it->object;
- glyph->pixel_width = it->pixel_width;
- glyph->voffset = it->voffset;
- glyph->type = COMPOSITE_GLYPH;
- glyph->multibyte_p = it->multibyte_p;
- glyph->left_box_line_p = it->start_of_box_run_p;
- glyph->right_box_line_p = it->end_of_box_run_p;
- glyph->overlaps_vertically_p = (it->phys_ascent > it->ascent
- || it->phys_descent > it->descent);
- glyph->padding_p = 0;
- glyph->glyph_not_available_p = 0;
- glyph->face_id = it->face_id;
- glyph->u.cmp_id = it->cmp_id;
- glyph->w32_font_type = UNKNOWN_FONT;
- ++it->glyph_row->used[area];
- }
-}
+/* Set up S->gc of glyph string S for drawing text in mouse face. */
+static void
+x_set_mouse_face_gc (s)
+ struct glyph_string *s;
+{
+ int face_id;
+ struct face *face;
-/* Change IT->ascent and IT->height according to the setting of
- IT->voffset. */
+ /* What face has to be used last for the mouse face? */
+ face_id = FRAME_W32_DISPLAY_INFO (s->f)->mouse_face_face_id;
+ face = FACE_FROM_ID (s->f, face_id);
+ if (face == NULL)
+ face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
-static INLINE void
-take_vertical_position_into_account (it)
- struct it *it;
-{
- if (it->voffset)
+ if (s->first_glyph->type == CHAR_GLYPH)
+ face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch);
+ else
+ face_id = FACE_FOR_CHAR (s->f, face, 0);
+ 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;
+ else
{
- if (it->voffset < 0)
- /* Increase the ascent so that we can display the text higher
- in the line. */
- it->ascent += abs (it->voffset);
+ /* Otherwise construct scratch_cursor_gc with values from FACE
+ but font FONT. */
+ XGCValues xgcv;
+ unsigned long mask;
+
+ xgcv.background = s->face->background;
+ xgcv.foreground = s->face->foreground;
+ IF_DEBUG (x_check_font (s->f, s->font));
+ xgcv.font = s->font;
+ mask = GCForeground | GCBackground | GCFont;
+
+ if (FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc)
+ XChangeGC (NULL, FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc,
+ mask, &xgcv);
else
- /* Increase the descent so that we can display the text lower
- in the line. */
- it->descent += it->voffset;
+ FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc
+ = XCreateGC (NULL, s->window, mask, &xgcv);
+
+ s->gc = FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc;
}
+
+ xassert (s->gc != 0);
}
-/* Produce glyphs/get display metrics for the image IT is loaded with.
- See the description of struct display_iterator in dispextern.h for
- an overview of struct display_iterator. */
+/* Set S->gc of glyph string S to a GC suitable for drawing a mode line.
+ Faces to use in the mode line have already been computed when the
+ matrix was built, so there isn't much to do, here. */
-static void
-x_produce_image_glyph (it)
- struct it *it;
+static INLINE void
+x_set_mode_line_face_gc (s)
+ struct glyph_string *s;
{
- struct image *img;
- struct face *face;
-
- xassert (it->what == IT_IMAGE);
+ s->gc = s->face->gc;
+}
- face = FACE_FROM_ID (it->f, it->face_id);
- img = IMAGE_FROM_ID (it->f, it->image_id);
- xassert (img);
- /* Make sure X resources of the face and image are loaded. */
- PREPARE_FACE_FOR_DISPLAY (it->f, face);
- prepare_image_for_display (it->f, img);
+/* Set S->gc of glyph string S for drawing that glyph string. Set
+ S->stippled_p to a non-zero value if the face of S has a stipple
+ pattern. */
- it->ascent = it->phys_ascent = image_ascent (img, face);
- it->descent = it->phys_descent = img->height + 2 * img->vmargin - it->ascent;
- it->pixel_width = img->width + 2 * img->hmargin;
+static INLINE void
+x_set_glyph_string_gc (s)
+ struct glyph_string *s;
+{
+ PREPARE_FACE_FOR_DISPLAY (s->f, s->face);
- it->nglyphs = 1;
-
- if (face->box != FACE_NO_BOX)
+ if (s->hl == DRAW_NORMAL_TEXT)
{
- if (face->box_line_width > 0)
- {
- it->ascent += face->box_line_width;
- it->descent += face->box_line_width;
- }
-
- if (it->start_of_box_run_p)
- it->pixel_width += abs (face->box_line_width);
- if (it->end_of_box_run_p)
- it->pixel_width += abs (face->box_line_width);
+ s->gc = s->face->gc;
+ s->stippled_p = s->face->stipple != 0;
}
-
- take_vertical_position_into_account (it);
-
- if (it->glyph_row)
+ else if (s->hl == DRAW_INVERSE_VIDEO)
{
- struct glyph *glyph;
- enum glyph_row_area area = it->area;
-
- glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
- if (glyph < it->glyph_row->glyphs[area + 1])
- {
- glyph->charpos = CHARPOS (it->position);
- glyph->object = it->object;
- glyph->pixel_width = it->pixel_width;
- glyph->voffset = it->voffset;
- glyph->type = IMAGE_GLYPH;
- glyph->multibyte_p = it->multibyte_p;
- glyph->left_box_line_p = it->start_of_box_run_p;
- glyph->right_box_line_p = it->end_of_box_run_p;
- glyph->overlaps_vertically_p = 0;
- glyph->padding_p = 0;
- glyph->glyph_not_available_p = 0;
- glyph->face_id = it->face_id;
- glyph->u.img_id = img->id;
- glyph->w32_font_type = UNKNOWN_FONT;
- ++it->glyph_row->used[area];
- }
+ x_set_mode_line_face_gc (s);
+ s->stippled_p = s->face->stipple != 0;
}
-}
-
-
-/* Append a stretch glyph to IT->glyph_row. OBJECT is the source
- of the glyph, WIDTH and HEIGHT are the width and height of the
- stretch. ASCENT is the percentage/100 of HEIGHT to use for the
- ascent of the glyph (0 <= ASCENT <= 1). */
-
-static void
-x_append_stretch_glyph (it, object, width, height, ascent)
- struct it *it;
- Lisp_Object object;
- int width, height;
- double ascent;
-{
- struct glyph *glyph;
- enum glyph_row_area area = it->area;
-
- xassert (ascent >= 0 && ascent <= 1);
-
- glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
- if (glyph < it->glyph_row->glyphs[area + 1])
+ else if (s->hl == DRAW_CURSOR)
+ {
+ x_set_cursor_gc (s);
+ s->stippled_p = 0;
+ }
+ else if (s->hl == DRAW_MOUSE_FACE)
+ {
+ x_set_mouse_face_gc (s);
+ s->stippled_p = s->face->stipple != 0;
+ }
+ else if (s->hl == DRAW_IMAGE_RAISED
+ || s->hl == DRAW_IMAGE_SUNKEN)
+ {
+ s->gc = s->face->gc;
+ s->stippled_p = s->face->stipple != 0;
+ }
+ else
{
- glyph->charpos = CHARPOS (it->position);
- glyph->object = object;
- glyph->pixel_width = width;
- glyph->voffset = it->voffset;
- glyph->type = STRETCH_GLYPH;
- glyph->multibyte_p = it->multibyte_p;
- glyph->left_box_line_p = it->start_of_box_run_p;
- glyph->right_box_line_p = it->end_of_box_run_p;
- glyph->overlaps_vertically_p = 0;
- glyph->padding_p = 0;
- glyph->glyph_not_available_p = 0;
- glyph->face_id = it->face_id;
- glyph->u.stretch.ascent = height * ascent;
- glyph->u.stretch.height = height;
- glyph->w32_font_type = UNKNOWN_FONT;
- ++it->glyph_row->used[area];
+ s->gc = s->face->gc;
+ s->stippled_p = s->face->stipple != 0;
}
+
+ /* GC must have been set. */
+ xassert (s->gc != 0);
}
-/* Produce a stretch glyph for iterator IT. IT->object is the value
- of the glyph property displayed. The value must be a list
- `(space KEYWORD VALUE ...)' with the following KEYWORD/VALUE pairs
- being recognized:
+/* Set clipping for output of glyph string S. S may be part of a mode
+ line or menu if we don't have X toolkit support. */
+
+static INLINE void
+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);
+}
- 1. `:width WIDTH' specifies that the space should be WIDTH *
- canonical char width wide. WIDTH may be an integer or floating
- point number.
- 2. `:relative-width FACTOR' specifies that the width of the stretch
- should be computed from the width of the first character having the
- `glyph' property, and should be FACTOR times that width.
+/* RIF:
+ Compute left and right overhang of glyph string S. If S is a glyph
+ string for a composition, assume overhangs don't exist. */
- 3. `:align-to HPOS' specifies that the space should be wide enough
- to reach HPOS, a value in canonical character units.
+static void
+w32_compute_glyph_string_overhangs (s)
+ struct glyph_string *s;
+{
+ /* TODO: Windows does not appear to have a method for
+ getting this info without getting the ABC widths for each
+ individual character and working it out manually. */
+}
- Exactly one of the above pairs must be present.
- 4. `:height HEIGHT' specifies that the height of the stretch produced
- should be HEIGHT, measured in canonical character units.
+static void
+w32_get_glyph_overhangs (glyph, f, left, right)
+ struct glyph *glyph;
+ struct frame *f;
+ int *left, *right;
+{
+ HDC hdc = get_frame_dc (f);
+ /* Convert to unicode! */
+ x_get_glyph_overhangs (glyph, f, left, right);
+ release_frame_dc (f, hdc);
+}
- 5. `:relative-height FACTOR' specifies that the height of the
- stretch should be FACTOR times the height of the characters having
- the glyph property.
- Either none or exactly one of 4 or 5 must be present.
+/* Fill rectangle X, Y, W, H with background color of glyph string S. */
- 6. `:ascent ASCENT' specifies that ASCENT percent of the height
- of the stretch should be used for the ascent of the stretch.
- ASCENT must be in the range 0 <= ASCENT <= 100. */
+static INLINE void
+x_clear_glyph_string_rect (s, x, y, w, h)
+ struct glyph_string *s;
+ int x, y, w, h;
+{
+ int real_x = x;
+ int real_y = y;
+ int real_w = w;
+ int real_h = h;
+#if 0
+ /* Take clipping into account. */
+ if (s->gc->clip_mask == Rect)
+ {
+ real_x = max (real_x, s->gc->clip_rectangle.left);
+ real_y = max (real_y, s->gc->clip_rectangle.top);
+ real_w = min (real_w, s->gc->clip_rectangle.right
+ - s->gc->clip_rectangle.left);
+ real_h = min (real_h, s->gc->clip_rectangle.bottom
+ - s->gc->clip_rectangle.top);
+ }
+#endif
+ w32_fill_area (s->f, s->hdc, s->gc->background, real_x, real_y,
+ real_w, real_h);
+}
-#define NUMVAL(X) \
- ((INTEGERP (X) || FLOATP (X)) \
- ? XFLOATINT (X) \
- : - 1)
+/* Draw the background of glyph_string S. If S->background_filled_p
+ is non-zero don't draw it. FORCE_P non-zero means draw the
+ background even if it wouldn't be drawn normally. This is used
+ when a string preceding S draws into the background of S, or S
+ contains the first component of a composition. */
static void
-x_produce_stretch_glyph (it)
- struct it *it;
+x_draw_glyph_string_background (s, force_p)
+ struct glyph_string *s;
+ int force_p;
{
- /* (space :width WIDTH :height HEIGHT. */
-#if GLYPH_DEBUG
- extern Lisp_Object Qspace;
-#endif
- extern Lisp_Object QCwidth, QCheight, QCascent;
- extern Lisp_Object QCrelative_width, QCrelative_height;
- extern Lisp_Object QCalign_to;
- Lisp_Object prop, plist;
- double width = 0, height = 0, ascent = 0;
- struct face *face = FACE_FROM_ID (it->f, it->face_id);
- XFontStruct *font = face->font ? face->font : FRAME_FONT (it->f);
-
- PREPARE_FACE_FOR_DISPLAY (it->f, face);
-
- /* List should start with `space'. */
- xassert (CONSP (it->object) && EQ (XCAR (it->object), Qspace));
- plist = XCDR (it->object);
-
- /* Compute the width of the stretch. */
- if (prop = Fplist_get (plist, QCwidth),
- NUMVAL (prop) > 0)
- /* Absolute width `:width WIDTH' specified and valid. */
- width = NUMVAL (prop) * CANON_X_UNIT (it->f);
- else if (prop = Fplist_get (plist, QCrelative_width),
- NUMVAL (prop) > 0)
+ /* Nothing to do if background has already been drawn or if it
+ shouldn't be drawn in the first place. */
+ if (!s->background_filled_p)
{
- /* Relative width `:relative-width FACTOR' specified and valid.
- Compute the width of the characters having the `glyph'
- property. */
- struct it it2;
- unsigned char *p = BYTE_POS_ADDR (IT_BYTEPOS (*it));
-
- it2 = *it;
- if (it->multibyte_p)
+ int box_line_width = max (s->face->box_line_width, 0);
+
+#if 0 /* TODO: stipple */
+ if (s->stippled_p)
{
- int maxlen = ((IT_BYTEPOS (*it) >= GPT ? ZV : GPT)
- - IT_BYTEPOS (*it));
- it2.c = STRING_CHAR_AND_LENGTH (p, maxlen, it2.len);
+ /* Fill background with a stipple pattern. */
+ XSetFillStyle (s->display, s->gc, FillOpaqueStippled);
+ XFillRectangle (s->display, s->window, s->gc, s->x,
+ s->y + box_line_width,
+ s->background_width,
+ s->height - 2 * box_line_width);
+ XSetFillStyle (s->display, s->gc, FillSolid);
+ s->background_filled_p = 1;
}
else
- it2.c = *p, it2.len = 1;
-
- it2.glyph_row = NULL;
- it2.what = IT_CHARACTER;
- x_produce_glyphs (&it2);
- width = NUMVAL (prop) * it2.pixel_width;
- }
- else if (prop = Fplist_get (plist, QCalign_to),
- NUMVAL (prop) > 0)
- width = NUMVAL (prop) * CANON_X_UNIT (it->f) - it->current_x;
- else
- /* Nothing specified -> width defaults to canonical char width. */
- width = CANON_X_UNIT (it->f);
-
- /* Compute height. */
- if (prop = Fplist_get (plist, QCheight),
- NUMVAL (prop) > 0)
- height = NUMVAL (prop) * CANON_Y_UNIT (it->f);
- else if (prop = Fplist_get (plist, QCrelative_height),
- NUMVAL (prop) > 0)
- height = FONT_HEIGHT (font) * NUMVAL (prop);
- else
- height = FONT_HEIGHT (font);
-
- /* Compute percentage of height used for ascent. If
- `:ascent ASCENT' is present and valid, use that. Otherwise,
- derive the ascent from the font in use. */
- if (prop = Fplist_get (plist, QCascent),
- NUMVAL (prop) > 0 && NUMVAL (prop) <= 100)
- ascent = NUMVAL (prop) / 100.0;
- else
- ascent = (double) FONT_BASE (font) / FONT_HEIGHT (font);
-
- if (width <= 0)
- width = 1;
- if (height <= 0)
- height = 1;
-
- if (it->glyph_row)
- {
- Lisp_Object object = it->stack[it->sp - 1].string;
- if (!STRINGP (object))
- object = it->w->buffer;
- x_append_stretch_glyph (it, object, width, height, ascent);
- }
-
- it->pixel_width = width;
- it->ascent = it->phys_ascent = height * ascent;
- it->descent = it->phys_descent = height - it->ascent;
- it->nglyphs = 1;
-
- if (face->box != FACE_NO_BOX)
- {
- if (face->box_line_width > 0)
+#endif
+ if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width
+ || s->font_not_found_p
+ || s->extends_to_end_of_line_p
+ || s->font->bdf
+ || force_p)
{
- it->ascent += face->box_line_width;
- it->descent += face->box_line_width;
+ x_clear_glyph_string_rect (s, s->x, s->y + box_line_width,
+ s->background_width,
+ s->height - 2 * box_line_width);
+ s->background_filled_p = 1;
}
-
- if (it->start_of_box_run_p)
- it->pixel_width += abs (face->box_line_width);
- if (it->end_of_box_run_p)
- it->pixel_width += abs (face->box_line_width);
}
-
- take_vertical_position_into_account (it);
-}
-
-/* Return proper value to be used as baseline offset of font that has
- ASCENT and DESCENT to draw characters by the font at the vertical
- center of the line of frame F.
-
- Here, out task is to find the value of BOFF in the following figure;
-
- -------------------------+-----------+-
- -+-+---------+-+ | |
- | | | | | |
- | | | | F_ASCENT F_HEIGHT
- | | | ASCENT | |
- HEIGHT | | | | |
- | | |-|-+------+-----------|------- baseline
- | | | | BOFF | |
- | |---------|-+-+ | |
- | | | DESCENT | |
- -+-+---------+-+ F_DESCENT |
- -------------------------+-----------+-
-
- -BOFF + DESCENT + (F_HEIGHT - HEIGHT) / 2 = F_DESCENT
- BOFF = DESCENT + (F_HEIGHT - HEIGHT) / 2 - F_DESCENT
- DESCENT = FONT->descent
- HEIGHT = FONT_HEIGHT (FONT)
- F_DESCENT = (F->output_data.x->font->descent
- - F->output_data.x->baseline_offset)
- F_HEIGHT = FRAME_LINE_HEIGHT (F)
-*/
+}
-#define VCENTER_BASELINE_OFFSET(FONT, F) \
- (FONT_DESCENT (FONT) \
- + (FRAME_LINE_HEIGHT ((F)) - FONT_HEIGHT ((FONT)) \
- + (FRAME_LINE_HEIGHT ((F)) > FONT_HEIGHT ((FONT)))) / 2 \
- - (FONT_DESCENT (FRAME_FONT (F)) - FRAME_BASELINE_OFFSET (F)))
-/* Produce glyphs/get display metrics for the display element IT is
- loaded with. See the description of struct display_iterator in
- dispextern.h for an overview of struct display_iterator. */
+/* Draw the foreground of glyph string S. */
static void
-x_produce_glyphs (it)
- struct it *it;
+x_draw_glyph_string_foreground (s)
+ struct glyph_string *s;
{
- it->glyph_not_available_p = 0;
+ int i, x;
+ HFONT old_font;
- if (it->what == IT_CHARACTER)
- {
- wchar_t char2b;
- XFontStruct *font;
- 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 */
- /* We may change it->multibyte_p upon unibyte<->multibyte
- conversion. So, save the current value now and restore it
- later.
-
- Note: It seems that we don't have to record multibyte_p in
- struct glyph because the character code itself tells if or
- not the character is multibyte. Thus, in the future, we must
- consider eliminating the field `multibyte_p' in the struct
- glyph.
- */
- int saved_multibyte_p = it->multibyte_p;
-
- /* Maybe translate single-byte characters to multibyte, or the
- other way. */
- it->char_to_display = it->c;
- if (!ASCII_CHAR_P (it->c))
- {
- 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->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);
- }
- }
-
- /* Get font to use. Encode IT->char_to_display. */
- x_get_char_face_and_encoding (it->f, it->char_to_display,
- it->face_id, &char2b,
- it->multibyte_p);
- font = face->font;
-
- /* When no suitable font found, use the default font. */
- font_not_found_p = font == NULL;
- if (font_not_found_p)
- {
- font = FRAME_FONT (it->f);
- boff = it->f->output_data.w32->baseline_offset;
- font_info = NULL;
- }
- 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;
- }
+ /* 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
+ && s->first_glyph->left_box_line_p)
+ x = s->x + abs (s->face->box_line_width);
+ else
+ x = s->x;
- if (it->char_to_display >= ' '
- && (!it->multibyte_p || it->char_to_display < 128))
- {
- /* Either unibyte or ASCII. */
- int stretched_p;
+ if (s->for_overlaps_p || (s->background_filled_p && s->hl != DRAW_CURSOR))
+ SetBkMode (s->hdc, TRANSPARENT);
+ else
+ SetBkMode (s->hdc, OPAQUE);
- it->nglyphs = 1;
+ SetTextColor (s->hdc, s->gc->foreground);
+ SetBkColor (s->hdc, s->gc->background);
+ SetTextAlign (s->hdc, TA_BASELINE | TA_LEFT);
- pcm = w32_per_char_metric (font, &char2b,
- font->bdf ? BDF_1D_FONT : ANSI_FONT);
- it->ascent = FONT_BASE (font) + boff;
- it->descent = FONT_DESCENT (font) - boff;
+ if (s->font && s->font->hfont)
+ old_font = SelectObject (s->hdc, s->font->hfont);
- if (pcm)
- {
- it->phys_ascent = pcm->ascent + boff;
- it->phys_descent = pcm->descent - boff;
- it->pixel_width = pcm->width;
- }
- else
- {
- it->glyph_not_available_p = 1;
- it->phys_ascent = FONT_BASE (font) + boff;
- it->phys_descent = FONT_DESCENT (font) - boff;
- it->pixel_width = FONT_WIDTH (font);
- }
-
- /* If this is a space inside a region of text with
- `space-width' property, change its width. */
- stretched_p = it->char_to_display == ' ' && !NILP (it->space_width);
- if (stretched_p)
- it->pixel_width *= XFLOATINT (it->space_width);
-
- /* If face has a box, add the box thickness to the character
- height. If character has a box line to the left and/or
- right, add the box line width to the character's width. */
- if (face->box != FACE_NO_BOX)
- {
- int thick = face->box_line_width;
-
- if (thick > 0)
- {
- it->ascent += thick;
- it->descent += thick;
- }
- else
- thick = -thick;
-
- if (it->start_of_box_run_p)
- it->pixel_width += thick;
- if (it->end_of_box_run_p)
- it->pixel_width += thick;
- }
-
- /* If face has an overline, add the height of the overline
- (1 pixel) and a 1 pixel margin to the character height. */
- if (face->overline_p)
- it->ascent += 2;
-
- take_vertical_position_into_account (it);
-
- /* If we have to actually produce glyphs, do it. */
- if (it->glyph_row)
- {
- if (stretched_p)
- {
- /* Translate a space with a `space-width' property
- into a stretch glyph. */
- double ascent = (double) FONT_BASE (font)
- / FONT_HEIGHT (font);
- x_append_stretch_glyph (it, it->object, it->pixel_width,
- it->ascent + it->descent, ascent);
- }
- else
- x_append_glyph (it);
-
- /* If characters with lbearing or rbearing are displayed
- in this line, record that fact in a flag of the
- glyph row. This is used to optimize X output code. */
- if (pcm && (pcm->lbearing < 0 || pcm->rbearing > pcm->width))
- it->glyph_row->contains_overlapping_glyphs_p = 1;
- }
- }
- else if (it->char_to_display == '\n')
- {
- /* A newline has no width but we need the height of the line. */
- it->pixel_width = 0;
- it->nglyphs = 0;
- it->ascent = it->phys_ascent = FONT_BASE (font) + boff;
- it->descent = it->phys_descent = FONT_DESCENT (font) - boff;
-
- if (face->box != FACE_NO_BOX
- && face->box_line_width > 0)
- {
- it->ascent += face->box_line_width;
- it->descent += face->box_line_width;
- }
- }
- else if (it->char_to_display == '\t')
- {
- int tab_width = it->tab_width * CANON_X_UNIT (it->f);
- int x = it->current_x + it->continuation_lines_width;
- int next_tab_x = ((1 + x + tab_width - 1) / tab_width) * tab_width;
-
- /* If the distance from the current position to the next tab
- stop is less than a canonical character width, use the
- tab stop after that. */
- if (next_tab_x - x < CANON_X_UNIT (it->f))
- next_tab_x += tab_width;
-
- it->pixel_width = next_tab_x - x;
- it->nglyphs = 1;
- it->ascent = it->phys_ascent = FONT_BASE (font) + boff;
- it->descent = it->phys_descent = FONT_DESCENT (font) - boff;
-
- if (it->glyph_row)
- {
- double ascent = (double) it->ascent / (it->ascent + it->descent);
- x_append_stretch_glyph (it, it->object, it->pixel_width,
- it->ascent + it->descent, ascent);
- }
- }
- else
- {
- /* A multi-byte character.
- 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. */
- enum w32_char_font_type type;
-
- if (font->bdf && CHARSET_DIMENSION (CHAR_CHARSET (it->c)) == 1)
- type = BDF_1D_FONT;
- else if (font->bdf)
- type = BDF_2D_FONT;
- else
- type = UNICODE_FONT;
-
- pcm = w32_per_char_metric (font, &char2b, type);
-
- if (font_not_found_p || !pcm)
- {
- int charset = CHAR_CHARSET (it->char_to_display);
-
- it->glyph_not_available_p = 1;
- it->pixel_width = (FONT_WIDTH (FRAME_FONT (it->f))
- * CHARSET_WIDTH (charset));
- it->phys_ascent = FONT_BASE (font) + boff;
- it->phys_descent = FONT_DESCENT (font) - boff;
- }
- else
- {
- it->pixel_width = pcm->width;
- it->phys_ascent = pcm->ascent + boff;
- it->phys_descent = pcm->descent - boff;
- if (it->glyph_row
- && (pcm->lbearing < 0
- || pcm->rbearing > pcm->width))
- it->glyph_row->contains_overlapping_glyphs_p = 1;
- }
- it->nglyphs = 1;
- it->ascent = FONT_BASE (font) + boff;
- it->descent = FONT_DESCENT (font) - boff;
- if (face->box != FACE_NO_BOX)
- {
- int thick = face->box_line_width;
+ /* Draw characters of S as rectangles if S's font could not be
+ loaded. */
+ if (s->font_not_found_p)
+ {
+ for (i = 0; i < s->nchars; ++i)
+ {
+ struct glyph *g = s->first_glyph + i;
- if (thick > 0)
- {
- it->ascent += thick;
- it->descent += thick;
- }
- else
- thick = - thick;
-
- if (it->start_of_box_run_p)
- it->pixel_width += thick;
- if (it->end_of_box_run_p)
- it->pixel_width += thick;
- }
-
- /* If face has an overline, add the height of the overline
- (1 pixel) and a 1 pixel margin to the character height. */
- if (face->overline_p)
- it->ascent += 2;
-
- take_vertical_position_into_account (it);
-
- if (it->glyph_row)
- x_append_glyph (it);
- }
- it->multibyte_p = saved_multibyte_p;
+ w32_draw_rectangle (s->hdc, s->gc, x, s->y, g->pixel_width - 1,
+ s->height - 1);
+ x += g->pixel_width;
+ }
}
- else if (it->what == IT_COMPOSITION)
+ else
{
- /* Note: A composition is represented as one glyph in the
- glyph matrix. There are no padding glyphs. */
- wchar_t char2b;
- XFontStruct *font;
- 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];
-
- /* 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);
- x_get_char_face_and_encoding (it->f, it->char_to_display,
- it->face_id, &char2b, it->multibyte_p);
- font = face->font;
-
- /* When no suitable font found, use the default font. */
- font_not_found_p = font == NULL;
- if (font_not_found_p)
- {
- font = FRAME_FONT (it->f);
- boff = it->f->output_data.w32->baseline_offset;
- font_info = NULL;
- }
- 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;
- }
+ char *char1b = (char *) s->char2b;
+ int boff = s->font_info->baseline_offset;
- /* 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;
-
- /* 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;
- /* Bounding box of the overall glyphs. */
- int leftmost, rightmost, lowest, highest;
- int i, width, ascent, descent;
- enum w32_char_font_type font_type;
-
- cmp->font = (void *) font;
-
- if (font->bdf && CHARSET_DIMENSION (CHAR_CHARSET (it->c)) == 1)
- font_type = BDF_1D_FONT;
- else if (font->bdf)
- font_type = BDF_2D_FONT;
- else
- font_type = UNICODE_FONT;
+ if (s->font_info->vertical_centering)
+ boff = VCENTER_BASELINE_OFFSET (s->font, s->f) - boff;
- /* Initialize the bounding box. */
- if (font_info
- && (pcm = w32_per_char_metric (font, &char2b, font_type)))
- {
- width = pcm->width;
- ascent = pcm->ascent;
- descent = pcm->descent;
- }
- else
- {
- width = FONT_WIDTH (font);
- ascent = FONT_BASE (font);
- descent = FONT_DESCENT (font);
- }
-
- rightmost = width;
- lowest = - descent + boff;
- highest = ascent + boff;
- leftmost = 0;
-
- if (font_info
- && font_info->default_ascent
- && CHAR_TABLE_P (Vuse_default_ascent)
- && !NILP (Faref (Vuse_default_ascent,
- make_number (it->char_to_display))))
- 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;
-
- /* Set cmp->offsets for the remaining glyphs. */
- for (i = 1; i < cmp->glyph_len; i++)
- {
- int left, right, btm, top;
- int ch = COMPOSITION_GLYPH (cmp, i);
- int face_id = FACE_FOR_CHAR (it->f, face, ch);
-
- face = FACE_FROM_ID (it->f, face_id);
- x_get_char_face_and_encoding (it->f, ch, face->id, &char2b,
- it->multibyte_p);
- font = face->font;
- if (font == NULL)
- {
- font = FRAME_FONT (it->f);
- boff = it->f->output_data.w32->baseline_offset;
- font_info = NULL;
- }
- 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;
- }
+ /* If we can use 8-bit functions, condense S->char2b. */
+ if (!s->two_byte_p)
+ for (i = 0; i < s->nchars; ++i)
+ char1b[i] = XCHAR2B_BYTE2 (&s->char2b[i]);
- if (font->bdf && CHARSET_DIMENSION (CHAR_CHARSET (ch)) == 1)
- font_type = BDF_1D_FONT;
- else if (font->bdf)
- font_type = BDF_2D_FONT;
- else
- font_type = UNICODE_FONT;
+ /* Draw text with TextOut and friends. */
+ w32_text_out (s, x, s->ybase - boff, s->char2b, s->nchars);
- if (font_info
- && (pcm = w32_per_char_metric (font, &char2b, font_type)))
- {
- width = pcm->width;
- ascent = pcm->ascent;
- descent = pcm->descent;
- }
- else
- {
- width = FONT_WIDTH (font);
- ascent = 1;
- descent = 0;
- }
+ if (s->face->overstrike)
+ {
+ /* For overstriking (to simulate bold-face), draw the
+ characters again shifted to the right by one pixel. */
+ w32_text_out (s, x + 1, s->ybase - boff, s->char2b, s->nchars);
+ }
+ }
+ if (s->font && s->font->hfont)
+ SelectObject (s->hdc, old_font);
+}
- 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)))))
- {
+/* Draw the foreground of composite glyph string S. */
- 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;
-
- 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));
- }
+static void
+x_draw_composite_glyph_string_foreground (s)
+ struct glyph_string *s;
+{
+ int i, x;
+ HFONT old_font;
- 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 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
+ && s->first_glyph->left_box_line_p)
+ x = s->x + abs (s->face->box_line_width);
+ else
+ x = s->x;
- /* If there are glyphs whose x-offsets are negative,
- shift all glyphs to the right and make all x-offsets
- non-negative. */
- if (leftmost < 0)
- {
- for (i = 0; i < cmp->glyph_len; i++)
- cmp->offsets[i * 2] -= leftmost;
- rightmost -= leftmost;
- }
+ /* S is a glyph string for a composition. S->gidx is the index of
+ the first character drawn for glyphs of this composition.
+ S->gidx == 0 means we are drawing the very first character of
+ this composition. */
- cmp->pixel_width = rightmost;
- cmp->ascent = highest;
- cmp->descent = - lowest;
- if (cmp->ascent < font_ascent)
- cmp->ascent = font_ascent;
- if (cmp->descent < font_descent)
- cmp->descent = font_descent;
- }
+ SetTextColor (s->hdc, s->gc->foreground);
+ SetBkColor (s->hdc, s->gc->background);
+ SetBkMode (s->hdc, TRANSPARENT);
+ SetTextAlign (s->hdc, TA_BASELINE | TA_LEFT);
- it->pixel_width = cmp->pixel_width;
- it->ascent = it->phys_ascent = cmp->ascent;
- it->descent = it->phys_descent = cmp->descent;
+ if (s->font && s->font->hfont)
+ old_font = SelectObject (s->hdc, s->font->hfont);
- if (face->box != FACE_NO_BOX)
+ /* Draw a rectangle for the composition if the font for the very
+ first character of the composition could not be loaded. */
+ if (s->font_not_found_p)
+ {
+ if (s->gidx == 0)
+ w32_draw_rectangle (s->hdc, s->gc, x, s->y, s->width - 1,
+ s->height - 1);
+ }
+ else
+ {
+ for (i = 0; i < s->nchars; i++, ++s->gidx)
{
- int thick = face->box_line_width;
-
- if (thick > 0)
- {
- it->ascent += thick;
- it->descent += thick;
- }
- else
- thick = - thick;
-
- if (it->start_of_box_run_p)
- it->pixel_width += thick;
- if (it->end_of_box_run_p)
- it->pixel_width += thick;
+ 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);
}
-
- /* If face has an overline, add the height of the overline
- (1 pixel) and a 1 pixel margin to the character height. */
- if (face->overline_p)
- it->ascent += 2;
-
- take_vertical_position_into_account (it);
-
- if (it->glyph_row)
- x_append_composite_glyph (it);
}
- else if (it->what == IT_IMAGE)
- x_produce_image_glyph (it);
- else if (it->what == IT_STRETCH)
- x_produce_stretch_glyph (it);
-
- /* Accumulate dimensions. Note: can't assume that it->descent > 0
- because this isn't true for images with `:ascent 100'. */
- xassert (it->ascent >= 0 && it->descent >= 0);
- if (it->area == TEXT_AREA)
- it->current_x += it->pixel_width;
- it->descent += it->extra_line_spacing;
-
- it->max_ascent = max (it->max_ascent, it->ascent);
- it->max_descent = max (it->max_descent, it->descent);
- it->max_phys_ascent = max (it->max_phys_ascent, it->phys_ascent);
- it->max_phys_descent = max (it->max_phys_descent, it->phys_descent);
+ if (s->font && s->font->hfont)
+ SelectObject (s->hdc, old_font);
}
-/* Estimate the pixel height of the mode or top line on frame F.
- FACE_ID specifies what line's height to estimate. */
-
-int
-x_estimate_mode_line_height (f, face_id)
- struct frame *f;
- enum face_id face_id;
-{
- int height = FONT_HEIGHT (FRAME_FONT (f));
+/* Brightness beyond which a color won't have its highlight brightness
+ boosted.
- /* This function is called so early when Emacs starts that the face
- cache and mode line face are not yet initialized. */
- if (FRAME_FACE_CACHE (f))
- {
- struct face *face = FACE_FROM_ID (f, face_id);
- if (face)
- {
- if (face->font)
- height = FONT_HEIGHT (face->font);
- if (face->box_line_width > 0)
- height += 2 * face->box_line_width;
- }
- }
-
- return height;
-}
+ Nominally, highlight colors for `3d' faces are calculated by
+ brightening an object's color by a constant scale factor, but this
+ doesn't yield good results for dark colors, so for colors who's
+ brightness is less than this value (on a scale of 0-255) have to
+ use an additional additive factor.
-\f
-/***********************************************************************
- Glyph display
- ***********************************************************************/
+ The value here is set so that the default menu-bar/mode-line color
+ (grey75) will not have its highlights changed at all. */
+#define HIGHLIGHT_COLOR_DARK_BOOST_LIMIT 187
-/* A sequence of glyphs to be drawn in the same face.
- This data structure is not really completely X specific, so it
- could possibly, at least partially, be useful for other systems. It
- is currently not part of the external redisplay interface because
- it's not clear what other systems will need. */
+/* Allocate a color which is lighter or darker than *COLOR by FACTOR
+ or DELTA. Try a color with RGB values multiplied by FACTOR first.
+ If this produces the same color as COLOR, try a color where all RGB
+ values have DELTA added. Return the allocated color in *COLOR.
+ DISPLAY is the X display, CMAP is the colormap to operate on.
+ Value is non-zero if successful. */
-struct glyph_string
+static int
+w32_alloc_lighter_color (f, color, factor, delta)
+ struct frame *f;
+ COLORREF *color;
+ double factor;
+ int delta;
{
- /* X-origin of the string. */
- int x;
-
- /* Y-origin and y-position of the base line of this string. */
- int y, ybase;
-
- /* The width of the string, not including a face extension. */
- int width;
-
- /* The width of the string, including a face extension. */
- int background_width;
-
- /* The height of this string. This is the height of the line this
- string is drawn in, and can be different from the height of the
- font the string is drawn in. */
- int height;
-
- /* Number of pixels this string overwrites in front of its x-origin.
- This number is zero if the string has an lbearing >= 0; it is
- -lbearing, if the string has an lbearing < 0. */
- int left_overhang;
+ COLORREF new;
+ long bright;
- /* Number of pixels this string overwrites past its right-most
- nominal x-position, i.e. x + width. Zero if the string's
- rbearing is <= its nominal width, rbearing - width otherwise. */
- int right_overhang;
+ /* On Windows, RGB values are 0-255, not 0-65535, so scale delta. */
+ delta /= 256;
- /* The frame on which the glyph string is drawn. */
- struct frame *f;
+ /* Change RGB values by specified FACTOR. Avoid overflow! */
+ xassert (factor >= 0);
+ new = PALETTERGB (min (0xff, factor * GetRValue (*color)),
+ min (0xff, factor * GetGValue (*color)),
+ min (0xff, factor * GetBValue (*color)));
- /* The window on which the glyph string is drawn. */
- struct window *w;
+ /* Calculate brightness of COLOR. */
+ bright = (2 * GetRValue (*color) + 3 * GetGValue (*color)
+ + GetBValue (*color)) / 6;
- /* X display and window for convenience. */
- Window window;
+ /* We only boost colors that are darker than
+ HIGHLIGHT_COLOR_DARK_BOOST_LIMIT. */
+ if (bright < HIGHLIGHT_COLOR_DARK_BOOST_LIMIT)
+ /* Make an additive adjustment to NEW, because it's dark enough so
+ that scaling by FACTOR alone isn't enough. */
+ {
+ /* How far below the limit this color is (0 - 1, 1 being darker). */
+ double dimness = 1 - (double)bright / HIGHLIGHT_COLOR_DARK_BOOST_LIMIT;
+ /* The additive adjustment. */
+ int min_delta = delta * dimness * factor / 2;
- /* The glyph row for which this string was built. It determines the
- y-origin and height of the string. */
- struct glyph_row *row;
+ if (factor < 1)
+ new = PALETTERGB (max (0, min (0xff, min_delta - GetRValue (*color))),
+ max (0, min (0xff, min_delta - GetGValue (*color))),
+ max (0, min (0xff, min_delta - GetBValue (*color))));
+ else
+ new = PALETTERGB (max (0, min (0xff, min_delta + GetRValue (*color))),
+ max (0, min (0xff, min_delta + GetGValue (*color))),
+ max (0, min (0xff, min_delta + GetBValue (*color))));
+ }
- /* The area within row. */
- enum glyph_row_area area;
+ if (new == *color)
+ new = PALETTERGB (max (0, min (0xff, delta + GetRValue (*color))),
+ max (0, min (0xff, delta + GetGValue (*color))),
+ max (0, min (0xff, delta + GetBValue (*color))));
- /* Characters to be drawn, and number of characters. */
- wchar_t *char2b;
- int nchars;
+ /* TODO: Map to palette and retry with delta if same? */
+ /* TODO: Free colors (if using palette)? */
- /* A face-override for drawing cursors, mouse face and similar. */
- enum draw_glyphs_face hl;
+ if (new == *color)
+ return 0;
- /* Face in which this string is to be drawn. */
- struct face *face;
+ *color = new;
- /* Font in which this string is to be drawn. */
- XFontStruct *font;
+ return 1;
+}
- /* Font info for this string. */
- struct font_info *font_info;
- /* Non-null means this string describes (part of) a composition.
- All characters from char2b are drawn composed. */
- struct composition *cmp;
+/* Set up the foreground color for drawing relief lines of glyph
+ string S. RELIEF is a pointer to a struct relief containing the GC
+ with which lines will be drawn. Use a color that is FACTOR or
+ DELTA lighter or darker than the relief's background which is found
+ in S->f->output_data.x->relief_background. If such a color cannot
+ be allocated, use DEFAULT_PIXEL, instead. */
- /* Index of this glyph string's first character in the glyph
- definition of CMP. If this is zero, this glyph string describes
- the first character of a composition. */
- int gidx;
+static void
+w32_setup_relief_color (f, relief, factor, delta, default_pixel)
+ struct frame *f;
+ struct relief *relief;
+ double factor;
+ int delta;
+ COLORREF default_pixel;
+{
+ XGCValues xgcv;
+ struct w32_output *di = f->output_data.w32;
+ unsigned long mask = GCForeground;
+ COLORREF pixel;
+ COLORREF background = di->relief_background;
+ struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
- /* 1 means this glyph strings face has to be drawn to the right end
- of the window's drawing area. */
- unsigned extends_to_end_of_line_p : 1;
+ /* TODO: Free colors (if using palette)? */
- /* 1 means the background of this string has been drawn. */
- unsigned background_filled_p : 1;
+ /* Allocate new color. */
+ xgcv.foreground = default_pixel;
+ pixel = background;
+ if (w32_alloc_lighter_color (f, &pixel, factor, delta))
+ {
+ relief->allocated_p = 1;
+ xgcv.foreground = relief->pixel = pixel;
+ }
+
+ if (relief->gc == 0)
+ {
+#if 0 /* TODO: stipple */
+ xgcv.stipple = dpyinfo->gray;
+ mask |= GCStipple;
+#endif
+ relief->gc = XCreateGC (NULL, FRAME_W32_WINDOW (f), mask, &xgcv);
+ }
+ else
+ XChangeGC (NULL, relief->gc, mask, &xgcv);
+}
- /* 1 means glyph string must be drawn with 16-bit functions. */
- unsigned two_byte_p : 1;
- /* 1 means that the original font determined for drawing this glyph
- string could not be loaded. The member `font' has been set to
- the frame's default font in this case. */
- unsigned font_not_found_p : 1;
+/* Set up colors for the relief lines around glyph string S. */
- /* 1 means that the face in which this glyph string is drawn has a
- stipple pattern. */
- unsigned stippled_p : 1;
+static void
+x_setup_relief_colors (s)
+ struct glyph_string *s;
+{
+ struct w32_output *di = s->f->output_data.w32;
+ COLORREF color;
- /* 1 means only the foreground of this glyph string must be drawn,
- and we should use the physical height of the line this glyph
- string appears in as clip rect. */
- unsigned for_overlaps_p : 1;
+ if (s->face->use_box_color_for_shadows_p)
+ color = s->face->box_color;
+ else if (s->first_glyph->type == IMAGE_GLYPH
+ && s->img->pixmap
+ && !IMAGE_BACKGROUND_TRANSPARENT (s->img, s->f, 0))
+ color = IMAGE_BACKGROUND (s->img, s->f, 0);
+ else
+ color = s->gc->background;
- /* The GC to use for drawing this glyph string. */
- XGCValues *gc;
+ if (di->white_relief.gc == 0
+ || color != di->relief_background)
+ {
+ di->relief_background = color;
+ w32_setup_relief_color (s->f, &di->white_relief, 1.2, 0x8000,
+ WHITE_PIX_DEFAULT (s->f));
+ w32_setup_relief_color (s->f, &di->black_relief, 0.6, 0x4000,
+ BLACK_PIX_DEFAULT (s->f));
+ }
+}
- HDC hdc;
- /* A pointer to the first glyph in the string. This glyph
- corresponds to char2b[0]. Needed to draw rectangles if
- font_not_found_p is 1. */
- struct glyph *first_glyph;
+/* Draw a relief on frame F inside the rectangle given by LEFT_X,
+ TOP_Y, RIGHT_X, and BOTTOM_Y. WIDTH is the thickness of the relief
+ to draw, it must be >= 0. RAISED_P non-zero means draw a raised
+ relief. LEFT_P non-zero means draw a relief on the left side of
+ the rectangle. RIGHT_P non-zero means draw a relief on the right
+ side of the rectangle. CLIP_RECT is the clipping rectangle to use
+ when drawing. */
- /* Image, if any. */
- struct image *img;
+static void
+w32_draw_relief_rect (f, left_x, top_y, right_x, bottom_y, width,
+ raised_p, left_p, right_p, clip_rect)
+ struct frame *f;
+ int left_x, top_y, right_x, bottom_y, width, left_p, right_p, raised_p;
+ RECT *clip_rect;
+{
+ int i;
+ XGCValues gc;
+ HDC hdc = get_frame_dc (f);
- struct glyph_string *next, *prev;
-};
+ if (raised_p)
+ gc.foreground = f->output_data.w32->white_relief.gc->foreground;
+ else
+ gc.foreground = f->output_data.w32->black_relief.gc->foreground;
+ w32_set_clip_rectangle (hdc, clip_rect);
-/* Encapsulate the different ways of displaying text under W32. */
+ /* Top. */
+ for (i = 0; i < width; ++i)
+ w32_fill_area (f, hdc, gc.foreground,
+ left_x + i * left_p, top_y + i,
+ right_x - left_x - i * (left_p + right_p ) + 1, 1);
-static void
-w32_text_out (s, x, y,chars,nchars)
- struct glyph_string * s;
- int x, y;
- wchar_t * chars;
- int nchars;
-{
- int charset_dim = w32_font_is_double_byte (s->gc->font) ? 2 : 1;
- if (s->gc->font->bdf)
- w32_BDF_TextOut (s->gc->font->bdf, s->hdc,
- x, y, (char *) chars, charset_dim,
- nchars * charset_dim, 0);
- else if (s->first_glyph->w32_font_type == UNICODE_FONT)
- ExtTextOutW (s->hdc, x, y, 0, NULL, chars, nchars, NULL);
+ /* Left. */
+ if (left_p)
+ for (i = 0; i < width; ++i)
+ w32_fill_area (f, hdc, gc.foreground,
+ left_x + i, top_y + i, 1,
+ bottom_y - top_y - 2 * i + 1);
+
+ if (raised_p)
+ gc.foreground = f->output_data.w32->black_relief.gc->foreground;
else
- ExtTextOutA (s->hdc, x, y, 0, NULL, (char *) chars,
- nchars * charset_dim, NULL);
+ gc.foreground = f->output_data.w32->white_relief.gc->foreground;
+
+ /* Bottom. */
+ for (i = 0; i < width; ++i)
+ w32_fill_area (f, hdc, gc.foreground,
+ left_x + i * left_p, bottom_y - i,
+ right_x - left_x - i * (left_p + right_p) + 1, 1);
+
+ /* Right. */
+ if (right_p)
+ for (i = 0; i < width; ++i)
+ w32_fill_area (f, hdc, gc.foreground,
+ right_x - i, top_y + i + 1, 1,
+ bottom_y - top_y - 2 * i - 1);
+
+ w32_set_clip_rectangle (hdc, NULL);
+
+ release_frame_dc (f, hdc);
}
-#if GLYPH_DEBUG
+
+/* Draw a box on frame F inside the rectangle given by LEFT_X, TOP_Y,
+ RIGHT_X, and BOTTOM_Y. WIDTH is the thickness of the lines to
+ draw, it must be >= 0. LEFT_P non-zero means draw a line on the
+ left side of the rectangle. RIGHT_P non-zero means draw a line
+ on the right side of the rectangle. CLIP_RECT is the clipping
+ rectangle to use when drawing. */
static void
-x_dump_glyph_string (s)
+w32_draw_box_rect (s, left_x, top_y, right_x, bottom_y, width,
+ left_p, right_p, clip_rect)
struct glyph_string *s;
+ int left_x, top_y, right_x, bottom_y, width, left_p, right_p;
+ RECT *clip_rect;
{
- fprintf (stderr, "glyph string\n");
- fprintf (stderr, " x, y, w, h = %d, %d, %d, %d\n",
- s->x, s->y, s->width, s->height);
- fprintf (stderr, " ybase = %d\n", s->ybase);
- fprintf (stderr, " hl = %d\n", s->hl);
- fprintf (stderr, " left overhang = %d, right = %d\n",
- s->left_overhang, s->right_overhang);
- fprintf (stderr, " nchars = %d\n", s->nchars);
- fprintf (stderr, " extends to end of line = %d\n",
- s->extends_to_end_of_line_p);
- fprintf (stderr, " font height = %d\n", FONT_HEIGHT (s->font));
- fprintf (stderr, " bg width = %d\n", s->background_width);
-}
-
-#endif /* GLYPH_DEBUG */
-
-
-
-static void x_append_glyph_string_lists P_ ((struct glyph_string **,
- struct glyph_string **,
- struct glyph_string *,
- struct glyph_string *));
-static void x_prepend_glyph_string_lists P_ ((struct glyph_string **,
- struct glyph_string **,
- struct glyph_string *,
- struct glyph_string *));
-static void x_append_glyph_string P_ ((struct glyph_string **,
- struct glyph_string **,
- struct glyph_string *));
-static int x_left_overwritten P_ ((struct glyph_string *));
-static int x_left_overwriting P_ ((struct glyph_string *));
-static int x_right_overwritten P_ ((struct glyph_string *));
-static int x_right_overwriting P_ ((struct glyph_string *));
-static int x_fill_glyph_string P_ ((struct glyph_string *, int, int, int,
- int));
-static void w32_init_glyph_string P_ ((struct glyph_string *, HDC hdc,
- wchar_t *, struct window *,
- struct glyph_row *,
- enum glyph_row_area, int,
- enum draw_glyphs_face));
-static int x_draw_glyphs P_ ((struct window *, int , struct glyph_row *,
- enum glyph_row_area, int, int,
- enum draw_glyphs_face, int));
-static void x_set_glyph_string_clipping P_ ((struct glyph_string *));
-static void x_set_glyph_string_gc P_ ((struct glyph_string *));
-static void x_draw_glyph_string_background P_ ((struct glyph_string *,
- int));
-static void x_draw_glyph_string_foreground P_ ((struct glyph_string *));
-static void x_draw_composite_glyph_string_foreground P_ ((struct glyph_string *));
-static void x_draw_glyph_string_box P_ ((struct glyph_string *));
-static void x_draw_glyph_string P_ ((struct glyph_string *));
-static void x_compute_glyph_string_overhangs P_ ((struct glyph_string *));
-static void x_set_cursor_gc P_ ((struct glyph_string *));
-static void x_set_mode_line_face_gc P_ ((struct glyph_string *));
-static void x_set_mouse_face_gc P_ ((struct glyph_string *));
-static void w32_get_glyph_overhangs P_ ((HDC hdc, struct glyph *,
- struct frame *,
- int *, int *));
-static void x_compute_overhangs_and_x P_ ((struct glyph_string *, int, int));
-static int w32_alloc_lighter_color (struct frame *, COLORREF *, double, int);
-static void w32_setup_relief_color P_ ((struct frame *, struct relief *,
- double, int, COLORREF));
-static void x_setup_relief_colors P_ ((struct glyph_string *));
-static void x_draw_image_glyph_string P_ ((struct glyph_string *));
-static void x_draw_image_relief P_ ((struct glyph_string *));
-static void x_draw_image_foreground P_ ((struct glyph_string *));
-static void w32_draw_image_foreground_1 P_ ((struct glyph_string *, HBITMAP));
-static void x_fill_image_glyph_string P_ ((struct glyph_string *));
-static void x_clear_glyph_string_rect P_ ((struct glyph_string *, int,
- int, int, int));
-static void w32_draw_relief_rect P_ ((struct frame *, int, int, int, int,
- int, int, int, int, RECT *));
-static void w32_draw_box_rect P_ ((struct glyph_string *, int, int, int, int,
- int, int, int, RECT *));
-static void x_fix_overlapping_area P_ ((struct window *, struct glyph_row *,
- enum glyph_row_area));
-static int x_fill_stretch_glyph_string P_ ((struct glyph_string *,
- struct glyph_row *,
- enum glyph_row_area, int, int));
+ w32_set_clip_rectangle (s->hdc, clip_rect);
-#if GLYPH_DEBUG
-static void x_check_font P_ ((struct frame *, XFontStruct *));
-#endif
+ /* Top. */
+ w32_fill_area (s->f, s->hdc, s->face->box_color,
+ left_x, top_y, right_x - left_x + 1, width);
+
+ /* Left. */
+ if (left_p)
+ {
+ w32_fill_area (s->f, s->hdc, s->face->box_color,
+ left_x, top_y, width, bottom_y - top_y + 1);
+ }
-
-/* Append the list of glyph strings with head H and tail T to the list
- with head *HEAD and tail *TAIL. Set *HEAD and *TAIL to the result. */
+ /* Bottom. */
+ w32_fill_area (s->f, s->hdc, s->face->box_color,
+ left_x, bottom_y - width + 1, right_x - left_x + 1, width);
-static INLINE void
-x_append_glyph_string_lists (head, tail, h, t)
- struct glyph_string **head, **tail;
- struct glyph_string *h, *t;
-{
- if (h)
+ /* Right. */
+ if (right_p)
{
- if (*head)
- (*tail)->next = h;
- else
- *head = h;
- h->prev = *tail;
- *tail = t;
+ w32_fill_area (s->f, s->hdc, s->face->box_color,
+ right_x - width + 1, top_y, width, bottom_y - top_y + 1);
}
+
+ w32_set_clip_rectangle (s->hdc, NULL);
}
-/* Prepend the list of glyph strings with head H and tail T to the
- list with head *HEAD and tail *TAIL. Set *HEAD and *TAIL to the
- result. */
+/* Draw a box around glyph string S. */
-static INLINE void
-x_prepend_glyph_string_lists (head, tail, h, t)
- struct glyph_string **head, **tail;
- struct glyph_string *h, *t;
+static void
+x_draw_glyph_string_box (s)
+ struct glyph_string *s;
{
- if (h)
+ int width, left_x, right_x, top_y, bottom_y, last_x, raised_p;
+ int left_p, right_p;
+ struct glyph *last_glyph;
+ RECT clip_rect;
+
+ last_x = window_box_right (s->w, s->area);
+ if (s->row->full_width_p
+ && !s->w->pseudo_window_p)
{
- if (*head)
- (*head)->prev = t;
- else
- *tail = t;
- t->next = *head;
- *head = h;
+ last_x += WINDOW_RIGHT_SCROLL_BAR_AREA_WIDTH (s->w);
+ if (s->area != RIGHT_MARGIN_AREA
+ || WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (s->w))
+ last_x += WINDOW_RIGHT_FRINGE_WIDTH (s->w);
}
-}
+ /* The glyph that may have a right box line. */
+ last_glyph = (s->cmp || s->img
+ ? s->first_glyph
+ : s->first_glyph + s->nchars - 1);
+
+ width = abs (s->face->box_line_width);
+ raised_p = s->face->box == FACE_RAISED_BOX;
+ left_x = s->x;
+ right_x = ((s->row->full_width_p && s->extends_to_end_of_line_p
+ ? last_x - 1
+ : min (last_x, s->x + s->background_width) - 1));
+ top_y = s->y;
+ bottom_y = top_y + s->height - 1;
+
+ left_p = (s->first_glyph->left_box_line_p
+ || (s->hl == DRAW_MOUSE_FACE
+ && (s->prev == NULL
+ || s->prev->hl != s->hl)));
+ right_p = (last_glyph->right_box_line_p
+ || (s->hl == DRAW_MOUSE_FACE
+ && (s->next == NULL
+ || s->next->hl != s->hl)));
-/* Append glyph string S to the list with head *HEAD and tail *TAIL.
- Set *HEAD and *TAIL to the resulting list. */
+ get_glyph_string_clip_rect (s, &clip_rect);
-static INLINE void
-x_append_glyph_string (head, tail, s)
- struct glyph_string **head, **tail;
- struct glyph_string *s;
-{
- s->next = s->prev = NULL;
- x_append_glyph_string_lists (head, tail, s, s);
+ if (s->face->box == FACE_SIMPLE_BOX)
+ w32_draw_box_rect (s, left_x, top_y, right_x, bottom_y, width,
+ left_p, right_p, &clip_rect);
+ else
+ {
+ x_setup_relief_colors (s);
+ w32_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y,
+ width, raised_p, left_p, right_p, &clip_rect);
+ }
}
-/* Set S->gc to a suitable GC for drawing glyph string S in cursor
- face. */
+/* Draw foreground of image glyph string S. */
static void
-x_set_cursor_gc (s)
+x_draw_image_foreground (s)
struct glyph_string *s;
{
- if (s->font == FRAME_FONT (s->f)
- && s->face->background == FRAME_BACKGROUND_PIXEL (s->f)
- && s->face->foreground == FRAME_FOREGROUND_PIXEL (s->f)
- && !s->cmp)
- s->gc = s->f->output_data.w32->cursor_gc;
+ int x;
+ int y = s->ybase - image_ascent (s->img, s->face);
+
+ /* If first glyph of S has a left box line, start drawing it to the
+ right of that line. */
+ if (s->face->box != FACE_NO_BOX
+ && s->first_glyph->left_box_line_p)
+ x = s->x + abs (s->face->box_line_width);
else
- {
- /* Cursor on non-default face: must merge. */
- XGCValues xgcv;
- unsigned long mask;
+ x = s->x;
- xgcv.background = s->f->output_data.w32->cursor_pixel;
- xgcv.foreground = s->face->background;
+ /* If there is a margin around the image, adjust x- and y-position
+ by that margin. */
+ x += s->img->hmargin;
+ y += s->img->vmargin;
- /* If the glyph would be invisible, try a different foreground. */
- if (xgcv.foreground == xgcv.background)
- xgcv.foreground = s->face->foreground;
- if (xgcv.foreground == xgcv.background)
- xgcv.foreground = s->f->output_data.w32->cursor_foreground_pixel;
- if (xgcv.foreground == xgcv.background)
- xgcv.foreground = s->face->foreground;
+ SaveDC (s->hdc);
- /* Make sure the cursor is distinct from text in this face. */
- if (xgcv.background == s->face->background
- && xgcv.foreground == s->face->foreground)
- {
- xgcv.background = s->face->foreground;
- xgcv.foreground = s->face->background;
- }
+ if (s->img->pixmap)
+ {
+ HDC compat_hdc = CreateCompatibleDC (s->hdc);
+ HBRUSH fg_brush = CreateSolidBrush (s->gc->foreground);
+ HBRUSH orig_brush = SelectObject (s->hdc, fg_brush);
+ HGDIOBJ orig_obj = SelectObject (compat_hdc, s->img->pixmap);
+ SetBkColor (compat_hdc, RGB (255, 255, 255));
+ SetTextColor (s->hdc, RGB (0, 0, 0));
+ x_set_glyph_string_clipping (s);
- IF_DEBUG (x_check_font (s->f, s->font));
- xgcv.font = s->font;
- mask = GCForeground | GCBackground | GCFont;
+ if (s->img->mask)
+ {
+ HDC mask_dc = CreateCompatibleDC (s->hdc);
+ HGDIOBJ mask_orig_obj = SelectObject (mask_dc, s->img->mask);
- if (FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc)
- XChangeGC (NULL, FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc,
- mask, &xgcv);
- else
- FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc
- = XCreateGC (NULL, s->window, mask, &xgcv);
+ SetTextColor (s->hdc, RGB (255, 255, 255));
+ SetBkColor (s->hdc, RGB (0, 0, 0));
- s->gc = FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc;
- }
-}
+ BitBlt (s->hdc, x, y, s->img->width, s->img->height,
+ compat_hdc, 0, 0, SRCINVERT);
+ BitBlt (s->hdc, x, y, s->img->width, s->img->height,
+ mask_dc, 0, 0, SRCAND);
+ BitBlt (s->hdc, x, y, s->img->width, s->img->height,
+ compat_hdc, 0, 0, SRCINVERT);
+ SelectObject (mask_dc, mask_orig_obj);
+ DeleteDC (mask_dc);
+ }
+ else
+ {
+ SetTextColor (s->hdc, s->gc->foreground);
+ SetBkColor (s->hdc, s->gc->background);
-/* Set up S->gc of glyph string S for drawing text in mouse face. */
-
-static void
-x_set_mouse_face_gc (s)
- struct glyph_string *s;
-{
- int face_id;
- struct face *face;
+ BitBlt (s->hdc, x, y, s->img->width, s->img->height,
+ compat_hdc, 0, 0, SRCCOPY);
- /* What face has to be used last for the mouse face? */
- face_id = FRAME_W32_DISPLAY_INFO (s->f)->mouse_face_face_id;
- face = FACE_FROM_ID (s->f, face_id);
- if (face == NULL)
- 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);
- else
- face_id = FACE_FOR_CHAR (s->f, face, 0);
- s->face = FACE_FROM_ID (s->f, face_id);
- PREPARE_FACE_FOR_DISPLAY (s->f, s->face);
+ /* When the image has a mask, we can expect that at
+ least part of a mouse highlight or a block cursor will
+ be visible. If the image doesn't have a mask, make
+ a block cursor visible by drawing a rectangle around
+ the image. I believe it's looking better if we do
+ nothing here for mouse-face. */
+ if (s->hl == DRAW_CURSOR)
+ {
+ int r = s->img->relief;
+ if (r < 0) r = -r;
+ w32_draw_rectangle (s->hdc, s->gc, x - r, y - r ,
+ s->img->width + r*2 - 1, s->img->height + r*2 - 1);
+ }
+ }
- /* If font in this face is same as S->font, use it. */
- if (s->font == s->face->font)
- s->gc = s->face->gc;
- else
- {
- /* Otherwise construct scratch_cursor_gc with values from FACE
- but font FONT. */
- XGCValues xgcv;
- unsigned long mask;
-
- xgcv.background = s->face->background;
- xgcv.foreground = s->face->foreground;
- IF_DEBUG (x_check_font (s->f, s->font));
- xgcv.font = s->font;
- mask = GCForeground | GCBackground | GCFont;
-
- if (FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc)
- XChangeGC (NULL, FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc,
- mask, &xgcv);
- else
- FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc
- = XCreateGC (NULL, s->window, mask, &xgcv);
-
- s->gc = FRAME_W32_DISPLAY_INFO (s->f)->scratch_cursor_gc;
+ w32_set_clip_rectangle (s->hdc, NULL);
+ SelectObject (s->hdc, orig_brush);
+ DeleteObject (fg_brush);
+ SelectObject (compat_hdc, orig_obj);
+ DeleteDC (compat_hdc);
}
+ else
+ w32_draw_rectangle (s->hdc, s->gc, x, y, s->img->width -1,
+ s->img->height - 1);
- xassert (s->gc != 0);
+ RestoreDC (s->hdc ,-1);
}
-/* Set S->gc of glyph string S to a GC suitable for drawing a mode line.
- Faces to use in the mode line have already been computed when the
- matrix was built, so there isn't much to do, here. */
-static INLINE void
-x_set_mode_line_face_gc (s)
+/* Draw a relief around the image glyph string S. */
+
+static void
+x_draw_image_relief (s)
struct glyph_string *s;
-{
- s->gc = s->face->gc;
-}
+{
+ int x0, y0, x1, y1, thick, raised_p;
+ RECT r;
+ int x;
+ int y = s->ybase - image_ascent (s->img, s->face);
+ /* If first glyph of S has a left box line, start drawing it to the
+ right of that line. */
+ if (s->face->box != FACE_NO_BOX
+ && s->first_glyph->left_box_line_p)
+ x = s->x + abs (s->face->box_line_width);
+ else
+ x = s->x;
-/* Set S->gc of glyph string S for drawing that glyph string. Set
- S->stippled_p to a non-zero value if the face of S has a stipple
- pattern. */
+ /* If there is a margin around the image, adjust x- and y-position
+ by that margin. */
+ x += s->img->hmargin;
+ y += s->img->vmargin;
-static INLINE void
-x_set_glyph_string_gc (s)
- struct glyph_string *s;
-{
- PREPARE_FACE_FOR_DISPLAY (s->f, s->face);
-
- if (s->hl == DRAW_NORMAL_TEXT)
- {
- s->gc = s->face->gc;
- s->stippled_p = s->face->stipple != 0;
- }
- else if (s->hl == DRAW_INVERSE_VIDEO)
- {
- x_set_mode_line_face_gc (s);
- s->stippled_p = s->face->stipple != 0;
- }
- else if (s->hl == DRAW_CURSOR)
- {
- x_set_cursor_gc (s);
- s->stippled_p = 0;
- }
- else if (s->hl == DRAW_MOUSE_FACE)
- {
- x_set_mouse_face_gc (s);
- s->stippled_p = s->face->stipple != 0;
- }
- else if (s->hl == DRAW_IMAGE_RAISED
- || s->hl == DRAW_IMAGE_SUNKEN)
+ if (s->hl == DRAW_IMAGE_SUNKEN
+ || s->hl == DRAW_IMAGE_RAISED)
{
- s->gc = s->face->gc;
- s->stippled_p = s->face->stipple != 0;
+ thick = tool_bar_button_relief >= 0 ? tool_bar_button_relief : DEFAULT_TOOL_BAR_BUTTON_RELIEF;
+ raised_p = s->hl == DRAW_IMAGE_RAISED;
}
else
{
- s->gc = s->face->gc;
- s->stippled_p = s->face->stipple != 0;
+ thick = abs (s->img->relief);
+ raised_p = s->img->relief > 0;
}
- /* GC must have been set. */
- xassert (s->gc != 0);
+ x0 = x - thick;
+ y0 = y - thick;
+ x1 = x + s->img->width + thick - 1;
+ y1 = y + s->img->height + thick - 1;
+
+ x_setup_relief_colors (s);
+ get_glyph_string_clip_rect (s, &r);
+ w32_draw_relief_rect (s->f, x0, y0, x1, y1, thick, raised_p, 1, 1, &r);
}
-/* Return in *R the clipping rectangle for glyph string S. */
+/* Draw the foreground of image glyph string S to PIXMAP. */
static void
-w32_get_glyph_string_clip_rect (s, r)
+w32_draw_image_foreground_1 (s, pixmap)
struct glyph_string *s;
- RECT *r;
+ HBITMAP pixmap;
{
- int r_height, r_width;
+ HDC hdc = CreateCompatibleDC (s->hdc);
+ HGDIOBJ orig_hdc_obj = SelectObject (hdc, pixmap);
+ int x;
+ int y = s->ybase - s->y - image_ascent (s->img, s->face);
+
+ /* If first glyph of S has a left box line, start drawing it to the
+ right of that line. */
+ if (s->face->box != FACE_NO_BOX
+ && s->first_glyph->left_box_line_p)
+ x = abs (s->face->box_line_width);
+ else
+ x = 0;
+
+ /* If there is a margin around the image, adjust x- and y-position
+ by that margin. */
+ x += s->img->hmargin;
+ y += s->img->vmargin;
- if (s->row->full_width_p)
+ if (s->img->pixmap)
{
- /* Draw full-width. X coordinates are relative to S->w->left. */
- int canon_x = CANON_X_UNIT (s->f);
-
- r->left = WINDOW_LEFT_MARGIN (s->w) * canon_x;
- r_width = XFASTINT (s->w->width) * canon_x;
+ HDC compat_hdc = CreateCompatibleDC (hdc);
+ HBRUSH fg_brush = CreateSolidBrush (s->gc->foreground);
+ HBRUSH orig_brush = SelectObject (hdc, fg_brush);
+ HGDIOBJ orig_obj = SelectObject (compat_hdc, s->img->pixmap);
- if (FRAME_HAS_VERTICAL_SCROLL_BARS (s->f))
+ if (s->img->mask)
{
- int width = FRAME_SCROLL_BAR_WIDTH (s->f) * canon_x;
- if (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (s->f))
- r->left -= width;
+ HDC mask_dc = CreateCompatibleDC (hdc);
+ HGDIOBJ mask_orig_obj = SelectObject (mask_dc, s->img->mask);
+
+ SetTextColor (hdc, RGB (0, 0, 0));
+ SetBkColor (hdc, RGB (255, 255, 255));
+ BitBlt (hdc, x, y, s->img->width, s->img->height,
+ compat_hdc, 0, 0, SRCINVERT);
+ BitBlt (hdc, x, y, s->img->width, s->img->height,
+ mask_dc, 0, 0, SRCAND);
+ BitBlt (hdc, x, y, s->img->width, s->img->height,
+ compat_hdc, 0, 0, SRCINVERT);
+
+ SelectObject (mask_dc, mask_orig_obj);
+ DeleteDC (mask_dc);
}
-
- r->left += FRAME_INTERNAL_BORDER_WIDTH (s->f);
-
- /* Unless displaying a mode or menu bar line, which are always
- fully visible, clip to the visible part of the row. */
- if (s->w->pseudo_window_p)
- r_height = s->row->visible_height;
else
- r_height = s->height;
- }
- else
- {
- /* This is a text line that may be partially visible. */
- r->left = WINDOW_AREA_TO_FRAME_PIXEL_X (s->w, s->area, 0);
- r_width = window_box_width (s->w, s->area);
- r_height = s->row->visible_height;
- }
+ {
+ SetTextColor (hdc, s->gc->foreground);
+ SetBkColor (hdc, s->gc->background);
- /* If S draws overlapping rows, it's sufficient to use the top and
- bottom of the window for clipping because this glyph string
- intentionally draws over other lines. */
- if (s->for_overlaps_p)
- {
- r->top = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (s->w);
- r_height = window_text_bottom_y (s->w) - r->top;
- }
- else
- {
- /* Don't use S->y for clipping because it doesn't take partially
- visible lines into account. For example, it can be negative for
- partially visible lines at the top of a window. */
- if (!s->row->full_width_p
- && MATRIX_ROW_PARTIALLY_VISIBLE_AT_TOP_P (s->w, s->row))
- r->top = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (s->w);
- else
- r->top = max (0, s->row->y);
+ BitBlt (hdc, x, y, s->img->width, s->img->height,
+ compat_hdc, 0, 0, SRCCOPY);
- /* If drawing a tool-bar window, draw it over the internal border
- at the top of the window. */
- if (s->w == XWINDOW (s->f->tool_bar_window))
- r->top -= s->f->output_data.w32->internal_border_width;
- }
+ /* When the image has a mask, we can expect that at
+ least part of a mouse highlight or a block cursor will
+ be visible. If the image doesn't have a mask, make
+ a block cursor visible by drawing a rectangle around
+ the image. I believe it's looking better if we do
+ nothing here for mouse-face. */
+ if (s->hl == DRAW_CURSOR)
+ {
+ int r = s->img->relief;
+ if (r < 0) r = -r;
+ w32_draw_rectangle (hdc, s->gc, x - r, y - r ,
+ s->img->width + r*2 - 1, s->img->height + r*2 - 1);
+ }
+ }
- r->top = WINDOW_TO_FRAME_PIXEL_Y (s->w, r->top);
+ SelectObject (hdc, orig_brush);
+ DeleteObject (fg_brush);
+ SelectObject (compat_hdc, orig_obj);
+ DeleteDC (compat_hdc);
+ }
+ else
+ w32_draw_rectangle (hdc, s->gc, x, y, s->img->width - 1,
+ s->img->height - 1);
- r->bottom = r->top + r_height;
- r->right = r->left + r_width;
+ SelectObject (hdc, orig_hdc_obj);
+ DeleteDC (hdc);
}
-/* Set clipping for output of glyph string S. S may be part of a mode
- line or menu if we don't have X toolkit support. */
+/* Draw part of the background of glyph string S. X, Y, W, and H
+ give the rectangle to draw. */
-static INLINE void
-x_set_glyph_string_clipping (s)
+static void
+x_draw_glyph_string_bg_rect (s, x, y, w, h)
struct glyph_string *s;
+ int x, y, w, h;
{
- RECT r;
- w32_get_glyph_string_clip_rect (s, &r);
- w32_set_clip_rectangle (s->hdc, &r);
+#if 0 /* TODO: stipple */
+ if (s->stippled_p)
+ {
+ /* Fill background with a stipple pattern. */
+ XSetFillStyle (s->display, s->gc, FillOpaqueStippled);
+ XFillRectangle (s->display, s->window, s->gc, x, y, w, h);
+ XSetFillStyle (s->display, s->gc, FillSolid);
+ }
+ else
+#endif
+ x_clear_glyph_string_rect (s, x, y, w, h);
}
-/* Compute left and right overhang of glyph string S. If S is a glyph
- string for a composition, assume overhangs don't exist. */
+/* Draw image glyph string S.
-static INLINE void
-x_compute_glyph_string_overhangs (s)
- struct glyph_string *s;
-{
- /* TODO: Windows does not appear to have a method for
- getting this info without getting the ABC widths for each
- individual character and working it out manually. */
-}
+ s->y
+ s->x +-------------------------
+ | s->face->box
+ |
+ | +-------------------------
+ | | s->img->vmargin
+ | |
+ | | +-------------------
+ | | | the image
+ */
-/* Compute overhangs and x-positions for glyph string S and its
- predecessors, or successors. X is the starting x-position for S.
- BACKWARD_P non-zero means process predecessors. */
-
static void
-x_compute_overhangs_and_x (s, x, backward_p)
+x_draw_image_glyph_string (s)
struct glyph_string *s;
- int x;
- int backward_p;
{
- if (backward_p)
- {
- while (s)
- {
- x_compute_glyph_string_overhangs (s);
- x -= s->width;
- s->x = x;
- s = s->prev;
- }
- }
- else
- {
- while (s)
- {
- x_compute_glyph_string_overhangs (s);
- s->x = x;
- x += s->width;
- s = s->next;
- }
- }
-}
-
+ int x, y;
+ int box_line_hwidth = abs (s->face->box_line_width);
+ int box_line_vwidth = max (s->face->box_line_width, 0);
+ int height;
+ HBITMAP pixmap = 0;
-/* Set *LEFT and *RIGHT to the left and right overhang of GLYPH on
- frame F. Overhangs of glyphs other than type CHAR_GLYPH are
- assumed to be zero. */
+ height = s->height - 2 * box_line_vwidth;
-static void
-w32_get_glyph_overhangs (hdc, glyph, f, left, right)
- HDC hdc;
- struct glyph *glyph;
- struct frame *f;
- int *left, *right;
-{
- *left = *right = 0;
-
- if (glyph->type == CHAR_GLYPH)
+ /* Fill background with face under the image. Do it only if row is
+ taller than image or if image has a clip mask to reduce
+ flickering. */
+ s->stippled_p = s->face->stipple != 0;
+ if (height > s->img->height
+ || s->img->hmargin
+ || s->img->vmargin
+ || s->img->mask
+ || s->img->pixmap == 0
+ || s->width != s->background_width)
{
- XFontStruct *font;
- struct face *face;
- wchar_t char2b;
- XCharStruct *pcm;
-
- face = x_get_glyph_face_and_encoding (f, glyph, &char2b, NULL);
- font = face->font;
+ if (box_line_hwidth && s->first_glyph->left_box_line_p)
+ x = s->x + box_line_hwidth;
+ else
+ x = s->x;
- if (font
- && (pcm = w32_per_char_metric (font, &char2b,
- glyph->w32_font_type)))
+ y = s->y + box_line_vwidth;
+#if 0 /* TODO: figure out if we need to do this on Windows. */
+ if (s->img->mask)
{
- if (pcm->rbearing > pcm->width)
- *right = pcm->rbearing - pcm->width;
- if (pcm->lbearing < 0)
- *left = -pcm->lbearing;
- }
- }
-}
+ /* Create a pixmap as large as the glyph string. Fill it
+ with the background color. Copy the image to it, using
+ its mask. Copy the temporary pixmap to the display. */
+ Screen *screen = FRAME_X_SCREEN (s->f);
+ int depth = DefaultDepthOfScreen (screen);
+ /* Create a pixmap as large as the glyph string. */
+ pixmap = XCreatePixmap (s->display, s->window,
+ s->background_width,
+ s->height, depth);
-static void
-x_get_glyph_overhangs (glyph, f, left, right)
- struct glyph *glyph;
- struct frame *f;
- int *left, *right;
-{
- HDC hdc = get_frame_dc (f);
- /* Convert to unicode! */
- w32_get_glyph_overhangs (hdc, glyph, f, left, right);
- release_frame_dc (f, hdc);
-}
+ /* Don't clip in the following because we're working on the
+ pixmap. */
+ XSetClipMask (s->display, s->gc, None);
+ /* Fill the pixmap with the background color/stipple. */
+ if (s->stippled_p)
+ {
+ /* Fill background with a stipple pattern. */
+ XSetFillStyle (s->display, s->gc, FillOpaqueStippled);
+ XFillRectangle (s->display, pixmap, s->gc,
+ 0, 0, s->background_width, s->height);
+ XSetFillStyle (s->display, s->gc, FillSolid);
+ }
+ else
+ {
+ XGCValues xgcv;
+ XGetGCValues (s->display, s->gc, GCForeground | GCBackground,
+ &xgcv);
+ XSetForeground (s->display, s->gc, xgcv.background);
+ XFillRectangle (s->display, pixmap, s->gc,
+ 0, 0, s->background_width, s->height);
+ XSetForeground (s->display, s->gc, xgcv.foreground);
+ }
+ }
+ else
+#endif
+ x_draw_glyph_string_bg_rect (s, x, y, s->background_width, height);
-/* Return the index of the first glyph preceding glyph string S that
- is overwritten by S because of S's left overhang. Value is -1
- if no glyphs are overwritten. */
+ s->background_filled_p = 1;
+ }
-static int
-x_left_overwritten (s)
- struct glyph_string *s;
-{
- int k;
-
- if (s->left_overhang)
+ /* Draw the foreground. */
+ if (pixmap != 0)
{
- int x = 0, i;
- struct glyph *glyphs = s->row->glyphs[s->area];
- int first = s->first_glyph - glyphs;
+ w32_draw_image_foreground_1 (s, pixmap);
+ x_set_glyph_string_clipping (s);
+ {
+ HDC compat_hdc = CreateCompatibleDC (s->hdc);
+ HBRUSH fg_brush = CreateSolidBrush (s->gc->foreground);
+ HBRUSH orig_brush = SelectObject (s->hdc, fg_brush);
+ HGDIOBJ orig_obj = SelectObject (compat_hdc, pixmap);
- for (i = first - 1; i >= 0 && x > -s->left_overhang; --i)
- x -= glyphs[i].pixel_width;
+ SetTextColor (s->hdc, s->gc->foreground);
+ SetBkColor (s->hdc, s->gc->background);
+ BitBlt (s->hdc, s->x, s->y, s->background_width, s->height,
+ compat_hdc, 0, 0, SRCCOPY);
- k = i + 1;
+ SelectObject (s->hdc, orig_brush);
+ DeleteObject (fg_brush);
+ SelectObject (compat_hdc, orig_obj);
+ DeleteDC (compat_hdc);
+ }
+ DeleteObject (pixmap);
+ pixmap = 0;
}
else
- k = -1;
+ x_draw_image_foreground (s);
- return k;
+ /* If we must draw a relief around the image, do it. */
+ if (s->img->relief
+ || s->hl == DRAW_IMAGE_RAISED
+ || s->hl == DRAW_IMAGE_SUNKEN)
+ x_draw_image_relief (s);
}
-/* Return the index of the first glyph preceding glyph string S that
- is overwriting S because of its right overhang. Value is -1 if no
- glyph in front of S overwrites S. */
+/* Draw stretch glyph string S. */
-static int
-x_left_overwriting (s)
+static void
+x_draw_stretch_glyph_string (s)
struct glyph_string *s;
{
- int i, k, x;
- struct glyph *glyphs = s->row->glyphs[s->area];
- int first = s->first_glyph - glyphs;
+ xassert (s->first_glyph->type == STRETCH_GLYPH);
+ s->stippled_p = s->face->stipple != 0;
- k = -1;
- x = 0;
- for (i = first - 1; i >= 0; --i)
+ if (s->hl == DRAW_CURSOR
+ && !x_stretch_cursor_p)
{
- int left, right;
- w32_get_glyph_overhangs (s->hdc, glyphs + i, s->f, &left, &right);
- if (x + right > 0)
- k = i;
- x -= glyphs[i].pixel_width;
- }
+ /* If `x-stretch-block-cursor' is nil, don't draw a block cursor
+ as wide as the stretch glyph. */
+ int width = min (FRAME_COLUMN_WIDTH (s->f), s->background_width);
- return k;
-}
+ /* Draw cursor. */
+ x_draw_glyph_string_bg_rect (s, s->x, s->y, width, s->height);
+ /* Clear rest using the GC of the original non-cursor face. */
+ if (width < s->background_width)
+ {
+ XGCValues *gc = s->face->gc;
+ int x = s->x + width, y = s->y;
+ int w = s->background_width - width, h = s->height;
+ RECT r;
+ HDC hdc = s->hdc;
-/* Return the index of the last glyph following glyph string S that is
- not overwritten by S because of S's right overhang. Value is -1 if
- no such glyph is found. */
+ if (s->row->mouse_face_p
+ && cursor_in_mouse_face_p (s->w))
+ {
+ x_set_mouse_face_gc (s);
+ gc = s->gc;
+ }
+ else
+ gc = s->face->gc;
-static int
-x_right_overwritten (s)
- struct glyph_string *s;
-{
- int k = -1;
+ get_glyph_string_clip_rect (s, &r);
+ w32_set_clip_rectangle (hdc, &r);
- if (s->right_overhang)
- {
- int x = 0, i;
- struct glyph *glyphs = s->row->glyphs[s->area];
- int first = (s->first_glyph - glyphs) + (s->cmp ? 1 : s->nchars);
- int end = s->row->used[s->area];
-
- for (i = first; i < end && s->right_overhang > x; ++i)
- x += glyphs[i].pixel_width;
-
- k = i;
+#if 0 /* TODO: stipple */
+ if (s->face->stipple)
+ {
+ /* Fill background with a stipple pattern. */
+ XSetFillStyle (s->display, gc, FillOpaqueStippled);
+ XFillRectangle (s->display, s->window, gc, x, y, w, h);
+ XSetFillStyle (s->display, gc, FillSolid);
+ }
+ else
+#endif
+ {
+ w32_fill_area (s->f, s->hdc, gc->background, x, y, w, h);
+ }
+ }
}
+ else if (!s->background_filled_p)
+ x_draw_glyph_string_bg_rect (s, s->x, s->y, s->background_width,
+ s->height);
- return k;
+ s->background_filled_p = 1;
}
-/* Return the index of the last glyph following glyph string S that
- overwrites S because of its left overhang. Value is negative
- if no such glyph is found. */
+/* Draw glyph string S. */
-static int
-x_right_overwriting (s)
+static void
+x_draw_glyph_string (s)
struct glyph_string *s;
{
- int i, k, x;
- int end = s->row->used[s->area];
- struct glyph *glyphs = s->row->glyphs[s->area];
- int first = (s->first_glyph - glyphs) + (s->cmp ? 1 : s->nchars);
+ int relief_drawn_p = 0;
- k = -1;
- x = 0;
- for (i = first; i < end; ++i)
+ /* If S draws into the background of its successor, draw the
+ background of the successor 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_p)
{
- int left, right;
- w32_get_glyph_overhangs (s->hdc, glyphs + i, s->f, &left, &right);
- if (x - left < 0)
- k = i;
- x += glyphs[i].pixel_width;
+ 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);
}
- return k;
-}
-
+ /* Set up S->gc, set clipping and draw S. */
+ x_set_glyph_string_gc (s);
-/* Fill rectangle X, Y, W, H with background color of glyph string S. */
+ /* Draw relief (if any) in advance for char/composition so that the
+ glyph string can be drawn over it. */
+ if (!s->for_overlaps_p
+ && s->face->box != FACE_NO_BOX
+ && (s->first_glyph->type == CHAR_GLYPH
+ || s->first_glyph->type == COMPOSITE_GLYPH))
-static INLINE void
-x_clear_glyph_string_rect (s, x, y, w, h)
- struct glyph_string *s;
- int x, y, w, h;
-{
- int real_x = x;
- int real_y = y;
- int real_w = w;
- int real_h = h;
-#if 0
- /* Take clipping into account. */
- if (s->gc->clip_mask == Rect)
{
- real_x = max (real_x, s->gc->clip_rectangle.left);
- real_y = max (real_y, s->gc->clip_rectangle.top);
- real_w = min (real_w, s->gc->clip_rectangle.right
- - s->gc->clip_rectangle.left);
- real_h = min (real_h, s->gc->clip_rectangle.bottom
- - s->gc->clip_rectangle.top);
+ x_set_glyph_string_clipping (s);
+ x_draw_glyph_string_background (s, 1);
+ x_draw_glyph_string_box (s);
+ x_set_glyph_string_clipping (s);
+ relief_drawn_p = 1;
}
-#endif
- w32_fill_area (s->f, s->hdc, s->gc->background, real_x, real_y,
- real_w, real_h);
-}
+ else
+ x_set_glyph_string_clipping (s);
+ switch (s->first_glyph->type)
+ {
+ case IMAGE_GLYPH:
+ x_draw_image_glyph_string (s);
+ break;
-/* Draw the background of glyph_string S. If S->background_filled_p
- is non-zero don't draw it. FORCE_P non-zero means draw the
- background even if it wouldn't be drawn normally. This is used
- when a string preceding S draws into the background of S, or S
- contains the first component of a composition. */
+ case STRETCH_GLYPH:
+ x_draw_stretch_glyph_string (s);
+ break;
-static void
-x_draw_glyph_string_background (s, force_p)
- struct glyph_string *s;
- int force_p;
-{
- /* Nothing to do if background has already been drawn or if it
- shouldn't be drawn in the first place. */
- if (!s->background_filled_p)
- {
- int box_line_width = max (s->face->box_line_width, 0);
+ case CHAR_GLYPH:
+ if (s->for_overlaps_p)
+ s->background_filled_p = 1;
+ else
+ x_draw_glyph_string_background (s, 0);
+ x_draw_glyph_string_foreground (s);
+ break;
-#if 0 /* TODO: stipple */
- if (s->stippled_p)
- {
- /* Fill background with a stipple pattern. */
- XSetFillStyle (s->display, s->gc, FillOpaqueStippled);
- XFillRectangle (s->display, s->window, s->gc, s->x,
- s->y + box_line_width,
- s->background_width,
- s->height - 2 * box_line_width);
- XSetFillStyle (s->display, s->gc, FillSolid);
- s->background_filled_p = 1;
- }
- else
-#endif
- if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width
- || s->font_not_found_p
- || s->extends_to_end_of_line_p
- || s->font->bdf
- || force_p)
- {
- x_clear_glyph_string_rect (s, s->x, s->y + box_line_width,
- s->background_width,
- s->height - 2 * box_line_width);
- s->background_filled_p = 1;
- }
- }
-}
-
-
-/* Draw the foreground of glyph string S. */
-
-static void
-x_draw_glyph_string_foreground (s)
- struct glyph_string *s;
-{
- int i, 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
- && s->first_glyph->left_box_line_p)
- x = s->x + abs (s->face->box_line_width);
- else
- x = s->x;
-
- if (s->for_overlaps_p || (s->background_filled_p && s->hl != DRAW_CURSOR))
- SetBkMode (s->hdc, TRANSPARENT);
- else
- SetBkMode (s->hdc, OPAQUE);
-
- SetTextColor (s->hdc, s->gc->foreground);
- SetBkColor (s->hdc, s->gc->background);
- SetTextAlign (s->hdc, TA_BASELINE | TA_LEFT);
-
- if (s->font && s->font->hfont)
- old_font = SelectObject (s->hdc, s->font->hfont);
-
- /* Draw characters of S as rectangles if S's font could not be
- loaded. */
- if (s->font_not_found_p)
- {
- for (i = 0; i < s->nchars; ++i)
- {
- struct glyph *g = s->first_glyph + i;
-
- w32_draw_rectangle (s->hdc, s->gc, x, s->y, g->pixel_width - 1,
- s->height - 1);
- x += g->pixel_width;
- }
- }
- else
- {
- char *char1b = (char *) s->char2b;
- int boff = s->font_info->baseline_offset;
-
- if (s->font_info->vertical_centering)
- boff = VCENTER_BASELINE_OFFSET (s->font, s->f) - boff;
-
- /* If we can use 8-bit functions, condense S->char2b. */
- if (!s->two_byte_p)
- for (i = 0; i < s->nchars; ++i)
- char1b[i] = BYTE2 (s->char2b[i]);
-
- /* Draw text with TextOut and friends. */
- w32_text_out (s, x, s->ybase - boff, s->char2b, s->nchars);
- }
- if (s->font && s->font->hfont)
- SelectObject (s->hdc, old_font);
-}
-
-/* Draw the foreground of composite glyph string S. */
-
-static void
-x_draw_composite_glyph_string_foreground (s)
- struct glyph_string *s;
-{
- int i, 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
- && s->first_glyph->left_box_line_p)
- x = s->x + abs (s->face->box_line_width);
- else
- x = s->x;
-
- /* S is a glyph string for a composition. S->gidx is the index of
- the first character drawn for glyphs of this composition.
- S->gidx == 0 means we are drawing the very first character of
- this composition. */
-
- SetTextColor (s->hdc, s->gc->foreground);
- SetBkColor (s->hdc, s->gc->background);
- SetBkMode (s->hdc, TRANSPARENT);
- SetTextAlign (s->hdc, TA_BASELINE | TA_LEFT);
-
- if (s->font && s->font->hfont)
- old_font = SelectObject (s->hdc, s->font->hfont);
-
- /* Draw a rectangle for the composition if the font for the very
- first character of the composition could not be loaded. */
- if (s->font_not_found_p)
- {
- if (s->gidx == 0)
- w32_draw_rectangle (s->hdc, s->gc, x, s->y, s->width - 1,
- s->height - 1);
- }
- else
- {
- for (i = 0; i < s->nchars; i++, ++s->gidx)
- 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->font && s->font->hfont)
- SelectObject (s->hdc, old_font);
-}
-
-
-/* Brightness beyond which a color won't have its highlight brightness
- boosted.
-
- Nominally, highlight colors for `3d' faces are calculated by
- brightening an object's color by a constant scale factor, but this
- doesn't yield good results for dark colors, so for colors who's
- brightness is less than this value (on a scale of 0-255) have to
- use an additional additive factor.
-
- The value here is set so that the default menu-bar/mode-line color
- (grey75) will not have its highlights changed at all. */
-#define HIGHLIGHT_COLOR_DARK_BOOST_LIMIT 187
-
-
-/* Allocate a color which is lighter or darker than *COLOR by FACTOR
- or DELTA. Try a color with RGB values multiplied by FACTOR first.
- If this produces the same color as COLOR, try a color where all RGB
- values have DELTA added. Return the allocated color in *COLOR.
- DISPLAY is the X display, CMAP is the colormap to operate on.
- Value is non-zero if successful. */
-
-static int
-w32_alloc_lighter_color (f, color, factor, delta)
- struct frame *f;
- COLORREF *color;
- double factor;
- int delta;
-{
- COLORREF new;
- long bright;
-
- /* On Windows, RGB values are 0-255, not 0-65535, so scale delta. */
- delta /= 256;
-
- /* Change RGB values by specified FACTOR. Avoid overflow! */
- xassert (factor >= 0);
- new = PALETTERGB (min (0xff, factor * GetRValue (*color)),
- min (0xff, factor * GetGValue (*color)),
- min (0xff, factor * GetBValue (*color)));
-
- /* Calculate brightness of COLOR. */
- bright = (2 * GetRValue (*color) + 3 * GetGValue (*color)
- + GetBValue (*color)) / 6;
-
- /* We only boost colors that are darker than
- HIGHLIGHT_COLOR_DARK_BOOST_LIMIT. */
- if (bright < HIGHLIGHT_COLOR_DARK_BOOST_LIMIT)
- /* Make an additive adjustment to NEW, because it's dark enough so
- that scaling by FACTOR alone isn't enough. */
- {
- /* How far below the limit this color is (0 - 1, 1 being darker). */
- double dimness = 1 - (double)bright / HIGHLIGHT_COLOR_DARK_BOOST_LIMIT;
- /* The additive adjustment. */
- int min_delta = delta * dimness * factor / 2;
-
- if (factor < 1)
- new = PALETTERGB (max (0, min (0xff, min_delta - GetRValue (*color))),
- max (0, min (0xff, min_delta - GetGValue (*color))),
- max (0, min (0xff, min_delta - GetBValue (*color))));
- else
- new = PALETTERGB (max (0, min (0xff, min_delta + GetRValue (*color))),
- max (0, min (0xff, min_delta + GetGValue (*color))),
- max (0, min (0xff, min_delta + GetBValue (*color))));
- }
-
- if (new == *color)
- new = PALETTERGB (max (0, min (0xff, delta + GetRValue (*color))),
- max (0, min (0xff, delta + GetGValue (*color))),
- max (0, min (0xff, delta + GetBValue (*color))));
-
- /* TODO: Map to palette and retry with delta if same? */
- /* TODO: Free colors (if using palette)? */
-
- if (new == *color)
- return 0;
-
- *color = new;
-
- return 1;
-}
-
-
-/* Set up the foreground color for drawing relief lines of glyph
- string S. RELIEF is a pointer to a struct relief containing the GC
- with which lines will be drawn. Use a color that is FACTOR or
- DELTA lighter or darker than the relief's background which is found
- in S->f->output_data.x->relief_background. If such a color cannot
- be allocated, use DEFAULT_PIXEL, instead. */
-
-static void
-w32_setup_relief_color (f, relief, factor, delta, default_pixel)
- struct frame *f;
- struct relief *relief;
- double factor;
- int delta;
- COLORREF default_pixel;
-{
- XGCValues xgcv;
- struct w32_output *di = f->output_data.w32;
- unsigned long mask = GCForeground;
- COLORREF pixel;
- COLORREF background = di->relief_background;
- struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
-
- /* TODO: Free colors (if using palette)? */
-
- /* Allocate new color. */
- xgcv.foreground = default_pixel;
- pixel = background;
- if (w32_alloc_lighter_color (f, &pixel, factor, delta))
- {
- relief->allocated_p = 1;
- xgcv.foreground = relief->pixel = pixel;
- }
-
- if (relief->gc == 0)
- {
-#if 0 /* TODO: stipple */
- xgcv.stipple = dpyinfo->gray;
- mask |= GCStipple;
-#endif
- relief->gc = XCreateGC (NULL, FRAME_W32_WINDOW (f), mask, &xgcv);
- }
- else
- XChangeGC (NULL, relief->gc, mask, &xgcv);
-}
-
-
-/* Set up colors for the relief lines around glyph string S. */
-
-static void
-x_setup_relief_colors (s)
- struct glyph_string *s;
-{
- struct w32_output *di = s->f->output_data.w32;
- COLORREF color;
-
- if (s->face->use_box_color_for_shadows_p)
- color = s->face->box_color;
- else if (s->first_glyph->type == IMAGE_GLYPH
- && s->img->pixmap
- && !IMAGE_BACKGROUND_TRANSPARENT (s->img, s->f, 0))
- color = IMAGE_BACKGROUND (s->img, s->f, 0);
- else
- color = s->gc->background;
-
- if (di->white_relief.gc == 0
- || color != di->relief_background)
- {
- di->relief_background = color;
- w32_setup_relief_color (s->f, &di->white_relief, 1.2, 0x8000,
- WHITE_PIX_DEFAULT (s->f));
- w32_setup_relief_color (s->f, &di->black_relief, 0.6, 0x4000,
- BLACK_PIX_DEFAULT (s->f));
- }
-}
-
-
-/* Draw a relief on frame F inside the rectangle given by LEFT_X,
- TOP_Y, RIGHT_X, and BOTTOM_Y. WIDTH is the thickness of the relief
- to draw, it must be >= 0. RAISED_P non-zero means draw a raised
- relief. LEFT_P non-zero means draw a relief on the left side of
- the rectangle. RIGHT_P non-zero means draw a relief on the right
- side of the rectangle. CLIP_RECT is the clipping rectangle to use
- when drawing. */
-
-static void
-w32_draw_relief_rect (f, left_x, top_y, right_x, bottom_y, width,
- raised_p, left_p, right_p, clip_rect)
- struct frame *f;
- int left_x, top_y, right_x, bottom_y, left_p, right_p, raised_p;
- RECT *clip_rect;
-{
- int i;
- XGCValues gc;
- HDC hdc = get_frame_dc (f);
-
- if (raised_p)
- gc.foreground = f->output_data.w32->white_relief.gc->foreground;
- else
- gc.foreground = f->output_data.w32->black_relief.gc->foreground;
-
- w32_set_clip_rectangle (hdc, clip_rect);
-
- /* Top. */
- for (i = 0; i < width; ++i)
- w32_fill_area (f, hdc, gc.foreground,
- left_x + i * left_p, top_y + i,
- (right_x + 1 - i * right_p) - (left_x + i * left_p) + 1, 1);
-
- /* Left. */
- if (left_p)
- for (i = 0; i < width; ++i)
- w32_fill_area (f, hdc, gc.foreground,
- left_x + i, top_y + i, 1,
- (bottom_y - i) - (top_y + i) + 2);
-
- if (raised_p)
- gc.foreground = f->output_data.w32->black_relief.gc->foreground;
- else
- gc.foreground = f->output_data.w32->white_relief.gc->foreground;
-
- /* Bottom. */
- for (i = 0; i < width; ++i)
- w32_fill_area (f, hdc, gc.foreground,
- left_x + i * left_p, bottom_y - i,
- (right_x - i * right_p) - (left_x + i * left_p) + 2, 1);
-
- /* Right. */
- if (right_p)
- for (i = 0; i < width; ++i)
- w32_fill_area (f, hdc, gc.foreground,
- right_x - i, top_y + i + 1, 1,
- (bottom_y - i) - (top_y + i));
-
- w32_set_clip_rectangle (hdc, NULL);
-
- release_frame_dc (f, hdc);
-}
-
-
-/* Draw a box on frame F inside the rectangle given by LEFT_X, TOP_Y,
- RIGHT_X, and BOTTOM_Y. WIDTH is the thickness of the lines to
- draw, it must be >= 0. LEFT_P non-zero means draw a line on the
- left side of the rectangle. RIGHT_P non-zero means draw a line
- on the right side of the rectangle. CLIP_RECT is the clipping
- rectangle to use when drawing. */
-
-static void
-w32_draw_box_rect (s, left_x, top_y, right_x, bottom_y, width,
- left_p, right_p, clip_rect)
- struct glyph_string *s;
- int left_x, top_y, right_x, bottom_y, width, left_p, right_p;
- RECT *clip_rect;
-{
- w32_set_clip_rectangle (s->hdc, clip_rect);
-
- /* Top. */
- w32_fill_area (s->f, s->hdc, s->face->box_color,
- left_x, top_y, right_x - left_x + 1, width);
-
- /* Left. */
- if (left_p)
- {
- w32_fill_area (s->f, s->hdc, s->face->box_color,
- left_x, top_y, width, bottom_y - top_y + 1);
- }
-
- /* Bottom. */
- w32_fill_area (s->f, s->hdc, s->face->box_color,
- left_x, bottom_y - width + 1, right_x - left_x + 1, width);
-
- /* Right. */
- if (right_p)
- {
- w32_fill_area (s->f, s->hdc, s->face->box_color,
- right_x - width + 1, top_y, width, bottom_y - top_y + 1);
- }
-
- w32_set_clip_rectangle (s->hdc, NULL);
-}
-
-
-/* Draw a box around glyph string S. */
-
-static void
-x_draw_glyph_string_box (s)
- struct glyph_string *s;
-{
- int width, left_x, right_x, top_y, bottom_y, last_x, raised_p;
- int left_p, right_p;
- struct glyph *last_glyph;
- RECT clip_rect;
-
- last_x = window_box_right (s->w, s->area);
- if (s->row->full_width_p
- && !s->w->pseudo_window_p)
- {
- last_x += FRAME_X_RIGHT_FRINGE_WIDTH (s->f);
- if (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (s->f))
- last_x += FRAME_SCROLL_BAR_WIDTH (s->f) * CANON_X_UNIT (s->f);
- }
-
- /* The glyph that may have a right box line. */
- last_glyph = (s->cmp || s->img
- ? s->first_glyph
- : s->first_glyph + s->nchars - 1);
-
- width = abs (s->face->box_line_width);
- raised_p = s->face->box == FACE_RAISED_BOX;
- left_x = s->x;
- right_x = ((s->row->full_width_p && s->extends_to_end_of_line_p
- ? last_x - 1
- : min (last_x, s->x + s->background_width) - 1));
- top_y = s->y;
- bottom_y = top_y + s->height - 1;
-
- left_p = (s->first_glyph->left_box_line_p
- || (s->hl == DRAW_MOUSE_FACE
- && (s->prev == NULL
- || s->prev->hl != s->hl)));
- right_p = (last_glyph->right_box_line_p
- || (s->hl == DRAW_MOUSE_FACE
- && (s->next == NULL
- || s->next->hl != s->hl)));
-
- w32_get_glyph_string_clip_rect (s, &clip_rect);
-
- if (s->face->box == FACE_SIMPLE_BOX)
- w32_draw_box_rect (s, left_x, top_y, right_x, bottom_y, width,
- left_p, right_p, &clip_rect);
- else
- {
- x_setup_relief_colors (s);
- w32_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y,
- width, raised_p, left_p, right_p, &clip_rect);
- }
-}
-
-
-/* Draw foreground of image glyph string S. */
-
-static void
-x_draw_image_foreground (s)
- struct glyph_string *s;
-{
- int x;
- int y = s->ybase - image_ascent (s->img, s->face);
-
- /* If first glyph of S has a left box line, start drawing it to the
- right of that line. */
- if (s->face->box != FACE_NO_BOX
- && s->first_glyph->left_box_line_p)
- x = s->x + abs (s->face->box_line_width);
- else
- x = s->x;
-
- /* If there is a margin around the image, adjust x- and y-position
- by that margin. */
- x += s->img->hmargin;
- y += s->img->vmargin;
-
- SaveDC (s->hdc);
-
- if (s->img->pixmap)
- {
-#if 0 /* TODO: image mask */
- if (s->img->mask)
- {
- /* We can't set both a clip mask and use XSetClipRectangles
- because the latter also sets a clip mask. We also can't
- trust on the shape extension to be available
- (XShapeCombineRegion). So, compute the rectangle to draw
- manually. */
- unsigned long mask = (GCClipMask | GCClipXOrigin | GCClipYOrigin
- | GCFunction);
- XGCValues xgcv;
- XRectangle clip_rect, image_rect, r;
-
- xgcv.clip_mask = s->img->mask;
- xgcv.clip_x_origin = x;
- xgcv.clip_y_origin = y;
- xgcv.function = GXcopy;
- XChangeGC (s->display, s->gc, mask, &xgcv);
-
- w32_get_glyph_string_clip_rect (s, &clip_rect);
- image_rect.x = x;
- image_rect.y = y;
- image_rect.width = s->img->width;
- image_rect.height = s->img->height;
- if (IntersectRect (&r, &clip_rect, &image_rect))
- XCopyArea (s->display, s->img->pixmap, s->window, s->gc,
- r.x - x, r.y - y, r.width, r.height, r.x, r.y);
- }
- else
-#endif
- {
- HDC compat_hdc = CreateCompatibleDC (s->hdc);
- HBRUSH fg_brush = CreateSolidBrush (s->gc->foreground);
- HBRUSH orig_brush = SelectObject (s->hdc, fg_brush);
- HGDIOBJ orig_obj = SelectObject (compat_hdc, s->img->pixmap);
- x_set_glyph_string_clipping (s);
-
- SetTextColor (s->hdc, s->gc->foreground);
- SetBkColor (s->hdc, s->gc->background);
-#if 0 /* From w32bdf.c (which is from Meadow). */
- BitBlt (s->hdc, x, y, s->img->width, s->img->height,
- compat_hdc, 0, 0, SRCCOPY);
- BitBlt (s->hdc, x, y, s->img->width, s->img->height,
- compat_hdc, 0, 0, 0xB8074A);
-#else
- BitBlt (s->hdc, x, y, s->img->width, s->img->height,
- compat_hdc, 0, 0, 0xE20746);
-#endif
- SelectObject (s->hdc, orig_brush);
- DeleteObject (fg_brush);
- SelectObject (compat_hdc, orig_obj);
- DeleteDC (compat_hdc);
-
- /* When the image has a mask, we can expect that at
- least part of a mouse highlight or a block cursor will
- be visible. If the image doesn't have a mask, make
- a block cursor visible by drawing a rectangle around
- the image. I believe it's looking better if we do
- nothing here for mouse-face. */
- if (s->hl == DRAW_CURSOR)
- w32_draw_rectangle (s->hdc, s->gc, x, y, s->img->width - 1,
- s->img->height - 1);
- w32_set_clip_rectangle (s->hdc, NULL);
- }
- }
- else
- w32_draw_rectangle (s->hdc, s->gc, x, y, s->img->width -1,
- s->img->height - 1);
-
- RestoreDC (s->hdc ,-1);
-}
-
-
-
-/* Draw a relief around the image glyph string S. */
-
-static void
-x_draw_image_relief (s)
- struct glyph_string *s;
-{
- int x0, y0, x1, y1, thick, raised_p;
- RECT r;
- int x;
- int y = s->ybase - image_ascent (s->img, s->face);
-
- /* If first glyph of S has a left box line, start drawing it to the
- right of that line. */
- if (s->face->box != FACE_NO_BOX
- && s->first_glyph->left_box_line_p)
- x = s->x + abs (s->face->box_line_width);
- else
- x = s->x;
-
- /* If there is a margin around the image, adjust x- and y-position
- by that margin. */
- x += s->img->hmargin;
- y += s->img->vmargin;
-
- if (s->hl == DRAW_IMAGE_SUNKEN
- || s->hl == DRAW_IMAGE_RAISED)
- {
- thick = tool_bar_button_relief >= 0 ? tool_bar_button_relief : DEFAULT_TOOL_BAR_BUTTON_RELIEF;
- raised_p = s->hl == DRAW_IMAGE_RAISED;
- }
- else
- {
- thick = abs (s->img->relief);
- raised_p = s->img->relief > 0;
- }
-
- x0 = x - thick;
- y0 = y - thick;
- x1 = x + s->img->width + thick - 1;
- y1 = y + s->img->height + thick - 1;
-
- x_setup_relief_colors (s);
- w32_get_glyph_string_clip_rect (s, &r);
- w32_draw_relief_rect (s->f, x0, y0, x1, y1, thick, raised_p, 1, 1, &r);
-}
-
-
-/* Draw the foreground of image glyph string S to PIXMAP. */
-
-static void
-w32_draw_image_foreground_1 (s, pixmap)
- struct glyph_string *s;
- HBITMAP pixmap;
-{
- HDC hdc = CreateCompatibleDC (s->hdc);
- HGDIOBJ orig_hdc_obj = SelectObject (hdc, pixmap);
- int x;
- int y = s->ybase - s->y - image_ascent (s->img, s->face);
-
- /* If first glyph of S has a left box line, start drawing it to the
- right of that line. */
- if (s->face->box != FACE_NO_BOX
- && s->first_glyph->left_box_line_p)
- x = abs (s->face->box_line_width);
- else
- x = 0;
-
- /* If there is a margin around the image, adjust x- and y-position
- by that margin. */
- x += s->img->hmargin;
- y += s->img->vmargin;
-
- if (s->img->pixmap)
- {
-#if 0 /* TODO: image mask */
- if (s->img->mask)
- {
- /* We can't set both a clip mask and use XSetClipRectangles
- because the latter also sets a clip mask. We also can't
- trust on the shape extension to be available
- (XShapeCombineRegion). So, compute the rectangle to draw
- manually. */
- unsigned long mask = (GCClipMask | GCClipXOrigin | GCClipYOrigin
- | GCFunction);
- XGCValues xgcv;
-
- xgcv.clip_mask = s->img->mask;
- xgcv.clip_x_origin = x;
- xgcv.clip_y_origin = y;
- xgcv.function = GXcopy;
- XChangeGC (s->display, s->gc, mask, &xgcv);
-
- XCopyArea (s->display, s->img->pixmap, pixmap, s->gc,
- 0, 0, s->img->width, s->img->height, x, y);
- XSetClipMask (s->display, s->gc, None);
- }
- else
-#endif
- {
- HDC compat_hdc = CreateCompatibleDC (hdc);
- HBRUSH fg_brush = CreateSolidBrush (s->gc->foreground);
- HBRUSH orig_brush = SelectObject (hdc, fg_brush);
- HGDIOBJ orig_obj = SelectObject (compat_hdc, s->img->pixmap);
-
- SetTextColor (hdc, s->gc->foreground);
- SetBkColor (hdc, s->gc->background);
-#if 0 /* From w32bdf.c (which is from Meadow). */
- BitBlt (hdc, x, y, s->img->width, s->img->height,
- compat_hdc, 0, 0, SRCCOPY);
- BitBlt (hdc, x, y, s->img->width, s->img->height,
- compat_hdc, 0, 0, 0xB8074A);
-#else
- BitBlt (hdc, x, y, s->img->width, s->img->height,
- compat_hdc, 0, 0, 0xE20746);
-#endif
- SelectObject (hdc, orig_brush);
- DeleteObject (fg_brush);
- SelectObject (compat_hdc, orig_obj);
- DeleteDC (compat_hdc);
-
- /* When the image has a mask, we can expect that at
- least part of a mouse highlight or a block cursor will
- be visible. If the image doesn't have a mask, make
- a block cursor visible by drawing a rectangle around
- the image. I believe it's looking better if we do
- nothing here for mouse-face. */
- if (s->hl == DRAW_CURSOR)
- w32_draw_rectangle (hdc, s->gc, x, y, s->img->width - 1,
- s->img->height - 1);
- }
- }
- else
- w32_draw_rectangle (hdc, s->gc, x, y, s->img->width - 1,
- s->img->height - 1);
-
- SelectObject (hdc, orig_hdc_obj);
- DeleteDC (hdc);
-}
-
-
-/* Draw part of the background of glyph string S. X, Y, W, and H
- give the rectangle to draw. */
-
-static void
-x_draw_glyph_string_bg_rect (s, x, y, w, h)
- struct glyph_string *s;
- int x, y, w, h;
-{
-#if 0 /* TODO: stipple */
- if (s->stippled_p)
- {
- /* Fill background with a stipple pattern. */
- XSetFillStyle (s->display, s->gc, FillOpaqueStippled);
- XFillRectangle (s->display, s->window, s->gc, x, y, w, h);
- XSetFillStyle (s->display, s->gc, FillSolid);
- }
- else
-#endif
- x_clear_glyph_string_rect (s, x, y, w, h);
-}
-
-
-/* Draw image glyph string S.
-
- s->y
- s->x +-------------------------
- | s->face->box
- |
- | +-------------------------
- | | s->img->vmargin
- | |
- | | +-------------------
- | | | the image
-
- */
-
-static void
-x_draw_image_glyph_string (s)
- struct glyph_string *s;
-{
- int x, y;
- int box_line_hwidth = abs (s->face->box_line_width);
- int box_line_vwidth = max (s->face->box_line_width, 0);
- int height;
- HBITMAP pixmap = 0;
-
- height = s->height - 2 * box_line_vwidth;
-
- /* Fill background with face under the image. Do it only if row is
- taller than image or if image has a clip mask to reduce
- flickering. */
- s->stippled_p = s->face->stipple != 0;
- if (height > s->img->height
- || s->img->hmargin
- || s->img->vmargin
-#if 0 /* TODO: image mask */
- || s->img->mask
-#endif
- || s->img->pixmap == 0
- || s->width != s->background_width)
- {
- if (box_line_hwidth && s->first_glyph->left_box_line_p)
- x = s->x + box_line_hwidth;
- else
- x = s->x;
-
- y = s->y + box_line_vwidth;
-#if 0 /* TODO: image mask */
- if (s->img->mask)
- {
- /* Create a pixmap as large as the glyph string. Fill it
- with the background color. Copy the image to it, using
- its mask. Copy the temporary pixmap to the display. */
- Screen *screen = FRAME_X_SCREEN (s->f);
- int depth = DefaultDepthOfScreen (screen);
-
- /* Create a pixmap as large as the glyph string. */
- pixmap = XCreatePixmap (s->display, s->window,
- s->background_width,
- s->height, depth);
-
- /* Don't clip in the following because we're working on the
- pixmap. */
- XSetClipMask (s->display, s->gc, None);
-
- /* Fill the pixmap with the background color/stipple. */
- if (s->stippled_p)
- {
- /* Fill background with a stipple pattern. */
- XSetFillStyle (s->display, s->gc, FillOpaqueStippled);
- XFillRectangle (s->display, pixmap, s->gc,
- 0, 0, s->background_width, s->height);
- XSetFillStyle (s->display, s->gc, FillSolid);
- }
- else
- {
- XGCValues xgcv;
- XGetGCValues (s->display, s->gc, GCForeground | GCBackground,
- &xgcv);
- XSetForeground (s->display, s->gc, xgcv.background);
- XFillRectangle (s->display, pixmap, s->gc,
- 0, 0, s->background_width, s->height);
- XSetForeground (s->display, s->gc, xgcv.foreground);
- }
- }
- else
-#endif
- x_draw_glyph_string_bg_rect (s, x, y, s->background_width, height);
-
- s->background_filled_p = 1;
- }
-
- /* Draw the foreground. */
- if (pixmap != 0)
- {
- w32_draw_image_foreground_1 (s, pixmap);
- x_set_glyph_string_clipping (s);
- {
- HDC compat_hdc = CreateCompatibleDC (s->hdc);
- HBRUSH fg_brush = CreateSolidBrush (s->gc->foreground);
- HBRUSH orig_brush = SelectObject (s->hdc, fg_brush);
- HGDIOBJ orig_obj = SelectObject (compat_hdc, pixmap);
-
- SetTextColor (s->hdc, s->gc->foreground);
- SetBkColor (s->hdc, s->gc->background);
-#if 0 /* From w32bdf.c (which is from Meadow). */
- BitBlt (s->hdc, s->x, s->y, s->background_width, s->height,
- compat_hdc, 0, 0, SRCCOPY);
- BitBlt (s->hdc, s->x, s->y, s->background_width, s->height,
- compat_hdc, 0, 0, 0xB8074A);
-#else
- BitBlt (s->hdc, s->x, s->y, s->background_width, s->height,
- compat_hdc, 0, 0, 0xE20746);
-#endif
- SelectObject (s->hdc, orig_brush);
- DeleteObject (fg_brush);
- SelectObject (compat_hdc, orig_obj);
- DeleteDC (compat_hdc);
- }
- DeleteObject (pixmap);
- pixmap = 0;
- }
- else
- x_draw_image_foreground (s);
-
- /* If we must draw a relief around the image, do it. */
- if (s->img->relief
- || s->hl == DRAW_IMAGE_RAISED
- || s->hl == DRAW_IMAGE_SUNKEN)
- x_draw_image_relief (s);
-}
-
-
-/* Draw stretch glyph string S. */
-
-static void
-x_draw_stretch_glyph_string (s)
- struct glyph_string *s;
-{
- xassert (s->first_glyph->type == STRETCH_GLYPH);
- s->stippled_p = s->face->stipple != 0;
-
- if (s->hl == DRAW_CURSOR
- && !x_stretch_cursor_p)
- {
- /* If `x-stretch-block-cursor' is nil, don't draw a block cursor
- as wide as the stretch glyph. */
- int width = min (CANON_X_UNIT (s->f), s->background_width);
-
- /* Draw cursor. */
- x_draw_glyph_string_bg_rect (s, s->x, s->y, width, s->height);
-
- /* Clear rest using the GC of the original non-cursor face. */
- if (width < s->background_width)
- {
- XGCValues *gc = s->face->gc;
- int x = s->x + width, y = s->y;
- int w = s->background_width - width, h = s->height;
- RECT r;
- HDC hdc = s->hdc;
-
- if (s->row->mouse_face_p
- && cursor_in_mouse_face_p (s->w))
- {
- x_set_mouse_face_gc (s);
- gc = s->gc;
- }
- else
- gc = s->face->gc;
-
- w32_get_glyph_string_clip_rect (s, &r);
- w32_set_clip_rectangle (hdc, &r);
-
-#if 0 /* TODO: stipple */
- if (s->face->stipple)
- {
- /* Fill background with a stipple pattern. */
- XSetFillStyle (s->display, gc, FillOpaqueStippled);
- XFillRectangle (s->display, s->window, gc, x, y, w, h);
- XSetFillStyle (s->display, gc, FillSolid);
- }
- else
-#endif
- {
- w32_fill_area (s->f, s->hdc, gc->background, x, y, w, h);
- }
- }
- }
- else if (!s->background_filled_p)
- x_draw_glyph_string_bg_rect (s, s->x, s->y, s->background_width,
- s->height);
-
- s->background_filled_p = 1;
-}
-
-
-/* Draw glyph string S. */
-
-static void
-x_draw_glyph_string (s)
- struct glyph_string *s;
-{
- 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.
- This makes S->next use XDrawString instead of XDrawImageString. */
- if (s->next && s->right_overhang && !s->for_overlaps_p)
- {
- 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);
- }
-
- /* Set up S->gc, set clipping and draw S. */
- x_set_glyph_string_gc (s);
-
- /* Draw relief (if any) in advance for char/composition so that the
- glyph string can be drawn over it. */
- if (!s->for_overlaps_p
- && s->face->box != FACE_NO_BOX
- && (s->first_glyph->type == CHAR_GLYPH
- || s->first_glyph->type == COMPOSITE_GLYPH))
-
- {
- x_set_glyph_string_clipping (s);
- x_draw_glyph_string_background (s, 1);
- x_draw_glyph_string_box (s);
- x_set_glyph_string_clipping (s);
- relief_drawn_p = 1;
- }
- else
- x_set_glyph_string_clipping (s);
-
- switch (s->first_glyph->type)
- {
- case IMAGE_GLYPH:
- x_draw_image_glyph_string (s);
- break;
-
- case STRETCH_GLYPH:
- x_draw_stretch_glyph_string (s);
- break;
-
- case CHAR_GLYPH:
- if (s->for_overlaps_p)
- s->background_filled_p = 1;
- else
- x_draw_glyph_string_background (s, 0);
- x_draw_glyph_string_foreground (s);
- break;
-
- case COMPOSITE_GLYPH:
- if (s->for_overlaps_p || s->gidx > 0)
- s->background_filled_p = 1;
- else
- x_draw_glyph_string_background (s, 1);
- x_draw_composite_glyph_string_foreground (s);
- break;
-
- default:
- abort ();
- }
-
- if (!s->for_overlaps_p)
- {
- /* Draw underline. */
- if (s->face->underline_p
- && (s->font->bdf || !s->font->tm.tmUnderlined))
- {
- unsigned long h = 1;
- unsigned long dy = s->height - h;
-
- /* TODO: Use font information for positioning and thickness
- of underline. See OUTLINETEXTMETRIC, and xterm.c. */
- if (s->face->underline_defaulted_p)
- {
- w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x,
- s->y + dy, s->width, 1);
- }
- else
- {
- w32_fill_area (s->f, s->hdc, s->face->underline_color, s->x,
- s->y + dy, s->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->width, h);
- }
- else
- {
- w32_fill_area (s->f, s->hdc, s->face->underline_color, s->x,
- s->y + dy, s->width, h);
- }
- }
-
- /* Draw strike-through. */
- if (s->face->strike_through_p
- && (s->font->bdf || !s->font->tm.tmStruckOut))
- {
- unsigned long h = 1;
- unsigned long dy = (s->height - h) / 2;
-
- if (s->face->strike_through_color_defaulted_p)
- {
- w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x, s->y + dy,
- s->width, h);
- }
- else
- {
- w32_fill_area (s->f, s->hdc, s->face->underline_color, s->x,
- s->y + dy, s->width, h);
- }
- }
-
- /* Draw relief. */
- if (!relief_drawn_p && s->face->box != FACE_NO_BOX)
- x_draw_glyph_string_box (s);
- }
-
- /* Reset clipping. */
- w32_set_clip_rectangle (s->hdc, NULL);
-}
-
-
-static int x_fill_composite_glyph_string P_ ((struct glyph_string *,
- struct face **, int));
-
-
-/* Fill glyph string S with composition components specified by S->cmp.
-
- FACES is an array of faces for all components of this composition.
- S->gidx is the index of the first component for S.
- OVERLAPS_P non-zero means S should draw the foreground only, and
- use its physical height for clipping.
-
- Value is the index of a component not in S. */
-
-static int
-x_fill_composite_glyph_string (s, faces, overlaps_p)
- struct glyph_string *s;
- struct face **faces;
- int overlaps_p;
-{
- int i;
-
- xassert (s);
-
- s->for_overlaps_p = overlaps_p;
-
- s->face = faces[s->gidx];
- s->font = s->face->font;
- s->font_info = FONT_INFO_FROM_ID (s->f, s->face->font_info_id);
-
- /* 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;
-
- /* 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
- the glyph string so that we can draw rectangles for the
- characters of the glyph string. */
- if (s->font == NULL)
- {
- s->font_not_found_p = 1;
- s->font = FRAME_FONT (s->f);
- }
-
- /* 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;
-
- return s->gidx + s->nchars;
-}
-
-
-/* Fill glyph string S from a sequence of character glyphs.
-
- FACE_ID is the face id of the string. START is the index of the
- first glyph to consider, END is the index of the last + 1.
- OVERLAPS_P non-zero means S should draw the foreground only, and
- use its physical height for clipping.
-
- Value is the index of the first glyph not in S. */
-
-static int
-x_fill_glyph_string (s, face_id, start, end, overlaps_p)
- struct glyph_string *s;
- int face_id;
- int start, end, overlaps_p;
-{
- struct glyph *glyph, *last;
- int voffset;
- int glyph_not_available_p;
-
- xassert (s->f == XFRAME (s->w->frame));
- xassert (s->nchars == 0);
- xassert (start >= 0 && end > start);
-
- s->for_overlaps_p = overlaps_p;
- glyph = s->row->glyphs[s->area] + start;
- last = s->row->glyphs[s->area] + end;
- voffset = glyph->voffset;
-
- glyph_not_available_p = glyph->glyph_not_available_p;
-
- while (glyph < last
- && glyph->type == CHAR_GLYPH
- && glyph->voffset == voffset
- /* Same face id implies same font, nowadays. */
- && glyph->face_id == face_id
- && glyph->glyph_not_available_p == glyph_not_available_p)
- {
- int two_byte_p;
-
- s->face = x_get_glyph_face_and_encoding (s->f, glyph,
- s->char2b + s->nchars,
- &two_byte_p);
- s->two_byte_p = two_byte_p;
- ++s->nchars;
- xassert (s->nchars <= end - start);
- s->width += glyph->pixel_width;
- ++glyph;
- }
-
- s->font = s->face->font;
- s->font_info = FONT_INFO_FROM_ID (s->f, s->face->font_info_id);
-
- /* If the specified font could not be loaded, use the frame's font,
- but record the fact that we couldn't load it in
- S->font_not_found_p so that we can draw rectangles for the
- characters of the glyph string. */
- if (s->font == NULL || glyph_not_available_p)
- {
- s->font_not_found_p = 1;
- s->font = FRAME_FONT (s->f);
- }
-
- /* Adjust base line for subscript/superscript text. */
- s->ybase += voffset;
-
- xassert (s->face && s->face->gc);
- return glyph - s->row->glyphs[s->area];
-}
-
-
-/* Fill glyph string S from image glyph S->first_glyph. */
-
-static void
-x_fill_image_glyph_string (s)
- struct glyph_string *s;
-{
- xassert (s->first_glyph->type == IMAGE_GLYPH);
- s->img = IMAGE_FROM_ID (s->f, s->first_glyph->u.img_id);
- xassert (s->img);
- s->face = FACE_FROM_ID (s->f, s->first_glyph->face_id);
- s->font = s->face->font;
- s->width = s->first_glyph->pixel_width;
-
- /* Adjust base line for subscript/superscript text. */
- s->ybase += s->first_glyph->voffset;
-}
-
-
-/* Fill glyph string S from a sequence of stretch glyphs.
-
- ROW is the glyph row in which the glyphs are found, AREA is the
- area within the row. START is the index of the first glyph to
- consider, END is the index of the last + 1.
-
- Value is the index of the first glyph not in S. */
-
-static int
-x_fill_stretch_glyph_string (s, row, area, start, end)
- struct glyph_string *s;
- struct glyph_row *row;
- enum glyph_row_area area;
- int start, end;
-{
- struct glyph *glyph, *last;
- int voffset, face_id;
-
- xassert (s->first_glyph->type == STRETCH_GLYPH);
-
- glyph = s->row->glyphs[s->area] + start;
- last = s->row->glyphs[s->area] + end;
- 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->width = glyph->pixel_width;
- voffset = glyph->voffset;
-
- for (++glyph;
- (glyph < last
- && glyph->type == STRETCH_GLYPH
- && glyph->voffset == voffset
- && glyph->face_id == face_id);
- ++glyph)
- s->width += glyph->pixel_width;
-
- /* Adjust base line for subscript/superscript text. */
- s->ybase += voffset;
-
- xassert (s->face);
- return glyph - s->row->glyphs[s->area];
-}
-
-
-/* Initialize glyph string S. CHAR2B is a suitably allocated vector
- of XChar2b structures for S; it can't be allocated in
- x_init_glyph_string because it must be allocated via `alloca'. W
- is the window on which S is drawn. ROW and AREA are the glyph row
- and area within the row from which S is constructed. START is the
- index of the first glyph structure covered by S. HL is a
- face-override for drawing S. */
-
-static void
-w32_init_glyph_string (s, hdc, char2b, w, row, area, start, hl)
- struct glyph_string *s;
- HDC hdc;
- wchar_t *char2b;
- struct window *w;
- struct glyph_row *row;
- enum glyph_row_area area;
- int start;
- enum draw_glyphs_face hl;
-{
- bzero (s, sizeof *s);
- s->w = w;
- s->f = XFRAME (w->frame);
- s->hdc = hdc;
- s->window = FRAME_W32_WINDOW (s->f);
- s->char2b = char2b;
- s->hl = hl;
- s->row = row;
- s->area = area;
- s->first_glyph = row->glyphs[area] + start;
- s->height = row->height;
- s->y = WINDOW_TO_FRAME_PIXEL_Y (w, row->y);
-
- /* Display the internal border below the tool-bar window. */
- if (s->w == XWINDOW (s->f->tool_bar_window))
- s->y -= s->f->output_data.w32->internal_border_width;
-
- s->ybase = s->y + row->ascent;
-}
-
-
-/* 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. */
-
-static INLINE void
-x_set_glyph_string_background_width (s, start, last_x)
- struct glyph_string *s;
- int start;
- int last_x;
-{
- /* If the face of this glyph string has to be drawn to the end of
- the drawing area, set S->extends_to_end_of_line_p. */
- struct face *default_face = FACE_FROM_ID (s->f, DEFAULT_FACE_ID);
-
- if (start == s->row->used[s->area]
- && s->area == TEXT_AREA
- && ((s->hl == DRAW_NORMAL_TEXT
- && (s->row->fill_line_p
- || s->face->background != default_face->background
- || s->face->stipple != default_face->stipple
- || s->row->mouse_face_p))
- || s->hl == DRAW_MOUSE_FACE
- || ((s->hl == DRAW_IMAGE_RAISED || s->hl == DRAW_IMAGE_SUNKEN)
- && s->row->fill_line_p)))
- s->extends_to_end_of_line_p = 1;
-
- /* If S extends its face to the end of the line, set its
- background_width to the distance to the right edge of the drawing
- area. */
- if (s->extends_to_end_of_line_p)
- s->background_width = last_x - s->x + 1;
- else
- s->background_width = s->width;
-}
-
-
-/* Add a glyph string for a stretch glyph to the list of strings
- between HEAD and TAIL. START is the index of the stretch glyph in
- row area AREA of glyph row ROW. END is the index of the last glyph
- in that glyph row area. X is the current output position assigned
- to the new glyph string constructed. HL overrides that face of the
- glyph; e.g. it is DRAW_CURSOR if a cursor has to be drawn. LAST_X
- is the right-most x-position of the drawing area. */
-
-#define BUILD_STRETCH_GLYPH_STRING(hdc, W, ROW, AREA, START, END, HEAD, TAIL, HL, X, LAST_X) \
- do \
- { \
- s = (struct glyph_string *) alloca (sizeof *s); \
- w32_init_glyph_string (s, hdc, NULL, W, ROW, AREA, START, HL); \
- START = x_fill_stretch_glyph_string (s, ROW, AREA, START, END); \
- x_append_glyph_string (&HEAD, &TAIL, s); \
- s->x = (X); \
- } \
- while (0)
-
-
-/* Add a glyph string for an image glyph to the list of strings
- between HEAD and TAIL. START is the index of the image glyph in
- row area AREA of glyph row ROW. END is the index of the last glyph
- in that glyph row area. X is the current output position assigned
- to the new glyph string constructed. HL overrides that face of the
- glyph; e.g. it is DRAW_CURSOR if a cursor has to be drawn. LAST_X
- is the right-most x-position of the drawing area. */
-
-#define BUILD_IMAGE_GLYPH_STRING(hdc, W, ROW, AREA, START, END, HEAD, TAIL, HL, X, LAST_X) \
- do \
- { \
- s = (struct glyph_string *) alloca (sizeof *s); \
- w32_init_glyph_string (s, hdc, NULL, W, ROW, AREA, START, HL); \
- x_fill_image_glyph_string (s); \
- x_append_glyph_string (&HEAD, &TAIL, s); \
- ++START; \
- s->x = (X); \
- } \
- while (0)
-
-
-/* Add a glyph string for a sequence of character glyphs to the list
- of strings between HEAD and TAIL. START is the index of the first
- glyph in row area AREA of glyph row ROW that is part of the new
- glyph string. END is the index of the last glyph in that glyph row
- area. X is the current output position assigned to the new glyph
- string constructed. HL overrides that face of the glyph; e.g. it
- is DRAW_CURSOR if a cursor has to be drawn. LAST_X is the
- right-most x-position of the drawing area. */
-
-#define BUILD_CHAR_GLYPH_STRINGS(hdc, W, ROW, AREA, START, END, HEAD, TAIL, HL, X, LAST_X, OVERLAPS_P) \
- do \
- { \
- int c, face_id; \
- wchar_t *char2b; \
- \
- c = (ROW)->glyphs[AREA][START].u.ch; \
- face_id = (ROW)->glyphs[AREA][START].face_id; \
- \
- s = (struct glyph_string *) alloca (sizeof *s); \
- char2b = (wchar_t *) alloca ((END - START) * sizeof *char2b); \
- w32_init_glyph_string (s, hdc, char2b, W, ROW, AREA, START, HL); \
- x_append_glyph_string (&HEAD, &TAIL, s); \
- s->x = (X); \
- START = x_fill_glyph_string (s, face_id, START, END, \
- OVERLAPS_P); \
- } \
- while (0)
-
-
-/* Add a glyph string for a composite sequence to the list of strings
- between HEAD and TAIL. START is the index of the first glyph in
- row area AREA of glyph row ROW that is part of the new glyph
- string. END is the index of the last glyph in that glyph row area.
- X is the current output position assigned to the new glyph string
- constructed. HL overrides that face of the glyph; e.g. it is
- DRAW_CURSOR if a cursor has to be drawn. LAST_X is the right-most
- x-position of the drawing area. */
-
-#define BUILD_COMPOSITE_GLYPH_STRING(hdc, W, ROW, AREA, START, END, HEAD, TAIL, HL, X, LAST_X, OVERLAPS_P) \
- 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 (XFRAME (w->frame), face_id); \
- struct composition *cmp = composition_table[cmp_id]; \
- int glyph_len = cmp->glyph_len; \
- wchar_t *char2b; \
- struct face **faces; \
- struct glyph_string *first_s = NULL; \
- int n; \
- \
- base_face = base_face->ascii_face; \
- char2b = (wchar_t *) 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 (XFRAME (w->frame), base_face, c); \
- faces[n] = FACE_FROM_ID (XFRAME (w->frame), this_face_id); \
- x_get_char_face_and_encoding (XFRAME (w->frame), c, \
- this_face_id, char2b + n, 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); \
- w32_init_glyph_string (s, hdc, char2b + n, W, ROW, AREA, START, HL); \
- x_append_glyph_string (&(HEAD), &(TAIL), s); \
- s->cmp = cmp; \
- s->gidx = n; \
- s->x = (X); \
- \
- if (n == 0) \
- first_s = s; \
- \
- n = x_fill_composite_glyph_string (s, faces, OVERLAPS_P); \
- } \
- \
- ++START; \
- s = first_s; \
- } while (0)
-
-
-/* Build a list of glyph strings between HEAD and TAIL for the glyphs
- of AREA of glyph row ROW on window W between indices START and END.
- HL overrides the face for drawing glyph strings, e.g. it is
- DRAW_CURSOR to draw a cursor. X and LAST_X are start and end
- x-positions of the drawing area.
-
- This is an ugly monster macro construct because we must use alloca
- to allocate glyph strings (because x_draw_glyphs can be called
- asynchronously). */
-
-#define BUILD_GLYPH_STRINGS(hdc, W, ROW, AREA, START, END, HEAD, TAIL, HL, X, LAST_X, OVERLAPS_P) \
- do \
- { \
- HEAD = TAIL = NULL; \
- while (START < END) \
- { \
- struct glyph *first_glyph = (ROW)->glyphs[AREA] + START; \
- switch (first_glyph->type) \
- { \
- case CHAR_GLYPH: \
- BUILD_CHAR_GLYPH_STRINGS (hdc, W, ROW, AREA, START, END, \
- HEAD, TAIL, HL, X, LAST_X, \
- OVERLAPS_P); \
- break; \
- \
- case COMPOSITE_GLYPH: \
- BUILD_COMPOSITE_GLYPH_STRING (hdc, W, ROW, AREA, START, \
- END, HEAD, TAIL, HL, X, \
- LAST_X, OVERLAPS_P); \
- break; \
- \
- case STRETCH_GLYPH: \
- BUILD_STRETCH_GLYPH_STRING (hdc, W, ROW, AREA, START, END,\
- HEAD, TAIL, HL, X, LAST_X); \
- break; \
- \
- case IMAGE_GLYPH: \
- BUILD_IMAGE_GLYPH_STRING (hdc, W, ROW, AREA, START, END, \
- HEAD, TAIL, HL, X, LAST_X); \
- break; \
- \
- default: \
- abort (); \
- } \
- \
- x_set_glyph_string_background_width (s, START, LAST_X); \
- (X) += s->width; \
- } \
- } \
- while (0)
-
-
-/* Draw glyphs between START and END in AREA of ROW on window W,
- starting at x-position X. X is relative to AREA in W. HL is a
- face-override with the following meaning:
-
- DRAW_NORMAL_TEXT draw normally
- DRAW_CURSOR draw in cursor face
- DRAW_MOUSE_FACE draw in mouse face.
- DRAW_INVERSE_VIDEO draw in mode line face
- DRAW_IMAGE_SUNKEN draw an image with a sunken relief around it
- DRAW_IMAGE_RAISED draw an image with a raised relief around it
-
- If OVERLAPS_P is non-zero, draw only the foreground of characters
- and clip to the physical height of ROW.
-
- Value is the x-position reached, relative to AREA of W. */
-
-static int
-x_draw_glyphs (w, x, row, area, start, end, hl, overlaps_p)
- struct window *w;
- int x;
- struct glyph_row *row;
- enum glyph_row_area area;
- int start, end;
- enum draw_glyphs_face hl;
- int overlaps_p;
-{
- struct glyph_string *head, *tail;
- struct glyph_string *s;
- int last_x, area_width;
- int x_reached;
- int i, j;
- HDC hdc = get_frame_dc (XFRAME (WINDOW_FRAME (w)));
-
- /* Let's rather be paranoid than getting a SEGV. */
- end = min (end, row->used[area]);
- start = max (0, start);
- start = min (end, start);
-
- /* Translate X to frame coordinates. Set last_x to the right
- end of the drawing area. */
- if (row->full_width_p)
- {
- /* X is relative to the left edge of W, without scroll bars
- or fringes. */
- struct frame *f = XFRAME (WINDOW_FRAME (w));
- int window_left_x = WINDOW_LEFT_MARGIN (w) * CANON_X_UNIT (f);
-
- x += window_left_x;
- area_width = XFASTINT (w->width) * CANON_X_UNIT (f);
- last_x = window_left_x + area_width;
-
- if (FRAME_HAS_VERTICAL_SCROLL_BARS (f))
- {
- int width = FRAME_SCROLL_BAR_WIDTH (f) * CANON_X_UNIT (f);
- if (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
- last_x += width;
- else
- x -= width;
- }
-
- x += FRAME_INTERNAL_BORDER_WIDTH (f);
- last_x -= FRAME_INTERNAL_BORDER_WIDTH (f);
- }
- else
- {
- x = WINDOW_AREA_TO_FRAME_PIXEL_X (w, area, x);
- area_width = window_box_width (w, area);
- last_x = WINDOW_AREA_TO_FRAME_PIXEL_X (w, area, area_width);
- }
-
- /* Build a doubly-linked list of glyph_string structures between
- head and tail from what we have to draw. Note that the macro
- BUILD_GLYPH_STRINGS will modify its start parameter. That's
- the reason we use a separate variable `i'. */
- i = start;
- BUILD_GLYPH_STRINGS (hdc, w, row, area, i, end, head, tail, hl, x, last_x,
- overlaps_p);
- if (tail)
- x_reached = tail->x + tail->background_width;
- else
- x_reached = x;
-
- /* If there are any glyphs with lbearing < 0 or rbearing > width in
- the row, redraw some glyphs in front or following the glyph
- strings built above. */
- if (head && !overlaps_p && row->contains_overlapping_glyphs_p)
- {
- int dummy_x = 0;
- struct glyph_string *h, *t;
-
- /* Compute overhangs for all glyph strings. */
- for (s = head; s; s = s->next)
- x_compute_glyph_string_overhangs (s);
-
- /* Prepend glyph strings for glyphs in front of the first glyph
- string that are overwritten because of the first glyph
- string's left overhang. The background of all strings
- prepended must be drawn because the first glyph string
- draws over it. */
- i = x_left_overwritten (head);
- if (i >= 0)
- {
- j = i;
- BUILD_GLYPH_STRINGS (hdc, w, row, area, j, start, h, t,
- DRAW_NORMAL_TEXT, dummy_x, last_x,
- overlaps_p);
- start = i;
- x_compute_overhangs_and_x (t, head->x, 1);
- x_prepend_glyph_string_lists (&head, &tail, h, t);
- }
-
- /* Prepend glyph strings for glyphs in front of the first glyph
- string that overwrite that glyph string because of their
- right overhang. For these strings, only the foreground must
- be drawn, because it draws over the glyph string at `head'.
- The background must not be drawn because this would overwrite
- right overhangs of preceding glyphs for which no glyph
- strings exist. */
- i = x_left_overwriting (head);
- if (i >= 0)
- {
- BUILD_GLYPH_STRINGS (hdc, w, row, area, i, start, h, t,
- DRAW_NORMAL_TEXT, dummy_x, last_x,
- overlaps_p);
- for (s = h; s; s = s->next)
- s->background_filled_p = 1;
- x_compute_overhangs_and_x (t, head->x, 1);
- x_prepend_glyph_string_lists (&head, &tail, h, t);
- }
-
- /* Append glyphs strings for glyphs following the last glyph
- string tail that are overwritten by tail. The background of
- these strings has to be drawn because tail's foreground draws
- over it. */
- i = x_right_overwritten (tail);
- if (i >= 0)
- {
- BUILD_GLYPH_STRINGS (hdc, w, row, area, end, i, h, t,
- DRAW_NORMAL_TEXT, x, last_x,
- overlaps_p);
- x_compute_overhangs_and_x (h, tail->x + tail->width, 0);
- x_append_glyph_string_lists (&head, &tail, h, t);
- }
-
- /* Append glyph strings for glyphs following the last glyph
- string tail that overwrite tail. The foreground of such
- glyphs has to be drawn because it writes into the background
- of tail. The background must not be drawn because it could
- paint over the foreground of following glyphs. */
- i = x_right_overwriting (tail);
- if (i >= 0)
- {
- BUILD_GLYPH_STRINGS (hdc, w, row, area, end, i, h, t,
- DRAW_NORMAL_TEXT, x, last_x,
- overlaps_p);
- for (s = h; s; s = s->next)
- s->background_filled_p = 1;
- x_compute_overhangs_and_x (h, tail->x + tail->width, 0);
- x_append_glyph_string_lists (&head, &tail, h, t);
- }
- }
-
- /* Draw all strings. */
- for (s = head; s; s = s->next)
- x_draw_glyph_string (s);
-
- if (area == TEXT_AREA
- && !row->full_width_p
- /* When drawing overlapping rows, only the glyph strings'
- foreground is drawn, which doesn't erase a cursor
- completely. */
- && !overlaps_p)
- {
- int x0 = head ? head->x : x;
- int x1 = tail ? tail->x + tail->background_width : x;
-
- x0 = FRAME_TO_WINDOW_PIXEL_X (w, x0);
- x1 = FRAME_TO_WINDOW_PIXEL_X (w, x1);
-
- if (!row->full_width_p && XFASTINT (w->left_margin_width) != 0)
- {
- int left_area_width = window_box_width (w, LEFT_MARGIN_AREA);
- x0 -= left_area_width;
- x1 -= left_area_width;
- }
-
- notice_overwritten_cursor (w, area, x0, x1,
- row->y, MATRIX_ROW_BOTTOM_Y (row));
- }
-
- /* Value is the x-position up to which drawn, relative to AREA of W.
- This doesn't include parts drawn because of overhangs. */
- x_reached = FRAME_TO_WINDOW_PIXEL_X (w, x_reached);
- if (!row->full_width_p)
- {
- if (area > LEFT_MARGIN_AREA)
- x_reached -= window_box_width (w, LEFT_MARGIN_AREA);
- if (area > TEXT_AREA)
- x_reached -= window_box_width (w, TEXT_AREA);
- }
-
- release_frame_dc (XFRAME (WINDOW_FRAME (w)), hdc);
-
- return x_reached;
-}
-
-
-/* Fix the display of area AREA of overlapping row ROW in window W. */
-
-static void
-x_fix_overlapping_area (w, row, area)
- struct window *w;
- struct glyph_row *row;
- enum glyph_row_area area;
-{
- int i, x;
-
- BLOCK_INPUT;
-
- if (area == LEFT_MARGIN_AREA)
- x = 0;
- else if (area == TEXT_AREA)
- x = row->x + window_box_width (w, LEFT_MARGIN_AREA);
- else
- x = (window_box_width (w, LEFT_MARGIN_AREA)
- + window_box_width (w, TEXT_AREA));
-
- for (i = 0; i < row->used[area];)
- {
- if (row->glyphs[area][i].overlaps_vertically_p)
- {
- int start = i, start_x = x;
-
- do
- {
- x += row->glyphs[area][i].pixel_width;
- ++i;
- }
- while (i < row->used[area]
- && row->glyphs[area][i].overlaps_vertically_p);
-
- x_draw_glyphs (w, start_x, row, area, start, i,
- DRAW_NORMAL_TEXT, 1);
- }
- else
- {
- x += row->glyphs[area][i].pixel_width;
- ++i;
- }
- }
-
- UNBLOCK_INPUT;
-}
-
-
-/* Output LEN glyphs starting at START at the nominal cursor position.
- Advance the nominal cursor over the text. The global variable
- updated_window contains the window being updated, updated_row is
- the glyph row being updated, and updated_area is the area of that
- row being updated. */
-
-static void
-x_write_glyphs (start, len)
- struct glyph *start;
- int len;
-{
- int x, hpos;
-
- xassert (updated_window && updated_row);
- BLOCK_INPUT;
-
- /* Write glyphs. */
-
- hpos = start - updated_row->glyphs[updated_area];
- x = x_draw_glyphs (updated_window, output_cursor.x,
- updated_row, updated_area,
- hpos, hpos + len,
- DRAW_NORMAL_TEXT, 0);
-
- UNBLOCK_INPUT;
-
- /* Advance the output cursor. */
- output_cursor.hpos += len;
- output_cursor.x = x;
-}
-
-
-/* Insert LEN glyphs from START at the nominal cursor position. */
-
-static void
-x_insert_glyphs (start, len)
- struct glyph *start;
- register int len;
-{
- struct frame *f;
- struct window *w;
- int line_height, shift_by_width, shifted_region_width;
- struct glyph_row *row;
- struct glyph *glyph;
- int frame_x, frame_y, hpos;
- HDC hdc;
-
- xassert (updated_window && updated_row);
- BLOCK_INPUT;
- w = updated_window;
- f = XFRAME (WINDOW_FRAME (w));
- hdc = get_frame_dc (f);
-
- /* Get the height of the line we are in. */
- row = updated_row;
- line_height = row->height;
-
- /* Get the width of the glyphs to insert. */
- shift_by_width = 0;
- for (glyph = start; glyph < start + len; ++glyph)
- shift_by_width += glyph->pixel_width;
-
- /* Get the width of the region to shift right. */
- shifted_region_width = (window_box_width (w, updated_area)
- - output_cursor.x
- - shift_by_width);
-
- /* Shift right. */
- frame_x = window_box_left (w, updated_area) + output_cursor.x;
- frame_y = WINDOW_TO_FRAME_PIXEL_Y (w, output_cursor.y);
- BitBlt (hdc, frame_x + shift_by_width, frame_y,
- shifted_region_width, line_height,
- hdc, frame_x, frame_y, SRCCOPY);
-
- /* Write the glyphs. */
- hpos = start - row->glyphs[updated_area];
- x_draw_glyphs (w, output_cursor.x, row, updated_area, hpos, hpos + len,
- DRAW_NORMAL_TEXT, 0);
-
- /* Advance the output cursor. */
- output_cursor.hpos += len;
- output_cursor.x += shift_by_width;
- release_frame_dc (f, hdc);
-
- UNBLOCK_INPUT;
-}
-
-
-/* Delete N glyphs at the nominal cursor position. Not implemented
- for X frames. */
-
-static void
-x_delete_glyphs (n)
- register int n;
-{
- struct frame *f;
-
- if (updating_frame)
- f = updating_frame;
- else
- f = SELECTED_FRAME ();
-
- if (! FRAME_W32_P (f))
- return;
-
- abort ();
-}
-
-
-/* Erase the current text line from the nominal cursor position
- (inclusive) to pixel column TO_X (exclusive). The idea is that
- everything from TO_X onward is already erased.
-
- TO_X is a pixel position relative to updated_area of
- updated_window. TO_X == -1 means clear to the end of this area. */
-
-static void
-x_clear_end_of_line (to_x)
- int to_x;
-{
- struct frame *f;
- struct window *w = updated_window;
- int max_x, min_y, max_y;
- int from_x, from_y, to_y;
-
- xassert (updated_window && updated_row);
- f = XFRAME (w->frame);
-
- if (updated_row->full_width_p)
- {
- max_x = XFASTINT (w->width) * CANON_X_UNIT (f);
- if (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
- && !w->pseudo_window_p)
- max_x += FRAME_SCROLL_BAR_WIDTH (f) * CANON_X_UNIT (f);
- }
- else
- max_x = window_box_width (w, updated_area);
- max_y = window_text_bottom_y (w);
-
- /* TO_X == 0 means don't do anything. TO_X < 0 means clear to end
- of window. For TO_X > 0, truncate to end of drawing area. */
- if (to_x == 0)
- return;
- else if (to_x < 0)
- to_x = max_x;
- else
- to_x = min (to_x, max_x);
-
- to_y = min (max_y, output_cursor.y + updated_row->height);
-
- /* Notice if the cursor will be cleared by this operation. */
- if (!updated_row->full_width_p)
- notice_overwritten_cursor (w, updated_area,
- output_cursor.x, -1,
- updated_row->y,
- MATRIX_ROW_BOTTOM_Y (updated_row));
-
- from_x = output_cursor.x;
-
- /* Translate to frame coordinates. */
- if (updated_row->full_width_p)
- {
- from_x = WINDOW_TO_FRAME_PIXEL_X (w, from_x);
- to_x = WINDOW_TO_FRAME_PIXEL_X (w, to_x);
- }
- else
- {
- from_x = WINDOW_AREA_TO_FRAME_PIXEL_X (w, updated_area, from_x);
- to_x = WINDOW_AREA_TO_FRAME_PIXEL_X (w, updated_area, to_x);
- }
-
- min_y = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w);
- from_y = WINDOW_TO_FRAME_PIXEL_Y (w, max (min_y, output_cursor.y));
- to_y = WINDOW_TO_FRAME_PIXEL_Y (w, to_y);
-
- /* Prevent inadvertently clearing to end of the X window. */
- if (to_x > from_x && to_y > from_y)
- {
- HDC hdc;
- BLOCK_INPUT;
- hdc = get_frame_dc (f);
-
- w32_clear_area (f, hdc, from_x, from_y, to_x - from_x, to_y - from_y);
- release_frame_dc (f, hdc);
- UNBLOCK_INPUT;
- }
-}
-
-
-/* Clear entire frame. If updating_frame is non-null, clear that
- frame. Otherwise clear the selected frame. */
-
-static void
-x_clear_frame ()
-{
- struct frame *f;
-
- if (updating_frame)
- f = updating_frame;
- else
- f = SELECTED_FRAME ();
-
- if (! FRAME_W32_P (f))
- return;
-
- /* Clearing the frame will erase any cursor, so mark them all as no
- longer visible. */
- mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f)));
- output_cursor.hpos = output_cursor.vpos = 0;
- output_cursor.x = -1;
-
- /* We don't set the output cursor here because there will always
- follow an explicit cursor_to. */
- BLOCK_INPUT;
-
- w32_clear_window (f);
-
- /* We have to clear the scroll bars, too. If we have changed
- colors or something like that, then they should be notified. */
- x_scroll_bar_clear (f);
-
- UNBLOCK_INPUT;
-}
-
-\f
-/* Make audible bell. */
-
-static void
-w32_ring_bell (void)
-{
- struct frame *f;
-
- f = SELECTED_FRAME ();
-
- BLOCK_INPUT;
-
- if (FRAME_W32_P (f) && visible_bell)
- {
- int i;
- HWND hwnd = FRAME_W32_WINDOW (SELECTED_FRAME ());
-
- for (i = 0; i < 5; i++)
- {
- FlashWindow (hwnd, TRUE);
- Sleep (10);
- }
- FlashWindow (hwnd, FALSE);
- }
- else
- w32_sys_ring_bell ();
-
- UNBLOCK_INPUT;
-}
-
-\f
-/* Specify how many text lines, from the top of the window,
- should be affected by insert-lines and delete-lines operations.
- This, and those operations, are used only within an update
- that is bounded by calls to x_update_begin and x_update_end. */
-
-static void
-w32_set_terminal_window (n)
- register int n;
-{
- /* This function intentionally left blank. */
-}
-\f
-
-\f
-/***********************************************************************
- Line Dance
- ***********************************************************************/
-
-/* Perform an insert-lines or delete-lines operation, inserting N
- lines or deleting -N lines at vertical position VPOS. */
-
-static void
-x_ins_del_lines (vpos, n)
- int vpos, n;
-{
- struct frame *f;
-
- if (updating_frame)
- f = updating_frame;
- else
- f = SELECTED_FRAME ();
-
- if (! FRAME_W32_P (f))
- return;
-
- abort ();
-}
-
-
-/* Scroll part of the display as described by RUN. */
-
-static void
-x_scroll_run (w, run)
- struct window *w;
- struct run *run;
-{
- struct frame *f = XFRAME (w->frame);
- int x, y, width, height, from_y, to_y, bottom_y;
- HWND hwnd = FRAME_W32_WINDOW (f);
- HRGN expect_dirty;
-
- /* Get frame-relative bounding box of the text display area of W,
- without mode lines. Include in this box the left and right
- fringes of W. */
- window_box (w, -1, &x, &y, &width, &height);
- width += FRAME_X_FRINGE_WIDTH (f);
- x -= FRAME_X_LEFT_FRINGE_WIDTH (f);
-
- from_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->current_y);
- to_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->desired_y);
- bottom_y = y + height;
-
- if (to_y < from_y)
- {
- /* Scrolling up. Make sure we don't copy part of the mode
- line at the bottom. */
- if (from_y + run->height > bottom_y)
- height = bottom_y - from_y;
- else
- height = run->height;
- expect_dirty = CreateRectRgn (x, y + height, x + width, bottom_y);
- }
- else
- {
- /* Scolling down. Make sure we don't copy over the mode line.
- at the bottom. */
- if (to_y + run->height > bottom_y)
- height = bottom_y - to_y;
- else
- height = run->height;
- expect_dirty = CreateRectRgn (x, y, x + width, to_y);
- }
-
- BLOCK_INPUT;
-
- /* Cursor off. Will be switched on again in x_update_window_end. */
- updated_window = w;
- x_clear_cursor (w);
-
- {
- RECT from;
- RECT to;
- HRGN dirty = CreateRectRgn (0, 0, 0, 0);
- HRGN combined = CreateRectRgn (0, 0, 0, 0);
-
- from.left = to.left = x;
- from.right = to.right = x + width;
- from.top = from_y;
- from.bottom = from_y + height;
- to.top = y;
- to.bottom = bottom_y;
-
- ScrollWindowEx (hwnd, 0, to_y - from_y, &from, &to, dirty,
- NULL, SW_INVALIDATE);
-
- /* Combine this with what we expect to be dirty. This covers the
- case where not all of the region we expect is actually dirty. */
- CombineRgn (combined, dirty, expect_dirty, RGN_OR);
-
- /* If the dirty region is not what we expected, redraw the entire frame. */
- if (!EqualRgn (combined, expect_dirty))
- SET_FRAME_GARBAGED (f);
- }
-
- UNBLOCK_INPUT;
-}
-
-
-\f
-/***********************************************************************
- Exposure Events
- ***********************************************************************/
-
-/* Redisplay an exposed area of frame F. X and Y are the upper-left
- corner of the exposed rectangle. W and H are width and height of
- the exposed area. All are pixel values. W or H zero means redraw
- the entire frame. */
-
-static void
-expose_frame (f, x, y, w, h)
- struct frame *f;
- int x, y, w, h;
-{
- RECT r;
- int mouse_face_overwritten_p = 0;
-
- TRACE ((stderr, "expose_frame "));
-
- /* No need to redraw if frame will be redrawn soon. */
- if (FRAME_GARBAGED_P (f))
- {
- TRACE ((stderr, " garbaged\n"));
- return;
- }
-
- /* If basic faces haven't been realized yet, there is no point in
- trying to redraw anything. This can happen when we get an expose
- event while Emacs is starting, e.g. by moving another window. */
- if (FRAME_FACE_CACHE (f) == NULL
- || FRAME_FACE_CACHE (f)->used < BASIC_FACE_ID_SENTINEL)
- {
- TRACE ((stderr, " no faces\n"));
- return;
- }
-
- if (w == 0 || h == 0)
- {
- r.left = r.top = 0;
- r.right = CANON_X_UNIT (f) * f->width;
- r.bottom = CANON_Y_UNIT (f) * f->height;
- }
- else
- {
- r.left = x;
- r.top = y;
- r.right = x + w;
- r.bottom = y + h;
- }
-
- TRACE ((stderr, "(%d, %d, %d, %d)\n", r.left, r.top, r.right, r.bottom));
- mouse_face_overwritten_p = expose_window_tree (XWINDOW (f->root_window), &r);
-
- if (WINDOWP (f->tool_bar_window))
- mouse_face_overwritten_p
- |= expose_window (XWINDOW (f->tool_bar_window), &r);
-
- /* Some window managers support a focus-follows-mouse style with
- delayed raising of frames. Imagine a partially obscured frame,
- and moving the mouse into partially obscured mouse-face on that
- frame. The visible part of the mouse-face will be highlighted,
- then the WM raises the obscured frame. With at least one WM, KDE
- 2.1, Emacs is not getting any event for the raising of the frame
- (even tried with SubstructureRedirectMask), only Expose events.
- These expose events will draw text normally, i.e. not
- highlighted. Which means we must redo the highlight here.
- Subsume it under ``we love X''. --gerd 2001-08-15 */
- /* Included in Windows version because Windows most likely does not
- do the right thing if any third party tool offers
- focus-follows-mouse with delayed raise. --jason 2001-10-12 */
- if (mouse_face_overwritten_p && !FRAME_GARBAGED_P (f))
- {
- struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
- if (f == dpyinfo->mouse_face_mouse_frame)
- {
- int x = dpyinfo->mouse_face_mouse_x;
- int y = dpyinfo->mouse_face_mouse_y;
- clear_mouse_face (dpyinfo);
- note_mouse_highlight (f, x, y);
- }
- }
-}
-
-
-/* Redraw (parts) of all windows in the window tree rooted at W that
- intersect R. R contains frame pixel coordinates. */
-
-static int
-expose_window_tree (w, r)
- struct window *w;
- RECT *r;
-{
- struct frame *f = XFRAME (w->frame);
- int mouse_face_overwritten_p = 0;
-
- while (w && !FRAME_GARBAGED_P (f))
- {
- if (!NILP (w->hchild))
- mouse_face_overwritten_p
- |= expose_window_tree (XWINDOW (w->hchild), r);
- else if (!NILP (w->vchild))
- mouse_face_overwritten_p
- |= expose_window_tree (XWINDOW (w->vchild), r);
- else
- mouse_face_overwritten_p |= expose_window (w, r);
-
- w = NILP (w->next) ? NULL : XWINDOW (w->next);
- }
-
- return mouse_face_overwritten_p;
-}
-
-
-/* Redraw the part of glyph row area AREA of glyph row ROW on window W
- which intersects rectangle R. R is in window-relative coordinates. */
-
-static void
-expose_area (w, row, r, area)
- struct window *w;
- struct glyph_row *row;
- RECT *r;
- enum glyph_row_area area;
-{
- struct glyph *first = row->glyphs[area];
- struct glyph *end = row->glyphs[area] + row->used[area];
- struct glyph *last;
- int first_x, start_x, x;
-
- if (area == TEXT_AREA && row->fill_line_p)
- /* If row extends face to end of line write the whole line. */
- x_draw_glyphs (w, 0, row, area,
- 0, row->used[area],
- DRAW_NORMAL_TEXT, 0);
- else
- {
- /* Set START_X to the window-relative start position for drawing glyphs of
- AREA. The first glyph of the text area can be partially visible.
- The first glyphs of other areas cannot. */
- if (area == LEFT_MARGIN_AREA)
- start_x = 0;
- else if (area == TEXT_AREA)
- start_x = row->x + window_box_width (w, LEFT_MARGIN_AREA);
- else
- start_x = (window_box_width (w, LEFT_MARGIN_AREA)
- + window_box_width (w, TEXT_AREA));
- x = start_x;
-
- /* Find the first glyph that must be redrawn. */
- while (first < end
- && x + first->pixel_width < r->left)
- {
- x += first->pixel_width;
- ++first;
- }
-
- /* Find the last one. */
- last = first;
- first_x = x;
- while (last < end
- && x < r->right)
- {
- x += last->pixel_width;
- ++last;
- }
-
- /* Repaint. */
- if (last > first)
- x_draw_glyphs (w, first_x - start_x, row, area,
- first - row->glyphs[area],
- last - row->glyphs[area],
- DRAW_NORMAL_TEXT, 0);
- }
-}
-
-
-/* Redraw the parts of the glyph row ROW on window W intersecting
- rectangle R. R is in window-relative coordinates. Value is
- non-zero if mouse face was overwritten. */
-
-static int
-expose_line (w, row, r)
- struct window *w;
- struct glyph_row *row;
- RECT *r;
-{
- xassert (row->enabled_p);
-
- if (row->mode_line_p || w->pseudo_window_p)
- x_draw_glyphs (w, 0, row, TEXT_AREA, 0, row->used[TEXT_AREA],
- DRAW_NORMAL_TEXT, 0);
- else
- {
- if (row->used[LEFT_MARGIN_AREA])
- expose_area (w, row, r, LEFT_MARGIN_AREA);
- if (row->used[TEXT_AREA])
- expose_area (w, row, r, TEXT_AREA);
- if (row->used[RIGHT_MARGIN_AREA])
- expose_area (w, row, r, RIGHT_MARGIN_AREA);
- x_draw_row_fringe_bitmaps (w, row);
- }
-
- return row->mouse_face_p;
-}
-
-
-/* Return non-zero if W's cursor intersects rectangle R. */
-
-static int
-x_phys_cursor_in_rect_p (w, r)
- struct window *w;
- RECT *r;
-{
- RECT cr, result;
- struct glyph *cursor_glyph;
-
- cursor_glyph = get_phys_cursor_glyph (w);
- if (cursor_glyph)
- {
- cr.left = w->phys_cursor.x;
- cr.top = w->phys_cursor.y;
- cr.right = cr.left + cursor_glyph->pixel_width;
- cr.bottom = cr.top + w->phys_cursor_height;
- return IntersectRect (&result, &cr, r);
- }
- else
- return 0;
-}
-
-
-/* Redraw the part of window W intersection rectagle FR. Pixel
- coordinates in FR are frame relative. Call this function with
- input blocked. Value is non-zero if the exposure overwrites
- mouse-face. */
-
-static int
-expose_window (w, fr)
- struct window *w;
- RECT *fr;
-{
- struct frame *f = XFRAME (w->frame);
- RECT wr, r;
- int mouse_face_overwritten_p = 0;
-
- /* If window is not yet fully initialized, do nothing. This can
- happen when toolkit scroll bars are used and a window is split.
- Reconfiguring the scroll bar will generate an expose for a newly
- created window. */
- if (w->current_matrix == NULL)
- return 0;
-
- /* When we're currently updating the window, display and current
- matrix usually don't agree. Arrange for a thorough display
- later. */
- if (w == updated_window)
- {
- SET_FRAME_GARBAGED (f);
- return 0;
- }
-
- /* Frame-relative pixel rectangle of W. */
- wr.left = XFASTINT (w->left) * CANON_X_UNIT (f);
- wr.top = XFASTINT (w->top) * CANON_Y_UNIT (f);
- wr.right = wr.left + XFASTINT (w->width) * CANON_X_UNIT (f);
- wr.bottom = wr.top + XFASTINT (w->height) * CANON_Y_UNIT (f);
-
- if (IntersectRect(&r, fr, &wr))
- {
- int yb = window_text_bottom_y (w);
- struct glyph_row *row;
- int cursor_cleared_p;
-
- TRACE ((stderr, "expose_window (%d, %d, %d, %d)\n",
- r.left, r.top, r.right, r.bottom));
-
- /* Convert to window coordinates. */
- r.left = FRAME_TO_WINDOW_PIXEL_X (w, r.left);
- r.right = FRAME_TO_WINDOW_PIXEL_X (w, r.right);
- r.top = FRAME_TO_WINDOW_PIXEL_Y (w, r.top);
- r.bottom = FRAME_TO_WINDOW_PIXEL_Y (w, r.bottom);
-
- /* Turn off the cursor. */
- if (!w->pseudo_window_p
- && x_phys_cursor_in_rect_p (w, &r))
- {
- x_clear_cursor (w);
- cursor_cleared_p = 1;
- }
- else
- cursor_cleared_p = 0;
-
- /* Find the first row intersecting the rectangle R. */
- for (row = w->current_matrix->rows;
- row->enabled_p;
- ++row)
- {
- int y0 = row->y;
- int y1 = MATRIX_ROW_BOTTOM_Y (row);
-
- if ((y0 >= r.top && y0 < r.bottom)
- || (y1 > r.top && y1 < r.bottom)
- || (r.top >= y0 && r.top < y1)
- || (r.bottom > y0 && r.bottom < y1))
- {
- if (expose_line (w, row, &r))
- mouse_face_overwritten_p = 1;
- }
-
- if (y1 >= yb)
- break;
- }
-
- /* Display the mode line if there is one. */
- if (WINDOW_WANTS_MODELINE_P (w)
- && (row = MATRIX_MODE_LINE_ROW (w->current_matrix),
- row->enabled_p)
- && row->y < r.bottom)
- {
- if (expose_line (w, row, &r))
- mouse_face_overwritten_p = 1;
- }
-
- if (!w->pseudo_window_p)
- {
- /* Draw border between windows. */
- x_draw_vertical_border (w);
-
- /* Turn the cursor on again. */
- if (cursor_cleared_p)
- x_update_window_cursor (w, 1);
- }
- }
-
- return mouse_face_overwritten_p;
-}
-
-\f
-static void
-frame_highlight (f)
- struct frame *f;
-{
- x_update_cursor (f, 1);
-}
-
-static void
-frame_unhighlight (f)
- struct frame *f;
-{
- x_update_cursor (f, 1);
-}
-
-/* The focus has changed. Update the frames as necessary to reflect
- the new situation. Note that we can't change the selected frame
- here, because the Lisp code we are interrupting might become confused.
- Each event gets marked with the frame in which it occurred, so the
- Lisp code can tell when the switch took place by examining the events. */
-
-static void
-x_new_focus_frame (dpyinfo, frame)
- struct w32_display_info *dpyinfo;
- struct frame *frame;
-{
- struct frame *old_focus = dpyinfo->w32_focus_frame;
-
- if (frame != dpyinfo->w32_focus_frame)
- {
- /* Set this before calling other routines, so that they see
- the correct value of w32_focus_frame. */
- dpyinfo->w32_focus_frame = frame;
-
- if (old_focus && old_focus->auto_lower)
- x_lower_frame (old_focus);
-
- if (dpyinfo->w32_focus_frame && dpyinfo->w32_focus_frame->auto_raise)
- pending_autoraise_frame = dpyinfo->w32_focus_frame;
- else
- pending_autoraise_frame = 0;
- }
-
- x_frame_rehighlight (dpyinfo);
-}
-
-/* Handle an event saying the mouse has moved out of an Emacs frame. */
-
-void
-x_mouse_leave (dpyinfo)
- struct w32_display_info *dpyinfo;
-{
- x_new_focus_frame (dpyinfo, dpyinfo->w32_focus_event_frame);
-}
-
-/* The focus has changed, or we have redirected a frame's focus to
- another frame (this happens when a frame uses a surrogate
- mini-buffer frame). Shift the highlight as appropriate.
-
- The FRAME argument doesn't necessarily have anything to do with which
- frame is being highlighted or un-highlighted; we only use it to find
- the appropriate X display info. */
-
-static void
-w32_frame_rehighlight (frame)
- struct frame *frame;
-{
- if (! FRAME_W32_P (frame))
- return;
- x_frame_rehighlight (FRAME_W32_DISPLAY_INFO (frame));
-}
-
-static void
-x_frame_rehighlight (dpyinfo)
- struct w32_display_info *dpyinfo;
-{
- struct frame *old_highlight = dpyinfo->w32_highlight_frame;
-
- if (dpyinfo->w32_focus_frame)
- {
- dpyinfo->w32_highlight_frame
- = ((GC_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->w32_highlight_frame))
- {
- FRAME_FOCUS_FRAME (dpyinfo->w32_focus_frame) = Qnil;
- dpyinfo->w32_highlight_frame = dpyinfo->w32_focus_frame;
- }
- }
- else
- dpyinfo->w32_highlight_frame = 0;
-
- if (dpyinfo->w32_highlight_frame != old_highlight)
- {
- if (old_highlight)
- frame_unhighlight (old_highlight);
- if (dpyinfo->w32_highlight_frame)
- frame_highlight (dpyinfo->w32_highlight_frame);
- }
-}
-\f
-/* Keyboard processing - modifier keys, etc. */
-
-/* Convert a keysym to its name. */
-
-char *
-x_get_keysym_name (keysym)
- int keysym;
-{
- /* Make static so we can always return it */
- static char value[100];
-
- BLOCK_INPUT;
- GetKeyNameText (keysym, value, 100);
- UNBLOCK_INPUT;
-
- return value;
-}
-
-
-\f
-/* Mouse clicks and mouse movement. Rah. */
-
-/* Given a pixel position (PIX_X, PIX_Y) on frame F, return glyph
- co-ordinates in (*X, *Y). Set *BOUNDS to the rectangle that the
- glyph at X, Y occupies, if BOUNDS != 0. If NOCLIP is non-zero, do
- not force the value into range. */
-
-void
-pixel_to_glyph_coords (f, pix_x, pix_y, x, y, bounds, noclip)
- FRAME_PTR f;
- register int pix_x, pix_y;
- register int *x, *y;
- RECT *bounds;
- int noclip;
-{
- /* Support tty mode: if Vwindow_system is nil, behave correctly. */
- if (NILP (Vwindow_system))
- {
- *x = pix_x;
- *y = pix_y;
- return;
- }
-
- /* Arrange for the division in PIXEL_TO_CHAR_COL etc. to round down
- even for negative values. */
- if (pix_x < 0)
- pix_x -= FONT_WIDTH (FRAME_FONT (f)) - 1;
- if (pix_y < 0)
- pix_y -= (f)->output_data.w32->line_height - 1;
-
- pix_x = PIXEL_TO_CHAR_COL (f, pix_x);
- pix_y = PIXEL_TO_CHAR_ROW (f, pix_y);
-
- if (bounds)
- {
- bounds->left = CHAR_TO_PIXEL_COL (f, pix_x);
- bounds->top = CHAR_TO_PIXEL_ROW (f, pix_y);
- bounds->right = bounds->left + FONT_WIDTH (FRAME_FONT (f)) - 1;
- bounds->bottom = bounds->top + f->output_data.w32->line_height - 1;
- }
-
- if (!noclip)
- {
- if (pix_x < 0)
- pix_x = 0;
- else if (pix_x > FRAME_WINDOW_WIDTH (f))
- pix_x = FRAME_WINDOW_WIDTH (f);
-
- if (pix_y < 0)
- pix_y = 0;
- else if (pix_y > f->height)
- pix_y = f->height;
- }
-
- *x = pix_x;
- *y = pix_y;
-}
-
-
-/* Given HPOS/VPOS in the current matrix of W, return corresponding
- frame-relative pixel positions in *FRAME_X and *FRAME_Y. If we
- can't tell the positions because W's display is not up to date,
- return 0. */
-
-int
-glyph_to_pixel_coords (w, hpos, vpos, frame_x, frame_y)
- struct window *w;
- int hpos, vpos;
- int *frame_x, *frame_y;
-{
- int success_p;
-
- xassert (hpos >= 0 && hpos < w->current_matrix->matrix_w);
- xassert (vpos >= 0 && vpos < w->current_matrix->matrix_h);
-
- if (display_completed)
- {
- struct glyph_row *row = MATRIX_ROW (w->current_matrix, vpos);
- struct glyph *glyph = row->glyphs[TEXT_AREA];
- struct glyph *end = glyph + min (hpos, row->used[TEXT_AREA]);
-
- *frame_y = row->y;
- *frame_x = row->x;
- while (glyph < end)
- {
- *frame_x += glyph->pixel_width;
- ++glyph;
- }
-
- success_p = 1;
- }
- else
- {
- *frame_y = *frame_x = 0;
- success_p = 0;
- }
-
- *frame_y = WINDOW_TO_FRAME_PIXEL_Y (w, *frame_y);
- *frame_x = WINDOW_TO_FRAME_PIXEL_X (w, *frame_x);
- return success_p;
-}
-
-/* Parse a button MESSAGE. The button index is returned in PBUTTON, and
- the state in PUP. XBUTTON provides extra information for extended mouse
- button messages. Returns FALSE if unable to parse the message. */
-BOOL
-parse_button (message, xbutton, pbutton, pup)
- int message;
- int xbutton;
- int * pbutton;
- int * pup;
-{
- int button = 0;
- int up = 0;
-
- switch (message)
- {
- case WM_LBUTTONDOWN:
- button = 0;
- up = 0;
- break;
- case WM_LBUTTONUP:
- button = 0;
- up = 1;
- break;
- case WM_MBUTTONDOWN:
- if (NILP (Vw32_swap_mouse_buttons))
- button = 1;
- else
- button = 2;
- up = 0;
- break;
- case WM_MBUTTONUP:
- if (NILP (Vw32_swap_mouse_buttons))
- button = 1;
- else
- button = 2;
- up = 1;
- break;
- case WM_RBUTTONDOWN:
- if (NILP (Vw32_swap_mouse_buttons))
- button = 2;
- else
- button = 1;
- up = 0;
- break;
- case WM_RBUTTONUP:
- if (NILP (Vw32_swap_mouse_buttons))
- button = 2;
- else
- button = 1;
- up = 1;
- break;
- case WM_XBUTTONDOWN:
- button = xbutton + 2;
- up = 0;
- break;
- case WM_XBUTTONUP:
- button = xbutton + 2;
- up = 1;
+ case COMPOSITE_GLYPH:
+ if (s->for_overlaps_p || s->gidx > 0)
+ s->background_filled_p = 1;
+ else
+ x_draw_glyph_string_background (s, 1);
+ x_draw_composite_glyph_string_foreground (s);
break;
+
default:
- return (FALSE);
+ abort ();
}
-
- if (pup) *pup = up;
- if (pbutton) *pbutton = button;
-
- return (TRUE);
-}
+ if (!s->for_overlaps_p)
+ {
+ /* Draw underline. */
+ if (s->face->underline_p
+ && (s->font->bdf || !s->font->tm.tmUnderlined))
+ {
+ unsigned long h = 1;
+ unsigned long dy = s->height - h;
-/* Prepare a mouse-event in *RESULT for placement in the input queue.
+ /* TODO: Use font information for positioning and thickness
+ of underline. See OUTLINETEXTMETRIC, and xterm.c. */
+ if (s->face->underline_defaulted_p)
+ {
+ w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x,
+ s->y + dy, s->width, 1);
+ }
+ else
+ {
+ w32_fill_area (s->f, s->hdc, s->face->underline_color, s->x,
+ s->y + dy, s->width, 1);
+ }
+ }
- If the event is a button press, then note that we have grabbed
- the mouse. */
+ /* Draw overline. */
+ if (s->face->overline_p)
+ {
+ unsigned long dy = 0, h = 1;
-static Lisp_Object
-construct_mouse_click (result, msg, f)
- struct input_event *result;
- W32Msg *msg;
- struct frame *f;
-{
- int button;
- int up;
+ if (s->face->overline_color_defaulted_p)
+ {
+ w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x,
+ s->y + dy, s->width, h);
+ }
+ else
+ {
+ w32_fill_area (s->f, s->hdc, s->face->underline_color, s->x,
+ s->y + dy, s->width, h);
+ }
+ }
- parse_button (msg->msg.message, HIWORD (msg->msg.wParam),
- &button, &up);
+ /* Draw strike-through. */
+ if (s->face->strike_through_p
+ && (s->font->bdf || !s->font->tm.tmStruckOut))
+ {
+ unsigned long h = 1;
+ unsigned long dy = (s->height - h) / 2;
- /* Make the event type no_event; we'll change that when we decide
- otherwise. */
- result->kind = mouse_click;
- result->code = button;
- result->timestamp = msg->msg.time;
- result->modifiers = (msg->dwModifiers
- | (up
- ? up_modifier
- : down_modifier));
+ if (s->face->strike_through_color_defaulted_p)
+ {
+ w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x, s->y + dy,
+ s->width, h);
+ }
+ else
+ {
+ w32_fill_area (s->f, s->hdc, s->face->underline_color, s->x,
+ s->y + dy, s->width, h);
+ }
+ }
- XSETINT (result->x, LOWORD (msg->msg.lParam));
- XSETINT (result->y, HIWORD (msg->msg.lParam));
- XSETFRAME (result->frame_or_window, f);
- result->arg = Qnil;
- return Qnil;
-}
+ /* Draw relief. */
+ if (!relief_drawn_p && s->face->box != FACE_NO_BOX)
+ x_draw_glyph_string_box (s);
+ }
-static Lisp_Object
-construct_mouse_wheel (result, msg, f)
- struct input_event *result;
- W32Msg *msg;
- struct frame *f;
-{
- POINT p;
- result->kind = mouse_wheel;
- result->code = (short) HIWORD (msg->msg.wParam);
- result->timestamp = msg->msg.time;
- result->modifiers = msg->dwModifiers;
- p.x = LOWORD (msg->msg.lParam);
- p.y = HIWORD (msg->msg.lParam);
- ScreenToClient (msg->msg.hwnd, &p);
- XSETINT (result->x, p.x);
- XSETINT (result->y, p.y);
- XSETFRAME (result->frame_or_window, f);
- result->arg = Qnil;
- return Qnil;
+ /* Reset clipping. */
+ w32_set_clip_rectangle (s->hdc, NULL);
}
-static Lisp_Object
-construct_drag_n_drop (result, msg, f)
- struct input_event *result;
- W32Msg *msg;
- struct frame *f;
-{
- Lisp_Object files;
- Lisp_Object frame;
- HDROP hdrop;
- POINT p;
- WORD num_files;
- char *name;
- int i, len;
-
- result->kind = drag_n_drop;
- result->code = 0;
- result->timestamp = msg->msg.time;
- result->modifiers = msg->dwModifiers;
-
- hdrop = (HDROP) msg->msg.wParam;
- DragQueryPoint (hdrop, &p);
-
-#if 0
- p.x = LOWORD (msg->msg.lParam);
- p.y = HIWORD (msg->msg.lParam);
- ScreenToClient (msg->msg.hwnd, &p);
-#endif
-
- XSETINT (result->x, p.x);
- XSETINT (result->y, p.y);
- num_files = DragQueryFile (hdrop, 0xFFFFFFFF, NULL, 0);
- files = Qnil;
+/* Shift display to make room for inserted glyphs. */
- for (i = 0; i < num_files; i++)
- {
- len = DragQueryFile (hdrop, i, NULL, 0);
- if (len <= 0)
- continue;
- name = alloca (len + 1);
- DragQueryFile (hdrop, i, name, len + 1);
- files = Fcons (build_string (name), files);
- }
+void
+w32_shift_glyphs_for_insert (f, x, y, width, height, shift_by)
+ struct frame *f;
+ int x, y, width, height, shift_by;
+{
+ HDC hdc;
- DragFinish (hdrop);
+ hdc = get_frame_dc (f);
+ BitBlt (hdc, x + shift_by, y, width, height,
+ hdc, x, y, SRCCOPY);
- XSETFRAME (frame, f);
- result->frame_or_window = Fcons (frame, files);
- result->arg = Qnil;
- return Qnil;
+ release_frame_dc (f, hdc);
}
-\f
-/* Function to report a mouse movement to the mainstream Emacs code.
- The input handler calls this.
-
- We have received a mouse movement event, which is given in *event.
- If the mouse is over a different glyph than it was last time, tell
- the mainstream emacs code by setting mouse_moved. If not, ask for
- another motion event, so we can check again the next time it moves. */
-
-static MSG last_mouse_motion_event;
-static Lisp_Object last_mouse_motion_frame;
-static void remember_mouse_glyph P_ ((struct frame *, int, int));
+/* Delete N glyphs at the nominal cursor position. Not implemented
+ for X frames. */
static void
-note_mouse_movement (frame, msg)
- FRAME_PTR frame;
- MSG *msg;
+x_delete_glyphs (n)
+ register int n;
{
- int mouse_x = LOWORD (msg->lParam);
- int mouse_y = HIWORD (msg->lParam);
-
- last_mouse_movement_time = msg->time;
- memcpy (&last_mouse_motion_event, msg, sizeof (last_mouse_motion_event));
- XSETFRAME (last_mouse_motion_frame, frame);
+ struct frame *f;
- if (x_autoselect_window_p)
- {
- int area;
- Lisp_Object window;
- static Lisp_Object last_window;
-
- window = window_from_coordinates (frame, mouse_x, mouse_y, &area, 0);
-
- /* Window will be selected only when it is not selected now and
- last mouse movement event was not in it. Minubuffer window
- will be selected iff it is active. */
- if (!EQ (window, last_window)
- && !EQ (window, selected_window)
- && (!MINI_WINDOW_P (XWINDOW (window))
- || (EQ (window, minibuf_window) && minibuf_level > 0)))
- Fselect_window (window);
-
- last_window=window;
- }
+ if (updating_frame)
+ f = updating_frame;
+ else
+ f = SELECTED_FRAME ();
- if (msg->hwnd != FRAME_W32_WINDOW (frame))
- {
- frame->mouse_moved = 1;
- last_mouse_scroll_bar = Qnil;
- note_mouse_highlight (frame, -1, -1);
- }
+ if (! FRAME_W32_P (f))
+ return;
- /* Has the mouse moved off the glyph it was on at the last sighting? */
- else if (mouse_x < last_mouse_glyph.left
- || mouse_x > last_mouse_glyph.right
- || mouse_y < last_mouse_glyph.top
- || mouse_y > last_mouse_glyph.bottom)
- {
- frame->mouse_moved = 1;
- last_mouse_scroll_bar = Qnil;
- note_mouse_highlight (frame, mouse_x, mouse_y);
- /* Remember the mouse position here, as w32_mouse_position only
- gets called when mouse tracking is enabled but we also need
- to keep track of the mouse for help_echo and highlighting at
- other times. */
- remember_mouse_glyph (frame, mouse_x, mouse_y);
- }
+ abort ();
}
-\f
-/************************************************************************
- Mouse Face
- ************************************************************************/
-/* Find the glyph under window-relative coordinates X/Y in window W.
- Consider only glyphs from buffer text, i.e. no glyphs from overlay
- strings. Return in *HPOS and *VPOS the row and column number of
- the glyph found. Return in *AREA the glyph area containing X.
- Value is a pointer to the glyph found or null if X/Y is not on
- text, or we can't tell because W's current matrix is not up to
- date. */
+/* Clear entire frame. If updating_frame is non-null, clear that
+ frame. Otherwise clear the selected frame. */
-static struct glyph *
-x_y_to_hpos_vpos (w, x, y, hpos, vpos, area, buffer_only_p)
- struct window *w;
- int x, y;
- int *hpos, *vpos, *area;
- int buffer_only_p;
+static void
+x_clear_frame ()
{
- struct glyph *glyph, *end;
- struct glyph_row *row = NULL;
- int x0, i, left_area_width;
-
- /* Find row containing Y. Give up if some row is not enabled. */
- for (i = 0; i < w->current_matrix->nrows; ++i)
- {
- row = MATRIX_ROW (w->current_matrix, i);
- if (!row->enabled_p)
- return NULL;
- if (y >= row->y && y < MATRIX_ROW_BOTTOM_Y (row))
- break;
- }
-
- *vpos = i;
- *hpos = 0;
-
- /* Give up if Y is not in the window. */
- if (i == w->current_matrix->nrows)
- return NULL;
+ struct frame *f;
- /* Get the glyph area containing X. */
- if (w->pseudo_window_p)
- {
- *area = TEXT_AREA;
- x0 = 0;
- }
- else
- {
- left_area_width = window_box_width (w, LEFT_MARGIN_AREA);
- if (x < left_area_width)
- {
- *area = LEFT_MARGIN_AREA;
- x0 = 0;
- }
- else if (x < left_area_width + window_box_width (w, TEXT_AREA))
- {
- *area = TEXT_AREA;
- x0 = row->x + left_area_width;
- }
- else
- {
- *area = RIGHT_MARGIN_AREA;
- x0 = left_area_width + window_box_width (w, TEXT_AREA);
- }
- }
+ if (updating_frame)
+ f = updating_frame;
+ else
+ f = SELECTED_FRAME ();
- /* Find glyph containing X. */
- glyph = row->glyphs[*area];
- end = glyph + row->used[*area];
- while (glyph < end)
- {
- if (x < x0 + glyph->pixel_width)
- {
- if (w->pseudo_window_p)
- break;
- else if (!buffer_only_p || BUFFERP (glyph->object))
- break;
- }
-
- x0 += glyph->pixel_width;
- ++glyph;
- }
+ if (! FRAME_W32_P (f))
+ return;
- if (glyph == end)
- return NULL;
+ /* Clearing the frame will erase any cursor, so mark them all as no
+ longer visible. */
+ mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f)));
+ output_cursor.hpos = output_cursor.vpos = 0;
+ output_cursor.x = -1;
- *hpos = glyph - row->glyphs[*area];
- return glyph;
-}
+ /* We don't set the output cursor here because there will always
+ follow an explicit cursor_to. */
+ BLOCK_INPUT;
+ w32_clear_window (f);
-/* Convert frame-relative x/y to coordinates relative to window W.
- Takes pseudo-windows into account. */
+ /* We have to clear the scroll bars, too. If we have changed
+ colors or something like that, then they should be notified. */
+ x_scroll_bar_clear (f);
-static void
-frame_to_window_pixel_xy (w, x, y)
- struct window *w;
- int *x, *y;
-{
- if (w->pseudo_window_p)
- {
- /* A pseudo-window is always full-width, and starts at the
- left edge of the frame, plus a frame border. */
- struct frame *f = XFRAME (w->frame);
- *x -= FRAME_INTERNAL_BORDER_WIDTH_SAFE (f);
- *y = FRAME_TO_WINDOW_PIXEL_Y (w, *y);
- }
- else
- {
- *x = FRAME_TO_WINDOW_PIXEL_X (w, *x);
- *y = FRAME_TO_WINDOW_PIXEL_Y (w, *y);
- }
+ UNBLOCK_INPUT;
}
-
-/* Take proper action when mouse has moved to the mode or header line of
- window W, x-position X. MODE_LINE_P non-zero means mouse is on the
- mode line. X is relative to the start of the text display area of
- W, so the width of fringes and scroll bars must be subtracted
- to get a position relative to the start of the mode line. */
+\f
+/* Make audible bell. */
static void
-note_mode_line_highlight (w, x, mode_line_p)
- struct window *w;
- int x, mode_line_p;
+w32_ring_bell (void)
{
- struct frame *f = XFRAME (w->frame);
- struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
- Cursor cursor = dpyinfo->vertical_scroll_bar_cursor;
- struct glyph_row *row;
+ struct frame *f;
- if (mode_line_p)
- row = MATRIX_MODE_LINE_ROW (w->current_matrix);
- else
- row = MATRIX_HEADER_LINE_ROW (w->current_matrix);
+ f = SELECTED_FRAME ();
+
+ BLOCK_INPUT;
- if (row->enabled_p)
+ if (FRAME_W32_P (f) && visible_bell)
{
- struct glyph *glyph, *end;
- Lisp_Object help, map;
- int x0;
-
- /* Find the glyph under X. */
- glyph = row->glyphs[TEXT_AREA];
- end = glyph + row->used[TEXT_AREA];
- x0 = - (FRAME_LEFT_SCROLL_BAR_WIDTH (f) * CANON_X_UNIT (f)
- + FRAME_X_LEFT_FRINGE_WIDTH (f));
-
- while (glyph < end
- && x >= x0 + glyph->pixel_width)
- {
- x0 += glyph->pixel_width;
- ++glyph;
- }
+ int i;
+ HWND hwnd = FRAME_W32_WINDOW (SELECTED_FRAME ());
- if (glyph < end
- && STRINGP (glyph->object)
- && XSTRING (glyph->object)->intervals
- && glyph->charpos >= 0
- && glyph->charpos < XSTRING (glyph->object)->size)
+ for (i = 0; i < 5; i++)
{
- /* If we're on a string with `help-echo' text property,
- arrange for the help to be displayed. This is done by
- setting the global variable help_echo to the help string. */
- help = Fget_text_property (make_number (glyph->charpos),
- Qhelp_echo, glyph->object);
- if (!NILP (help))
- {
- help_echo = help;
- XSETWINDOW (help_echo_window, w);
- help_echo_object = glyph->object;
- help_echo_pos = glyph->charpos;
- }
-
- /* Change the mouse pointer according to what is under X/Y. */
- map = Fget_text_property (make_number (glyph->charpos),
- Qlocal_map, glyph->object);
- if (KEYMAPP (map))
- cursor = f->output_data.w32->nontext_cursor;
- else
- {
- map = Fget_text_property (make_number (glyph->charpos),
- Qkeymap, glyph->object);
- if (KEYMAPP (map))
- cursor = f->output_data.w32->nontext_cursor;
- }
+ FlashWindow (hwnd, TRUE);
+ Sleep (10);
}
+ FlashWindow (hwnd, FALSE);
}
+ else
+ w32_sys_ring_bell ();
-#if 0 /* TODO: mouse cursor */
- XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
-#endif
+ UNBLOCK_INPUT;
}
-
-/* Take proper action when the mouse has moved to position X, Y on
- frame F as regards highlighting characters that have mouse-face
- properties. Also de-highlighting chars where the mouse was before.
- X and Y can be negative or out of range. */
+\f
+/* Specify how many text lines, from the top of the window,
+ should be affected by insert-lines and delete-lines operations.
+ This, and those operations, are used only within an update
+ that is bounded by calls to x_update_begin and x_update_end. */
static void
-note_mouse_highlight (f, x, y)
- struct frame *f;
- int x, y;
+w32_set_terminal_window (n)
+ register int n;
{
- struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
- int portion;
- Lisp_Object window;
- struct window *w;
- struct buffer *b;
+ /* This function intentionally left blank. */
+}
- /* When a menu is active, don't highlight because this looks odd. */
- if (popup_activated ())
- return;
+\f
+/***********************************************************************
+ Line Dance
+ ***********************************************************************/
- if (NILP (Vmouse_highlight)
- || !f->glyphs_initialized_p)
- return;
+/* Perform an insert-lines or delete-lines operation, inserting N
+ lines or deleting -N lines at vertical position VPOS. */
- dpyinfo->mouse_face_mouse_x = x;
- dpyinfo->mouse_face_mouse_y = y;
- dpyinfo->mouse_face_mouse_frame = f;
+static void
+x_ins_del_lines (vpos, n)
+ int vpos, n;
+{
+ struct frame *f;
- if (dpyinfo->mouse_face_defer)
- return;
+ if (updating_frame)
+ f = updating_frame;
+ else
+ f = SELECTED_FRAME ();
- if (gc_in_progress)
- {
- dpyinfo->mouse_face_deferred_gc = 1;
- return;
- }
+ if (! FRAME_W32_P (f))
+ return;
- /* Which window is that in? */
- window = window_from_coordinates (f, x, y, &portion, 1);
+ abort ();
+}
- /* If we were displaying active text in another window, clear that. */
- if (! EQ (window, dpyinfo->mouse_face_window))
- clear_mouse_face (dpyinfo);
- /* Not on a window -> return. */
- if (!WINDOWP (window))
- return;
+/* Scroll part of the display as described by RUN. */
- /* Reset help_echo. It will get recomputed below. */
- help_echo = Qnil;
+static void
+x_scroll_run (w, run)
+ struct window *w;
+ struct run *run;
+{
+ struct frame *f = XFRAME (w->frame);
+ int x, y, width, height, from_y, to_y, bottom_y;
+ HWND hwnd = FRAME_W32_WINDOW (f);
+ HRGN expect_dirty;
- /* Convert to window-relative pixel coordinates. */
- w = XWINDOW (window);
- frame_to_window_pixel_xy (w, &x, &y);
+ /* Get frame-relative bounding box of the text display area of W,
+ without mode lines. Include in this box the left and right
+ fringes of W. */
+ window_box (w, -1, &x, &y, &width, &height);
- /* Handle tool-bar window differently since it doesn't display a
- buffer. */
- if (EQ (window, f->tool_bar_window))
- {
- note_tool_bar_highlight (f, x, y);
- return;
- }
+ from_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->current_y);
+ to_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->desired_y);
+ bottom_y = y + height;
- /* Mouse is on the mode or header line? */
- if (portion == 1 || portion == 3)
+ if (to_y < from_y)
{
- note_mode_line_highlight (w, x, portion == 1);
- return;
+ /* Scrolling up. Make sure we don't copy part of the mode
+ line at the bottom. */
+ if (from_y + run->height > bottom_y)
+ height = bottom_y - from_y;
+ else
+ height = run->height;
+ expect_dirty = CreateRectRgn (x, y + height, x + width, bottom_y);
}
-#if 0 /* TODO: mouse cursor */
- if (portion == 2)
- cursor = f->output_data.x->horizontal_drag_cursor;
else
- cursor = f->output_data.x->text_cursor;
-#endif
- /* Are we in a window whose display is up to date?
- And verify the buffer's text has not changed. */
- b = XBUFFER (w->buffer);
- if (/* Within text portion of the window. */
- portion == 0
- && EQ (w->window_end_valid, w->buffer)
- && XFASTINT (w->last_modified) == BUF_MODIFF (b)
- && XFASTINT (w->last_overlay_modified) == BUF_OVERLAY_MODIFF (b))
{
- int hpos, vpos, pos, i, area;
- struct glyph *glyph;
- Lisp_Object object;
- Lisp_Object mouse_face = Qnil, overlay = Qnil, position;
- Lisp_Object *overlay_vec = NULL;
- int len, noverlays;
- struct buffer *obuf;
- int obegv, ozv, same_region;
-
- /* Find the glyph under X/Y. */
- glyph = x_y_to_hpos_vpos (w, x, y, &hpos, &vpos, &area, 0);
-
- /* Clear mouse face if X/Y not over text. */
- if (glyph == NULL
- || area != TEXT_AREA
- || !MATRIX_ROW (w->current_matrix, vpos)->displays_text_p)
- {
- clear_mouse_face (dpyinfo);
- /* TODO: mouse cursor */
- goto set_cursor;
- }
-
- pos = glyph->charpos;
- object = glyph->object;
- if (!STRINGP (object) && !BUFFERP (object))
- goto set_cursor;
-
- /* If we get an out-of-range value, return now; avoid an error. */
- if (BUFFERP (object) && pos > BUF_Z (b))
- goto set_cursor;
-
- /* Make the window's buffer temporarily current for
- overlays_at and compute_char_face. */
- obuf = current_buffer;
- current_buffer = b;
- obegv = BEGV;
- ozv = ZV;
- BEGV = BEG;
- ZV = Z;
-
- /* Is this char mouse-active or does it have help-echo? */
- position = make_number (pos);
-
- if (BUFFERP (object))
- {
- /* Put all the overlays we want in a vector in overlay_vec.
- Store the length in len. If there are more than 10, make
- enough space for all, and try again. */
- len = 10;
- overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
- noverlays = overlays_at (pos, 0, &overlay_vec, &len, NULL, NULL, 0);
- if (noverlays > len)
- {
- len = noverlays;
- overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
- noverlays = overlays_at (pos, 0, &overlay_vec, &len, NULL, NULL,0);
- }
-
- /* Sort overlays into increasing priority order. */
- noverlays = sort_overlays (overlay_vec, noverlays, w);
- }
+ /* Scolling down. Make sure we don't copy over the mode line.
+ at the bottom. */
+ if (to_y + run->height > bottom_y)
+ height = bottom_y - to_y;
else
- noverlays = 0;
-
- same_region = (EQ (window, dpyinfo->mouse_face_window)
- && vpos >= dpyinfo->mouse_face_beg_row
- && vpos <= dpyinfo->mouse_face_end_row
- && (vpos > dpyinfo->mouse_face_beg_row
- || hpos >= dpyinfo->mouse_face_beg_col)
- && (vpos < dpyinfo->mouse_face_end_row
- || hpos < dpyinfo->mouse_face_end_col
- || dpyinfo->mouse_face_past_end));
-
- /* TODO: if (same_region)
- mouse cursor */
-
- /* Check mouse-face highlighting. */
- if (! same_region
- /* If there exists an overlay with mouse-face overlapping
- the one we are currently highlighting, we have to
- check if we enter the overlapping overlay, and then
- highlight that. */
- || (OVERLAYP (dpyinfo->mouse_face_overlay)
- && mouse_face_overlay_overlaps (dpyinfo->mouse_face_overlay)))
- {
- /* Find the highest priority overlay that has a mouse-face
- property. */
- overlay = Qnil;
- for (i = noverlays - 1; i >= 0 && NILP (overlay); --i)
- {
- mouse_face = Foverlay_get (overlay_vec[i], Qmouse_face);
- if (!NILP (mouse_face))
- overlay = overlay_vec[i];
- }
-
- /* If we're actually highlighting the same overlay as
- before, there's no need to do that again. */
- if (!NILP (overlay)
- && EQ (overlay, dpyinfo->mouse_face_overlay))
- goto check_help_echo;
-
- dpyinfo->mouse_face_overlay = overlay;
-
- /* Clear the display of the old active region, if any. */
- clear_mouse_face (dpyinfo);
- /* TODO: mouse cursor changes. */
-
- /* If no overlay applies, get a text property. */
- if (NILP (overlay))
- mouse_face = Fget_text_property (position, Qmouse_face, object);
-
- /* Handle the overlay case. */
- if (!NILP (overlay))
- {
- /* Find the range of text around this char that
- should be active. */
- Lisp_Object before, after;
- int ignore;
-
- before = Foverlay_start (overlay);
- after = Foverlay_end (overlay);
- /* Record this as the current active region. */
- fast_find_position (w, XFASTINT (before),
- &dpyinfo->mouse_face_beg_col,
- &dpyinfo->mouse_face_beg_row,
- &dpyinfo->mouse_face_beg_x,
- &dpyinfo->mouse_face_beg_y, Qnil);
-
- dpyinfo->mouse_face_past_end
- = !fast_find_position (w, XFASTINT (after),
- &dpyinfo->mouse_face_end_col,
- &dpyinfo->mouse_face_end_row,
- &dpyinfo->mouse_face_end_x,
- &dpyinfo->mouse_face_end_y, Qnil);
- dpyinfo->mouse_face_window = window;
-
- dpyinfo->mouse_face_face_id
- = face_at_buffer_position (w, pos, 0, 0,
- &ignore, pos + 1, 1);
-
- /* Display it as active. */
- show_mouse_face (dpyinfo, DRAW_MOUSE_FACE);
- /* TODO: mouse cursor changes. */
- }
- /* Handle the text property case. */
- else if (! NILP (mouse_face) && BUFFERP (object))
- {
- /* Find the range of text around this char that
- should be active. */
- Lisp_Object before, after, beginning, end;
- int ignore;
-
- beginning = Fmarker_position (w->start);
- end = make_number (BUF_Z (XBUFFER (object))
- - XFASTINT (w->window_end_pos));
- before
- = Fprevious_single_property_change (make_number (pos + 1),
- Qmouse_face,
- object, beginning);
- after
- = Fnext_single_property_change (position, Qmouse_face,
- object, end);
-
- /* Record this as the current active region. */
- fast_find_position (w, XFASTINT (before),
- &dpyinfo->mouse_face_beg_col,
- &dpyinfo->mouse_face_beg_row,
- &dpyinfo->mouse_face_beg_x,
- &dpyinfo->mouse_face_beg_y, Qnil);
- dpyinfo->mouse_face_past_end
- = !fast_find_position (w, XFASTINT (after),
- &dpyinfo->mouse_face_end_col,
- &dpyinfo->mouse_face_end_row,
- &dpyinfo->mouse_face_end_x,
- &dpyinfo->mouse_face_end_y, Qnil);
- dpyinfo->mouse_face_window = window;
-
- if (BUFFERP (object))
- dpyinfo->mouse_face_face_id
- = face_at_buffer_position (w, pos, 0, 0,
- &ignore, pos + 1, 1);
-
- /* Display it as active. */
- show_mouse_face (dpyinfo, DRAW_MOUSE_FACE);
- /* TODO: mouse cursor changes. */
- }
- else if (!NILP (mouse_face) && STRINGP (object))
- {
- Lisp_Object b, e;
- int ignore;
-
- b = Fprevious_single_property_change (make_number (pos + 1),
- Qmouse_face,
- object, Qnil);
- e = Fnext_single_property_change (position, Qmouse_face,
- object, Qnil);
- if (NILP (b))
- b = make_number (0);
- if (NILP (e))
- e = make_number (XSTRING (object)->size - 1);
- fast_find_string_pos (w, XINT (b), object,
- &dpyinfo->mouse_face_beg_col,
- &dpyinfo->mouse_face_beg_row,
- &dpyinfo->mouse_face_beg_x,
- &dpyinfo->mouse_face_beg_y, 0);
- fast_find_string_pos (w, XINT (e), object,
- &dpyinfo->mouse_face_end_col,
- &dpyinfo->mouse_face_end_row,
- &dpyinfo->mouse_face_end_x,
- &dpyinfo->mouse_face_end_y, 1);
- dpyinfo->mouse_face_past_end = 0;
- dpyinfo->mouse_face_window = window;
- dpyinfo->mouse_face_face_id
- = face_at_string_position (w, object, pos, 0, 0, 0, &ignore,
- glyph->face_id, 1);
- show_mouse_face (dpyinfo, DRAW_MOUSE_FACE);
- /* TODO: mouse cursor changes. */
- }
- else if (STRINGP (object) && NILP (mouse_face))
- {
- /* A string which doesn't have mouse-face, but
- the text ``under'' it might have. */
- struct glyph_row *r = MATRIX_ROW (w->current_matrix, vpos);
- int start = MATRIX_ROW_START_CHARPOS (r);
-
- pos = string_buffer_position (w, object, start);
- if (pos > 0)
- mouse_face = get_char_property_and_overlay (make_number (pos),
- Qmouse_face,
- w->buffer,
- &overlay);
- if (!NILP (mouse_face) && !NILP (overlay))
- {
- Lisp_Object before = Foverlay_start (overlay);
- Lisp_Object after = Foverlay_end (overlay);
- int ignore;
-
- /* Note that we might not be able to find position
- BEFORE in the glyph matrix if the overlay is
- entirely covered by a `display' property. In
- this case, we overshoot. So let's stop in
- the glyph matrix before glyphs for OBJECT. */
- fast_find_position (w, XFASTINT (before),
- &dpyinfo->mouse_face_beg_col,
- &dpyinfo->mouse_face_beg_row,
- &dpyinfo->mouse_face_beg_x,
- &dpyinfo->mouse_face_beg_y,
- object);
-
- dpyinfo->mouse_face_past_end
- = !fast_find_position (w, XFASTINT (after),
- &dpyinfo->mouse_face_end_col,
- &dpyinfo->mouse_face_end_row,
- &dpyinfo->mouse_face_end_x,
- &dpyinfo->mouse_face_end_y,
- Qnil);
- dpyinfo->mouse_face_window = window;
- dpyinfo->mouse_face_face_id
- = face_at_buffer_position (w, pos, 0, 0,
- &ignore, pos + 1, 1);
-
- /* Display it as active. */
- show_mouse_face (dpyinfo, DRAW_MOUSE_FACE);
- /* TODO: mouse cursor changes. */
- }
- }
- }
+ height = run->height;
+ expect_dirty = CreateRectRgn (x, y, x + width, to_y);
+ }
- check_help_echo:
+ BLOCK_INPUT;
- /* Look for a `help-echo' property. */
- {
- Lisp_Object help, overlay;
+ /* Cursor off. Will be switched on again in x_update_window_end. */
+ updated_window = w;
+ x_clear_cursor (w);
- /* Check overlays first. */
- help = overlay = Qnil;
- for (i = noverlays - 1; i >= 0 && NILP (help); --i)
- {
- overlay = overlay_vec[i];
- help = Foverlay_get (overlay, Qhelp_echo);
- }
+ {
+ RECT from;
+ RECT to;
+ HRGN dirty = CreateRectRgn (0, 0, 0, 0);
+ HRGN combined = CreateRectRgn (0, 0, 0, 0);
- if (!NILP (help))
- {
- help_echo = help;
- help_echo_window = window;
- help_echo_object = overlay;
- help_echo_pos = pos;
- }
- else
- {
- Lisp_Object object = glyph->object;
- int charpos = glyph->charpos;
+ from.left = to.left = x;
+ from.right = to.right = x + width;
+ from.top = from_y;
+ from.bottom = from_y + height;
+ to.top = y;
+ to.bottom = bottom_y;
- /* Try text properties. */
- if (STRINGP (object)
- && charpos >= 0
- && charpos < XSTRING (object)->size)
- {
- help = Fget_text_property (make_number (charpos),
- Qhelp_echo, object);
- if (NILP (help))
- {
- /* If the string itself doesn't specify a help-echo,
- see if the buffer text ``under'' it does. */
- struct glyph_row *r
- = MATRIX_ROW (w->current_matrix, vpos);
- int start = MATRIX_ROW_START_CHARPOS (r);
- int pos = string_buffer_position (w, object, start);
- if (pos > 0)
- {
- help = Fget_char_property (make_number (pos),
- Qhelp_echo, w->buffer);
- if (!NILP (help))
- {
- charpos = pos;
- object = w->buffer;
- }
- }
- }
- }
- else if (BUFFERP (object)
- && charpos >= BEGV
- && charpos < ZV)
- help = Fget_text_property (make_number (charpos), Qhelp_echo,
- object);
-
- if (!NILP (help))
- {
- help_echo = help;
- help_echo_window = window;
- help_echo_object = object;
- help_echo_pos = charpos;
- }
- }
- }
+ ScrollWindowEx (hwnd, 0, to_y - from_y, &from, &to, dirty,
+ NULL, SW_INVALIDATE);
- BEGV = obegv;
- ZV = ozv;
- current_buffer = obuf;
- }
+ /* Combine this with what we expect to be dirty. This covers the
+ case where not all of the region we expect is actually dirty. */
+ CombineRgn (combined, dirty, expect_dirty, RGN_OR);
- set_cursor:
- /* TODO: mouse cursor changes. */
- ;
-}
+ /* If the dirty region is not what we expected, redraw the entire frame. */
+ if (!EqualRgn (combined, expect_dirty))
+ SET_FRAME_GARBAGED (f);
+ }
-static void
-redo_mouse_highlight ()
-{
- if (!NILP (last_mouse_motion_frame)
- && FRAME_LIVE_P (XFRAME (last_mouse_motion_frame)))
- note_mouse_highlight (XFRAME (last_mouse_motion_frame),
- LOWORD (last_mouse_motion_event.lParam),
- HIWORD (last_mouse_motion_event.lParam));
+ UNBLOCK_INPUT;
}
\f
/***********************************************************************
- Tool-bars
+ Exposure Events
***********************************************************************/
-static int x_tool_bar_item P_ ((struct frame *, int, int,
- struct glyph **, int *, int *, int *));
-
-/* Tool-bar item index of the item on which a mouse button was pressed
- or -1. */
-
-static int last_tool_bar_item;
-
-
-/* Get information about the tool-bar item at position X/Y on frame F.
- Return in *GLYPH a pointer to the glyph of the tool-bar item in
- the current matrix of the tool-bar window of F, or NULL if not
- on a tool-bar item. Return in *PROP_IDX the index of the tool-bar
- item in F->tool_bar_items. Value is
-
- -1 if X/Y is not on a tool-bar item
- 0 if X/Y is on the same item that was highlighted before.
- 1 otherwise. */
-
-static int
-x_tool_bar_item (f, x, y, glyph, hpos, vpos, prop_idx)
+static void
+frame_highlight (f)
struct frame *f;
- int x, y;
- struct glyph **glyph;
- int *hpos, *vpos, *prop_idx;
{
- struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
- struct window *w = XWINDOW (f->tool_bar_window);
- int area;
-
- /* Find the glyph under X/Y. */
- *glyph = x_y_to_hpos_vpos (w, x, y, hpos, vpos, &area, 0);
- if (*glyph == NULL)
- return -1;
-
- /* Get the start of this tool-bar item's properties in
- f->tool_bar_items. */
- if (!tool_bar_item_info (f, *glyph, prop_idx))
- return -1;
-
- /* Is mouse on the highlighted item? */
- if (EQ (f->tool_bar_window, dpyinfo->mouse_face_window)
- && *vpos >= dpyinfo->mouse_face_beg_row
- && *vpos <= dpyinfo->mouse_face_end_row
- && (*vpos > dpyinfo->mouse_face_beg_row
- || *hpos >= dpyinfo->mouse_face_beg_col)
- && (*vpos < dpyinfo->mouse_face_end_row
- || *hpos < dpyinfo->mouse_face_end_col
- || dpyinfo->mouse_face_past_end))
- return 0;
-
- return 1;
+ x_update_cursor (f, 1);
}
-
-/* Handle mouse button event on the tool-bar of frame F, at
- frame-relative coordinates X/Y. EVENT_TYPE is either ButtionPress
- or ButtonRelase. */
-
static void
-w32_handle_tool_bar_click (f, button_event)
+frame_unhighlight (f)
struct frame *f;
- struct input_event *button_event;
{
- struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
- struct window *w = XWINDOW (f->tool_bar_window);
- int hpos, vpos, prop_idx;
- struct glyph *glyph;
- Lisp_Object enabled_p;
- int x = XFASTINT (button_event->x);
- int y = XFASTINT (button_event->y);
-
- /* If not on the highlighted tool-bar item, return. */
- frame_to_window_pixel_xy (w, &x, &y);
- if (x_tool_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx) != 0)
- return;
-
- /* If item is disabled, do nothing. */
- enabled_p = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_ENABLED_P);
- if (NILP (enabled_p))
- return;
-
- if (button_event->kind == mouse_click)
- {
- /* Show item in pressed state. */
- show_mouse_face (dpyinfo, DRAW_IMAGE_SUNKEN);
- dpyinfo->mouse_face_image_state = DRAW_IMAGE_SUNKEN;
- last_tool_bar_item = prop_idx;
- }
- else
- {
- Lisp_Object key, frame;
- struct input_event event;
-
- /* Show item in released state. */
- show_mouse_face (dpyinfo, DRAW_IMAGE_RAISED);
- dpyinfo->mouse_face_image_state = DRAW_IMAGE_RAISED;
-
- key = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_KEY);
-
- XSETFRAME (frame, f);
- event.kind = TOOL_BAR_EVENT;
- event.frame_or_window = frame;
- event.arg = frame;
- kbd_buffer_store_event (&event);
-
- event.kind = TOOL_BAR_EVENT;
- event.frame_or_window = frame;
- event.arg = key;
- event.modifiers = button_event->modifiers;
- kbd_buffer_store_event (&event);
- last_tool_bar_item = -1;
- }
+ x_update_cursor (f, 1);
}
-
-/* Possibly highlight a tool-bar item on frame F when mouse moves to
- tool-bar window-relative coordinates X/Y. Called from
- note_mouse_highlight. */
+/* The focus has changed. Update the frames as necessary to reflect
+ the new situation. Note that we can't change the selected frame
+ here, because the Lisp code we are interrupting might become confused.
+ Each event gets marked with the frame in which it occurred, so the
+ Lisp code can tell when the switch took place by examining the events. */
static void
-note_tool_bar_highlight (f, x, y)
- struct frame *f;
- int x, y;
+x_new_focus_frame (dpyinfo, frame)
+ struct w32_display_info *dpyinfo;
+ struct frame *frame;
{
- Lisp_Object window = f->tool_bar_window;
- struct window *w = XWINDOW (window);
- struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
- int hpos, vpos;
- struct glyph *glyph;
- struct glyph_row *row;
- int i;
- Lisp_Object enabled_p;
- int prop_idx;
- enum draw_glyphs_face draw = DRAW_IMAGE_RAISED;
- int mouse_down_p, rc;
-
- /* Function note_mouse_highlight is called with negative x(y
- values when mouse moves outside of the frame. */
- if (x <= 0 || y <= 0)
- {
- clear_mouse_face (dpyinfo);
- return;
- }
+ struct frame *old_focus = dpyinfo->w32_focus_frame;
- rc = x_tool_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx);
- if (rc < 0)
+ if (frame != dpyinfo->w32_focus_frame)
{
- /* Not on tool-bar item. */
- clear_mouse_face (dpyinfo);
- return;
- }
- else if (rc == 0)
- /* On same tool-bar item as before. */
- goto set_help_echo;
-
- clear_mouse_face (dpyinfo);
-
- /* Mouse is down, but on different tool-bar item? */
- mouse_down_p = (dpyinfo->grabbed
- && f == last_mouse_frame
- && FRAME_LIVE_P (f));
- if (mouse_down_p
- && last_tool_bar_item != prop_idx)
- return;
+ /* Set this before calling other routines, so that they see
+ the correct value of w32_focus_frame. */
+ dpyinfo->w32_focus_frame = frame;
- dpyinfo->mouse_face_image_state = DRAW_NORMAL_TEXT;
- draw = mouse_down_p ? DRAW_IMAGE_SUNKEN : DRAW_IMAGE_RAISED;
-
- /* If tool-bar item is not enabled, don't highlight it. */
- enabled_p = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_ENABLED_P);
- if (!NILP (enabled_p))
- {
- /* Compute the x-position of the glyph. In front and past the
- image is a space. We include this is the highlighted area. */
- row = MATRIX_ROW (w->current_matrix, vpos);
- for (i = x = 0; i < hpos; ++i)
- x += row->glyphs[TEXT_AREA][i].pixel_width;
-
- /* Record this as the current active region. */
- dpyinfo->mouse_face_beg_col = hpos;
- dpyinfo->mouse_face_beg_row = vpos;
- dpyinfo->mouse_face_beg_x = x;
- dpyinfo->mouse_face_beg_y = row->y;
- dpyinfo->mouse_face_past_end = 0;
-
- dpyinfo->mouse_face_end_col = hpos + 1;
- dpyinfo->mouse_face_end_row = vpos;
- dpyinfo->mouse_face_end_x = x + glyph->pixel_width;
- dpyinfo->mouse_face_end_y = row->y;
- dpyinfo->mouse_face_window = window;
- dpyinfo->mouse_face_face_id = TOOL_BAR_FACE_ID;
-
- /* Display it as active. */
- show_mouse_face (dpyinfo, draw);
- dpyinfo->mouse_face_image_state = draw;
- }
-
- set_help_echo:
-
- /* Set help_echo to a help string.to display for this tool-bar item.
- w32_read_socket does the rest. */
- help_echo_object = help_echo_window = Qnil;
- help_echo_pos = -1;
- help_echo = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_HELP);
- if (NILP (help_echo))
- help_echo = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_CAPTION);
-}
+ if (old_focus && old_focus->auto_lower)
+ x_lower_frame (old_focus);
-\f
-/* Find the glyph matrix position of buffer position CHARPOS in window
- *W. HPOS, *VPOS, *X, and *Y are set to the positions found. W's
- current glyphs must be up to date. If CHARPOS is above window
- start return (0, 0, 0, 0). If CHARPOS is after end of W, return end
- of last line in W. In the row containing CHARPOS, stop before glyphs
- having STOP as object. */
-
-#if 0 /* This is a version of fast_find_position that's more correct
- in the presence of hscrolling, for example. I didn't install
- it right away because the problem fixed is minor, it failed
- in 20.x as well, and I think it's too risky to install
- so near the release of 21.1. 2001-09-25 gerd. */
-static int
-fast_find_position (w, charpos, hpos, vpos, x, y, stop)
- struct window *w;
- int charpos;
- int *hpos, *vpos, *x, *y;
- Lisp_Object stop;
-{
- struct glyph_row *row, *first;
- struct glyph *glyph, *end;
- int i, past_end = 0;
- first = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
- row = row_containing_pos (w, charpos, first, NULL, 0);
- if (row == NULL)
- {
- if (charpos < MATRIX_ROW_START_CHARPOS (first))
- {
- *x = *y = *hpos = *vpos = 0;
- return 0;
- }
- else
- {
- row = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos));
- past_end = 1;
- }
- }
- *x = row->x;
- *y = row->y;
- *vpos = MATRIX_ROW_VPOS (row, w->current_matrix);
-
- glyph = row->glyphs[TEXT_AREA];
- end = glyph + row->used[TEXT_AREA];
-
- /* Skip over glyphs not having an object at the start of the row.
- These are special glyphs like truncation marks on terminal
- frames. */
- if (row->displays_text_p)
- while (glyph < end
- && INTEGERP (glyph->object)
- && !EQ (stop, glyph->object)
- && glyph->charpos < 0)
- {
- *x += glyph->pixel_width;
- ++glyph;
- }
- while (glyph < end
- && !INTEGERP (glyph->object)
- && !EQ (stop, glyph->object)
- && (!BUFFERP (glyph->object)
- || glyph->charpos < charpos))
- {
- *x += glyph->pixel_width;
- ++glyph;
+
+
+
+ if (dpyinfo->w32_focus_frame && dpyinfo->w32_focus_frame->auto_raise)
+ pending_autoraise_frame = dpyinfo->w32_focus_frame;
+ else
+ pending_autoraise_frame = 0;
}
- *hpos = glyph - row->glyphs[TEXT_AREA];
- return past_end;
+ x_frame_rehighlight (dpyinfo);
}
-#else /* not 0 */
+/* Handle an event saying the mouse has moved out of an Emacs frame. */
-static int
-fast_find_position (w, pos, hpos, vpos, x, y, stop)
- struct window *w;
- int pos;
- int *hpos, *vpos, *x, *y;
- Lisp_Object stop;
+void
+x_mouse_leave (dpyinfo)
+ struct w32_display_info *dpyinfo;
{
- int i;
- int lastcol;
- int maybe_next_line_p = 0;
- int line_start_position;
- int yb = window_text_bottom_y (w);
- struct glyph_row *row, *best_row;
- int row_vpos, best_row_vpos;
- int current_x;
-
- row = best_row = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
- row_vpos = best_row_vpos = MATRIX_ROW_VPOS (row, w->current_matrix);
-
- while (row->y < yb)
- {
- if (row->used[TEXT_AREA])
- line_start_position = row->glyphs[TEXT_AREA]->charpos;
- else
- line_start_position = 0;
+ x_new_focus_frame (dpyinfo, dpyinfo->w32_focus_event_frame);
+}
- if (line_start_position > pos)
- break;
- /* If the position sought is the end of the buffer,
- don't include the blank lines at the bottom of the window. */
- else if (line_start_position == pos
- && pos == BUF_ZV (XBUFFER (w->buffer)))
- {
- maybe_next_line_p = 1;
- break;
- }
- else if (line_start_position > 0)
- {
- best_row = row;
- best_row_vpos = row_vpos;
- }
+/* The focus has changed, or we have redirected a frame's focus to
+ another frame (this happens when a frame uses a surrogate
+ mini-buffer frame). Shift the highlight as appropriate.
- if (row->y + row->height >= yb)
- break;
+ The FRAME argument doesn't necessarily have anything to do with which
+ frame is being highlighted or un-highlighted; we only use it to find
+ the appropriate X display info. */
- ++row;
- ++row_vpos;
- }
+static void
+w32_frame_rehighlight (frame)
+ struct frame *frame;
+{
+ if (! FRAME_W32_P (frame))
+ return;
+ x_frame_rehighlight (FRAME_W32_DISPLAY_INFO (frame));
+}
- /* Find the right column within BEST_ROW. */
- lastcol = 0;
- current_x = best_row->x;
- for (i = 0; i < best_row->used[TEXT_AREA]; i++)
- {
- struct glyph *glyph = best_row->glyphs[TEXT_AREA] + i;
- int charpos = glyph->charpos;
+static void
+x_frame_rehighlight (dpyinfo)
+ struct w32_display_info *dpyinfo;
+{
+ struct frame *old_highlight = dpyinfo->x_highlight_frame;
- if (BUFFERP (glyph->object))
+ if (dpyinfo->w32_focus_frame)
+ {
+ dpyinfo->x_highlight_frame
+ = ((GC_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))
{
- if (charpos == pos)
- {
- *hpos = i;
- *vpos = best_row_vpos;
- *x = current_x;
- *y = best_row->y;
- return 1;
- }
- else if (charpos > pos)
- break;
+ FRAME_FOCUS_FRAME (dpyinfo->w32_focus_frame) = Qnil;
+ dpyinfo->x_highlight_frame = dpyinfo->w32_focus_frame;
}
- else if (EQ (glyph->object, stop))
- break;
-
- if (charpos > 0)
- lastcol = i;
- current_x += glyph->pixel_width;
}
+ else
+ dpyinfo->x_highlight_frame = 0;
- /* If we're looking for the end of the buffer,
- and we didn't find it in the line we scanned,
- use the start of the following line. */
- if (maybe_next_line_p)
+ if (dpyinfo->x_highlight_frame != old_highlight)
{
- ++best_row;
- ++best_row_vpos;
- lastcol = 0;
- current_x = best_row->x;
+ if (old_highlight)
+ frame_unhighlight (old_highlight);
+ if (dpyinfo->x_highlight_frame)
+ frame_highlight (dpyinfo->x_highlight_frame);
}
-
- *vpos = best_row_vpos;
- *hpos = lastcol + 1;
- *x = current_x;
- *y = best_row->y;
- return 0;
}
+\f
+/* Keyboard processing - modifier keys, etc. */
-#endif /* not 0 */
+/* Convert a keysym to its name. */
+char *
+x_get_keysym_name (keysym)
+ int keysym;
+{
+ /* Make static so we can always return it */
+ static char value[100];
-/* Find the position of the glyph for position POS in OBJECT in
- window W's current matrix, and return in *X/*Y the pixel
- coordinates, and return in *HPOS/*VPOS the column/row of the glyph.
+ BLOCK_INPUT;
+ GetKeyNameText (keysym, value, 100);
+ UNBLOCK_INPUT;
- RIGHT_P non-zero means return the position of the right edge of the
- glyph, RIGHT_P zero means return the left edge position.
+ return value;
+}
- If no glyph for POS exists in the matrix, return the position of
- the glyph with the next smaller position that is in the matrix, if
- RIGHT_P is zero. If RIGHT_P is non-zero, and no glyph for POS
- exists in the matrix, return the position of the glyph with the
- next larger position in OBJECT.
- Value is non-zero if a glyph was found. */
+\f
+/* Mouse clicks and mouse movement. Rah. */
-static int
-fast_find_string_pos (w, pos, object, hpos, vpos, x, y, right_p)
- struct window *w;
- int pos;
- Lisp_Object object;
- int *hpos, *vpos, *x, *y;
- int right_p;
-{
- int yb = window_text_bottom_y (w);
- struct glyph_row *r;
- struct glyph *best_glyph = NULL;
- struct glyph_row *best_row = NULL;
- int best_x = 0;
-
- for (r = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
- r->enabled_p && r->y < yb;
- ++r)
- {
- struct glyph *g = r->glyphs[TEXT_AREA];
- struct glyph *e = g + r->used[TEXT_AREA];
- int gx;
+/* Parse a button MESSAGE. The button index is returned in PBUTTON, and
+ the state in PUP. XBUTTON provides extra information for extended mouse
+ button messages. Returns FALSE if unable to parse the message. */
+BOOL
+parse_button (message, xbutton, pbutton, pup)
+ int message;
+ int xbutton;
+ int * pbutton;
+ int * pup;
+{
+ int button = 0;
+ int up = 0;
- for (gx = r->x; g < e; gx += g->pixel_width, ++g)
- if (EQ (g->object, object))
- {
- if (g->charpos == pos)
- {
- best_glyph = g;
- best_x = gx;
- best_row = r;
- goto found;
- }
- else if (best_glyph == NULL
- || ((abs (g->charpos - pos)
- < abs (best_glyph->charpos - pos))
- && (right_p
- ? g->charpos < pos
- : g->charpos > pos)))
- {
- best_glyph = g;
- best_x = gx;
- best_row = r;
- }
- }
+ switch (message)
+ {
+ case WM_LBUTTONDOWN:
+ button = 0;
+ up = 0;
+ break;
+ case WM_LBUTTONUP:
+ button = 0;
+ up = 1;
+ break;
+ case WM_MBUTTONDOWN:
+ if (NILP (Vw32_swap_mouse_buttons))
+ button = 1;
+ else
+ button = 2;
+ up = 0;
+ break;
+ case WM_MBUTTONUP:
+ if (NILP (Vw32_swap_mouse_buttons))
+ button = 1;
+ else
+ button = 2;
+ up = 1;
+ break;
+ case WM_RBUTTONDOWN:
+ if (NILP (Vw32_swap_mouse_buttons))
+ button = 2;
+ else
+ button = 1;
+ up = 0;
+ break;
+ case WM_RBUTTONUP:
+ if (NILP (Vw32_swap_mouse_buttons))
+ button = 2;
+ else
+ button = 1;
+ up = 1;
+ break;
+ case WM_XBUTTONDOWN:
+ button = xbutton + 2;
+ up = 0;
+ break;
+ case WM_XBUTTONUP:
+ button = xbutton + 2;
+ up = 1;
+ break;
+ default:
+ return (FALSE);
}
- found:
+ if (pup) *pup = up;
+ if (pbutton) *pbutton = button;
- if (best_glyph)
- {
- *x = best_x;
- *hpos = best_glyph - best_row->glyphs[TEXT_AREA];
+ return (TRUE);
+}
- if (right_p)
- {
- *x += best_glyph->pixel_width;
- ++*hpos;
- }
-
- *y = best_row->y;
- *vpos = best_row - w->current_matrix->rows;
- }
- return best_glyph != NULL;
-}
+/* Prepare a mouse-event in *RESULT for placement in the input queue.
+ If the event is a button press, then note that we have grabbed
+ the mouse. */
-/* Display the active region described by mouse_face_*
- in its mouse-face if HL > 0, in its normal face if HL = 0. */
+static Lisp_Object
+construct_mouse_click (result, msg, f)
+ struct input_event *result;
+ W32Msg *msg;
+ struct frame *f;
+{
+ int button;
+ int up;
-static void
-show_mouse_face (dpyinfo, draw)
- struct w32_display_info *dpyinfo;
- enum draw_glyphs_face draw;
+ parse_button (msg->msg.message, HIWORD (msg->msg.wParam),
+ &button, &up);
+
+ /* Make the event type NO_EVENT; we'll change that when we decide
+ otherwise. */
+ result->kind = MOUSE_CLICK_EVENT;
+ result->code = button;
+ result->timestamp = msg->msg.time;
+ result->modifiers = (msg->dwModifiers
+ | (up
+ ? up_modifier
+ : down_modifier));
+
+ XSETINT (result->x, LOWORD (msg->msg.lParam));
+ XSETINT (result->y, HIWORD (msg->msg.lParam));
+ XSETFRAME (result->frame_or_window, f);
+ result->arg = Qnil;
+ return Qnil;
+}
+
+static Lisp_Object
+construct_mouse_wheel (result, msg, f)
+ struct input_event *result;
+ W32Msg *msg;
+ struct frame *f;
{
- struct window *w = XWINDOW (dpyinfo->mouse_face_window);
- struct frame *f = XFRAME (WINDOW_FRAME (w));
-
- if (/* If window is in the process of being destroyed, don't bother
- to do anything. */
- w->current_matrix != NULL
- /* Don't update mouse highlight if hidden */
- && (draw != DRAW_MOUSE_FACE || !dpyinfo->mouse_face_hidden)
- /* Recognize when we are called to operate on rows that don't exist
- anymore. This can happen when a window is split. */
- && dpyinfo->mouse_face_end_row < w->current_matrix->nrows)
- {
- int phys_cursor_on_p = w->phys_cursor_on_p;
- struct glyph_row *row, *first, *last;
+ POINT p;
+ int delta;
- first = MATRIX_ROW (w->current_matrix, dpyinfo->mouse_face_beg_row);
- last = MATRIX_ROW (w->current_matrix, dpyinfo->mouse_face_end_row);
-
- for (row = first; row <= last && row->enabled_p; ++row)
- {
- int start_hpos, end_hpos, start_x;
+ result->kind = WHEEL_EVENT;
+ result->code = 0;
+ result->timestamp = msg->msg.time;
- /* For all but the first row, the highlight starts at column 0. */
- if (row == first)
- {
- start_hpos = dpyinfo->mouse_face_beg_col;
- start_x = dpyinfo->mouse_face_beg_x;
- }
- else
- {
- start_hpos = 0;
- start_x = 0;
- }
+ /* A WHEEL_DELTA positive value indicates that the wheel was rotated
+ forward, away from the user (up); a negative value indicates that
+ the wheel was rotated backward, toward the user (down). */
+ delta = GET_WHEEL_DELTA_WPARAM (msg->msg.wParam);
- if (row == last)
- end_hpos = dpyinfo->mouse_face_end_col;
- else
- end_hpos = row->used[TEXT_AREA];
+ /* The up and down modifiers indicate if the wheel was rotated up or
+ down based on WHEEL_DELTA value. */
+ result->modifiers = (msg->dwModifiers
+ | ((delta < 0 ) ? down_modifier : up_modifier));
- if (end_hpos > start_hpos)
- {
- x_draw_glyphs (w, start_x, row, TEXT_AREA,
- start_hpos, end_hpos, draw, 0);
+ p.x = LOWORD (msg->msg.lParam);
+ p.y = HIWORD (msg->msg.lParam);
+ ScreenToClient (msg->msg.hwnd, &p);
+ XSETINT (result->x, p.x);
+ XSETINT (result->y, p.y);
+ XSETFRAME (result->frame_or_window, f);
+ result->arg = Qnil;
+ return Qnil;
+}
+
+static Lisp_Object
+construct_drag_n_drop (result, msg, f)
+ struct input_event *result;
+ W32Msg *msg;
+ struct frame *f;
+{
+ Lisp_Object files;
+ Lisp_Object frame;
+ HDROP hdrop;
+ POINT p;
+ WORD num_files;
+ char *name;
+ int i, len;
- row->mouse_face_p
- = draw == DRAW_MOUSE_FACE || draw == DRAW_IMAGE_RAISED;
- }
- }
+ result->kind = DRAG_N_DROP_EVENT;
+ result->code = 0;
+ result->timestamp = msg->msg.time;
+ result->modifiers = msg->dwModifiers;
- /* When we've written over the cursor, arrange for it to
- be displayed again. */
- if (phys_cursor_on_p && !w->phys_cursor_on_p)
- x_display_cursor (w, 1,
- w->phys_cursor.hpos, w->phys_cursor.vpos,
- w->phys_cursor.x, w->phys_cursor.y);
- }
+ hdrop = (HDROP) msg->msg.wParam;
+ DragQueryPoint (hdrop, &p);
-#if 0 /* TODO: mouse cursor */
- /* Change the mouse cursor. */
- if (draw == DRAW_NORMAL_TEXT)
- XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- f->output_data.x->text_cursor);
- else if (draw == DRAW_MOUSE_FACE)
- XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- f->output_data.x->cross_cursor);
- else
- XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- f->output_data.x->nontext_cursor);
+#if 0
+ p.x = LOWORD (msg->msg.lParam);
+ p.y = HIWORD (msg->msg.lParam);
+ ScreenToClient (msg->msg.hwnd, &p);
#endif
-}
-/* Clear out the mouse-highlighted active region.
- Redraw it un-highlighted first. */
+ XSETINT (result->x, p.x);
+ XSETINT (result->y, p.y);
-static int
-clear_mouse_face (dpyinfo)
- struct w32_display_info *dpyinfo;
-{
- int cleared = 0;
+ num_files = DragQueryFile (hdrop, 0xFFFFFFFF, NULL, 0);
+ files = Qnil;
- if (! NILP (dpyinfo->mouse_face_window))
+ for (i = 0; i < num_files; i++)
{
- show_mouse_face (dpyinfo, DRAW_NORMAL_TEXT);
- cleared = 1;
+ len = DragQueryFile (hdrop, i, NULL, 0);
+ if (len <= 0)
+ continue;
+ name = alloca (len + 1);
+ DragQueryFile (hdrop, i, name, len + 1);
+ files = Fcons (DECODE_FILE (build_string (name)), files);
}
- dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1;
- dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1;
- dpyinfo->mouse_face_window = Qnil;
- dpyinfo->mouse_face_overlay = Qnil;
- return cleared;
+ DragFinish (hdrop);
+
+ XSETFRAME (frame, f);
+ result->frame_or_window = Fcons (frame, files);
+ result->arg = Qnil;
+ return Qnil;
}
+\f
+/* Function to report a mouse movement to the mainstream Emacs code.
+ The input handler calls this.
-/* Clear any mouse-face on window W. This function is part of the
- redisplay interface, and is called from try_window_id and similar
- functions to ensure the mouse-highlight is off. */
+ We have received a mouse movement event, which is given in *event.
+ If the mouse is over a different glyph than it was last time, tell
+ the mainstream emacs code by setting mouse_moved. If not, ask for
+ another motion event, so we can check again the next time it moves. */
-static void
-x_clear_mouse_face (w)
- struct window *w;
-{
- struct w32_display_info *dpyinfo
- = FRAME_W32_DISPLAY_INFO (XFRAME (w->frame));
- Lisp_Object window;
+static MSG last_mouse_motion_event;
+static Lisp_Object last_mouse_motion_frame;
- BLOCK_INPUT;
- XSETWINDOW (window, w);
- if (EQ (window, dpyinfo->mouse_face_window))
- clear_mouse_face (dpyinfo);
- UNBLOCK_INPUT;
-}
+static void remember_mouse_glyph P_ ((struct frame *, int, int));
+static void
+note_mouse_movement (frame, msg)
+ FRAME_PTR frame;
+ MSG *msg;
+{
+ int mouse_x = LOWORD (msg->lParam);
+ int mouse_y = HIWORD (msg->lParam);
-/* Just discard the mouse face information for frame F, if any.
- This is used when the size of F is changed. */
+ last_mouse_movement_time = msg->time;
+ memcpy (&last_mouse_motion_event, msg, sizeof (last_mouse_motion_event));
+ XSETFRAME (last_mouse_motion_frame, frame);
-void
-cancel_mouse_face (f)
- FRAME_PTR f;
-{
- Lisp_Object window;
- struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
+ if (msg->hwnd != FRAME_W32_WINDOW (frame))
+ {
+ frame->mouse_moved = 1;
+ last_mouse_scroll_bar = Qnil;
+ note_mouse_highlight (frame, -1, -1);
+ }
- window = dpyinfo->mouse_face_window;
- if (! NILP (window) && XFRAME (XWINDOW (window)->frame) == f)
+ /* Has the mouse moved off the glyph it was on at the last sighting? */
+ else if (mouse_x < last_mouse_glyph.left
+ || mouse_x > last_mouse_glyph.right
+ || mouse_y < last_mouse_glyph.top
+ || mouse_y > last_mouse_glyph.bottom)
{
- dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1;
- dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1;
- dpyinfo->mouse_face_window = Qnil;
+ frame->mouse_moved = 1;
+ last_mouse_scroll_bar = Qnil;
+ note_mouse_highlight (frame, mouse_x, mouse_y);
+ /* Remember the mouse position here, as w32_mouse_position only
+ gets called when mouse tracking is enabled but we also need
+ to keep track of the mouse for help_echo and highlighting at
+ other times. */
+ remember_mouse_glyph (frame, mouse_x, mouse_y);
}
}
+
\f
+/************************************************************************
+ Mouse Face
+ ************************************************************************/
+
static struct scroll_bar *x_window_to_scroll_bar ();
static void x_scroll_bar_report_motion ();
static void x_check_fullscreen P_ ((struct frame *));
static int glyph_rect P_ ((struct frame *f, int, int, RECT *));
+static void
+redo_mouse_highlight ()
+{
+ if (!NILP (last_mouse_motion_frame)
+ && FRAME_LIVE_P (XFRAME (last_mouse_motion_frame)))
+ note_mouse_highlight (XFRAME (last_mouse_motion_frame),
+ LOWORD (last_mouse_motion_event.lParam),
+ HIWORD (last_mouse_motion_event.lParam));
+}
+
+void
+w32_define_cursor (window, cursor)
+ Window window;
+ Cursor cursor;
+{
+ PostMessage (window, WM_EMACS_SETCURSOR, (WPARAM) cursor, 0);
+}
+
/* Try to determine frame pixel position and size of the glyph under
frame pixel coordinates X/Y on frame F . Return the position and
size in *RECT. Value is non-zero if we could compute these
RECT *rect;
{
Lisp_Object window;
- int part;
- window = window_from_coordinates (f, x, y, &part, 0);
+ window = window_from_coordinates (f, x, y, 0, &x, &y, 0);
+
if (!NILP (window))
{
struct window *w = XWINDOW (window);
struct glyph_row *r = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
struct glyph_row *end = r + w->current_matrix->nrows - 1;
- frame_to_window_pixel_xy (w, &x, &y);
-
for (; r < end && r->enabled_p; ++r)
if (r->y <= y && r->y + r->height > y)
{
if (x < r->x)
{
/* x is to the left of the first glyph in the row. */
- rect->left = XINT (w->left);
+ /* Shouldn't this be a pixel value?
+ WINDOW_LEFT_EDGE_X (w) seems to be the right value.
+ ++KFS */
+ rect->left = WINDOW_LEFT_EDGE_COL (w);
rect->right = WINDOW_TO_FRAME_PIXEL_X (w, r->x);
return 1;
}
/* x is to the right of the last glyph in the row. */
rect->left = WINDOW_TO_FRAME_PIXEL_X (w, gx);
- rect->right = XINT (w->left) + XINT (w->width);
+ /* Shouldn't this be a pixel value?
+ WINDOW_RIGHT_EDGE_X (w) seems to be the right value.
+ ++KFS */
+ rect->right = WINDOW_RIGHT_EDGE_COL (w);
return 1;
}
}
int width = FRAME_SMALLEST_CHAR_WIDTH (f1);
int height = FRAME_SMALLEST_FONT_HEIGHT (f1);
- /* Arrange for the division in PIXEL_TO_CHAR_COL etc. to
+ /* Arrange for the division in FRAME_PIXEL_X_TO_COL etc. to
round down even for negative values. */
if (gx < 0)
gx -= width - 1;
XFRAME (frame)->mouse_moved = 0;
last_mouse_scroll_bar = Qnil;
-
+
GetCursorPos (&pt);
/* Now we have a position on the root; find the innermost window
}
\f
+/***********************************************************************
+ Tool-bars
+ ***********************************************************************/
+
+/* Handle mouse button event on the tool-bar of frame F, at
+ frame-relative coordinates X/Y. EVENT_TYPE is either ButtionPress
+ or ButtonRelase. */
+
+static void
+w32_handle_tool_bar_click (f, button_event)
+ struct frame *f;
+ struct input_event *button_event;
+{
+ int x = XFASTINT (button_event->x);
+ int y = XFASTINT (button_event->y);
+
+ if (button_event->modifiers & down_modifier)
+ handle_tool_bar_click (f, x, y, 1, 0);
+ else
+ handle_tool_bar_click (f, x, y, 0,
+ button_event->modifiers & ~up_modifier);
+}
+
+
+\f
+/***********************************************************************
+ Scroll bars
+ ***********************************************************************/
+
/* Scroll bar support. */
/* Given a window ID, find the struct scroll_bar which manages it.
/************************************************************************
Scroll bars, general
************************************************************************/
-
-HWND
+
+HWND
my_create_scrollbar (f, bar)
struct frame * f;
struct scroll_bar * bar;
{
return (HWND) SendMessage (FRAME_W32_WINDOW (f),
- WM_EMACS_CREATESCROLLBAR, (WPARAM) f,
+ WM_EMACS_CREATESCROLLBAR, (WPARAM) f,
(LPARAM) bar);
}
struct frame * f;
HWND hwnd;
{
- SendMessage (FRAME_W32_WINDOW (f), WM_EMACS_SETFOCUS,
+ SendMessage (FRAME_W32_WINDOW (f), WM_EMACS_SETFOCUS,
(WPARAM) hwnd, 0);
}
struct frame * f;
HWND hwnd;
{
- SendMessage (FRAME_W32_WINDOW (f), WM_EMACS_DESTROYWINDOW,
+ SendMessage (FRAME_W32_WINDOW (f), WM_EMACS_DESTROYWINDOW,
(WPARAM) hwnd, 0);
}
struct frame *f = XFRAME (w->frame);
struct scroll_bar *bar;
int top, height, left, sb_left, width, sb_width;
- int window_x, window_y, window_width, window_height;
+ int window_y, window_height;
/* Get window dimensions. */
- window_box (w, -1, &window_x, &window_y, &window_width, &window_height);
+ window_box (w, -1, 0, &window_y, 0, &window_height);
top = window_y;
- width = FRAME_SCROLL_BAR_COLS (f) * CANON_X_UNIT (f);
+ width = WINDOW_CONFIG_SCROLL_BAR_COLS (w) * FRAME_COLUMN_WIDTH (f);
height = window_height;
/* Compute the left edge of the scroll bar area. */
- if (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
- left = XINT (w->left) + XINT (w->width) - FRAME_SCROLL_BAR_COLS (f);
- else
- left = XFASTINT (w->left);
- left *= CANON_X_UNIT (f);
- left += FRAME_INTERNAL_BORDER_WIDTH (f);
+ left = WINDOW_SCROLL_BAR_AREA_X (w);
/* Compute the width of the scroll bar which might be less than
the width of the area reserved for the scroll bar. */
- if (FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0)
- sb_width = FRAME_SCROLL_BAR_PIXEL_WIDTH (f);
+ if (WINDOW_CONFIG_SCROLL_BAR_WIDTH (w) > 0)
+ sb_width = WINDOW_CONFIG_SCROLL_BAR_WIDTH (w);
else
sb_width = width;
/* Compute the left edge of the scroll bar. */
- if (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
- sb_left = left + width - sb_width - (width - sb_width) / 2;
+ if (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w))
+ sb_left = left + width - sb_width - (width - sb_width) / 2;
else
sb_left = left + (width - sb_width) / 2;
}
else
{
- /* It may just need to be moved and resized. */
+ /* It may just need to be moved and resized. */
HWND hwnd;
bar = XSCROLL_BAR (w->vertical_scroll_bar);
}
/* Handle a mouse click on the scroll bar BAR. If *EMACS_EVENT's kind
- is set to something other than no_event, it is enqueued.
+ is set to something other than NO_EVENT, it is enqueued.
This may be called from a signal handler, so we have to ignore GC
mark bits. */
if (! GC_WINDOWP (bar->window))
abort ();
- emacs_event->kind = w32_scroll_bar_click;
+ emacs_event->kind = W32_SCROLL_BAR_CLICK_EVENT;
emacs_event->code = 0;
/* not really meaningful to distinguish up/down */
emacs_event->modifiers = msg->dwModifiers;
last_mouse_scroll_bar_pos = msg->msg.wParam;
-
+
switch (LOWORD (msg->msg.wParam))
{
case SB_LINEDOWN:
}
/* fall through */
default:
- emacs_event->kind = no_event;
+ emacs_event->kind = NO_EVENT;
return FALSE;
}
We return the number of characters stored into the buffer,
thus pretending to be `read'.
- EXPECTED is nonzero if the caller knows input is available.
+ EXPECTED is nonzero if the caller knows input is available.
Some of these messages are reposted back to the message queue since the
- system calls the windows proc directly in a context where we cannot return
+ system calls the windows proc directly in a context where we cannot return
the data nor can we guarantee the state we are in. So if we dispatch them
we will get into an infinite loop. To prevent this from ever happening we
will set a variable to indicate we are in the read_socket call and indicate
- which message we are processing since the windows proc gets called
+ which message we are processing since the windows proc gets called
recursively with different messages by the system.
*/
case WM_PAINT:
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
- if (f)
+ if (f)
{
if (msg.rect.right == msg.rect.left ||
msg.rect.bottom == msg.rect.top)
/* We may get paint messages even though the client
area is clipped - these are not expose events. */
DebPrint (("clipped frame %p (%s) got WM_PAINT - ignored\n", f,
- XSTRING (f->name)->data));
+ SDATA (f->name)));
}
else if (f->async_visible != 1)
{
f->async_iconified = 0;
SET_FRAME_GARBAGED (f);
DebPrint (("frame %p (%s) reexposed by WM_PAINT\n", f,
- XSTRING (f->name)->data));
+ SDATA (f->name)));
/* WM_PAINT serves as MapNotify as well, so report
visibility changes properly. */
if (f->iconified)
{
- bufp->kind = deiconify_event;
+ bufp->kind = DEICONIFY_EVENT;
XSETFRAME (bufp->frame_or_window, f);
bufp->arg = Qnil;
bufp++;
{
if (numchars == 0)
abort ();
-
- bufp->kind = language_change_event;
+
+ bufp->kind = LANGUAGE_CHANGE_EVENT;
XSETFRAME (bufp->frame_or_window, f);
bufp->arg = Qnil;
bufp->code = msg.msg.wParam;
case WM_KEYDOWN:
case WM_SYSKEYDOWN:
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
-
+
if (f && !f->iconified)
{
if (!dpyinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight))
if (temp_index == sizeof temp_buffer / sizeof (short))
temp_index = 0;
temp_buffer[temp_index++] = msg.msg.wParam;
- bufp->kind = non_ascii_keystroke;
+ bufp->kind = NON_ASCII_KEYSTROKE_EVENT;
bufp->code = msg.msg.wParam;
bufp->modifiers = msg.dwModifiers;
XSETFRAME (bufp->frame_or_window, f);
case WM_SYSCHAR:
case WM_CHAR:
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
-
+
if (f && !f->iconified)
{
if (!dpyinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight))
if (temp_index == sizeof temp_buffer / sizeof (short))
temp_index = 0;
temp_buffer[temp_index++] = msg.msg.wParam;
- bufp->kind = ascii_keystroke;
+ bufp->kind = ASCII_KEYSTROKE_EVENT;
bufp->code = msg.msg.wParam;
bufp->modifiers = msg.dwModifiers;
XSETFRAME (bufp->frame_or_window, f);
break;
case WM_MOUSEMOVE:
- previous_help_echo = help_echo;
- help_echo_object = help_echo_window = Qnil;
- help_echo_pos = -1;
+ /* Ignore non-movement. */
+ {
+ int x = LOWORD (msg.msg.lParam);
+ int y = HIWORD (msg.msg.lParam);
+ if (x == last_mousemove_x && y == last_mousemove_y)
+ break;
+ last_mousemove_x = x;
+ last_mousemove_y = y;
+ }
+
+ previous_help_echo_string = help_echo_string;
if (dpyinfo->grabbed && last_mouse_frame
&& FRAME_LIVE_P (last_mouse_frame))
f = last_mouse_frame;
else
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
-
+
if (dpyinfo->mouse_face_hidden)
{
dpyinfo->mouse_face_hidden = 0;
}
if (f)
- note_mouse_movement (f, &msg.msg);
+ {
+ /* Generate SELECT_WINDOW_EVENTs when needed. */
+ if (mouse_autoselect_window)
+ {
+ Lisp_Object window;
+ int x = LOWORD (msg.msg.lParam);
+ int y = HIWORD (msg.msg.lParam);
+
+ window = window_from_coordinates (f, x, y, 0, 0, 0, 0);
+
+ /* Window will be selected only when it is not
+ selected now and last mouse movement event was
+ not in it. Minibuffer window will be selected
+ iff it is active. */
+ if (WINDOWP(window)
+ && !EQ (window, last_window)
+ && !EQ (window, selected_window)
+ && numchars > 0)
+ {
+ bufp->kind = SELECT_WINDOW_EVENT;
+ bufp->frame_or_window = window;
+ bufp->arg = Qnil;
+ ++bufp, ++count, --numchars;
+ }
+
+ last_window=window;
+ }
+ note_mouse_movement (f, &msg.msg);
+ }
else
{
/* If we move outside the frame, then we're
clear_mouse_face (dpyinfo);
}
- /* If the contents of the global variable help_echo
+ /* If the contents of the global variable help_echo_string
has changed, generate a HELP_EVENT. */
- if (help_echo != previous_help_echo)
+ if (help_echo_string != previous_help_echo_string ||
+ (!NILP (help_echo_string) && !STRINGP (help_echo_string) && f->mouse_moved))
{
Lisp_Object frame;
int n;
+ if (help_echo_string == Qnil)
+ {
+ help_echo_object = help_echo_window = Qnil;
+ help_echo_pos = -1;
+ }
+
if (f)
XSETFRAME (frame, f);
else
frame = Qnil;
any_help_event_p = 1;
- n = gen_help_event (bufp, numchars, help_echo, frame,
+ n = gen_help_event (bufp, numchars, help_echo_string, frame,
help_echo_window, help_echo_object,
help_echo_pos);
bufp += n, count += n, numchars -= n;
int button;
int up;
- emacs_event.kind = no_event;
-
+ emacs_event.kind = NO_EVENT;
+
if (dpyinfo->grabbed && last_mouse_frame
&& FRAME_LIVE_P (last_mouse_frame))
f = last_mouse_frame;
else
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
-
+
if (f)
{
construct_mouse_click (&emacs_event, &msg, f);
-
+
/* Is this in the tool-bar? */
if (WINDOWP (f->tool_bar_window)
- && XFASTINT (XWINDOW (f->tool_bar_window)->height))
+ && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window)))
{
Lisp_Object window;
- int p;
+ int x = XFASTINT (emacs_event.x);
+ int y = XFASTINT (emacs_event.y);
+
+ window = window_from_coordinates (f, x, y, 0, 0, 0, 1);
- /* Set x and y. */
- window = window_from_coordinates (f,
- emacs_event.x,
- emacs_event.y,
- &p, 1);
if (EQ (window, f->tool_bar_window))
{
w32_handle_tool_bar_click (f, &emacs_event);
numchars--;
}
}
-
+
parse_button (msg.msg.message, HIWORD (msg.msg.wParam),
&button, &up);
}
break;
}
-
- case WM_MOUSEWHEEL:
- if (dpyinfo->grabbed && last_mouse_frame
- && FRAME_LIVE_P (last_mouse_frame))
- f = last_mouse_frame;
- else
- f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
- if (f)
- {
- if ((!dpyinfo->w32_focus_frame
- || f == dpyinfo->w32_focus_frame)
- && (numchars >= 1))
- {
- construct_mouse_wheel (bufp, &msg, f);
- bufp++;
- count++;
- numchars--;
- }
- }
+ case WM_MOUSEWHEEL:
+ {
+ if (dpyinfo->grabbed && last_mouse_frame
+ && FRAME_LIVE_P (last_mouse_frame))
+ f = last_mouse_frame;
+ else
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (f)
+ {
+
+ if ((!dpyinfo->w32_focus_frame
+ || f == dpyinfo->w32_focus_frame)
+ && (numchars >= 1))
+ {
+ /* Emit an Emacs wheel-up/down event. */
+ construct_mouse_wheel (bufp, &msg, f);
+ bufp++;
+ count++;
+ numchars--;
+ }
+ /* Ignore any mouse motion that happened before this
+ event; any subsequent mouse-movement Emacs events
+ should reflect only motion after the
+ ButtonPress. */
+ f->mouse_moved = 0;
+ }
+ last_mouse_frame = f;
+ last_tool_bar_item = -1;
+ }
break;
case WM_DROPFILES:
{
struct scroll_bar *bar =
x_window_to_scroll_bar ((HWND)msg.msg.lParam);
-
+
if (bar && numchars >= 1)
{
if (w32_scroll_bar_handle_click (bar, &msg, bufp))
}
break;
}
-
+
case WM_WINDOWPOSCHANGED:
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
if (f)
{
x_check_fullscreen_move(f);
- if (f->output_data.w32->want_fullscreen & FULLSCREEN_WAIT)
- f->output_data.w32->want_fullscreen &=
- ~(FULLSCREEN_WAIT|FULLSCREEN_BOTH);
+ if (f->want_fullscreen & FULLSCREEN_WAIT)
+ f->want_fullscreen &= ~(FULLSCREEN_WAIT|FULLSCREEN_BOTH);
}
check_visibility = 1;
break;
case WM_MOVE:
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
-
+
if (f && !f->async_iconified)
{
int x, y;
x_real_positions (f, &x, &y);
- f->output_data.w32->left_pos = x;
- f->output_data.w32->top_pos = y;
+ f->left_pos = x;
+ f->top_pos = y;
}
check_visibility = 1;
case WM_SIZE:
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
-
+
/* Inform lisp of whether frame has been iconified etc. */
if (f)
{
case SIZE_MINIMIZED:
f->async_visible = 0;
f->async_iconified = 1;
-
- bufp->kind = iconify_event;
+
+ bufp->kind = ICONIFY_EVENT;
XSETFRAME (bufp->frame_or_window, f);
bufp->arg = Qnil;
bufp++;
case SIZE_RESTORED:
f->async_visible = 1;
f->async_iconified = 0;
-
+
/* wait_reading_process_input will notice this and update
the frame's display structures. */
SET_FRAME_GARBAGED (f);
-
+
if (f->iconified)
{
int x, y;
when the Window is iconified, with 3000,3000
as the co-ords. */
x_real_positions (f, &x, &y);
- f->output_data.w32->left_pos = x;
- f->output_data.w32->top_pos = y;
+ f->left_pos = x;
+ f->top_pos = y;
- bufp->kind = deiconify_event;
+ bufp->kind = DEICONIFY_EVENT;
XSETFRAME (bufp->frame_or_window, f);
bufp->arg = Qnil;
bufp++;
int columns;
int width;
int height;
-
+
GetClientRect (msg.msg.hwnd, &rect);
-
+
height = rect.bottom - rect.top;
width = rect.right - rect.left;
-
- rows = PIXEL_TO_CHAR_HEIGHT (f, height);
- columns = PIXEL_TO_CHAR_WIDTH (f, width);
-
+
+ rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, height);
+ columns = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, width);
+
/* TODO: Clip size to the screen dimensions. */
-
+
/* Even if the number of character rows and columns has
not changed, the font size may have changed, so we need
to check the pixel dimensions as well. */
-
- if (columns != f->width
- || rows != f->height
- || width != f->output_data.w32->pixel_width
- || height != f->output_data.w32->pixel_height)
+
+ if (columns != FRAME_COLS (f)
+ || rows != FRAME_LINES (f)
+ || width != FRAME_PIXEL_WIDTH (f)
+ || height != FRAME_PIXEL_HEIGHT (f))
{
change_frame_size (f, rows, columns, 0, 1, 0);
SET_FRAME_GARBAGED (f);
cancel_mouse_face (f);
- f->output_data.w32->pixel_width = width;
- f->output_data.w32->pixel_height = height;
- f->output_data.w32->win_gravity = NorthWestGravity;
+ FRAME_PIXEL_WIDTH (f) = width;
+ FRAME_PIXEL_HEIGHT (f) = height;
+ f->win_gravity = NorthWestGravity;
}
}
int n;
XSETFRAME (frame, f);
- help_echo = Qnil;
+ help_echo_string = Qnil;
n = gen_help_event (bufp, numchars,
Qnil, frame, Qnil, Qnil, 0);
bufp += n, count += n, numchars -= n;
}
}
break;
-
+
case WM_SETFOCUS:
+ /* TODO: Port this change:
+ 2002-06-28 Jan D. <jan.h.d@swipnet.se>
+ * xterm.h (struct x_output): Add focus_state.
+ * xterm.c (x_focus_changed): New function.
+ (x_detect_focus_change): New function.
+ (XTread_socket): Call x_detect_focus_change for FocusIn/FocusOut
+ EnterNotify and LeaveNotify to track X focus changes.
+ */
f = x_any_window_to_frame (dpyinfo, msg.msg.hwnd);
dpyinfo->w32_focus_event_frame = f;
-
+
if (f)
x_new_focus_frame (dpyinfo, f);
int n;
XSETFRAME (frame, f);
- help_echo = Qnil;
+ help_echo_string = Qnil;
n = gen_help_event (bufp, numchars,
Qnil, frame, Qnil, Qnil, 0);
bufp += n, count += n, numchars -=n;
case WM_CLOSE:
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
-
+
if (f)
{
if (numchars == 0)
abort ();
-
- bufp->kind = delete_window_event;
+
+ bufp->kind = DELETE_WINDOW_EVENT;
XSETFRAME (bufp->frame_or_window, f);
bufp->arg = Qnil;
bufp++;
case WM_INITMENU:
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
-
+
if (f)
{
if (numchars == 0)
abort ();
-
- bufp->kind = menu_bar_activate_event;
+
+ bufp->kind = MENU_BAR_ACTIVATE_EVENT;
XSETFRAME (bufp->frame_or_window, f);
bufp->arg = Qnil;
bufp++;
case WM_DISPLAYCHANGE:
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
- if (f)
+ if (f)
{
dpyinfo->width = (short) LOWORD (msg.msg.lParam);
dpyinfo->height = (short) HIWORD (msg.msg.lParam);
DebPrint (("display change: %d %d\n", dpyinfo->width,
dpyinfo->height));
}
-
+
check_visibility = 1;
break;
default:
- /* Check for messages registered at runtime. */
+ /* Check for messages registered at runtime. */
if (msg.msg.message == msh_mousewheel)
{
- if (dpyinfo->grabbed && last_mouse_frame
- && FRAME_LIVE_P (last_mouse_frame))
- f = last_mouse_frame;
- else
- f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
-
- if (f)
- {
- if ((!dpyinfo->w32_focus_frame
- || f == dpyinfo->w32_focus_frame)
- && (numchars >= 1))
- {
- construct_mouse_wheel (bufp, &msg, f);
- bufp++;
- count++;
- numchars--;
- }
- }
+ /* Forward MSH_MOUSEWHEEL as WM_MOUSEWHEEL. */
+ msg.msg.message == WM_MOUSEWHEEL;
+ prepend_msg (&msg);
}
break;
}
Lisp_Object tail, frame;
FOR_EACH_FRAME (tail, frame)
- {
- FRAME_PTR f = XFRAME (frame);
- /* The tooltip has been drawn already. Avoid the
- SET_FRAME_GARBAGED below. */
- if (EQ (frame, tip_frame))
- continue;
-
- /* Check "visible" frames and mark each as obscured or not.
- Note that async_visible is nonzero for unobscured and
- obscured frames, but zero for hidden and iconified frames. */
- if (FRAME_W32_P (f) && f->async_visible)
- {
- RECT clipbox;
- HDC hdc;
-
- enter_crit ();
- /* Query clipping rectangle for the entire window area
- (GetWindowDC), not just the client portion (GetDC).
- Otherwise, the scrollbars and menubar aren't counted as
- part of the visible area of the frame, and we may think
- the frame is obscured when really a scrollbar is still
- visible and gets WM_PAINT messages above. */
- hdc = GetWindowDC (FRAME_W32_WINDOW (f));
- GetClipBox (hdc, &clipbox);
- ReleaseDC (FRAME_W32_WINDOW (f), hdc);
- leave_crit ();
-
- if (clipbox.right == clipbox.left
- || clipbox.bottom == clipbox.top)
- {
- /* Frame has become completely obscured so mark as
- such (we do this by setting async_visible to 2 so
- that FRAME_VISIBLE_P is still true, but redisplay
- will skip it). */
- f->async_visible = 2;
+ {
+ FRAME_PTR f = XFRAME (frame);
+ /* The tooltip has been drawn already. Avoid the
+ SET_FRAME_GARBAGED below. */
+ if (EQ (frame, tip_frame))
+ continue;
+
+ /* Check "visible" frames and mark each as obscured or not.
+ Note that async_visible is nonzero for unobscured and
+ obscured frames, but zero for hidden and iconified frames. */
+ if (FRAME_W32_P (f) && f->async_visible)
+ {
+ RECT clipbox;
+ HDC hdc;
+
+ enter_crit ();
+ /* Query clipping rectangle for the entire window area
+ (GetWindowDC), not just the client portion (GetDC).
+ Otherwise, the scrollbars and menubar aren't counted as
+ part of the visible area of the frame, and we may think
+ the frame is obscured when really a scrollbar is still
+ visible and gets WM_PAINT messages above. */
+ hdc = GetWindowDC (FRAME_W32_WINDOW (f));
+ GetClipBox (hdc, &clipbox);
+ ReleaseDC (FRAME_W32_WINDOW (f), hdc);
+ leave_crit ();
+
+ if (clipbox.right == clipbox.left
+ || clipbox.bottom == clipbox.top)
+ {
+ /* Frame has become completely obscured so mark as
+ such (we do this by setting async_visible to 2 so
+ that FRAME_VISIBLE_P is still true, but redisplay
+ will skip it). */
+ f->async_visible = 2;
- if (!FRAME_OBSCURED_P (f))
- {
- DebPrint (("frame %p (%s) obscured\n", f,
- XSTRING (f->name)->data));
- }
- }
- else
- {
- /* Frame is not obscured, so mark it as such. */
- f->async_visible = 1;
+ if (!FRAME_OBSCURED_P (f))
+ {
+ DebPrint (("frame %p (%s) obscured\n", f,
+ SDATA (f->name)));
+ }
+ }
+ else
+ {
+ /* Frame is not obscured, so mark it as such. */
+ f->async_visible = 1;
- if (FRAME_OBSCURED_P (f))
- {
- SET_FRAME_GARBAGED (f);
- DebPrint (("obscured frame %p (%s) found to be visible\n", f,
- XSTRING (f->name)->data));
+ if (FRAME_OBSCURED_P (f))
+ {
+ SET_FRAME_GARBAGED (f);
+ DebPrint (("obscured frame %p (%s) found to be visible\n", f,
+ SDATA (f->name)));
- /* Force a redisplay sooner or later. */
- record_asynch_buffer_change ();
- }
- }
- }
- }
+ /* Force a redisplay sooner or later. */
+ record_asynch_buffer_change ();
+ }
+ }
+ }
+ }
}
UNBLOCK_INPUT;
Text Cursor
***********************************************************************/
-/* Notice if the text cursor of window W has been overwritten by a
- drawing operation that outputs glyphs starting at START_X and
- ending at END_X in the line given by output_cursor.vpos.
- Coordinates are area-relative. END_X < 0 means all the rest
- of the line after START_X has been written. */
-
-static void
-notice_overwritten_cursor (w, area, x0, x1, y0, y1)
- struct window *w;
- enum glyph_row_area area;
- int x0, x1, y0, y1;
-{
- if (area == TEXT_AREA
- && w->phys_cursor_on_p
- && y0 <= w->phys_cursor.y
- && y1 >= w->phys_cursor.y + w->phys_cursor_height
- && x0 <= w->phys_cursor.x
- && (x1 < 0 || x1 > w->phys_cursor.x))
- w->phys_cursor_on_p = 0;
-}
-
-
/* Set clipping for output in glyph row ROW. W is the window in which
we operate. GC is the graphics context to set clipping in.
- WHOLE_LINE_P non-zero means include the areas used for truncation
- mark display and alike in the clipping rectangle.
ROW may be a text row or, e.g., a mode line. Text rows must be
clipped to the interior of the window dedicated to text display,
mode lines must be clipped to the whole window. */
static void
-w32_clip_to_row (w, row, hdc, whole_line_p)
+w32_clip_to_row (w, row, hdc)
struct window *w;
struct glyph_row *row;
HDC hdc;
- int whole_line_p;
{
struct frame *f = XFRAME (WINDOW_FRAME (w));
RECT clip_rect;
- int window_x, window_y, window_width, window_height;
+ int window_y, window_width;
- window_box (w, -1, &window_x, &window_y, &window_width, &window_height);
+ window_box (w, -1, 0, &window_y, &window_width, 0);
clip_rect.left = WINDOW_TO_FRAME_PIXEL_X (w, 0);
clip_rect.top = WINDOW_TO_FRAME_PIXEL_Y (w, row->y);
clip_rect.right = clip_rect.left + window_width;
clip_rect.bottom = clip_rect.top + row->visible_height;
- /* If clipping to the whole line, including trunc marks, extend
- the rectangle to the left and increase its width. */
- if (whole_line_p)
- {
- clip_rect.left -= FRAME_X_LEFT_FRINGE_WIDTH (f);
- clip_rect.right += FRAME_X_FRINGE_WIDTH (f);
- }
-
w32_set_clip_rectangle (hdc, &clip_rect);
}
rect.left = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x);
rect.top = (WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y)
+ row->ascent - w->phys_cursor_ascent);
- rect.bottom = rect.top + row->height - 1;
+ rect.bottom = rect.top + row->height;
/* Get the glyph the cursor is on. If we can't tell because
the current matrix is invalid or such, give up. */
glyph, and `x-stretch-block-cursor' is nil, don't draw a
rectangle as wide as the glyph, but use a canonical character
width instead. */
- wd = cursor_glyph->pixel_width - 1;
+ wd = cursor_glyph->pixel_width;
if (cursor_glyph->type == STRETCH_GLYPH
&& !x_stretch_cursor_p)
- wd = min (CANON_X_UNIT (f), wd);
+ wd = min (FRAME_COLUMN_WIDTH (f), wd);
+ w->phys_cursor_width = wd;
rect.right = rect.left + wd;
hdc = get_frame_dc (f);
+ /* Set clipping, draw the rectangle, and reset clipping again. */
+ w32_clip_to_row (w, row, hdc);
FrameRect (hdc, &rect, hb);
DeleteObject (hb);
-
+ w32_set_clip_rectangle (hdc, NULL);
release_frame_dc (f, hdc);
}
--gerd. */
static void
-x_draw_bar_cursor (w, row, width)
+x_draw_bar_cursor (w, row, width, kind)
struct window *w;
struct glyph_row *row;
int width;
+ enum text_cursor_kinds kind;
{
struct frame *f = XFRAME (w->frame);
struct glyph *cursor_glyph;
{
struct glyph_row *row;
row = MATRIX_ROW (w->current_matrix, w->phys_cursor.vpos);
- x_draw_phys_cursor_glyph (w, row, DRAW_CURSOR);
+ draw_phys_cursor_glyph (w, row, DRAW_CURSOR);
}
else
{
COLORREF cursor_color = f->output_data.w32->cursor_pixel;
struct face *face = FACE_FROM_ID (f, cursor_glyph->face_id);
- if (width < 0)
- width = f->output_data.w32->cursor_width;
-
/* If the glyph's background equals the color we normally draw
the bar cursor in, the bar cursor in its normal color is
invisible. Use the glyph's foreground color instead in this
cursor_color = face->foreground;
x = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x);
- hdc = get_frame_dc (f);
- w32_clip_to_row (w, row, hdc, 0);
- w32_fill_area (f, hdc, cursor_color, x,
- WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y),
- min (cursor_glyph->pixel_width, width),
- row->height);
- release_frame_dc (f, hdc);
- }
-}
+ if (width < 0)
+ width = FRAME_CURSOR_WIDTH (f);
+ width = min (cursor_glyph->pixel_width, width);
-/* Clear the cursor of window W to background color, and mark the
- cursor as not shown. This is used when the text where the cursor
- is is about to be rewritten. */
-
-static void
-x_clear_cursor (w)
- struct window *w;
-{
- if (FRAME_VISIBLE_P (XFRAME (w->frame)) && w->phys_cursor_on_p)
- x_update_window_cursor (w, 0);
-}
+ w->phys_cursor_width = width;
-/* Draw the cursor glyph of window W in glyph row ROW. See the
- comment of x_draw_glyphs for the meaning of HL. */
+ hdc = get_frame_dc (f);
+ w32_clip_to_row (w, row, hdc);
-static void
-x_draw_phys_cursor_glyph (w, row, hl)
- struct window *w;
- struct glyph_row *row;
- enum draw_glyphs_face hl;
-{
- /* If cursor hpos is out of bounds, don't draw garbage. This can
- happen in mini-buffer windows when switching between echo area
- glyphs and mini-buffer. */
- if (w->phys_cursor.hpos < row->used[TEXT_AREA])
- {
- int on_p = w->phys_cursor_on_p;
- x_draw_glyphs (w, w->phys_cursor.x, row, TEXT_AREA,
- w->phys_cursor.hpos, w->phys_cursor.hpos + 1,
- hl, 0);
- w->phys_cursor_on_p = on_p;
-
- /* When we erase the cursor, and ROW is overlapped by other
- rows, make sure that these overlapping parts of other rows
- are redrawn. */
- if (hl == DRAW_NORMAL_TEXT && row->overlapped_p)
+ if (kind == BAR_CURSOR)
{
- if (row > w->current_matrix->rows
- && MATRIX_ROW_OVERLAPS_SUCC_P (row - 1))
- x_fix_overlapping_area (w, row - 1, TEXT_AREA);
-
- if (MATRIX_ROW_BOTTOM_Y (row) < window_text_bottom_y (w)
- && MATRIX_ROW_OVERLAPS_PRED_P (row + 1))
- x_fix_overlapping_area (w, row + 1, TEXT_AREA);
+ w32_fill_area (f, hdc, cursor_color, x,
+ WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y),
+ width, row->height);
+ }
+ else
+ {
+ w32_fill_area (f, hdc, cursor_color, x,
+ WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y +
+ row->height - width),
+ cursor_glyph->pixel_width, width);
}
+
+ w32_set_clip_rectangle (hdc, NULL);
+ release_frame_dc (f, hdc);
}
}
-/* Erase the image of a cursor of window W from the screen. */
+/* RIF: Define cursor CURSOR on frame F. */
static void
-x_erase_phys_cursor (w)
- struct window *w;
+w32_define_frame_cursor (f, cursor)
+ struct frame *f;
+ Cursor cursor;
{
- struct frame *f = XFRAME (w->frame);
- struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
- int hpos = w->phys_cursor.hpos;
- int vpos = w->phys_cursor.vpos;
- int mouse_face_here_p = 0;
- struct glyph_matrix *active_glyphs = w->current_matrix;
- struct glyph_row *cursor_row;
- struct glyph *cursor_glyph;
- enum draw_glyphs_face hl;
-
- /* No cursor displayed or row invalidated => nothing to do on the
- screen. */
- if (w->phys_cursor_type == NO_CURSOR)
- goto mark_cursor_off;
-
- /* VPOS >= active_glyphs->nrows means that window has been resized.
- Don't bother to erase the cursor. */
- if (vpos >= active_glyphs->nrows)
- goto mark_cursor_off;
-
- /* If row containing cursor is marked invalid, there is nothing we
- can do. */
- cursor_row = MATRIX_ROW (active_glyphs, vpos);
- if (!cursor_row->enabled_p)
- goto mark_cursor_off;
-
- /* If row is completely invisible, don't attempt to delete a cursor which
- isn't there. This may happen if cursor is at top of window, and
- we switch to a buffer with a header line in that window. */
- if (cursor_row->visible_height <= 0)
- goto mark_cursor_off;
-
- /* This can happen when the new row is shorter than the old one.
- In this case, either x_draw_glyphs or clear_end_of_line
- should have cleared the cursor. Note that we wouldn't be
- able to erase the cursor in this case because we don't have a
- cursor glyph at hand. */
- if (w->phys_cursor.hpos >= cursor_row->used[TEXT_AREA])
- goto mark_cursor_off;
-
- /* If the cursor is in the mouse face area, redisplay that when
- we clear the cursor. */
- if (! NILP (dpyinfo->mouse_face_window)
- && w == XWINDOW (dpyinfo->mouse_face_window)
- && (vpos > dpyinfo->mouse_face_beg_row
- || (vpos == dpyinfo->mouse_face_beg_row
- && hpos >= dpyinfo->mouse_face_beg_col))
- && (vpos < dpyinfo->mouse_face_end_row
- || (vpos == dpyinfo->mouse_face_end_row
- && hpos < dpyinfo->mouse_face_end_col))
- /* Don't redraw the cursor's spot in mouse face if it is at the
- end of a line (on a newline). The cursor appears there, but
- mouse highlighting does not. */
- && cursor_row->used[TEXT_AREA] > hpos)
- mouse_face_here_p = 1;
-
- /* Maybe clear the display under the cursor. */
- if (w->phys_cursor_type == HOLLOW_BOX_CURSOR)
- {
- int x;
- int header_line_height = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w);
- HDC hdc;
-
- cursor_glyph = get_phys_cursor_glyph (w);
- if (cursor_glyph == NULL)
- goto mark_cursor_off;
-
- x = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x);
-
- hdc = get_frame_dc (f);
- w32_clear_area (f, hdc, x,
- WINDOW_TO_FRAME_PIXEL_Y (w, max (header_line_height,
- cursor_row->y)),
- cursor_glyph->pixel_width,
- cursor_row->visible_height);
- release_frame_dc (f, hdc);
- }
-
- /* Erase the cursor by redrawing the character underneath it. */
- if (mouse_face_here_p)
- hl = DRAW_MOUSE_FACE;
- else
- hl = DRAW_NORMAL_TEXT;
- x_draw_phys_cursor_glyph (w, cursor_row, hl);
-
- mark_cursor_off:
- w->phys_cursor_on_p = 0;
- w->phys_cursor_type = NO_CURSOR;
+ w32_define_cursor (FRAME_W32_WINDOW (f), cursor);
}
-/* Non-zero if physical cursor of window W is within mouse face. */
+/* RIF: Clear area on frame F. */
-static int
-cursor_in_mouse_face_p (w)
- struct window *w;
+static void
+w32_clear_frame_area (f, x, y, width, height)
+ struct frame *f;
+ int x, y, width, height;
{
- struct w32_display_info *dpyinfo
- = FRAME_W32_DISPLAY_INFO (XFRAME (w->frame));
- int in_mouse_face = 0;
-
- if (WINDOWP (dpyinfo->mouse_face_window)
- && XWINDOW (dpyinfo->mouse_face_window) == w)
- {
- int hpos = w->phys_cursor.hpos;
- int vpos = w->phys_cursor.vpos;
-
- if (vpos >= dpyinfo->mouse_face_beg_row
- && vpos <= dpyinfo->mouse_face_end_row
- && (vpos > dpyinfo->mouse_face_beg_row
- || hpos >= dpyinfo->mouse_face_beg_col)
- && (vpos < dpyinfo->mouse_face_end_row
- || hpos < dpyinfo->mouse_face_end_col
- || dpyinfo->mouse_face_past_end))
- in_mouse_face = 1;
- }
+ HDC hdc;
- return in_mouse_face;
+ hdc = get_frame_dc (f);
+ w32_clear_area (f, hdc, x, y, width, height);
+ release_frame_dc (f, hdc);
}
+/* RIF: Draw or clear cursor on window W. */
-/* Display or clear cursor of window W. If ON is zero, clear the
- cursor. If it is non-zero, display the cursor. If ON is nonzero,
- where to put the cursor is specified by HPOS, VPOS, X and Y. */
-
-void
-x_display_and_set_cursor (w, on, hpos, vpos, x, y)
+static void
+w32_draw_window_cursor (w, glyph_row, x, y, cursor_type, cursor_width, on_p, active_p)
struct window *w;
- int on, hpos, vpos, x, y;
+ struct glyph_row *glyph_row;
+ int x, y;
+ int cursor_type, cursor_width;
+ int on_p, active_p;
{
- struct frame *f = XFRAME (w->frame);
- int new_cursor_type;
- int new_cursor_width;
- struct glyph_matrix *current_glyphs;
- struct glyph_row *glyph_row;
- struct glyph *glyph;
- int cursor_non_selected;
- int active_cursor = 1;
-
- /* This is pointless on invisible frames, and dangerous on garbaged
- windows and frames; in the latter case, the frame or window may
- be in the midst of changing its size, and x and y may be off the
- window. */
- if (! FRAME_VISIBLE_P (f)
- || FRAME_GARBAGED_P (f)
- || vpos >= w->current_matrix->nrows
- || hpos >= w->current_matrix->matrix_w)
- return;
-
- /* If cursor is off and we want it off, return quickly. */
- if (!on && !w->phys_cursor_on_p)
- return;
-
- current_glyphs = w->current_matrix;
- glyph_row = MATRIX_ROW (current_glyphs, vpos);
- glyph = glyph_row->glyphs[TEXT_AREA] + hpos;
-
- /* If cursor row is not enabled, we don't really know where to
- display the cursor. */
- if (!glyph_row->enabled_p)
- {
- w->phys_cursor_on_p = 0;
- return;
- }
-
- xassert (interrupt_input_blocked);
-
- /* Set new_cursor_type to the cursor we want to be displayed. In a
- mini-buffer window, we want the cursor only to appear if we are
- reading input from this window. For the selected window, we want
- the cursor type given by the frame parameter. If explicitly
- marked off, draw no cursor. In all other cases, we want a hollow
- box cursor. */
- cursor_non_selected
- = !NILP (Fbuffer_local_value (Qcursor_in_non_selected_windows,
- w->buffer));
- new_cursor_width = -1;
- if (cursor_in_echo_area
- && FRAME_HAS_MINIBUF_P (f)
- && EQ (FRAME_MINIBUF_WINDOW (f), echo_area_window))
- {
- if (w == XWINDOW (echo_area_window))
- new_cursor_type = FRAME_DESIRED_CURSOR (f);
- else
- {
- if (cursor_non_selected)
- new_cursor_type = HOLLOW_BOX_CURSOR;
- else
- new_cursor_type = NO_CURSOR;
- active_cursor = 0;
- }
- }
- else
+ if (on_p)
{
- if (f != FRAME_W32_DISPLAY_INFO (f)->w32_highlight_frame
- || w != XWINDOW (f->selected_window))
- {
- active_cursor = 0;
-
- if (MINI_WINDOW_P (w)
- || !cursor_non_selected
- || NILP (XBUFFER (w->buffer)->cursor_type))
- new_cursor_type = NO_CURSOR;
- else
- new_cursor_type = HOLLOW_BOX_CURSOR;
- }
- else if (w->cursor_off_p)
- new_cursor_type = NO_CURSOR;
- else
- {
- struct buffer *b = XBUFFER (w->buffer);
-
- if (EQ (b->cursor_type, Qt))
- new_cursor_type = FRAME_DESIRED_CURSOR (f);
- else
- new_cursor_type = x_specified_cursor_type (b->cursor_type,
- &new_cursor_width);
- }
- }
-
- /* If cursor is currently being shown and we don't want it to be or
- it is in the wrong place, or the cursor type is not what we want,
- erase it. */
- if (w->phys_cursor_on_p
- && (!on
- || w->phys_cursor.x != x
- || w->phys_cursor.y != y
- || new_cursor_type != w->phys_cursor_type))
- x_erase_phys_cursor (w);
-
- /* If the cursor is now invisible and we want it to be visible,
- display it. */
- if (on && !w->phys_cursor_on_p)
- {
- w->phys_cursor_ascent = glyph_row->ascent;
- w->phys_cursor_height = glyph_row->height;
-
- /* Set phys_cursor_.* before x_draw_.* is called because some
- of them may need the information. */
- w->phys_cursor.x = x;
- w->phys_cursor.y = glyph_row->y;
- w->phys_cursor.hpos = hpos;
- w->phys_cursor.vpos = vpos;
-
/* If the user wants to use the system caret, make sure our own
cursor remains invisible. */
if (w32_use_visible_system_caret)
{
if (w->phys_cursor_type != NO_CURSOR)
- x_erase_phys_cursor (w);
+ erase_phys_cursor (w);
- new_cursor_type = w->phys_cursor_type = NO_CURSOR;
+ cursor_type = w->phys_cursor_type = NO_CURSOR;
+ w->phys_cursor_width = -1;
}
else
- w->phys_cursor_type = new_cursor_type;
+ {
+ w->phys_cursor_type = cursor_type;
+ }
w->phys_cursor_on_p = 1;
/* If this is the active cursor, we need to track it with the
system caret, so third party software like screen magnifiers
and speech synthesizers can follow the cursor. */
- if (active_cursor)
+ if (active_p)
{
+ struct frame *f = XFRAME (WINDOW_FRAME (w));
HWND hwnd = FRAME_W32_WINDOW (f);
w32_system_caret_x
PostMessage (hwnd, WM_EMACS_TRACK_CARET, 0, 0);
}
- switch (new_cursor_type)
+ switch (cursor_type)
{
case HOLLOW_BOX_CURSOR:
x_draw_hollow_cursor (w, glyph_row);
break;
case FILLED_BOX_CURSOR:
- x_draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR);
+ draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR);
break;
case BAR_CURSOR:
- x_draw_bar_cursor (w, glyph_row, new_cursor_width);
+ x_draw_bar_cursor (w, glyph_row, cursor_width, BAR_CURSOR);
+ break;
+
+ case HBAR_CURSOR:
+ x_draw_bar_cursor (w, glyph_row, cursor_width, HBAR_CURSOR);
break;
case NO_CURSOR:
+ w->phys_cursor_width = 0;
break;
default:
}
-/* Display the cursor on window W, or clear it. X and Y are window
- relative pixel coordinates. HPOS and VPOS are glyph matrix
- positions. If W is not the selected window, display a hollow
- cursor. ON non-zero means display the cursor at X, Y which
- correspond to HPOS, VPOS, otherwise it is cleared. */
-
-void
-x_display_cursor (w, on, hpos, vpos, x, y)
- struct window *w;
- int on, hpos, vpos, x, y;
-{
- BLOCK_INPUT;
- x_display_and_set_cursor (w, on, hpos, vpos, x, y);
- UNBLOCK_INPUT;
-}
-
-
-/* Display the cursor on window W, or clear it, according to ON_P.
- Don't change the cursor's position. */
-
-void
-x_update_cursor (f, on_p)
- struct frame *f;
- int on_p;
-{
- x_update_cursor_in_window_tree (XWINDOW (f->root_window), on_p);
-}
-
-
-/* Call x_update_window_cursor with parameter ON_P on all leaf windows
- in the window tree rooted at W. */
-
-static void
-x_update_cursor_in_window_tree (w, on_p)
- struct window *w;
- int on_p;
-{
- while (w)
- {
- if (!NILP (w->hchild))
- x_update_cursor_in_window_tree (XWINDOW (w->hchild), on_p);
- else if (!NILP (w->vchild))
- x_update_cursor_in_window_tree (XWINDOW (w->vchild), on_p);
- else
- x_update_window_cursor (w, on_p);
-
- w = NILP (w->next) ? 0 : XWINDOW (w->next);
- }
-}
-
-
-/* Switch the display of W's cursor on or off, according to the value
- of ON. */
-
-static void
-x_update_window_cursor (w, on)
- struct window *w;
- int on;
-{
- /* Don't update cursor in windows whose frame is in the process
- of being deleted. */
- if (w->current_matrix)
- {
- BLOCK_INPUT;
- x_display_and_set_cursor (w, on, w->phys_cursor.hpos,
- w->phys_cursor.vpos, w->phys_cursor.x,
- w->phys_cursor.y);
- UNBLOCK_INPUT;
- }
-}
-
-
-
\f
/* Icons. */
if (NILP (icon))
hicon = LoadIcon (hinst, EMACS_CLASS);
else if (STRINGP (icon))
- hicon = LoadImage (NULL, (LPCTSTR) XSTRING (icon)->data, IMAGE_ICON, 0, 0,
+ hicon = LoadImage (NULL, (LPCTSTR) SDATA (icon), IMAGE_ICON, 0, 0,
LR_DEFAULTSIZE | LR_LOADFROMFILE);
else if (SYMBOLP (icon))
{
register char *fontname;
{
struct font_info *fontp
- = FS_LOAD_FONT (f, 0, fontname, -1);
+ = FS_LOAD_FONT (f, fontname);
if (!fontp)
return Qnil;
FRAME_BASELINE_OFFSET (f) = fontp->baseline_offset;
FRAME_FONTSET (f) = -1;
+ FRAME_COLUMN_WIDTH (f) = FONT_WIDTH (FRAME_FONT (f));
+ FRAME_LINE_HEIGHT (f) = FONT_HEIGHT (FRAME_FONT (f));
+
+ compute_fringe_widths (f, 1);
+
/* Compute the scroll bar width in character columns. */
- if (f->scroll_bar_pixel_width > 0)
+ if (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0)
{
- int wid = FONT_WIDTH (FRAME_FONT (f));
- f->scroll_bar_cols = (f->scroll_bar_pixel_width + wid-1) / wid;
+ int wid = FRAME_COLUMN_WIDTH (f);
+ FRAME_CONFIG_SCROLL_BAR_COLS (f)
+ = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + wid-1) / wid;
}
else
{
- int wid = FONT_WIDTH (FRAME_FONT (f));
- f->scroll_bar_cols = (14 + wid - 1) / wid;
+ 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_W32_WINDOW (f) != 0)
{
- frame_update_line_height (f);
if (NILP (tip_frame) || XFRAME (tip_frame) != f)
- x_set_window_size (f, 0, f->width, f->height);
+ x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
}
- else
- /* If we are setting a new frame's font for the first time,
- there are no faces yet, so this font's height is the line height. */
- f->output_data.w32->line_height = FONT_HEIGHT (FRAME_FONT (f));
return build_string (fontp->full_name);
}
to do. */
return fontset_name (fontset);
- result = x_new_font (f, (XSTRING (fontset_ascii (fontset))->data));
+ result = x_new_font (f, (SDATA (fontset_ascii (fontset))));
if (!STRINGP (result))
/* Can't load ASCII font. */
return build_string (fontsetname);
}
-/* Compute actual fringe widths */
-
-void
-x_compute_fringe_widths (f, redraw)
- struct frame *f;
- int redraw;
-{
- int o_left = f->output_data.w32->left_fringe_width;
- int o_right = f->output_data.w32->right_fringe_width;
- int o_cols = f->output_data.w32->fringe_cols;
-
- Lisp_Object left_fringe = Fassq (Qleft_fringe, f->param_alist);
- Lisp_Object right_fringe = Fassq (Qright_fringe, f->param_alist);
- int left_fringe_width, right_fringe_width;
-
- if (!NILP (left_fringe))
- left_fringe = Fcdr (left_fringe);
- if (!NILP (right_fringe))
- right_fringe = Fcdr (right_fringe);
-
- left_fringe_width = ((NILP (left_fringe) || !INTEGERP (left_fringe)) ? 8 :
- XINT (left_fringe));
- right_fringe_width = ((NILP (right_fringe) || !INTEGERP (right_fringe)) ? 8 :
- XINT (right_fringe));
-
- if (left_fringe_width || right_fringe_width)
- {
- int left_wid = left_fringe_width >= 0 ? left_fringe_width : -left_fringe_width;
- int right_wid = right_fringe_width >= 0 ? right_fringe_width : -right_fringe_width;
- int conf_wid = left_wid + right_wid;
- int font_wid = FONT_WIDTH (f->output_data.w32->font);
- int cols = (left_wid + right_wid + font_wid-1) / font_wid;
- int real_wid = cols * font_wid;
- if (left_wid && right_wid)
- {
- if (left_fringe_width < 0)
- {
- /* Left fringe width is fixed, adjust right fringe if necessary */
- f->output_data.w32->left_fringe_width = left_wid;
- f->output_data.w32->right_fringe_width = real_wid - left_wid;
- }
- else if (right_fringe_width < 0)
- {
- /* Right fringe width is fixed, adjust left fringe if necessary */
- f->output_data.w32->left_fringe_width = real_wid - right_wid;
- f->output_data.w32->right_fringe_width = right_wid;
- }
- else
- {
- /* Adjust both fringes with an equal amount.
- Note that we are doing integer arithmetic here, so don't
- lose a pixel if the total width is an odd number. */
- int fill = real_wid - conf_wid;
- f->output_data.w32->left_fringe_width = left_wid + fill/2;
- f->output_data.w32->right_fringe_width = right_wid + fill - fill/2;
- }
- }
- else if (left_fringe_width)
- {
- f->output_data.w32->left_fringe_width = real_wid;
- f->output_data.w32->right_fringe_width = 0;
- }
- else
- {
- f->output_data.w32->left_fringe_width = 0;
- f->output_data.w32->right_fringe_width = real_wid;
- }
- f->output_data.w32->fringe_cols = cols;
- f->output_data.w32->fringes_extra = real_wid;
- }
- else
- {
- f->output_data.w32->left_fringe_width = 0;
- f->output_data.w32->right_fringe_width = 0;
- f->output_data.w32->fringe_cols = 0;
- f->output_data.w32->fringes_extra = 0;
- }
-
- if (redraw && FRAME_VISIBLE_P (f))
- if (o_left != f->output_data.w32->left_fringe_width ||
- o_right != f->output_data.w32->right_fringe_width ||
- o_cols != f->output_data.w32->fringe_cols)
- redraw_frame (f);
-}
\f
/***********************************************************************
TODO: W32 Input Methods
struct frame *f;
{
POINT pt;
- int flags = f->output_data.w32->size_hint_flags;
+ int flags = f->size_hint_flags;
pt.x = pt.y = 0;
{
RECT rt;
rt.left = rt.right = rt.top = rt.bottom = 0;
-
+
BLOCK_INPUT;
AdjustWindowRect(&rt, f->output_data.w32->dwStyle,
FRAME_EXTERNAL_MENU_BAR (f));
/* Treat negative positions as relative to the leftmost bottommost
position that fits on the screen. */
if (flags & XNegative)
- f->output_data.w32->left_pos = (FRAME_W32_DISPLAY_INFO (f)->width
- - 2 * f->output_data.w32->border_width - pt.x
- - PIXEL_WIDTH (f)
- + f->output_data.w32->left_pos);
+ f->left_pos = (FRAME_W32_DISPLAY_INFO (f)->width
+ - 2 * f->border_width - pt.x
+ - FRAME_PIXEL_WIDTH (f)
+ + f->left_pos);
if (flags & YNegative)
- f->output_data.w32->top_pos = (FRAME_W32_DISPLAY_INFO (f)->height
- - 2 * f->output_data.w32->border_width - pt.y
- - PIXEL_HEIGHT (f)
- + f->output_data.w32->top_pos);
+ f->top_pos = (FRAME_W32_DISPLAY_INFO (f)->height
+ - 2 * f->border_width - pt.y
+ - FRAME_PIXEL_HEIGHT (f)
+ + f->top_pos);
/* The left_pos and top_pos
are now relative to the top and left screen edges,
so the flags should correspond. */
- f->output_data.w32->size_hint_flags &= ~ (XNegative | YNegative);
+ f->size_hint_flags &= ~ (XNegative | YNegative);
}
/* CHANGE_GRAVITY is 1 when calling from Fset_frame_position,
if (change_gravity > 0)
{
- f->output_data.w32->top_pos = yoff;
- f->output_data.w32->left_pos = xoff;
- f->output_data.w32->size_hint_flags &= ~ (XNegative | YNegative);
+ f->top_pos = yoff;
+ f->left_pos = xoff;
+ f->size_hint_flags &= ~ (XNegative | YNegative);
if (xoff < 0)
- f->output_data.w32->size_hint_flags |= XNegative;
+ f->size_hint_flags |= XNegative;
if (yoff < 0)
- f->output_data.w32->size_hint_flags |= YNegative;
- f->output_data.w32->win_gravity = NorthWestGravity;
+ f->size_hint_flags |= YNegative;
+ f->win_gravity = NorthWestGravity;
}
x_calc_absolute_position (f);
BLOCK_INPUT;
x_wm_set_size_hint (f, (long) 0, 0);
- modified_left = f->output_data.w32->left_pos;
- modified_top = f->output_data.w32->top_pos;
+ modified_left = f->left_pos;
+ modified_top = f->top_pos;
my_set_window_pos (FRAME_W32_WINDOW (f),
NULL,
x_check_fullscreen (f)
struct frame *f;
{
- if (f->output_data.w32->want_fullscreen & FULLSCREEN_BOTH)
+ if (f->want_fullscreen & FULLSCREEN_BOTH)
{
int width, height, ign;
-
- x_real_positions (f, &f->output_data.w32->left_pos,
- &f->output_data.w32->top_pos);
+
+ x_real_positions (f, &f->left_pos, &f->top_pos);
x_fullscreen_adjust (f, &width, &height, &ign, &ign);
-
+
/* We do not need to move the window, it shall be taken care of
when setting WM manager hints.
If the frame is visible already, the position is checked by
x_check_fullscreen_move. */
- if (f->width != width || f->height != height)
+ if (FRAME_COLS (f) != width || FRAME_LINES (f) != height)
{
change_frame_size (f, height, width, 0, 1, 0);
SET_FRAME_GARBAGED (f);
cancel_mouse_face (f);
/* Wait for the change of frame size to occur */
- f->output_data.w32->want_fullscreen |= FULLSCREEN_WAIT;
+ f->want_fullscreen |= FULLSCREEN_WAIT;
}
}
}
x_check_fullscreen_move (f)
struct frame *f;
{
- if (f->output_data.w32->want_fullscreen & FULLSCREEN_MOVE_WAIT)
+ if (f->want_fullscreen & FULLSCREEN_MOVE_WAIT)
{
- int expect_top = f->output_data.w32->top_pos;
- int expect_left = f->output_data.w32->left_pos;
+ int expect_top = f->top_pos;
+ int expect_left = f->left_pos;
- if (f->output_data.w32->want_fullscreen & FULLSCREEN_HEIGHT)
+ if (f->want_fullscreen & FULLSCREEN_HEIGHT)
expect_top = 0;
- if (f->output_data.w32->want_fullscreen & FULLSCREEN_WIDTH)
+ if (f->want_fullscreen & FULLSCREEN_WIDTH)
expect_left = 0;
-
- if (expect_top != f->output_data.w32->top_pos
- || expect_left != f->output_data.w32->left_pos)
+
+ if (expect_top != f->top_pos
+ || expect_left != f->left_pos)
x_set_offset (f, expect_left, expect_top, 1);
/* Just do this once */
- f->output_data.w32->want_fullscreen &= ~FULLSCREEN_MOVE_WAIT;
+ f->want_fullscreen &= ~FULLSCREEN_MOVE_WAIT;
}
}
-/* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
- wanted positions of the WM window (not emacs window).
- Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
- window (FRAME_X_WINDOW).
- */
-void
-x_fullscreen_adjust (f, width, height, top_pos, left_pos)
- struct frame *f;
- int *width;
- int *height;
- int *top_pos;
- int *left_pos;
-{
- int newwidth = f->width, newheight = f->height;
-
- *top_pos = f->output_data.w32->top_pos;
- *left_pos = f->output_data.w32->left_pos;
-
- if (f->output_data.w32->want_fullscreen & FULLSCREEN_HEIGHT)
- {
- int ph;
-
- ph = FRAME_X_DISPLAY_INFO (f)->height;
- newheight = PIXEL_TO_CHAR_HEIGHT (f, ph);
- ph = CHAR_TO_PIXEL_HEIGHT (f, newheight)
- - f->output_data.w32->y_pixels_diff;
- newheight = PIXEL_TO_CHAR_HEIGHT (f, ph);
- *top_pos = 0;
- }
-
- if (f->output_data.w32->want_fullscreen & FULLSCREEN_WIDTH)
- {
- int pw;
-
- pw = FRAME_X_DISPLAY_INFO (f)->width;
- newwidth = PIXEL_TO_CHAR_WIDTH (f, pw);
- pw = CHAR_TO_PIXEL_WIDTH (f, newwidth)
- - f->output_data.w32->x_pixels_diff;
- newwidth = PIXEL_TO_CHAR_WIDTH (f, pw);
- *left_pos = 0;
- }
-
- *width = newwidth;
- *height = newheight;
-}
-
-
/* Call this to change the size of frame F's x-window.
If CHANGE_GRAVITY is 1, we change to top-left-corner window gravity
for this size change and subsequent size changes.
int cols, rows;
{
int pixelwidth, pixelheight;
-
+
BLOCK_INPUT;
-
+
check_frame_size (f, &rows, &cols);
- f->output_data.w32->vertical_scroll_bar_extra
- = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
- ? 0
- : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.w32->font)));
+ f->scroll_bar_actual_width
+ = FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f);
- x_compute_fringe_widths (f, 0);
+ compute_fringe_widths (f, 0);
- pixelwidth = CHAR_TO_PIXEL_WIDTH (f, cols);
- pixelheight = CHAR_TO_PIXEL_HEIGHT (f, rows);
-
- f->output_data.w32->win_gravity = NorthWestGravity;
+ pixelwidth = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, cols);
+ pixelheight = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, rows);
+
+ f->win_gravity = NorthWestGravity;
x_wm_set_size_hint (f, (long) 0, 0);
-
+
{
RECT rect;
rect.left = rect.top = 0;
rect.right = pixelwidth;
rect.bottom = pixelheight;
-
+
AdjustWindowRect(&rect, f->output_data.w32->dwStyle,
FRAME_EXTERNAL_MENU_BAR (f));
-
+
my_set_window_pos (FRAME_W32_WINDOW (f),
- NULL,
+ NULL,
0, 0,
rect.right - rect.left,
rect.bottom - rect.top,
SWP_NOZORDER | SWP_NOMOVE | SWP_NOACTIVATE);
}
-
+
/* Now, strictly speaking, we can't be sure that this is accurate,
but the window manager will get around to dealing with the size
change request eventually, and we'll hear how it went when the
ConfigureNotify event gets here.
-
+
We could just not bother storing any of this information here,
and let the ConfigureNotify event set everything up, but that
might be kind of confusing to the Lisp code, since size changes
We pass 1 for DELAY since we can't run Lisp code inside of
a BLOCK_INPUT. */
change_frame_size (f, rows, cols, 0, 1, 0);
- PIXEL_WIDTH (f) = pixelwidth;
- PIXEL_HEIGHT (f) = pixelheight;
+ FRAME_PIXEL_WIDTH (f) = pixelwidth;
+ FRAME_PIXEL_HEIGHT (f) = pixelheight;
/* We've set {FRAME,PIXEL}_{WIDTH,HEIGHT} to the values we hope to
receive in the ConfigureNotify event; if we get what we asked
mark_window_cursors_off (XWINDOW (f->root_window));
/* Clear out any recollection of where the mouse highlighting was,
- since it might be in a place that's outside the new frame size.
+ since it might be in a place that's outside the new frame size.
Actually checking whether it is outside is a pain in the neck,
so don't try--just let the highlighting be done afresh with new size. */
cancel_mouse_face (f);
{
int pix_x, pix_y;
- pix_x = CHAR_TO_PIXEL_COL (f, x) + FONT_WIDTH (f->output_data.w32->font) / 2;
- pix_y = CHAR_TO_PIXEL_ROW (f, y) + f->output_data.w32->line_height / 2;
+ pix_x = FRAME_COL_TO_PIXEL_X (f, x) + FRAME_COLUMN_WIDTH (f) / 2;
+ pix_y = FRAME_LINE_TO_PIXEL_Y (f, y) + FRAME_LINE_HEIGHT (f) / 2;
if (pix_x < 0) pix_x = 0;
- if (pix_x > PIXEL_WIDTH (f)) pix_x = PIXEL_WIDTH (f);
+ if (pix_x > FRAME_PIXEL_WIDTH (f)) pix_x = FRAME_PIXEL_WIDTH (f);
if (pix_y < 0) pix_y = 0;
- if (pix_y > PIXEL_HEIGHT (f)) pix_y = PIXEL_HEIGHT (f);
+ if (pix_y > FRAME_PIXEL_HEIGHT (f)) pix_y = FRAME_PIXEL_HEIGHT (f);
x_set_mouse_pixel_position (f, pix_x, pix_y);
}
before the window gets really visible. */
if (! FRAME_ICONIFIED_P (f)
&& ! f->output_data.w32->asked_for_visible)
- x_set_offset (f, f->output_data.w32->left_pos, f->output_data.w32->top_pos, 0);
+ x_set_offset (f, f->left_pos, f->top_pos, 0);
f->output_data.w32->asked_for_visible = 1;
struct frame *f;
{
/* Don't keep the highlight on an invisible frame. */
- if (FRAME_W32_DISPLAY_INFO (f)->w32_highlight_frame == f)
- FRAME_W32_DISPLAY_INFO (f)->w32_highlight_frame = 0;
-
+ if (FRAME_W32_DISPLAY_INFO (f)->x_highlight_frame == f)
+ FRAME_W32_DISPLAY_INFO (f)->x_highlight_frame = 0;
+
BLOCK_INPUT;
-
+
my_show_window (f, FRAME_W32_WINDOW (f), SW_HIDE);
-
+
/* We can't distinguish this from iconification
just by the event that we get from the server.
So we can't win using the usual strategy of letting
FRAME_ICONIFIED_P (f) = 0;
f->async_visible = 0;
f->async_iconified = 0;
-
+
UNBLOCK_INPUT;
}
Lisp_Object type;
/* Don't keep the highlight on an invisible frame. */
- if (FRAME_W32_DISPLAY_INFO (f)->w32_highlight_frame == f)
- FRAME_W32_DISPLAY_INFO (f)->w32_highlight_frame = 0;
+ if (FRAME_W32_DISPLAY_INFO (f)->x_highlight_frame == f)
+ FRAME_W32_DISPLAY_INFO (f)->x_highlight_frame = 0;
if (f->async_iconified)
return;
if (FRAME_W32_WINDOW (f))
my_destroy_window (f, FRAME_W32_WINDOW (f));
-
+
free_frame_menubar (f);
unload_color (f, f->output_data.x->foreground_pixel);
if (FRAME_FACE_CACHE (f))
free_frame_faces (f);
-
+
xfree (f->output_data.w32);
f->output_data.w32 = NULL;
-
+
if (f == dpyinfo->w32_focus_frame)
dpyinfo->w32_focus_frame = 0;
if (f == dpyinfo->w32_focus_event_frame)
dpyinfo->w32_focus_event_frame = 0;
- if (f == dpyinfo->w32_highlight_frame)
- dpyinfo->w32_highlight_frame = 0;
+ if (f == dpyinfo->x_highlight_frame)
+ dpyinfo->x_highlight_frame = 0;
if (f == dpyinfo->mouse_face_mouse_frame)
{
enter_crit ();
- SetWindowLong (window, WND_FONTWIDTH_INDEX, FONT_WIDTH (f->output_data.w32->font));
- SetWindowLong (window, WND_LINEHEIGHT_INDEX, f->output_data.w32->line_height);
- SetWindowLong (window, WND_BORDER_INDEX, f->output_data.w32->internal_border_width);
- SetWindowLong (window, WND_SCROLLBAR_INDEX, f->output_data.w32->vertical_scroll_bar_extra);
+ SetWindowLong (window, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
+ SetWindowLong (window, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
+ SetWindowLong (window, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
+ SetWindowLong (window, WND_SCROLLBAR_INDEX, f->scroll_bar_actual_width);
leave_crit ();
}
/* Window manager things */
+void
x_wm_set_icon_position (f, icon_x, icon_y)
struct frame *f;
int icon_x, icon_y;
xassert (font != NULL);
for (i = 0; i < dpyinfo->n_fonts; i++)
- if (dpyinfo->font_table[i].name
+ if (dpyinfo->font_table[i].name
&& font == dpyinfo->font_table[i].font)
break;
XFontStruct *font;
int old_width = dpyinfo->smallest_char_width;
int old_height = dpyinfo->smallest_font_height;
-
+
dpyinfo->smallest_font_height = 100000;
dpyinfo->smallest_char_width = 100000;
-
+
for (i = 0; i < dpyinfo->n_fonts; ++i)
if (dpyinfo->font_table[i].name)
{
struct font_info *fontp = dpyinfo->font_table + i;
int w, h;
-
+
font = (XFontStruct *) fontp->font;
xassert (font != (XFontStruct *) ~0);
x_font_min_bounds (font, &w, &h);
-
+
dpyinfo->smallest_font_height = min (dpyinfo->smallest_font_height, h);
dpyinfo->smallest_char_width = min (dpyinfo->smallest_char_width, w);
}
w32_display_name_list = Fcons (Fcons (display_name, Qnil),
w32_display_name_list);
dpyinfo->name_list_element = XCAR (w32_display_name_list);
-
+
dpyinfo->w32_id_name
- = (char *) xmalloc (XSTRING (Vinvocation_name)->size
- + XSTRING (Vsystem_name)->size
+ = (char *) xmalloc (SCHARS (Vinvocation_name)
+ + SCHARS (Vsystem_name)
+ 2);
sprintf (dpyinfo->w32_id_name, "%s@%s",
- XSTRING (Vinvocation_name)->data, XSTRING (Vsystem_name)->data);
+ SDATA (Vinvocation_name), SDATA (Vsystem_name));
/* Default Console mode values - overridden when running in GUI mode
with values obtained from system metrics. */
dpyinfo->mouse_face_window = Qnil;
dpyinfo->mouse_face_overlay = Qnil;
dpyinfo->mouse_face_hidden = 0;
+
+ dpyinfo->vertical_scroll_bar_cursor = w32_load_cursor (IDC_ARROW);
/* TODO: dpyinfo->gray */
}
+/* Create an xrdb-style database of resources to supercede registry settings.
+ The database is just a concatenation of C strings, finished by an additional
+ \0. The string are submitted to some basic normalization, so
+
+ [ *]option[ *]:[ *]value...
+
+ becomes
+
+ option:value...
+
+ but any whitespace following value is not removed. */
+
+static char *
+w32_make_rdb (xrm_option)
+ char *xrm_option;
+{
+ char *buffer = xmalloc (strlen (xrm_option) + 2);
+ char *current = buffer;
+ char ch;
+ int in_option = 1;
+ int before_value = 0;
+
+ do {
+ ch = *xrm_option++;
+
+ if (ch == '\n')
+ {
+ *current++ = '\0';
+ in_option = 1;
+ before_value = 0;
+ }
+ else if (ch != ' ')
+ {
+ *current++ = ch;
+ if (in_option && (ch == ':'))
+ {
+ in_option = 0;
+ before_value = 1;
+ }
+ else if (before_value)
+ {
+ before_value = 0;
+ }
+ }
+ else if (!(in_option || before_value))
+ {
+ *current++ = ch;
+ }
+ } while (ch);
+
+ *current = '\0';
+
+ return buffer;
+}
+
struct w32_display_info *
w32_term_init (display_name, xrm_option, resource_name)
Lisp_Object display_name;
{
struct w32_display_info *dpyinfo;
HDC hdc;
-
+
BLOCK_INPUT;
-
+
if (!w32_initialized)
{
w32_initialize ();
w32_initialized = 1;
}
-
- {
- int argc = 0;
- char *argv[3];
- argv[0] = "";
- argc = 1;
- if (xrm_option)
- {
- argv[argc++] = "-xrm";
- argv[argc++] = xrm_option;
- }
- }
-
w32_initialize_display_info (display_name);
dpyinfo = &one_w32_display_info;
+ dpyinfo->xrdb = xrm_option ? w32_make_rdb (xrm_option) : NULL;
+
/* Put this display on the chain. */
dpyinfo->next = x_display_list;
x_display_list = dpyinfo;
-
+
hdc = GetDC (GetDesktopWindow ());
dpyinfo->height = GetDeviceCaps (hdc, VERTRES);
/* initialise palette with white and black */
{
- COLORREF color;
+ XColor color;
w32_defined_color (0, "white", &color, 1);
w32_defined_color (0, "black", &color, 1);
}
- /* Create Row Bitmaps and store them for later use. */
- left_bmp = CreateBitmap (left_width, left_height, 1, 1, left_bits);
- ov_bmp = CreateBitmap (ov_width, ov_height, 1, 1, ov_bits);
- right_bmp = CreateBitmap (right_width, right_height, 1, 1, right_bits);
- continued_bmp = CreateBitmap (continued_width, continued_height, 1,
- 1, continued_bits);
- continuation_bmp = CreateBitmap (continuation_width, continuation_height,
- 1, 1, continuation_bits);
- zv_bmp = CreateBitmap (zv_width, zv_height, 1, 1, zv_bits);
+ /* Create Fringe Bitmaps and store them for later use.
+
+ On W32, bitmaps are all unsigned short, as Windows requires
+ bitmap data to be Word aligned. For some reason they are
+ horizontally reflected compared to how they appear on X, so we
+ need to bitswap and convert to unsigned shorts before creating
+ the bitmaps. */
+ {
+ int i, j;
+
+ for (i = NO_FRINGE_BITMAP + 1; i < MAX_FRINGE_BITMAPS; i++)
+ {
+ int h = fringe_bitmaps[i].height;
+ int wd = fringe_bitmaps[i].width;
+ unsigned short *w32bits
+ = (unsigned short *)alloca (h * sizeof (unsigned short));
+ unsigned short *wb = w32bits;
+ unsigned char *bits = fringe_bitmaps[i].bits;
+ for (j = 0; j < h; j++)
+ {
+ static unsigned char swap_nibble[16]
+ = { 0x0, 0x8, 0x4, 0xc, /* 0000 1000 0100 1100 */
+ 0x2, 0xa, 0x6, 0xe, /* 0010 1010 0110 1110 */
+ 0x1, 0x9, 0x5, 0xd, /* 0001 1001 0101 1101 */
+ 0x3, 0xb, 0x7, 0xf }; /* 0011 1011 0111 1111 */
+
+ unsigned char b = *bits++;
+ *wb++ = (unsigned short)((swap_nibble[b & 0xf]<<4)
+ | (swap_nibble[(b>>4) & 0xf]));
+ }
+ fringe_bmp[i] = CreateBitmap (wd, h, 1, 1, w32bits);
+ }
+ }
#ifndef F_SETOWN_BUG
#ifdef F_SETOWN
xfree (dpyinfo->w32_id_name);
/* Destroy row bitmaps. */
- DeleteObject (left_bmp);
- DeleteObject (ov_bmp);
- DeleteObject (right_bmp);
- DeleteObject (continued_bmp);
- DeleteObject (continuation_bmp);
- DeleteObject (zv_bmp);
+ {
+ int i;
+
+ for (i = NO_FRINGE_BITMAP + 1; i < MAX_FRINGE_BITMAPS; i++)
+ DeleteObject (fringe_bmp[i]);
+ }
}
\f
/* Set up use of W32. */
x_flush (struct frame * f)
{ /* Nothing to do */ }
+extern frame_parm_handler w32_frame_parm_handlers[];
+
static struct redisplay_interface w32_redisplay_interface =
{
+ w32_frame_parm_handlers,
x_produce_glyphs,
x_write_glyphs,
x_insert_glyphs,
x_after_update_window_line,
x_update_window_begin,
x_update_window_end,
- w32_cursor_to,
+ x_cursor_to,
x_flush,
- x_clear_mouse_face,
- x_get_glyph_overhangs,
- x_fix_overlapping_area
+ 0, /* flush_display_optional */
+ x_clear_window_mouse_face,
+ w32_get_glyph_overhangs,
+ x_fix_overlapping_area,
+ w32_draw_fringe_bitmap,
+ w32_per_char_metric,
+ w32_encode_char,
+ NULL, /* w32_compute_glyph_string_overhangs */
+ x_draw_glyph_string,
+ w32_define_frame_cursor,
+ w32_clear_frame_area,
+ w32_draw_window_cursor,
+ w32_draw_vertical_window_border,
+ w32_shift_glyphs_for_insert
};
void
condemn_scroll_bars_hook = w32_condemn_scroll_bars;
redeem_scroll_bar_hook = w32_redeem_scroll_bar;
judge_scroll_bars_hook = w32_judge_scroll_bars;
- estimate_mode_line_height_hook = x_estimate_mode_line_height;
scroll_region_ok = 1; /* we'll scroll partial frames */
char_ins_del_ok = 1;
init_crit ();
dwMainThreadId = GetCurrentThreadId ();
- DuplicateHandle (GetCurrentProcess (), GetCurrentThread (),
+ DuplicateHandle (GetCurrentProcess (), GetCurrentThread (),
GetCurrentProcess (), &hMainThread, 0, TRUE, DUPLICATE_SAME_ACCESS);
/* Wait for thread to start */
PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
- hWindowsThread = CreateThread (NULL, 0,
- (LPTHREAD_START_ROUTINE) w32_msg_worker,
+ hWindowsThread = CreateThread (NULL, 0,
+ (LPTHREAD_START_ROUTINE) w32_msg_worker,
0, 0, &dwWindowsThreadId);
GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
}
-
+
/* It is desirable that mainThread should have the same notion of
focus window and active window as windowsThread. Unfortunately, the
following call to AttachThreadInput, which should do precisely what
&Vw32_recognize_altgr,
doc: /* Recognize right-alt and left-ctrl as AltGr.
When nil, the right-alt and left-ctrl key combination is
-interpreted normally. */);
+interpreted normally. */);
Vw32_recognize_altgr = Qt;
DEFVAR_BOOL ("w32-enable-unicode-output",
affect on NT machines. */);
w32_enable_unicode_output = 1;
- help_echo = Qnil;
- staticpro (&help_echo);
- help_echo_object = Qnil;
- staticpro (&help_echo_object);
- help_echo_window = Qnil;
- staticpro (&help_echo_window);
- previous_help_echo = Qnil;
- staticpro (&previous_help_echo);
- help_echo_pos = -1;
-
- DEFVAR_BOOL ("x-autoselect-window", &x_autoselect_window_p,
- doc: /* *Non-nil means autoselect window with mouse pointer. */);
- x_autoselect_window_p = 0;
-
DEFVAR_BOOL ("w32-use-visible-system-caret",
&w32_use_visible_system_caret,
doc: /* Flag to make the system caret visible.
using the system caret instead of drawing its own cursor. Some screen
reader software does not track the system cursor properly when it is
invisible, and gets confused by Emacs drawing its own cursor, so this
-variable is initialized to t when Emacs detects that screen reader
+variable is initialized to t when Emacs detects that screen reader
software is running as it starts up.
When this variable is set, other variables affecting the appearance of
&w32_use_visible_system_caret, 0))
w32_use_visible_system_caret = 0;
- DEFVAR_BOOL ("x-stretch-cursor", &x_stretch_cursor_p,
- doc: /* *Non-nil means draw block cursor as wide as the glyph under it.
-For example, if a block cursor is over a tab, it will be drawn as
-wide as that tab on the display. */);
- x_stretch_cursor_p = 0;
-
-#if 0 /* TODO: Setting underline position from font properties. */
- DEFVAR_BOOL ("x-use-underline-position-properties",
- &x_use_underline_position_properties,
- doc: /* *Non-nil means make use of UNDERLINE_POSITION font properties.
-nil means ignore them. If you encounter fonts with bogus
-UNDERLINE_POSITION font properties, for example 7x13 on XFree prior
-to 4.1, set this to nil. */);
- x_use_underline_position_properties = 1;
-#endif
-
DEFVAR_LISP ("x-toolkit-scroll-bars", &Vx_toolkit_scroll_bars,
doc: /* If not nil, Emacs uses toolkit scroll bars. */);
Vx_toolkit_scroll_bars = Qt;
/* Display generation from window structure and buffer text.
- Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 97, 98, 99, 2000, 2001
+ Copyright (C) 1985,86,87,88,93,94,95,97,98,99,2000,01,02,03
Free Software Foundation, Inc.
This file is part of GNU Emacs.
you will encounter bugs which are very hard to explain.
(Direct functions, see below)
- direct_output_for_insert,
+ direct_output_for_insert,
direct_forward_char (dispnew.c)
+---------------------------------+
| |
|
X expose events -----+
- What does redisplay? Obviously, it has to figure out somehow what
+ What does redisplay do? Obviously, it has to figure out somehow what
has been changed since the last time the display has been updated,
and to make these changes visible. Preferably it would do that in
a moderately intelligent way, i.e. fast.
`direct_output_for_insert' and `direct_output_forward_char' in
dispnew.c.
-
+
Desired matrices.
Desired matrices are always built per Emacs window. The function
on various settings of buffers and windows, on overlays and text
properties, on display tables, on selective display. The good news
is that all this hairy stuff is hidden behind a small set of
- interface functions taking a iterator structure (struct it)
+ interface functions taking an iterator structure (struct it)
argument.
Iteration over things to be displayed is then simple. It is
#include "termchar.h"
#include "dispextern.h"
#include "buffer.h"
+ #include "character.h"
#include "charset.h"
#include "indent.h"
#include "commands.h"
+#include "keymap.h"
#include "macros.h"
#include "disptab.h"
#include "termhooks.h"
#include "process.h"
#include "region-cache.h"
#include "fontset.h"
+#include "blockinput.h"
#ifdef HAVE_X_WINDOWS
#include "xterm.h"
#ifdef WINDOWSNT
#include "w32term.h"
#endif
-#ifdef macintosh
+#ifdef MAC_OS
#include "macterm.h"
+
+Cursor No_Cursor;
+#endif
+
+#ifndef FRAME_X_OUTPUT
+#define FRAME_X_OUTPUT(f) ((f)->output_data.x)
#endif
#define INFINITY 10000000
-#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
+#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (MAC_OS) \
+ || defined (USE_GTK)
extern void set_frame_menubar P_ ((struct frame *f, int, int));
extern int pending_menu_activation;
#endif
extern int command_loop_level;
extern int minibuffer_auto_raise;
+extern Lisp_Object Vminibuffer_list;
extern Lisp_Object Qface;
+extern Lisp_Object Qmode_line, Qmode_line_inactive, Qheader_line;
extern Lisp_Object Voverriding_local_map;
extern Lisp_Object Voverriding_local_map_menu_flag;
extern Lisp_Object Qmenu_item;
+extern Lisp_Object Qwhen;
+extern Lisp_Object Qhelp_echo;
Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
Lisp_Object Qwindow_scroll_functions, Vwindow_scroll_functions;
Lisp_Object Qredisplay_end_trigger_functions;
Lisp_Object Qinhibit_point_motion_hooks;
-Lisp_Object QCeval, Qwhen, QCfile, QCdata, QCpropertize;
+Lisp_Object QCeval, QCfile, QCdata, QCpropertize;
Lisp_Object Qfontified;
Lisp_Object Qgrow_only;
Lisp_Object Qinhibit_eval_during_redisplay;
Lisp_Object Qbuffer_position, Qposition, Qobject;
+/* Cursor shapes */
+Lisp_Object Qbar, Qhbar, Qbox, Qhollow;
+
+Lisp_Object Qrisky_local_variable;
+
+/* Holds the list (error). */
+Lisp_Object list_of_error;
+
/* Functions called to fontify regions of text. */
Lisp_Object Vfontification_functions;
Lisp_Object Qfontification_functions;
+/* Non-zero means automatically select any window when the mouse
+ cursor moves into it. */
+int mouse_autoselect_window;
+
/* Non-zero means draw tool bar buttons raised when the mouse moves
over them. */
/* Thickness of shadow to draw around tool bar buttons. */
-int tool_bar_button_relief;
+EMACS_INT tool_bar_button_relief;
/* Non-zero means automatically resize tool-bars so that all tool-bar
items are visible, and no blank lines remain. */
int auto_resize_tool_bars_p;
+/* Non-zero means draw block and hollow cursor as wide as the glyph
+ under it. For example, if a block cursor is over a tab, it will be
+ drawn as wide as that tab on the display. */
+
+int x_stretch_cursor_p;
+
/* Non-nil means don't actually do any redisplay. */
Lisp_Object Vinhibit_redisplay, Qinhibit_redisplay;
Lisp_Object Qleft_margin, Qright_margin, Qspace_width, Qraise;
Lisp_Object Qmargin;
extern Lisp_Object Qheight;
+extern Lisp_Object QCwidth, QCheight, QCascent;
/* Non-nil means highlight trailing whitespace. */
/* A flag to control how to display unibyte 8-bit character. */
int unibyte_display_via_language_environment;
-
+
/* Nonzero means we have more than one non-mini-buffer-only frame.
Not guaranteed to be accurate except while parsing
frame-title-format. */
/* If cursor motion alone moves point off frame, try scrolling this
many lines up or down if that will bring it back. */
-static int scroll_step;
+static EMACS_INT scroll_step;
/* Nonzero means scroll just far enough to bring point back on the
screen, when appropriate. */
-static int scroll_conservatively;
+static EMACS_INT scroll_conservatively;
/* Recenter the window whenever point gets within this many lines of
the top or bottom of the window. This value is translated into a
- pixel value by multiplying it with CANON_Y_UNIT, which means that
- there is really a fixed pixel height scroll margin. */
+ pixel value by multiplying it with FRAME_LINE_HEIGHT, which means
+ that there is really a fixed pixel height scroll margin. */
-int scroll_margin;
+EMACS_INT scroll_margin;
/* Number of windows showing the buffer of the selected window (or
another buffer with the same base buffer). keyboard.c refers to
of the line that contains the prompt. */
int minibuf_prompt_width;
-int minibuf_prompt_pixel_width;
/* This is the window where the echo area message was displayed. It
is always a mini-buffer window, but it may not be the same window
int windows_or_buffers_changed;
+/* Nonzero means a frame's cursor type has been changed. */
+
+int cursor_type_changed;
+
/* Nonzero after display_mode_line if %l was used and it displayed a
line number. */
/* Line width to consider when repositioning for line number display. */
-static int line_number_display_limit_width;
+static EMACS_INT line_number_display_limit_width;
/* Number of lines to keep in the message log buffer. t means
infinite. nil means don't log at all. */
/* Non-zero means we want a hollow cursor in windows that are not
selected. Zero means there's no cursor in such windows. */
-int cursor_in_non_selected_windows;
+Lisp_Object Vcursor_in_non_selected_windows;
Lisp_Object Qcursor_in_non_selected_windows;
+/* How to blink the default frame cursor off. */
+Lisp_Object Vblink_cursor_alist;
+
/* A scratch glyph row with contents used for generating truncation
glyphs. Also used in direct_output_for_insert. */
int current_mode_line_height, current_header_line_height;
/* The maximum distance to look ahead for text properties. Values
- that are too small let us call compute_char_face and similar
+ that are too small let us call compute_char_face and similar
functions too often which is expensive. Values that are too large
let us call compute_char_face and alike too often because we
might not be interested in text properties that far away. */
#else
#define TRACE_MOVE(x) (void) 0
#endif
-
+
/* Non-zero means automatically scroll windows horizontally to make
point visible. */
/* How close to the margin can point get before the window is scrolled
horizontally. */
-int automatic_hscroll_margin;
+EMACS_INT hscroll_margin;
/* How much to scroll horizontally when point is inside the above margin. */
-Lisp_Object Vautomatic_hscroll_step;
+Lisp_Object Vhscroll_step;
/* A list of symbols, one for each supported image type. */
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. */
static struct props it_props[] =
{
+ {&Qauto_composed, AUTO_COMPOSED_PROP_IDX, handle_auto_composed_prop},
{&Qfontified, FONTIFIED_PROP_IDX, handle_fontified_prop},
/* Handle `face' before `display' because some sub-properties of
`display' need to know the face. */
/* Move within a line ended at the end of a line that must be
continued. */
MOVE_LINE_CONTINUED,
-
+
/* Move within a line ended at the end of a line that would
be displayed truncated. */
MOVE_LINE_TRUNCATED,
MOVE_NEWLINE_OR_CR
};
+/* This counter is used to clear the face cache every once in a while
+ in redisplay_internal. It is incremented for each redisplay.
+ Every CLEAR_FACE_CACHE_COUNT full redisplays, the face cache is
+ cleared. */
+
+#define CLEAR_FACE_CACHE_COUNT 500
+static int clear_face_cache_count;
+
+/* Record the previous terminal frame we displayed. */
+
+static struct frame *previous_terminal_frame;
+
+/* Non-zero while redisplay_internal is in progress. */
+
+int redisplaying_p;
+
+/* Non-zero means don't free realized faces. Bound while freeing
+ realized faces is dangerous because glyph matrices might still
+ reference them. */
+
+int inhibit_free_realized_faces;
+Lisp_Object Qinhibit_free_realized_faces;
+
+/* If a string, XTread_socket generates an event to display that string.
+ (The display is done in read_char.) */
+
+Lisp_Object help_echo_string;
+Lisp_Object help_echo_window;
+Lisp_Object help_echo_object;
+int help_echo_pos;
+
+/* Temporary variable for XTread_socket. */
+
+Lisp_Object previous_help_echo_string;
+
\f
/* Function prototypes. */
static void reconsider_clip_changes P_ ((struct window *, struct buffer *));
static int text_outside_line_unchanged_p P_ ((struct window *, int, int));
static void store_frame_title_char P_ ((char));
-static int store_frame_title P_ ((unsigned char *, int, int));
+static int store_frame_title P_ ((const unsigned char *, int, int));
static void x_consider_frame_title P_ ((Lisp_Object));
static void handle_stop P_ ((struct it *));
static int tool_bar_lines_needed P_ ((struct frame *));
static int display_echo_area_1 P_ ((EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT));
static int resize_mini_window_1 P_ ((EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT));
static Lisp_Object unwind_redisplay P_ ((Lisp_Object));
-static int string_char_and_length P_ ((unsigned char *, int, int *));
+static int string_char_and_length P_ ((const unsigned char *, int, int *));
static struct text_pos display_prop_end P_ ((struct it *, Lisp_Object,
struct text_pos));
static int compute_window_start_on_continuation_line P_ ((struct window *));
static void extend_face_to_end_of_line P_ ((struct it *));
static int append_space P_ ((struct it *, int));
static int make_cursor_line_fully_visible P_ ((struct window *));
-static int try_scrolling P_ ((Lisp_Object, int, int, int, int));
+static int try_scrolling P_ ((Lisp_Object, int, EMACS_INT, EMACS_INT, int, int));
static int try_cursor_movement P_ ((Lisp_Object, struct text_pos, int *));
static int trailing_whitespace_p P_ ((int));
static int message_log_check_duplicate P_ ((int, int, int, int));
static int display_line P_ ((struct it *));
static int display_mode_lines P_ ((struct window *));
static int display_mode_line P_ ((struct window *, enum face_id, Lisp_Object));
-static int display_mode_element P_ ((struct it *, int, int, int, Lisp_Object, Lisp_Object));
+static int display_mode_element P_ ((struct it *, int, int, int, Lisp_Object, Lisp_Object, int));
+static int store_mode_line_string P_ ((char *, Lisp_Object, int, int, int, Lisp_Object));
static char *decode_mode_spec P_ ((struct window *, int, int, int, int *));
static void display_menu_bar P_ ((struct window *));
static int display_count_lines P_ ((int, int, int, int, int *));
static void build_desired_tool_bar_string P_ ((struct frame *f));
static int redisplay_tool_bar P_ ((struct frame *));
static void display_tool_bar_line P_ ((struct it *));
+static void notice_overwritten_cursor P_ ((struct window *,
+ enum glyph_row_area,
+ int, int, int, int));
+
+
#endif /* HAVE_WINDOW_SYSTEM */
Window display dimensions
***********************************************************************/
-/* Return the window-relative maximum y + 1 for glyph rows displaying
- text in window W. This is the height of W minus the height of a
- mode line, if any. */
+/* Return the bottom boundary y-position for text lines in window W.
+ This is the first y position at which a line cannot start.
+ It is relative to the top of the window.
+
+ This is the height of W minus the height of a mode line, if any. */
INLINE int
window_text_bottom_y (w)
struct window *w;
{
- struct frame *f = XFRAME (w->frame);
- int height = XFASTINT (w->height) * CANON_Y_UNIT (f);
+ int height = WINDOW_TOTAL_HEIGHT (w);
if (WINDOW_WANTS_MODELINE_P (w))
height -= CURRENT_MODE_LINE_HEIGHT (w);
return height;
}
-
/* Return the pixel width of display area AREA of window W. AREA < 0
means return the total width of W, not including fringes to
the left and right of the window. */
struct window *w;
int area;
{
- struct frame *f = XFRAME (w->frame);
- int width = XFASTINT (w->width);
-
+ int cols = XFASTINT (w->total_cols);
+ int pixels = 0;
+
if (!w->pseudo_window_p)
{
- width -= FRAME_SCROLL_BAR_WIDTH (f) + FRAME_FRINGE_COLS (f);
-
+ cols -= WINDOW_SCROLL_BAR_COLS (w);
+
if (area == TEXT_AREA)
{
- if (INTEGERP (w->left_margin_width))
- width -= XFASTINT (w->left_margin_width);
- if (INTEGERP (w->right_margin_width))
- width -= XFASTINT (w->right_margin_width);
+ if (INTEGERP (w->left_margin_cols))
+ cols -= XFASTINT (w->left_margin_cols);
+ if (INTEGERP (w->right_margin_cols))
+ cols -= XFASTINT (w->right_margin_cols);
+ pixels = -WINDOW_TOTAL_FRINGE_WIDTH (w);
}
else if (area == LEFT_MARGIN_AREA)
- width = (INTEGERP (w->left_margin_width)
- ? XFASTINT (w->left_margin_width) : 0);
+ {
+ cols = (INTEGERP (w->left_margin_cols)
+ ? XFASTINT (w->left_margin_cols) : 0);
+ pixels = 0;
+ }
else if (area == RIGHT_MARGIN_AREA)
- width = (INTEGERP (w->right_margin_width)
- ? XFASTINT (w->right_margin_width) : 0);
+ {
+ cols = (INTEGERP (w->right_margin_cols)
+ ? XFASTINT (w->right_margin_cols) : 0);
+ pixels = 0;
+ }
}
- return width * CANON_X_UNIT (f);
+ return cols * WINDOW_FRAME_COLUMN_WIDTH (w) + pixels;
}
struct window *w;
{
struct frame *f = XFRAME (w->frame);
- int height = XFASTINT (w->height) * CANON_Y_UNIT (f);
+ int height = WINDOW_TOTAL_HEIGHT (w);
xassert (height >= 0);
-
+
/* Note: the code below that determines the mode-line/header-line
height is essentially the same as that contained in the macro
CURRENT_{MODE,HEADER}_LINE_HEIGHT, except that it checks whether
return max (0, height);
}
+/* Return the window-relative coordinate of the left edge of display
+ area AREA of window W. AREA < 0 means return the left edge of the
+ whole window, to the right of the left fringe of W. */
+
+INLINE int
+window_box_left_offset (w, area)
+ struct window *w;
+ int area;
+{
+ int x;
+
+ if (w->pseudo_window_p)
+ return 0;
+
+ x = WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (w);
+
+ if (area == TEXT_AREA)
+ x += (WINDOW_LEFT_FRINGE_WIDTH (w)
+ + window_box_width (w, LEFT_MARGIN_AREA));
+ else if (area == RIGHT_MARGIN_AREA)
+ x += (WINDOW_LEFT_FRINGE_WIDTH (w)
+ + window_box_width (w, LEFT_MARGIN_AREA)
+ + window_box_width (w, TEXT_AREA)
+ + (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
+ ? 0
+ : WINDOW_RIGHT_FRINGE_WIDTH (w)));
+ else if (area == LEFT_MARGIN_AREA
+ && WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w))
+ x += WINDOW_LEFT_FRINGE_WIDTH (w);
+
+ return x;
+}
+
+
+/* Return the window-relative coordinate of the right edge of display
+ area AREA of window W. AREA < 0 means return the left edge of the
+ whole window, to the left of the right fringe of W. */
+
+INLINE int
+window_box_right_offset (w, area)
+ struct window *w;
+ int area;
+{
+ return window_box_left_offset (w, area) + window_box_width (w, area);
+}
/* Return the frame-relative coordinate of the left edge of display
area AREA of window W. AREA < 0 means return the left edge of the
int area;
{
struct frame *f = XFRAME (w->frame);
- int x = FRAME_INTERNAL_BORDER_WIDTH_SAFE (f);
+ int x;
- if (!w->pseudo_window_p)
- {
- x += (WINDOW_LEFT_MARGIN (w) * CANON_X_UNIT (f)
- + FRAME_LEFT_FRINGE_WIDTH (f));
-
- if (area == TEXT_AREA)
- x += window_box_width (w, LEFT_MARGIN_AREA);
- else if (area == RIGHT_MARGIN_AREA)
- x += (window_box_width (w, LEFT_MARGIN_AREA)
- + window_box_width (w, TEXT_AREA));
- }
+ if (w->pseudo_window_p)
+ return FRAME_INTERNAL_BORDER_WIDTH (f);
+
+ x = (WINDOW_LEFT_EDGE_X (w)
+ + window_box_left_offset (w, area));
return x;
-}
+}
/* Return the frame-relative coordinate of the right edge of display
int area;
{
return window_box_left (w, area) + window_box_width (w, area);
-}
-
+}
/* Get the bounding box of the display area AREA of window W, without
mode lines, in frame-relative coordinates. AREA < 0 means the
int area;
int *box_x, *box_y, *box_width, *box_height;
{
- struct frame *f = XFRAME (w->frame);
-
- *box_width = window_box_width (w, area);
- *box_height = window_box_height (w);
- *box_x = window_box_left (w, area);
- *box_y = (FRAME_INTERNAL_BORDER_WIDTH_SAFE (f)
- + XFASTINT (w->top) * CANON_Y_UNIT (f));
- if (WINDOW_WANTS_HEADER_LINE_P (w))
- *box_y += CURRENT_HEADER_LINE_HEIGHT (w);
+ if (box_width)
+ *box_width = window_box_width (w, area);
+ if (box_height)
+ *box_height = window_box_height (w);
+ if (box_x)
+ *box_x = window_box_left (w, area);
+ if (box_y)
+ {
+ *box_y = WINDOW_TOP_EDGE_Y (w);
+ if (WINDOW_WANTS_HEADER_LINE_P (w))
+ *box_y += CURRENT_HEADER_LINE_HEIGHT (w);
+ }
}
{
int line_height = it->max_ascent + it->max_descent;
int line_top_y = it->current_y;
-
+
if (line_height == 0)
{
if (last_height)
else
{
struct glyph_row *row = it->glyph_row;
-
+
/* Use the default character height. */
it->glyph_row = NULL;
it->what = IT_CHARACTER;
*fully = visible_p = 0;
SET_TEXT_POS_FROM_MARKER (top, w->start);
-
+
/* Compute exact mode line heights, if requested. */
if (exact_mode_line_heights_p)
{
current_mode_line_height
= display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w),
current_buffer->mode_line_format);
-
+
if (WINDOW_WANTS_HEADER_LINE_P (w))
current_header_line_height
= display_mode_line (w, HEADER_LINE_FACE_ID,
{
int top_y = it.current_y;
int bottom_y = line_bottom_y (&it);
- int window_top_y = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w);
-
+ int window_top_y = WINDOW_HEADER_LINE_HEIGHT (w);
+
if (top_y < window_top_y)
visible_p = bottom_y > window_top_y;
else if (top_y < it.last_visible_y)
static INLINE int
string_char_and_length (str, maxlen, len)
- unsigned char *str;
+ const unsigned char *str;
int maxlen, *len;
{
int c;
if (STRING_MULTIBYTE (string))
{
- int rest = STRING_BYTES (XSTRING (string)) - BYTEPOS (pos);
- unsigned char *p = XSTRING (string)->data + BYTEPOS (pos);
+ int rest = SBYTES (string) - BYTEPOS (pos);
+ const unsigned char *p = SDATA (string) + BYTEPOS (pos);
int len;
while (nchars--)
int multibyte_p;
{
int nchars;
-
+
if (multibyte_p)
{
int rest = strlen (s), len;
return nchars;
}
-
+
/* Compute byte position NEWPOS->bytepos corresponding to
NEWPOS->charpos. POS is a known position in string STRING.
NEWPOS->charpos must be >= POS.charpos. */
{
xassert (STRINGP (string));
xassert (CHARPOS (*newpos) >= CHARPOS (pos));
-
+
if (STRING_MULTIBYTE (string))
*newpos = string_pos_nchars_ahead (pos, string,
CHARPOS (*newpos) - CHARPOS (pos));
BYTEPOS (*newpos) = CHARPOS (*newpos);
}
+/* EXPORT:
+ Return an estimation of the pixel height of mode or top lines on
+ frame F. FACE_ID specifies what line's height to estimate. */
+
+int
+estimate_mode_line_height (f, face_id)
+ struct frame *f;
+ enum face_id face_id;
+{
+#ifdef HAVE_WINDOW_SYSTEM
+ if (FRAME_WINDOW_P (f))
+ {
+ int height = FONT_HEIGHT (FRAME_FONT (f));
+
+ /* This function is called so early when Emacs starts that the face
+ cache and mode line face are not yet initialized. */
+ if (FRAME_FACE_CACHE (f))
+ {
+ struct face *face = FACE_FROM_ID (f, face_id);
+ if (face)
+ {
+ if (face->font)
+ height = FONT_HEIGHT (face->font);
+ if (face->box_line_width > 0)
+ height += 2 * face->box_line_width;
+ }
+ }
+
+ return height;
+ }
+#endif
+
+ return 1;
+}
+
+/* Given a pixel position (PIX_X, PIX_Y) on frame F, return glyph
+ co-ordinates in (*X, *Y). Set *BOUNDS to the rectangle that the
+ glyph at X, Y occupies, if BOUNDS != 0. If NOCLIP is non-zero, do
+ not force the value into range. */
+
+void
+pixel_to_glyph_coords (f, pix_x, pix_y, x, y, bounds, noclip)
+ FRAME_PTR f;
+ register int pix_x, pix_y;
+ int *x, *y;
+ NativeRectangle *bounds;
+ int noclip;
+{
+
+#ifdef HAVE_WINDOW_SYSTEM
+ if (FRAME_WINDOW_P (f))
+ {
+ /* Arrange for the division in FRAME_PIXEL_X_TO_COL etc. to round down
+ even for negative values. */
+ if (pix_x < 0)
+ pix_x -= FRAME_COLUMN_WIDTH (f) - 1;
+ if (pix_y < 0)
+ pix_y -= FRAME_LINE_HEIGHT (f) - 1;
+
+ pix_x = FRAME_PIXEL_X_TO_COL (f, pix_x);
+ pix_y = FRAME_PIXEL_Y_TO_LINE (f, pix_y);
+
+ if (bounds)
+ STORE_NATIVE_RECT (*bounds,
+ FRAME_COL_TO_PIXEL_X (f, pix_x),
+ FRAME_LINE_TO_PIXEL_Y (f, pix_y),
+ FRAME_COLUMN_WIDTH (f) - 1,
+ FRAME_LINE_HEIGHT (f) - 1);
+
+ if (!noclip)
+ {
+ if (pix_x < 0)
+ pix_x = 0;
+ else if (pix_x > FRAME_TOTAL_COLS (f))
+ pix_x = FRAME_TOTAL_COLS (f);
+
+ if (pix_y < 0)
+ pix_y = 0;
+ else if (pix_y > FRAME_LINES (f))
+ pix_y = FRAME_LINES (f);
+ }
+ }
+#endif
+
+ *x = pix_x;
+ *y = pix_y;
+}
+
+
+/* Given HPOS/VPOS in the current matrix of W, return corresponding
+ frame-relative pixel positions in *FRAME_X and *FRAME_Y. If we
+ can't tell the positions because W's display is not up to date,
+ return 0. */
+
+int
+glyph_to_pixel_coords (w, hpos, vpos, frame_x, frame_y)
+ struct window *w;
+ int hpos, vpos;
+ int *frame_x, *frame_y;
+{
+#ifdef HAVE_WINDOW_SYSTEM
+ if (FRAME_WINDOW_P (XFRAME (WINDOW_FRAME (w))))
+ {
+ int success_p;
+
+ xassert (hpos >= 0 && hpos < w->current_matrix->matrix_w);
+ xassert (vpos >= 0 && vpos < w->current_matrix->matrix_h);
+
+ if (display_completed)
+ {
+ struct glyph_row *row = MATRIX_ROW (w->current_matrix, vpos);
+ struct glyph *glyph = row->glyphs[TEXT_AREA];
+ struct glyph *end = glyph + min (hpos, row->used[TEXT_AREA]);
+
+ hpos = row->x;
+ vpos = row->y;
+ while (glyph < end)
+ {
+ hpos += glyph->pixel_width;
+ ++glyph;
+ }
+
+ success_p = 1;
+ }
+ else
+ {
+ hpos = vpos = 0;
+ success_p = 0;
+ }
+
+ *frame_x = WINDOW_TO_FRAME_PIXEL_X (w, hpos);
+ *frame_y = WINDOW_TO_FRAME_PIXEL_Y (w, vpos);
+ return success_p;
+ }
+#endif
+
+ *frame_x = hpos;
+ *frame_y = vpos;
+ return 1;
+}
+
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* Find the glyph under window-relative coordinates X/Y in window W.
+ Consider only glyphs from buffer text, i.e. no glyphs from overlay
+ strings. Return in *HPOS and *VPOS the row and column number of
+ the glyph found. Return in *AREA the glyph area containing X.
+ Value is a pointer to the glyph found or null if X/Y is not on
+ text, or we can't tell because W's current matrix is not up to
+ date. */
+
+static struct glyph *
+x_y_to_hpos_vpos (w, x, y, hpos, vpos, area, buffer_only_p)
+ struct window *w;
+ int x, y;
+ int *hpos, *vpos, *area;
+ int buffer_only_p;
+{
+ struct glyph *glyph, *end;
+ struct glyph_row *row = NULL;
+ int x0, i;
+
+ /* Find row containing Y. Give up if some row is not enabled. */
+ for (i = 0; i < w->current_matrix->nrows; ++i)
+ {
+ row = MATRIX_ROW (w->current_matrix, i);
+ if (!row->enabled_p)
+ return NULL;
+ if (y >= row->y && y < MATRIX_ROW_BOTTOM_Y (row))
+ break;
+ }
+
+ *vpos = i;
+ *hpos = 0;
+
+ /* Give up if Y is not in the window. */
+ if (i == w->current_matrix->nrows)
+ return NULL;
+
+ /* Get the glyph area containing X. */
+ if (w->pseudo_window_p)
+ {
+ *area = TEXT_AREA;
+ x0 = 0;
+ }
+ else
+ {
+ if (x < window_box_left_offset (w, TEXT_AREA))
+ {
+ *area = LEFT_MARGIN_AREA;
+ x0 = window_box_left_offset (w, LEFT_MARGIN_AREA);
+ }
+ else if (x < window_box_right_offset (w, TEXT_AREA))
+ {
+ *area = TEXT_AREA;
+ x0 = window_box_left_offset (w, TEXT_AREA);
+ }
+ else
+ {
+ *area = RIGHT_MARGIN_AREA;
+ x0 = window_box_left_offset (w, RIGHT_MARGIN_AREA);
+ }
+ }
+
+ /* Find glyph containing X. */
+ glyph = row->glyphs[*area];
+ end = glyph + row->used[*area];
+ while (glyph < end)
+ {
+ if (x < x0 + glyph->pixel_width)
+ {
+ if (w->pseudo_window_p)
+ break;
+ else if (!buffer_only_p || BUFFERP (glyph->object))
+ break;
+ }
+
+ x0 += glyph->pixel_width;
+ ++glyph;
+ }
+
+ if (glyph == end)
+ return NULL;
+
+ *hpos = glyph - row->glyphs[*area];
+ return glyph;
+}
+
+
+/* EXPORT:
+ Convert frame-relative x/y to coordinates relative to window W.
+ Takes pseudo-windows into account. */
+
+void
+frame_to_window_pixel_xy (w, x, y)
+ struct window *w;
+ int *x, *y;
+{
+ if (w->pseudo_window_p)
+ {
+ /* A pseudo-window is always full-width, and starts at the
+ left edge of the frame, plus a frame border. */
+ struct frame *f = XFRAME (w->frame);
+ *x -= FRAME_INTERNAL_BORDER_WIDTH (f);
+ *y = FRAME_TO_WINDOW_PIXEL_Y (w, *y);
+ }
+ else
+ {
+ *x -= WINDOW_LEFT_EDGE_X (w);
+ *y = FRAME_TO_WINDOW_PIXEL_Y (w, *y);
+ }
+}
+
+/* EXPORT:
+ Return in *R the clipping rectangle for glyph string S. */
+
+void
+get_glyph_string_clip_rect (s, nr)
+ struct glyph_string *s;
+ NativeRectangle *nr;
+{
+ XRectangle r;
+
+ if (s->row->full_width_p)
+ {
+ /* Draw full-width. X coordinates are relative to S->w->left_col. */
+ r.x = WINDOW_LEFT_EDGE_X (s->w);
+ r.width = WINDOW_TOTAL_WIDTH (s->w);
+
+ /* Unless displaying a mode or menu bar line, which are always
+ fully visible, clip to the visible part of the row. */
+ if (s->w->pseudo_window_p)
+ r.height = s->row->visible_height;
+ else
+ r.height = s->height;
+ }
+ else
+ {
+ /* This is a text line that may be partially visible. */
+ r.x = window_box_left (s->w, s->area);
+ r.width = window_box_width (s->w, s->area);
+ r.height = s->row->visible_height;
+ }
+
+ /* If S draws overlapping rows, it's sufficient to use the top and
+ bottom of the window for clipping because this glyph string
+ intentionally draws over other lines. */
+ if (s->for_overlaps_p)
+ {
+ r.y = WINDOW_HEADER_LINE_HEIGHT (s->w);
+ r.height = window_text_bottom_y (s->w) - r.y;
+ }
+ else
+ {
+ /* Don't use S->y for clipping because it doesn't take partially
+ visible lines into account. For example, it can be negative for
+ partially visible lines at the top of a window. */
+ if (!s->row->full_width_p
+ && MATRIX_ROW_PARTIALLY_VISIBLE_AT_TOP_P (s->w, s->row))
+ r.y = WINDOW_HEADER_LINE_HEIGHT (s->w);
+ else
+ r.y = max (0, s->row->y);
+
+ /* If drawing a tool-bar window, draw it over the internal border
+ at the top of the window. */
+ if (s->w == XWINDOW (s->f->tool_bar_window))
+ r.y -= FRAME_INTERNAL_BORDER_WIDTH (s->f);
+ }
+
+ r.y = WINDOW_TO_FRAME_PIXEL_Y (s->w, r.y);
+
+#ifdef HAVE_NTGUI
+ /* ++KFS: From W32 port, but it looks ok for all platforms to me. */
+ /* If drawing the cursor, don't let glyph draw outside its
+ advertised boundaries. Cleartype does this under some circumstances. */
+ if (s->hl == DRAW_CURSOR)
+ {
+ if (s->x > r.x)
+ {
+ r.width -= s->x - r.x;
+ r.x = s->x;
+ }
+ r.width = min (r.width, s->first_glyph->pixel_width);
+ }
+#endif
+
+#ifdef CONVERT_FROM_XRECT
+ CONVERT_FROM_XRECT (r, *nr);
+#else
+ *nr = r;
+#endif
+}
+
+#endif /* HAVE_WINDOW_SYSTEM */
\f
/***********************************************************************
Lisp_Object sexpr;
{
Lisp_Object val;
-
+
if (inhibit_eval_during_redisplay)
val = Qnil;
else
{
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
struct gcpro gcpro1;
GCPRO1 (sexpr);
specbind (Qinhibit_redisplay, Qt);
- val = internal_condition_case_1 (Feval, sexpr, Qerror,
+ /* Use Qt to ensure debugger does not run,
+ so there is no possibility of wanting to redisplay. */
+ val = internal_condition_case_1 (Feval, sexpr, Qt,
safe_eval_handler);
UNGCPRO;
val = unbind_to (count, val);
}
-
+
return val;
}
Lisp_Object *args;
{
Lisp_Object val;
-
+
if (inhibit_eval_during_redisplay)
val = Qnil;
else
{
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
struct gcpro gcpro1;
GCPRO1 (args[0]);
gcpro1.nvars = nargs;
specbind (Qinhibit_redisplay, Qt);
- val = internal_condition_case_2 (Ffuncall, nargs, args, Qerror,
+ /* Use Qt to ensure debugger does not run,
+ so there is no possibility of wanting to redisplay. */
+ val = internal_condition_case_2 (Ffuncall, nargs, args, Qt,
safe_eval_handler);
UNGCPRO;
val = unbind_to (count, val);
DEFAULT_FACE_ID for normal text, MODE_LINE_FACE_ID,
MODE_LINE_INACTIVE_FACE_ID, or HEADER_LINE_FACE_ID for displaying
mode lines, or TOOL_BAR_FACE_ID for displaying the tool-bar.
-
+
If ROW is null and BASE_FACE_ID is equal to MODE_LINE_FACE_ID,
MODE_LINE_INACTIVE_FACE_ID, or HEADER_LINE_FACE_ID, the iterator
will be initialized to use the corresponding mode line glyph row of
/* If face attributes have been changed since the last redisplay,
free realized faces now because they depend on face definitions
- that might have changed. */
- if (face_change_count)
+ that might have changed. Don't free faces while there might be
+ desired matrices pending which reference these faces. */
+ if (face_change_count && !inhibit_free_realized_faces)
{
face_change_count = 0;
free_all_realized_faces (Qnil);
else if (base_face_id == HEADER_LINE_FACE_ID)
row = MATRIX_HEADER_LINE_ROW (w->desired_matrix);
}
-
+
/* Clear IT. */
bzero (it, sizeof *it);
it->current.overlay_string_index = -1;
/* Current value of the `space-width', and 'height' properties. */
it->space_width = Qnil;
it->font_height = Qnil;
-
+
/* Are control characters displayed as `^C'? */
it->ctl_arrow_p = !NILP (current_buffer->ctl_arrow);
invisible. */
it->selective = (INTEGERP (current_buffer->selective_display)
? XFASTINT (current_buffer->selective_display)
- : (!NILP (current_buffer->selective_display)
+ : (!NILP (current_buffer->selective_display)
? -1 : 0));
it->selective_display_ellipsis_p
= !NILP (current_buffer->selective_display_ellipses);
-1 to indicate no region. */
if (highlight_region_p
/* Maybe highlight only in selected window. */
- && (/* Either show region everywhere. */
+ && (/* Either show region everywhere. */
highlight_nonselected_windows
/* Or show region in the selected window. */
|| w == XWINDOW (selected_window)
/* Or show the region if we are in the mini-buffer and W is
the window the mini-buffer refers to. */
|| (MINI_WINDOW_P (XWINDOW (selected_window))
- && WINDOWP (Vminibuf_selected_window)
- && w == XWINDOW (Vminibuf_selected_window))))
+ && WINDOWP (minibuf_selected_window)
+ && w == XWINDOW (minibuf_selected_window))))
{
int charpos = marker_position (current_buffer->mark);
it->region_beg_charpos = min (PT, charpos);
{
/* Mode lines, menu bar in terminal frames. */
it->first_visible_x = 0;
- it->last_visible_x = XFASTINT (w->width) * CANON_X_UNIT (it->f);
+ it->last_visible_x = WINDOW_TOTAL_WIDTH (w);
}
else
{
it->first_visible_x
- = XFASTINT (it->w->hscroll) * CANON_X_UNIT (it->f);
+ = XFASTINT (it->w->hscroll) * FRAME_COLUMN_WIDTH (it->f);
it->last_visible_x = (it->first_visible_x
+ window_box_width (w, TEXT_AREA));
}
it->header_line_p = WINDOW_WANTS_HEADER_LINE_P (w);
- it->current_y = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w) + w->vscroll;
+ it->current_y = WINDOW_HEADER_LINE_HEIGHT (w) + w->vscroll;
}
/* Leave room for a border glyph. */
if (base_face_id != DEFAULT_FACE_ID)
{
struct face *face;
-
+
it->face_id = base_face_id;
/* If we have a boxed mode line, make the first character appear
it->end_charpos = ZV;
it->face_id = -1;
IT_CHARPOS (*it) = charpos;
-
+
/* Compute byte position if not specified. */
if (bytepos < charpos)
IT_BYTEPOS (*it) = CHAR_TO_BYTE (charpos);
/* Compute faces etc. */
reseat (it, it->current.pos, 1);
}
-
+
CHECK_IT (it);
}
{
int start_at_line_beg_p;
int first_y = it->current_y;
-
+
/* If window start is not at a line start, skip forward to POS to
get the correct continuation lines width. */
start_at_line_beg_p = (CHARPOS (pos) == BEGV
|| FETCH_BYTE (BYTEPOS (pos) - 1) == '\n');
if (!start_at_line_beg_p)
{
+ int new_x;
+
reseat_at_previous_visible_line_start (it);
move_it_to (it, CHARPOS (pos), -1, -1, -1, MOVE_TO_POS);
+ new_x = it->current_x + it->pixel_width;
+
/* If lines are continued, this line may end in the middle
of a multi-glyph character (e.g. a control character
displayed as \003, or in the middle of an overlay
string). In this case move_it_to above will not have
taken us to the start of the continuation line but to the
end of the continued line. */
- if (it->current_x > 0)
+ if (it->current_x > 0
+ && !it->truncate_lines_p /* Lines are continued. */
+ && (/* And glyph doesn't fit on the line. */
+ new_x > it->last_visible_x
+ /* Or it fits exactly and we're on a window
+ system frame. */
+ || (new_x == it->last_visible_x
+ && FRAME_WINDOW_P (it->f))))
{
if (it->current.dpvec_index >= 0
|| it->current.overlay_string_index >= 0)
set_iterator_to_next (it, 1);
move_it_in_display_line_to (it, -1, -1, 0);
}
-
+
it->continuation_lines_width += it->current_x;
}
fields in the iterator structure. */
it->max_ascent = it->max_descent = 0;
it->max_phys_ascent = it->max_phys_descent = 0;
-
+
it->current_y = first_y;
it->vpos = 0;
it->current_x = it->hpos = 0;
#if 0 /* Don't assert the following because start_display is sometimes
called intentionally with a window start that is not at a
line start. Please leave this code in as a comment. */
-
+
/* Window start should be on a line start, now. */
xassert (it->continuation_lines_width
|| IT_CHARPOS (it) == BEGV
Lisp_Object prop, window;
int ellipses_p = 0;
int charpos = CHARPOS (pos->pos);
-
+
/* If POS specifies a position in a display vector, this might
be for an ellipsis displayed for invisible text. We won't
get the iterator set up for delivering that ellipsis unless
{
int charpos = CHARPOS (pos->pos), bytepos = BYTEPOS (pos->pos);
int i, overlay_strings_with_newlines = 0;
-
+
/* If POS specifies a position in a display vector, this might
be for an ellipsis displayed for invisible text. We won't
get the iterator set up for delivering that ellipsis unless
--charpos;
bytepos = 0;
}
-
+
/* Keep in mind: the call to reseat in init_iterator skips invisible
text, so we might end up at a position different from POS. This
is only a problem when POS is a row start after a newline and an
for (i = 0; i < it->n_overlay_strings; ++i)
{
- char *s = XSTRING (it->overlay_strings[i])->data;
- char *e = s + STRING_BYTES (XSTRING (it->overlay_strings[i]));
-
+ const char *s = SDATA (it->overlay_strings[i]);
+ const char *e = s + SBYTES (it->overlay_strings[i]);
+
while (s < e && *s != '\n')
++s;
correct the overlay string index. */
if (it->method == next_element_from_image)
pop_it (it);
-
+
/* We already have the first chunk of overlay strings in
IT->overlay_strings. Load more until the one for
pos->overlay_string_index is in IT->overlay_strings. */
it->current.overlay_string_index += OVERLAY_STRING_CHUNK_SIZE;
}
}
-
+
it->current.overlay_string_index = pos->overlay_string_index;
relative_index = (it->current.overlay_string_index
% OVERLAY_STRING_CHUNK_SIZE);
it->current.string_pos = pos->string_pos;
it->method = next_element_from_string;
}
-
+
#if 0 /* This is bogus because POS not having an overlay string
position does not mean it's after the string. Example: A
line starting with a before-string and initialization of IT
it->overlay_strings_at_end_processed_p = 1;
}
#endif /* 0 */
-
+
if (CHARPOS (pos->string_pos) >= 0)
{
/* Recorded position is not in an overlay string, but in another
xassert (it->dpvec && it->current.dpvec_index == 0);
it->current.dpvec_index = pos->dpvec_index;
}
-
+
CHECK_IT (it);
return !overlay_strings_with_newlines;
}
CHECK_IT (it);
}
-
+
/* Initialize IT for stepping through current_buffer in window W
starting in the line following ROW, i.e. starting at ROW->end.
Value is zero if there are overlay strings with newlines at ROW's
struct glyph_row *row;
{
int success = 0;
-
+
if (init_from_display_pos (it, w, &row->end))
{
if (row->continued_p)
CHECK_IT (it);
success = 1;
}
-
+
return success;
}
do
{
handled = HANDLED_NORMALLY;
-
+
/* Call text property handlers. */
for (p = it_props; p->handler; ++p)
{
/* Handle overlay changes. */
if (handle_overlay_change_p)
handled = handle_overlay_change (it);
-
+
/* Determine where to stop next. */
if (handled == HANDLED_NORMALLY)
compute_stop_pos (it);
/* If nowhere else, stop at the end. */
it->stop_charpos = it->end_charpos;
-
+
if (STRINGP (it->string))
{
/* Strings are usually short, so don't limit the search for
else if (IT_CHARPOS (*it) < it->region_end_charpos)
it->stop_charpos = min (it->stop_charpos, it->region_end_charpos);
}
-
+
/* Set up variables for computing the stop position from text
property changes. */
XSETBUFFER (object, current_buffer);
if (!EQ (values_here[p->idx], new_value))
break;
}
-
+
if (p->handler)
break;
}
prop = Fget_char_property (pos, Qfontified, Qnil),
NILP (prop)))
{
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
Lisp_Object val;
val = Vfontification_functions;
specbind (Qfontification_functions, Qnil);
-
+
if (!CONSP (val) || EQ (XCAR (val), Qlambda))
safe_call1 (val, pos);
else
globals = Qnil;
GCPRO2 (val, globals);
-
+
for (; CONSP (val); val = XCDR (val))
{
fn = XCAR (val);
-
+
if (EQ (fn, Qt))
{
/* A value of t indicates this hook has a local
struct it *it;
{
int new_face_id, next_stop;
-
+
if (!STRINGP (it->string))
{
new_face_id
(IT_CHARPOS (*it)
+ TEXT_PROP_DISTANCE_LIMIT),
0);
-
+
/* Is this a start of a run of characters with box face?
Caveat: this can be called for a freshly initialized
iterator; face_id is -1 in this case. We know that the new
if (new_face_id != it->face_id)
{
struct face *new_face = FACE_FROM_ID (it->f, new_face_id);
-
+
/* If new face has a box but old face has not, this is
the start of a run of characters with box, i.e. it has
a shadow on the left side. The value of face_id of the
bufpos = IT_CHARPOS (*it);
else
bufpos = 0;
-
+
/* For strings from a buffer, i.e. overlay strings or strings
from a `display' property, use the face at IT's current
buffer position as the base face to merge with, so that
overlay strings appear in the same face as surrounding
text, unless they specify their own faces. */
base_face_id = underlying_face_id (it);
-
+
new_face_id = face_at_string_position (it->w,
it->string,
IT_STRING_CHARPOS (*it),
it->region_end_charpos,
&next_stop,
base_face_id, 0);
-
+
#if 0 /* This shouldn't be neccessary. Let's check it. */
/* If IT is used to display a mode line we would really like to
use the mode line face instead of the frame's default face. */
&& new_face_id == DEFAULT_FACE_ID)
new_face_id = CURRENT_MODE_LINE_FACE_ID (it->w);
#endif
-
+
/* Is this a start of a run of characters with box? Caveat:
this can be called for a freshly allocated iterator; face_id
is -1 is this case. We know that the new face will not
{
struct face *new_face = FACE_FROM_ID (it->f, new_face_id);
struct face *old_face = FACE_FROM_ID (it->f, it->face_id);
-
+
/* If new face has a box but old face hasn't, this is the
start of a run of characters with box, i.e. it has a
shadow on the left side. */
it->face_box_p = new_face->box != FACE_NO_BOX;
}
}
-
+
it->face_id = new_face_id;
return HANDLED_NORMALLY;
}
struct text_pos pos;
xassert (it->s == NULL);
-
+
if (STRINGP (it->string))
{
int bufpos, base_face_id;
-
+
/* No face change past the end of the string (for the case
we are padding with spaces). No face change before the
string start. */
- if (IT_STRING_CHARPOS (*it) >= XSTRING (it->string)->size
+ if (IT_STRING_CHARPOS (*it) >= SCHARS (it->string)
|| (IT_STRING_CHARPOS (*it) == 0 && before_p))
return it->face_id;
suitable for unibyte text if IT->string is unibyte. */
if (STRING_MULTIBYTE (it->string))
{
- unsigned char *p = XSTRING (it->string)->data + BYTEPOS (pos);
- int rest = STRING_BYTES (XSTRING (it->string)) - BYTEPOS (pos);
+ const unsigned char *p = SDATA (it->string) + BYTEPOS (pos);
+ int rest = SBYTES (it->string) - BYTEPOS (pos);
int c, len;
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);
}
if ((IT_CHARPOS (*it) >= ZV && !before_p)
|| (IT_CHARPOS (*it) <= BEGV && before_p))
return it->face_id;
-
+
limit = IT_CHARPOS (*it) + TEXT_PROP_DISTANCE_LIMIT;
pos = it->current.pos;
-
+
if (before_p)
DEC_TEXT_POS (pos, it->multibyte_p);
else
else
INC_TEXT_POS (pos, it->multibyte_p);
}
-
+
/* Determine face for CHARSET_ASCII, or unibyte. */
face_id = face_at_buffer_position (it->w,
CHARPOS (pos),
face_id = FACE_FOR_CHAR (it->f, face, c);
}
}
-
+
return face_id;
}
&& IT_STRING_CHARPOS (*it) < it->end_charpos)
{
handled = HANDLED_RECOMPUTE_PROPS;
-
+
/* Get the position at which the next change of the
invisible text property can be found in IT->string.
Value will be nil if the property value is the same for
all the rest of IT->string. */
- XSETINT (limit, XSTRING (it->string)->size);
+ XSETINT (limit, SCHARS (it->string));
end_charpos = Fnext_single_property_change (charpos, Qinvisible,
- it->string, limit);
-
+ it->string, limit);
+
/* Text at current position is invisible. The next
change in the property is at position end_charpos.
Move IT's current position to that position. */
}
else
{
- struct Lisp_String *s = XSTRING (it->string);
- IT_STRING_CHARPOS (*it) = s->size;
- IT_STRING_BYTEPOS (*it) = STRING_BYTES (s);
+ IT_STRING_CHARPOS (*it) = SCHARS (it->string);
+ IT_STRING_BYTEPOS (*it) = SBYTES (it->string);
}
}
}
int display_ellipsis_p = invis_p == 2;
handled = HANDLED_RECOMPUTE_PROPS;
-
+
/* Loop skipping over invisible text. The loop is left at
ZV or with IT on the first char being visible again. */
do
prop = Fget_char_property (pos, Qinvisible, it->window);
invis_p = TEXT_PROP_MEANS_INVISIBLE (prop);
}
-
+
/* If we ended up on invisible text, proceed to
skip starting with next_stop. */
if (invis_p)
/* The position newpos is now either ZV or on visible text. */
IT_CHARPOS (*it) = newpos;
IT_BYTEPOS (*it) = CHAR_TO_BYTE (newpos);
-
+
/* If there are before-strings at the start of invisible
text, and the text is invisible because of a text
property, arrange to show before-strings because 20.x did
setup_for_ellipsis (it)
struct it *it;
{
- if (it->dp
+ if (it->dp
&& VECTORP (DISP_INVIS_VECTOR (it->dp)))
{
struct Lisp_Vector *v = XVECTOR (DISP_INVIS_VECTOR (it->dp));
it->dpvec = v->contents;
it->dpend = v->contents + v->size;
}
- else
+ else
{
/* Default `...'. */
it->dpvec = default_invis_vector;
it->dpend = default_invis_vector + 3;
}
-
+
/* The ellipsis display does not replace the display of the
character at the new position. Indicate this by setting
IT->dpvec_char_len to zero. */
it->dpvec_char_len = 0;
-
+
it->current.dpvec_index = 0;
it->method = next_element_from_display_vector;
}
if (!NILP (form) && !EQ (form, Qt))
{
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
struct gcpro gcpro1;
/* Bind `object' to the object having the `display' property, a
UNGCPRO;
unbind_to (count, Qnil);
}
-
+
if (NILP (form))
return 0;
{
if (FRAME_TERMCAP_P (it->f) || FRAME_MSDOS_P (it->f))
return 0;
-
+
/* `(height HEIGHT)'. */
it->font_height = XCAR (XCDR (prop));
if (!NILP (it->font_height))
{
/* Value is a multiple of the canonical char height. */
struct face *face;
-
+
face = FACE_FROM_ID (it->f, DEFAULT_FACE_ID);
new_height = (XFLOATINT (it->font_height)
* XINT (face->lface[LFACE_HEIGHT_INDEX]));
/* Evaluate IT->font_height with `height' bound to the
current specified height to get the new height. */
Lisp_Object value;
- int count = BINDING_STACK_SIZE ();
-
+ int count = SPECPDL_INDEX ();
+
specbind (Qheight, face->lface[LFACE_HEIGHT_INDEX]);
value = safe_eval (it->font_height);
unbind_to (count, Qnil);
-
+
if (NUMBERP (value))
new_height = XFLOATINT (value);
}
-
+
if (new_height > 0)
it->face_id = face_with_height (it->f, it->face_id, new_height);
}
/* `(space_width WIDTH)'. */
if (FRAME_TERMCAP_P (it->f) || FRAME_MSDOS_P (it->f))
return 0;
-
+
value = XCAR (XCDR (prop));
if (NUMBERP (value) && XFLOATINT (value) > 0)
it->space_width = value;
/* `(raise FACTOR)'. */
if (FRAME_TERMCAP_P (it->f) || FRAME_MSDOS_P (it->f))
return 0;
-
+
#ifdef HAVE_WINDOW_SYSTEM
value = XCAR (XCDR (prop));
if (NUMBERP (value))
if (CONSP (prop) && CONSP (XCAR (prop)))
{
Lisp_Object tem;
-
+
value = XCDR (prop);
if (CONSP (value))
value = XCAR (value);
#else /* not HAVE_WINDOW_SYSTEM */
valid_p = STRINGP (value);
#endif /* not HAVE_WINDOW_SYSTEM */
-
+
if ((EQ (location, Qleft_margin)
|| EQ (location, Qright_margin)
|| NILP (location))
&& !display_replaced_before_p)
{
replaces_text_display_p = 1;
-
+
/* Save current settings of IT so that we can restore them
when we are finished with the glyph property value. */
push_it (it);
-
+
if (NILP (location))
it->area = TEXT_AREA;
else if (EQ (location, Qleft_margin))
it->area = LEFT_MARGIN_AREA;
else
it->area = RIGHT_MARGIN_AREA;
-
+
if (STRINGP (value))
{
it->string = value;
it->multibyte_p = STRING_MULTIBYTE (it->string);
it->current.overlay_string_index = -1;
IT_STRING_CHARPOS (*it) = IT_STRING_BYTEPOS (*it) = 0;
- it->end_charpos = it->string_nchars
- = XSTRING (it->string)->size;
+ it->end_charpos = it->string_nchars = SCHARS (it->string);
it->method = next_element_from_string;
it->stop_charpos = 0;
it->string_from_display_prop_p = 1;
it->position = start_pos;
it->object = NILP (object) ? it->w->buffer : object;
it->method = next_element_from_image;
-
+
/* Say that we haven't consumed the characters with
`display' property yet. The call to pop_it in
set_iterator_to_next will clean this up. */
prop = XCDR (prop);
}
+ if (STRINGP (prop))
+ return 1;
+
if (!CONSP (prop))
return 0;
|| EQ (XCAR (prop), Qright_margin))
return 0;
}
-
- return CONSP (prop) && EQ (XCAR (prop), Qimage);
+
+ return (CONSP (prop)
+ && (EQ (XCAR (prop), Qimage)
+ || EQ (XCAR (prop), Qspace)));
}
{
if (EQ (string, prop))
return 1;
-
+
/* Skip over `when FORM'. */
if (CONSP (prop) && EQ (XCAR (prop), Qwhen))
{
if (!CONSP (prop))
return 0;
}
-
+
return CONSP (prop) && EQ (XCAR (prop), string);
}
`composition' property
***********************************************************************/
- int count = BINDING_STACK_SIZE ();
+ static enum prop_handled
+ handle_auto_composed_prop (it)
+ struct it *it;
+ {
+ enum prop_handled handled = HANDLED_NORMALLY;
+
+ if (! NILP (Vauto_composition_function))
+ {
+ Lisp_Object val;
+ int pos;
+
+ if (STRINGP (it->string))
+ pos = IT_STRING_CHARPOS (*it);
+ else
+ pos = IT_CHARPOS (*it);
+
+ val =Fget_char_property (make_number (pos), Qauto_composed, it->string);
+ if (NILP (val))
+ {
++ int count = SPECPDL_INDEX ();
+ Lisp_Object args[3];
+
+ args[0] = Vauto_composition_function;
+ specbind (Qauto_composition_function, Qnil);
+ args[1] = make_number (pos);
+ args[2] = it->string;
+ safe_call (3, args);
+ unbind_to (count, Qnil);
+
+ val = Fget_char_property (args[1], Qauto_composed, it->string);
+ if (! NILP (val))
+ handled = HANDLED_RECOMPUTE_PROPS;
+ }
+ }
+
+ return handled;
+ }
+
/* Set up iterator IT from `composition' property at its current
position. Called from handle_stop. */
overlay strings to display, IT->string and
IT->current.overlay_string_index are set appropriately here.
Otherwise IT->string is set to nil. */
-
+
static void
next_overlay_string (it)
struct it *it;
they were before overlay strings were processed, and
continue to deliver from current_buffer. */
int display_ellipsis_p = it->stack[it->sp - 1].display_ellipsis_p;
-
+
pop_it (it);
xassert (it->stop_charpos >= BEGV
&& it->stop_charpos <= it->end_charpos);
where we must load IT->overlay_strings with more strings, do
it. */
int i = it->current.overlay_string_index % OVERLAY_STRING_CHUNK_SIZE;
-
+
if (it->current.overlay_string_index && i == 0)
load_overlay_strings (it, 0);
it->method = next_element_from_string;
it->stop_charpos = 0;
}
-
+
CHECK_IT (it);
}
1. All after-strings come in front of before-strings, except
when they come from the same overlay.
-
+
2. Within after-strings, strings are sorted so that overlay strings
from overlays with higher priorities come first.
Value is analogous to strcmp. */
-
+
static int
compare_overlay_entries (e1, e2)
void *e1, *e2;
front of before-string strings. Within before and after-strings,
strings are sorted by overlay priority. See also function
compare_overlay_entries. */
-
+
static void
load_overlay_strings (it, charpos)
struct it *it;
int charpos;
{
extern Lisp_Object Qafter_string, Qbefore_string, Qwindow, Qpriority;
- Lisp_Object ov, overlay, window, str, invisible;
+ Lisp_Object overlay, window, str, invisible;
+ struct Lisp_Overlay *ov;
int start, end;
int size = 20;
int n = 0, i, j, invis_p;
while (0)
/* Process overlay before the overlay center. */
- for (ov = current_buffer->overlays_before; CONSP (ov); ov = XCDR (ov))
+ for (ov = current_buffer->overlays_before; ov; ov = ov->next)
{
- overlay = XCAR (ov);
+ XSETMISC (overlay, ov);
xassert (OVERLAYP (overlay));
start = OVERLAY_POSITION (OVERLAY_START (overlay));
end = OVERLAY_POSITION (OVERLAY_END (overlay));
-
+
if (end < charpos)
break;
position. */
if (end != charpos && start != charpos)
continue;
-
+
/* Skip this overlay if it doesn't apply to IT->w. */
window = Foverlay_get (overlay, Qwindow);
if (WINDOWP (window) && XWINDOW (window) != it->w)
/* If overlay has a non-empty before-string, record it. */
if ((start == charpos || (end == charpos && invis_p))
&& (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))
- && XSTRING (str)->size)
+ && SCHARS (str))
RECORD_OVERLAY_STRING (overlay, str, 0);
-
+
/* If overlay has a non-empty after-string, record it. */
if ((end == charpos || (start == charpos && invis_p))
&& (str = Foverlay_get (overlay, Qafter_string), STRINGP (str))
- && XSTRING (str)->size)
+ && SCHARS (str))
RECORD_OVERLAY_STRING (overlay, str, 1);
}
-
+
/* Process overlays after the overlay center. */
- for (ov = current_buffer->overlays_after; CONSP (ov); ov = XCDR (ov))
+ for (ov = current_buffer->overlays_after; ov; ov = ov->next)
{
- overlay = XCAR (ov);
+ XSETMISC (overlay, ov);
xassert (OVERLAYP (overlay));
start = OVERLAY_POSITION (OVERLAY_START (overlay));
end = OVERLAY_POSITION (OVERLAY_END (overlay));
if (start > charpos)
break;
-
+
/* Skip this overlay if it doesn't start or end at IT's current
position. */
if (end != charpos && start != charpos)
window = Foverlay_get (overlay, Qwindow);
if (WINDOWP (window) && XWINDOW (window) != it->w)
continue;
-
+
/* If the text ``under'' the overlay is invisible, it has a zero
dimension, and both before- and after-strings apply. */
invisible = Foverlay_get (overlay, Qinvisible);
/* If overlay has a non-empty before-string, record it. */
if ((start == charpos || (end == charpos && invis_p))
&& (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))
- && XSTRING (str)->size)
+ && SCHARS (str))
RECORD_OVERLAY_STRING (overlay, str, 0);
-
+
/* If overlay has a non-empty after-string, record it. */
if ((end == charpos || (start == charpos && invis_p))
&& (str = Foverlay_get (overlay, Qafter_string), STRINGP (str))
- && XSTRING (str)->size)
+ && SCHARS (str))
RECORD_OVERLAY_STRING (overlay, str, 1);
}
#undef RECORD_OVERLAY_STRING
-
+
/* Sort entries. */
if (n > 1)
qsort (entries, n, sizeof *entries, compare_overlay_entries);
strings. */
compute_stop_pos (it);
xassert (it->face_id >= 0);
-
+
/* Save IT's settings. They are restored after all overlay
strings have been processed. */
xassert (it->sp == 0);
IT_STRING_CHARPOS (*it) = IT_STRING_BYTEPOS (*it) = 0;
it->string = it->overlay_strings[0];
it->stop_charpos = 0;
- it->end_charpos = XSTRING (it->string)->size;
- it->multibyte_p = STRING_MULTIBYTE (it->string);
xassert (STRINGP (it->string));
+ it->end_charpos = SCHARS (it->string);
+ it->multibyte_p = STRING_MULTIBYTE (it->string);
it->method = next_element_from_string;
}
else
struct it *it;
{
struct iterator_stack_entry *p;
-
+
xassert (it->sp < 2);
p = it->stack + it->sp;
struct it *it;
{
struct iterator_stack_entry *p;
-
+
xassert (it->sp > 0);
--it->sp;
p = it->stack + it->sp;
/* Move IT to the next line start.
-
+
Value is non-zero if a newline was found. Set *SKIPPED_P to 1 if
we skipped over part of the text (as opposed to moving the iterator
continuously over the text). Otherwise, don't change the value
of *SKIPPED_P.
-
+
Newlines may come from buffer text, overlay strings, or strings
displayed via the `display' property. That's the reason we can't
simply use find_next_newline_no_quit.
n += STRINGP (it->string) ? 0 : 1)
{
if (!get_next_display_element (it))
- break;
+ return 0;
newline_found_p = it->what == IT_CHARACTER && it->c == '\n';
set_iterator_to_next (it, 0);
}
/* If we didn't find a newline near enough, see if we can use a
short-cut. */
- if (n == MAX_NEWLINE_DISTANCE)
+ if (!newline_found_p)
{
int start = IT_CHARPOS (*it);
int limit = find_next_newline_no_quit (start, 1);
are invisible. */
if (it->selective > 0
&& indented_beyond_p (IT_CHARPOS (*it), IT_BYTEPOS (*it),
- it->selective))
+ (double) it->selective)) /* iftc */
visible_p = 0;
- else
+ else
{
Lisp_Object prop;
if (it->selective > 0)
while (IT_CHARPOS (*it) < ZV
&& indented_beyond_p (IT_CHARPOS (*it), IT_BYTEPOS (*it),
- it->selective))
+ (double) it->selective)) /* iftc */
{
xassert (FETCH_BYTE (IT_BYTEPOS (*it) - 1) == '\n');
newline_found_p = forward_to_next_line_start (it, &skipped_p);
}
else if (skipped_p)
reseat (it, it->current.pos, 0);
-
+
CHECK_IT (it);
}
IT_STRING_BYTEPOS (*it) = -1;
it->string = Qnil;
it->method = next_element_from_buffer;
+ /* RMS: I added this to fix a bug in move_it_vertically_backward
+ where it->area continued to relate to the starting point
+ for the backward motion. Bug report from
+ Nick Roberts <nick@nick.uklinux.net> on 19 May 2003.
+ However, I am not sure whether reseat still does the right thing
+ in general after this change. */
+ it->area = TEXT_AREA;
it->multibyte_p = !NILP (current_buffer->enable_multibyte_characters);
it->sp = 0;
it->face_before_selective_p = 0;
/* Set up IT for displaying a string, starting at CHARPOS in window W.
If S is non-null, it is a C string to iterate over. Otherwise,
STRING gives a Lisp string to iterate over.
-
+
If PRECISION > 0, don't return more then PRECISION number of
characters from the string.
it->current.overlay_string_index = -1;
it->current.dpvec_index = -1;
xassert (charpos >= 0);
-
+
/* If STRING is specified, use its multibyteness, otherwise use the
setting of MULTIBYTE, if specified. */
if (multibyte >= 0)
it->multibyte_p = multibyte > 0;
-
+
if (s == NULL)
{
xassert (STRINGP (string));
it->string = string;
it->s = NULL;
- it->end_charpos = it->string_nchars = XSTRING (string)->size;
+ it->end_charpos = it->string_nchars = SCHARS (string);
it->method = next_element_from_string;
it->current.string_pos = string_pos (charpos, string);
}
IT_CHARPOS (*it) = IT_BYTEPOS (*it) = charpos;
it->end_charpos = it->string_nchars = strlen (s);
}
-
+
it->method = next_element_from_c_string;
}
get_next_display_element (it)
struct it *it;
{
- /* Non-zero means that we found an display element. Zero means that
+ /* Non-zero means that we found a display element. Zero means that
we hit the end of what we iterate over. Performance note: the
function pointer `method' used here turns out to be faster than
using a sequence of if-statements. */
the translation. This could easily be changed but I
don't believe that it is worth doing.
- Non-printable multibyte characters are also translated
- octal form. */
+ 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 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
|| (it->c != '\n' && it->c != '\t')))
- || (it->multibyte_p
- ? ((it->c >= 127
- && it->len == 1)
- || !CHAR_PRINTABLE_P (it->c))
- : (it->c >= 127
- && it->c == unibyte_char_to_multibyte (it->c))))
+ || (it->c != '\n' && it->c != '\t'
+ && (it->multibyte_p ? !CHAR_PRINTABLE_P (it->c)
+ : it->c == 127)))
{
/* IT->c is a control character which must be displayed
either as '\003' or as `^C' where the '\\' and '^'
else
escape_glyph = FAST_MAKE_GLYPH ('\\', 0);
- 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++)
XSETINT (it->ctl_chars[i * 4], escape_glyph);
/* Insert three more glyphs into IT->ctl_chars for
the octal display of the character. */
- g = FAST_MAKE_GLYPH (((str[i] >> 6) & 7) + '0', 0);
+ g = FAST_MAKE_GLYPH (((str[i] >> 6) & 7) + '0', 0);
XSETINT (it->ctl_chars[i * 4 + 1], g);
- g = FAST_MAKE_GLYPH (((str[i] >> 3) & 7) + '0', 0);
+ g = FAST_MAKE_GLYPH (((str[i] >> 3) & 7) + '0', 0);
XSETINT (it->ctl_chars[i * 4 + 2], g);
- g = FAST_MAKE_GLYPH ((str[i] & 7) + '0', 0);
+ g = FAST_MAKE_GLYPH ((str[i] & 7) + '0', 0);
XSETINT (it->ctl_chars[i * 4 + 3], g);
}
with box. Reset them at the start of this function because
moving the iterator to a new position might set them. */
it->start_of_box_run_p = it->end_of_box_run_p = 0;
-
+
if (it->method == next_element_from_buffer)
{
/* The current display element of IT is a character from
/* Restore face of the iterator to what they were before the
display vector entry (these entries may contain faces). */
it->face_id = it->saved_face_id;
-
+
if (it->dpvec + it->current.dpvec_index == it->dpend)
{
if (it->s)
xassert (it->s == NULL && STRINGP (it->string));
IT_STRING_BYTEPOS (*it) += it->len;
IT_STRING_CHARPOS (*it) += 1;
-
+
consider_string_end:
if (it->current.overlay_string_index >= 0)
{
/* IT->string is an overlay string. Advance to the
next, if there is one. */
- if (IT_STRING_CHARPOS (*it) >= XSTRING (it->string)->size)
+ if (IT_STRING_CHARPOS (*it) >= SCHARS (it->string))
next_overlay_string (it);
}
else
its end, and there is something on IT->stack, proceed
with what is on the stack. This can be either another
string, this time an overlay string, or a buffer. */
- if (IT_STRING_CHARPOS (*it) == XSTRING (it->string)->size
+ if (IT_STRING_CHARPOS (*it) == SCHARS (it->string)
&& it->sp > 0)
{
pop_it (it);
/* Remember the current face id in case glyphs specify faces.
IT's face is restored in set_iterator_to_next. */
it->saved_face_id = it->face_id;
-
+
if (INTEGERP (*it->dpvec)
&& GLYPH_CHAR_VALID_P (XFASTINT (*it->dpvec)))
{
/* Get the next character from an overlay string. In overlay
strings, There is no field width or padding with spaces to
do. */
- if (IT_STRING_CHARPOS (*it) >= XSTRING (it->string)->size)
+ if (IT_STRING_CHARPOS (*it) >= SCHARS (it->string))
{
it->what = IT_EOB;
return 0;
}
else if (STRING_MULTIBYTE (it->string))
{
- int remaining = (STRING_BYTES (XSTRING (it->string))
- - IT_STRING_BYTEPOS (*it));
- unsigned char *s = (XSTRING (it->string)->data
- + IT_STRING_BYTEPOS (*it));
+ int remaining = SBYTES (it->string) - IT_STRING_BYTEPOS (*it);
+ const unsigned char *s = (SDATA (it->string)
+ + IT_STRING_BYTEPOS (*it));
it->c = string_char_and_length (s, remaining, &it->len);
}
else
{
- it->c = XSTRING (it->string)->data[IT_STRING_BYTEPOS (*it)];
+ it->c = SREF (it->string, IT_STRING_BYTEPOS (*it));
it->len = 1;
}
}
}
else if (STRING_MULTIBYTE (it->string))
{
- int maxlen = (STRING_BYTES (XSTRING (it->string))
- - IT_STRING_BYTEPOS (*it));
- unsigned char *s = (XSTRING (it->string)->data
- + IT_STRING_BYTEPOS (*it));
+ int maxlen = SBYTES (it->string) - IT_STRING_BYTEPOS (*it);
+ const unsigned char *s = (SDATA (it->string)
+ + IT_STRING_BYTEPOS (*it));
it->c = string_char_and_length (s, maxlen, &it->len);
}
else
{
- it->c = XSTRING (it->string)->data[IT_STRING_BYTEPOS (*it)];
+ it->c = SREF (it->string, IT_STRING_BYTEPOS (*it));
it->len = 1;
}
}
struct it *it;
{
int success_p = 1;
-
+
xassert (it->s);
it->what = IT_CHARACTER;
BYTEPOS (it->position) = CHARPOS (it->position) = 0;
it->object = Qnil;
-
+
/* IT's position can be greater IT->string_nchars in case a field
width or precision has been specified when the iterator was
initialized. */
}
else
it->c = it->s[IT_BYTEPOS (*it)], it->len = 1;
-
+
return success_p;
}
reseat_at_next_visible_line_start (it, 1);
it->face_before_selective_p = 1;
}
-
+
return get_next_display_element (it);
}
/* Deliver an image display element. The iterator IT is already
filled with image information (done in handle_display_prop). Value
is always 1. */
-
+
static int
next_element_from_image (it)
if (IT_CHARPOS (*it) >= it->end_charpos)
{
int overlay_strings_follow_p;
-
+
/* End of the game, except when overlay strings follow that
haven't been returned yet. */
if (it->overlay_strings_at_end_processed_p)
&& IT_CHARPOS (*it) + 1 < ZV
&& indented_beyond_p (IT_CHARPOS (*it) + 1,
IT_BYTEPOS (*it) + 1,
- it->selective))
+ (double) it->selective)) /* iftc */
{
success_p = next_element_from_ellipsis (it);
it->dpvec_char_len = -1;
return success_p;
}
-
+
/* Run the redisplay end trigger hook for IT. */
static void
them again, even if they get an error. */
it->w->redisplay_end_trigger = Qnil;
Frun_hook_with_args (3, args);
-
+
/* Notice if it changed the face of the character we are on. */
handle_face_prop (it);
}
/* Move iterator IT to a specified buffer or X position within one
line on the display without producing glyphs.
- Begin to skip at IT's current position. Skip to TO_CHARPOS or TO_X
- whichever is reached first.
+ OP should be a bit mask including some or all of these bits:
+ MOVE_TO_X: Stop on reaching x-position TO_X.
+ MOVE_TO_POS: Stop on reaching buffer or string position TO_CHARPOS.
+ Regardless of OP's value, stop in reaching the end of the display line.
- TO_CHARPOS <= 0 means no TO_CHARPOS is specified.
+ TO_X is normally a value 0 <= TO_X <= IT->last_visible_x.
+ This means, in particular, that TO_X includes window's horizontal
+ scroll amount.
- TO_X < 0 means that no TO_X is specified. TO_X is normally a value
- 0 <= TO_X <= IT->last_visible_x. This means in particular, that
- TO_X includes the amount by which a window is horizontally
- scrolled.
-
- Value is
+ The return value has several possible values that
+ say what condition caused the scan to stop:
MOVE_POS_MATCH_OR_ZV
- when TO_POS or ZV was reached.
-
+
MOVE_X_REACHED
-when TO_X was reached before TO_POS or ZV were reached.
-
+
MOVE_LINE_CONTINUED
- when we reached the end of the display area and the line must
be continued.
-
+
MOVE_LINE_TRUNCATED
- when we reached the end of the display area and the line is
truncated.
while (1)
{
int x, i, ascent = 0, descent = 0;
-
+
/* Stop when ZV or TO_CHARPOS reached. */
if (!get_next_display_element (it)
|| ((op & MOVE_TO_POS) != 0
result = MOVE_POS_MATCH_OR_ZV;
break;
}
-
+
/* The call to produce_glyphs will get the metrics of the
display element IT is loaded with. We record in x the
x-position before this display element in case it does not
fit on the line. */
x = it->current_x;
-
+
/* Remember the line height so far in case the next element doesn't
fit on the line. */
if (!it->truncate_lines_p)
ascent = it->max_ascent;
descent = it->max_descent;
}
-
+
PRODUCE_GLYPHS (it);
if (it->area != TEXT_AREA)
glyphs have the same width. */
int single_glyph_width = it->pixel_width / it->nglyphs;
int new_x;
-
+
for (i = 0; i < it->nglyphs; ++i, x = new_x)
{
new_x = x + single_glyph_width;
it->max_ascent = ascent;
it->max_descent = descent;
}
-
+
TRACE_MOVE ((stderr, "move_it_in: continued at %d\n",
IT_CHARPOS (*it)));
result = MOVE_LINE_CONTINUED;
}
else
{
- /* Glyph is completely off the left margin of the display
+ /* Glyph is completely off the left margin of the display
area. Nothing to do. */
}
}
result = MOVE_X_REACHED;
break;
}
-
+
/* Is this a line end? If yes, we're done. */
if (ITERATOR_AT_END_OF_LINE_P (it))
{
result = MOVE_NEWLINE_OR_CR;
break;
}
-
+
/* The current display element has been consumed. Advance
to the next. */
set_iterator_to_next (it, 1);
-
+
/* Stop if lines are truncated and IT's current x-position is
past the right edge of the window now. */
if (it->truncate_lines_p
}
-/* Move IT forward to a specified buffer position TO_CHARPOS, TO_X,
- TO_Y, TO_VPOS. OP is a bit-mask that specifies where to stop. See
- the description of enum move_operation_enum.
-
+/* Move IT forward until it satisfies one or more of the criteria in
+ TO_CHARPOS, TO_X, TO_Y, and TO_VPOS.
+
+ OP is a bit-mask that specifies where to stop, and in particular,
+ which of those four position arguments makes a difference. See the
+ description of enum move_operation_enum.
+
If TO_CHARPOS is in invisible text, e.g. a truncated part of a
screen line, this function will set IT to the next position >
TO_CHARPOS. */
reached = 2;
break;
}
-
+
skip = move_it_in_display_line_to (it, to_charpos, to_x, op);
if (skip == MOVE_POS_MATCH_OR_ZV || it->vpos == to_vpos)
else if (op & MOVE_TO_Y)
{
struct it it_backup;
-
+
/* TO_Y specified means stop at TO_X in the line containing
TO_Y---or at TO_CHARPOS if this is reached first. The
problem is that we can't really tell whether the line
reached = 5;
break;
}
-
+
/* If TO_X was reached, we would like to know whether TO_Y
is in the line. This can only be said if we know the
total line height which requires us to scan the rest of
/* Now, decide whether TO_Y is in this line. */
line_height = it->max_ascent + it->max_descent;
TRACE_MOVE ((stderr, "move_it: line_height = %d\n", line_height));
-
+
if (to_y >= it->current_y
&& to_y < it->current_y + line_height)
{
last_max_ascent = it->max_ascent;
it->max_ascent = it->max_descent = 0;
}
-
+
out:
TRACE_MOVE ((stderr, "move_it_to: reached %d\n", reached));
int nlines, h;
struct it it2, it3;
int start_pos = IT_CHARPOS (*it);
-
+
xassert (dy >= 0);
/* Estimate how many newlines we must move back. */
- nlines = max (1, dy / CANON_Y_UNIT (it->f));
+ nlines = max (1, dy / FRAME_LINE_HEIGHT (it->f));
/* Set the iterator's position that many lines back. */
while (nlines-- && IT_CHARPOS (*it) > BEGV)
/* We are now surely at a line start. */
it->current_x = it->hpos = 0;
+ it->continuation_lines_width = 0;
/* Move forward and see what y-distance we moved. First move to the
start of the next line so that we get its height. We need this
MOVE_TO_POS | MOVE_TO_VPOS);
xassert (IT_CHARPOS (*it) >= BEGV);
it3 = it2;
-
+
move_it_to (&it2, start_pos, -1, -1, -1, MOVE_TO_POS);
xassert (IT_CHARPOS (*it) >= BEGV);
+ /* H is the actual vertical distance from the position in *IT
+ and the starting position. */
h = it2.current_y - it->current_y;
+ /* NLINES is the distance in number of lines. */
nlines = it2.vpos - it->vpos;
- /* Correct IT's y and vpos position. */
+ /* Correct IT's y and vpos position
+ so that they are relative to the starting point. */
it->vpos -= nlines;
it->current_y -= h;
-
+
if (dy == 0)
{
/* DY == 0 means move to the start of the screen line. The
move_it_by_lines (it, nlines, 1);
xassert (IT_CHARPOS (*it) <= start_pos);
}
- else if (nlines)
+ else
{
- /* The y-position we try to reach. Note that h has been
- subtracted in front of the if-statement. */
+ /* The y-position we try to reach, relative to *IT.
+ Note that H has been subtracted in front of the if-statement. */
int target_y = it->current_y + h - dy;
int y0 = it3.current_y;
int y1 = line_bottom_y (&it3);
else if (target_y >= it->current_y + line_height
&& IT_CHARPOS (*it) < ZV)
{
- /* Should move forward by at least one line, maybe more. */
- do
+ /* Should move forward by at least one line, maybe more.
+
+ Note: Calling move_it_by_lines can be expensive on
+ terminal frames, where compute_motion is used (via
+ vmotion) to do the job, when there are very long lines
+ and truncate-lines is nil. That's the reason for
+ treating terminal frames specially here. */
+
+ if (!FRAME_WINDOW_P (it->f))
+ move_it_vertically (it, target_y - (it->current_y + line_height));
+ else
{
- move_it_by_lines (it, 1, 1);
+ do
+ {
+ move_it_by_lines (it, 1, 1);
+ }
+ while (target_y >= line_bottom_y (it) && IT_CHARPOS (*it) < ZV);
}
- while (target_y >= line_bottom_y (it) && IT_CHARPOS (*it) < ZV);
xassert (IT_CHARPOS (*it) >= BEGV);
}
move backwards. DY = 0 means move to start of screen line. At the
end, IT will be on the start of a screen line. */
-void
+void
move_it_vertically (it, dy)
struct it *it;
int dy;
struct it *it;
{
enum move_it_result rc;
-
+
rc = move_it_in_display_line_to (it, Z, 0, MOVE_TO_POS);
if (rc == MOVE_NEWLINE_OR_CR)
set_iterator_to_next (it, 0);
{
Lisp_Object prop, limit;
int invisible_found_p;
-
+
xassert (it != NULL && start_charpos <= end_charpos);
/* Is text at START invisible? */
int dvpos, need_y_p;
{
struct position pos;
-
+
if (!FRAME_WINDOW_P (it->f))
{
struct text_pos textpos;
-
+
/* We can use vmotion on frames without proportional fonts. */
pos = *vmotion (IT_CHARPOS (*it), dvpos, it->w);
SET_TEXT_POS (textpos, pos.bufpos, pos.bytepos);
{
struct it it2;
int start_charpos, i;
-
+
/* Start at the beginning of the screen line containing IT's
position. */
move_it_vertically_backward (it, 0);
-
+
/* Go back -DVPOS visible lines and reseat the iterator there. */
start_charpos = IT_CHARPOS (*it);
for (i = -dvpos; i && IT_CHARPOS (*it) > BEGV; --i)
}
}
+/* Return 1 if IT points into the middle of a display vector. */
+
+int
+in_display_vector_p (it)
+ struct it *it;
+{
+ return (it->method == next_element_from_display_vector
+ && it->current.dpvec_index > 0
+ && it->dpvec + it->current.dpvec_index != it->dpend);
+}
\f
/***********************************************************************
fmt = msg = Qnil;
GCPRO4 (fmt, msg, arg1, arg2);
-
+
args[0] = fmt = build_string (format);
args[1] = arg1;
args[2] = arg2;
msg = Fformat (3, args);
- len = STRING_BYTES (XSTRING (msg)) + 1;
+ len = SBYTES (msg) + 1;
buffer = (char *) alloca (len);
- bcopy (XSTRING (msg)->data, buffer, len);
-
+ bcopy (SDATA (msg), buffer, len);
+
message_dolog (buffer, len - 1, 1, 0);
UNGCPRO;
}
void
message_dolog (m, nbytes, nlflag, multibyte)
- char *m;
+ const char *m;
int nbytes, nlflag, multibyte;
{
+ if (!NILP (Vmemory_full))
+ return;
+
if (!NILP (Vmessage_log_max))
{
struct buffer *oldbuf;
{
int i, c, char_bytes;
unsigned char work[1];
-
+
/* Convert a multibyte string to single-byte
for the *Message* buffer. */
- for (i = 0; i < nbytes; i += nbytes)
+ 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);
XMARKER (oldpoint)->bytepos);
UNGCPRO;
- unchain_marker (oldpoint);
- unchain_marker (oldbegv);
- unchain_marker (oldzv);
+ unchain_marker (XMARKER (oldpoint));
+ unchain_marker (XMARKER (oldbegv));
+ unchain_marker (XMARKER (oldzv));
tem = Fget_buffer_window (Fcurrent_buffer (), Qt);
set_buffer_internal (oldbuf);
void
message2 (m, nbytes, multibyte)
- char *m;
+ const char *m;
int nbytes;
int multibyte;
{
void
message2_nolog (m, nbytes, multibyte)
- char *m;
+ const char *m;
int nbytes, multibyte;
{
struct frame *sf = SELECTED_FRAME ();
/* A null message buffer means that the frame hasn't really been
initialized yet. Error messages get reported properly by
cmd_error, so this must be just an informative message; toss it. */
- else if (INTERACTIVE
+ else if (INTERACTIVE
&& sf->glyphs_initialized_p
&& FRAME_MESSAGE_BUF (sf))
{
struct gcpro gcpro1;
GCPRO1 (m);
-
+
/* First flush out any partial line written with print. */
message_log_maybe_newline ();
if (STRINGP (m))
- message_dolog (XSTRING (m)->data, nbytes, 1, multibyte);
+ message_dolog (SDATA (m), nbytes, 1, multibyte);
message3_nolog (m, nbytes, multibyte);
UNGCPRO;
putc ('\n', stderr);
noninteractive_need_newline = 0;
if (STRINGP (m))
- fwrite (XSTRING (m)->data, nbytes, 1, stderr);
+ fwrite (SDATA (m), nbytes, 1, stderr);
if (cursor_in_echo_area == 0)
fprintf (stderr, "\n");
fflush (stderr);
/* A null message buffer means that the frame hasn't really been
initialized yet. Error messages get reported properly by
cmd_error, so this must be just an informative message; toss it. */
- else if (INTERACTIVE
+ else if (INTERACTIVE
&& sf->glyphs_initialized_p
&& FRAME_MESSAGE_BUF (sf))
{
&& !FRAME_VISIBLE_P (f))
Fmake_frame_visible (frame);
- if (STRINGP (m) && XSTRING (m)->size)
+ if (STRINGP (m) && SCHARS (m) > 0)
{
set_message (NULL, m, nbytes, multibyte);
if (minibuffer_auto_raise)
Lisp_Object string;
int log;
{
+ CHECK_STRING (string);
+
if (noninteractive)
{
if (m)
if (noninteractive_need_newline)
putc ('\n', stderr);
noninteractive_need_newline = 0;
- fprintf (stderr, m, XSTRING (string)->data);
+ fprintf (stderr, m, SDATA (string));
if (cursor_in_echo_area == 0)
fprintf (stderr, "\n");
fflush (stderr);
cmd_error, so this must be just an informative message; toss it. */
if (FRAME_MESSAGE_BUF (f))
{
- int len;
- char *a[1];
- a[0] = (char *) XSTRING (string)->data;
+ Lisp_Object args[2], message;
+ struct gcpro gcpro1, gcpro2;
+
+ args[0] = build_string (m);
+ args[1] = message = string;
+ GCPRO2 (args[0], message);
+ gcpro1.nvars = 2;
- len = doprnt (FRAME_MESSAGE_BUF (f),
- FRAME_MESSAGE_BUF_SIZE (f), m, (char *)0, 3, a);
+ message = Fformat (2, args);
if (log)
- message2 (FRAME_MESSAGE_BUF (f), len,
- STRING_MULTIBYTE (string));
+ message3 (message, SBYTES (message), STRING_MULTIBYTE (message));
else
- message2_nolog (FRAME_MESSAGE_BUF (f), len,
- STRING_MULTIBYTE (string));
+ message3_nolog (message, SBYTES (message), STRING_MULTIBYTE (message));
+
+ UNGCPRO;
/* Print should start at the beginning of the message
buffer next time. */
{
Lisp_Object string;
string = Fcurrent_message ();
- message3 (string, XSTRING (string)->size,
+ message3 (string, SBYTES (string),
!NILP (current_buffer->enable_multibyte_characters));
}
}
-/* Make sure echo area buffers in echo_buffers[] are life. If they
- aren't, make new ones. */
+/* Make sure echo area buffers in `echo_buffers' are live.
+ If they aren't, make new ones. */
static void
ensure_echo_area_buffers ()
{
Lisp_Object buffer;
int this_one, the_other, clear_buffer_p, rc;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
- /* If buffers aren't life, make new ones. */
+ /* If buffers aren't live, make new ones. */
ensure_echo_area_buffers ();
clear_buffer_p = 0;
-
+
if (which == 0)
this_one = 0, the_other = 1;
else if (which > 0)
{
this_one = 0, the_other = 1;
clear_buffer_p = 1;
-
+
/* We need a fresh one in case the current echo buffer equals
the one containing the last displayed echo area message. */
if (!NILP (echo_area_buffer[this_one])
Vwith_echo_area_save_vector. */
vector = Vwith_echo_area_save_vector;
Vwith_echo_area_save_vector = Qnil;
-
+
if (NILP (vector))
vector = Fmake_vector (make_number (7), Qnil);
-
+
XSETBUFFER (AREF (vector, i), current_buffer); ++i;
AREF (vector, i) = Vdeactivate_mark, ++i;
AREF (vector, i) = make_number (windows_or_buffers_changed), ++i;
-
+
if (w)
{
XSETWINDOW (AREF (vector, i), w); ++i;
{
struct window *w;
Lisp_Object buffer, charpos, bytepos;
-
+
w = XWINDOW (AREF (vector, 3));
buffer = AREF (vector, 4);
charpos = AREF (vector, 5);
bytepos = AREF (vector, 6);
-
+
w->buffer = buffer;
set_marker_both (w->pointm, buffer,
XFASTINT (charpos), XFASTINT (bytepos));
setup_echo_area_for_printing (multibyte_p)
int multibyte_p;
{
+ /* If we can't find an echo area any more, exit. */
+ if (! FRAME_LIVE_P (XFRAME (selected_frame)))
+ Fkill_emacs (Qnil);
+
ensure_echo_area_buffers ();
if (!message_buf_print)
/* A message has been output since the last time we printed.
Choose a fresh echo area buffer. */
if (EQ (echo_area_buffer[1], echo_buffer[0]))
- echo_area_buffer[0] = echo_buffer[1];
+ echo_area_buffer[0] = echo_buffer[1];
else
echo_area_buffer[0] = echo_buffer[0];
/* Switch to that buffer and clear it. */
set_buffer_internal (XBUFFER (echo_area_buffer[0]));
current_buffer->truncate_lines = Qnil;
-
+
if (Z > BEG)
{
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
specbind (Qinhibit_read_only, Qt);
+ /* Note that undo recording is always disabled. */
del_range (BEG, Z);
unbind_to (count, Qnil);
}
/* Set up the buffer for the multibyteness we need. */
if (multibyte_p
!= !NILP (current_buffer->enable_multibyte_characters))
- Fset_buffer_multibyte (multibyte_p ? Qt : Qnil, Qnil);
+ Fset_buffer_multibyte (multibyte_p ? Qt : Qnil);
/* Raise the frame containing the echo area. */
if (minibuffer_auto_raise)
if (NILP (echo_area_buffer[0]))
{
if (EQ (echo_area_buffer[1], echo_buffer[0]))
- echo_area_buffer[0] = echo_buffer[1];
+ echo_area_buffer[0] = echo_buffer[1];
else
echo_area_buffer[0] = echo_buffer[0];
}
-
+
if (current_buffer != XBUFFER (echo_area_buffer[0]))
{
/* Someone switched buffers between print requests. */
with_echo_area_buffer will sets it to an empty buffer. */
i = display_last_displayed_message_p ? 1 : 0;
no_message_p = NILP (echo_area_buffer[i]);
-
+
window_height_changed_p
= with_echo_area_buffer (w, display_last_displayed_message_p,
display_echo_area_1,
resize_exactly = Qt;
else
resize_exactly = Qnil;
-
+
resized_p = with_echo_area_buffer (w, 0, resize_mini_window_1,
(EMACS_INT) w, resize_exactly, 0, 0);
if (resized_p)
functions with safe_call which binds inhibit-redisplay to t. */
if (!NILP (Vinhibit_redisplay))
return 0;
-
+
/* Nil means don't try to resize. */
if (NILP (Vresize_mini_windows)
- || (FRAME_X_P (f) && f->output_data.x == NULL))
+ || (FRAME_X_P (f) && FRAME_X_OUTPUT (f) == NULL))
return 0;
-
+
if (!FRAME_MINIBUF_ONLY_P (f))
{
struct it it;
struct window *root = XWINDOW (FRAME_ROOT_WINDOW (f));
- int total_height = XFASTINT (root->height) + XFASTINT (w->height);
+ int total_height = WINDOW_TOTAL_LINES (root) + WINDOW_TOTAL_LINES (w);
int height, max_height;
- int unit = CANON_Y_UNIT (f);
+ int unit = FRAME_LINE_HEIGHT (f);
struct text_pos start;
struct buffer *old_current_buffer = NULL;
/* Compute the max. number of lines specified by the user. */
if (FLOATP (Vmax_mini_window_height))
- max_height = XFLOATINT (Vmax_mini_window_height) * FRAME_HEIGHT (f);
+ max_height = XFLOATINT (Vmax_mini_window_height) * FRAME_LINES (f);
else if (INTEGERP (Vmax_mini_window_height))
max_height = XINT (Vmax_mini_window_height);
else
max_height = total_height / 4;
-
+
/* Correct that max. height if it's bogus. */
max_height = max (1, max_height);
max_height = min (total_height, max_height);
-
+
/* Find out the height of the text in the window. */
if (it.truncate_lines_p)
height = 1;
height -= it.extra_line_spacing;
height = (height + unit - 1) / unit;
}
-
+
/* Compute a suitable window start. */
if (height > max_height)
{
{
/* Let it grow only, until we display an empty message, in which
case the window shrinks again. */
- if (height > XFASTINT (w->height))
+ if (height > WINDOW_TOTAL_LINES (w))
{
- int old_height = XFASTINT (w->height);
+ int old_height = WINDOW_TOTAL_LINES (w);
freeze_window_starts (f, 1);
- grow_mini_window (w, height - XFASTINT (w->height));
- window_height_changed_p = XFASTINT (w->height) != old_height;
+ grow_mini_window (w, height - WINDOW_TOTAL_LINES (w));
+ window_height_changed_p = WINDOW_TOTAL_LINES (w) != old_height;
}
- else if (height < XFASTINT (w->height)
+ else if (height < WINDOW_TOTAL_LINES (w)
&& (exact_p || BEGV == ZV))
{
- int old_height = XFASTINT (w->height);
+ int old_height = WINDOW_TOTAL_LINES (w);
freeze_window_starts (f, 0);
shrink_mini_window (w);
- window_height_changed_p = XFASTINT (w->height) != old_height;
+ window_height_changed_p = WINDOW_TOTAL_LINES (w) != old_height;
}
}
- else
+ else
{
/* Always resize to exact size needed. */
- if (height > XFASTINT (w->height))
+ if (height > WINDOW_TOTAL_LINES (w))
{
- int old_height = XFASTINT (w->height);
+ int old_height = WINDOW_TOTAL_LINES (w);
freeze_window_starts (f, 1);
- grow_mini_window (w, height - XFASTINT (w->height));
- window_height_changed_p = XFASTINT (w->height) != old_height;
+ grow_mini_window (w, height - WINDOW_TOTAL_LINES (w));
+ window_height_changed_p = WINDOW_TOTAL_LINES (w) != old_height;
}
- else if (height < XFASTINT (w->height))
+ else if (height < WINDOW_TOTAL_LINES (w))
{
- int old_height = XFASTINT (w->height);
+ int old_height = WINDOW_TOTAL_LINES (w);
freeze_window_starts (f, 0);
shrink_mini_window (w);
if (height)
{
freeze_window_starts (f, 1);
- grow_mini_window (w, height - XFASTINT (w->height));
+ grow_mini_window (w, height - WINDOW_TOTAL_LINES (w));
}
-
- window_height_changed_p = XFASTINT (w->height) != old_height;
+
+ window_height_changed_p = WINDOW_TOTAL_LINES (w) != old_height;
}
}
if (NILP (msg))
echo_area_buffer[0] = Qnil;
}
-
+
return msg;
}
EMACS_INT a3, a4;
{
Lisp_Object *msg = (Lisp_Object *) a1;
-
+
if (Z > BEG)
*msg = make_buffer_string (BEG, Z, 1);
else
}
-/* Handler for record_unwind_protect calling pop_message. */
-
-Lisp_Object
-push_message_unwind (dummy)
- Lisp_Object dummy;
-{
- pop_message ();
- return Qnil;
-}
-
-
/* Restore message display from the top of Vmessage_stack. */
void
restore_message ()
{
Lisp_Object msg;
-
+
xassert (CONSP (Vmessage_stack));
msg = XCAR (Vmessage_stack);
if (STRINGP (msg))
- message3_nolog (msg, STRING_BYTES (XSTRING (msg)), STRING_MULTIBYTE (msg));
+ message3_nolog (msg, SBYTES (msg), STRING_MULTIBYTE (msg));
else
message3_nolog (msg, 0, 0);
}
+/* Handler for record_unwind_protect calling pop_message. */
+
+Lisp_Object
+pop_message_unwind (dummy)
+ Lisp_Object dummy;
+{
+ pop_message ();
+ return Qnil;
+}
+
/* Pop the top-most entry off Vmessage_stack. */
void
void
set_message (s, string, nbytes, multibyte_p)
- char *s;
+ const char *s;
Lisp_Object string;
int nbytes, multibyte_p;
{
message_enable_multibyte
= ((s && multibyte_p)
|| (STRINGP (string) && STRING_MULTIBYTE (string)));
-
+
with_echo_area_buffer (0, -1, set_message_1,
(EMACS_INT) s, string, nbytes, multibyte_p);
message_buf_print = 0;
Lisp_Object a2;
EMACS_INT nbytes, multibyte_p;
{
- char *s = (char *) a1;
+ const char *s = (const char *) a1;
Lisp_Object string = a2;
-
+
xassert (BEG == Z);
-
+
/* Change multibyteness of the echo buffer appropriately. */
if (message_enable_multibyte
!= !NILP (current_buffer->enable_multibyte_characters))
- Fset_buffer_multibyte (message_enable_multibyte ? Qt : Qnil, Qnil);
+ Fset_buffer_multibyte (message_enable_multibyte ? Qt : Qnil);
current_buffer->truncate_lines = message_truncate_lines ? Qt : Qnil;
-
+
/* Insert new message at BEG. */
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
if (STRINGP (string))
{
int nchars;
-
+
if (nbytes == 0)
- nbytes = XSTRING (string)->size_byte;
+ nbytes = SBYTES (string);
nchars = string_byte_to_char (string, nbytes);
-
+
/* This function takes care of single/multibyte conversion. We
just have to ensure that the echo area buffer has the right
setting of enable_multibyte_characters. */
{
if (nbytes == 0)
nbytes = strlen (s);
-
+
if (multibyte_p && NILP (current_buffer->enable_multibyte_characters))
{
/* Convert from multi-byte to single-byte. */
int i, c, n;
unsigned char work[1];
-
+
/* Convert a multibyte string to single-byte. */
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 from single-byte to multi-byte. */
int i, c, n;
- unsigned char *msg = (unsigned char *) s;
+ const unsigned char *msg = (const unsigned char *) s;
unsigned char str[MAX_MULTIBYTE_LENGTH];
-
+
/* Convert a single-byte string to multibyte. */
for (i = 0; i < nbytes; i++)
{
echo_area_buffer[0] = Qnil;
message_cleared_p = 1;
}
-
+
if (last_displayed_p)
echo_area_buffer[1] = Qnil;
-
+
message_buf_print = 0;
}
if (frame_garbaged)
{
Lisp_Object tail, frame;
-
+ int changed_count = 0;
+
FOR_EACH_FRAME (tail, frame)
{
struct frame *f = XFRAME (frame);
-
+
if (FRAME_VISIBLE_P (f) && FRAME_GARBAGED_P (f))
{
if (f->resized_p)
Fredraw_frame (frame);
clear_current_matrices (f);
+ changed_count++;
f->garbaged = 0;
f->resized_p = 0;
}
}
frame_garbaged = 0;
- ++windows_or_buffers_changed;
+ if (changed_count)
+ ++windows_or_buffers_changed;
}
}
return 0;
/* The terminal frame is used as the first Emacs frame on the Mac OS. */
-#ifndef macintosh
+#ifndef MAC_OS8
#ifdef HAVE_WINDOW_SYSTEM
/* When Emacs starts, selected_frame may be a visible terminal
frame, even if we run under a window system. If we let this
through, a message would be displayed on the terminal. */
- if (EQ (selected_frame, Vterminal_frame)
+ if (EQ (selected_frame, Vterminal_frame)
&& !NILP (Vwindow_system))
return 0;
#endif /* HAVE_WINDOW_SYSTEM */
garbaged. This looks odd, so we prevent it here. */
if (!display_completed)
n = redisplay_mode_lines (FRAME_ROOT_WINDOW (f), 0);
-
+
if (window_height_changed_p
/* Don't do this if Emacs is shutting down. Redisplay
needs to run hooks. */
/* Must update other windows. Likewise as in other
cases, don't let this update be interrupted by
pending input. */
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
specbind (Qredisplay_dont_pause, Qt);
windows_or_buffers_changed = 1;
redisplay_internal (0);
/* Last displayed message is now the current message. */
echo_area_buffer[1] = echo_area_buffer[0];
-
+
/* Prevent redisplay optimization in redisplay_internal by resetting
this_line_start_pos. This is done because the mini-buffer now
displays the message instead of its buffer text. */
***********************************************************************/
-#ifdef HAVE_WINDOW_SYSTEM
+/* The frame title buffering code is also used by Fformat_mode_line.
+ So it is not conditioned by HAVE_WINDOW_SYSTEM. */
/* A buffer for constructing frame titles in it; allocated from the
heap in init_xdisp and resized as needed in store_frame_title_char. */
Re-allocate frame_title_buf if necessary. */
static void
+#ifdef PROTOTYPES
+store_frame_title_char (char c)
+#else
store_frame_title_char (c)
char c;
+#endif
{
/* If output position has reached the end of the allocated buffer,
double the buffer's size. */
static int
store_frame_title (str, field_width, precision)
- unsigned char *str;
+ const unsigned char *str;
int field_width, precision;
{
int n = 0;
return n;
}
+#ifdef HAVE_WINDOW_SYSTEM
/* Set the title of FRAME, if it has changed. The title format is
Vicon_title_format if FRAME is iconified, otherwise it is
Lisp_Object other_frame = XCAR (tail);
struct frame *tf = XFRAME (other_frame);
- if (tf != f
+ if (tf != f
&& FRAME_KBOARD (tf) == FRAME_KBOARD (f)
&& !FRAME_MINIBUF_ONLY_P (tf)
&& !EQ (other_frame, tip_frame)
frame_title_ptr = frame_title_buf;
init_iterator (&it, XWINDOW (f->selected_window), -1, -1,
NULL, DEFAULT_FACE_ID);
- display_mode_element (&it, 0, -1, -1, fmt, Qnil);
+ display_mode_element (&it, 0, -1, -1, fmt, Qnil, 0);
len = frame_title_ptr - frame_title_buf;
frame_title_ptr = NULL;
set_buffer_internal_1 (obuf);
already wasted too much time by walking through the list with
display_mode_element, then we might need to optimize at a
higher level than this.) */
- if (! STRINGP (f->name)
- || STRING_BYTES (XSTRING (f->name)) != len
- || bcmp (frame_title_buf, XSTRING (f->name)->data, len) != 0)
+ if (! STRINGP (f->name)
+ || SBYTES (f->name) != len
+ || bcmp (frame_title_buf, SDATA (f->name), len) != 0)
x_implicitly_set_name (f, make_string (frame_title_buf, len), Qnil);
}
}
-#else /* not HAVE_WINDOW_SYSTEM */
-
-#define frame_title_ptr ((char *)0)
-#define store_frame_title(str, mincol, maxcol) 0
-
#endif /* not HAVE_WINDOW_SYSTEM */
/* Update the menu bar item lists, if appropriate. This has to be
done before any actual redisplay or generation of display lines. */
- all_windows = (update_mode_lines
+ all_windows = (update_mode_lines
|| buffer_shared > 1
|| windows_or_buffers_changed);
if (all_windows)
{
Lisp_Object tail, frame;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
/* Ignore tooltip frame. */
if (EQ (frame, tooltip_frame))
continue;
-
+
/* If a window on this frame changed size, report that to
the user and clear the size-change flag. */
if (FRAME_WINDOW_SIZES_CHANGED (f))
{
Lisp_Object functions;
-
+
/* Clear flag first in case we get an error below. */
FRAME_WINDOW_SIZES_CHANGED (f) = 0;
functions = Vwindow_size_change_functions;
GCPRO2 (tail, functions);
-
+
while (CONSP (functions))
{
call1 (XCAR (functions), frame);
}
UNGCPRO;
}
-
+
GCPRO1 (tail);
update_menu_bar (f, 0);
#ifdef HAVE_WINDOW_SYSTEM
window = FRAME_SELECTED_WINDOW (f);
w = XWINDOW (window);
-
+
+#if 0 /* The if statement below this if statement used to include the
+ condition !NILP (w->update_mode_line), rather than using
+ update_mode_lines directly, and this if statement may have
+ been added to make that condition work. Now the if
+ statement below matches its comment, this isn't needed. */
if (update_mode_lines)
w->update_mode_line = Qt;
+#endif
if (FRAME_WINDOW_P (f)
?
-#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
- FRAME_EXTERNAL_MENU_BAR (f)
+#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (MAC_OS) \
+ || defined (USE_GTK)
+ FRAME_EXTERNAL_MENU_BAR (f)
#else
FRAME_MENU_BAR_LINES (f) > 0
#endif
the rest of the redisplay algorithm is about the same as
windows_or_buffers_changed anyway. */
if (windows_or_buffers_changed
- || !NILP (w->update_mode_line)
+ /* This used to test w->update_mode_line, but we believe
+ there is no need to recompute the menu in that case. */
+ || update_mode_lines
|| ((BUF_SAVE_MODIFF (XBUFFER (w->buffer))
< BUF_MODIFF (XBUFFER (w->buffer)))
!= !NILP (w->last_had_star))
!= !NILP (w->region_showing)))
{
struct buffer *prev = current_buffer;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
specbind (Qinhibit_menubar_update, Qt);
/* Run the Lucid hook. */
safe_run_hooks (Qactivate_menubar_hook);
-
+
/* If it has changed current-menubar from previous value,
really recompute the menu-bar from the value. */
if (! NILP (Vlucid_menu_bar_dirty_flag))
call0 (Qrecompute_lucid_menubar);
-
+
safe_run_hooks (Qmenu_bar_update_hook);
FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
-
+
/* Redisplay the menu bar in case we changed it. */
-#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
+#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (MAC_OS) \
+ || defined (USE_GTK)
if (FRAME_WINDOW_P (f)
-#if defined (macintosh)
+#if defined (MAC_OS)
/* All frames on Mac OS share the same menubar. So only the
selected frame should be allowed to set it. */
&& f == SELECTED_FRAME ()
/* On a terminal screen, the menu bar is an ordinary screen
line, and this makes it get updated. */
w->update_mode_line = Qt;
-#else /* ! (USE_X_TOOLKIT || HAVE_NTGUI) */
+#else /* ! (USE_X_TOOLKIT || HAVE_NTGUI || MAC_OS || USE_GTK) */
/* In the non-toolkit version, the menu bar is an ordinary screen
line, and this makes it get updated. */
w->update_mode_line = Qt;
-#endif /* ! (USE_X_TOOLKIT || HAVE_NTGUI) */
+#endif /* ! (USE_X_TOOLKIT || HAVE_NTGUI || MAC_OS || USE_GTK) */
unbind_to (count, Qnil);
set_buffer_internal_1 (prev);
}
+\f
+/***********************************************************************
+ Output Cursor
+ ***********************************************************************/
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* EXPORT:
+ Nominal cursor position -- where to draw output.
+ HPOS and VPOS are window relative glyph matrix coordinates.
+ X and Y are window relative pixel coordinates. */
+
+struct cursor_pos output_cursor;
+
+
+/* EXPORT:
+ Set the global variable output_cursor to CURSOR. All cursor
+ positions are relative to updated_window. */
+
+void
+set_output_cursor (cursor)
+ struct cursor_pos *cursor;
+{
+ output_cursor.hpos = cursor->hpos;
+ output_cursor.vpos = cursor->vpos;
+ output_cursor.x = cursor->x;
+ output_cursor.y = cursor->y;
+}
+
+
+/* EXPORT for RIF:
+ Set a nominal cursor position.
+
+ HPOS and VPOS are column/row positions in a window glyph matrix. X
+ and Y are window text area relative pixel positions.
+
+ If this is done during an update, updated_window will contain the
+ window that is being updated and the position is the future output
+ cursor position for that window. If updated_window is null, use
+ selected_window and display the cursor at the given position. */
+
+void
+x_cursor_to (vpos, hpos, y, x)
+ int vpos, hpos, y, x;
+{
+ struct window *w;
+
+ /* If updated_window is not set, work on selected_window. */
+ if (updated_window)
+ w = updated_window;
+ else
+ w = XWINDOW (selected_window);
+
+ /* Set the output cursor. */
+ output_cursor.hpos = hpos;
+ output_cursor.vpos = vpos;
+ output_cursor.x = x;
+ output_cursor.y = y;
+
+ /* If not called as part of an update, really display the cursor.
+ This will also set the cursor position of W. */
+ if (updated_window == NULL)
+ {
+ BLOCK_INPUT;
+ display_and_set_cursor (w, 1, hpos, vpos, x, y);
+ if (rif->flush_display_optional)
+ rif->flush_display_optional (SELECTED_FRAME ());
+ UNBLOCK_INPUT;
+ }
+}
+
+#endif /* HAVE_WINDOW_SYSTEM */
+
\f
/***********************************************************************
Tool-bars
#ifdef HAVE_WINDOW_SYSTEM
+/* Where the mouse was last time we reported a mouse event. */
+
+FRAME_PTR last_mouse_frame;
+
+/* Tool-bar item index of the item on which a mouse button was pressed
+ or -1. */
+
+int last_tool_bar_item;
+
+
/* Update the tool-bar item list for frame F. This has to be done
before we start to fill in any display lines. Called from
prepare_menu_bars. If SAVE_MATCH_DATA is non-zero, we must save
struct frame *f;
int save_match_data;
{
- if (WINDOWP (f->tool_bar_window)
- && XFASTINT (XWINDOW (f->tool_bar_window)->height) > 0)
+#ifdef USE_GTK
+ int do_update = FRAME_EXTERNAL_TOOL_BAR(f);
+#else
+ int do_update = WINDOWP (f->tool_bar_window)
+ && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window)) > 0;
+#endif
+
+ if (do_update)
{
Lisp_Object window;
struct window *w;
window = FRAME_SELECTED_WINDOW (f);
w = XWINDOW (window);
-
+
/* If the user has switched buffers or windows, we need to
recompute to reflect the new bindings. But we'll
recompute when update_mode_lines is set too; that means
windows_or_buffers_changed anyway. */
if (windows_or_buffers_changed
|| !NILP (w->update_mode_line)
+ || update_mode_lines
|| ((BUF_SAVE_MODIFF (XBUFFER (w->buffer))
< BUF_MODIFF (XBUFFER (w->buffer)))
!= !NILP (w->last_had_star))
!= !NILP (w->region_showing)))
{
struct buffer *prev = current_buffer;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
+ Lisp_Object old_tool_bar;
+ struct gcpro gcpro1;
/* Set current_buffer to the buffer of the selected
window of the frame, so that we get the right local
specbind (Qoverriding_local_map, Qnil);
}
+ old_tool_bar = f->tool_bar_items;
+ GCPRO1 (old_tool_bar);
+
/* Build desired tool-bar items from keymaps. */
+ BLOCK_INPUT;
f->tool_bar_items
= tool_bar_items (f->tool_bar_items, &f->n_tool_bar_items);
+ UNBLOCK_INPUT;
+
+ /* Redisplay the tool-bar if we changed it. */
+ if (! NILP (Fequal (old_tool_bar, f->tool_bar_items)))
+ w->update_mode_line = Qt;
- /* Redisplay the tool-bar in case we changed it. */
- w->update_mode_line = Qt;
+ UNGCPRO;
unbind_to (count, Qnil);
set_buffer_internal_1 (prev);
/* Prepare F->desired_tool_bar_string. If we can reuse it, do so.
Otherwise, make a new string. */
-
+
/* The size of the string we might be able to reuse. */
size = (STRINGP (f->desired_tool_bar_string)
- ? XSTRING (f->desired_tool_bar_string)->size
+ ? SCHARS (f->desired_tool_bar_string)
: 0);
/* We need one space in the string for each image. */
size_needed = f->n_tool_bar_items;
-
+
/* Reuse f->desired_tool_bar_string, if possible. */
if (size < size_needed || NILP (f->desired_tool_bar_string))
f->desired_tool_bar_string = Fmake_string (make_number (size_needed),
idx = (selected_p
? TOOL_BAR_IMAGE_DISABLED_SELECTED
: TOOL_BAR_IMAGE_DISABLED_DESELECTED);
-
+
xassert (ASIZE (image) >= idx);
image = AREF (image, idx);
}
if (INTEGERP (XCAR (Vtool_bar_button_margin))
&& XINT (XCAR (Vtool_bar_button_margin)) > 0)
hmargin += XFASTINT (XCAR (Vtool_bar_button_margin));
-
+
if (INTEGERP (XCDR (Vtool_bar_button_margin))
&& XINT (XCDR (Vtool_bar_button_margin)) > 0)
vmargin += XFASTINT (XCDR (Vtool_bar_button_margin));
}
-
+
if (auto_raise_tool_bar_buttons_p)
{
/* Add a `:relief' property to the image spec if the item is
Fcons (make_number (hmargin),
make_number (vmargin)));
}
-
+
/* If button is not enabled, and we don't have special images
for the disabled state, make the image appear disabled by
applying an appropriate algorithm to it. */
if (!enabled_p && idx < 0)
plist = Fplist_put (plist, QCconversion, Qdisabled);
-
+
/* Put a `display' text property on the string for the image to
display. Put a `menu-item' property on the string that gives
the start of this item's properties in the tool-bar items
string. The string can be longer than needed when we reuse a
previous string. */
if (i + 1 == f->n_tool_bar_items)
- end = XSTRING (f->desired_tool_bar_string)->size;
+ end = SCHARS (f->desired_tool_bar_string);
else
end = i + 1;
Fadd_text_properties (make_number (i), make_number (end),
struct glyph_row *row = it->glyph_row;
int max_x = it->last_visible_x;
struct glyph *last;
-
+
prepare_desired_row (row);
row->y = it->current_y;
/* Note that this isn't made use of if the face hasn't a box,
so there's no need to check the face here. */
it->start_of_box_run_p = 1;
-
+
while (it->current_x < max_x)
{
int x_before, x, n_glyphs_before, i, nglyphs;
while (i < nglyphs)
{
struct glyph *glyph = row->glyphs[TEXT_AREA] + n_glyphs_before + i;
-
+
if (x + glyph->pixel_width > max_x)
{
/* Glyph doesn't fit on line. */
if (last == row->glyphs[TEXT_AREA])
last->left_box_line_p = 1;
compute_line_metrics (it);
-
+
/* If line is empty, make it occupy the rest of the tool-bar. */
if (!row->displays_text_p)
{
row->height = row->phys_height = it->last_visible_y - row->y;
row->ascent = row->phys_ascent = 0;
}
-
+
row->full_width_p = 1;
row->continued_p = 0;
row->truncated_on_left_p = 0;
{
struct window *w = XWINDOW (f->tool_bar_window);
struct it it;
-
+
/* Initialize an iterator for iteration over
F->desired_tool_bar_string in the tool-bar window of frame F. */
init_iterator (&it, w, -1, -1, w->desired_matrix->rows, TOOL_BAR_FACE_ID);
it.first_visible_x = 0;
- it.last_visible_x = FRAME_WINDOW_WIDTH (f) * CANON_X_UNIT (f);
+ it.last_visible_x = FRAME_TOTAL_COLS (f) * FRAME_COLUMN_WIDTH (f);
reseat_to_string (&it, NULL, f->desired_tool_bar_string, 0, 0, 0, -1);
while (!ITERATOR_AT_END_P (&it))
display_tool_bar_line (&it);
}
- return (it.current_y + CANON_Y_UNIT (f) - 1) / CANON_Y_UNIT (f);
+ return (it.current_y + FRAME_LINE_HEIGHT (f) - 1) / FRAME_LINE_HEIGHT (f);
}
else
CHECK_FRAME (frame);
f = XFRAME (frame);
-
+
if (WINDOWP (f->tool_bar_window)
|| (w = XWINDOW (f->tool_bar_window),
- XFASTINT (w->height) > 0))
+ WINDOW_TOTAL_LINES (w) > 0))
{
update_tool_bar (f, 1);
if (f->n_tool_bar_items)
struct it it;
struct glyph_row *row;
int change_height_p = 0;
-
+
+#ifdef USE_GTK
+ if (FRAME_EXTERNAL_TOOL_BAR(f))
+ update_frame_tool_bar (f);
+ return 0;
+#endif
+
/* If frame hasn't a tool-bar window or if it is zero-height, don't
do anything. This means you must start with tool-bar-lines
non-zero to get the auto-sizing effect. Or in other words, you
can turn off tool-bars by specifying tool-bar-lines zero. */
if (!WINDOWP (f->tool_bar_window)
|| (w = XWINDOW (f->tool_bar_window),
- XFASTINT (w->height) == 0))
+ WINDOW_TOTAL_LINES (w) == 0))
return 0;
/* Set up an iterator for the tool-bar window. */
init_iterator (&it, w, -1, -1, w->desired_matrix->rows, TOOL_BAR_FACE_ID);
it.first_visible_x = 0;
- it.last_visible_x = FRAME_WINDOW_WIDTH (f) * CANON_X_UNIT (f);
+ it.last_visible_x = FRAME_TOTAL_COLS (f) * FRAME_COLUMN_WIDTH (f);
row = it.glyph_row;
/* Build a string that represents the contents of the tool-bar. */
height. */
if (IT_STRING_CHARPOS (it) < it.end_charpos)
change_height_p = 1;
-
+
/* If there are blank lines at the end, except for a partially
visible blank line at the end that is smaller than
- CANON_Y_UNIT, change the tool-bar's height. */
+ FRAME_LINE_HEIGHT, change the tool-bar's height. */
row = it.glyph_row - 1;
if (!row->displays_text_p
- && row->height >= CANON_Y_UNIT (f))
+ && row->height >= FRAME_LINE_HEIGHT (f))
change_height_p = 1;
/* If row displays tool-bar items, but is partially visible,
frame parameter. */
if (change_height_p
&& (nlines = tool_bar_lines_needed (f),
- nlines != XFASTINT (w->height)))
+ nlines != WINDOW_TOTAL_LINES (w)))
{
extern Lisp_Object Qtool_bar_lines;
Lisp_Object frame;
- int old_height = XFASTINT (w->height);
-
+ int old_height = WINDOW_TOTAL_LINES (w);
+
XSETFRAME (frame, f);
clear_glyph_matrix (w->desired_matrix);
Fmodify_frame_parameters (frame,
Fcons (Fcons (Qtool_bar_lines,
make_number (nlines)),
Qnil));
- if (XFASTINT (w->height) != old_height)
+ if (WINDOW_TOTAL_LINES (w) != old_height)
fonts_changed_p = 1;
}
}
properties start in F->tool_bar_items. Value is zero if
GLYPH doesn't display a tool-bar item. */
-int
+static int
tool_bar_item_info (f, glyph, prop_idx)
struct frame *f;
struct glyph *glyph;
/* This function can be called asynchronously, which means we must
exclude any possibility that Fget_text_property signals an
error. */
- charpos = min (XSTRING (f->current_tool_bar_string)->size, glyph->charpos);
+ charpos = min (SCHARS (f->current_tool_bar_string), glyph->charpos);
charpos = max (0, charpos);
-
+
/* Get the text property `menu-item' at pos. The value of that
property is the start index of this item's properties in
F->tool_bar_items. */
return success_p;
}
-
-#endif /* HAVE_WINDOW_SYSTEM */
-
\f
-/************************************************************************
- Horizontal scrolling
- ************************************************************************/
-
-static int hscroll_window_tree P_ ((Lisp_Object));
-static int hscroll_windows P_ ((Lisp_Object));
+/* Get information about the tool-bar item at position X/Y on frame F.
+ Return in *GLYPH a pointer to the glyph of the tool-bar item in
+ the current matrix of the tool-bar window of F, or NULL if not
+ on a tool-bar item. Return in *PROP_IDX the index of the tool-bar
+ item in F->tool_bar_items. Value is
-/* For all leaf windows in the window tree rooted at WINDOW, set their
- hscroll value so that PT is (i) visible in the window, and (ii) so
- that it is not within a certain margin at the window's left and
- right border. Value is non-zero if any window's hscroll has been
- changed. */
+ -1 if X/Y is not on a tool-bar item
+ 0 if X/Y is on the same item that was highlighted before.
+ 1 otherwise. */
static int
-hscroll_window_tree (window)
- Lisp_Object window;
+get_tool_bar_item (f, x, y, glyph, hpos, vpos, prop_idx)
+ struct frame *f;
+ int x, y;
+ struct glyph **glyph;
+ int *hpos, *vpos, *prop_idx;
{
- int hscrolled_p = 0;
- int hscroll_relative_p = FLOATP (Vautomatic_hscroll_step);
- int hscroll_step_abs = 0;
- double hscroll_step_rel = 0;
+ Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ struct window *w = XWINDOW (f->tool_bar_window);
+ int area;
- if (hscroll_relative_p)
- {
- hscroll_step_rel = XFLOAT_DATA (Vautomatic_hscroll_step);
- if (hscroll_step_rel < 0)
- {
- hscroll_relative_p = 0;
- hscroll_step_abs = 0;
- }
- }
- else if (INTEGERP (Vautomatic_hscroll_step))
+ /* Find the glyph under X/Y. */
+ *glyph = x_y_to_hpos_vpos (w, x, y, hpos, vpos, &area, 0);
+ if (*glyph == NULL)
+ return -1;
+
+ /* Get the start of this tool-bar item's properties in
+ f->tool_bar_items. */
+ if (!tool_bar_item_info (f, *glyph, prop_idx))
+ return -1;
+
+ /* Is mouse on the highlighted item? */
+ if (EQ (f->tool_bar_window, dpyinfo->mouse_face_window)
+ && *vpos >= dpyinfo->mouse_face_beg_row
+ && *vpos <= dpyinfo->mouse_face_end_row
+ && (*vpos > dpyinfo->mouse_face_beg_row
+ || *hpos >= dpyinfo->mouse_face_beg_col)
+ && (*vpos < dpyinfo->mouse_face_end_row
+ || *hpos < dpyinfo->mouse_face_end_col
+ || dpyinfo->mouse_face_past_end))
+ return 0;
+
+ return 1;
+}
+
+
+/* EXPORT:
+ Handle mouse button event on the tool-bar of frame F, at
+ frame-relative coordinates X/Y. DOWN_P is 1 for a button press,
+ 0 for button release. MODIFIERS is event modifiers for button
+ release. */
+
+void
+handle_tool_bar_click (f, x, y, down_p, modifiers)
+ struct frame *f;
+ int x, y, down_p;
+ unsigned int modifiers;
+{
+ Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ struct window *w = XWINDOW (f->tool_bar_window);
+ int hpos, vpos, prop_idx;
+ struct glyph *glyph;
+ Lisp_Object enabled_p;
+
+ /* If not on the highlighted tool-bar item, return. */
+ frame_to_window_pixel_xy (w, &x, &y);
+ if (get_tool_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx) != 0)
+ return;
+
+ /* If item is disabled, do nothing. */
+ enabled_p = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_ENABLED_P);
+ if (NILP (enabled_p))
+ return;
+
+ if (down_p)
{
- hscroll_step_abs = XINT (Vautomatic_hscroll_step);
- if (hscroll_step_abs < 0)
- hscroll_step_abs = 0;
+ /* Show item in pressed state. */
+ show_mouse_face (dpyinfo, DRAW_IMAGE_SUNKEN);
+ dpyinfo->mouse_face_image_state = DRAW_IMAGE_SUNKEN;
+ last_tool_bar_item = prop_idx;
}
else
- hscroll_step_abs = 0;
-
- while (WINDOWP (window))
{
- struct window *w = XWINDOW (window);
+ Lisp_Object key, frame;
+ struct input_event event;
+ EVENT_INIT (event);
- if (WINDOWP (w->hchild))
- hscrolled_p |= hscroll_window_tree (w->hchild);
- else if (WINDOWP (w->vchild))
- hscrolled_p |= hscroll_window_tree (w->vchild);
- else if (w->cursor.vpos >= 0)
- {
- int hscroll_margin, text_area_x, text_area_y;
- int text_area_width, text_area_height;
- struct glyph_row *current_cursor_row
- = MATRIX_ROW (w->current_matrix, w->cursor.vpos);
- struct glyph_row *desired_cursor_row
- = MATRIX_ROW (w->desired_matrix, w->cursor.vpos);
- struct glyph_row *cursor_row
- = (desired_cursor_row->enabled_p
- ? desired_cursor_row
- : current_cursor_row);
+ /* Show item in released state. */
+ show_mouse_face (dpyinfo, DRAW_IMAGE_RAISED);
+ dpyinfo->mouse_face_image_state = DRAW_IMAGE_RAISED;
- window_box (w, TEXT_AREA, &text_area_x, &text_area_y,
- &text_area_width, &text_area_height);
+ key = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_KEY);
- /* Scroll when cursor is inside this scroll margin. */
- hscroll_margin
- = automatic_hscroll_margin * CANON_X_UNIT (XFRAME (w->frame));
+ XSETFRAME (frame, f);
+ event.kind = TOOL_BAR_EVENT;
+ event.frame_or_window = frame;
+ event.arg = frame;
+ kbd_buffer_store_event (&event);
- if ((XFASTINT (w->hscroll)
- && w->cursor.x <= hscroll_margin)
- || (cursor_row->enabled_p
- && cursor_row->truncated_on_right_p
- && (w->cursor.x >= text_area_width - hscroll_margin)))
- {
- struct it it;
- int hscroll;
- struct buffer *saved_current_buffer;
- int pt;
- int wanted_x;
+ event.kind = TOOL_BAR_EVENT;
+ event.frame_or_window = frame;
+ event.arg = key;
+ event.modifiers = modifiers;
+ kbd_buffer_store_event (&event);
+ last_tool_bar_item = -1;
+ }
+}
- /* Find point in a display of infinite width. */
- saved_current_buffer = current_buffer;
- current_buffer = XBUFFER (w->buffer);
- if (w == XWINDOW (selected_window))
- pt = BUF_PT (current_buffer);
- else
- {
- pt = marker_position (w->pointm);
- pt = max (BEGV, pt);
- pt = min (ZV, pt);
- }
+/* Possibly highlight a tool-bar item on frame F when mouse moves to
+ tool-bar window-relative coordinates X/Y. Called from
+ note_mouse_highlight. */
- /* Move iterator to pt starting at cursor_row->start in
- a line with infinite width. */
- init_to_row_start (&it, w, cursor_row);
- it.last_visible_x = INFINITY;
- move_it_in_display_line_to (&it, pt, -1, MOVE_TO_POS);
- current_buffer = saved_current_buffer;
+static void
+note_tool_bar_highlight (f, x, y)
+ struct frame *f;
+ int x, y;
+{
+ Lisp_Object window = f->tool_bar_window;
+ struct window *w = XWINDOW (window);
+ Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ int hpos, vpos;
+ struct glyph *glyph;
+ struct glyph_row *row;
+ int i;
+ Lisp_Object enabled_p;
+ int prop_idx;
+ enum draw_glyphs_face draw = DRAW_IMAGE_RAISED;
+ int mouse_down_p, rc;
+
+ /* Function note_mouse_highlight is called with negative x(y
+ values when mouse moves outside of the frame. */
+ if (x <= 0 || y <= 0)
+ {
+ clear_mouse_face (dpyinfo);
+ return;
+ }
+
+ rc = get_tool_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx);
+ if (rc < 0)
+ {
+ /* Not on tool-bar item. */
+ clear_mouse_face (dpyinfo);
+ return;
+ }
+ else if (rc == 0)
+ /* On same tool-bar item as before. */
+ goto set_help_echo;
+
+ clear_mouse_face (dpyinfo);
+
+ /* Mouse is down, but on different tool-bar item? */
+ mouse_down_p = (dpyinfo->grabbed
+ && f == last_mouse_frame
+ && FRAME_LIVE_P (f));
+ if (mouse_down_p
+ && last_tool_bar_item != prop_idx)
+ return;
+
+ dpyinfo->mouse_face_image_state = DRAW_NORMAL_TEXT;
+ draw = mouse_down_p ? DRAW_IMAGE_SUNKEN : DRAW_IMAGE_RAISED;
+
+ /* If tool-bar item is not enabled, don't highlight it. */
+ enabled_p = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_ENABLED_P);
+ if (!NILP (enabled_p))
+ {
+ /* Compute the x-position of the glyph. In front and past the
+ image is a space. We include this in the highlighted area. */
+ row = MATRIX_ROW (w->current_matrix, vpos);
+ for (i = x = 0; i < hpos; ++i)
+ x += row->glyphs[TEXT_AREA][i].pixel_width;
+
+ /* Record this as the current active region. */
+ dpyinfo->mouse_face_beg_col = hpos;
+ dpyinfo->mouse_face_beg_row = vpos;
+ dpyinfo->mouse_face_beg_x = x;
+ dpyinfo->mouse_face_beg_y = row->y;
+ dpyinfo->mouse_face_past_end = 0;
+
+ dpyinfo->mouse_face_end_col = hpos + 1;
+ dpyinfo->mouse_face_end_row = vpos;
+ dpyinfo->mouse_face_end_x = x + glyph->pixel_width;
+ dpyinfo->mouse_face_end_y = row->y;
+ dpyinfo->mouse_face_window = window;
+ dpyinfo->mouse_face_face_id = TOOL_BAR_FACE_ID;
+
+ /* Display it as active. */
+ show_mouse_face (dpyinfo, draw);
+ dpyinfo->mouse_face_image_state = draw;
+ }
+
+ set_help_echo:
+
+ /* Set help_echo_string to a help string to display for this tool-bar item.
+ XTread_socket does the rest. */
+ help_echo_object = help_echo_window = Qnil;
+ help_echo_pos = -1;
+ help_echo_string = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_HELP);
+ if (NILP (help_echo_string))
+ help_echo_string = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_CAPTION);
+}
+
+#endif /* HAVE_WINDOW_SYSTEM */
+
+
+\f
+/***********************************************************************
+ Fringes
+ ***********************************************************************/
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* An arrow like this: `<-'. */
+static unsigned char left_bits[] = {
+ 0x18, 0x0c, 0x06, 0x3f, 0x3f, 0x06, 0x0c, 0x18};
+
+/* Right truncation arrow bitmap `->'. */
+static unsigned char right_bits[] = {
+ 0x18, 0x30, 0x60, 0xfc, 0xfc, 0x60, 0x30, 0x18};
+
+/* Marker for continued lines. */
+static unsigned char continued_bits[] = {
+ 0x3c, 0x7c, 0xc0, 0xe4, 0xfc, 0x7c, 0x3c, 0x7c};
+
+/* Marker for continuation lines. */
+static unsigned char continuation_bits[] = {
+ 0x3c, 0x3e, 0x03, 0x27, 0x3f, 0x3e, 0x3c, 0x3e};
+
+/* Overlay arrow bitmap. A triangular arrow. */
+static unsigned char ov_bits[] = {
+ 0x03, 0x0f, 0x1f, 0x3f, 0x3f, 0x1f, 0x0f, 0x03};
+
+/* Bitmap drawn to indicate lines not displaying text if
+ `indicate-empty-lines' is non-nil. */
+static unsigned char zv_bits[] = {
+ 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
+ 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
+ 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
+ 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
+ 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
+ 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
+ 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
+ 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00};
+
+struct fringe_bitmap fringe_bitmaps[MAX_FRINGE_BITMAPS] =
+{
+ { 0, 0, 0, NULL /* NO_FRINGE_BITMAP */ },
+ { 8, sizeof (left_bits), 0, left_bits },
+ { 8, sizeof (right_bits), 0, right_bits },
+ { 8, sizeof (continued_bits), 0, continued_bits },
+ { 8, sizeof (continuation_bits), 0, continuation_bits },
+ { 8, sizeof (ov_bits), 0, ov_bits },
+ { 8, sizeof (zv_bits), 3, zv_bits }
+};
+
+
+/* Draw the bitmap WHICH in one of the left or right fringes of
+ window W. ROW is the glyph row for which to display the bitmap; it
+ determines the vertical position at which the bitmap has to be
+ drawn. */
+
+static void
+draw_fringe_bitmap (w, row, which, left_p)
+ struct window *w;
+ struct glyph_row *row;
+ enum fringe_bitmap_type which;
+ int left_p;
+{
+ struct frame *f = XFRAME (WINDOW_FRAME (w));
+ struct draw_fringe_bitmap_params p;
+
+ /* Convert row to frame coordinates. */
+ p.y = WINDOW_TO_FRAME_PIXEL_Y (w, row->y);
+
+ p.which = which;
+ p.wd = fringe_bitmaps[which].width;
+
+ p.h = fringe_bitmaps[which].height;
+ p.dh = (fringe_bitmaps[which].period
+ ? (p.y % fringe_bitmaps[which].period)
+ : 0);
+ p.h -= p.dh;
+ /* Clip bitmap if too high. */
+ if (p.h > row->height)
+ p.h = row->height;
+
+ p.face = FACE_FROM_ID (f, FRINGE_FACE_ID);
+ PREPARE_FACE_FOR_DISPLAY (f, p.face);
+
+ /* Clear left fringe if no bitmap to draw or if bitmap doesn't fill
+ the fringe. */
+ p.bx = -1;
+ if (left_p)
+ {
+ int wd = WINDOW_LEFT_FRINGE_WIDTH (w);
+ int x = window_box_left (w, (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
+ ? LEFT_MARGIN_AREA
+ : TEXT_AREA));
+ if (p.wd > wd)
+ p.wd = wd;
+ p.x = x - p.wd - (wd - p.wd) / 2;
+
+ if (p.wd < wd || row->height > p.h)
+ {
+ /* If W has a vertical border to its left, don't draw over it. */
+ wd -= ((!WINDOW_LEFTMOST_P (w)
+ && !WINDOW_HAS_VERTICAL_SCROLL_BAR (w))
+ ? 1 : 0);
+ p.bx = x - wd;
+ p.nx = wd;
+ }
+ }
+ else
+ {
+ int x = window_box_right (w,
+ (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
+ ? RIGHT_MARGIN_AREA
+ : TEXT_AREA));
+ int wd = WINDOW_RIGHT_FRINGE_WIDTH (w);
+ if (p.wd > wd)
+ p.wd = wd;
+ p.x = x + (wd - p.wd) / 2;
+ /* Clear right fringe if no bitmap to draw of if bitmap doesn't fill
+ the fringe. */
+ if (p.wd < wd || row->height > p.h)
+ {
+ p.bx = x;
+ p.nx = wd;
+ }
+ }
+
+ if (p.bx >= 0)
+ {
+ int header_line_height = WINDOW_HEADER_LINE_HEIGHT (w);
+
+ p.by = WINDOW_TO_FRAME_PIXEL_Y (w, max (header_line_height, row->y));
+ p.ny = row->visible_height;
+ }
+
+ /* Adjust y to the offset in the row to start drawing the bitmap. */
+ p.y += (row->height - p.h) / 2;
+
+ rif->draw_fringe_bitmap (w, row, &p);
+}
+
+/* Draw fringe bitmaps for glyph row ROW on window W. Call this
+ function with input blocked. */
+
+void
+draw_row_fringe_bitmaps (w, row)
+ struct window *w;
+ struct glyph_row *row;
+{
+ enum fringe_bitmap_type bitmap;
+
+ xassert (interrupt_input_blocked);
+
+ /* If row is completely invisible, because of vscrolling, we
+ don't have to draw anything. */
+ if (row->visible_height <= 0)
+ return;
+
+ if (WINDOW_LEFT_FRINGE_WIDTH (w) != 0)
+ {
+ /* Decide which bitmap to draw in the left fringe. */
+ if (row->overlay_arrow_p)
+ bitmap = OVERLAY_ARROW_BITMAP;
+ else if (row->truncated_on_left_p)
+ bitmap = LEFT_TRUNCATION_BITMAP;
+ else if (MATRIX_ROW_CONTINUATION_LINE_P (row))
+ bitmap = CONTINUATION_LINE_BITMAP;
+ else if (row->indicate_empty_line_p)
+ bitmap = ZV_LINE_BITMAP;
+ else
+ bitmap = NO_FRINGE_BITMAP;
+
+ draw_fringe_bitmap (w, row, bitmap, 1);
+ }
+
+ if (WINDOW_RIGHT_FRINGE_WIDTH (w) != 0)
+ {
+ /* Decide which bitmap to draw in the right fringe. */
+ if (row->truncated_on_right_p)
+ bitmap = RIGHT_TRUNCATION_BITMAP;
+ else if (row->continued_p)
+ bitmap = CONTINUED_LINE_BITMAP;
+ else if (row->indicate_empty_line_p && WINDOW_LEFT_FRINGE_WIDTH (w) == 0)
+ bitmap = ZV_LINE_BITMAP;
+ else
+ bitmap = NO_FRINGE_BITMAP;
+
+ draw_fringe_bitmap (w, row, bitmap, 0);
+ }
+}
+
+
+/* Compute actual fringe widths */
+
+void
+compute_fringe_widths (f, redraw)
+ struct frame *f;
+ int redraw;
+{
+ int o_left = FRAME_LEFT_FRINGE_WIDTH (f);
+ int o_right = FRAME_RIGHT_FRINGE_WIDTH (f);
+ int o_cols = FRAME_FRINGE_COLS (f);
+
+ Lisp_Object left_fringe = Fassq (Qleft_fringe, f->param_alist);
+ Lisp_Object right_fringe = Fassq (Qright_fringe, f->param_alist);
+ int left_fringe_width, right_fringe_width;
+
+ if (!NILP (left_fringe))
+ left_fringe = Fcdr (left_fringe);
+ if (!NILP (right_fringe))
+ right_fringe = Fcdr (right_fringe);
+
+ left_fringe_width = ((NILP (left_fringe) || !INTEGERP (left_fringe)) ? 8 :
+ XINT (left_fringe));
+ right_fringe_width = ((NILP (right_fringe) || !INTEGERP (right_fringe)) ? 8 :
+ XINT (right_fringe));
+
+ if (left_fringe_width || right_fringe_width)
+ {
+ int left_wid = left_fringe_width >= 0 ? left_fringe_width : -left_fringe_width;
+ int right_wid = right_fringe_width >= 0 ? right_fringe_width : -right_fringe_width;
+ int conf_wid = left_wid + right_wid;
+ int font_wid = FRAME_COLUMN_WIDTH (f);
+ int cols = (left_wid + right_wid + font_wid-1) / font_wid;
+ int real_wid = cols * font_wid;
+ if (left_wid && right_wid)
+ {
+ if (left_fringe_width < 0)
+ {
+ /* Left fringe width is fixed, adjust right fringe if necessary */
+ FRAME_LEFT_FRINGE_WIDTH (f) = left_wid;
+ FRAME_RIGHT_FRINGE_WIDTH (f) = real_wid - left_wid;
+ }
+ else if (right_fringe_width < 0)
+ {
+ /* Right fringe width is fixed, adjust left fringe if necessary */
+ FRAME_LEFT_FRINGE_WIDTH (f) = real_wid - right_wid;
+ FRAME_RIGHT_FRINGE_WIDTH (f) = right_wid;
+ }
+ else
+ {
+ /* Adjust both fringes with an equal amount.
+ Note that we are doing integer arithmetic here, so don't
+ lose a pixel if the total width is an odd number. */
+ int fill = real_wid - conf_wid;
+ FRAME_LEFT_FRINGE_WIDTH (f) = left_wid + fill/2;
+ FRAME_RIGHT_FRINGE_WIDTH (f) = right_wid + fill - fill/2;
+ }
+ }
+ else if (left_fringe_width)
+ {
+ FRAME_LEFT_FRINGE_WIDTH (f) = real_wid;
+ FRAME_RIGHT_FRINGE_WIDTH (f) = 0;
+ }
+ else
+ {
+ FRAME_LEFT_FRINGE_WIDTH (f) = 0;
+ FRAME_RIGHT_FRINGE_WIDTH (f) = real_wid;
+ }
+ FRAME_FRINGE_COLS (f) = cols;
+ }
+ else
+ {
+ FRAME_LEFT_FRINGE_WIDTH (f) = 0;
+ FRAME_RIGHT_FRINGE_WIDTH (f) = 0;
+ FRAME_FRINGE_COLS (f) = 0;
+ }
+
+ if (redraw && FRAME_VISIBLE_P (f))
+ if (o_left != FRAME_LEFT_FRINGE_WIDTH (f) ||
+ o_right != FRAME_RIGHT_FRINGE_WIDTH (f) ||
+ o_cols != FRAME_FRINGE_COLS (f))
+ redraw_frame (f);
+}
+
+#endif /* HAVE_WINDOW_SYSTEM */
+
+
+\f
+/************************************************************************
+ Horizontal scrolling
+ ************************************************************************/
+
+static int hscroll_window_tree P_ ((Lisp_Object));
+static int hscroll_windows P_ ((Lisp_Object));
+
+/* For all leaf windows in the window tree rooted at WINDOW, set their
+ hscroll value so that PT is (i) visible in the window, and (ii) so
+ that it is not within a certain margin at the window's left and
+ right border. Value is non-zero if any window's hscroll has been
+ changed. */
+
+static int
+hscroll_window_tree (window)
+ Lisp_Object window;
+{
+ int hscrolled_p = 0;
+ int hscroll_relative_p = FLOATP (Vhscroll_step);
+ int hscroll_step_abs = 0;
+ double hscroll_step_rel = 0;
+
+ if (hscroll_relative_p)
+ {
+ hscroll_step_rel = XFLOAT_DATA (Vhscroll_step);
+ if (hscroll_step_rel < 0)
+ {
+ hscroll_relative_p = 0;
+ hscroll_step_abs = 0;
+ }
+ }
+ else if (INTEGERP (Vhscroll_step))
+ {
+ hscroll_step_abs = XINT (Vhscroll_step);
+ if (hscroll_step_abs < 0)
+ hscroll_step_abs = 0;
+ }
+ else
+ hscroll_step_abs = 0;
+
+ while (WINDOWP (window))
+ {
+ struct window *w = XWINDOW (window);
+
+ if (WINDOWP (w->hchild))
+ hscrolled_p |= hscroll_window_tree (w->hchild);
+ else if (WINDOWP (w->vchild))
+ hscrolled_p |= hscroll_window_tree (w->vchild);
+ else if (w->cursor.vpos >= 0)
+ {
+ int h_margin;
+ int text_area_width;
+ struct glyph_row *current_cursor_row
+ = MATRIX_ROW (w->current_matrix, w->cursor.vpos);
+ struct glyph_row *desired_cursor_row
+ = MATRIX_ROW (w->desired_matrix, w->cursor.vpos);
+ struct glyph_row *cursor_row
+ = (desired_cursor_row->enabled_p
+ ? desired_cursor_row
+ : current_cursor_row);
+
+ text_area_width = window_box_width (w, TEXT_AREA);
+
+ /* Scroll when cursor is inside this scroll margin. */
+ h_margin = hscroll_margin * WINDOW_FRAME_COLUMN_WIDTH (w);
+
+ if ((XFASTINT (w->hscroll)
+ && w->cursor.x <= h_margin)
+ || (cursor_row->enabled_p
+ && cursor_row->truncated_on_right_p
+ && (w->cursor.x >= text_area_width - h_margin)))
+ {
+ struct it it;
+ int hscroll;
+ struct buffer *saved_current_buffer;
+ int pt;
+ int wanted_x;
+
+ /* Find point in a display of infinite width. */
+ saved_current_buffer = current_buffer;
+ current_buffer = XBUFFER (w->buffer);
+
+ if (w == XWINDOW (selected_window))
+ pt = BUF_PT (current_buffer);
+ else
+ {
+ pt = marker_position (w->pointm);
+ pt = max (BEGV, pt);
+ pt = min (ZV, pt);
+ }
+
+ /* Move iterator to pt starting at cursor_row->start in
+ a line with infinite width. */
+ init_to_row_start (&it, w, cursor_row);
+ it.last_visible_x = INFINITY;
+ move_it_in_display_line_to (&it, pt, -1, MOVE_TO_POS);
+ current_buffer = saved_current_buffer;
/* Position cursor in window. */
if (!hscroll_relative_p && hscroll_step_abs == 0)
hscroll = max (0, it.current_x - text_area_width / 2)
- / CANON_X_UNIT (it.f);
- else if (w->cursor.x >= text_area_width - hscroll_margin)
+ / FRAME_COLUMN_WIDTH (it.f);
+ else if (w->cursor.x >= text_area_width - h_margin)
{
if (hscroll_relative_p)
wanted_x = text_area_width * (1 - hscroll_step_rel)
- - hscroll_margin;
+ - h_margin;
else
wanted_x = text_area_width
- - hscroll_step_abs * CANON_X_UNIT (it.f)
- - hscroll_margin;
+ - hscroll_step_abs * FRAME_COLUMN_WIDTH (it.f)
+ - h_margin;
hscroll
- = max (0, it.current_x - wanted_x) / CANON_X_UNIT (it.f);
+ = max (0, it.current_x - wanted_x) / FRAME_COLUMN_WIDTH (it.f);
}
else
{
if (hscroll_relative_p)
wanted_x = text_area_width * hscroll_step_rel
- + hscroll_margin;
+ + h_margin;
else
- wanted_x = hscroll_step_abs * CANON_X_UNIT (it.f)
- + hscroll_margin;
+ wanted_x = hscroll_step_abs * FRAME_COLUMN_WIDTH (it.f)
+ + h_margin;
hscroll
- = max (0, it.current_x - wanted_x) / CANON_X_UNIT (it.f);
+ = max (0, it.current_x - wanted_x) / FRAME_COLUMN_WIDTH (it.f);
}
hscroll = max (hscroll, XFASTINT (w->min_hscroll));
Lisp_Object window;
{
int hscrolled_p;
-
+
if (automatic_hscrolling_p)
{
hscrolled_p = hscroll_window_tree (window);
/* Values of window_end_pos and window_end_vpos at the end of
try_window_id. */
-int debug_end_pos, debug_end_vpos;
+EMACS_INT debug_end_pos, debug_end_vpos;
/* Append a string to W->desired_matrix->method. FMT is a printf
format string. A1...A9 are a supplement for a variable-length
method[len] = '|';
--remaining, ++len;
}
-
+
strncpy (method + len, buffer, remaining);
if (trace_redisplay_p)
w,
((BUFFERP (w->buffer)
&& STRINGP (XBUFFER (w->buffer)->name))
- ? (char *) XSTRING (XBUFFER (w->buffer)->name)->data
+ ? (char *) SDATA (XBUFFER (w->buffer)->name)
: "no buffer"),
buffer);
}
#endif /* GLYPH_DEBUG */
-/* This counter is used to clear the face cache every once in a while
- in redisplay_internal. It is incremented for each redisplay.
- Every CLEAR_FACE_CACHE_COUNT full redisplays, the face cache is
- cleared. */
-
-#define CLEAR_FACE_CACHE_COUNT 500
-static int clear_face_cache_count;
-
-/* Record the previous terminal frame we displayed. */
-
-static struct frame *previous_terminal_frame;
-
-/* Non-zero while redisplay_internal is in progress. */
-
-int redisplaying_p;
-
-
/* Value is non-zero if all changes in window W, which displays
current_buffer, are in the text between START and END. START is a
buffer position, END is given as a distance from Z. Used in
int start, end;
{
int unchanged_p = 1;
-
+
/* If text or overlays have changed, see where. */
if (XFASTINT (w->last_modified) < MODIFF
|| XFASTINT (w->last_overlay_modified) < OVERLAY_MODIFF)
&& (BEG_UNCHANGED < start - 1
|| END_UNCHANGED < end))
unchanged_p = 0;
-
+
/* If selective display, can't optimize if changes start at the
beginning of the line. */
if (unchanged_p
if (prev_pt == pt)
/* Point didn't move. */
return 0;
-
+
if (prev_pt > BUF_BEGV (buf) && prev_pt < BUF_ZV (buf)
&& find_composition (prev_pt, -1, &start, &end, &prop, buffer)
&& COMPOSITION_VALID_P (start, end, prop)
struct window *w;
struct buffer *b;
{
- if (b->prevent_redisplay_optimizations_p)
- b->clip_changed = 1;
- else if (b->clip_changed
+ if (b->clip_changed
&& !NILP (w->window_end_valid)
&& w->current_matrix->buffer == b
&& w->current_matrix->zv == BUF_ZV (b)
b->clip_changed = 1;
}
}
+\f
+#define STOP_POLLING \
+do { if (! polling_stopped_here) stop_polling (); \
+ polling_stopped_here = 1; } while (0)
+
+#define RESUME_POLLING \
+do { if (polling_stopped_here) start_polling (); \
+ polling_stopped_here = 0; } while (0)
/* If PRESERVE_ECHO_AREA is nonzero, it means this redisplay is not in
int number_of_visible_frames;
int count;
struct frame *sf = SELECTED_FRAME ();
+ int polling_stopped_here = 0;
/* Non-zero means redisplay has to consider all windows on all
frames. Zero means, only selected_window is considered. */
int consider_all_windows_p;
-
+
TRACE ((stderr, "redisplay_internal %d\n", redisplaying_p));
/* No redisplay if running in batch mode or frame is not yet fully
return;
}
-#ifdef USE_X_TOOLKIT
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
if (popup_activated ())
return;
#endif
/* Record a function that resets redisplaying_p to its old value
when we leave this function. */
- count = BINDING_STACK_SIZE ();
+ count = SPECPDL_INDEX ();
record_unwind_protect (unwind_redisplay, make_number (redisplaying_p));
++redisplaying_p;
-
+ specbind (Qinhibit_free_realized_faces, Qnil);
+
retry:
pause = 0;
reconsider_clip_changes (w, current_buffer);
FOR_EACH_FRAME (tail, frame)
{
struct frame *f = XFRAME (frame);
-
+
FRAME_SAMPLE_VISIBILITY (f);
if (FRAME_VISIBLE_P (f))
++number_of_visible_frames;
&& !(PT == XFASTINT (w->last_point)
&& XFASTINT (w->last_modified) >= MODIFF
&& XFASTINT (w->last_overlay_modified) >= OVERLAY_MODIFF)
- && XFASTINT (w->column_number_displayed) != current_column ())
- w->update_mode_line = Qt;
+ && (XFASTINT (w->column_number_displayed)
+ != (int) current_column ())) /* iftc */
+ w->update_mode_line = Qt;
FRAME_SCROLL_BOTTOM_VPOS (XFRAME (w->frame)) = -1;
/* The variable buffer_shared is set in redisplay_window and
indicates that we redisplay a buffer in different windows. See
there. */
- consider_all_windows_p = update_mode_lines || buffer_shared > 1;
+ consider_all_windows_p = (update_mode_lines || buffer_shared > 1
+ || cursor_type_changed);
/* If specs for an arrow have changed, do thorough redisplay
to ensure we remove any arrow that should no longer exist. */
the echo area. */
if (!display_last_displayed_message_p)
message_cleared_p = 0;
-
+
if (fonts_changed_p)
goto retry;
else if (window_height_changed_p)
consider_all_windows_p = 1;
++update_mode_lines;
++windows_or_buffers_changed;
-
+
/* If window configuration was changed, frames may have been
marked garbaged. Clear them or we will experience
surprises wrt scrolling. */
consider_all_windows_p = 1;
++windows_or_buffers_changed;
++update_mode_lines;
-
+
/* If window configuration was changed, frames may have been
marked garbaged. Clear them or we will experience
surprises wrt scrolling. */
if (frame_garbaged)
clear_garbaged_frames ();
}
-
+
/* If showing the region, and mark has changed, we must redisplay
the whole window. The assignment to this_line_start_pos prevents
&& CHARPOS (tlbufpos) > 0
&& NILP (w->update_mode_line)
&& !current_buffer->clip_changed
+ && !current_buffer->prevent_redisplay_optimizations_p
&& FRAME_VISIBLE_P (XFRAME (w->frame))
&& !FRAME_OBSCURED_P (XFRAME (w->frame))
/* Make sure recorded data applies to current buffer, etc. */
&& this_line_buffer == current_buffer
&& current_buffer == XBUFFER (w->buffer)
&& NILP (w->force_start)
+ && NILP (w->optional_new_start)
/* Point must be on the line that we have info recorded about. */
&& PT >= CHARPOS (tlbufpos)
&& PT <= Z - CHARPOS (tlendpos)
/* If line contains point, is not continued,
and ends at same distance from eob as before, we win */
- if (w->cursor.vpos >= 0
+ if (w->cursor.vpos >= 0
/* Line is not continued, otherwise this_line_start_pos
would have been set to 0 in display_line. */
&& CHARPOS (this_line_start_pos)
struct glyph_row *row
= MATRIX_ROW (w->current_matrix, this_line_vpos + 1);
int delta, delta_bytes;
-
+
if (Z - CHARPOS (tlendpos) == ZV)
{
/* This line ends at end of (accessible part of)
- BYTEPOS (tlendpos)
- MATRIX_ROW_START_BYTEPOS (row));
}
-
+
increment_matrix_positions (w->current_matrix,
this_line_vpos + 1,
w->current_matrix->nrows,
&& this_line_vpos > 0)
XSETINT (w->window_end_vpos, this_line_vpos - 1);
w->window_end_valid = Qnil;
-
+
/* Update hint: No need to try to scroll in update_window. */
w->desired_matrix->no_scrolling_p = 1;
/* Make sure the cursor was last displayed
in this window. Otherwise we have to reposition it. */
&& 0 <= w->cursor.vpos
- && XINT (w->height) > w->cursor.vpos)
+ && WINDOW_TOTAL_LINES (w) > w->cursor.vpos)
{
if (!must_finish)
{
do_pending_window_change (1);
- /* We used to always goto end_of_redisplay here, but this
+ /* We used to always goto end_of_redisplay here, but this
isn't enough if we have a blinking cursor. */
if (w->cursor_off_p == w->last_cursor_off_p)
goto end_of_redisplay;
it.current_x = this_line_start_x;
it.current_y = this_line_y;
it.vpos = this_line_vpos;
-
+
/* The call to move_it_to stops in front of PT, but
moves over before-strings. */
move_it_to (&it, PT, -1, -1, -1, MOVE_TO_POS);
consider_all_windows_p |= buffer_shared > 1;
++clear_face_cache_count;
-
+
/* Build desired matrices, and update the display. If
consider_all_windows_p is non-zero, do it for all windows on all
frames. Otherwise do it for selected_window, only. */
FOR_EACH_FRAME (tail, frame)
{
struct frame *f = XFRAME (frame);
-
+
if (FRAME_WINDOW_P (f) || f == sf)
{
+#ifdef HAVE_WINDOW_SYSTEM
if (clear_face_cache_count % 50 == 0
&& FRAME_WINDOW_P (f))
clear_image_cache (f, 0);
+#endif /* HAVE_WINDOW_SYSTEM */
/* Mark all the scroll bars to be removed; we'll redeem
the ones we want when we redisplay their windows. */
judge_scroll_bars_hook (f);
/* If fonts changed, display again. */
+ /* ??? rms: I suspect it is a mistake to jump all the way
+ back to retry here. It should just retry this frame. */
if (fonts_changed_p)
goto retry;
-
+
if (FRAME_VISIBLE_P (f) && !FRAME_OBSCURED_P (f))
{
/* See if we have to hscroll. */
error. */
if (interrupt_input)
unrequest_sigio ();
- stop_polling ();
+ STOP_POLLING;
/* Update the display. */
set_window_update_flags (XWINDOW (f->root_window), 1);
pause |= update_frame (f, 0, 0);
+#if 0 /* Exiting the loop can leave the wrong value for buffer_shared. */
if (pause)
break;
+#endif
if (n == size)
{
bcopy (updated, p, nbytes);
size *= 2;
}
-
+
updated[n++] = f;
}
}
struct frame *mini_frame;
displayed_buffer = XBUFFER (XWINDOW (selected_window)->buffer);
- internal_condition_case_1 (redisplay_window_1, selected_window, Qerror,
+ /* Use list_of_error, not Qerror, so that
+ we catch only errors and don't run the debugger. */
+ internal_condition_case_1 (redisplay_window_1, selected_window,
+ list_of_error,
redisplay_window_error);
-
+
/* Compare desired and current matrices, perform output. */
+
update:
-
/* If fonts changed, display again. */
if (fonts_changed_p)
goto retry;
which can cause an apparent I/O error. */
if (interrupt_input)
unrequest_sigio ();
- stop_polling ();
+ STOP_POLLING;
if (FRAME_VISIBLE_P (sf) && !FRAME_OBSCURED_P (sf))
{
if (hscroll_windows (selected_window))
goto retry;
-
+
XWINDOW (selected_window)->must_be_updated_p = 1;
pause = update_frame (sf, 0, 0);
}
it here. */
mini_window = FRAME_MINIBUF_WINDOW (sf);
mini_frame = XFRAME (WINDOW_FRAME (XWINDOW (mini_window)));
-
+
if (mini_frame != sf && FRAME_WINDOW_P (mini_frame))
{
XWINDOW (mini_window)->must_be_updated_p = 1;
last_arrow_position = Qt;
last_arrow_string = Qt;
}
-
+
/* If we pause after scrolling, some rows in the current
matrices of some windows are not valid. */
if (!WINDOW_FULL_WIDTH_P (w)
/* This has already been done above if
consider_all_windows_p is set. */
mark_window_display_accurate_1 (w, 1);
-
+
last_arrow_position = COERCE_MARKER (Voverlay_arrow_position);
last_arrow_string = Voverlay_arrow_string;
-
+
if (frame_up_to_date_hook != 0)
frame_up_to_date_hook (sf);
}
update_mode_lines = 0;
windows_or_buffers_changed = 0;
+ cursor_type_changed = 0;
}
/* Start SIGIO interrupts coming again. Having them off during the
But it is much hairier to try to do anything about that. */
if (interrupt_input)
request_sigio ();
- start_polling ();
+ RESUME_POLLING;
/* If a frame has become visible which was not before, redisplay
again, so that we display it. Expose events for such a frame
if (windows_or_buffers_changed && !pause)
goto retry;
- end_of_redisplay:;
-
+ end_of_redisplay:
unbind_to (count, Qnil);
+ RESUME_POLLING;
}
/* Function registered with record_unwind_protect in
- redisplay_internal. Clears the flag indicating that a redisplay is
- in progress. */
+ redisplay_internal. Reset redisplaying_p to the value it had
+ before redisplay_internal was called, and clear
+ prevent_freeing_realized_faces_p. */
static Lisp_Object
unwind_redisplay (old_redisplaying_p)
if (BUFFERP (w->buffer))
{
struct buffer *b = XBUFFER (w->buffer);
-
+
w->last_modified
= make_number (accurate_p ? BUF_MODIFF (b) : 0);
w->last_overlay_modified
BUF_OVERLAY_UNCHANGED_MODIFIED (b) = BUF_OVERLAY_MODIFF (b);
BUF_BEG_UNCHANGED (b) = BUF_GPT (b) - BUF_BEG (b);
BUF_END_UNCHANGED (b) = BUF_Z (b) - BUF_GPT (b);
-
+
w->current_matrix->buffer = b;
w->current_matrix->begv = BUF_BEGV (b);
w->current_matrix->zv = BUF_ZV (b);
-
+
w->last_cursor = w->cursor;
w->last_cursor_off_p = w->cursor_off_p;
-
+
if (w == XWINDOW (selected_window))
w->last_point = make_number (BUF_PT (b));
else
w->window_end_valid = w->buffer;
#if 0 /* This is incorrect with variable-height lines. */
xassert (XINT (w->window_end_vpos)
- < (XINT (w->height)
+ < (WINDOW_TOTAL_LINES (w)
- (WINDOW_WANTS_MODELINE_P (w) ? 1 : 0)));
#endif
w->update_mode_line = Qnil;
int accurate_p;
{
struct window *w;
-
+
for (; !NILP (window); window = w->next)
{
w = XWINDOW (window);
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;
-}
+}
\f
while (!NILP (window))
{
struct window *w = XWINDOW (window);
-
+
if (!NILP (w->hchild))
redisplay_windows (w->hchild);
else if (!NILP (w->vchild))
else
{
displayed_buffer = XBUFFER (w->buffer);
- internal_condition_case_1 (redisplay_window_0, window, Qerror,
+ /* Use list_of_error, not Qerror, so that
+ we catch only errors and don't run the debugger. */
+ internal_condition_case_1 (redisplay_window_0, window,
+ list_of_error,
redisplay_window_error);
}
&& row->x == 0)
{
this_line_buffer = XBUFFER (w->buffer);
-
+
CHARPOS (this_line_start_pos)
= MATRIX_ROW_START_CHARPOS (row) + delta;
BYTEPOS (this_line_start_pos)
= MATRIX_ROW_START_BYTEPOS (row) + delta_bytes;
-
+
CHARPOS (this_line_end_pos)
= Z - (MATRIX_ROW_END_CHARPOS (row) + delta);
BYTEPOS (this_line_end_pos)
= Z_BYTE - (MATRIX_ROW_END_BYTEPOS (row) + delta_bytes);
-
+
this_line_y = w->cursor.y;
this_line_pixel_height = row->height;
this_line_vpos = w->cursor.vpos;
if (!NILP (Vwindow_scroll_functions))
{
- run_hook_with_args_2 (Qwindow_scroll_functions, window,
+ run_hook_with_args_2 (Qwindow_scroll_functions, window,
make_number (CHARPOS (startp)));
SET_TEXT_POS_FROM_MARKER (startp, w->start);
/* In case the hook functions switch buffers. */
}
-/* Modify the desired matrix of window W and W->vscroll so that the
- line containing the cursor is fully visible. If this requires
- larger matrices than are allocated, set fonts_changed_p and return
- 0. */
+/* Make sure the line containing the cursor is fully visible.
+ A value of 1 means there is nothing to be done.
+ (Either the line is fully visible, or it cannot be made so,
+ or we cannot tell.)
+ A value of 0 means the caller should do scrolling
+ as if point had gone off the screen. */
static int
make_cursor_line_fully_visible (w)
struct glyph_matrix *matrix;
struct glyph_row *row;
int window_height;
-
+
/* It's not always possible to find the cursor, e.g, when a window
is full of overlay strings. Don't do anything in that case. */
if (w->cursor.vpos < 0)
return 1;
-
+
matrix = w->desired_matrix;
row = MATRIX_ROW (matrix, w->cursor.vpos);
- /* If the cursor row is not partially visible, there's nothing
- to do. */
+ /* If the cursor row is not partially visible, there's nothing to do. */
if (!MATRIX_ROW_PARTIALLY_VISIBLE_P (row))
return 1;
if (row->height >= window_height)
return 1;
+ return 0;
+
+#if 0
+ /* This code used to try to scroll the window just enough to make
+ the line visible. It returned 0 to say that the caller should
+ allocate larger glyph matrices. */
+
if (MATRIX_ROW_PARTIALLY_VISIBLE_AT_TOP_P (w, row))
{
int dy = row->height - row->visible_height;
w->cursor.y += dy;
shift_glyph_matrix (w, matrix, 0, matrix->nrows, dy);
}
-
+
/* When we change the cursor y-position of the selected window,
change this_line_y as well so that the display optimization for
the cursor line of the selected window in redisplay_internal uses
}
return 1;
+#endif /* 0 */
}
in redisplay_window to bring a partially visible line into view in
the case that only the cursor has moved.
+ LAST_LINE_MISFIT should be nonzero if we're scrolling because the
+ last screen line's vertical height extends past the end of the screen.
+
Value is
1 if scrolling succeeded
-
+
0 if scrolling didn't find point.
-
+
-1 if new fonts have been loaded so that we must interrupt
redisplay, adjust glyph matrices, and try again. */
static int
try_scrolling (window, just_this_one_p, scroll_conservatively,
- scroll_step, temp_scroll_step)
+ scroll_step, temp_scroll_step, last_line_misfit)
Lisp_Object window;
int just_this_one_p;
- int scroll_conservatively, scroll_step;
+ EMACS_INT scroll_conservatively, scroll_step;
int temp_scroll_step;
+ int last_line_misfit;
{
struct window *w = XWINDOW (window);
struct frame *f = XFRAME (w->frame);
int amount_to_scroll = 0;
Lisp_Object aggressive;
int height;
+ int end_scroll_margin;
#if GLYPH_DEBUG
debug_method_add (w, "try_scrolling");
#endif
SET_TEXT_POS_FROM_MARKER (startp, w->start);
-
+
/* Compute scroll margin height in pixels. We scroll when point is
within this distance from the top or bottom of the window. */
if (scroll_margin > 0)
{
- this_scroll_margin = min (scroll_margin, XINT (w->height) / 4);
- this_scroll_margin *= CANON_Y_UNIT (f);
+ this_scroll_margin = min (scroll_margin, WINDOW_TOTAL_LINES (w) / 4);
+ this_scroll_margin *= FRAME_LINE_HEIGHT (f);
}
else
this_scroll_margin = 0;
scroll_max = 10;
else
scroll_max = 0;
- scroll_max *= CANON_Y_UNIT (f);
+ scroll_max *= FRAME_LINE_HEIGHT (f);
/* Decide whether we have to scroll down. Start at the window end
and move this_scroll_margin up to find the position of the scroll
margin. */
window_end = Fwindow_end (window, Qt);
+
+ too_near_end:
+
CHARPOS (scroll_margin_pos) = XINT (window_end);
BYTEPOS (scroll_margin_pos) = CHAR_TO_BYTE (CHARPOS (scroll_margin_pos));
- if (this_scroll_margin)
+
+ end_scroll_margin = this_scroll_margin + !!last_line_misfit;
+ if (end_scroll_margin)
{
start_display (&it, w, scroll_margin_pos);
- move_it_vertically (&it, - this_scroll_margin);
+ move_it_vertically (&it, - end_scroll_margin);
scroll_margin_pos = it.current.pos;
}
if (PT >= CHARPOS (scroll_margin_pos))
{
int y0;
-
+
/* Point is in the scroll margin at the bottom of the window, or
below. Compute a new window start that makes point visible. */
down so that the line the cursor is in is visible, which
means we have to add in the height of the cursor line. */
dy = line_bottom_y (&it) - y0;
-
+
if (dy > scroll_max)
return SCROLLING_FAILED;
-
+
/* Move the window start down. If scrolling conservatively,
move it just enough down to make point visible. If
scroll_step is set, move it down by scroll_step. */
start_display (&it, w, startp);
if (scroll_conservatively)
+ /* Set AMOUNT_TO_SCROLL to at least one line,
+ and at most scroll_conservatively lines. */
amount_to_scroll
- = max (max (dy, CANON_Y_UNIT (f)),
- CANON_Y_UNIT (f) * max (scroll_step, temp_scroll_step));
+ = min (max (dy, FRAME_LINE_HEIGHT (f)),
+ FRAME_LINE_HEIGHT (f) * scroll_conservatively);
else if (scroll_step || temp_scroll_step)
amount_to_scroll = scroll_max;
else
{
aggressive = current_buffer->scroll_up_aggressively;
- height = (WINDOW_DISPLAY_HEIGHT_NO_MODE_LINE (w)
- - WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w));
+ height = WINDOW_BOX_TEXT_HEIGHT (w);
if (NUMBERP (aggressive))
amount_to_scroll = XFLOATINT (aggressive) * height;
}
if (amount_to_scroll <= 0)
return SCROLLING_FAILED;
+ /* If moving by amount_to_scroll leaves STARTP unchanged,
+ move it down one screen line. */
+
move_it_vertically (&it, amount_to_scroll);
+ if (CHARPOS (it.current.pos) == CHARPOS (startp))
+ move_it_by_lines (&it, 1, 1);
startp = it.current.pos;
}
else
/* Point is in the scroll margin at the top of the window or
above what is displayed in the window. */
int y0;
-
+
/* Compute the vertical distance from PT to the scroll
margin position. Give up if distance is greater than
scroll_max. */
dy = it.current_y - y0;
if (dy > scroll_max)
return SCROLLING_FAILED;
-
+
/* Compute new window start. */
start_display (&it, w, startp);
-
+
if (scroll_conservatively)
amount_to_scroll =
- max (dy, CANON_Y_UNIT (f) * max (scroll_step, temp_scroll_step));
+ max (dy, FRAME_LINE_HEIGHT (f) * max (scroll_step, temp_scroll_step));
else if (scroll_step || temp_scroll_step)
amount_to_scroll = scroll_max;
else
{
aggressive = current_buffer->scroll_down_aggressively;
- height = (WINDOW_DISPLAY_HEIGHT_NO_MODE_LINE (w)
- - WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w));
+ height = WINDOW_BOX_TEXT_HEIGHT (w);
if (NUMBERP (aggressive))
amount_to_scroll = XFLOATINT (aggressive) * height;
}
if (amount_to_scroll <= 0)
return SCROLLING_FAILED;
-
+
move_it_vertically (&it, - amount_to_scroll);
startp = it.current.pos;
}
else
{
/* Maybe forget recorded base line for line number display. */
- if (!just_this_one_p
+ if (!just_this_one_p
|| current_buffer->clip_changed
|| BEG_UNCHANGED < CHARPOS (startp))
w->base_line_number = Qnil;
-
- /* If cursor ends up on a partially visible line, shift display
- lines up or down. If that fails because we need larger
- matrices, give up. */
- if (!make_cursor_line_fully_visible (w))
- rc = SCROLLING_NEED_LARGER_MATRICES;
- else
- rc = SCROLLING_SUCCESS;
+
+ /* If cursor ends up on a partially visible line,
+ treat that as being off the bottom of the screen. */
+ if (! make_cursor_line_fully_visible (w))
+ {
+ clear_glyph_matrix (w->desired_matrix);
+ last_line_misfit = 1;
+ goto too_near_end;
+ }
+ rc = SCROLLING_SUCCESS;
}
return rc;
SET_TEXT_POS_FROM_MARKER (start_pos, w->start);
/* If window start is on a continuation line... Window start may be
- < BEGV in case there's invisible text at the start of the
+ < BEGV in case there's invisible text at the start of the
buffer (M-x rmail, for example). */
if (CHARPOS (start_pos) > BEGV
&& FETCH_BYTE (BYTEPOS (start_pos) - 1) != '\n')
SET_TEXT_POS (start_pos, BEGV, BEGV_BYTE);
else if (CHARPOS (start_pos) > ZV)
SET_TEXT_POS (start_pos, ZV, ZV_BYTE);
-
+
/* Find the start of the continued line. This should be fast
because scan_buffer is fast (newline cache). */
row = w->desired_matrix->rows + (WINDOW_WANTS_HEADER_LINE_P (w) ? 1 : 0);
/* If the line start is "too far" away from the window start,
say it takes too much time to compute a new window start. */
if (CHARPOS (start_pos) - IT_CHARPOS (it)
- < XFASTINT (w->height) * XFASTINT (w->width))
+ < WINDOW_TOTAL_LINES (w) * WINDOW_TOTAL_COLS (w))
{
int min_distance, distance;
-
+
/* Move forward by display lines to find the new window
start. If window width was enlarged, the new start can
be expected to be > the old start. If window width was
pos = it.current.pos;
move_it_by_lines (&it, 1, 0);
}
-
+
/* Set the window start there. */
SET_MARKER_FROM_TEXT_POS (w->start, pos);
window_start_changed_p = 1;
}
}
-
+
return window_start_changed_p;
}
-/* Try cursor movement in case text has not changes in window WINDOW,
+/* Try cursor movement in case text has not changed in window WINDOW,
with window start STARTP. Value is
CURSOR_MOVEMENT_SUCCESS if successful
-
+
CURSOR_MOVEMENT_CANNOT_BE_USED if this method cannot be used
CURSOR_MOVEMENT_MUST_SCROLL if we know we have to scroll the
which case we have to abort this redisplay, and adjust matrices
first. */
-enum
+enum
{
CURSOR_MOVEMENT_SUCCESS,
CURSOR_MOVEMENT_CANNOT_BE_USED,
struct window *w = XWINDOW (window);
struct frame *f = XFRAME (w->frame);
int rc = CURSOR_MOVEMENT_CANNOT_BE_USED;
-
+
#if GLYPH_DEBUG
if (inhibit_try_cursor_movement)
return rc;
cases. */
&& !update_mode_lines
&& !windows_or_buffers_changed
- /* Can't use this case if highlighting a region. When a
+ && !cursor_type_changed
+ /* Can't use this case if highlighting a region. When a
region exists, cursor movement has to do more than just
set the cursor. */
&& !(!NILP (Vtransient_mark_mode)
/* Scroll if point within this distance from the top or bottom
of the window. This is a pixel value. */
this_scroll_margin = max (0, scroll_margin);
- this_scroll_margin = min (this_scroll_margin, XFASTINT (w->height) / 4);
- this_scroll_margin *= CANON_Y_UNIT (f);
+ this_scroll_margin = min (this_scroll_margin, WINDOW_TOTAL_LINES (w) / 4);
+ this_scroll_margin *= FRAME_LINE_HEIGHT (f);
/* Start with the row the cursor was displayed during the last
not paused redisplay. Give up if that row is not valid. */
{
int scroll_p = 0;
int last_y = window_text_bottom_y (w) - this_scroll_margin;
-
+
if (PT > XFASTINT (w->last_point))
{
/* Point has moved forward. */
&& MATRIX_ROW_END_CHARPOS (row) == PT
&& !cursor_row_p (w, row))
++row;
-
+
/* If within the scroll margin, scroll. */
if (row->y < this_scroll_margin
&& CHARPOS (startp) != BEGV)
else
{
set_cursor_from_row (w, row, w->current_matrix, 0, 0, 0, 0);
- try_window (window, startp);
if (!make_cursor_line_fully_visible (w))
- rc = CURSOR_MOVEMENT_NEED_LARGER_MATRICES;
+ rc = CURSOR_MOVEMENT_MUST_SCROLL;
else
rc = CURSOR_MOVEMENT_SUCCESS;
}
return rc;
}
+void
+set_vertical_scroll_bar (w)
+ struct window *w;
+{
+ int start, end, whole;
+
+ /* Calculate the start and end positions for the current window.
+ At some point, it would be nice to choose between scrollbars
+ which reflect the whole buffer size, with special markers
+ indicating narrowing, and scrollbars which reflect only the
+ visible region.
+
+ Note that mini-buffers sometimes aren't displaying any text. */
+ if (!MINI_WINDOW_P (w)
+ || (w == XWINDOW (minibuf_window)
+ && NILP (echo_area_buffer[0])))
+ {
+ struct buffer *buf = XBUFFER (w->buffer);
+ whole = BUF_ZV (buf) - BUF_BEGV (buf);
+ start = marker_position (w->start) - BUF_BEGV (buf);
+ /* I don't think this is guaranteed to be right. For the
+ moment, we'll pretend it is. */
+ end = BUF_Z (buf) - XFASTINT (w->window_end_pos) - BUF_BEGV (buf);
+
+ if (end < start)
+ end = start;
+ if (whole < (end - start))
+ whole = end - start;
+ }
+ else
+ start = end = whole = 0;
+
+ /* Indicate what this scroll bar ought to be displaying now. */
+ set_vertical_scroll_bar_hook (w, end - start, whole, start);
+}
/* Redisplay leaf window WINDOW. JUST_THIS_ONE_P non-zero means only
- selected_window is redisplayed. */
+ selected_window is redisplayed.
+
+ We can return without actually redisplaying the window if
+ fonts_changed_p is nonzero. In that case, redisplay_internal will
+ retry. */
static void
redisplay_window (window, just_this_one_p)
struct it it;
/* Record it now because it's overwritten. */
int current_matrix_up_to_date_p = 0;
+ /* This is less strict than current_matrix_up_to_date_p.
+ It indictes that the buffer contents and narrowing are unchanged. */
+ int buffer_unchanged_p = 0;
int temp_scroll_step = 0;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
int rc;
+ int centering_position;
+ int last_line_misfit = 0;
SET_TEXT_POS (lpoint, PT, PT_BYTE);
opoint = lpoint;
specbind (Qinhibit_point_motion_hooks, Qt);
reconsider_clip_changes (w, buffer);
-
- /* Has the mode line to be updated? */
+
+ /* Has the mode line to be updated? */
update_mode_line = (!NILP (w->update_mode_line)
|| update_mode_lines
- || buffer->clip_changed);
+ || buffer->clip_changed
+ || buffer->prevent_redisplay_optimizations_p);
if (MINI_WINDOW_P (w))
{
/* We've already displayed the echo area glyphs in this window. */
goto finish_scroll_bars;
}
- else if (w != XWINDOW (minibuf_window))
+ else if ((w != XWINDOW (minibuf_window)
+ || minibuf_level == 0)
+ /* When buffer is nonempty, redisplay window normally. */
+ && BUF_Z (XBUFFER (w->buffer)) == BUF_BEG (XBUFFER (w->buffer))
+ /* Quail displays non-mini buffers in minibuffer window.
+ In that case, redisplay the window normally. */
+ && !NILP (Fmemq (w->buffer, Vminibuffer_list)))
{
- /* W is a mini-buffer window, but it's not the currently
- active one, so clear it. */
+ /* W is a mini-buffer window, but it's not active, so clear
+ it. */
int yb = window_text_bottom_y (w);
struct glyph_row *row;
int y;
SET_TEXT_POS (opoint, PT, PT_BYTE);
current_matrix_up_to_date_p
+ = (!NILP (w->window_end_valid)
+ && !current_buffer->clip_changed
+ && !current_buffer->prevent_redisplay_optimizations_p
+ && XFASTINT (w->last_modified) >= MODIFF
+ && XFASTINT (w->last_overlay_modified) >= OVERLAY_MODIFF);
+
+ buffer_unchanged_p
= (!NILP (w->window_end_valid)
&& !current_buffer->clip_changed
&& XFASTINT (w->last_modified) >= MODIFF
window start in case the window's width changed. */
if (XMARKER (w->start)->buffer == current_buffer)
compute_window_start_on_continuation_line (w);
-
+
w->window_end_valid = Qnil;
}
&& !(PT == XFASTINT (w->last_point)
&& XFASTINT (w->last_modified) >= MODIFF
&& XFASTINT (w->last_overlay_modified) >= OVERLAY_MODIFF)
- && XFASTINT (w->column_number_displayed) != current_column ())
- update_mode_line = 1;
+ && (XFASTINT (w->column_number_displayed)
+ != (int) current_column ())) /* iftc */
+ update_mode_line = 1;
/* Count number of windows showing the selected buffer. An indirect
buffer counts as its base buffer. */
new_pt_byte = ZV_BYTE;
set_marker_both (w->pointm, Qnil, ZV, ZV_BYTE);
}
-
+
/* We don't use SET_PT so that the point-motion hooks don't run. */
TEMP_SET_PT_BOTH (new_pt, new_pt_byte);
}
if (!NILP (w->force_start)
|| w->frozen_window_start_p)
{
+ /* We set this later on if we have to adjust point. */
+ int new_vpos = -1;
+
w->force_start = Qnil;
w->vscroll = 0;
w->window_end_valid = Qnil;
/* Forget any recorded base line for line number display. */
- if (!current_matrix_up_to_date_p
- || current_buffer->clip_changed)
+ if (!buffer_unchanged_p)
w->base_line_number = Qnil;
/* Redisplay the mode line. Select the buffer properly for that.
w->update_mode_line = Qt;
startp = run_window_scroll_functions (window, startp);
}
-
+
w->last_modified = make_number (0);
w->last_overlay_modified = make_number (0);
if (CHARPOS (startp) < BEGV)
SET_TEXT_POS (startp, BEGV, BEGV_BYTE);
else if (CHARPOS (startp) > ZV)
SET_TEXT_POS (startp, ZV, ZV_BYTE);
-
- /* Redisplay, then check if cursor has been set during the
+
+ /* Redisplay, then check if cursor has been set during the
redisplay. Give up if new fonts were loaded. */
if (!try_window (window, startp))
{
w->force_start = Qt;
clear_glyph_matrix (w->desired_matrix);
- goto finish_scroll_bars;
+ goto need_larger_matrices;
}
if (w->cursor.vpos < 0 && !w->frozen_window_start_p)
/* If point does not appear, try to move point so it does
appear. The desired matrix has been built above, so we
can use it here. */
- int window_height;
+ new_vpos = window_box_height (w) / 2;
+ }
+
+ if (!make_cursor_line_fully_visible (w))
+ {
+ /* Point does appear, but on a line partly visible at end of window.
+ Move it back to a fully-visible line. */
+ new_vpos = window_box_height (w);
+ }
+
+ /* If we need to move point for either of the above reasons,
+ now actually do it. */
+ if (new_vpos >= 0)
+ {
struct glyph_row *row;
- window_height = window_box_height (w) / 2;
row = MATRIX_FIRST_TEXT_ROW (w->desired_matrix);
- while (MATRIX_ROW_BOTTOM_Y (row) < window_height)
+ while (MATRIX_ROW_BOTTOM_Y (row) < new_vpos)
++row;
TEMP_SET_PT_BOTH (MATRIX_ROW_START_CHARPOS (row),
SET_TEXT_POS (lpoint, PT, PT_BYTE);
set_cursor_from_row (w, row, w->desired_matrix, 0, 0, 0, 0);
-
+
/* If we are highlighting the region, then we just changed
the region, so redisplay to show it. */
if (!NILP (Vtransient_mark_mode)
}
}
- if (!make_cursor_line_fully_visible (w))
- goto need_larger_matrices;
#if GLYPH_DEBUG
debug_method_add (w, "forced window start");
#endif
}
/* Handle case where text has not changed, only point, and it has
- not moved off the frame. */
+ not moved off the frame, and we are not retrying after hscroll.
+ (current_matrix_up_to_date_p is nonzero when retrying.) */
if (current_matrix_up_to_date_p
&& (rc = try_cursor_movement (window, startp, &temp_scroll_step),
rc != CURSOR_MOVEMENT_CANNOT_BE_USED))
{
case CURSOR_MOVEMENT_SUCCESS:
goto done;
-
+
+#if 0 /* try_cursor_movement never returns this value. */
case CURSOR_MOVEMENT_NEED_LARGER_MATRICES:
goto need_larger_matrices;
-
+#endif
+
case CURSOR_MOVEMENT_MUST_SCROLL:
goto try_to_scroll;
-
+
default:
abort ();
}
#endif
goto recenter;
}
-
+
/* Try scrolling with try_window_id. Value is > 0 if update has
been done, it is -1 if we know that the same window start will
not work. It is 0 if unsuccessful for some other reason. */
#if GLYPH_DEBUG
debug_method_add (w, "same window start");
#endif
-
+
/* Try to redisplay starting at same place as before.
If point has not moved off frame, accept the results. */
if (!current_matrix_up_to_date_p
if (fonts_changed_p)
goto need_larger_matrices;
-
+
if (w->cursor.vpos >= 0)
{
- if (!just_this_one_p
+ if (!just_this_one_p
|| current_buffer->clip_changed
|| BEG_UNCHANGED < CHARPOS (startp))
/* Forget any recorded base line for line number display. */
w->base_line_number = Qnil;
-
+
if (!make_cursor_line_fully_visible (w))
- goto need_larger_matrices;
- goto done;
+ {
+ clear_glyph_matrix (w->desired_matrix);
+ last_line_misfit = 1;
+ }
+ /* Drop through and scroll. */
+ else
+ goto done;
}
else
clear_glyph_matrix (w->desired_matrix);
|| NUMBERP (current_buffer->scroll_up_aggressively)
|| NUMBERP (current_buffer->scroll_down_aggressively))
&& !current_buffer->clip_changed
- && CHARPOS (startp) >= BEGV
+ && CHARPOS (startp) >= BEGV
&& CHARPOS (startp) <= ZV)
{
/* The function returns -1 if new fonts were loaded, 1 if
int rc = try_scrolling (window, just_this_one_p,
scroll_conservatively,
scroll_step,
- temp_scroll_step);
+ temp_scroll_step, last_line_misfit);
switch (rc)
{
case SCROLLING_SUCCESS:
goto done;
-
+
case SCROLLING_NEED_LARGER_MATRICES:
goto need_larger_matrices;
-
+
case SCROLLING_FAILED:
break;
-
+
default:
abort ();
}
/* Finally, just choose place to start which centers point */
recenter:
+ centering_position = window_box_height (w) / 2;
+
+ point_at_top:
+ /* Jump here with centering_position already set to 0. */
#if GLYPH_DEBUG
debug_method_add (w, "recenter");
/* w->vscroll = 0; */
/* Forget any previously recorded base line for line number display. */
- if (!current_matrix_up_to_date_p
- || current_buffer->clip_changed)
+ if (!buffer_unchanged_p)
w->base_line_number = Qnil;
/* Move backward half the height of the window. */
init_iterator (&it, w, PT, PT_BYTE, NULL, DEFAULT_FACE_ID);
it.current_y = it.last_visible_y;
- move_it_vertically_backward (&it, window_box_height (w) / 2);
+ move_it_vertically_backward (&it, centering_position);
xassert (IT_CHARPOS (it) >= BEGV);
/* The function move_it_vertically_backward may move over more
}
it.current_x = it.hpos = 0;
-
+
/* Set startp here explicitly in case that helps avoid an infinite loop
in case the window-scroll-functions functions get errors. */
set_marker_both (w->start, Qnil, IT_CHARPOS (it), IT_BYTEPOS (it));
/* Redisplay the window. */
if (!current_matrix_up_to_date_p
|| windows_or_buffers_changed
+ || cursor_type_changed
/* Don't use try_window_reusing_current_matrix in this case
because it can have changed the buffer. */
|| !NILP (Vwindow_scroll_functions)
++row;
set_cursor_from_row (w, row, w->current_matrix, 0, 0, 0, 0);
}
-
+
if (!make_cursor_line_fully_visible (w))
- goto need_larger_matrices;
+ {
+ /* If vscroll is enabled, disable it and try again. */
+ if (w->vscroll)
+ {
+ w->vscroll = 0;
+ clear_glyph_matrix (w->desired_matrix);
+ goto recenter;
+ }
+
+ /* If centering point failed to make the whole line visible,
+ put point at the top instead. That has to make the whole line
+ visible, if it can be done. */
+ centering_position = 0;
+ goto point_at_top;
+ }
done:
/* Display the mode line, if we must. */
if ((update_mode_line
/* If window not full width, must redo its mode line
- if (a) the window to its side is being redone and
+ if (a) the window to its side is being redone and
(b) we do a frame-based redisplay. This is a consequence
of how inverted lines are drawn in frame-based redisplay. */
- || (!just_this_one_p
+ || (!just_this_one_p
&& !FRAME_WINDOW_P (f)
&& !WINDOW_FULL_WIDTH_P (w))
/* Line number to display. */
|| INTEGERP (w->base_line_pos)
/* Column number is displayed and different from the one displayed. */
|| (!NILP (w->column_number_displayed)
- && XFASTINT (w->column_number_displayed) != current_column ()))
+ && (XFASTINT (w->column_number_displayed)
+ != (int) current_column ()))) /* iftc */
/* This means that the window has a mode line. */
&& (WINDOW_WANTS_MODELINE_P (w)
|| WINDOW_WANTS_HEADER_LINE_P (w)))
MATRIX_MODE_LINE_ROW (w->current_matrix)->height
= DESIRED_MODE_LINE_HEIGHT (w);
}
-
+
/* If top line height has changed, arrange for a thorough
immediate redisplay using the correct mode line height. */
if (WINDOW_WANTS_HEADER_LINE_P (w)
}
finish_menu_bars:
-
+
/* When we reach a frame's selected window, redo the frame's menu bar. */
if (update_mode_line
&& EQ (FRAME_SELECTED_WINDOW (f), window))
{
int redisplay_menu_p = 0;
+ int redisplay_tool_bar_p = 0;
if (FRAME_WINDOW_P (f))
{
-#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
+#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (MAC_OS) \
+ || defined (USE_GTK)
redisplay_menu_p = FRAME_EXTERNAL_MENU_BAR (f);
#else
redisplay_menu_p = FRAME_MENU_BAR_LINES (f) > 0;
display_menu_bar (w);
#ifdef HAVE_WINDOW_SYSTEM
- if (WINDOWP (f->tool_bar_window)
- && (FRAME_TOOL_BAR_LINES (f) > 0
- || auto_resize_tool_bars_p))
- redisplay_tool_bar (f);
+#ifdef USE_GTK
+ redisplay_tool_bar_p = FRAME_EXTERNAL_TOOL_BAR (f);
+#else
+ redisplay_tool_bar_p = WINDOWP (f->tool_bar_window)
+ && (FRAME_TOOL_BAR_LINES (f) > 0
+ || auto_resize_tool_bars_p);
+
+#endif
+
+ if (redisplay_tool_bar_p)
+ redisplay_tool_bar (f);
#endif
}
+ /* We go to this label, with fonts_changed_p nonzero,
+ if it is necessary to try again using larger glyph matrices.
+ We have to redeem the scroll bar even in this case,
+ because the loop in redisplay_internal expects that. */
need_larger_matrices:
;
finish_scroll_bars:
- if (FRAME_HAS_VERTICAL_SCROLL_BARS (f))
+ if (WINDOW_HAS_VERTICAL_SCROLL_BAR (w))
{
- int start, end, whole;
-
- /* Calculate the start and end positions for the current window.
- At some point, it would be nice to choose between scrollbars
- which reflect the whole buffer size, with special markers
- indicating narrowing, and scrollbars which reflect only the
- visible region.
-
- Note that mini-buffers sometimes aren't displaying any text. */
- if (!MINI_WINDOW_P (w)
- || (w == XWINDOW (minibuf_window)
- && NILP (echo_area_buffer[0])))
- {
- whole = ZV - BEGV;
- start = marker_position (w->start) - BEGV;
- /* I don't think this is guaranteed to be right. For the
- moment, we'll pretend it is. */
- end = (Z - XFASTINT (w->window_end_pos)) - BEGV;
-
- if (end < start)
- end = start;
- if (whole < (end - start))
- whole = end - start;
- }
- else
- start = end = whole = 0;
-
- /* Indicate what this scroll bar ought to be displaying now. */
- set_vertical_scroll_bar_hook (w, end - start, whole, start);
+ /* Set the thumb's position and size. */
+ set_vertical_scroll_bar (w);
/* Note that we actually used the scroll bar attached to this
window, so it shouldn't be deleted at the end of redisplay. */
}
else
{
- w->window_end_bytepos = 0;
- w->window_end_pos = w->window_end_vpos = make_number (0);
+ w->window_end_bytepos = Z_BYTE - ZV_BYTE;
+ w->window_end_pos = make_number (Z - ZV);
+ w->window_end_vpos = make_number (0);
}
-
+
/* But that is not valid info until redisplay finishes. */
w->window_end_valid = Qnil;
return 1;
!FRAME_WINDOW_P (f)
/* Don't try to reuse the display if windows have been split
or such. */
- || windows_or_buffers_changed)
+ || windows_or_buffers_changed
+ || cursor_type_changed)
return 0;
/* Can't do this if region may have changed. */
/* Clear the desired matrix for the display below. */
clear_glyph_matrix (w->desired_matrix);
-
+
if (CHARPOS (new_start) <= CHARPOS (start))
{
int first_row_y;
-
+
/* Don't use this method if the display starts with an ellipsis
displayed for invisible text. It's not easy to handle that case
below, and it's certainly not worth the effort since this is
return 0;
IF_DEBUG (debug_method_add (w, "twu1"));
-
+
/* Display up to a row that can be reused. The variable
last_text_row is set to the last row displayed that displays
text. Note that it.vpos == 0 if or if not there is a
first_row_y = it.current_y;
w->cursor.vpos = -1;
last_text_row = last_reused_text_row = NULL;
-
+
while (it.current_y < it.last_visible_y
&& IT_CHARPOS (it) < CHARPOS (start)
&& !fonts_changed_p)
{
/* IT.vpos always starts from 0; it counts text lines. */
nrows_scrolled = it.vpos;
-
+
/* Find PT if not already found in the lines displayed. */
if (w->cursor.vpos < 0)
{
int dy = it.current_y - first_row_y;
-
+
row = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
row = row_containing_pos (w, PT, row, NULL, dy);
if (row)
{
update_begin (f);
rif->update_window_begin_hook (w);
- rif->clear_mouse_face (w);
+ rif->clear_window_mouse_face (w);
rif->scroll_run_hook (w, &run);
rif->update_window_end_hook (w, 0, 0);
update_end (f);
start_vpos,
MATRIX_ROW_VPOS (bottom_row, w->current_matrix),
nrows_scrolled);
-
+
/* Disable lines that must be updated. */
for (i = 0; i < it.vpos; ++i)
(start_row + i)->enabled_p = 0;
/* Re-compute Y positions. */
- min_y = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w);
+ min_y = WINDOW_HEADER_LINE_HEIGHT (w);
max_y = it.last_visible_y;
for (row = start_row + nrows_scrolled;
row < bottom_row;
row->visible_height -= min_y - row->y;
if (row->y + row->height > max_y)
row->visible_height -= row->y + row->height - max_y;
-
+
it.current_y += row->height;
if (MATRIX_ROW_DISPLAYS_TEXT_P (row))
if (MATRIX_ROW_BOTTOM_Y (row) >= it.last_visible_y)
break;
}
-
+
/* Disable lines in the current matrix which are now
below the window. */
for (++row; row < bottom_row; ++row)
else
{
/* This window must be completely empty. */
- w->window_end_bytepos = 0;
- w->window_end_pos = w->window_end_vpos = make_number (0);
+ w->window_end_bytepos = Z_BYTE - ZV_BYTE;
+ w->window_end_pos = make_number (Z - ZV);
+ w->window_end_vpos = make_number (0);
}
w->window_end_valid = Qnil;
/* Update hint: don't try scrolling again in update_window. */
w->desired_matrix->no_scrolling_p = 1;
-
+
#if GLYPH_DEBUG
debug_method_add (w, "try_window_reusing_current_matrix 1");
#endif
it.vpos = (MATRIX_ROW_VPOS (first_row_to_display, w->current_matrix)
- nrows_scrolled);
it.current_y = (first_row_to_display->y - first_reusable_row->y
- + WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w));
+ + WINDOW_HEADER_LINE_HEIGHT (w));
/* Display lines beginning with first_row_to_display in the
desired matrix. Set last_text_row to the last row displayed
/* Scroll the display. */
run.current_y = first_reusable_row->y;
- run.desired_y = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w);
+ run.desired_y = WINDOW_HEADER_LINE_HEIGHT (w);
run.height = it.last_visible_y - run.current_y;
dy = run.current_y - run.desired_y;
-
+
if (run.height)
{
struct frame *f = XFRAME (WINDOW_FRAME (w));
update_begin (f);
rif->update_window_begin_hook (w);
- rif->clear_mouse_face (w);
+ rif->clear_window_mouse_face (w);
rif->scroll_run_hook (w, &run);
rif->update_window_end_hook (w, 0, 0);
update_end (f);
/* Adjust Y positions of reused rows. */
bottom_row = MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w);
- min_y = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w);
+ min_y = WINDOW_HEADER_LINE_HEIGHT (w);
max_y = it.last_visible_y;
for (row = first_reusable_row; row < first_row_to_display; ++row)
{
w->window_end_vpos
= make_number (XFASTINT (w->window_end_vpos) - nrows_scrolled);
}
-
+
w->window_end_valid = Qnil;
w->desired_matrix->no_scrolling_p = 1;
#endif
return 1;
}
-
+
return 0;
}
break;
++row;
}
-
+
return row_found;
}
/* Stop if last visible row. */
if (MATRIX_ROW_BOTTOM_Y (row) >= yb)
break;
-
+
++row;
}
/* Find the first glyph row in the current matrix of W that is not
- affected by changes at the end of current_buffer since the
+ affected by changes at the end of current_buffer since the
time W's current matrix was built.
Return in *DELTA the number of chars by which buffer positions in
unchanged text at the end of current_buffer must be adjusted.
-
+
Return in *DELTA_BYTES the corresponding number of bytes.
Value is null if no such row exists, i.e. all rows are affected by
changes. */
-
+
static struct glyph_row *
find_first_unchanged_at_end_row (w, delta, delta_bytes)
struct window *w;
is not up to date. */
if (NILP (w->window_end_valid))
abort ();
-
+
/* A value of window_end_pos >= END_UNCHANGED means that the window
end is in the range of changed text. If so, there is no
unchanged row at the end of W's current matrix. */
/* Set row to the last row in W's current matrix displaying text. */
row = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos));
-
- /* If matrix is entirely empty, no unchanged row exists. */
+
+ /* If matrix is entirely empty, no unchanged row exists. */
if (MATRIX_ROW_DISPLAYS_TEXT_P (row))
{
/* The value of row is the last glyph row in the matrix having a
position. */
last_unchanged_pos = Z - END_UNCHANGED + BEG;
last_unchanged_pos_old = last_unchanged_pos - *delta;
-
+
/* Search backward from ROW for a row displaying a line that
starts at a minimum position >= last_unchanged_pos_old. */
for (; row > first_text_row; --row)
{
if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
abort ();
-
+
if (MATRIX_ROW_START_CHARPOS (row) >= last_unchanged_pos_old)
row_found = row;
}
if (row_found && !MATRIX_ROW_DISPLAYS_TEXT_P (row_found))
abort ();
-
+
return row_found;
}
/* If W is a full-width window, glyph pointers in W's current matrix
have, by definition, to be the same as glyph pointers in the
- corresponding frame matrix. */
+ corresponding frame matrix. Note that frame matrices have no
+ marginal areas (see build_frame_matrix). */
window_row = w->current_matrix->rows;
window_row_end = window_row + w->current_matrix->nrows;
- frame_row = f->current_matrix->rows + XFASTINT (w->top);
+ frame_row = f->current_matrix->rows + WINDOW_TOP_EDGE_LINE (w);
while (window_row < window_row_end)
{
- int area;
-
- for (area = LEFT_MARGIN_AREA; area <= LAST_AREA; ++area)
- frame_row->glyphs[area] = window_row->glyphs[area];
+ struct glyph *start = window_row->glyphs[LEFT_MARGIN_AREA];
+ struct glyph *end = window_row->glyphs[LAST_AREA];
+
+ frame_row->glyphs[LEFT_MARGIN_AREA] = start;
+ frame_row->glyphs[TEXT_AREA] = start;
+ frame_row->glyphs[RIGHT_MARGIN_AREA] = end;
+ frame_row->glyphs[LAST_AREA] = end;
/* Disable frame rows whose corresponding window rows have
been disabled in try_window_id. */
if (!window_row->enabled_p)
frame_row->enabled_p = 0;
-
+
++window_row, ++frame_row;
}
}
/* If we happen to start on a header-line, skip that. */
if (row->mode_line_p)
++row;
-
+
if ((end && row >= end) || !row->enabled_p)
return NULL;
-
+
last_y = window_text_bottom_y (w) - dy;
-
- while ((end == NULL || row < end)
- && MATRIX_ROW_BOTTOM_Y (row) < last_y
- && (MATRIX_ROW_END_CHARPOS (row) < charpos
+
+ while (1)
+ {
+ /* Give up if we have gone too far. */
+ if (end && row >= end)
+ return NULL;
+ /* This formerly returned if they were equal.
+ I think that both quantities are of a "last plus one" type;
+ if so, when they are equal, the row is within the screen. -- rms. */
+ if (MATRIX_ROW_BOTTOM_Y (row) > last_y)
+ return NULL;
+
+ /* If it is in this row, return this row. */
+ if (! (MATRIX_ROW_END_CHARPOS (row) < charpos
|| (MATRIX_ROW_END_CHARPOS (row) == charpos
/* The end position of a row equals the start
position of the next row. If CHARPOS is there, we
would rather display it in the next line, except
when this line ends in ZV. */
&& !row->ends_at_zv_p
- && !MATRIX_ROW_ENDS_IN_MIDDLE_OF_CHAR_P (row))))
- ++row;
-
- /* Give up if CHARPOS not found. */
- if ((end && row >= end)
- || charpos < MATRIX_ROW_START_CHARPOS (row)
- || charpos > MATRIX_ROW_END_CHARPOS (row))
- row = NULL;
-
- return row;
+ && !MATRIX_ROW_ENDS_IN_MIDDLE_OF_CHAR_P (row)))
+ && charpos >= MATRIX_ROW_START_CHARPOS (row))
+ return row;
+ ++row;
+ }
}
#else
#define GIVE_UP(X) return 0
#endif
-
+
SET_TEXT_POS_FROM_MARKER (start, w->start);
/* Don't use this for mini-windows because these can show
messages and mini-buffers, and we don't handle that here. */
if (MINI_WINDOW_P (w))
GIVE_UP (1);
-
+
/* This flag is used to prevent redisplay optimizations. */
- if (windows_or_buffers_changed)
+ if (windows_or_buffers_changed || cursor_type_changed)
GIVE_UP (2);
-
- /* Verify that narrowing has not changed. This flag is also set to prevent
- redisplay optimizations. It would be nice to further
+
+ /* Verify that narrowing has not changed.
+ Also verify that we were not told to prevent redisplay optimizations.
+ It would be nice to further
reduce the number of cases where this prevents try_window_id. */
- if (current_buffer->clip_changed)
+ if (current_buffer->clip_changed
+ || current_buffer->prevent_redisplay_optimizations_p)
GIVE_UP (3);
/* Window must either use window-based redisplay or be full width. */
/* Another way to prevent redisplay optimizations. */
if (XFASTINT (w->last_modified) == 0)
GIVE_UP (6);
-
+
/* Verify that window is not hscrolled. */
if (XFASTINT (w->hscroll) != 0)
GIVE_UP (7);
-
+
/* Verify that display wasn't paused. */
if (NILP (w->window_end_valid))
GIVE_UP (8);
-
+
/* Can't use this if highlighting a region because a cursor movement
will do more than just set the cursor. */
if (!NILP (Vtransient_mark_mode)
/* Likewise if highlighting trailing whitespace. */
if (!NILP (Vshow_trailing_whitespace))
GIVE_UP (11);
-
+
/* Likewise if showing a region. */
if (!NILP (w->region_showing))
GIVE_UP (10);
-
+
/* Can use this if overlay arrow position and or string have changed. */
if (!EQ (last_arrow_position, COERCE_MARKER (Voverlay_arrow_position))
|| !EQ (last_arrow_string, Voverlay_arrow_string))
GIVE_UP (12);
-
+
/* Make sure beg_unchanged and end_unchanged are up to date. Do it
only if buffer has really changed. The reason is that the gap is
initially at Z for freshly visited files. The code below would
Z_BYTE_old = MATRIX_ROW_END_BYTEPOS (row) + w->window_end_bytepos;
delta = Z - Z_old;
delta_bytes = Z_BYTE - Z_BYTE_old;
-
+
/* Give up if PT is not in the window. Note that it already has
been checked at the start of try_window_id that PT is not in
front of the window start. */
the window end again, since its offset from Z hasn't changed. */
r0 = MATRIX_FIRST_TEXT_ROW (current_matrix);
if (CHARPOS (start) == MATRIX_ROW_START_CHARPOS (r0) + delta
- && BYTEPOS (start) == MATRIX_ROW_START_BYTEPOS (r0) + delta_bytes)
+ && BYTEPOS (start) == MATRIX_ROW_START_BYTEPOS (r0) + delta_bytes
+ /* PT must not be in a partially visible line. */
+ && !(PT >= MATRIX_ROW_START_CHARPOS (row) + delta
+ && MATRIX_ROW_BOTTOM_Y (row) > window_text_bottom_y (w)))
{
/* Adjust positions in the glyph matrix. */
if (delta || delta_bytes)
MATRIX_ROW_VPOS (r1, current_matrix),
delta, delta_bytes);
}
-
+
/* Set the cursor. */
row = row_containing_pos (w, PT, r0, NULL, 0);
- set_cursor_from_row (w, row, current_matrix, 0, 0, 0, 0);
+ if (row)
+ set_cursor_from_row (w, row, current_matrix, 0, 0, 0, 0);
+ else
+ abort ();
return 1;
}
}
as is, without changing glyph positions since no text has
been added/removed in front of the window end. */
r0 = MATRIX_FIRST_TEXT_ROW (current_matrix);
- if (TEXT_POS_EQUAL_P (start, r0->start.pos))
+ if (TEXT_POS_EQUAL_P (start, r0->start.pos)
+ /* PT must not be in a partially visible line. */
+ && !(PT >= MATRIX_ROW_START_CHARPOS (row)
+ && MATRIX_ROW_BOTTOM_Y (row) > window_text_bottom_y (w)))
{
/* We have to compute the window end anew since text
can have been added/removed after it. */
/* Set the cursor. */
row = row_containing_pos (w, PT, r0, NULL, 0);
- set_cursor_from_row (w, row, current_matrix, 0, 0, 0, 0);
+ if (row)
+ set_cursor_from_row (w, row, current_matrix, 0, 0, 0, 0);
+ else
+ abort ();
return 2;
}
}
/* Give up if window start is in the changed area.
-
+
The condition used to read
(BEG_UNCHANGED + END_UNCHANGED != Z - BEG && ...)
if (CHARPOS (start) >= first_changed_charpos
&& CHARPOS (start) <= last_changed_charpos)
GIVE_UP (15);
-
+
/* Check that window start agrees with the start of the first glyph
row in its current matrix. Check this after we know the window
start is not in changed text, otherwise positions would not be
if (init_to_row_end (&it, w, last_unchanged_at_beg_row) == 0)
GIVE_UP (18);
start_pos = it.current.pos;
-
+
/* Start displaying new lines in the desired matrix at the same
vpos we would use in the current matrix, i.e. below
last_unchanged_at_beg_row. */
= find_first_unchanged_at_end_row (w, &delta, &delta_bytes);
IF_DEBUG (debug_delta = delta);
IF_DEBUG (debug_delta_bytes = delta_bytes);
-
+
/* Set stop_pos to the buffer position up to which we will have to
display new lines. If first_unchanged_at_end_row != NULL, this
is the buffer position of the start of the line displayed in that
{
xassert (last_unchanged_at_beg_row == NULL
|| first_unchanged_at_end_row >= last_unchanged_at_beg_row);
-
+
/* If this is a continuation line, move forward to the next one
that isn't. Changes in lines above affect this line.
Caution: this may move first_unchanged_at_end_row to a row
#if GLYPH_DEBUG
-
+
/* Either there is no unchanged row at the end, or the one we have
now displays text. This is a necessary condition for the window
end pos calculation at the end of this function. */
xassert (first_unchanged_at_end_row == NULL
|| MATRIX_ROW_DISPLAYS_TEXT_P (first_unchanged_at_end_row));
-
+
debug_last_unchanged_at_beg_vpos
= (last_unchanged_at_beg_row
? MATRIX_ROW_VPOS (last_unchanged_at_beg_row, current_matrix)
: -1);
debug_first_unchanged_at_end_vpos = first_unchanged_at_end_vpos;
-
+
#endif /* GLYPH_DEBUG != 0 */
-
+
/* Display new lines. Set last_text_row to the last new line
displayed which has text on it, i.e. might end up as being the
line where the window_end_vpos is. */
return -1;
}
}
-
+
/* Don't let the cursor end in the scroll margins. */
{
int this_scroll_margin, cursor_height;
-
+
this_scroll_margin = max (0, scroll_margin);
- this_scroll_margin = min (this_scroll_margin,
- XFASTINT (w->height) / 4);
- this_scroll_margin *= CANON_Y_UNIT (it.f);
+ this_scroll_margin = min (this_scroll_margin, WINDOW_TOTAL_LINES (w) / 4);
+ this_scroll_margin *= FRAME_LINE_HEIGHT (it.f);
cursor_height = MATRIX_ROW (w->desired_matrix, w->cursor.vpos)->height;
-
+
if ((w->cursor.y < this_scroll_margin
&& CHARPOS (start) > BEGV)
/* Don't take scroll margin into account at the bottom because
if (dy && run.height)
{
update_begin (f);
-
+
if (FRAME_WINDOW_P (f))
{
rif->update_window_begin_hook (w);
- rif->clear_mouse_face (w);
+ rif->clear_window_mouse_face (w);
rif->scroll_run_hook (w, &run);
rif->update_window_end_hook (w, 0, 0);
}
lines to scroll by; dvpos < 0 means scroll up. */
int first_unchanged_at_end_vpos
= MATRIX_ROW_VPOS (first_unchanged_at_end_row, w->current_matrix);
- int from = XFASTINT (w->top) + first_unchanged_at_end_vpos;
- int end = (XFASTINT (w->top)
+ int from = WINDOW_TOP_EDGE_LINE (w) + first_unchanged_at_end_vpos;
+ int end = (WINDOW_TOP_EDGE_LINE (w)
+ (WINDOW_WANTS_HEADER_LINE_P (w) ? 1 : 0)
+ window_internal_height (w));
-
+
/* Perform the operation on the screen. */
if (dvpos > 0)
{
if (!scroll_region_ok)
ins_del_lines (end + dvpos, -dvpos);
}
-
+
set_terminal_window (0);
}
-
+
update_end (f);
}
get the right continuation_lines_width and current_x. */
it.continuation_lines_width = last_row->continuation_lines_width;
it.hpos = it.current_x = 0;
-
+
/* Display the rest of the lines at the window end. */
it.glyph_row = MATRIX_ROW (desired_matrix, it.vpos);
while (it.current_y < it.last_visible_y
row = find_last_row_displaying_text (w->current_matrix, &it,
first_unchanged_at_end_row);
xassert (row && MATRIX_ROW_DISPLAYS_TEXT_P (row));
-
+
w->window_end_pos = make_number (Z - MATRIX_ROW_END_CHARPOS (row));
w->window_end_bytepos = Z_BYTE - MATRIX_ROW_END_BYTEPOS (row);
w->window_end_vpos
{
fprintf (stderr, "Row Start End Used oEI><O\\CTZFesm X Y W H V A P\n");
fprintf (stderr, "=======================================================================\n");
-
+
fprintf (stderr, "%3d %5d %5d %4d %1.1d%1.1d%1.1d%1.1d%1.1d\
%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d %4d %4d %4d %4d %4d %4d %4d\n",
vpos,
fprintf (stderr, "%9d %5d\n", row->start.dpvec_index,
row->end.dpvec_index);
}
-
+
if (glyphs > 1)
{
int area;
{
struct glyph *glyph = row->glyphs[area];
struct glyph *glyph_end = glyph + row->used[area];
-
+
/* Glyph for a line end in text. */
if (area == TEXT_AREA && glyph == glyph_end && glyph->charpos > 0)
++glyph_end;
-
+
if (glyph < glyph_end)
fprintf (stderr, " Glyph Type Pos O W Code C Face LR\n");
-
+
for (; glyph < glyph_end; ++glyph)
dump_glyph (row, glyph, area);
}
else
s[i] = '.';
}
-
+
s[i] = '\0';
fprintf (stderr, "%3d: (%d) '%s'\n", vpos, row->enabled_p, s);
}
}
+DEFUN ("dump-frame-glyph-matrix", Fdump_frame_glyph_matrix,
+ Sdump_frame_glyph_matrix, 0, 0, "", doc: /* */)
+ ()
+{
+ struct frame *f = XFRAME (selected_frame);
+ dump_glyph_matrix (f->current_matrix, 1);
+ return Qnil;
+}
+
+
DEFUN ("dump-glyph-row", Fdump_glyph_row, Sdump_glyph_row, 1, 2, "",
doc: /* Dump glyph row ROW to stderr.
GLYPH 0 means don't dump glyphs.
{
struct glyph_matrix *matrix;
int vpos;
-
+
CHECK_NUMBER (row);
matrix = XWINDOW (selected_window)->current_matrix;
vpos = XINT (row);
struct frame *sf = SELECTED_FRAME ();
struct glyph_matrix *m = XWINDOW (sf->tool_bar_window)->current_matrix;
int vpos;
-
+
CHECK_NUMBER (row);
vpos = XINT (row);
if (vpos >= 0 && vpos < m->nrows)
arg = Fprefix_numeric_value (arg);
trace_redisplay_p = XINT (arg) > 0;
}
-
+
return Qnil;
}
DEFUN ("trace-to-stderr", Ftrace_to_stderr, Strace_to_stderr, 1, MANY, "",
- doc: /* Like `format', but print result to stderr. */)
+ doc: /* Like `format', but print result to stderr.
+usage: (trace-to-stderr STRING &rest OBJECTS) */)
(nargs, args)
int nargs;
Lisp_Object *args;
{
Lisp_Object s = Fformat (nargs, args);
- fprintf (stderr, "%s", XSTRING (s)->data);
+ fprintf (stderr, "%s", SDATA (s));
return Qnil;
}
-
+
#endif /* GLYPH_DEBUG */
struct frame *f = XFRAME (WINDOW_FRAME (w));
struct buffer *buffer = XBUFFER (w->buffer);
struct buffer *old = current_buffer;
- unsigned char *arrow_string = XSTRING (Voverlay_arrow_string)->data;
- int arrow_len = XSTRING (Voverlay_arrow_string)->size;
- unsigned char *arrow_end = arrow_string + arrow_len;
- unsigned char *p;
+ const unsigned char *arrow_string = SDATA (Voverlay_arrow_string);
+ int arrow_len = SCHARS (Voverlay_arrow_string);
+ const unsigned char *arrow_end = arrow_string + arrow_len;
+ const unsigned char *p;
struct it it;
int multibyte_p;
int n_glyphs_before;
while (p < arrow_end)
{
Lisp_Object face, ilisp;
-
+
/* Get the next character. */
if (multibyte_p)
it.c = string_char_and_length (p, arrow_len, &it.len);
else
it.c = *p, it.len = 1;
p += it.len;
-
+
/* Get its face. */
ilisp = make_number (p - arrow_string);
face = Fget_text_property (ilisp, Qface, Voverlay_arrow_string);
break;
}
}
-
+
set_buffer_temp (old);
return it.glyph_row;
}
CHARPOS (truncate_it.position) = BYTEPOS (truncate_it.position) = -1;
truncate_it.object = make_number (0);
produce_special_glyphs (&truncate_it, IT_TRUNCATION);
-
+
/* Overwrite glyphs from IT with truncation glyphs. */
from = truncate_it.glyph_row->glyphs[TEXT_AREA];
end = from + truncate_it.glyph_row->used[TEXT_AREA];
if (row->height == 0)
{
if (it->max_ascent + it->max_descent == 0)
- it->max_descent = it->max_phys_descent = CANON_Y_UNIT (it->f);
+ it->max_descent = it->max_phys_descent = FRAME_LINE_HEIGHT (it->f);
row->ascent = it->max_ascent;
row->height = it->max_ascent + it->max_descent;
row->phys_ascent = it->max_phys_ascent;
row->phys_height = it->max_phys_ascent + it->max_phys_descent;
}
-
+
/* Compute the width of this line. */
row->pixel_width = row->x;
for (i = 0; i < row->used[TEXT_AREA]; ++i)
/* Compute how much of the line is visible. */
row->visible_height = row->height;
-
- min_y = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (it->w);
- max_y = WINDOW_DISPLAY_HEIGHT_NO_MODE_LINE (it->w);
+
+ min_y = WINDOW_HEADER_LINE_HEIGHT (it->w);
+ max_y = WINDOW_BOX_HEIGHT_NO_MODE_LINE (it->w);
if (row->y < min_y)
row->visible_height -= min_y - row->y;
saved_object = it->object;
saved_pos = it->position;
-
+
it->what = IT_CHARACTER;
bzero (&it->position, sizeof it->position);
it->object = make_number (0);
it->face_id = FACE_FOR_CHAR (it->f, face, 0);
PRODUCE_GLYPHS (it);
-
+
it->current_x = saved_x;
it->object = saved_object;
it->position = saved_pos;
to the end of the display line. Called from display_line.
If the glyph row is empty, add a space glyph to it so that we
know the face to draw. Set the glyph row flag fill_line_p. */
-
+
static void
extend_face_to_end_of_line (it)
struct it *it;
/* If line is already filled, do nothing. */
if (it->current_x >= it->last_visible_x)
return;
-
+
/* Face extension extends the background and box of IT->face_id
to the end of the line. If the background equals the background
of the frame, we don't have to do anything. */
face = FACE_FROM_ID (it->f, it->saved_face_id);
else
face = FACE_FROM_ID (f, it->face_id);
-
+
if (FRAME_WINDOW_P (f)
&& face->box == FACE_NO_BOX
&& face->background == FRAME_BACKGROUND_PIXEL (f)
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);
}
saved_object = it->object;
saved_pos = it->position;
-
+
it->what = IT_CHARACTER;
bzero (&it->position, sizeof it->position);
it->object = make_number (0);
it->c = ' ';
it->len = 1;
it->face_id = face->id;
-
+
PRODUCE_GLYPHS (it);
-
+
while (it->current_x <= it->last_visible_x)
PRODUCE_GLYPHS (it);
-
+
/* Don't count these blanks really. It would let us insert a left
truncation glyph below and make us set the cursor on them, maybe. */
it->current_x = saved_x;
struct glyph_row *row;
{
int used = row->used[TEXT_AREA];
-
+
if (used)
{
struct glyph *start = row->glyphs[TEXT_AREA];
&& glyph->u.ch == ' '))
&& trailing_whitespace_p (glyph->charpos))
{
- int face_id = lookup_named_face (f, Qtrailing_whitespace, 0);
+ int face_id = lookup_named_face (f, Qtrailing_whitespace);
-
+
while (glyph >= start
&& BUFFERP (glyph->object)
&& (glyph->type == STRETCH_GLYPH
struct glyph_row *row;
{
int cursor_row_p = 1;
-
+
if (PT == MATRIX_ROW_END_CHARPOS (row))
{
/* If the row ends with a newline from a string, we don't want
for an overview of struct it. Value is non-zero if
IT->glyph_row displays text, as opposed to a line displaying ZV
only. */
-
+
static int
display_line (it)
struct it *it;
|| (minibuf_level && EQ (it->window, minibuf_window))))
row->indicate_empty_line_p = 1;
}
-
+
it->continuation_lines_width = 0;
row->ends_at_zv_p = 1;
break;
phys_ascent = it->max_phys_ascent;
phys_descent = it->max_phys_descent;
}
-
+
PRODUCE_GLYPHS (it);
/* If this display element was in marginal areas, continue with
{
int new_x;
struct glyph *glyph;
-
+
for (i = 0; i < nglyphs; ++i, x = new_x)
{
glyph = row->glyphs[TEXT_AREA] + n_glyphs_before + i;
&& FRAME_WINDOW_P (it->f))))
{
/* End of a continued line. */
-
+
if (it->hpos == 0
|| (new_x == it->last_visible_x
&& FRAME_WINDOW_P (it->f)))
This means the whole character doesn't fit
on the line. */
row->used[TEXT_AREA] = n_glyphs_before;
-
+
/* Fill the rest of the row with continuation
glyphs like in 20.x. */
while (row->glyphs[TEXT_AREA] + row->used[TEXT_AREA]
< row->glyphs[1 + TEXT_AREA])
produce_special_glyphs (it, IT_CONTINUATION);
-
+
row->continued_p = 1;
it->current_x = x_before;
it->continuation_lines_width += x_before;
-
+
/* Restore the height to what it was before the
element not fitting on the line. */
it->max_ascent = ascent;
the right edge of the window. Restore
positions to values before the element. */
row->used[TEXT_AREA] = n_glyphs_before + i;
-
+
/* Display continuation glyphs. */
if (!FRAME_WINDOW_P (it->f))
produce_special_glyphs (it, IT_CONTINUATION);
row->continued_p = 1;
it->continuation_lines_width += x;
-
+
if (nglyphs > 1 && i > 0)
{
row->ends_in_middle_of_char_p = 1;
it->starts_in_middle_of_char_p = 1;
}
-
+
/* Restore the height to what it was before the
element not fitting on the line. */
it->max_ascent = ascent;
{
/* Increment number of glyphs actually displayed. */
++it->hpos;
-
+
if (x < it->first_visible_x)
/* Glyph is partially visible, i.e. row starts at
negative X position. */
{
/* Glyph is completely off the left margin of the
window. This should not happen because of the
- move_it_in_display_line at the start of
- this function. */
- abort ();
+ move_it_in_display_line at the start of this
+ function, unless the text display area of the
+ window is empty. */
+ xassert (it->first_visible_x <= it->last_visible_x);
}
}
-
+
row->ascent = max (row->ascent, it->max_ascent);
row->height = max (row->height, it->max_ascent + it->max_descent);
row->phys_ascent = max (row->phys_ascent, it->max_phys_ascent);
row->phys_height = max (row->phys_height,
it->max_phys_ascent + it->max_phys_descent);
-
+
/* End of this display line if row is continued. */
if (row->continued_p)
break;
/* Add a space at the end of the line that is used to
display the cursor there. */
append_space (it, 0);
-
+
/* Extend the face to the end of the line. */
extend_face_to_end_of_line (it);
/* Make sure we have the position. */
if (used_before == 0)
row->glyphs[TEXT_AREA]->charpos = CHARPOS (it->position);
-
+
/* Consume the line end. This skips over invisible lines. */
set_iterator_to_next (it, 1);
it->continuation_lines_width = 0;
break;
}
- /* Proceed with next display element. Note that this skips
+ /* Proceed with next display element. Note that this skips
over lines invisible because of selective display. */
set_iterator_to_next (it, 1);
if (!FRAME_WINDOW_P (it->f))
{
int i, n;
-
+
for (i = row->used[TEXT_AREA] - 1; i > 0; --i)
if (!CHAR_GLYPH_PADDING_P (row->glyphs[TEXT_AREA][i]))
break;
produce_special_glyphs (it, IT_TRUNCATION);
}
}
-
+
row->truncated_on_right_p = 1;
it->continuation_lines_width = 0;
reseat_at_next_visible_line_start (it, 0);
row->used[TEXT_AREA] = p2 - row->glyphs[TEXT_AREA];
}
}
-
+
overlay_arrow_seen = 1;
row->overlay_arrow_p = 1;
}
The menu bar of X frames that don't have X toolkit support is
displayed in a special window W->frame->menu_bar_window.
-
+
The menu bar of terminal frames is treated specially as far as
glyph matrices are concerned. Menu bar lines are not part of
windows, so the update is done directly on the frame matrix rows
if (!NILP (Vwindow_system))
return;
#endif
-#ifdef USE_X_TOOLKIT
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
if (FRAME_X_P (f))
return;
#endif
-#ifdef macintosh
+#ifdef MAC_OS
if (FRAME_MAC_P (f))
return;
#endif
xassert (!FRAME_WINDOW_P (f));
init_iterator (&it, w, -1, -1, f->desired_matrix->rows, MENU_FACE_ID);
it.first_visible_x = 0;
- it.last_visible_x = FRAME_WINDOW_WIDTH (f) * CANON_X_UNIT (f);
+ it.last_visible_x = FRAME_TOTAL_COLS (f) * FRAME_COLUMN_WIDTH (f);
#else /* not USE_X_TOOLKIT */
if (FRAME_WINDOW_P (f))
{
init_iterator (&it, menu_w, -1, -1, menu_w->desired_matrix->rows,
MENU_FACE_ID);
it.first_visible_x = 0;
- it.last_visible_x = FRAME_WINDOW_WIDTH (f) * CANON_X_UNIT (f);
+ it.last_visible_x = FRAME_TOTAL_COLS (f) * FRAME_COLUMN_WIDTH (f);
}
else
{
init_iterator (&it, w, -1, -1, f->desired_matrix->rows,
MENU_FACE_ID);
it.first_visible_x = 0;
- it.last_visible_x = FRAME_WIDTH (f);
+ it.last_visible_x = FRAME_COLS (f);
}
#endif /* not USE_X_TOOLKIT */
/* Display the item, pad with one space. */
if (it.current_x < it.last_visible_x)
display_string (NULL, string, Qnil, 0, 0, &it,
- XSTRING (string)->size + 1, 0, 0, -1);
+ SCHARS (string) + 1, 0, 0, -1);
}
/* Fill out the line with spaces. */
int force;
{
int nwindows = 0;
-
+
while (!NILP (window))
{
struct window *w = XWINDOW (window);
-
+
if (WINDOWP (w->hchild))
nwindows += redisplay_mode_lines (w->hchild, force);
else if (WINDOWP (w->vchild))
/* Set the window's buffer for the mode line display. */
SET_TEXT_POS (lpoint, PT, PT_BYTE);
set_buffer_internal_1 (XBUFFER (w->buffer));
-
+
/* Point refers normally to the selected window. For any
other window, set up appropriate value. */
if (!EQ (window, selected_window))
{
struct text_pos pt;
-
+
SET_TEXT_POS_FROM_MARKER (pt, w->pointm);
if (CHARPOS (pt) < BEGV)
TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
selected_frame = w->frame;
old_selected_window = selected_window;
XSETWINDOW (selected_window, w);
-
+
/* These will be set while the mode line specs are processed. */
line_number_displayed = 0;
w->column_number_displayed = Qnil;
current_buffer->mode_line_format);
++n;
}
-
+
if (WINDOW_WANTS_HEADER_LINE_P (w))
{
display_mode_line (w, HEADER_LINE_FACE_ID,
kboard-local variables in the mode_line_format will get the right
values. */
push_frame_kboard (it.f);
- display_mode_element (&it, 0, 0, 0, format, Qnil);
+ display_mode_element (&it, 0, 0, 0, format, Qnil, 0);
pop_frame_kboard ();
/* Fill up with spaces. */
display_string (" ", Qnil, Qnil, 0, 0, &it, 10000, -1, -1, 0);
-
+
compute_line_metrics (&it);
it.glyph_row->full_width_p = 1;
it.glyph_row->mode_line_p = 1;
Each element is (PROPERTIZED-STRING . PROPERTY-LIST). */
Lisp_Object mode_line_proptrans_alist;
+/* List of strings making up the mode-line. */
+Lisp_Object mode_line_string_list;
+
+/* Base face property when building propertized mode line string. */
+static Lisp_Object mode_line_string_face;
+static Lisp_Object mode_line_string_face_prop;
+
+
/* Contribute ELT to the mode line for window IT->w. How it
translates into text depends on its data type.
characters to display from ELT's representation. See
display_string for details.
- Returns the hpos of the end of the text generated by ELT. */
+ Returns the hpos of the end of the text generated by ELT.
+
+ PROPS is a property list to add to any string we encounter.
+
+ If RISKY is nonzero, remove (disregard) any properties in any string
+ we encounter, and ignore :eval and :propertize.
+
+ If the global variable `frame_title_ptr' is non-NULL, then the output
+ is passed to `store_frame_title' instead of `display_string'. */
static int
-display_mode_element (it, depth, field_width, precision, elt, props)
+display_mode_element (it, depth, field_width, precision, elt, props, risky)
struct it *it;
int depth;
int field_width, precision;
Lisp_Object elt, props;
+ int risky;
{
int n = 0, field, prec;
int literal = 0;
tail_recurse:
- if (depth > 10)
- goto invalid;
+ if (depth > 100)
+ elt = build_string ("*too-deep*");
depth++;
{
/* A string: output it and check for %-constructs within it. */
unsigned char c;
- unsigned char *this = XSTRING (elt)->data;
- unsigned char *lisp_string = this;
+ const unsigned char *this, *lisp_string;
- if (!NILP (props))
+ if (!NILP (props) || risky)
{
Lisp_Object oprops, aelt;
oprops = Ftext_properties_at (make_number (0), elt);
- if (NILP (Fequal (props, oprops)))
+
+ if (NILP (Fequal (props, oprops)) || risky)
{
+ /* If the starting string has properties,
+ merge the specified ones onto the existing ones. */
+ if (! NILP (oprops) && !risky)
+ {
+ Lisp_Object tem;
+
+ oprops = Fcopy_sequence (oprops);
+ tem = props;
+ while (CONSP (tem))
+ {
+ oprops = Fplist_put (oprops, XCAR (tem),
+ XCAR (XCDR (tem)));
+ tem = XCDR (XCDR (tem));
+ }
+ props = oprops;
+ }
+
aelt = Fassoc (elt, mode_line_proptrans_alist);
if (! NILP (aelt) && !NILP (Fequal (props, XCDR (aelt))))
- elt = XCAR (aelt);
+ {
+ mode_line_proptrans_alist
+ = Fcons (aelt, Fdelq (aelt, mode_line_proptrans_alist));
+ elt = XCAR (aelt);
+ }
else
{
+ Lisp_Object tem;
+
elt = Fcopy_sequence (elt);
Fset_text_properties (make_number (0), Flength (elt),
props, elt);
+ /* Add this item to mode_line_proptrans_alist. */
mode_line_proptrans_alist
= Fcons (Fcons (elt, props),
mode_line_proptrans_alist);
+ /* Truncate mode_line_proptrans_alist
+ to at most 50 elements. */
+ tem = Fnthcdr (make_number (50),
+ mode_line_proptrans_alist);
+ if (! NILP (tem))
+ XSETCDR (tem, Qnil);
}
}
- this = XSTRING (elt)->data;
- lisp_string = this;
}
+ this = SDATA (elt);
+ lisp_string = this;
+
if (literal)
{
prec = precision - n;
if (frame_title_ptr)
- n += store_frame_title (XSTRING (elt)->data, -1, prec);
+ n += store_frame_title (SDATA (elt), -1, prec);
+ else if (!NILP (mode_line_string_list))
+ n += store_mode_line_string (NULL, elt, 1, 0, prec, Qnil);
else
n += display_string (NULL, elt, Qnil, 0, 0, it,
0, prec, 0, STRING_MULTIBYTE (elt));
while ((precision <= 0 || n < precision)
&& *this
&& (frame_title_ptr
+ || !NILP (mode_line_string_list)
|| it->current_x < it->last_visible_x))
{
- unsigned char *last = this;
+ const unsigned char *last = this;
/* Advance to end of string or next format specifier. */
while ((c = *this++) != '\0' && c != '%')
;
-
+
if (this - 1 != last)
{
/* Output to end of string or up to '%'. Field width
prec = chars_in_text (last, this - last);
if (precision > 0 && prec > precision - n)
prec = precision - n;
-
+
if (frame_title_ptr)
n += store_frame_title (last, 0, prec);
+ else if (!NILP (mode_line_string_list))
+ {
+ int bytepos = last - lisp_string;
+ int charpos = string_byte_to_char (elt, bytepos);
+ n += store_mode_line_string (NULL,
+ Fsubstring (elt, make_number (charpos),
+ make_number (charpos + prec)),
+ 0, 0, 0, Qnil);
+ }
else
{
int bytepos = last - lisp_string;
}
else /* c == '%' */
{
- unsigned char *percent_position = this;
-
+ const unsigned char *percent_position = this;
+
/* Get the specified minimum width. Zero means
don't pad. */
field = 0;
/* Note that either PRECISION <= 0 or N < PRECISION. */
prec = precision - n;
-
+
if (c == 'M')
n += display_mode_element (it, depth, field, prec,
- Vglobal_mode_string, props);
+ Vglobal_mode_string, props,
+ risky);
else if (c != 0)
{
int multibyte;
- unsigned char *spec
+ int bytepos, charpos;
+ unsigned char *spec;
+
+ bytepos = percent_position - lisp_string;
+ charpos = (STRING_MULTIBYTE (elt)
+ ? string_byte_to_char (elt, bytepos)
+ : bytepos);
+
+ spec
= decode_mode_spec (it->w, c, field, prec, &multibyte);
if (frame_title_ptr)
n += store_frame_title (spec, field, prec);
+ else if (!NILP (mode_line_string_list))
+ {
+ int len = strlen (spec);
+ Lisp_Object tem = make_string (spec, len);
+ props = Ftext_properties_at (make_number (charpos), elt);
+ /* Should only keep face property in props */
+ n += store_mode_line_string (NULL, tem, 0, field, prec, props);
+ }
else
{
- int nglyphs_before, bytepos, charpos, nwritten;
-
+ int nglyphs_before, nwritten;
+
nglyphs_before = it->glyph_row->used[TEXT_AREA];
- bytepos = percent_position - lisp_string;
- charpos = (STRING_MULTIBYTE (elt)
- ? string_byte_to_char (elt, bytepos)
- : bytepos);
nwritten = display_string (spec, Qnil, elt,
charpos, 0, it,
field, prec, 0,
glyph[i].object = elt;
glyph[i].charpos = charpos;
}
-
+
n += nwritten;
}
}
literally. */
{
register Lisp_Object tem;
+
+ /* If the variable is not marked as risky to set
+ then its contents are risky to use. */
+ if (NILP (Fget (elt, Qrisky_local_variable)))
+ risky = 1;
+
tem = Fboundp (elt);
if (!NILP (tem))
{
/* An element of the form (:eval FORM) means evaluate FORM
and use the result as mode line elements. */
+ if (risky)
+ break;
+
if (CONSP (XCDR (elt)))
{
Lisp_Object spec;
spec = safe_eval (XCAR (XCDR (elt)));
n += display_mode_element (it, depth, field_width - n,
- precision - n, spec, props);
+ precision - n, spec, props,
+ risky);
}
}
else if (EQ (car, QCpropertize))
{
+ /* An element of the form (:propertize ELT PROPS...)
+ means display ELT but applying properties PROPS. */
+
+ if (risky)
+ break;
+
if (CONSP (XCDR (elt)))
- {
- /* An element of the form (:propertize ELT PROPS...)
- means display ELT but applying properties PROPS. */
- n += display_mode_element (it, depth, field_width - n,
- precision - n, XCAR (XCDR (elt)),
- XCDR (XCDR (elt)));
- }
+ n += display_mode_element (it, depth, field_width - n,
+ precision - n, XCAR (XCDR (elt)),
+ XCDR (XCDR (elt)), risky);
}
else if (SYMBOLP (car))
{
&& (precision <= 0 || n < precision))
{
n += display_mode_element (it, depth, field_width - n,
- precision - n, XCAR (elt), props);
+ precision - n, XCAR (elt),
+ props, risky);
elt = XCDR (elt);
}
}
default:
invalid:
- if (frame_title_ptr)
- n += store_frame_title ("*invalid*", 0, precision - n);
- else
- n += display_string ("*invalid*", Qnil, Qnil, 0, 0, it, 0,
- precision - n, 0, 0);
- return n;
+ elt = build_string ("*invalid*");
+ goto tail_recurse;
}
/* Pad to FIELD_WIDTH. */
{
if (frame_title_ptr)
n += store_frame_title ("", field_width - n, 0);
+ else if (!NILP (mode_line_string_list))
+ n += store_mode_line_string ("", Qnil, 0, field_width - n, 0, Qnil);
else
n += display_string ("", Qnil, Qnil, 0, 0, it, field_width - n,
0, 0, 0);
}
-
+
+ return n;
+}
+
+/* Store a mode-line string element in mode_line_string_list.
+
+ If STRING is non-null, display that C string. Otherwise, the Lisp
+ string LISP_STRING is displayed.
+
+ FIELD_WIDTH is the minimum number of output glyphs to produce.
+ If STRING has fewer characters than FIELD_WIDTH, pad to the right
+ with spaces. FIELD_WIDTH <= 0 means don't pad.
+
+ PRECISION is the maximum number of characters to output from
+ STRING. PRECISION <= 0 means don't truncate the string.
+
+ If COPY_STRING is non-zero, make a copy of LISP_STRING before adding
+ properties to the string.
+
+ PROPS are the properties to add to the string.
+ The mode_line_string_face face property is always added to the string.
+ */
+
+static int store_mode_line_string (string, lisp_string, copy_string, field_width, precision, props)
+ char *string;
+ Lisp_Object lisp_string;
+ int copy_string;
+ int field_width;
+ int precision;
+ Lisp_Object props;
+{
+ int len;
+ int n = 0;
+
+ if (string != NULL)
+ {
+ len = strlen (string);
+ if (precision > 0 && len > precision)
+ len = precision;
+ lisp_string = make_string (string, len);
+ if (NILP (props))
+ props = mode_line_string_face_prop;
+ else if (!NILP (mode_line_string_face))
+ {
+ Lisp_Object face = Fplist_get (props, Qface);
+ props = Fcopy_sequence (props);
+ if (NILP (face))
+ face = mode_line_string_face;
+ else
+ face = Fcons (face, Fcons (mode_line_string_face, Qnil));
+ props = Fplist_put (props, Qface, face);
+ }
+ Fadd_text_properties (make_number (0), make_number (len),
+ props, lisp_string);
+ }
+ else
+ {
+ len = XFASTINT (Flength (lisp_string));
+ if (precision > 0 && len > precision)
+ {
+ len = precision;
+ lisp_string = Fsubstring (lisp_string, make_number (0), make_number (len));
+ precision = -1;
+ }
+ if (!NILP (mode_line_string_face))
+ {
+ Lisp_Object face;
+ if (NILP (props))
+ props = Ftext_properties_at (make_number (0), lisp_string);
+ face = Fplist_get (props, Qface);
+ if (NILP (face))
+ face = mode_line_string_face;
+ else
+ face = Fcons (face, Fcons (mode_line_string_face, Qnil));
+ props = Fcons (Qface, Fcons (face, Qnil));
+ if (copy_string)
+ lisp_string = Fcopy_sequence (lisp_string);
+ }
+ if (!NILP (props))
+ Fadd_text_properties (make_number (0), make_number (len),
+ props, lisp_string);
+ }
+
+ if (len > 0)
+ {
+ mode_line_string_list = Fcons (lisp_string, mode_line_string_list);
+ n += len;
+ }
+
+ if (field_width > len)
+ {
+ field_width -= len;
+ lisp_string = Fmake_string (make_number (field_width), make_number (' '));
+ if (!NILP (props))
+ Fadd_text_properties (make_number (0), make_number (field_width),
+ props, lisp_string);
+ mode_line_string_list = Fcons (lisp_string, mode_line_string_list);
+ n += field_width;
+ }
+
return n;
}
+DEFUN ("format-mode-line", Fformat_mode_line, Sformat_mode_line,
+ 0, 3, 0,
+ doc: /* Return the mode-line of selected window as a string.
+First optional arg FORMAT specifies a different format string (see
+`mode-line-format' for details) to use. If FORMAT is t, return
+the buffer's header-line. Second optional arg WINDOW specifies a
+different window to use as the context for the formatting.
+If third optional arg NO-PROPS is non-nil, string is not propertized. */)
+ (format, window, no_props)
+ Lisp_Object format, window, no_props;
+{
+ struct it it;
+ int len;
+ struct window *w;
+ struct buffer *old_buffer = NULL;
+ enum face_id face_id = DEFAULT_FACE_ID;
+
+ if (NILP (window))
+ window = selected_window;
+ CHECK_WINDOW (window);
+ w = XWINDOW (window);
+ CHECK_BUFFER (w->buffer);
+
+ if (XBUFFER (w->buffer) != current_buffer)
+ {
+ old_buffer = current_buffer;
+ set_buffer_internal_1 (XBUFFER (w->buffer));
+ }
+
+ if (NILP (format) || EQ (format, Qt))
+ {
+ face_id = NILP (format)
+ ? CURRENT_MODE_LINE_FACE_ID (w) :
+ HEADER_LINE_FACE_ID;
+ format = NILP (format)
+ ? current_buffer->mode_line_format
+ : current_buffer->header_line_format;
+ }
+
+ init_iterator (&it, w, -1, -1, NULL, face_id);
+
+ if (NILP (no_props))
+ {
+ mode_line_string_face =
+ (face_id == MODE_LINE_FACE_ID ? Qmode_line :
+ face_id == MODE_LINE_INACTIVE_FACE_ID ? Qmode_line_inactive :
+ face_id == HEADER_LINE_FACE_ID ? Qheader_line : Qnil);
+
+ mode_line_string_face_prop =
+ NILP (mode_line_string_face) ? Qnil :
+ Fcons (Qface, Fcons (mode_line_string_face, Qnil));
+
+ /* We need a dummy last element in mode_line_string_list to
+ indicate we are building the propertized mode-line string.
+ Using mode_line_string_face_prop here GC protects it. */
+ mode_line_string_list =
+ Fcons (mode_line_string_face_prop, Qnil);
+ frame_title_ptr = NULL;
+ }
+ else
+ {
+ mode_line_string_face_prop = Qnil;
+ mode_line_string_list = Qnil;
+ frame_title_ptr = frame_title_buf;
+ }
+
+ push_frame_kboard (it.f);
+ display_mode_element (&it, 0, 0, 0, format, Qnil, 0);
+ pop_frame_kboard ();
+
+ if (old_buffer)
+ set_buffer_internal_1 (old_buffer);
+
+ if (NILP (no_props))
+ {
+ Lisp_Object str;
+ mode_line_string_list = Fnreverse (mode_line_string_list);
+ str = Fmapconcat (intern ("identity"), XCDR (mode_line_string_list),
+ make_string ("", 0));
+ mode_line_string_face_prop = Qnil;
+ mode_line_string_list = Qnil;
+ return str;
+ }
+
+ len = frame_title_ptr - frame_title_buf;
+ if (len > 0 && frame_title_ptr[-1] == '-')
+ {
+ /* Mode lines typically ends with numerous dashes; reduce to two dashes. */
+ while (frame_title_ptr > frame_title_buf && *--frame_title_ptr == '-')
+ ;
+ frame_title_ptr += 3; /* restore last non-dash + two dashes */
+ if (len > frame_title_ptr - frame_title_buf)
+ len = frame_title_ptr - frame_title_buf;
+ }
+
+ frame_title_ptr = NULL;
+ return make_string (frame_title_buf, len);
+}
+
/* Write a null-terminated, right justified decimal representation of
the positive integer D to BUF using a minimal field width WIDTH. */
register int d;
{
register char *p = buf;
-
+
if (d <= 0)
*p++ = '0';
else
d /= 10;
}
}
-
+
for (width -= (int) (p - buf); width > 0; --width)
*p++ = ' ';
*p-- = '\0';
{
Lisp_Object val;
int multibyte = !NILP (current_buffer->enable_multibyte_characters);
- unsigned char *eol_str;
+ const unsigned char *eol_str;
int eol_str_len;
/* 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));
}
}
-
+
if (eol_flag)
{
/* Mention the EOL conversion if it is not the usual one. */
if (STRINGP (eoltype))
{
- eol_str = XSTRING (eoltype)->data;
- eol_str_len = XSTRING (eoltype)->size;
+ eol_str = SDATA (eoltype);
+ eol_str_len = SBYTES (eoltype);
}
- else if (INTEGERP (eoltype)
- && CHAR_VALID_P (XINT (eoltype), 0))
+ else if (CHARACTERP (eoltype))
{
- eol_str = (unsigned char *) alloca (MAX_MULTIBYTE_LENGTH);
- eol_str_len = CHAR_STRING (XINT (eoltype), eol_str);
+ unsigned char *tmp = (unsigned char *) alloca (MAX_MULTIBYTE_LENGTH);
+ eol_str_len = CHAR_STRING (XINT (eoltype), tmp);
+ eol_str = tmp;
}
else
{
case '%':
return "%";
- case '[':
+ case '[':
{
int i;
char *p;
return decode_mode_spec_buf;
}
- case ']':
+ case ']':
{
int i;
char *p;
register int i;
/* Let lots_of_dashes be a string of infinite length. */
+ if (!NILP (mode_line_string_list))
+ return "--";
if (field_width <= 0
|| field_width > sizeof (lots_of_dashes))
{
return lots_of_dashes;
}
- case 'b':
+ case 'b':
obj = b->name;
break;
case 'c':
{
- int col = current_column ();
+ int col = (int) current_column (); /* iftc */
w->column_number_displayed = make_number (col);
pint2str (decode_mode_spec_buf, field_width, col);
return decode_mode_spec_buf;
case 'F':
/* %F displays the frame name. */
if (!NILP (f->title))
- return (char *) XSTRING (f->title)->data;
+ return (char *) SDATA (f->title);
if (f->explicit_name || ! FRAME_WINDOW_P (f))
- return (char *) XSTRING (f->name)->data;
+ return (char *) SDATA (f->name);
return "Emacs";
- case 'f':
+ case 'f':
obj = b->filename;
break;
int startpos_byte = marker_byte_position (w->start);
int line, linepos, linepos_byte, topline;
int nlines, junk;
- int height = XFASTINT (w->height);
+ int height = WINDOW_TOTAL_LINES (w);
- /* If we decided that this buffer isn't suitable for line numbers,
+ /* If we decided that this buffer isn't suitable for line numbers,
don't forget that too fast. */
if (EQ (w->base_line_pos, w->buffer))
goto no_value;
limit_byte,
- (height * 2 + 30),
&position);
- /* If we couldn't find the lines we wanted within
+ /* If we couldn't find the lines we wanted within
line_number_display_limit_width chars per line,
give up on line numbers for this window. */
if (position == limit_byte && limit == startpos - distance)
}
break;
- case 'm':
+ case 'm':
obj = b->mode_name;
break;
{
/* No need to mention EOL here--the terminal never needs
to do EOL conversion. */
- p = decode_mode_spec_coding (keyboard_coding.symbol, p, 0);
- p = decode_mode_spec_coding (terminal_coding.symbol, p, 0);
+ p = decode_mode_spec_coding (CODING_ID_NAME (keyboard_coding.id),
+ p, 0);
+ p = decode_mode_spec_coding (CODING_ID_NAME (terminal_coding.id),
+ p, 0);
}
p = decode_mode_spec_coding (b->buffer_file_coding_system,
p, eol_flag);
if (STRINGP (obj))
{
*multibyte = STRING_MULTIBYTE (obj);
- return (char *) XSTRING (obj)->data;
+ return (char *) SDATA (obj);
}
else
return "";
If STRING has fewer characters than FIELD_WIDTH, pad to the right
with spaces. If STRING has more characters, more than FIELD_WIDTH
glyphs will be produced. FIELD_WIDTH <= 0 means don't pad.
-
+
PRECISION is the maximum number of characters to output from
STRING. PRECISION < 0 means don't truncate the string.
{
int endptr;
struct face *face;
-
+
it->face_id
= face_at_string_position (it->w, face_string, face_string_pos,
0, it->region_beg_charpos,
while (i < nglyphs)
{
struct glyph *glyph = row->glyphs[TEXT_AREA] + n_glyphs_before + i;
-
+
if (!it->truncate_lines_p
&& x + glyph->pixel_width > max_x)
{
}
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;
}
it->face_id = saved_face_id;
-
+
/* Value is number of columns displayed. */
return it->hpos - hpos_at_start;
}
Lisp_Object list;
{
register Lisp_Object tail, proptail;
-
+
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
register Lisp_Object tem;
if (CONSP (tem) && EQ (propval, XCAR (tem)))
return NILP (XCDR (tem)) ? 1 : 2;
}
-
+
if (CONSP (propval))
{
for (proptail = propval; CONSP (proptail); proptail = XCDR (proptail))
}
}
}
-
+
return 0;
}
\f
/***********************************************************************
- Initialization
+ Glyph Display
***********************************************************************/
+#ifdef HAVE_WINDOW_SYSTEM
+
+#if GLYPH_DEBUG
+
void
-syms_of_xdisp ()
+dump_glyph_string (s)
+ struct glyph_string *s;
{
- Vwith_echo_area_save_vector = Qnil;
- staticpro (&Vwith_echo_area_save_vector);
+ fprintf (stderr, "glyph string\n");
+ fprintf (stderr, " x, y, w, h = %d, %d, %d, %d\n",
+ s->x, s->y, s->width, s->height);
+ fprintf (stderr, " ybase = %d\n", s->ybase);
+ fprintf (stderr, " hl = %d\n", s->hl);
+ fprintf (stderr, " left overhang = %d, right = %d\n",
+ s->left_overhang, s->right_overhang);
+ fprintf (stderr, " nchars = %d\n", s->nchars);
+ fprintf (stderr, " extends to end of line = %d\n",
+ s->extends_to_end_of_line_p);
+ fprintf (stderr, " font height = %d\n", FONT_HEIGHT (s->font));
+ fprintf (stderr, " bg width = %d\n", s->background_width);
+}
- Vmessage_stack = Qnil;
- staticpro (&Vmessage_stack);
-
- Qinhibit_redisplay = intern ("inhibit-redisplay");
- staticpro (&Qinhibit_redisplay);
+#endif /* GLYPH_DEBUG */
- message_dolog_marker1 = Fmake_marker ();
- staticpro (&message_dolog_marker1);
- message_dolog_marker2 = Fmake_marker ();
- staticpro (&message_dolog_marker2);
- message_dolog_marker3 = Fmake_marker ();
- staticpro (&message_dolog_marker3);
+/* Initialize glyph string S. CHAR2B is a suitably allocated vector
+ of XChar2b structures for S; it can't be allocated in
+ init_glyph_string because it must be allocated via `alloca'. W
+ is the window on which S is drawn. ROW and AREA are the glyph row
+ and area within the row from which S is constructed. START is the
+ index of the first glyph structure covered by S. HL is a
+ face-override for drawing S. */
-#if GLYPH_DEBUG
- defsubr (&Sdump_glyph_matrix);
- defsubr (&Sdump_glyph_row);
- defsubr (&Sdump_tool_bar_row);
- defsubr (&Strace_redisplay);
- defsubr (&Strace_to_stderr);
-#endif
-#ifdef HAVE_WINDOW_SYSTEM
- defsubr (&Stool_bar_lines_needed);
+#ifdef HAVE_NTGUI
+#define OPTIONAL_HDC(hdc) hdc,
+#define DECLARE_HDC(hdc) HDC hdc;
+#define ALLOCATE_HDC(hdc, f) hdc = get_frame_dc ((f))
+#define RELEASE_HDC(hdc, f) release_frame_dc ((f), (hdc))
#endif
- staticpro (&Qmenu_bar_update_hook);
- Qmenu_bar_update_hook = intern ("menu-bar-update-hook");
+#ifndef OPTIONAL_HDC
+#define OPTIONAL_HDC(hdc)
+#define DECLARE_HDC(hdc)
+#define ALLOCATE_HDC(hdc, f)
+#define RELEASE_HDC(hdc, f)
+#endif
+
+static void
+init_glyph_string (s, OPTIONAL_HDC (hdc) char2b, w, row, area, start, hl)
+ struct glyph_string *s;
+ DECLARE_HDC (hdc)
+ XChar2b *char2b;
+ struct window *w;
+ struct glyph_row *row;
+ enum glyph_row_area area;
+ int start;
+ enum draw_glyphs_face hl;
+{
+ bzero (s, sizeof *s);
+ s->w = w;
+ s->f = XFRAME (w->frame);
+#ifdef HAVE_NTGUI
+ s->hdc = hdc;
+#endif
+ s->display = FRAME_X_DISPLAY (s->f);
+ s->window = FRAME_X_WINDOW (s->f);
+ s->char2b = char2b;
+ s->hl = hl;
+ s->row = row;
+ s->area = area;
+ s->first_glyph = row->glyphs[area] + start;
+ s->height = row->height;
+ s->y = WINDOW_TO_FRAME_PIXEL_Y (w, row->y);
+
+ /* Display the internal border below the tool-bar window. */
+ if (s->w == XWINDOW (s->f->tool_bar_window))
+ s->y -= FRAME_INTERNAL_BORDER_WIDTH (s->f);
+
+ s->ybase = s->y + row->ascent;
+}
+
+
+/* Append the list of glyph strings with head H and tail T to the list
+ with head *HEAD and tail *TAIL. Set *HEAD and *TAIL to the result. */
+
+static INLINE void
+append_glyph_string_lists (head, tail, h, t)
+ struct glyph_string **head, **tail;
+ struct glyph_string *h, *t;
+{
+ if (h)
+ {
+ if (*head)
+ (*tail)->next = h;
+ else
+ *head = h;
+ h->prev = *tail;
+ *tail = t;
+ }
+}
+
+
+/* Prepend the list of glyph strings with head H and tail T to the
+ list with head *HEAD and tail *TAIL. Set *HEAD and *TAIL to the
+ result. */
+
+static INLINE void
+prepend_glyph_string_lists (head, tail, h, t)
+ struct glyph_string **head, **tail;
+ struct glyph_string *h, *t;
+{
+ if (h)
+ {
+ if (*head)
+ (*head)->prev = t;
+ else
+ *tail = t;
+ t->next = *head;
+ *head = h;
+ }
+}
+
+
+/* Append glyph string S to the list with head *HEAD and tail *TAIL.
+ Set *HEAD and *TAIL to the resulting list. */
+
+static INLINE void
+append_glyph_string (head, tail, s)
+ struct glyph_string **head, **tail;
+ struct glyph_string *s;
+{
+ s->next = s->prev = NULL;
+ append_glyph_string_lists (head, tail, s, s);
+}
+
+
+/* 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. */
+
+static INLINE struct face *
+get_glyph_face_and_encoding (f, glyph, char2b, two_byte_p)
+ struct frame *f;
+ struct glyph *glyph;
+ XChar2b *char2b;
+ int *two_byte_p;
+{
+ struct face *face;
+
+ xassert (glyph->type == CHAR_GLYPH);
+ face = FACE_FROM_ID (f, glyph->face_id);
+
+ if (two_byte_p)
+ *two_byte_p = 0;
+
+ if (!glyph->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, glyph->u.ch);
+ }
+ else if (glyph->u.ch < 128
+ && glyph->face_id < BASIC_FACE_ID_SENTINEL)
+ {
+ /* Case of ASCII in a face known to fit ASCII. */
+ STORE_XCHAR2B (char2b, 0, glyph->u.ch);
+ }
+ 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
- = rif->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
++ = rif->encode_char (glyph->u.ch, char2b, font_info, charset,
++ two_byte_p);
++ }
+ }
+ }
+
+ /* Make sure X resources of the face are allocated. */
+ xassert (face != NULL);
+ PREPARE_FACE_FOR_DISPLAY (f, face);
+ return face;
+}
+
+
+/* Fill glyph string S with composition components specified by S->cmp.
+
+ FACES is an array of faces for all components of this composition.
+ S->gidx is the index of the first component for S.
+ OVERLAPS_P non-zero means S should draw the foreground only, and
+ use its physical height for clipping.
+
+ Value is the index of a component not in S. */
+
+static int
+fill_composite_glyph_string (s, faces, overlaps_p)
+ struct glyph_string *s;
+ struct face **faces;
+ int overlaps_p;
+{
+ int i;
+
+ xassert (s);
+
+ s->for_overlaps_p = overlaps_p;
+
+ s->face = faces[s->gidx];
+ s->font = s->face->font;
+ s->font_info = FONT_INFO_FROM_ID (s->f, s->face->font_info_id);
+
+ /* 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;
+
+ /* 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
+ the glyph string so that we can draw rectangles for the
+ characters of the glyph string. */
+ if (s->font == NULL)
+ {
+ s->font_not_found_p = 1;
+ s->font = FRAME_FONT (s->f);
+ }
+
+ /* 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;
+
+ return s->gidx + s->nchars;
+}
+
+
+/* Fill glyph string S from a sequence of character glyphs.
+
+ FACE_ID is the face id of the string. START is the index of the
+ first glyph to consider, END is the index of the last + 1.
+ OVERLAPS_P non-zero means S should draw the foreground only, and
+ use its physical height for clipping.
+
+ Value is the index of the first glyph not in S. */
+
+static int
+fill_glyph_string (s, face_id, start, end, overlaps_p)
+ struct glyph_string *s;
+ int face_id;
+ int start, end, overlaps_p;
+{
+ struct glyph *glyph, *last;
+ int voffset;
+ int glyph_not_available_p;
+
+ xassert (s->f == XFRAME (s->w->frame));
+ xassert (s->nchars == 0);
+ xassert (start >= 0 && end > start);
+
+ s->for_overlaps_p = overlaps_p,
+ glyph = s->row->glyphs[s->area] + start;
+ last = s->row->glyphs[s->area] + end;
+ voffset = glyph->voffset;
+
+ glyph_not_available_p = glyph->glyph_not_available_p;
+
+ while (glyph < last
+ && glyph->type == CHAR_GLYPH
+ && glyph->voffset == voffset
+ /* Same face id implies same font, nowadays. */
+ && glyph->face_id == face_id
+ && glyph->glyph_not_available_p == glyph_not_available_p)
+ {
+ int two_byte_p;
+
+ s->face = get_glyph_face_and_encoding (s->f, glyph,
+ s->char2b + s->nchars,
+ &two_byte_p);
+ s->two_byte_p = two_byte_p;
+ ++s->nchars;
+ xassert (s->nchars <= end - start);
+ s->width += glyph->pixel_width;
+ ++glyph;
+ }
+
+ s->font = s->face->font;
+ s->font_info = FONT_INFO_FROM_ID (s->f, s->face->font_info_id);
+
+ /* If the specified font could not be loaded, use the frame's font,
+ but record the fact that we couldn't load it in
+ S->font_not_found_p so that we can draw rectangles for the
+ characters of the glyph string. */
+ if (s->font == NULL || glyph_not_available_p)
+ {
+ s->font_not_found_p = 1;
+ s->font = FRAME_FONT (s->f);
+ }
+
+ /* Adjust base line for subscript/superscript text. */
+ s->ybase += voffset;
+
+ xassert (s->face && s->face->gc);
+ return glyph - s->row->glyphs[s->area];
+}
+
+
+/* Fill glyph string S from image glyph S->first_glyph. */
+
+static void
+fill_image_glyph_string (s)
+ struct glyph_string *s;
+{
+ xassert (s->first_glyph->type == IMAGE_GLYPH);
+ s->img = IMAGE_FROM_ID (s->f, s->first_glyph->u.img_id);
+ xassert (s->img);
+ s->face = FACE_FROM_ID (s->f, s->first_glyph->face_id);
+ s->font = s->face->font;
+ s->width = s->first_glyph->pixel_width;
+
+ /* Adjust base line for subscript/superscript text. */
+ s->ybase += s->first_glyph->voffset;
+}
+
+
+/* Fill glyph string S from a sequence of stretch glyphs.
+
+ ROW is the glyph row in which the glyphs are found, AREA is the
+ area within the row. START is the index of the first glyph to
+ consider, END is the index of the last + 1.
+
+ Value is the index of the first glyph not in S. */
+
+static int
+fill_stretch_glyph_string (s, row, area, start, end)
+ struct glyph_string *s;
+ struct glyph_row *row;
+ enum glyph_row_area area;
+ int start, end;
+{
+ struct glyph *glyph, *last;
+ int voffset, face_id;
+
+ xassert (s->first_glyph->type == STRETCH_GLYPH);
+
+ glyph = s->row->glyphs[s->area] + start;
+ last = s->row->glyphs[s->area] + end;
+ 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->width = glyph->pixel_width;
+ voffset = glyph->voffset;
+
+ for (++glyph;
+ (glyph < last
+ && glyph->type == STRETCH_GLYPH
+ && glyph->voffset == voffset
+ && glyph->face_id == face_id);
+ ++glyph)
+ s->width += glyph->pixel_width;
+
+ /* Adjust base line for subscript/superscript text. */
+ s->ybase += voffset;
+
+ /* The case that face->gc == 0 is handled when drawing the glyph
+ string by calling PREPARE_FACE_FOR_DISPLAY. */
+ xassert (s->face);
+ return glyph - s->row->glyphs[s->area];
+}
+
+
+/* EXPORT for RIF:
+ Set *LEFT and *RIGHT to the left and right overhang of GLYPH on
+ frame F. Overhangs of glyphs other than type CHAR_GLYPH are
+ assumed to be zero. */
+
+void
+x_get_glyph_overhangs (glyph, f, left, right)
+ struct glyph *glyph;
+ struct frame *f;
+ int *left, *right;
+{
+ *left = *right = 0;
+
+ if (glyph->type == CHAR_GLYPH)
+ {
+ XFontStruct *font;
+ struct face *face;
+ struct font_info *font_info;
+ XChar2b char2b;
+ XCharStruct *pcm;
+
+ face = get_glyph_face_and_encoding (f, glyph, &char2b, NULL);
+ font = face->font;
+ font_info = FONT_INFO_FROM_ID (f, face->font_info_id);
+ if (font /* ++KFS: Should this be font_info ? */
+ && (pcm = rif->per_char_metric (font, &char2b, glyph->font_type)))
+ {
+ if (pcm->rbearing > pcm->width)
+ *right = pcm->rbearing - pcm->width;
+ if (pcm->lbearing < 0)
+ *left = -pcm->lbearing;
+ }
+ }
+}
+
+
+/* Return the index of the first glyph preceding glyph string S that
+ is overwritten by S because of S's left overhang. Value is -1
+ if no glyphs are overwritten. */
+
+static int
+left_overwritten (s)
+ struct glyph_string *s;
+{
+ int k;
+
+ if (s->left_overhang)
+ {
+ int x = 0, i;
+ struct glyph *glyphs = s->row->glyphs[s->area];
+ int first = s->first_glyph - glyphs;
+
+ for (i = first - 1; i >= 0 && x > -s->left_overhang; --i)
+ x -= glyphs[i].pixel_width;
+
+ k = i + 1;
+ }
+ else
+ k = -1;
+
+ return k;
+}
+
+
+/* Return the index of the first glyph preceding glyph string S that
+ is overwriting S because of its right overhang. Value is -1 if no
+ glyph in front of S overwrites S. */
+
+static int
+left_overwriting (s)
+ struct glyph_string *s;
+{
+ int i, k, x;
+ struct glyph *glyphs = s->row->glyphs[s->area];
+ int first = s->first_glyph - glyphs;
+
+ k = -1;
+ x = 0;
+ for (i = first - 1; i >= 0; --i)
+ {
+ int left, right;
+ x_get_glyph_overhangs (glyphs + i, s->f, &left, &right);
+ if (x + right > 0)
+ k = i;
+ x -= glyphs[i].pixel_width;
+ }
+
+ return k;
+}
+
+
+/* Return the index of the last glyph following glyph string S that is
+ not overwritten by S because of S's right overhang. Value is -1 if
+ no such glyph is found. */
+
+static int
+right_overwritten (s)
+ struct glyph_string *s;
+{
+ int k = -1;
+
+ if (s->right_overhang)
+ {
+ int x = 0, i;
+ struct glyph *glyphs = s->row->glyphs[s->area];
+ int first = (s->first_glyph - glyphs) + (s->cmp ? 1 : s->nchars);
+ int end = s->row->used[s->area];
+
+ for (i = first; i < end && s->right_overhang > x; ++i)
+ x += glyphs[i].pixel_width;
+
+ k = i;
+ }
+
+ return k;
+}
+
+
+/* Return the index of the last glyph following glyph string S that
+ overwrites S because of its left overhang. Value is negative
+ if no such glyph is found. */
+
+static int
+right_overwriting (s)
+ struct glyph_string *s;
+{
+ int i, k, x;
+ int end = s->row->used[s->area];
+ struct glyph *glyphs = s->row->glyphs[s->area];
+ int first = (s->first_glyph - glyphs) + (s->cmp ? 1 : s->nchars);
+
+ k = -1;
+ x = 0;
+ for (i = first; i < end; ++i)
+ {
+ int left, right;
+ x_get_glyph_overhangs (glyphs + i, s->f, &left, &right);
+ if (x - left < 0)
+ k = i;
+ x += glyphs[i].pixel_width;
+ }
+
+ return k;
+}
+
+
+/* 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 && face_id < BASIC_FACE_ID_SENTINEL)
+ {
+ /* Case of ASCII in a face known to fit ASCII. */
+ STORE_XCHAR2B (char2b, 0, c);
+ }
- else
++ else if (face->font != NULL)
+ {
- int c1, c2, charset;
++ 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);
+
- /* 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);
++ if (CHARSET_DIMENSION (charset) == 1)
++ STORE_XCHAR2B (char2b, 0, code);
+ 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)
- rif->encode_char (c, char2b, font_info, 0);
- }
++ STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF));
++ /* Maybe encode the character in *CHAR2B. */
++ rif->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;
+}
+
+
+/* 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. */
+
+static INLINE void
+set_glyph_string_background_width (s, start, last_x)
+ struct glyph_string *s;
+ int start;
+ int last_x;
+{
+ /* If the face of this glyph string has to be drawn to the end of
+ the drawing area, set S->extends_to_end_of_line_p. */
+ struct face *default_face = FACE_FROM_ID (s->f, DEFAULT_FACE_ID);
+
+ if (start == s->row->used[s->area]
+ && s->area == TEXT_AREA
+ && ((s->hl == DRAW_NORMAL_TEXT
+ && (s->row->fill_line_p
+ || s->face->background != default_face->background
+ || s->face->stipple != default_face->stipple
+ || s->row->mouse_face_p))
+ || s->hl == DRAW_MOUSE_FACE
+ || ((s->hl == DRAW_IMAGE_RAISED || s->hl == DRAW_IMAGE_SUNKEN)
+ && s->row->fill_line_p)))
+ s->extends_to_end_of_line_p = 1;
+
+ /* If S extends its face to the end of the line, set its
+ background_width to the distance to the right edge of the drawing
+ area. */
+ if (s->extends_to_end_of_line_p)
+ s->background_width = last_x - s->x + 1;
+ else
+ s->background_width = s->width;
+}
+
+
+/* Compute overhangs and x-positions for glyph string S and its
+ predecessors, or successors. X is the starting x-position for S.
+ BACKWARD_P non-zero means process predecessors. */
+
+static void
+compute_overhangs_and_x (s, x, backward_p)
+ struct glyph_string *s;
+ int x;
+ int backward_p;
+{
+ if (backward_p)
+ {
+ while (s)
+ {
+ if (rif->compute_glyph_string_overhangs)
+ rif->compute_glyph_string_overhangs (s);
+ x -= s->width;
+ s->x = x;
+ s = s->prev;
+ }
+ }
+ else
+ {
+ while (s)
+ {
+ if (rif->compute_glyph_string_overhangs)
+ rif->compute_glyph_string_overhangs (s);
+ s->x = x;
+ x += s->width;
+ s = s->next;
+ }
+ }
+}
+
+
+
+/* The following macros are only called from draw_glyphs below.
+ They reference the following parameters of that function directly:
+ `w', `row', `area', and `overlap_p'
+ as well as the following local variables:
+ `s', `f', and `hdc' (in W32) */
+
+#ifdef HAVE_NTGUI
+/* On W32, silently add local `hdc' variable to argument list of
+ init_glyph_string. */
+#define INIT_GLYPH_STRING(s, char2b, w, row, area, start, hl) \
+ init_glyph_string (s, hdc, char2b, w, row, area, start, hl)
+#else
+#define INIT_GLYPH_STRING(s, char2b, w, row, area, start, hl) \
+ init_glyph_string (s, char2b, w, row, area, start, hl)
+#endif
+
+/* Add a glyph string for a stretch glyph to the list of strings
+ between HEAD and TAIL. START is the index of the stretch glyph in
+ row area AREA of glyph row ROW. END is the index of the last glyph
+ in that glyph row area. X is the current output position assigned
+ to the new glyph string constructed. HL overrides that face of the
+ glyph; e.g. it is DRAW_CURSOR if a cursor has to be drawn. LAST_X
+ is the right-most x-position of the drawing area. */
+
+/* SunOS 4 bundled cc, barfed on continuations in the arg lists here
+ and below -- keep them on one line. */
+#define BUILD_STRETCH_GLYPH_STRING(START, END, HEAD, TAIL, HL, X, LAST_X) \
+ do \
+ { \
+ s = (struct glyph_string *) alloca (sizeof *s); \
+ INIT_GLYPH_STRING (s, NULL, w, row, area, START, HL); \
+ START = fill_stretch_glyph_string (s, row, area, START, END); \
+ append_glyph_string (&HEAD, &TAIL, s); \
+ s->x = (X); \
+ } \
+ while (0)
+
+
+/* Add a glyph string for an image glyph to the list of strings
+ between HEAD and TAIL. START is the index of the image glyph in
+ row area AREA of glyph row ROW. END is the index of the last glyph
+ in that glyph row area. X is the current output position assigned
+ to the new glyph string constructed. HL overrides that face of the
+ glyph; e.g. it is DRAW_CURSOR if a cursor has to be drawn. LAST_X
+ is the right-most x-position of the drawing area. */
+
+#define BUILD_IMAGE_GLYPH_STRING(START, END, HEAD, TAIL, HL, X, LAST_X) \
+ do \
+ { \
+ s = (struct glyph_string *) alloca (sizeof *s); \
+ INIT_GLYPH_STRING (s, NULL, w, row, area, START, HL); \
+ fill_image_glyph_string (s); \
+ append_glyph_string (&HEAD, &TAIL, s); \
+ ++START; \
+ s->x = (X); \
+ } \
+ while (0)
+
+
+/* Add a glyph string for a sequence of character glyphs to the list
+ of strings between HEAD and TAIL. START is the index of the first
+ glyph in row area AREA of glyph row ROW that is part of the new
+ glyph string. END is the index of the last glyph in that glyph row
+ area. X is the current output position assigned to the new glyph
+ string constructed. HL overrides that face of the glyph; e.g. it
+ is DRAW_CURSOR if a cursor has to be drawn. LAST_X is the
+ right-most x-position of the drawing area. */
+
+#define BUILD_CHAR_GLYPH_STRINGS(START, END, HEAD, TAIL, HL, X, LAST_X) \
+ do \
+ { \
+ int c, 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); \
+ char2b = (XChar2b *) alloca ((END - START) * sizeof *char2b); \
+ INIT_GLYPH_STRING (s, char2b, w, row, area, START, HL); \
+ append_glyph_string (&HEAD, &TAIL, s); \
+ s->x = (X); \
+ START = fill_glyph_string (s, face_id, START, END, overlaps_p); \
+ } \
+ while (0)
+
+
+/* Add a glyph string for a composite sequence to the list of strings
+ between HEAD and TAIL. START is the index of the first glyph in
+ row area AREA of glyph row ROW that is part of the new glyph
+ string. END is the index of the last glyph in that glyph row area.
+ X is the current output position assigned to the new glyph string
+ constructed. HL overrides that face of the glyph; e.g. it is
+ DRAW_CURSOR if a cursor has to be drawn. LAST_X is the right-most
+ 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_p); \
+ } \
+ \
+ ++START; \
+ s = first_s; \
+ } while (0)
+
+
+/* Build a list of glyph strings between HEAD and TAIL for the glyphs
+ of AREA of glyph row ROW on window W between indices START and END.
+ HL overrides the face for drawing glyph strings, e.g. it is
+ DRAW_CURSOR to draw a cursor. X and LAST_X are start and end
+ x-positions of the drawing area.
+
+ This is an ugly monster macro construct because we must use alloca
+ to allocate glyph strings (because draw_glyphs can be called
+ asynchronously). */
+
+#define BUILD_GLYPH_STRINGS(START, END, HEAD, TAIL, HL, X, LAST_X) \
+ do \
+ { \
+ HEAD = TAIL = NULL; \
+ while (START < END) \
+ { \
+ struct glyph *first_glyph = (row)->glyphs[area] + START; \
+ switch (first_glyph->type) \
+ { \
+ case CHAR_GLYPH: \
+ BUILD_CHAR_GLYPH_STRINGS (START, END, HEAD, TAIL, \
+ HL, X, LAST_X); \
+ break; \
+ \
+ case COMPOSITE_GLYPH: \
+ BUILD_COMPOSITE_GLYPH_STRING (START, END, HEAD, TAIL, \
+ HL, X, LAST_X); \
+ break; \
+ \
+ case STRETCH_GLYPH: \
+ BUILD_STRETCH_GLYPH_STRING (START, END, HEAD, TAIL, \
+ HL, X, LAST_X); \
+ break; \
+ \
+ case IMAGE_GLYPH: \
+ BUILD_IMAGE_GLYPH_STRING (START, END, HEAD, TAIL, \
+ HL, X, LAST_X); \
+ break; \
+ \
+ default: \
+ abort (); \
+ } \
+ \
+ set_glyph_string_background_width (s, START, LAST_X); \
+ (X) += s->width; \
+ } \
+ } \
+ while (0)
+
+
+/* Draw glyphs between START and END in AREA of ROW on window W,
+ starting at x-position X. X is relative to AREA in W. HL is a
+ face-override with the following meaning:
+
+ DRAW_NORMAL_TEXT draw normally
+ DRAW_CURSOR draw in cursor face
+ DRAW_MOUSE_FACE draw in mouse face.
+ DRAW_INVERSE_VIDEO draw in mode line face
+ DRAW_IMAGE_SUNKEN draw an image with a sunken relief around it
+ DRAW_IMAGE_RAISED draw an image with a raised relief around it
+
+ If OVERLAPS_P is non-zero, draw only the foreground of characters
+ and clip to the physical height of ROW.
+
+ Value is the x-position reached, relative to AREA of W. */
+
+static int
+draw_glyphs (w, x, row, area, start, end, hl, overlaps_p)
+ struct window *w;
+ int x;
+ struct glyph_row *row;
+ enum glyph_row_area area;
+ int start, end;
+ enum draw_glyphs_face hl;
+ int overlaps_p;
+{
+ struct glyph_string *head, *tail;
+ struct glyph_string *s;
+ int last_x, area_width;
+ int x_reached;
+ int i, j;
+ struct frame *f = XFRAME (WINDOW_FRAME (w));
+ DECLARE_HDC (hdc);
+
+ ALLOCATE_HDC (hdc, f);
+
+ /* Let's rather be paranoid than getting a SEGV. */
+ end = min (end, row->used[area]);
+ start = max (0, start);
+ start = min (end, start);
+
+ /* Translate X to frame coordinates. Set last_x to the right
+ end of the drawing area. */
+ if (row->full_width_p)
+ {
+ /* X is relative to the left edge of W, without scroll bars
+ or fringes. */
+ x += WINDOW_LEFT_EDGE_X (w);
+ last_x = WINDOW_LEFT_EDGE_X (w) + WINDOW_TOTAL_WIDTH (w);
+ }
+ else
+ {
+ int area_left = window_box_left (w, area);
+ x += area_left;
+ area_width = window_box_width (w, area);
+ last_x = area_left + area_width;
+ }
+
+ /* Build a doubly-linked list of glyph_string structures between
+ head and tail from what we have to draw. Note that the macro
+ BUILD_GLYPH_STRINGS will modify its start parameter. That's
+ the reason we use a separate variable `i'. */
+ i = start;
+ BUILD_GLYPH_STRINGS (i, end, head, tail, hl, x, last_x);
+ if (tail)
+ x_reached = tail->x + tail->background_width;
+ else
+ x_reached = x;
+
+ /* If there are any glyphs with lbearing < 0 or rbearing > width in
+ the row, redraw some glyphs in front or following the glyph
+ strings built above. */
+ if (head && !overlaps_p && row->contains_overlapping_glyphs_p)
+ {
+ int dummy_x = 0;
+ struct glyph_string *h, *t;
+
+ /* Compute overhangs for all glyph strings. */
+ if (rif->compute_glyph_string_overhangs)
+ for (s = head; s; s = s->next)
+ rif->compute_glyph_string_overhangs (s);
+
+ /* Prepend glyph strings for glyphs in front of the first glyph
+ string that are overwritten because of the first glyph
+ string's left overhang. The background of all strings
+ prepended must be drawn because the first glyph string
+ draws over it. */
+ i = left_overwritten (head);
+ if (i >= 0)
+ {
+ j = i;
+ BUILD_GLYPH_STRINGS (j, start, h, t,
+ DRAW_NORMAL_TEXT, dummy_x, last_x);
+ start = i;
+ compute_overhangs_and_x (t, head->x, 1);
+ prepend_glyph_string_lists (&head, &tail, h, t);
+ }
+
+ /* Prepend glyph strings for glyphs in front of the first glyph
+ string that overwrite that glyph string because of their
+ right overhang. For these strings, only the foreground must
+ be drawn, because it draws over the glyph string at `head'.
+ The background must not be drawn because this would overwrite
+ right overhangs of preceding glyphs for which no glyph
+ strings exist. */
+ i = left_overwriting (head);
+ if (i >= 0)
+ {
+ BUILD_GLYPH_STRINGS (i, start, h, t,
+ DRAW_NORMAL_TEXT, dummy_x, last_x);
+ for (s = h; s; s = s->next)
+ s->background_filled_p = 1;
+ compute_overhangs_and_x (t, head->x, 1);
+ prepend_glyph_string_lists (&head, &tail, h, t);
+ }
+
+ /* Append glyphs strings for glyphs following the last glyph
+ string tail that are overwritten by tail. The background of
+ these strings has to be drawn because tail's foreground draws
+ over it. */
+ i = right_overwritten (tail);
+ if (i >= 0)
+ {
+ BUILD_GLYPH_STRINGS (end, i, h, t,
+ DRAW_NORMAL_TEXT, x, last_x);
+ compute_overhangs_and_x (h, tail->x + tail->width, 0);
+ append_glyph_string_lists (&head, &tail, h, t);
+ }
+
+ /* Append glyph strings for glyphs following the last glyph
+ string tail that overwrite tail. The foreground of such
+ glyphs has to be drawn because it writes into the background
+ of tail. The background must not be drawn because it could
+ paint over the foreground of following glyphs. */
+ i = right_overwriting (tail);
+ if (i >= 0)
+ {
+ BUILD_GLYPH_STRINGS (end, i, h, t,
+ DRAW_NORMAL_TEXT, x, last_x);
+ for (s = h; s; s = s->next)
+ s->background_filled_p = 1;
+ compute_overhangs_and_x (h, tail->x + tail->width, 0);
+ append_glyph_string_lists (&head, &tail, h, t);
+ }
+ }
+
+ /* Draw all strings. */
+ for (s = head; s; s = s->next)
+ rif->draw_glyph_string (s);
+
+ if (area == TEXT_AREA
+ && !row->full_width_p
+ /* When drawing overlapping rows, only the glyph strings'
+ foreground is drawn, which doesn't erase a cursor
+ completely. */
+ && !overlaps_p)
+ {
+ int x0 = head ? head->x : x;
+ int x1 = tail ? tail->x + tail->background_width : x;
+
+ int text_left = window_box_left (w, TEXT_AREA);
+ x0 -= text_left;
+ x1 -= text_left;
+
+ notice_overwritten_cursor (w, TEXT_AREA, x0, x1,
+ row->y, MATRIX_ROW_BOTTOM_Y (row));
+ }
+
+ /* Value is the x-position up to which drawn, relative to AREA of W.
+ This doesn't include parts drawn because of overhangs. */
+ if (row->full_width_p)
+ x_reached = FRAME_TO_WINDOW_PIXEL_X (w, x_reached);
+ else
+ x_reached -= window_box_left (w, area);
+
+ RELEASE_HDC (hdc, f);
+
+ return x_reached;
+}
+
+
+/* Store one glyph for IT->char_to_display in IT->glyph_row.
+ Called from x_produce_glyphs when IT->glyph_row is non-null. */
+
+static INLINE void
+append_glyph (it)
+ struct it *it;
+{
+ struct glyph *glyph;
+ enum glyph_row_area area = it->area;
+
+ xassert (it->glyph_row);
+ xassert (it->char_to_display != '\n' && it->char_to_display != '\t');
+
+ glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
+ if (glyph < it->glyph_row->glyphs[area + 1])
+ {
+ glyph->charpos = CHARPOS (it->position);
+ glyph->object = it->object;
+ glyph->pixel_width = it->pixel_width;
+ glyph->voffset = it->voffset;
+ glyph->type = CHAR_GLYPH;
+ glyph->multibyte_p = it->multibyte_p;
+ glyph->left_box_line_p = it->start_of_box_run_p;
+ glyph->right_box_line_p = it->end_of_box_run_p;
+ glyph->overlaps_vertically_p = (it->phys_ascent > it->ascent
+ || it->phys_descent > it->descent);
+ glyph->padding_p = 0;
+ glyph->glyph_not_available_p = it->glyph_not_available_p;
+ glyph->face_id = it->face_id;
+ glyph->u.ch = it->char_to_display;
+ glyph->font_type = FONT_TYPE_UNKNOWN;
+ ++it->glyph_row->used[area];
+ }
+}
+
+/* Store one glyph for the composition IT->cmp_id in IT->glyph_row.
+ Called from x_produce_glyphs when IT->glyph_row is non-null. */
+
+static INLINE void
+append_composite_glyph (it)
+ struct it *it;
+{
+ struct glyph *glyph;
+ enum glyph_row_area area = it->area;
+
+ xassert (it->glyph_row);
+
+ glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
+ if (glyph < it->glyph_row->glyphs[area + 1])
+ {
+ glyph->charpos = CHARPOS (it->position);
+ glyph->object = it->object;
+ glyph->pixel_width = it->pixel_width;
+ glyph->voffset = it->voffset;
+ glyph->type = COMPOSITE_GLYPH;
+ glyph->multibyte_p = it->multibyte_p;
+ glyph->left_box_line_p = it->start_of_box_run_p;
+ glyph->right_box_line_p = it->end_of_box_run_p;
+ glyph->overlaps_vertically_p = (it->phys_ascent > it->ascent
+ || it->phys_descent > it->descent);
+ glyph->padding_p = 0;
+ glyph->glyph_not_available_p = 0;
+ glyph->face_id = it->face_id;
+ glyph->u.cmp_id = it->cmp_id;
+ glyph->font_type = FONT_TYPE_UNKNOWN;
+ ++it->glyph_row->used[area];
+ }
+}
+
+
+/* Change IT->ascent and IT->height according to the setting of
+ IT->voffset. */
+
+static INLINE void
+take_vertical_position_into_account (it)
+ struct it *it;
+{
+ if (it->voffset)
+ {
+ if (it->voffset < 0)
+ /* Increase the ascent so that we can display the text higher
+ in the line. */
+ it->ascent += abs (it->voffset);
+ else
+ /* Increase the descent so that we can display the text lower
+ in the line. */
+ it->descent += it->voffset;
+ }
+}
+
+
+/* Produce glyphs/get display metrics for the image IT is loaded with.
+ See the description of struct display_iterator in dispextern.h for
+ an overview of struct display_iterator. */
+
+static void
+produce_image_glyph (it)
+ struct it *it;
+{
+ struct image *img;
+ struct face *face;
+
+ xassert (it->what == IT_IMAGE);
+
+ face = FACE_FROM_ID (it->f, it->face_id);
+ img = IMAGE_FROM_ID (it->f, it->image_id);
+ xassert (img);
+
+ /* Make sure X resources of the face and image are loaded. */
+ PREPARE_FACE_FOR_DISPLAY (it->f, face);
+ prepare_image_for_display (it->f, img);
+
+ it->ascent = it->phys_ascent = image_ascent (img, face);
+ it->descent = it->phys_descent = img->height + 2 * img->vmargin - it->ascent;
+ it->pixel_width = img->width + 2 * img->hmargin;
+
+ it->nglyphs = 1;
+
+ if (face->box != FACE_NO_BOX)
+ {
+ if (face->box_line_width > 0)
+ {
+ it->ascent += face->box_line_width;
+ it->descent += face->box_line_width;
+ }
+
+ if (it->start_of_box_run_p)
+ it->pixel_width += abs (face->box_line_width);
+ if (it->end_of_box_run_p)
+ it->pixel_width += abs (face->box_line_width);
+ }
+
+ take_vertical_position_into_account (it);
+
+ if (it->glyph_row)
+ {
+ struct glyph *glyph;
+ enum glyph_row_area area = it->area;
+
+ glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
+ if (glyph < it->glyph_row->glyphs[area + 1])
+ {
+ glyph->charpos = CHARPOS (it->position);
+ glyph->object = it->object;
+ glyph->pixel_width = it->pixel_width;
+ glyph->voffset = it->voffset;
+ glyph->type = IMAGE_GLYPH;
+ glyph->multibyte_p = it->multibyte_p;
+ glyph->left_box_line_p = it->start_of_box_run_p;
+ glyph->right_box_line_p = it->end_of_box_run_p;
+ glyph->overlaps_vertically_p = 0;
+ glyph->padding_p = 0;
+ glyph->glyph_not_available_p = 0;
+ glyph->face_id = it->face_id;
+ glyph->u.img_id = img->id;
+ glyph->font_type = FONT_TYPE_UNKNOWN;
+ ++it->glyph_row->used[area];
+ }
+ }
+}
+
+
+/* Append a stretch glyph to IT->glyph_row. OBJECT is the source
+ of the glyph, WIDTH and HEIGHT are the width and height of the
+ stretch. ASCENT is the percentage/100 of HEIGHT to use for the
+ ascent of the glyph (0 <= ASCENT <= 1). */
+
+static void
+append_stretch_glyph (it, object, width, height, ascent)
+ struct it *it;
+ Lisp_Object object;
+ int width, height;
+ double ascent;
+{
+ struct glyph *glyph;
+ enum glyph_row_area area = it->area;
+
+ xassert (ascent >= 0 && ascent <= 1);
+
+ glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
+ if (glyph < it->glyph_row->glyphs[area + 1])
+ {
+ glyph->charpos = CHARPOS (it->position);
+ glyph->object = object;
+ glyph->pixel_width = width;
+ glyph->voffset = it->voffset;
+ glyph->type = STRETCH_GLYPH;
+ glyph->multibyte_p = it->multibyte_p;
+ glyph->left_box_line_p = it->start_of_box_run_p;
+ glyph->right_box_line_p = it->end_of_box_run_p;
+ glyph->overlaps_vertically_p = 0;
+ glyph->padding_p = 0;
+ glyph->glyph_not_available_p = 0;
+ glyph->face_id = it->face_id;
+ glyph->u.stretch.ascent = height * ascent;
+ glyph->u.stretch.height = height;
+ glyph->font_type = FONT_TYPE_UNKNOWN;
+ ++it->glyph_row->used[area];
+ }
+}
+
+
+/* Produce a stretch glyph for iterator IT. IT->object is the value
+ of the glyph property displayed. The value must be a list
+ `(space KEYWORD VALUE ...)' with the following KEYWORD/VALUE pairs
+ being recognized:
+
+ 1. `:width WIDTH' specifies that the space should be WIDTH *
+ canonical char width wide. WIDTH may be an integer or floating
+ point number.
+
+ 2. `:relative-width FACTOR' specifies that the width of the stretch
+ should be computed from the width of the first character having the
+ `glyph' property, and should be FACTOR times that width.
+
+ 3. `:align-to HPOS' specifies that the space should be wide enough
+ to reach HPOS, a value in canonical character units.
+
+ Exactly one of the above pairs must be present.
+
+ 4. `:height HEIGHT' specifies that the height of the stretch produced
+ should be HEIGHT, measured in canonical character units.
+
+ 5. `:relative-height FACTOR' specifies that the height of the
+ stretch should be FACTOR times the height of the characters having
+ the glyph property.
+
+ Either none or exactly one of 4 or 5 must be present.
+
+ 6. `:ascent ASCENT' specifies that ASCENT percent of the height
+ of the stretch should be used for the ascent of the stretch.
+ ASCENT must be in the range 0 <= ASCENT <= 100. */
+
+#define NUMVAL(X) \
+ ((INTEGERP (X) || FLOATP (X)) \
+ ? XFLOATINT (X) \
+ : - 1)
+
+
+static void
+produce_stretch_glyph (it)
+ struct it *it;
+{
+ /* (space :width WIDTH :height HEIGHT. */
+ Lisp_Object prop, plist;
+ int width = 0, height = 0;
+ double ascent = 0;
+ struct face *face = FACE_FROM_ID (it->f, it->face_id);
+ XFontStruct *font = face->font ? face->font : FRAME_FONT (it->f);
+
+ PREPARE_FACE_FOR_DISPLAY (it->f, face);
+
+ /* List should start with `space'. */
+ xassert (CONSP (it->object) && EQ (XCAR (it->object), Qspace));
+ plist = XCDR (it->object);
+
+ /* Compute the width of the stretch. */
+ if (prop = Fplist_get (plist, QCwidth),
+ NUMVAL (prop) > 0)
+ /* Absolute width `:width WIDTH' specified and valid. */
+ width = NUMVAL (prop) * FRAME_COLUMN_WIDTH (it->f);
+ else if (prop = Fplist_get (plist, QCrelative_width),
+ NUMVAL (prop) > 0)
+ {
+ /* Relative width `:relative-width FACTOR' specified and valid.
+ Compute the width of the characters having the `glyph'
+ property. */
+ struct it it2;
+ unsigned char *p = BYTE_POS_ADDR (IT_BYTEPOS (*it));
+
+ it2 = *it;
+ if (it->multibyte_p)
+ {
+ int maxlen = ((IT_BYTEPOS (*it) >= GPT ? ZV : GPT)
+ - IT_BYTEPOS (*it));
+ it2.c = STRING_CHAR_AND_LENGTH (p, maxlen, it2.len);
+ }
+ else
+ it2.c = *p, it2.len = 1;
+
+ it2.glyph_row = NULL;
+ it2.what = IT_CHARACTER;
+ x_produce_glyphs (&it2);
+ width = NUMVAL (prop) * it2.pixel_width;
+ }
+ else if (prop = Fplist_get (plist, QCalign_to),
+ NUMVAL (prop) > 0)
+ width = NUMVAL (prop) * FRAME_COLUMN_WIDTH (it->f) - it->current_x;
+ else
+ /* Nothing specified -> width defaults to canonical char width. */
+ width = FRAME_COLUMN_WIDTH (it->f);
+
+ /* Compute height. */
+ if (prop = Fplist_get (plist, QCheight),
+ NUMVAL (prop) > 0)
+ height = NUMVAL (prop) * FRAME_LINE_HEIGHT (it->f);
+ else if (prop = Fplist_get (plist, QCrelative_height),
+ NUMVAL (prop) > 0)
+ height = FONT_HEIGHT (font) * NUMVAL (prop);
+ else
+ height = FONT_HEIGHT (font);
+
+ /* Compute percentage of height used for ascent. If
+ `:ascent ASCENT' is present and valid, use that. Otherwise,
+ derive the ascent from the font in use. */
+ if (prop = Fplist_get (plist, QCascent),
+ NUMVAL (prop) > 0 && NUMVAL (prop) <= 100)
+ ascent = NUMVAL (prop) / 100.0;
+ else
+ ascent = (double) FONT_BASE (font) / FONT_HEIGHT (font);
+
+ if (width <= 0)
+ width = 1;
+ if (height <= 0)
+ height = 1;
+
+ if (it->glyph_row)
+ {
+ Lisp_Object object = it->stack[it->sp - 1].string;
+ if (!STRINGP (object))
+ object = it->w->buffer;
+ append_stretch_glyph (it, object, width, height, ascent);
+ }
+
+ it->pixel_width = width;
+ it->ascent = it->phys_ascent = height * ascent;
+ it->descent = it->phys_descent = height - it->ascent;
+ it->nglyphs = 1;
+
+ if (face->box != FACE_NO_BOX)
+ {
+ if (face->box_line_width > 0)
+ {
+ it->ascent += face->box_line_width;
+ it->descent += face->box_line_width;
+ }
+
+ if (it->start_of_box_run_p)
+ it->pixel_width += abs (face->box_line_width);
+ if (it->end_of_box_run_p)
+ it->pixel_width += abs (face->box_line_width);
+ }
+
+ take_vertical_position_into_account (it);
+}
+
+/* RIF:
+ Produce glyphs/get display metrics for the display element IT is
+ loaded with. See the description of struct display_iterator in
+ dispextern.h for an overview of struct display_iterator. */
+
+void
+x_produce_glyphs (it)
+ struct it *it;
+{
+ it->glyph_not_available_p = 0;
+
+ if (it->what == IT_CHARACTER)
+ {
+ XChar2b char2b;
+ XFontStruct *font;
+ 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 */
+ /* We may change it->multibyte_p upon unibyte<->multibyte
+ conversion. So, save the current value now and restore it
+ later.
+
+ Note: It seems that we don't have to record multibyte_p in
+ struct glyph because the character code itself tells if or
+ not the character is multibyte. Thus, in the future, we must
+ consider eliminating the field `multibyte_p' in the struct
+ glyph. */
+ int saved_multibyte_p = it->multibyte_p;
+
+ /* 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->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);
+ }
+ }
+
+ /* Get font to use. Encode IT->char_to_display. */
+ get_char_face_and_encoding (it->f, it->char_to_display, it->face_id,
+ &char2b, it->multibyte_p, 0);
+ font = face->font;
+
+ /* When no suitable font found, use the default font. */
+ font_not_found_p = font == NULL;
+ if (font_not_found_p)
+ {
+ font = FRAME_FONT (it->f);
+ boff = FRAME_BASELINE_OFFSET (it->f);
+ font_info = NULL;
+ }
+ 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;
+ }
+
+ if (it->char_to_display >= ' '
+ && (!it->multibyte_p || it->char_to_display < 128))
+ {
+ /* Either unibyte or ASCII. */
+ int stretched_p;
+
+ it->nglyphs = 1;
+
+ pcm = rif->per_char_metric (font, &char2b,
+ FONT_TYPE_FOR_UNIBYTE (font, it->char_to_display));
+ it->ascent = FONT_BASE (font) + boff;
+ it->descent = FONT_DESCENT (font) - boff;
+
+ if (pcm)
+ {
+ it->phys_ascent = pcm->ascent + boff;
+ it->phys_descent = pcm->descent - boff;
+ it->pixel_width = pcm->width;
+ }
+ else
+ {
+ it->glyph_not_available_p = 1;
+ it->phys_ascent = FONT_BASE (font) + boff;
+ it->phys_descent = FONT_DESCENT (font) - boff;
+ it->pixel_width = FONT_WIDTH (font);
+ }
+
+ /* If this is a space inside a region of text with
+ `space-width' property, change its width. */
+ stretched_p = it->char_to_display == ' ' && !NILP (it->space_width);
+ if (stretched_p)
+ it->pixel_width *= XFLOATINT (it->space_width);
+
+ /* If face has a box, add the box thickness to the character
+ height. If character has a box line to the left and/or
+ right, add the box line width to the character's width. */
+ if (face->box != FACE_NO_BOX)
+ {
+ int thick = face->box_line_width;
+
+ if (thick > 0)
+ {
+ it->ascent += thick;
+ it->descent += thick;
+ }
+ else
+ thick = -thick;
+
+ if (it->start_of_box_run_p)
+ it->pixel_width += thick;
+ if (it->end_of_box_run_p)
+ it->pixel_width += thick;
+ }
+
+ /* If face has an overline, add the height of the overline
+ (1 pixel) and a 1 pixel margin to the character height. */
+ if (face->overline_p)
+ it->ascent += 2;
+
+ take_vertical_position_into_account (it);
+
+ /* If we have to actually produce glyphs, do it. */
+ if (it->glyph_row)
+ {
+ if (stretched_p)
+ {
+ /* Translate a space with a `space-width' property
+ into a stretch glyph. */
+ double ascent = (double) FONT_BASE (font)
+ / FONT_HEIGHT (font);
+ append_stretch_glyph (it, it->object, it->pixel_width,
+ it->ascent + it->descent, ascent);
+ }
+ else
+ append_glyph (it);
+
+ /* If characters with lbearing or rbearing are displayed
+ in this line, record that fact in a flag of the
+ glyph row. This is used to optimize X output code. */
+ if (pcm && (pcm->lbearing < 0 || pcm->rbearing > pcm->width))
+ it->glyph_row->contains_overlapping_glyphs_p = 1;
+ }
+ }
+ else if (it->char_to_display == '\n')
+ {
+ /* A newline has no width but we need the height of the line. */
+ it->pixel_width = 0;
+ it->nglyphs = 0;
+ it->ascent = it->phys_ascent = FONT_BASE (font) + boff;
+ it->descent = it->phys_descent = FONT_DESCENT (font) - boff;
+
+ if (face->box != FACE_NO_BOX
+ && face->box_line_width > 0)
+ {
+ it->ascent += face->box_line_width;
+ it->descent += face->box_line_width;
+ }
+ }
+ else if (it->char_to_display == '\t')
+ {
+ int tab_width = it->tab_width * FRAME_COLUMN_WIDTH (it->f);
+ int x = it->current_x + it->continuation_lines_width;
+ int next_tab_x = ((1 + x + tab_width - 1) / tab_width) * tab_width;
+
+ /* If the distance from the current position to the next tab
+ stop is less than a canonical character width, use the
+ tab stop after that. */
+ if (next_tab_x - x < FRAME_COLUMN_WIDTH (it->f))
+ next_tab_x += tab_width;
+
+ it->pixel_width = next_tab_x - x;
+ it->nglyphs = 1;
+ it->ascent = it->phys_ascent = FONT_BASE (font) + boff;
+ it->descent = it->phys_descent = FONT_DESCENT (font) - boff;
+
+ if (it->glyph_row)
+ {
+ double ascent = (double) it->ascent / (it->ascent + it->descent);
+ append_stretch_glyph (it, it->object, it->pixel_width,
+ it->ascent + it->descent, ascent);
+ }
+ }
+ else
+ {
+ /* A multi-byte character. Assume that the display width of the
+ character is the width of the character multiplied by the
+ width of the font. */
+
+ /* 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 = rif->per_char_metric (font, &char2b,
+ FONT_TYPE_FOR_MULTIBYTE (font, it->c));
+
+ if (font_not_found_p || !pcm)
+ {
- int charset = CHAR_CHARSET (it->char_to_display);
-
+ it->glyph_not_available_p = 1;
+ it->pixel_width = (FRAME_COLUMN_WIDTH (it->f)
- * CHARSET_WIDTH (charset));
++ * CHAR_WIDTH (it->char_to_display));
+ it->phys_ascent = FONT_BASE (font) + boff;
+ it->phys_descent = FONT_DESCENT (font) - boff;
+ }
+ else
+ {
+ it->pixel_width = pcm->width;
+ it->phys_ascent = pcm->ascent + boff;
+ it->phys_descent = pcm->descent - boff;
+ if (it->glyph_row
+ && (pcm->lbearing < 0
+ || pcm->rbearing > pcm->width))
+ it->glyph_row->contains_overlapping_glyphs_p = 1;
+ }
+ it->nglyphs = 1;
+ it->ascent = FONT_BASE (font) + boff;
+ it->descent = FONT_DESCENT (font) - boff;
+ if (face->box != FACE_NO_BOX)
+ {
+ int thick = face->box_line_width;
+
+ if (thick > 0)
+ {
+ it->ascent += thick;
+ it->descent += thick;
+ }
+ else
+ thick = - thick;
+
+ if (it->start_of_box_run_p)
+ it->pixel_width += thick;
+ if (it->end_of_box_run_p)
+ it->pixel_width += thick;
+ }
+
+ /* If face has an overline, add the height of the overline
+ (1 pixel) and a 1 pixel margin to the character height. */
+ if (face->overline_p)
+ it->ascent += 2;
+
+ take_vertical_position_into_account (it);
+
+ if (it->glyph_row)
+ append_glyph (it);
+ }
+ it->multibyte_p = saved_multibyte_p;
+ }
+ 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;
+ 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];
+
+ /* 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->c >= 0200)
+ {
+ 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;
+
+ /* When no suitable font found, use the default font. */
+ font_not_found_p = font == NULL;
+ if (font_not_found_p)
+ {
+ font = FRAME_FONT (it->f);
+ boff = FRAME_BASELINE_OFFSET (it->f);
+ font_info = NULL;
+ }
+ 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;
+
+ /* 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;
+ /* Bounding box of the overall glyphs. */
+ int leftmost, rightmost, lowest, highest;
+ int i, width, ascent, descent;
+
+ cmp->font = (void *) font;
+
+ /* Initialize the bounding box. */
+ if (font_info
+ && (pcm = rif->per_char_metric (font, &char2b,
+ FONT_TYPE_FOR_MULTIBYTE (font, it->c))))
+ {
+ width = pcm->width;
+ ascent = pcm->ascent;
+ descent = pcm->descent;
+ }
+ else
+ {
+ width = FONT_WIDTH (font);
+ ascent = FONT_BASE (font);
+ descent = FONT_DESCENT (font);
+ }
+
+ rightmost = width;
+ lowest = - descent + boff;
+ highest = ascent + boff;
+ leftmost = 0;
+
+ if (font_info
+ && font_info->default_ascent
+ && CHAR_TABLE_P (Vuse_default_ascent)
+ && !NILP (Faref (Vuse_default_ascent,
+ make_number (it->char_to_display))))
+ 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;
+
+ /* Set cmp->offsets for the remaining glyphs. */
+ for (i = 1; i < cmp->glyph_len; i++)
+ {
+ int left, right, btm, top;
+ int ch = COMPOSITION_GLYPH (cmp, i);
+ int face_id = FACE_FOR_CHAR (it->f, face, ch);
+
+ 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;
+ }
+ 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;
+ }
+
+ if (font_info
+ && (pcm = rif->per_char_metric (font, &char2b,
+ FONT_TYPE_FOR_MULTIBYTE (font, ch))))
+ {
+ width = pcm->width;
+ ascent = pcm->ascent;
+ descent = pcm->descent;
+ }
+ else
+ {
+ width = FONT_WIDTH (font);
+ ascent = 1;
+ descent = 0;
+ }
+
+ 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;
+
+ 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,
+ shift all glyphs to the right and make all x-offsets
+ non-negative. */
+ if (leftmost < 0)
+ {
+ for (i = 0; i < cmp->glyph_len; i++)
+ cmp->offsets[i * 2] -= leftmost;
+ rightmost -= leftmost;
+ }
+
+ cmp->pixel_width = rightmost;
+ cmp->ascent = highest;
+ cmp->descent = - lowest;
+ if (cmp->ascent < font_ascent)
+ cmp->ascent = font_ascent;
+ if (cmp->descent < font_descent)
+ cmp->descent = font_descent;
+ }
+
+ it->pixel_width = cmp->pixel_width;
+ it->ascent = it->phys_ascent = cmp->ascent;
+ it->descent = it->phys_descent = cmp->descent;
+
+ if (face->box != FACE_NO_BOX)
+ {
+ int thick = face->box_line_width;
+
+ if (thick > 0)
+ {
+ it->ascent += thick;
+ it->descent += thick;
+ }
+ else
+ thick = - thick;
+
+ if (it->start_of_box_run_p)
+ it->pixel_width += thick;
+ if (it->end_of_box_run_p)
+ it->pixel_width += thick;
+ }
+
+ /* If face has an overline, add the height of the overline
+ (1 pixel) and a 1 pixel margin to the character height. */
+ if (face->overline_p)
+ it->ascent += 2;
+
+ take_vertical_position_into_account (it);
+
+ if (it->glyph_row)
+ append_composite_glyph (it);
+ }
+ else if (it->what == IT_IMAGE)
+ produce_image_glyph (it);
+ else if (it->what == IT_STRETCH)
+ produce_stretch_glyph (it);
+
+ /* Accumulate dimensions. Note: can't assume that it->descent > 0
+ because this isn't true for images with `:ascent 100'. */
+ xassert (it->ascent >= 0 && it->descent >= 0);
+ if (it->area == TEXT_AREA)
+ it->current_x += it->pixel_width;
+
+ it->descent += it->extra_line_spacing;
+
+ it->max_ascent = max (it->max_ascent, it->ascent);
+ it->max_descent = max (it->max_descent, it->descent);
+ it->max_phys_ascent = max (it->max_phys_ascent, it->phys_ascent);
+ it->max_phys_descent = max (it->max_phys_descent, it->phys_descent);
+}
+
+/* EXPORT for RIF:
+ Output LEN glyphs starting at START at the nominal cursor position.
+ Advance the nominal cursor over the text. The global variable
+ updated_window contains the window being updated, updated_row is
+ the glyph row being updated, and updated_area is the area of that
+ row being updated. */
+
+void
+x_write_glyphs (start, len)
+ struct glyph *start;
+ int len;
+{
+ int x, hpos;
+
+ xassert (updated_window && updated_row);
+ BLOCK_INPUT;
+
+ /* Write glyphs. */
+
+ hpos = start - updated_row->glyphs[updated_area];
+ x = draw_glyphs (updated_window, output_cursor.x,
+ updated_row, updated_area,
+ hpos, hpos + len,
+ DRAW_NORMAL_TEXT, 0);
+
+ /* Invalidate old phys cursor if the glyph at its hpos is redrawn. */
+ if (updated_area == TEXT_AREA
+ && updated_window->phys_cursor_on_p
+ && updated_window->phys_cursor.vpos == output_cursor.vpos
+ && updated_window->phys_cursor.hpos >= hpos
+ && updated_window->phys_cursor.hpos < hpos + len)
+ updated_window->phys_cursor_on_p = 0;
+
+ UNBLOCK_INPUT;
+
+ /* Advance the output cursor. */
+ output_cursor.hpos += len;
+ output_cursor.x = x;
+}
+
+
+/* EXPORT for RIF:
+ Insert LEN glyphs from START at the nominal cursor position. */
+
+void
+x_insert_glyphs (start, len)
+ struct glyph *start;
+ int len;
+{
+ struct frame *f;
+ struct window *w;
+ int line_height, shift_by_width, shifted_region_width;
+ struct glyph_row *row;
+ struct glyph *glyph;
+ int frame_x, frame_y, hpos;
+
+ xassert (updated_window && updated_row);
+ BLOCK_INPUT;
+ w = updated_window;
+ f = XFRAME (WINDOW_FRAME (w));
+
+ /* Get the height of the line we are in. */
+ row = updated_row;
+ line_height = row->height;
+
+ /* Get the width of the glyphs to insert. */
+ shift_by_width = 0;
+ for (glyph = start; glyph < start + len; ++glyph)
+ shift_by_width += glyph->pixel_width;
+
+ /* Get the width of the region to shift right. */
+ shifted_region_width = (window_box_width (w, updated_area)
+ - output_cursor.x
+ - shift_by_width);
+
+ /* Shift right. */
+ frame_x = window_box_left (w, updated_area) + output_cursor.x;
+ frame_y = WINDOW_TO_FRAME_PIXEL_Y (w, output_cursor.y);
+
+ rif->shift_glyphs_for_insert (f, frame_x, frame_y, shifted_region_width,
+ line_height, shift_by_width);
+
+ /* Write the glyphs. */
+ hpos = start - row->glyphs[updated_area];
+ draw_glyphs (w, output_cursor.x, row, updated_area,
+ hpos, hpos + len,
+ DRAW_NORMAL_TEXT, 0);
+
+ /* Advance the output cursor. */
+ output_cursor.hpos += len;
+ output_cursor.x += shift_by_width;
+ UNBLOCK_INPUT;
+}
+
+
+/* EXPORT for RIF:
+ Erase the current text line from the nominal cursor position
+ (inclusive) to pixel column TO_X (exclusive). The idea is that
+ everything from TO_X onward is already erased.
+
+ TO_X is a pixel position relative to updated_area of
+ updated_window. TO_X == -1 means clear to the end of this area. */
+
+void
+x_clear_end_of_line (to_x)
+ int to_x;
+{
+ struct frame *f;
+ struct window *w = updated_window;
+ int max_x, min_y, max_y;
+ int from_x, from_y, to_y;
+
+ xassert (updated_window && updated_row);
+ f = XFRAME (w->frame);
+
+ if (updated_row->full_width_p)
+ max_x = WINDOW_TOTAL_WIDTH (w);
+ else
+ max_x = window_box_width (w, updated_area);
+ max_y = window_text_bottom_y (w);
+
+ /* TO_X == 0 means don't do anything. TO_X < 0 means clear to end
+ of window. For TO_X > 0, truncate to end of drawing area. */
+ if (to_x == 0)
+ return;
+ else if (to_x < 0)
+ to_x = max_x;
+ else
+ to_x = min (to_x, max_x);
+
+ to_y = min (max_y, output_cursor.y + updated_row->height);
+
+ /* Notice if the cursor will be cleared by this operation. */
+ if (!updated_row->full_width_p)
+ notice_overwritten_cursor (w, updated_area,
+ output_cursor.x, -1,
+ updated_row->y,
+ MATRIX_ROW_BOTTOM_Y (updated_row));
+
+ from_x = output_cursor.x;
+
+ /* Translate to frame coordinates. */
+ if (updated_row->full_width_p)
+ {
+ from_x = WINDOW_TO_FRAME_PIXEL_X (w, from_x);
+ to_x = WINDOW_TO_FRAME_PIXEL_X (w, to_x);
+ }
+ else
+ {
+ int area_left = window_box_left (w, updated_area);
+ from_x += area_left;
+ to_x += area_left;
+ }
+
+ min_y = WINDOW_HEADER_LINE_HEIGHT (w);
+ from_y = WINDOW_TO_FRAME_PIXEL_Y (w, max (min_y, output_cursor.y));
+ to_y = WINDOW_TO_FRAME_PIXEL_Y (w, to_y);
+
+ /* Prevent inadvertently clearing to end of the X window. */
+ if (to_x > from_x && to_y > from_y)
+ {
+ BLOCK_INPUT;
+ rif->clear_frame_area (f, from_x, from_y,
+ to_x - from_x, to_y - from_y);
+ UNBLOCK_INPUT;
+ }
+}
+
+#endif /* HAVE_WINDOW_SYSTEM */
+
+
+\f
+/***********************************************************************
+ Cursor types
+ ***********************************************************************/
+
+/* Value is the internal representation of the specified cursor type
+ ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
+ of the bar cursor. */
+
+enum text_cursor_kinds
+get_specified_cursor_type (arg, width)
+ Lisp_Object arg;
+ int *width;
+{
+ enum text_cursor_kinds type;
+
+ if (NILP (arg))
+ return NO_CURSOR;
+
+ if (EQ (arg, Qbox))
+ return FILLED_BOX_CURSOR;
+
+ if (EQ (arg, Qhollow))
+ return HOLLOW_BOX_CURSOR;
+
+ if (EQ (arg, Qbar))
+ {
+ *width = 2;
+ return BAR_CURSOR;
+ }
+
+ if (CONSP (arg)
+ && EQ (XCAR (arg), Qbar)
+ && INTEGERP (XCDR (arg))
+ && XINT (XCDR (arg)) >= 0)
+ {
+ *width = XINT (XCDR (arg));
+ return BAR_CURSOR;
+ }
+
+ if (EQ (arg, Qhbar))
+ {
+ *width = 2;
+ return HBAR_CURSOR;
+ }
+
+ if (CONSP (arg)
+ && EQ (XCAR (arg), Qhbar)
+ && INTEGERP (XCDR (arg))
+ && XINT (XCDR (arg)) >= 0)
+ {
+ *width = XINT (XCDR (arg));
+ return HBAR_CURSOR;
+ }
+
+ /* Treat anything unknown as "hollow box cursor".
+ It was bad to signal an error; people have trouble fixing
+ .Xdefaults with Emacs, when it has something bad in it. */
+ type = HOLLOW_BOX_CURSOR;
+
+ return type;
+}
+
+/* Set the default cursor types for specified frame. */
+void
+set_frame_cursor_types (f, arg)
+ struct frame *f;
+ Lisp_Object arg;
+{
+ int width;
+ Lisp_Object tem;
+
+ FRAME_DESIRED_CURSOR (f) = get_specified_cursor_type (arg, &width);
+ FRAME_CURSOR_WIDTH (f) = width;
+
+ /* By default, set up the blink-off state depending on the on-state. */
+
+ tem = Fassoc (arg, Vblink_cursor_alist);
+ if (!NILP (tem))
+ {
+ FRAME_BLINK_OFF_CURSOR (f)
+ = get_specified_cursor_type (XCDR (tem), &width);
+ FRAME_BLINK_OFF_CURSOR_WIDTH (f) = width;
+ }
+ else
+ FRAME_BLINK_OFF_CURSOR (f) = DEFAULT_CURSOR;
+}
+
+
+/* Return the cursor we want to be displayed in window W. Return
+ width of bar/hbar cursor through WIDTH arg. Return with
+ ACTIVE_CURSOR arg set to 1 if cursor in window W is `active'
+ (i.e. if the `system caret' should track this cursor).
+
+ In a mini-buffer window, we want the cursor only to appear if we
+ are reading input from this window. For the selected window, we
+ want the cursor type given by the frame parameter or buffer local
+ setting of cursor-type. If explicitly marked off, draw no cursor.
+ In all other cases, we want a hollow box cursor. */
+
+enum text_cursor_kinds
+get_window_cursor_type (w, width, active_cursor)
+ struct window *w;
+ int *width;
+ int *active_cursor;
+{
+ struct frame *f = XFRAME (w->frame);
+ struct buffer *b = XBUFFER (w->buffer);
+ int cursor_type = DEFAULT_CURSOR;
+ Lisp_Object alt_cursor;
+ int non_selected = 0;
+
+ *active_cursor = 1;
+
+ /* Echo area */
+ if (cursor_in_echo_area
+ && FRAME_HAS_MINIBUF_P (f)
+ && EQ (FRAME_MINIBUF_WINDOW (f), echo_area_window))
+ {
+ if (w == XWINDOW (echo_area_window))
+ {
+ *width = FRAME_CURSOR_WIDTH (f);
+ return FRAME_DESIRED_CURSOR (f);
+ }
+
+ *active_cursor = 0;
+ non_selected = 1;
+ }
+
+ /* Nonselected window or nonselected frame. */
+ else if (w != XWINDOW (f->selected_window)
+#ifdef HAVE_WINDOW_SYSTEM
+ || f != FRAME_X_DISPLAY_INFO (f)->x_highlight_frame
+#endif
+ )
+ {
+ *active_cursor = 0;
+
+ if (MINI_WINDOW_P (w) && minibuf_level == 0)
+ return NO_CURSOR;
+
+ non_selected = 1;
+ }
+
+ /* Never display a cursor in a window in which cursor-type is nil. */
+ if (NILP (b->cursor_type))
+ return NO_CURSOR;
+
+ /* Use cursor-in-non-selected-windows for non-selected window or frame. */
+ if (non_selected)
+ {
+ alt_cursor = Fbuffer_local_value (Qcursor_in_non_selected_windows, w->buffer);
+ return get_specified_cursor_type (alt_cursor, width);
+ }
+
+ /* Get the normal cursor type for this window. */
+ if (EQ (b->cursor_type, Qt))
+ {
+ cursor_type = FRAME_DESIRED_CURSOR (f);
+ *width = FRAME_CURSOR_WIDTH (f);
+ }
+ else
+ cursor_type = get_specified_cursor_type (b->cursor_type, width);
+
+ /* Use normal cursor if not blinked off. */
+ if (!w->cursor_off_p)
+ return cursor_type;
+
+ /* Cursor is blinked off, so determine how to "toggle" it. */
+
+ /* First look for an entry matching the buffer's cursor-type in blink-cursor-alist. */
+ if ((alt_cursor = Fassoc (b->cursor_type, Vblink_cursor_alist), !NILP (alt_cursor)))
+ return get_specified_cursor_type (XCDR (alt_cursor), width);
+
+ /* Then see if frame has specified a specific blink off cursor type. */
+ if (FRAME_BLINK_OFF_CURSOR (f) != DEFAULT_CURSOR)
+ {
+ *width = FRAME_BLINK_OFF_CURSOR_WIDTH (f);
+ return FRAME_BLINK_OFF_CURSOR (f);
+ }
+
+ /* Finally perform built-in cursor blinking:
+ filled box <-> hollow box
+ wide [h]bar <-> narrow [h]bar
+ narrow [h]bar <-> no cursor
+ other type <-> no cursor */
+
+ if (cursor_type == FILLED_BOX_CURSOR)
+ return HOLLOW_BOX_CURSOR;
+
+ if ((cursor_type == BAR_CURSOR || cursor_type == HBAR_CURSOR) && *width > 1)
+ {
+ *width = 1;
+ return cursor_type;
+ }
+
+ return NO_CURSOR;
+}
+
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* Notice when the text cursor of window W has been completely
+ overwritten by a drawing operation that outputs glyphs in AREA
+ starting at X0 and ending at X1 in the line starting at Y0 and
+ ending at Y1. X coordinates are area-relative. X1 < 0 means all
+ the rest of the line after X0 has been written. Y coordinates
+ are window-relative. */
+
+static void
+notice_overwritten_cursor (w, area, x0, x1, y0, y1)
+ struct window *w;
+ enum glyph_row_area area;
+ int x0, y0, x1, y1;
+{
+ if (area == TEXT_AREA && w->phys_cursor_on_p)
+ {
+ int cx0 = w->phys_cursor.x;
+ int cx1 = cx0 + w->phys_cursor_width;
+ int cy0 = w->phys_cursor.y;
+ int cy1 = cy0 + w->phys_cursor_height;
+
+ if (x0 <= cx0 && (x1 < 0 || x1 >= cx1))
+ {
+ /* The cursor image will be completely removed from the
+ screen if the output area intersects the cursor area in
+ y-direction. When we draw in [y0 y1[, and some part of
+ the cursor is at y < y0, that part must have been drawn
+ before. When scrolling, the cursor is erased before
+ actually scrolling, so we don't come here. When not
+ scrolling, the rows above the old cursor row must have
+ changed, and in this case these rows must have written
+ over the cursor image.
+
+ Likewise if part of the cursor is below y1, with the
+ exception of the cursor being in the first blank row at
+ the buffer and window end because update_text_area
+ doesn't draw that row. (Except when it does, but
+ that's handled in update_text_area.) */
+
+ if (((y0 >= cy0 && y0 < cy1) || (y1 > cy0 && y1 < cy1))
+ && w->current_matrix->rows[w->phys_cursor.vpos].displays_text_p)
+ w->phys_cursor_on_p = 0;
+ }
+ }
+}
+
+#endif /* HAVE_WINDOW_SYSTEM */
+
+\f
+/************************************************************************
+ Mouse Face
+ ************************************************************************/
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* EXPORT for RIF:
+ Fix the display of area AREA of overlapping row ROW in window W. */
+
+void
+x_fix_overlapping_area (w, row, area)
+ struct window *w;
+ struct glyph_row *row;
+ enum glyph_row_area area;
+{
+ int i, x;
+
+ BLOCK_INPUT;
+
+ x = 0;
+ for (i = 0; i < row->used[area];)
+ {
+ if (row->glyphs[area][i].overlaps_vertically_p)
+ {
+ int start = i, start_x = x;
+
+ do
+ {
+ x += row->glyphs[area][i].pixel_width;
+ ++i;
+ }
+ while (i < row->used[area]
+ && row->glyphs[area][i].overlaps_vertically_p);
+
+ draw_glyphs (w, start_x, row, area,
+ start, i,
+ DRAW_NORMAL_TEXT, 1);
+ }
+ else
+ {
+ x += row->glyphs[area][i].pixel_width;
+ ++i;
+ }
+ }
+
+ UNBLOCK_INPUT;
+}
+
+
+/* EXPORT:
+ Draw the cursor glyph of window W in glyph row ROW. See the
+ comment of draw_glyphs for the meaning of HL. */
+
+void
+draw_phys_cursor_glyph (w, row, hl)
+ struct window *w;
+ struct glyph_row *row;
+ enum draw_glyphs_face hl;
+{
+ /* If cursor hpos is out of bounds, don't draw garbage. This can
+ happen in mini-buffer windows when switching between echo area
+ glyphs and mini-buffer. */
+ if (w->phys_cursor.hpos < row->used[TEXT_AREA])
+ {
+ int on_p = w->phys_cursor_on_p;
+ int x1;
+ x1 = draw_glyphs (w, w->phys_cursor.x, row, TEXT_AREA,
+ w->phys_cursor.hpos, w->phys_cursor.hpos + 1,
+ hl, 0);
+ w->phys_cursor_on_p = on_p;
+
+ if (hl == DRAW_CURSOR)
+ w->phys_cursor_width = x1 - w->phys_cursor.x;
+ /* When we erase the cursor, and ROW is overlapped by other
+ rows, make sure that these overlapping parts of other rows
+ are redrawn. */
+ else if (hl == DRAW_NORMAL_TEXT && row->overlapped_p)
+ {
+ if (row > w->current_matrix->rows
+ && MATRIX_ROW_OVERLAPS_SUCC_P (row - 1))
+ x_fix_overlapping_area (w, row - 1, TEXT_AREA);
+
+ if (MATRIX_ROW_BOTTOM_Y (row) < window_text_bottom_y (w)
+ && MATRIX_ROW_OVERLAPS_PRED_P (row + 1))
+ x_fix_overlapping_area (w, row + 1, TEXT_AREA);
+ }
+ }
+}
+
+
+/* EXPORT:
+ Erase the image of a cursor of window W from the screen. */
+
+void
+erase_phys_cursor (w)
+ struct window *w;
+{
+ struct frame *f = XFRAME (w->frame);
+ Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ int hpos = w->phys_cursor.hpos;
+ int vpos = w->phys_cursor.vpos;
+ int mouse_face_here_p = 0;
+ struct glyph_matrix *active_glyphs = w->current_matrix;
+ struct glyph_row *cursor_row;
+ struct glyph *cursor_glyph;
+ enum draw_glyphs_face hl;
+
+ /* No cursor displayed or row invalidated => nothing to do on the
+ screen. */
+ if (w->phys_cursor_type == NO_CURSOR)
+ goto mark_cursor_off;
+
+ /* VPOS >= active_glyphs->nrows means that window has been resized.
+ Don't bother to erase the cursor. */
+ if (vpos >= active_glyphs->nrows)
+ goto mark_cursor_off;
+
+ /* If row containing cursor is marked invalid, there is nothing we
+ can do. */
+ cursor_row = MATRIX_ROW (active_glyphs, vpos);
+ if (!cursor_row->enabled_p)
+ goto mark_cursor_off;
+
+ /* If row is completely invisible, don't attempt to delete a cursor which
+ isn't there. This can happen if cursor is at top of a window, and
+ we switch to a buffer with a header line in that window. */
+ if (cursor_row->visible_height <= 0)
+ goto mark_cursor_off;
+
+ /* This can happen when the new row is shorter than the old one.
+ In this case, either draw_glyphs or clear_end_of_line
+ should have cleared the cursor. Note that we wouldn't be
+ able to erase the cursor in this case because we don't have a
+ cursor glyph at hand. */
+ if (w->phys_cursor.hpos >= cursor_row->used[TEXT_AREA])
+ goto mark_cursor_off;
+
+ /* If the cursor is in the mouse face area, redisplay that when
+ we clear the cursor. */
+ if (! NILP (dpyinfo->mouse_face_window)
+ && w == XWINDOW (dpyinfo->mouse_face_window)
+ && (vpos > dpyinfo->mouse_face_beg_row
+ || (vpos == dpyinfo->mouse_face_beg_row
+ && hpos >= dpyinfo->mouse_face_beg_col))
+ && (vpos < dpyinfo->mouse_face_end_row
+ || (vpos == dpyinfo->mouse_face_end_row
+ && hpos < dpyinfo->mouse_face_end_col))
+ /* Don't redraw the cursor's spot in mouse face if it is at the
+ end of a line (on a newline). The cursor appears there, but
+ mouse highlighting does not. */
+ && cursor_row->used[TEXT_AREA] > hpos)
+ mouse_face_here_p = 1;
+
+ /* Maybe clear the display under the cursor. */
+ if (w->phys_cursor_type == HOLLOW_BOX_CURSOR)
+ {
+ int x, y;
+ int header_line_height = WINDOW_HEADER_LINE_HEIGHT (w);
+
+ cursor_glyph = get_phys_cursor_glyph (w);
+ if (cursor_glyph == NULL)
+ goto mark_cursor_off;
+
+ x = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x);
+ y = WINDOW_TO_FRAME_PIXEL_Y (w, max (header_line_height, cursor_row->y));
+
+ rif->clear_frame_area (f, x, y,
+ cursor_glyph->pixel_width, cursor_row->visible_height);
+ }
+
+ /* Erase the cursor by redrawing the character underneath it. */
+ if (mouse_face_here_p)
+ hl = DRAW_MOUSE_FACE;
+ else
+ hl = DRAW_NORMAL_TEXT;
+ draw_phys_cursor_glyph (w, cursor_row, hl);
+
+ mark_cursor_off:
+ w->phys_cursor_on_p = 0;
+ w->phys_cursor_type = NO_CURSOR;
+}
+
+
+/* EXPORT:
+ Display or clear cursor of window W. If ON is zero, clear the
+ cursor. If it is non-zero, display the cursor. If ON is nonzero,
+ where to put the cursor is specified by HPOS, VPOS, X and Y. */
+
+void
+display_and_set_cursor (w, on, hpos, vpos, x, y)
+ struct window *w;
+ int on, hpos, vpos, x, y;
+{
+ struct frame *f = XFRAME (w->frame);
+ int new_cursor_type;
+ int new_cursor_width;
+ int active_cursor;
+ struct glyph_matrix *current_glyphs;
+ struct glyph_row *glyph_row;
+ struct glyph *glyph;
+
+ /* This is pointless on invisible frames, and dangerous on garbaged
+ windows and frames; in the latter case, the frame or window may
+ be in the midst of changing its size, and x and y may be off the
+ window. */
+ if (! FRAME_VISIBLE_P (f)
+ || FRAME_GARBAGED_P (f)
+ || vpos >= w->current_matrix->nrows
+ || hpos >= w->current_matrix->matrix_w)
+ return;
+
+ /* If cursor is off and we want it off, return quickly. */
+ if (!on && !w->phys_cursor_on_p)
+ return;
+
+ current_glyphs = w->current_matrix;
+ glyph_row = MATRIX_ROW (current_glyphs, vpos);
+ glyph = glyph_row->glyphs[TEXT_AREA] + hpos;
+
+ /* If cursor row is not enabled, we don't really know where to
+ display the cursor. */
+ if (!glyph_row->enabled_p)
+ {
+ w->phys_cursor_on_p = 0;
+ return;
+ }
+
+ xassert (interrupt_input_blocked);
+
+ /* Set new_cursor_type to the cursor we want to be displayed. */
+ new_cursor_type = get_window_cursor_type (w, &new_cursor_width, &active_cursor);
+
+ /* If cursor is currently being shown and we don't want it to be or
+ it is in the wrong place, or the cursor type is not what we want,
+ erase it. */
+ if (w->phys_cursor_on_p
+ && (!on
+ || w->phys_cursor.x != x
+ || w->phys_cursor.y != y
+ || new_cursor_type != w->phys_cursor_type
+ || ((new_cursor_type == BAR_CURSOR || new_cursor_type == HBAR_CURSOR)
+ && new_cursor_width != w->phys_cursor_width)))
+ erase_phys_cursor (w);
+
+ /* Don't check phys_cursor_on_p here because that flag is only set
+ to zero in some cases where we know that the cursor has been
+ completely erased, to avoid the extra work of erasing the cursor
+ twice. In other words, phys_cursor_on_p can be 1 and the cursor
+ still not be visible, or it has only been partly erased. */
+ if (on)
+ {
+ w->phys_cursor_ascent = glyph_row->ascent;
+ w->phys_cursor_height = glyph_row->height;
+
+ /* Set phys_cursor_.* before x_draw_.* is called because some
+ of them may need the information. */
+ w->phys_cursor.x = x;
+ w->phys_cursor.y = glyph_row->y;
+ w->phys_cursor.hpos = hpos;
+ w->phys_cursor.vpos = vpos;
+ }
+
+ rif->draw_window_cursor (w, glyph_row, x, y,
+ new_cursor_type, new_cursor_width,
+ on, active_cursor);
+}
+
+
+/* Switch the display of W's cursor on or off, according to the value
+ of ON. */
+
+static void
+update_window_cursor (w, on)
+ struct window *w;
+ int on;
+{
+ /* Don't update cursor in windows whose frame is in the process
+ of being deleted. */
+ if (w->current_matrix)
+ {
+ BLOCK_INPUT;
+ display_and_set_cursor (w, on, w->phys_cursor.hpos, w->phys_cursor.vpos,
+ w->phys_cursor.x, w->phys_cursor.y);
+ UNBLOCK_INPUT;
+ }
+}
+
+
+/* Call update_window_cursor with parameter ON_P on all leaf windows
+ in the window tree rooted at W. */
+
+static void
+update_cursor_in_window_tree (w, on_p)
+ struct window *w;
+ int on_p;
+{
+ while (w)
+ {
+ if (!NILP (w->hchild))
+ update_cursor_in_window_tree (XWINDOW (w->hchild), on_p);
+ else if (!NILP (w->vchild))
+ update_cursor_in_window_tree (XWINDOW (w->vchild), on_p);
+ else
+ update_window_cursor (w, on_p);
+
+ w = NILP (w->next) ? 0 : XWINDOW (w->next);
+ }
+}
+
+
+/* EXPORT:
+ Display the cursor on window W, or clear it, according to ON_P.
+ Don't change the cursor's position. */
+
+void
+x_update_cursor (f, on_p)
+ struct frame *f;
+ int on_p;
+{
+ update_cursor_in_window_tree (XWINDOW (f->root_window), on_p);
+}
+
+
+/* EXPORT:
+ Clear the cursor of window W to background color, and mark the
+ cursor as not shown. This is used when the text where the cursor
+ is is about to be rewritten. */
+
+void
+x_clear_cursor (w)
+ struct window *w;
+{
+ if (FRAME_VISIBLE_P (XFRAME (w->frame)) && w->phys_cursor_on_p)
+ update_window_cursor (w, 0);
+}
+
+
+/* EXPORT:
+ Display the active region described by mouse_face_* according to DRAW. */
+
+void
+show_mouse_face (dpyinfo, draw)
+ Display_Info *dpyinfo;
+ enum draw_glyphs_face draw;
+{
+ struct window *w = XWINDOW (dpyinfo->mouse_face_window);
+ struct frame *f = XFRAME (WINDOW_FRAME (w));
+
+ if (/* If window is in the process of being destroyed, don't bother
+ to do anything. */
+ w->current_matrix != NULL
+ /* Don't update mouse highlight if hidden */
+ && (draw != DRAW_MOUSE_FACE || !dpyinfo->mouse_face_hidden)
+ /* Recognize when we are called to operate on rows that don't exist
+ anymore. This can happen when a window is split. */
+ && dpyinfo->mouse_face_end_row < w->current_matrix->nrows)
+ {
+ int phys_cursor_on_p = w->phys_cursor_on_p;
+ struct glyph_row *row, *first, *last;
+
+ first = MATRIX_ROW (w->current_matrix, dpyinfo->mouse_face_beg_row);
+ last = MATRIX_ROW (w->current_matrix, dpyinfo->mouse_face_end_row);
+
+ for (row = first; row <= last && row->enabled_p; ++row)
+ {
+ int start_hpos, end_hpos, start_x;
+
+ /* For all but the first row, the highlight starts at column 0. */
+ if (row == first)
+ {
+ start_hpos = dpyinfo->mouse_face_beg_col;
+ start_x = dpyinfo->mouse_face_beg_x;
+ }
+ else
+ {
+ start_hpos = 0;
+ start_x = 0;
+ }
+
+ if (row == last)
+ end_hpos = dpyinfo->mouse_face_end_col;
+ else
+ end_hpos = row->used[TEXT_AREA];
+
+ if (end_hpos > start_hpos)
+ {
+ draw_glyphs (w, start_x, row, TEXT_AREA,
+ start_hpos, end_hpos,
+ draw, 0);
+
+ row->mouse_face_p
+ = draw == DRAW_MOUSE_FACE || draw == DRAW_IMAGE_RAISED;
+ }
+ }
+
+ /* When we've written over the cursor, arrange for it to
+ be displayed again. */
+ if (phys_cursor_on_p && !w->phys_cursor_on_p)
+ {
+ BLOCK_INPUT;
+ display_and_set_cursor (w, 1,
+ w->phys_cursor.hpos, w->phys_cursor.vpos,
+ w->phys_cursor.x, w->phys_cursor.y);
+ UNBLOCK_INPUT;
+ }
+ }
+
+ /* Change the mouse cursor. */
+ if (draw == DRAW_NORMAL_TEXT)
+ rif->define_frame_cursor (f, FRAME_X_OUTPUT (f)->text_cursor);
+ else if (draw == DRAW_MOUSE_FACE)
+ rif->define_frame_cursor (f, FRAME_X_OUTPUT (f)->hand_cursor);
+ else
+ rif->define_frame_cursor (f, FRAME_X_OUTPUT (f)->nontext_cursor);
+}
+
+/* EXPORT:
+ Clear out the mouse-highlighted active region.
+ Redraw it un-highlighted first. Value is non-zero if mouse
+ face was actually drawn unhighlighted. */
+
+int
+clear_mouse_face (dpyinfo)
+ Display_Info *dpyinfo;
+{
+ int cleared = 0;
+
+ if (!NILP (dpyinfo->mouse_face_window))
+ {
+ show_mouse_face (dpyinfo, DRAW_NORMAL_TEXT);
+ cleared = 1;
+ }
+
+ dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1;
+ dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1;
+ dpyinfo->mouse_face_window = Qnil;
+ dpyinfo->mouse_face_overlay = Qnil;
+ return cleared;
+}
+
+
+/* EXPORT:
+ Non-zero if physical cursor of window W is within mouse face. */
+
+int
+cursor_in_mouse_face_p (w)
+ struct window *w;
+{
+ Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (XFRAME (w->frame));
+ int in_mouse_face = 0;
+
+ if (WINDOWP (dpyinfo->mouse_face_window)
+ && XWINDOW (dpyinfo->mouse_face_window) == w)
+ {
+ int hpos = w->phys_cursor.hpos;
+ int vpos = w->phys_cursor.vpos;
+
+ if (vpos >= dpyinfo->mouse_face_beg_row
+ && vpos <= dpyinfo->mouse_face_end_row
+ && (vpos > dpyinfo->mouse_face_beg_row
+ || hpos >= dpyinfo->mouse_face_beg_col)
+ && (vpos < dpyinfo->mouse_face_end_row
+ || hpos < dpyinfo->mouse_face_end_col
+ || dpyinfo->mouse_face_past_end))
+ in_mouse_face = 1;
+ }
+
+ return in_mouse_face;
+}
+
+
+
+\f
+/* Find the glyph matrix position of buffer position CHARPOS in window
+ *W. HPOS, *VPOS, *X, and *Y are set to the positions found. W's
+ current glyphs must be up to date. If CHARPOS is above window
+ start return (0, 0, 0, 0). If CHARPOS is after end of W, return end
+ of last line in W. In the row containing CHARPOS, stop before glyphs
+ having STOP as object. */
+
+#if 1 /* This is a version of fast_find_position that's more correct
+ in the presence of hscrolling, for example. I didn't install
+ it right away because the problem fixed is minor, it failed
+ in 20.x as well, and I think it's too risky to install
+ so near the release of 21.1. 2001-09-25 gerd. */
+
+static int
+fast_find_position (w, charpos, hpos, vpos, x, y, stop)
+ struct window *w;
+ int charpos;
+ int *hpos, *vpos, *x, *y;
+ Lisp_Object stop;
+{
+ struct glyph_row *row, *first;
+ struct glyph *glyph, *end;
+ int past_end = 0;
+
+ first = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
+ row = row_containing_pos (w, charpos, first, NULL, 0);
+ if (row == NULL)
+ {
+ if (charpos < MATRIX_ROW_START_CHARPOS (first))
+ {
+ *x = *y = *hpos = *vpos = 0;
+ return 0;
+ }
+ else
+ {
+ row = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos));
+ past_end = 1;
+ }
+ }
+
+ *x = row->x;
+ *y = row->y;
+ *vpos = MATRIX_ROW_VPOS (row, w->current_matrix);
+
+ glyph = row->glyphs[TEXT_AREA];
+ end = glyph + row->used[TEXT_AREA];
+
+ /* Skip over glyphs not having an object at the start of the row.
+ These are special glyphs like truncation marks on terminal
+ frames. */
+ if (row->displays_text_p)
+ while (glyph < end
+ && INTEGERP (glyph->object)
+ && !EQ (stop, glyph->object)
+ && glyph->charpos < 0)
+ {
+ *x += glyph->pixel_width;
+ ++glyph;
+ }
+
+ while (glyph < end
+ && !INTEGERP (glyph->object)
+ && !EQ (stop, glyph->object)
+ && (!BUFFERP (glyph->object)
+ || glyph->charpos < charpos))
+ {
+ *x += glyph->pixel_width;
+ ++glyph;
+ }
+
+ *hpos = glyph - row->glyphs[TEXT_AREA];
+ return past_end;
+}
+
+#else /* not 1 */
+
+static int
+fast_find_position (w, pos, hpos, vpos, x, y, stop)
+ struct window *w;
+ int pos;
+ int *hpos, *vpos, *x, *y;
+ Lisp_Object stop;
+{
+ int i;
+ int lastcol;
+ int maybe_next_line_p = 0;
+ int line_start_position;
+ int yb = window_text_bottom_y (w);
+ struct glyph_row *row, *best_row;
+ int row_vpos, best_row_vpos;
+ int current_x;
+
+ row = best_row = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
+ row_vpos = best_row_vpos = MATRIX_ROW_VPOS (row, w->current_matrix);
+
+ while (row->y < yb)
+ {
+ if (row->used[TEXT_AREA])
+ line_start_position = row->glyphs[TEXT_AREA]->charpos;
+ else
+ line_start_position = 0;
+
+ if (line_start_position > pos)
+ break;
+ /* If the position sought is the end of the buffer,
+ don't include the blank lines at the bottom of the window. */
+ else if (line_start_position == pos
+ && pos == BUF_ZV (XBUFFER (w->buffer)))
+ {
+ maybe_next_line_p = 1;
+ break;
+ }
+ else if (line_start_position > 0)
+ {
+ best_row = row;
+ best_row_vpos = row_vpos;
+ }
+
+ if (row->y + row->height >= yb)
+ break;
+
+ ++row;
+ ++row_vpos;
+ }
+
+ /* Find the right column within BEST_ROW. */
+ lastcol = 0;
+ current_x = best_row->x;
+ for (i = 0; i < best_row->used[TEXT_AREA]; i++)
+ {
+ struct glyph *glyph = best_row->glyphs[TEXT_AREA] + i;
+ int charpos = glyph->charpos;
+
+ if (BUFFERP (glyph->object))
+ {
+ if (charpos == pos)
+ {
+ *hpos = i;
+ *vpos = best_row_vpos;
+ *x = current_x;
+ *y = best_row->y;
+ return 1;
+ }
+ else if (charpos > pos)
+ break;
+ }
+ else if (EQ (glyph->object, stop))
+ break;
+
+ if (charpos > 0)
+ lastcol = i;
+ current_x += glyph->pixel_width;
+ }
+
+ /* If we're looking for the end of the buffer,
+ and we didn't find it in the line we scanned,
+ use the start of the following line. */
+ if (maybe_next_line_p)
+ {
+ ++best_row;
+ ++best_row_vpos;
+ lastcol = 0;
+ current_x = best_row->x;
+ }
+
+ *vpos = best_row_vpos;
+ *hpos = lastcol + 1;
+ *x = current_x;
+ *y = best_row->y;
+ return 0;
+}
+
+#endif /* not 1 */
+
+
+/* Find the position of the glyph for position POS in OBJECT in
+ window W's current matrix, and return in *X, *Y the pixel
+ coordinates, and return in *HPOS, *VPOS the column/row of the glyph.
+
+ RIGHT_P non-zero means return the position of the right edge of the
+ glyph, RIGHT_P zero means return the left edge position.
+
+ If no glyph for POS exists in the matrix, return the position of
+ the glyph with the next smaller position that is in the matrix, if
+ RIGHT_P is zero. If RIGHT_P is non-zero, and no glyph for POS
+ exists in the matrix, return the position of the glyph with the
+ next larger position in OBJECT.
+
+ Value is non-zero if a glyph was found. */
+
+static int
+fast_find_string_pos (w, pos, object, hpos, vpos, x, y, right_p)
+ struct window *w;
+ int pos;
+ Lisp_Object object;
+ int *hpos, *vpos, *x, *y;
+ int right_p;
+{
+ int yb = window_text_bottom_y (w);
+ struct glyph_row *r;
+ struct glyph *best_glyph = NULL;
+ struct glyph_row *best_row = NULL;
+ int best_x = 0;
+
+ for (r = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
+ r->enabled_p && r->y < yb;
+ ++r)
+ {
+ struct glyph *g = r->glyphs[TEXT_AREA];
+ struct glyph *e = g + r->used[TEXT_AREA];
+ int gx;
+
+ for (gx = r->x; g < e; gx += g->pixel_width, ++g)
+ if (EQ (g->object, object))
+ {
+ if (g->charpos == pos)
+ {
+ best_glyph = g;
+ best_x = gx;
+ best_row = r;
+ goto found;
+ }
+ else if (best_glyph == NULL
+ || ((abs (g->charpos - pos)
+ < abs (best_glyph->charpos - pos))
+ && (right_p
+ ? g->charpos < pos
+ : g->charpos > pos)))
+ {
+ best_glyph = g;
+ best_x = gx;
+ best_row = r;
+ }
+ }
+ }
+
+ found:
+
+ if (best_glyph)
+ {
+ *x = best_x;
+ *hpos = best_glyph - best_row->glyphs[TEXT_AREA];
+
+ if (right_p)
+ {
+ *x += best_glyph->pixel_width;
+ ++*hpos;
+ }
+
+ *y = best_row->y;
+ *vpos = best_row - w->current_matrix->rows;
+ }
+
+ return best_glyph != NULL;
+}
+
+
+/* Take proper action when mouse has moved to the mode or header line
+ or marginal area AREA of window W, x-position X and y-position Y.
+ X is relative to the start of the text display area of W, so the
+ width of bitmap areas and scroll bars must be subtracted to get a
+ position relative to the start of the mode line. */
+
+static void
+note_mode_line_or_margin_highlight (w, x, y, area)
+ struct window *w;
+ int x, y;
+ enum window_part area;
+{
+ struct frame *f = XFRAME (w->frame);
+ Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ Cursor cursor = dpyinfo->vertical_scroll_bar_cursor;
+ int charpos;
+ Lisp_Object string, help, map, pos;
+
+ if (area == ON_MODE_LINE || area == ON_HEADER_LINE)
+ string = mode_line_string (w, x, y, area, &charpos);
+ else
+ string = marginal_area_string (w, x, y, area, &charpos);
+
+ if (STRINGP (string))
+ {
+ pos = make_number (charpos);
+
+ /* If we're on a string with `help-echo' text property, arrange
+ for the help to be displayed. This is done by setting the
+ global variable help_echo_string to the help string. */
+ help = Fget_text_property (pos, Qhelp_echo, string);
+ if (!NILP (help))
+ {
+ help_echo_string = help;
+ XSETWINDOW (help_echo_window, w);
+ help_echo_object = string;
+ help_echo_pos = charpos;
+ }
+
+ /* Change the mouse pointer according to what is under X/Y. */
+ map = Fget_text_property (pos, Qlocal_map, string);
+ if (!KEYMAPP (map))
+ map = Fget_text_property (pos, Qkeymap, string);
+ if (KEYMAPP (map))
+ cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
+ }
+
+ rif->define_frame_cursor (f, cursor);
+}
+
+
+/* EXPORT:
+ Take proper action when the mouse has moved to position X, Y on
+ frame F as regards highlighting characters that have mouse-face
+ properties. Also de-highlighting chars where the mouse was before.
+ X and Y can be negative or out of range. */
+
+void
+note_mouse_highlight (f, x, y)
+ struct frame *f;
+ int x, y;
+{
+ Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ enum window_part part;
+ Lisp_Object window;
+ struct window *w;
+ Cursor cursor = No_Cursor;
+ struct buffer *b;
+
+ /* When a menu is active, don't highlight because this looks odd. */
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI)
+ if (popup_activated ())
+ return;
+#endif
+
+ if (NILP (Vmouse_highlight)
+ || !f->glyphs_initialized_p)
+ return;
+
+ dpyinfo->mouse_face_mouse_x = x;
+ dpyinfo->mouse_face_mouse_y = y;
+ dpyinfo->mouse_face_mouse_frame = f;
+
+ if (dpyinfo->mouse_face_defer)
+ return;
+
+ if (gc_in_progress)
+ {
+ dpyinfo->mouse_face_deferred_gc = 1;
+ return;
+ }
+
+ /* Which window is that in? */
+ window = window_from_coordinates (f, x, y, &part, 0, 0, 1);
+
+ /* If we were displaying active text in another window, clear that. */
+ if (! EQ (window, dpyinfo->mouse_face_window))
+ clear_mouse_face (dpyinfo);
+
+ /* Not on a window -> return. */
+ if (!WINDOWP (window))
+ return;
+
+ /* Reset help_echo_string. It will get recomputed below. */
+ /* ++KFS: X version didn't do this, but it looks harmless. */
+ help_echo_string = Qnil;
+
+ /* Convert to window-relative pixel coordinates. */
+ w = XWINDOW (window);
+ frame_to_window_pixel_xy (w, &x, &y);
+
+ /* Handle tool-bar window differently since it doesn't display a
+ buffer. */
+ if (EQ (window, f->tool_bar_window))
+ {
+ note_tool_bar_highlight (f, x, y);
+ return;
+ }
+
+ /* Mouse is on the mode, header line or margin? */
+ if (part == ON_MODE_LINE || part == ON_HEADER_LINE
+ || part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN)
+ {
+ note_mode_line_or_margin_highlight (w, x, y, part);
+ return;
+ }
+
+ if (part == ON_VERTICAL_BORDER)
+ cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor;
+ else
+ cursor = FRAME_X_OUTPUT (f)->text_cursor;
+
+ /* Are we in a window whose display is up to date?
+ And verify the buffer's text has not changed. */
+ b = XBUFFER (w->buffer);
+ if (part == ON_TEXT
+ && EQ (w->window_end_valid, w->buffer)
+ && XFASTINT (w->last_modified) == BUF_MODIFF (b)
+ && XFASTINT (w->last_overlay_modified) == BUF_OVERLAY_MODIFF (b))
+ {
+ int hpos, vpos, pos, i, area;
+ struct glyph *glyph;
+ Lisp_Object object;
+ Lisp_Object mouse_face = Qnil, overlay = Qnil, position;
+ Lisp_Object *overlay_vec = NULL;
+ int len, noverlays;
+ struct buffer *obuf;
+ int obegv, ozv, same_region;
+
+ /* Find the glyph under X/Y. */
+ glyph = x_y_to_hpos_vpos (w, x, y, &hpos, &vpos, &area, 0);
+
+ /* Clear mouse face if X/Y not over text. */
+ if (glyph == NULL
+ || area != TEXT_AREA
+ || !MATRIX_ROW (w->current_matrix, vpos)->displays_text_p)
+ {
+#if defined (HAVE_NTGUI)
+ /* ++KFS: Why is this necessary on W32 ? */
+ clear_mouse_face (dpyinfo);
+ cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
+#else
+ if (clear_mouse_face (dpyinfo))
+ cursor = No_Cursor;
+#endif
+ goto set_cursor;
+ }
+
+ pos = glyph->charpos;
+ object = glyph->object;
+ if (!STRINGP (object) && !BUFFERP (object))
+ goto set_cursor;
+
+ /* If we get an out-of-range value, return now; avoid an error. */
+ if (BUFFERP (object) && pos > BUF_Z (b))
+ goto set_cursor;
+
+ /* Make the window's buffer temporarily current for
+ overlays_at and compute_char_face. */
+ obuf = current_buffer;
+ current_buffer = b;
+ obegv = BEGV;
+ ozv = ZV;
+ BEGV = BEG;
+ ZV = Z;
+
+ /* Is this char mouse-active or does it have help-echo? */
+ position = make_number (pos);
+
+ if (BUFFERP (object))
+ {
+ /* Put all the overlays we want in a vector in overlay_vec.
+ Store the length in len. If there are more than 10, make
+ enough space for all, and try again. */
+ len = 10;
+ overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
+ noverlays = overlays_at (pos, 0, &overlay_vec, &len, NULL, NULL, 0);
+ if (noverlays > len)
+ {
+ len = noverlays;
+ overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
+ noverlays = overlays_at (pos, 0, &overlay_vec, &len, NULL, NULL,0);
+ }
+
+ /* Sort overlays into increasing priority order. */
+ noverlays = sort_overlays (overlay_vec, noverlays, w);
+ }
+ else
+ noverlays = 0;
+
+ same_region = (EQ (window, dpyinfo->mouse_face_window)
+ && vpos >= dpyinfo->mouse_face_beg_row
+ && vpos <= dpyinfo->mouse_face_end_row
+ && (vpos > dpyinfo->mouse_face_beg_row
+ || hpos >= dpyinfo->mouse_face_beg_col)
+ && (vpos < dpyinfo->mouse_face_end_row
+ || hpos < dpyinfo->mouse_face_end_col
+ || dpyinfo->mouse_face_past_end));
+
+ if (same_region)
+ cursor = No_Cursor;
+
+ /* Check mouse-face highlighting. */
+ if (! same_region
+ /* If there exists an overlay with mouse-face overlapping
+ the one we are currently highlighting, we have to
+ check if we enter the overlapping overlay, and then
+ highlight only that. */
+ || (OVERLAYP (dpyinfo->mouse_face_overlay)
+ && mouse_face_overlay_overlaps (dpyinfo->mouse_face_overlay)))
+ {
+ /* Find the highest priority overlay that has a mouse-face
+ property. */
+ overlay = Qnil;
+ for (i = noverlays - 1; i >= 0 && NILP (overlay); --i)
+ {
+ mouse_face = Foverlay_get (overlay_vec[i], Qmouse_face);
+ if (!NILP (mouse_face))
+ overlay = overlay_vec[i];
+ }
+
+ /* If we're actually highlighting the same overlay as
+ before, there's no need to do that again. */
+ if (!NILP (overlay)
+ && EQ (overlay, dpyinfo->mouse_face_overlay))
+ goto check_help_echo;
+
+ dpyinfo->mouse_face_overlay = overlay;
+
+ /* Clear the display of the old active region, if any. */
+ if (clear_mouse_face (dpyinfo))
+ cursor = No_Cursor;
+
+ /* If no overlay applies, get a text property. */
+ if (NILP (overlay))
+ mouse_face = Fget_text_property (position, Qmouse_face, object);
+
+ /* Handle the overlay case. */
+ if (!NILP (overlay))
+ {
+ /* Find the range of text around this char that
+ should be active. */
+ Lisp_Object before, after;
+ int ignore;
+
+ before = Foverlay_start (overlay);
+ after = Foverlay_end (overlay);
+ /* Record this as the current active region. */
+ fast_find_position (w, XFASTINT (before),
+ &dpyinfo->mouse_face_beg_col,
+ &dpyinfo->mouse_face_beg_row,
+ &dpyinfo->mouse_face_beg_x,
+ &dpyinfo->mouse_face_beg_y, Qnil);
+
+ dpyinfo->mouse_face_past_end
+ = !fast_find_position (w, XFASTINT (after),
+ &dpyinfo->mouse_face_end_col,
+ &dpyinfo->mouse_face_end_row,
+ &dpyinfo->mouse_face_end_x,
+ &dpyinfo->mouse_face_end_y, Qnil);
+ dpyinfo->mouse_face_window = window;
+
+ dpyinfo->mouse_face_face_id
+ = face_at_buffer_position (w, pos, 0, 0,
+ &ignore, pos + 1,
+ !dpyinfo->mouse_face_hidden);
+
+ /* Display it as active. */
+ show_mouse_face (dpyinfo, DRAW_MOUSE_FACE);
+ cursor = No_Cursor;
+ }
+ /* Handle the text property case. */
+ else if (!NILP (mouse_face) && BUFFERP (object))
+ {
+ /* Find the range of text around this char that
+ should be active. */
+ Lisp_Object before, after, beginning, end;
+ int ignore;
+
+ beginning = Fmarker_position (w->start);
+ end = make_number (BUF_Z (XBUFFER (object))
+ - XFASTINT (w->window_end_pos));
+ before
+ = Fprevious_single_property_change (make_number (pos + 1),
+ Qmouse_face,
+ object, beginning);
+ after
+ = Fnext_single_property_change (position, Qmouse_face,
+ object, end);
+
+ /* Record this as the current active region. */
+ fast_find_position (w, XFASTINT (before),
+ &dpyinfo->mouse_face_beg_col,
+ &dpyinfo->mouse_face_beg_row,
+ &dpyinfo->mouse_face_beg_x,
+ &dpyinfo->mouse_face_beg_y, Qnil);
+ dpyinfo->mouse_face_past_end
+ = !fast_find_position (w, XFASTINT (after),
+ &dpyinfo->mouse_face_end_col,
+ &dpyinfo->mouse_face_end_row,
+ &dpyinfo->mouse_face_end_x,
+ &dpyinfo->mouse_face_end_y, Qnil);
+ dpyinfo->mouse_face_window = window;
+
+ if (BUFFERP (object))
+ dpyinfo->mouse_face_face_id
+ = face_at_buffer_position (w, pos, 0, 0,
+ &ignore, pos + 1,
+ !dpyinfo->mouse_face_hidden);
+
+ /* Display it as active. */
+ show_mouse_face (dpyinfo, DRAW_MOUSE_FACE);
+ cursor = No_Cursor;
+ }
+ else if (!NILP (mouse_face) && STRINGP (object))
+ {
+ Lisp_Object b, e;
+ int ignore;
+
+ b = Fprevious_single_property_change (make_number (pos + 1),
+ Qmouse_face,
+ object, Qnil);
+ e = Fnext_single_property_change (position, Qmouse_face,
+ object, Qnil);
+ if (NILP (b))
+ b = make_number (0);
+ if (NILP (e))
+ e = make_number (SCHARS (object) - 1);
+ fast_find_string_pos (w, XINT (b), object,
+ &dpyinfo->mouse_face_beg_col,
+ &dpyinfo->mouse_face_beg_row,
+ &dpyinfo->mouse_face_beg_x,
+ &dpyinfo->mouse_face_beg_y, 0);
+ fast_find_string_pos (w, XINT (e), object,
+ &dpyinfo->mouse_face_end_col,
+ &dpyinfo->mouse_face_end_row,
+ &dpyinfo->mouse_face_end_x,
+ &dpyinfo->mouse_face_end_y, 1);
+ dpyinfo->mouse_face_past_end = 0;
+ dpyinfo->mouse_face_window = window;
+ dpyinfo->mouse_face_face_id
+ = face_at_string_position (w, object, pos, 0, 0, 0, &ignore,
+ glyph->face_id, 1);
+ show_mouse_face (dpyinfo, DRAW_MOUSE_FACE);
+ cursor = No_Cursor;
+ }
+ else if (STRINGP (object) && NILP (mouse_face))
+ {
+ /* A string which doesn't have mouse-face, but
+ the text ``under'' it might have. */
+ struct glyph_row *r = MATRIX_ROW (w->current_matrix, vpos);
+ int start = MATRIX_ROW_START_CHARPOS (r);
+
+ pos = string_buffer_position (w, object, start);
+ if (pos > 0)
+ mouse_face = get_char_property_and_overlay (make_number (pos),
+ Qmouse_face,
+ w->buffer,
+ &overlay);
+ if (!NILP (mouse_face) && !NILP (overlay))
+ {
+ Lisp_Object before = Foverlay_start (overlay);
+ Lisp_Object after = Foverlay_end (overlay);
+ int ignore;
+
+ /* Note that we might not be able to find position
+ BEFORE in the glyph matrix if the overlay is
+ entirely covered by a `display' property. In
+ this case, we overshoot. So let's stop in
+ the glyph matrix before glyphs for OBJECT. */
+ fast_find_position (w, XFASTINT (before),
+ &dpyinfo->mouse_face_beg_col,
+ &dpyinfo->mouse_face_beg_row,
+ &dpyinfo->mouse_face_beg_x,
+ &dpyinfo->mouse_face_beg_y,
+ object);
+
+ dpyinfo->mouse_face_past_end
+ = !fast_find_position (w, XFASTINT (after),
+ &dpyinfo->mouse_face_end_col,
+ &dpyinfo->mouse_face_end_row,
+ &dpyinfo->mouse_face_end_x,
+ &dpyinfo->mouse_face_end_y,
+ Qnil);
+ dpyinfo->mouse_face_window = window;
+ dpyinfo->mouse_face_face_id
+ = face_at_buffer_position (w, pos, 0, 0,
+ &ignore, pos + 1,
+ !dpyinfo->mouse_face_hidden);
+
+ /* Display it as active. */
+ show_mouse_face (dpyinfo, DRAW_MOUSE_FACE);
+ cursor = No_Cursor;
+ }
+ }
+ }
+
+ check_help_echo:
+
+ /* Look for a `help-echo' property. */
+ {
+ Lisp_Object help, overlay;
+
+ /* Check overlays first. */
+ help = overlay = Qnil;
+ for (i = noverlays - 1; i >= 0 && NILP (help); --i)
+ {
+ overlay = overlay_vec[i];
+ help = Foverlay_get (overlay, Qhelp_echo);
+ }
+
+ if (!NILP (help))
+ {
+ help_echo_string = help;
+ help_echo_window = window;
+ help_echo_object = overlay;
+ help_echo_pos = pos;
+ }
+ else
+ {
+ Lisp_Object object = glyph->object;
+ int charpos = glyph->charpos;
+
+ /* Try text properties. */
+ if (STRINGP (object)
+ && charpos >= 0
+ && charpos < SCHARS (object))
+ {
+ help = Fget_text_property (make_number (charpos),
+ Qhelp_echo, object);
+ if (NILP (help))
+ {
+ /* If the string itself doesn't specify a help-echo,
+ see if the buffer text ``under'' it does. */
+ struct glyph_row *r
+ = MATRIX_ROW (w->current_matrix, vpos);
+ int start = MATRIX_ROW_START_CHARPOS (r);
+ int pos = string_buffer_position (w, object, start);
+ if (pos > 0)
+ {
+ help = Fget_char_property (make_number (pos),
+ Qhelp_echo, w->buffer);
+ if (!NILP (help))
+ {
+ charpos = pos;
+ object = w->buffer;
+ }
+ }
+ }
+ }
+ else if (BUFFERP (object)
+ && charpos >= BEGV
+ && charpos < ZV)
+ help = Fget_text_property (make_number (charpos), Qhelp_echo,
+ object);
+
+ if (!NILP (help))
+ {
+ help_echo_string = help;
+ help_echo_window = window;
+ help_echo_object = object;
+ help_echo_pos = charpos;
+ }
+ }
+ }
+
+ BEGV = obegv;
+ ZV = ozv;
+ current_buffer = obuf;
+ }
+
+ set_cursor:
+
+#ifndef HAVE_CARBON
+ if (cursor != No_Cursor)
+#else
+ if (bcmp (&cursor, &No_Cursor, sizeof (Cursor)))
+#endif
+ rif->define_frame_cursor (f, cursor);
+}
+
+
+/* EXPORT for RIF:
+ Clear any mouse-face on window W. This function is part of the
+ redisplay interface, and is called from try_window_id and similar
+ functions to ensure the mouse-highlight is off. */
+
+void
+x_clear_window_mouse_face (w)
+ struct window *w;
+{
+ Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (XFRAME (w->frame));
+ Lisp_Object window;
+
+ BLOCK_INPUT;
+ XSETWINDOW (window, w);
+ if (EQ (window, dpyinfo->mouse_face_window))
+ clear_mouse_face (dpyinfo);
+ UNBLOCK_INPUT;
+}
+
+
+/* EXPORT:
+ Just discard the mouse face information for frame F, if any.
+ This is used when the size of F is changed. */
+
+void
+cancel_mouse_face (f)
+ struct frame *f;
+{
+ Lisp_Object window;
+ Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+
+ window = dpyinfo->mouse_face_window;
+ if (! NILP (window) && XFRAME (XWINDOW (window)->frame) == f)
+ {
+ dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1;
+ dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1;
+ dpyinfo->mouse_face_window = Qnil;
+ }
+}
+
+
+#endif /* HAVE_WINDOW_SYSTEM */
+
+\f
+/***********************************************************************
+ Exposure Events
+ ***********************************************************************/
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* Redraw the part of glyph row area AREA of glyph row ROW on window W
+ which intersects rectangle R. R is in window-relative coordinates. */
+
+static void
+expose_area (w, row, r, area)
+ struct window *w;
+ struct glyph_row *row;
+ XRectangle *r;
+ enum glyph_row_area area;
+{
+ struct glyph *first = row->glyphs[area];
+ struct glyph *end = row->glyphs[area] + row->used[area];
+ struct glyph *last;
+ int first_x, start_x, x;
+
+ if (area == TEXT_AREA && row->fill_line_p)
+ /* If row extends face to end of line write the whole line. */
+ draw_glyphs (w, 0, row, area,
+ 0, row->used[area],
+ DRAW_NORMAL_TEXT, 0);
+ else
+ {
+ /* Set START_X to the window-relative start position for drawing glyphs of
+ AREA. The first glyph of the text area can be partially visible.
+ The first glyphs of other areas cannot. */
+ start_x = window_box_left_offset (w, area);
+ if (area == TEXT_AREA)
+ start_x += row->x;
+ x = start_x;
+
+ /* Find the first glyph that must be redrawn. */
+ while (first < end
+ && x + first->pixel_width < r->x)
+ {
+ x += first->pixel_width;
+ ++first;
+ }
+
+ /* Find the last one. */
+ last = first;
+ first_x = x;
+ while (last < end
+ && x < r->x + r->width)
+ {
+ x += last->pixel_width;
+ ++last;
+ }
+
+ /* Repaint. */
+ if (last > first)
+ draw_glyphs (w, first_x - start_x, row, area,
+ first - row->glyphs[area], last - row->glyphs[area],
+ DRAW_NORMAL_TEXT, 0);
+ }
+}
+
+
+/* Redraw the parts of the glyph row ROW on window W intersecting
+ rectangle R. R is in window-relative coordinates. Value is
+ non-zero if mouse-face was overwritten. */
+
+static int
+expose_line (w, row, r)
+ struct window *w;
+ struct glyph_row *row;
+ XRectangle *r;
+{
+ xassert (row->enabled_p);
+
+ if (row->mode_line_p || w->pseudo_window_p)
+ draw_glyphs (w, 0, row, TEXT_AREA,
+ 0, row->used[TEXT_AREA],
+ DRAW_NORMAL_TEXT, 0);
+ else
+ {
+ if (row->used[LEFT_MARGIN_AREA])
+ expose_area (w, row, r, LEFT_MARGIN_AREA);
+ if (row->used[TEXT_AREA])
+ expose_area (w, row, r, TEXT_AREA);
+ if (row->used[RIGHT_MARGIN_AREA])
+ expose_area (w, row, r, RIGHT_MARGIN_AREA);
+ draw_row_fringe_bitmaps (w, row);
+ }
+
+ return row->mouse_face_p;
+}
+
+
+/* Redraw those parts of glyphs rows during expose event handling that
+ overlap other rows. Redrawing of an exposed line writes over parts
+ of lines overlapping that exposed line; this function fixes that.
+
+ W is the window being exposed. FIRST_OVERLAPPING_ROW is the first
+ row in W's current matrix that is exposed and overlaps other rows.
+ LAST_OVERLAPPING_ROW is the last such row. */
+
+static void
+expose_overlaps (w, first_overlapping_row, last_overlapping_row)
+ struct window *w;
+ struct glyph_row *first_overlapping_row;
+ struct glyph_row *last_overlapping_row;
+{
+ struct glyph_row *row;
+
+ for (row = first_overlapping_row; row <= last_overlapping_row; ++row)
+ if (row->overlapping_p)
+ {
+ xassert (row->enabled_p && !row->mode_line_p);
+
+ if (row->used[LEFT_MARGIN_AREA])
+ x_fix_overlapping_area (w, row, LEFT_MARGIN_AREA);
+
+ if (row->used[TEXT_AREA])
+ x_fix_overlapping_area (w, row, TEXT_AREA);
+
+ if (row->used[RIGHT_MARGIN_AREA])
+ x_fix_overlapping_area (w, row, RIGHT_MARGIN_AREA);
+ }
+}
+
+
+/* Return non-zero if W's cursor intersects rectangle R. */
+
+static int
+phys_cursor_in_rect_p (w, r)
+ struct window *w;
+ XRectangle *r;
+{
+ XRectangle cr, result;
+ struct glyph *cursor_glyph;
+
+ cursor_glyph = get_phys_cursor_glyph (w);
+ if (cursor_glyph)
+ {
+ /* r is relative to W's box, but w->phys_cursor.x is relative
+ to left edge of W's TEXT area. Adjust it. */
+ cr.x = window_box_left_offset (w, TEXT_AREA) + w->phys_cursor.x;
+ cr.y = w->phys_cursor.y;
+ cr.width = cursor_glyph->pixel_width;
+ cr.height = w->phys_cursor_height;
+ /* ++KFS: W32 version used W32-specific IntersectRect here, but
+ I assume the effect is the same -- and this is portable. */
+ return x_intersect_rectangles (&cr, r, &result);
+ }
+ else
+ return 0;
+}
+
+
+/* EXPORT:
+ Draw a vertical window border to the right of window W if W doesn't
+ have vertical scroll bars. */
+
+void
+x_draw_vertical_border (w)
+ struct window *w;
+{
+ /* We could do better, if we knew what type of scroll-bar the adjacent
+ windows (on either side) have... But we don't :-(
+ However, I think this works ok. ++KFS 2003-04-25 */
+
+ /* Redraw borders between horizontally adjacent windows. Don't
+ do it for frames with vertical scroll bars because either the
+ right scroll bar of a window, or the left scroll bar of its
+ neighbor will suffice as a border. */
+ if (!WINDOW_RIGHTMOST_P (w)
+ && !WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w))
+ {
+ int x0, x1, y0, y1;
+
+ window_box_edges (w, -1, &x0, &y0, &x1, &y1);
+ y1 -= 1;
+
+ rif->draw_vertical_window_border (w, x1, y0, y1);
+ }
+ else if (!WINDOW_LEFTMOST_P (w)
+ && !WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w))
+ {
+ int x0, x1, y0, y1;
+
+ window_box_edges (w, -1, &x0, &y0, &x1, &y1);
+ y1 -= 1;
+
+ rif->draw_vertical_window_border (w, x0, y0, y1);
+ }
+}
+
+
+/* Redraw the part of window W intersection rectangle FR. Pixel
+ coordinates in FR are frame-relative. Call this function with
+ input blocked. Value is non-zero if the exposure overwrites
+ mouse-face. */
+
+static int
+expose_window (w, fr)
+ struct window *w;
+ XRectangle *fr;
+{
+ struct frame *f = XFRAME (w->frame);
+ XRectangle wr, r;
+ int mouse_face_overwritten_p = 0;
+
+ /* If window is not yet fully initialized, do nothing. This can
+ happen when toolkit scroll bars are used and a window is split.
+ Reconfiguring the scroll bar will generate an expose for a newly
+ created window. */
+ if (w->current_matrix == NULL)
+ return 0;
+
+ /* When we're currently updating the window, display and current
+ matrix usually don't agree. Arrange for a thorough display
+ later. */
+ if (w == updated_window)
+ {
+ SET_FRAME_GARBAGED (f);
+ return 0;
+ }
+
+ /* Frame-relative pixel rectangle of W. */
+ wr.x = WINDOW_LEFT_EDGE_X (w);
+ wr.y = WINDOW_TOP_EDGE_Y (w);
+ wr.width = WINDOW_TOTAL_WIDTH (w);
+ wr.height = WINDOW_TOTAL_HEIGHT (w);
+
+ if (x_intersect_rectangles (fr, &wr, &r))
+ {
+ int yb = window_text_bottom_y (w);
+ struct glyph_row *row;
+ int cursor_cleared_p;
+ struct glyph_row *first_overlapping_row, *last_overlapping_row;
+
+ TRACE ((stderr, "expose_window (%d, %d, %d, %d)\n",
+ r.x, r.y, r.width, r.height));
+
+ /* Convert to window coordinates. */
+ r.x -= WINDOW_LEFT_EDGE_X (w);
+ r.y -= WINDOW_TOP_EDGE_Y (w);
+
+ /* Turn off the cursor. */
+ if (!w->pseudo_window_p
+ && phys_cursor_in_rect_p (w, &r))
+ {
+ x_clear_cursor (w);
+ cursor_cleared_p = 1;
+ }
+ else
+ cursor_cleared_p = 0;
+
+ /* Update lines intersecting rectangle R. */
+ first_overlapping_row = last_overlapping_row = NULL;
+ for (row = w->current_matrix->rows;
+ row->enabled_p;
+ ++row)
+ {
+ int y0 = row->y;
+ int y1 = MATRIX_ROW_BOTTOM_Y (row);
+
+ if ((y0 >= r.y && y0 < r.y + r.height)
+ || (y1 > r.y && y1 < r.y + r.height)
+ || (r.y >= y0 && r.y < y1)
+ || (r.y + r.height > y0 && r.y + r.height < y1))
+ {
+ if (row->overlapping_p)
+ {
+ if (first_overlapping_row == NULL)
+ first_overlapping_row = row;
+ last_overlapping_row = row;
+ }
+
+ if (expose_line (w, row, &r))
+ mouse_face_overwritten_p = 1;
+ }
+
+ if (y1 >= yb)
+ break;
+ }
+
+ /* Display the mode line if there is one. */
+ if (WINDOW_WANTS_MODELINE_P (w)
+ && (row = MATRIX_MODE_LINE_ROW (w->current_matrix),
+ row->enabled_p)
+ && row->y < r.y + r.height)
+ {
+ if (expose_line (w, row, &r))
+ mouse_face_overwritten_p = 1;
+ }
+
+ if (!w->pseudo_window_p)
+ {
+ /* Fix the display of overlapping rows. */
+ if (first_overlapping_row)
+ expose_overlaps (w, first_overlapping_row, last_overlapping_row);
+
+ /* Draw border between windows. */
+ x_draw_vertical_border (w);
+
+ /* Turn the cursor on again. */
+ if (cursor_cleared_p)
+ update_window_cursor (w, 1);
+ }
+ }
+
+#ifdef HAVE_CARBON
+ /* Display scroll bar for this window. */
+ if (!NILP (w->vertical_scroll_bar))
+ {
+ /* ++KFS:
+ If this doesn't work here (maybe some header files are missing),
+ make a function in macterm.c and call it to do the job! */
+ ControlHandle ch
+ = SCROLL_BAR_CONTROL_HANDLE (XSCROLL_BAR (w->vertical_scroll_bar));
+
+ Draw1Control (ch);
+ }
+#endif
+
+ return mouse_face_overwritten_p;
+}
+
+
+
+/* Redraw (parts) of all windows in the window tree rooted at W that
+ intersect R. R contains frame pixel coordinates. Value is
+ non-zero if the exposure overwrites mouse-face. */
+
+static int
+expose_window_tree (w, r)
+ struct window *w;
+ XRectangle *r;
+{
+ struct frame *f = XFRAME (w->frame);
+ int mouse_face_overwritten_p = 0;
+
+ while (w && !FRAME_GARBAGED_P (f))
+ {
+ if (!NILP (w->hchild))
+ mouse_face_overwritten_p
+ |= expose_window_tree (XWINDOW (w->hchild), r);
+ else if (!NILP (w->vchild))
+ mouse_face_overwritten_p
+ |= expose_window_tree (XWINDOW (w->vchild), r);
+ else
+ mouse_face_overwritten_p |= expose_window (w, r);
+
+ w = NILP (w->next) ? NULL : XWINDOW (w->next);
+ }
+
+ return mouse_face_overwritten_p;
+}
+
+
+/* EXPORT:
+ Redisplay an exposed area of frame F. X and Y are the upper-left
+ corner of the exposed rectangle. W and H are width and height of
+ the exposed area. All are pixel values. W or H zero means redraw
+ the entire frame. */
+
+void
+expose_frame (f, x, y, w, h)
+ struct frame *f;
+ int x, y, w, h;
+{
+ XRectangle r;
+ int mouse_face_overwritten_p = 0;
+
+ TRACE ((stderr, "expose_frame "));
+
+ /* No need to redraw if frame will be redrawn soon. */
+ if (FRAME_GARBAGED_P (f))
+ {
+ TRACE ((stderr, " garbaged\n"));
+ return;
+ }
+
+#ifdef HAVE_CARBON
+ /* MAC_TODO: this is a kludge, but if scroll bars are not activated
+ or deactivated here, for unknown reasons, activated scroll bars
+ are shown in deactivated frames in some instances. */
+ if (f == FRAME_MAC_DISPLAY_INFO (f)->x_focus_frame)
+ activate_scroll_bars (f);
+ else
+ deactivate_scroll_bars (f);
+#endif
+
+ /* If basic faces haven't been realized yet, there is no point in
+ trying to redraw anything. This can happen when we get an expose
+ event while Emacs is starting, e.g. by moving another window. */
+ if (FRAME_FACE_CACHE (f) == NULL
+ || FRAME_FACE_CACHE (f)->used < BASIC_FACE_ID_SENTINEL)
+ {
+ TRACE ((stderr, " no faces\n"));
+ return;
+ }
+
+ if (w == 0 || h == 0)
+ {
+ r.x = r.y = 0;
+ r.width = FRAME_COLUMN_WIDTH (f) * FRAME_COLS (f);
+ r.height = FRAME_LINE_HEIGHT (f) * FRAME_LINES (f);
+ }
+ else
+ {
+ r.x = x;
+ r.y = y;
+ r.width = w;
+ r.height = h;
+ }
+
+ TRACE ((stderr, "(%d, %d, %d, %d)\n", r.x, r.y, r.width, r.height));
+ mouse_face_overwritten_p = expose_window_tree (XWINDOW (f->root_window), &r);
+
+ if (WINDOWP (f->tool_bar_window))
+ mouse_face_overwritten_p
+ |= expose_window (XWINDOW (f->tool_bar_window), &r);
+
+#ifdef HAVE_X_WINDOWS
+#ifndef MSDOS
+#ifndef USE_X_TOOLKIT
+ if (WINDOWP (f->menu_bar_window))
+ mouse_face_overwritten_p
+ |= expose_window (XWINDOW (f->menu_bar_window), &r);
+#endif /* not USE_X_TOOLKIT */
+#endif
+#endif
+
+ /* Some window managers support a focus-follows-mouse style with
+ delayed raising of frames. Imagine a partially obscured frame,
+ and moving the mouse into partially obscured mouse-face on that
+ frame. The visible part of the mouse-face will be highlighted,
+ then the WM raises the obscured frame. With at least one WM, KDE
+ 2.1, Emacs is not getting any event for the raising of the frame
+ (even tried with SubstructureRedirectMask), only Expose events.
+ These expose events will draw text normally, i.e. not
+ highlighted. Which means we must redo the highlight here.
+ Subsume it under ``we love X''. --gerd 2001-08-15 */
+ /* Included in Windows version because Windows most likely does not
+ do the right thing if any third party tool offers
+ focus-follows-mouse with delayed raise. --jason 2001-10-12 */
+ if (mouse_face_overwritten_p && !FRAME_GARBAGED_P (f))
+ {
+ Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ if (f == dpyinfo->mouse_face_mouse_frame)
+ {
+ int x = dpyinfo->mouse_face_mouse_x;
+ int y = dpyinfo->mouse_face_mouse_y;
+ clear_mouse_face (dpyinfo);
+ note_mouse_highlight (f, x, y);
+ }
+ }
+}
+
+
+/* EXPORT:
+ Determine the intersection of two rectangles R1 and R2. Return
+ the intersection in *RESULT. Value is non-zero if RESULT is not
+ empty. */
+
+int
+x_intersect_rectangles (r1, r2, result)
+ XRectangle *r1, *r2, *result;
+{
+ XRectangle *left, *right;
+ XRectangle *upper, *lower;
+ int intersection_p = 0;
+
+ /* Rearrange so that R1 is the left-most rectangle. */
+ if (r1->x < r2->x)
+ left = r1, right = r2;
+ else
+ left = r2, right = r1;
+
+ /* X0 of the intersection is right.x0, if this is inside R1,
+ otherwise there is no intersection. */
+ if (right->x <= left->x + left->width)
+ {
+ result->x = right->x;
+
+ /* The right end of the intersection is the minimum of the
+ the right ends of left and right. */
+ result->width = (min (left->x + left->width, right->x + right->width)
+ - result->x);
+
+ /* Same game for Y. */
+ if (r1->y < r2->y)
+ upper = r1, lower = r2;
+ else
+ upper = r2, lower = r1;
+
+ /* The upper end of the intersection is lower.y0, if this is inside
+ of upper. Otherwise, there is no intersection. */
+ if (lower->y <= upper->y + upper->height)
+ {
+ result->y = lower->y;
+
+ /* The lower end of the intersection is the minimum of the lower
+ ends of upper and lower. */
+ result->height = (min (lower->y + lower->height,
+ upper->y + upper->height)
+ - result->y);
+ intersection_p = 1;
+ }
+ }
+
+ return intersection_p;
+}
+
+#endif /* HAVE_WINDOW_SYSTEM */
+
+\f
+/***********************************************************************
+ Initialization
+ ***********************************************************************/
+
+void
+syms_of_xdisp ()
+{
+ Vwith_echo_area_save_vector = Qnil;
+ staticpro (&Vwith_echo_area_save_vector);
+
+ Vmessage_stack = Qnil;
+ staticpro (&Vmessage_stack);
+
+ Qinhibit_redisplay = intern ("inhibit-redisplay");
+ staticpro (&Qinhibit_redisplay);
+
+ message_dolog_marker1 = Fmake_marker ();
+ staticpro (&message_dolog_marker1);
+ message_dolog_marker2 = Fmake_marker ();
+ staticpro (&message_dolog_marker2);
+ message_dolog_marker3 = Fmake_marker ();
+ staticpro (&message_dolog_marker3);
+
+#if GLYPH_DEBUG
+ defsubr (&Sdump_frame_glyph_matrix);
+ defsubr (&Sdump_glyph_matrix);
+ defsubr (&Sdump_glyph_row);
+ defsubr (&Sdump_tool_bar_row);
+ defsubr (&Strace_redisplay);
+ defsubr (&Strace_to_stderr);
+#endif
+#ifdef HAVE_WINDOW_SYSTEM
+ defsubr (&Stool_bar_lines_needed);
+#endif
+ defsubr (&Sformat_mode_line);
+
+ staticpro (&Qmenu_bar_update_hook);
+ Qmenu_bar_update_hook = intern ("menu-bar-update-hook");
staticpro (&Qoverriding_terminal_local_map);
Qoverriding_terminal_local_map = intern ("overriding-terminal-local-map");
staticpro (&Qredisplay_end_trigger_functions);
Qredisplay_end_trigger_functions = intern ("redisplay-end-trigger-functions");
-
+
staticpro (&Qinhibit_point_motion_hooks);
Qinhibit_point_motion_hooks = intern ("inhibit-point-motion-hooks");
staticpro (&QCeval);
QCpropertize = intern (":propertize");
staticpro (&QCpropertize);
- Qwhen = intern ("when");
- staticpro (&Qwhen);
QCfile = intern (":file");
staticpro (&QCfile);
Qfontified = intern ("fontified");
staticpro (&Qbuffer_position);
Qobject = intern ("object");
staticpro (&Qobject);
+ Qbar = intern ("bar");
+ staticpro (&Qbar);
+ Qhbar = intern ("hbar");
+ staticpro (&Qhbar);
+ Qbox = intern ("box");
+ staticpro (&Qbox);
+ Qhollow = intern ("hollow");
+ staticpro (&Qhollow);
+ Qrisky_local_variable = intern ("risky-local-variable");
+ staticpro (&Qrisky_local_variable);
+ Qinhibit_free_realized_faces = intern ("inhibit-free-realized-faces");
+ staticpro (&Qinhibit_free_realized_faces);
+
+ list_of_error = Fcons (intern ("error"), Qnil);
+ staticpro (&list_of_error);
last_arrow_position = Qnil;
last_arrow_string = Qnil;
staticpro (&last_arrow_position);
staticpro (&last_arrow_string);
-
+
echo_buffer[0] = echo_buffer[1] = Qnil;
staticpro (&echo_buffer[0]);
staticpro (&echo_buffer[1]);
mode_line_proptrans_alist = Qnil;
staticpro (&mode_line_proptrans_alist);
-
+
+ mode_line_string_list = Qnil;
+ staticpro (&mode_line_string_list);
+
+ help_echo_string = Qnil;
+ staticpro (&help_echo_string);
+ help_echo_object = Qnil;
+ staticpro (&help_echo_object);
+ help_echo_window = Qnil;
+ staticpro (&help_echo_window);
+ previous_help_echo_string = Qnil;
+ staticpro (&previous_help_echo_string);
+ help_echo_pos = -1;
+
+#ifdef HAVE_WINDOW_SYSTEM
+ DEFVAR_BOOL ("x-stretch-cursor", &x_stretch_cursor_p,
+ doc: /* *Non-nil means draw block cursor as wide as the glyph under it.
+For example, if a block cursor is over a tab, it will be drawn as
+wide as that tab on the display. */);
+ x_stretch_cursor_p = 0;
+#endif
+
DEFVAR_LISP ("show-trailing-whitespace", &Vshow_trailing_whitespace,
doc: /* Non-nil means highlight trailing whitespace.
The face used for trailing whitespace is `trailing-whitespace'. */);
DEFVAR_BOOL ("mode-line-inverse-video", &mode_line_inverse_video,
doc: /* nil means display the mode-line/header-line/menu-bar in the default face.
Any other value means to use the appropriate face, `mode-line',
-`header-line', or `menu' respectively.
-
-This variable is deprecated; please change the above faces instead. */);
+`header-line', or `menu' respectively. */);
mode_line_inverse_video = 1;
DEFVAR_LISP ("line-number-display-limit", &Vline_number_display_limit,
and its new display-start position. Note that the value of `window-end'
is not valid when these functions are called. */);
Vwindow_scroll_functions = Qnil;
-
+
+ DEFVAR_BOOL ("mouse-autoselect-window", &mouse_autoselect_window,
+ doc: /* *Non-nil means autoselect window with mouse pointer. */);
+ mouse_autoselect_window = 0;
+
DEFVAR_BOOL ("auto-resize-tool-bars", &auto_resize_tool_bars_p,
doc: /* *Non-nil means automatically resize tool-bars.
This increases a tool-bar's height if not all tool-bar items are visible.
It decreases a tool-bar's height when it would display blank lines
otherwise. */);
auto_resize_tool_bars_p = 1;
-
+
DEFVAR_BOOL ("auto-raise-tool-bar-buttons", &auto_raise_tool_bar_buttons_p,
doc: /* *Non-nil means raise tool-bar buttons when the mouse moves over them. */);
auto_raise_tool_bar_buttons_p = 1;
go back to their normal size. */);
Vresize_mini_windows = Qgrow_only;
- DEFVAR_BOOL ("cursor-in-non-selected-windows",
- &cursor_in_non_selected_windows,
- doc: /* *Non-nil means display a hollow cursor in non-selected windows.
-nil means don't display a cursor there. */);
- cursor_in_non_selected_windows = 1;
-
- DEFVAR_BOOL ("automatic-hscrolling", &automatic_hscrolling_p,
+ DEFVAR_LISP ("cursor-in-non-selected-windows",
+ &Vcursor_in_non_selected_windows,
+ doc: /* *Cursor type to display in non-selected windows.
+t means to use hollow box cursor. See `cursor-type' for other values. */);
+ Vcursor_in_non_selected_windows = Qt;
+
+ DEFVAR_LISP ("blink-cursor-alist", &Vblink_cursor_alist,
+ doc: /* Alist specifying how to blink the cursor off.
+Each element has the form (ON-STATE . OFF-STATE). Whenever the
+`cursor-type' frame-parameter or variable equals ON-STATE,
+comparing using `equal', Emacs uses OFF-STATE to specify
+how to blink it off. */);
+ Vblink_cursor_alist = Qnil;
+
+ DEFVAR_BOOL ("auto-hscroll-mode", &automatic_hscrolling_p,
doc: /* *Non-nil means scroll the display automatically to make point visible. */);
automatic_hscrolling_p = 1;
- DEFVAR_INT ("automatic-hscroll-margin", &automatic_hscroll_margin,
+ DEFVAR_INT ("hscroll-margin", &hscroll_margin,
doc: /* *How many columns away from the window edge point is allowed to get
before automatic hscrolling will horizontally scroll the window. */);
- automatic_hscroll_margin = 5;
+ hscroll_margin = 5;
- DEFVAR_LISP ("automatic-hscroll-step", &Vautomatic_hscroll_step,
+ DEFVAR_LISP ("hscroll-step", &Vhscroll_step,
doc: /* *How many columns to scroll the window when point gets too close to the edge.
When point is less than `automatic-hscroll-margin' columns from the window
edge, automatic hscrolling will scroll the window by the amount of columns
Note that the lower bound for automatic hscrolling specified by `scroll-left'
and `scroll-right' overrides this variable's effect. */);
- Vautomatic_hscroll_step = make_number (0);
-
+ Vhscroll_step = make_number (0);
+
DEFVAR_LISP ("image-types", &Vimage_types,
doc: /* List of supported image types.
Each element of the list is a symbol for a supported image type. */);
Vimage_types = Qnil;
-
+
DEFVAR_BOOL ("message-truncate-lines", &message_truncate_lines,
doc: /* If non-nil, messages are truncated instead of resizing the echo area.
Bind this around calls to `message' to let it take effect. */);
doc: /* Normal hook run for clicks on menu bar, before displaying a submenu.
Can be used to update submenus whose contents should vary. */);
Vmenu_bar_update_hook = Qnil;
-
+
DEFVAR_BOOL ("inhibit-menubar-update", &inhibit_menubar_update,
doc: /* Non-nil means don't update menu bars. Internal use only. */);
inhibit_menubar_update = 0;
doc: /* Non-nil means don't eval Lisp during redisplay. */);
inhibit_eval_during_redisplay = 0;
+ DEFVAR_BOOL ("inhibit-free-realized-faces", &inhibit_free_realized_faces,
+ doc: /* Non-nil means don't free realized faces. Internal use only. */);
+ inhibit_free_realized_faces = 0;
+
#if GLYPH_DEBUG
DEFVAR_BOOL ("inhibit-try-window-id", &inhibit_try_window_id,
doc: /* Inhibit try_window_id display optimization. */);
struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (root_window)));
int i;
- XWINDOW (root_window)->top = make_number (FRAME_TOP_MARGIN (f));
+ XWINDOW (root_window)->top_line = make_number (FRAME_TOP_MARGIN (f));
set_window_height (root_window,
- FRAME_HEIGHT (f) - 1 - FRAME_TOP_MARGIN (f),
+ FRAME_LINES (f) - 1 - FRAME_TOP_MARGIN (f),
0);
- mini_w->top = make_number (FRAME_HEIGHT (f) - 1);
+ mini_w->top_line = make_number (FRAME_LINES (f) - 1);
set_window_height (minibuf_window, 1, 0);
- XWINDOW (root_window)->width = make_number (FRAME_WIDTH (f));
- mini_w->width = make_number (FRAME_WIDTH (f));
+ XWINDOW (root_window)->total_cols = make_number (FRAME_COLS (f));
+ mini_w->total_cols = make_number (FRAME_COLS (f));
scratch_glyph_row.glyphs[TEXT_AREA] = scratch_glyphs;
scratch_glyph_row.glyphs[TEXT_AREA + 1]
= scratch_glyphs + MAX_SCRATCH_GLYPHS;
- /* The default ellipsis glyphs `...'. */
+ /* The default ellipsis glyphs `...'. */
for (i = 0; i < 3; ++i)
default_invis_vector[i] = make_number ('.');
}
-#ifdef HAVE_WINDOW_SYSTEM
{
- /* Allocate the buffer for frame titles. */
+ /* Allocate the buffer for frame titles.
+ Also used for `format-mode-line'. */
int size = 100;
frame_title_buf = (char *) xmalloc (size);
frame_title_buf_end = frame_title_buf + size;
frame_title_ptr = NULL;
}
-#endif /* HAVE_WINDOW_SYSTEM */
-
+
help_echo_showing_p = 0;
}
/* xfaces.c -- "Face" primitives.
- Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002
+ Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003
Free Software Foundation.
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 <sys/stat.h>
#include "lisp.h"
+ #include "character.h"
#include "charset.h"
#include "keyboard.h"
#include "frame.h"
#define check_x check_w32
#define x_list_fonts w32_list_fonts
#define GCGraphicsExposures 0
-/* 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 /* WINDOWSNT */
-#ifdef macintosh
+#ifdef MAC_OS
#include "macterm.h"
#define x_display_info mac_display_info
#define check_x check_mac
-
-extern XGCValues *XCreateGC (void *, WindowPtr, unsigned long, XGCValues *);
-
-static INLINE GC
-x_create_gc (f, mask, xgcv)
- struct frame *f;
- unsigned long mask;
- XGCValues *xgcv;
-{
- GC gc;
- gc = XCreateGC (FRAME_MAC_DISPLAY (f), FRAME_MAC_WINDOW (f), mask, xgcv);
- return gc;
-}
-
-static INLINE void
-x_free_gc (f, gc)
- struct frame *f;
- GC gc;
-{
- XFreeGC (FRAME_MAC_DISPLAY (f), gc);
-}
-#endif
+#endif /* MAC_OS */
#include "buffer.h"
#include "dispextern.h"
/* Make a copy of the contents of Lisp string S on the stack using
alloca. Value is a pointer to the copy. */
-#define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
+#define LSTRDUPA(S) STRDUPA (SDATA ((S)))
/* Size of hash table of realized faces in face caches (should be a
prime number). */
#define FACE_CACHE_BUCKETS_SIZE 1001
-/* A definition of XColor for non-X frames. */
-
-#ifndef HAVE_X_WINDOWS
-
-typedef struct
-{
- unsigned long pixel;
- unsigned short red, green, blue;
- char flags;
- char pad;
-}
-XColor;
-
-#endif /* not HAVE_X_WINDOWS */
-
/* Keyword symbols used for face attribute names. */
Lisp_Object QCfamily, QCheight, QCweight, QCslant, QCunderline;
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. */
Lisp_Object Qface_alias;
-/* Names of frame parameters related to faces. */
-
-extern Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
-extern Lisp_Object Qborder_color, Qcursor_color, Qmouse_color;
-
/* Default stipple pattern used on monochrome displays. This stipple
pattern is used on monochrome displays instead of shades of gray
for a face background color. See `set-face-stipple' for possible
/* TTY color-related functions (defined in tty-colors.el). */
-Lisp_Object Qtty_color_desc, Qtty_color_by_index;
+Lisp_Object Qtty_color_desc, Qtty_color_by_index, Qtty_color_standard_values;
/* The name of the function used to compute colors on TTYs. */
static void map_tty_color P_ ((struct frame *, struct face *,
enum lface_attribute_index, int *));
static Lisp_Object resolve_face_name P_ ((Lisp_Object));
-static int may_use_scalable_font_p P_ ((char *));
+static int may_use_scalable_font_p P_ ((const char *));
static void set_font_frame_param P_ ((Lisp_Object, Lisp_Object));
static int better_font_p P_ ((int *, struct font_name *, struct font_name *,
int, int));
static int x_face_list_fonts P_ ((struct frame *, char *,
- struct font_name *, int, int));
+ struct font_name **, int, int));
static int font_scalable_p P_ ((struct font_name *));
static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *, int));
static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *));
static unsigned char *xstrlwr P_ ((unsigned char *));
static void signal_error P_ ((char *, Lisp_Object));
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*, Lisp_Object));
static void merge_face_inheritance P_ ((struct frame *f, Lisp_Object,
Lisp_Object *, 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));
+ struct font_name *, int, int, int *));
static void cache_face P_ ((struct face_cache *, struct face *, unsigned));
static void uncache_face P_ ((struct face_cache *, struct face *));
static int xlfd_numeric_slant P_ ((struct font_name *));
#endif /* WINDOWSNT */
+#ifdef MAC_OS
+/* Mac OS emulation of GCs */
+
+extern XGCValues *XCreateGC (void *, Window, unsigned long, XGCValues *);
+
+static INLINE GC
+x_create_gc (f, mask, xgcv)
+ struct frame *f;
+ unsigned long mask;
+ XGCValues *xgcv;
+{
+ GC gc;
+ gc = XCreateGC (FRAME_MAC_DISPLAY (f), FRAME_MAC_WINDOW (f), mask, xgcv);
+ return gc;
+}
+
+static INLINE void
+x_free_gc (f, gc)
+ struct frame *f;
+ GC gc;
+{
+ XFreeGC (FRAME_MAC_DISPLAY (f), gc);
+}
+
+#endif /* MAC_OS */
+
/* Like stricmp. Used to compare parts of font names which are in
ISO8859-1. */
int
xstricmp (s1, s2)
- unsigned char *s1, *s2;
+ const unsigned char *s1, *s2;
{
while (*s1 && *s2)
{
#endif
#ifdef WINDOWSNT
if (!FRAME_WINDOW_P (f) || FRAME_W32_WINDOW (f))
+#endif
+#ifdef MAC_OS
+ if (!FRAME_MAC_P (f) || FRAME_MAC_WINDOW (f))
#endif
if (!realize_basic_faces (f))
abort ();
|| ++clear_font_table_count == CLEAR_FONT_TABLE_COUNT)
{
struct x_display_info *dpyinfo;
-
+
/* Fonts are common for frames on one display, i.e. on
one X screen. */
for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
if (dpyinfo->n_fonts > CLEAR_FONT_TABLE_NFONTS)
clear_font_table (dpyinfo);
-
+
/* From time to time see if we can unload some fonts. This also
frees all realized faces on all frames. Fonts needed by
faces will be loaded again when faces are realized again. */
if (font_info->name == NULL)
continue;
- /* Don't free a default font of some frame on this display. */
+ /* Don't free a default font of some frame. */
FOR_EACH_FRAME (tail, frame)
{
struct frame *f = XFRAME (frame);
if (FRAME_WINDOW_P (f)
- && FRAME_X_DISPLAY_INFO (f) == dpyinfo
&& font_info->font == FRAME_FONT (f))
break;
}
{
int bytes_per_row = ((XFASTINT (width) + BITS_PER_CHAR - 1)
/ BITS_PER_CHAR);
- if (STRING_BYTES (XSTRING (data)) >= bytes_per_row * XINT (height))
+ if (SBYTES (data) >= bytes_per_row * XINT (height))
pixmap_p = 1;
}
}
h = XINT (Fcar (Fcdr (name)));
bits = Fcar (Fcdr (Fcdr (name)));
- bitmap_id = x_create_bitmap_from_data (f, XSTRING (bits)->data,
+ bitmap_id = x_create_bitmap_from_data (f, SDATA (bits),
w, h);
}
else
#endif /* HAVE_WINDOW_SYSTEM */
-\f
-/***********************************************************************
- Minimum font bounds
- ***********************************************************************/
-
-#ifdef HAVE_WINDOW_SYSTEM
-
-/* Update the line_height of frame F. Return non-zero if line height
- changes. */
-
-int
-frame_update_line_height (f)
- struct frame *f;
-{
- int line_height, changed_p;
-
- line_height = FONT_HEIGHT (FRAME_FONT (f));
- changed_p = line_height != FRAME_LINE_HEIGHT (f);
- FRAME_LINE_HEIGHT (f) = line_height;
- return changed_p;
-}
-
-#endif /* HAVE_WINDOW_SYSTEM */
-
\f
/***********************************************************************
Fonts
#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;
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);
-
++ 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)
face->font_info_id = font_info->font_idx;
face->font = font_info->font;
face->font_name = font_info->full_name;
+ face->overstrike = needs_overstrike;
if (face->gc)
{
x_free_gc (f, face->gc);
X Colors
***********************************************************************/
+/* Parse RGB_LIST, and fill in the RGB fields of COLOR.
+ RGB_LIST should contain (at least) 3 lisp integers.
+ Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
+
+static int
+parse_rgb_list (rgb_list, color)
+ Lisp_Object rgb_list;
+ XColor *color;
+{
+#define PARSE_RGB_LIST_FIELD(field) \
+ if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
+ { \
+ color->field = XINT (XCAR (rgb_list)); \
+ rgb_list = XCDR (rgb_list); \
+ } \
+ else \
+ return 0;
+
+ PARSE_RGB_LIST_FIELD (red);
+ PARSE_RGB_LIST_FIELD (green);
+ PARSE_RGB_LIST_FIELD (blue);
+
+ return 1;
+}
+
+
+/* Lookup on frame F the color described by the lisp string COLOR.
+ The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
+ non-zero, then the `standard' definition of the same color is
+ returned in it. */
+
+static int
+tty_lookup_color (f, color, tty_color, std_color)
+ struct frame *f;
+ Lisp_Object color;
+ XColor *tty_color, *std_color;
+{
+ Lisp_Object frame, color_desc;
+
+ if (!STRINGP (color) || NILP (Ffboundp (Qtty_color_desc)))
+ return 0;
+
+ XSETFRAME (frame, f);
+
+ color_desc = call2 (Qtty_color_desc, color, frame);
+ if (CONSP (color_desc) && CONSP (XCDR (color_desc)))
+ {
+ Lisp_Object rgb;
+
+ if (! INTEGERP (XCAR (XCDR (color_desc))))
+ return 0;
+
+ tty_color->pixel = XINT (XCAR (XCDR (color_desc)));
+
+ rgb = XCDR (XCDR (color_desc));
+ if (! parse_rgb_list (rgb, tty_color))
+ return 0;
+
+ /* Should we fill in STD_COLOR too? */
+ if (std_color)
+ {
+ /* Default STD_COLOR to the same as TTY_COLOR. */
+ *std_color = *tty_color;
+
+ /* Do a quick check to see if the returned descriptor is
+ actually _exactly_ equal to COLOR, otherwise we have to
+ lookup STD_COLOR separately. If it's impossible to lookup
+ a standard color, we just give up and use TTY_COLOR. */
+ if ((!STRINGP (XCAR (color_desc))
+ || NILP (Fstring_equal (color, XCAR (color_desc))))
+ && !NILP (Ffboundp (Qtty_color_standard_values)))
+ {
+ /* Look up STD_COLOR separately. */
+ rgb = call1 (Qtty_color_standard_values, color);
+ if (! parse_rgb_list (rgb, std_color))
+ return 0;
+ }
+ }
+
+ return 1;
+ }
+ else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
+ /* We were called early during startup, and the colors are not
+ yet set up in tty-defined-color-alist. Don't return a failure
+ indication, since this produces the annoying "Unable to
+ load color" messages in the *Messages* buffer. */
+ return 1;
+ else
+ /* tty-color-desc seems to have returned a bad value. */
+ return 0;
+}
+
/* A version of defined_color for non-X frames. */
int
XColor *color_def;
int alloc;
{
- Lisp_Object color_desc;
- unsigned long color_idx = FACE_TTY_DEFAULT_COLOR;
- unsigned long red = 0, green = 0, blue = 0;
int status = 1;
- if (*color_name && !NILP (Ffboundp (Qtty_color_desc)))
- {
- Lisp_Object frame;
+ /* Defaults. */
+ color_def->pixel = FACE_TTY_DEFAULT_COLOR;
+ color_def->red = 0;
+ color_def->blue = 0;
+ color_def->green = 0;
- XSETFRAME (frame, f);
- status = 0;
- color_desc = call2 (Qtty_color_desc, build_string (color_name), frame);
- if (CONSP (color_desc) && CONSP (XCDR (color_desc)))
- {
- color_idx = XINT (XCAR (XCDR (color_desc)));
- if (CONSP (XCDR (XCDR (color_desc))))
- {
- red = XINT (XCAR (XCDR (XCDR (color_desc))));
- green = XINT (XCAR (XCDR (XCDR (XCDR (color_desc)))));
- blue = XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc))))));
- }
- status = 1;
- }
- else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
- /* We were called early during startup, and the colors are not
- yet set up in tty-defined-color-alist. Don't return a failure
- indication, since this produces the annoying "Unable to
- load color" messages in the *Messages* buffer. */
- status = 1;
- }
- if (color_idx == FACE_TTY_DEFAULT_COLOR && *color_name)
+ if (*color_name)
+ status = tty_lookup_color (f, build_string (color_name), color_def, 0);
+
+ if (color_def->pixel == FACE_TTY_DEFAULT_COLOR && *color_name)
{
if (strcmp (color_name, "unspecified-fg") == 0)
- color_idx = FACE_TTY_DEFAULT_FG_COLOR;
+ color_def->pixel = FACE_TTY_DEFAULT_FG_COLOR;
else if (strcmp (color_name, "unspecified-bg") == 0)
- color_idx = FACE_TTY_DEFAULT_BG_COLOR;
+ color_def->pixel = FACE_TTY_DEFAULT_BG_COLOR;
}
- if (color_idx != FACE_TTY_DEFAULT_COLOR)
+ if (color_def->pixel != FACE_TTY_DEFAULT_COLOR)
status = 1;
- color_def->pixel = color_idx;
- color_def->red = red;
- color_def->green = green;
- color_def->blue = blue;
-
return status;
}
else if (FRAME_W32_P (f))
return w32_defined_color (f, color_name, color_def, alloc);
#endif
-#ifdef macintosh
+#ifdef MAC_OS
else if (FRAME_MAC_P (f))
return mac_defined_color (f, color_name, color_def, alloc);
#endif
CHECK_FRAME (frame);
CHECK_STRING (color);
f = XFRAME (frame);
- return face_color_gray_p (f, XSTRING (color)->data) ? Qt : Qnil;
+ return face_color_gray_p (f, SDATA (color)) ? Qt : Qnil;
}
DEFUN ("color-supported-p", Fcolor_supported_p,
- Scolor_supported_p, 2, 3, 0,
+ Scolor_supported_p, 1, 3, 0,
doc: /* Return non-nil if COLOR can be displayed on FRAME.
BACKGROUND-P non-nil means COLOR is used as a background.
If FRAME is nil or omitted, use the selected frame.
CHECK_FRAME (frame);
CHECK_STRING (color);
f = XFRAME (frame);
- if (face_color_supported_p (f, XSTRING (color)->data, !NILP (background_p)))
+ if (face_color_supported_p (f, SDATA (color), !NILP (background_p)))
return Qt;
return Qnil;
}
/* if the color map is full, defined_color will return a best match
to the values in an existing cell. */
- if (!defined_color (f, XSTRING (name)->data, &color, 1))
+ if (!defined_color (f, SDATA (name), &color, 1))
{
add_to_log ("Unable to load color \"%s\"", name, Qnil);
face_color_supported_p is smart enough to know that grays are
"supported" as background because we are supposed to use stipple
for them. */
- if (!face_color_supported_p (f, XSTRING (bg)->data, 0)
+ if (!face_color_supported_p (f, SDATA (bg), 0)
&& !NILP (Fbitmap_spec_p (Vface_default_stipple)))
{
x_destroy_bitmap (f, face->stipple);
font height, then for weight, then for slant.' This variable can be
set via set-face-font-sort-order. */
-#ifdef macintosh
+#ifdef MAC_OS
static int font_sort_order[4] = {
XLFD_SWIDTH, XLFD_POINT_SIZE, XLFD_WEIGHT, XLFD_SLANT
};
return face_numeric_value (swidth_table, DIM (swidth_table), width);
}
-
+ 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 *) XSTRING (AREF (vec, i))->data);
++ ? "*" : (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;
+ }
#ifdef HAVE_WINDOW_SYSTEM
}
else
pixel = atoi (pixel_field);
-
+
if (pixel == 0)
real_pt = 0;
else
/* Return a rescaling ratio of a font of NAME. */
static double
-font_rescale_ratio (char *name)
+font_rescale_ratio (name)
+ char *name;
{
-- Lisp_Object tail, elt;
++ Lisp_Object tail, elt;
for (tail = Vface_font_rescale_alist; CONSP (tail); tail = XCDR (tail))
{
{
char *start, *end;
int j;
-
+
for (++p; *p && *p != ']'; ++p)
if (*p == '~')
*p = '-';
fonts that we can't parse. Value is the number of fonts found. */
static int
-x_face_list_fonts (f, pattern, fonts, nfonts, try_alternatives_p)
+x_face_list_fonts (f, pattern, pfonts, nfonts, try_alternatives_p)
struct frame *f;
char *pattern;
- struct font_name *fonts;
+ struct font_name **pfonts;
int nfonts, try_alternatives_p;
{
int n, nignored;
better to do it the other way around. */
Lisp_Object lfonts;
Lisp_Object lpattern, tem;
+ struct font_name *fonts = 0;
+ int num_fonts = nfonts;
+ *pfonts = 0;
lpattern = build_string (pattern);
/* Get the list of fonts matching PATTERN. */
lfonts = x_list_fonts (f, lpattern, -1, nfonts);
#endif
-
+ if (nfonts < 0 && CONSP (lfonts))
+ num_fonts = XFASTINT (Flength (lfonts));
++
/* Make a copy of the font names we got from X, and
split them into fields. */
n = nignored = 0;
- for (tem = lfonts; CONSP (tem) && n < nfonts; tem = XCDR (tem))
+ for (tem = lfonts; CONSP (tem) && n < num_fonts; tem = XCDR (tem))
{
Lisp_Object elt, tail;
- char *name = XSTRING (XCAR (tem))->data;
+ const char *name = SDATA (XCAR (tem));
/* Ignore fonts matching a pattern from face-ignored-fonts. */
for (tail = Vface_ignored_fonts; CONSP (tail); tail = XCDR (tail))
continue;
}
+ if (! fonts)
+ {
+ *pfonts = (struct font_name *) xmalloc (num_fonts * sizeof **pfonts);
+ fonts = *pfonts;
+ }
+
/* Make a copy of the font name. */
fonts[n].name = xstrdup (name);
{
Lisp_Object list = Valternate_fontname_alist;
+ if (*pfonts)
+ {
+ xfree (*pfonts);
+ *pfonts = 0;
+ }
+
while (CONSP (list))
{
Lisp_Object entry = XCAR (list);
if (CONSP (entry)
&& STRINGP (XCAR (entry))
- && strcmp (XSTRING (XCAR (entry))->data, pattern) == 0)
+ && strcmp (SDATA (XCAR (entry)), pattern) == 0)
break;
list = XCDR (list);
}
STRINGP (name))
/* Ignore patterns equal to PATTERN because we tried that
already with no success. */
- && (strcmp (XSTRING (name)->data, pattern) == 0
- || (n = x_face_list_fonts (f, XSTRING (name)->data,
- fonts, nfonts, 0),
+ && (strcmp (SDATA (name), pattern) == 0
+ || (n = x_face_list_fonts (f, SDATA (name),
+ pfonts, nfonts, 0),
n == 0)))
patterns = XCDR (patterns);
}
/* Get the list of fonts matching pattern. 100 should suffice. */
nfonts = DEFAULT_FONT_LIST_LIMIT;
- if (INTEGERP (Vfont_list_limit) && XINT (Vfont_list_limit) > 0)
- nfonts = XFASTINT (Vfont_list_limit);
+ if (INTEGERP (Vfont_list_limit))
+ nfonts = XINT (Vfont_list_limit);
- *fonts = (struct font_name *) xmalloc (nfonts * sizeof **fonts);
- nfonts = x_face_list_fonts (f, pattern, *fonts, nfonts, 1);
+ *fonts = NULL;
+ nfonts = x_face_list_fonts (f, pattern, fonts, nfonts, 1);
/* Sort the resulting array and return it in *FONTS. If no
fonts were found, make sure to set *FONTS to null. */
if (nfonts)
sort_fonts (f, *fonts, nfonts, cmpfn);
- else
+ else if (*fonts)
{
xfree (*fonts);
*fonts = NULL;
}
- /* 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. 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. */
++/* 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)
if (NILP (pattern))
{
- family_str = (NILP (family) ? "*" : (char *) XSTRING (family)->data);
- registry_str = (NILP (registry) ? "*" : (char *) XSTRING (registry)->data);
+ family_str = (NILP (family) ? "*" : (char *) SDATA (family));
+ registry_str = (NILP (registry) ? "*" : (char *) SDATA (registry));
pattern_str = (char *) alloca (strlen (family_str)
+ strlen (registry_str)
}
}
else
- pattern_str = (char *) XSTRING (pattern)->data;
+ pattern_str = (char *) SDATA (pattern);
return sorted_font_list (f, pattern_str, cmp_font_names, 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.
Set *FONTS to a vector of font_name structures allocated from the
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;
+ }
}
}
struct font_name *fonts;
Lisp_Object result;
struct gcpro gcpro1;
- int count = specpdl_ptr - specpdl;
- int limit;
-
- /* Let's consider all fonts. Increase the limit for matching
- fonts until we have them all. */
- for (limit = 500;;)
- {
- specbind (intern ("font-list-limit"), make_number (limit));
- nfonts = font_list (f, Qnil, Qnil, Qnil, &fonts);
+ int count = SPECPDL_INDEX ();
- if (nfonts == limit)
- {
- free_font_names (fonts, nfonts);
- limit *= 2;
- }
- else
- break;
- }
+ /* Let's consider all fonts. */
+ specbind (intern ("font-list-limit"), make_number (-1));
+ nfonts = font_list (f, Qnil, Qnil, Qnil, &fonts);
result = Qnil;
GCPRO1 (result);
CHECK_STRING (pattern);
if (NILP (maximum))
- maxnames = 2000;
+ maxnames = -1;
else
{
CHECK_NATNUM (maximum);
{
/* 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);
+ int face_id = lookup_named_face (f, face);
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
- size = FONT_WIDTH (FRAME_FONT (f));
+ size = FONT_WIDTH (FRAME_FONT (f)); /* FRAME_COLUMN_WIDTH (f) */
if (!NILP (width))
size *= XINT (width);
#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])
|| NILP (attrs[LFACE_FONT_INDEX])
|| STRINGP (attrs[LFACE_FONT_INDEX]));
+ xassert (UNSPECIFIEDP (attrs[LFACE_FONTSET_INDEX])
+ || STRINGP (attrs[LFACE_FONTSET_INDEX]));
#endif
}
Lisp_Object aliased;
if (STRINGP (face_name))
- face_name = intern (XSTRING (face_name)->data);
+ face_name = intern (SDATA (face_name));
while (SYMBOLP (face_name))
{
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
if (i != LFACE_FONT_INDEX && i != LFACE_INHERIT_INDEX
-- && i != LFACE_AVGWIDTH_INDEX)
- if (UNSPECIFIEDP (attrs[i]))
++ && i != LFACE_AVGWIDTH_INDEX && i != LFACE_FONTSET_INDEX)
+ if (UNSPECIFIEDP (attrs[i]))
break;
return i == LFACE_VECTOR_SIZE;
If the fullname is not in a valid XLFD format,
return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
in LFACE and return 1.
- Otherwise, return 1.
-
- Currently this function is always called with both FORCE_P and
- MAIL_FAIL_P non-zero. */
+ Otherwise, return 1. */
static int
set_lface_from_font_name (f, lface, fontname, force_p, may_fail_p)
int pt;
int have_xlfd_p;
int fontset;
- char *font_name = XSTRING (fontname)->data;
+ char *font_name = SDATA (fontname);
struct font_info *font_info;
/* 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 = XSTRING (fontset_ascii (fontset))->data;
+ 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)
+ {
+ LFACE_FONT (lface) = build_string (font_info->full_name);
+ LFACE_FONTSET (lface) = fontset_name (fontset);
+ }
+ else
+ LFACE_FONT (lface) = fontname;
return 1;
}
add_to_log ("Invalid face color", color_name, Qnil);
}
else if (SYMBOLP (first)
- && *XSYMBOL (first)->name->data == ':')
+ && *SDATA (SYMBOL_NAME (first)) == ':')
{
/* Assume this is the property list form. */
while (CONSP (prop) && CONSP (XCDR (prop)))
if (!UNSPECIFIEDP (value))
{
CHECK_STRING (value);
- if (XSTRING (value)->size == 0)
+ if (SCHARS (value) == 0)
signal_error ("Invalid face family", value);
}
old_value = LFACE_FAMILY (lface);
&& !EQ (value, Qnil))
/* Underline color. */
|| (STRINGP (value)
- && XSTRING (value)->size == 0))
+ && SCHARS (value) == 0))
signal_error ("Invalid face underline", value);
old_value = LFACE_UNDERLINE (lface);
&& !EQ (value, Qnil))
/* Overline color. */
|| (STRINGP (value)
- && XSTRING (value)->size == 0))
+ && SCHARS (value) == 0))
signal_error ("Invalid face overline", value);
old_value = LFACE_OVERLINE (lface);
&& !EQ (value, Qnil))
/* Strike-through color. */
|| (STRINGP (value)
- && XSTRING (value)->size == 0))
+ && SCHARS (value) == 0))
signal_error ("Invalid face strike-through", value);
old_value = LFACE_STRIKE_THROUGH (lface);
else if (INTEGERP (value))
valid_p = XINT (value) != 0;
else if (STRINGP (value))
- valid_p = XSTRING (value)->size > 0;
+ valid_p = SCHARS (value) > 0;
else if (CONSP (value))
{
Lisp_Object tem;
}
else if (EQ (k, QCcolor))
{
- if (!STRINGP (v) || XSTRING (v)->size == 0)
+ if (!STRINGP (v) || SCHARS (v) == 0)
break;
}
else if (EQ (k, QCstyle))
on the frame (display) whether the color will be valid
when the face is realized. */
CHECK_STRING (value);
- if (XSTRING (value)->size == 0)
+ if (SCHARS (value) == 0)
signal_error ("Empty foreground color value", value);
}
old_value = LFACE_FOREGROUND (lface);
on the frame (display) whether the color will be valid
when the face is realized. */
CHECK_STRING (value);
- if (XSTRING (value)->size == 0)
+ if (SCHARS (value) == 0)
signal_error ("Empty background color value", value);
}
old_value = LFACE_BACKGROUND (lface);
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 (FRAME_WINDOW_P (XFRAME (frame)))
+ if (EQ (frame, Qt) || FRAME_WINDOW_P (XFRAME (frame)))
{
/* Set font-related attributes of the Lisp face from an XLFD
font name. */
struct frame *f;
Lisp_Object tmp;
- CHECK_STRING (value);
if (EQ (frame, Qt))
f = SELECTED_FRAME ();
else
f = check_x_frame (frame);
- /* VALUE may be a fontset name or an alias of fontset. In
- such a case, use the base fontset name. */
- tmp = Fquery_fontset (value, Qnil);
- if (!NILP (tmp))
- value = tmp;
- else if (EQ (attr, QCfontset))
- signal_error ("Invalid fontset name", value);
-
- if (EQ (attr, QCfont))
+ if (!UNSPECIFIEDP (value))
{
- if (!set_lface_from_font_name (f, lface, value, 1, 1))
- signal_error ("Invalid font or fontset name", value);
+ CHECK_STRING (value);
+
+ /* VALUE may be a fontset name or an alias of fontset. In
+ such a case, use the base fontset name. */
+ 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;
}
- else
- LFACE_FONTSET (lface) = value;
font_attr_p = 1;
}
init_iterator will then free realized faces. */
if (!EQ (frame, Qt)
&& (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. */
{
Lisp_Object font_name;
char *font;
-
+
if (STRINGP (LFACE_FONT (lface)))
font_name = LFACE_FONT (lface);
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);
++ font = choose_face_font (f, XVECTOR (lface)->contents, Qnil, NULL);
if (!font)
error ("No font matches the specified attribute");
font_name = build_string (font);
xfree (font);
}
-
+
+ f->default_face_done_p = 0;
Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, font_name), Qnil));
}
}
Lisp_Object resource, class, frame;
{
Lisp_Object value = Qnil;
-#ifndef WINDOWSNT
-#ifndef macintosh
CHECK_STRING (resource);
CHECK_STRING (class);
CHECK_LIVE_FRAME (frame);
value = display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame)),
resource, class, Qnil, Qnil);
UNBLOCK_INPUT;
-#endif /* not macintosh */
-#endif /* not WINDOWSNT */
return value;
}
xassert (STRINGP (value));
- if (xstricmp (XSTRING (value)->data, "on") == 0
- || xstricmp (XSTRING (value)->data, "true") == 0)
+ if (xstricmp (SDATA (value), "on") == 0
+ || xstricmp (SDATA (value), "true") == 0)
result = Qt;
- else if (xstricmp (XSTRING (value)->data, "off") == 0
- || xstricmp (XSTRING (value)->data, "false") == 0)
+ else if (xstricmp (SDATA (value), "off") == 0
+ || xstricmp (SDATA (value), "false") == 0)
result = Qnil;
- else if (xstricmp (XSTRING (value)->data, "unspecified") == 0)
+ else if (xstricmp (SDATA (value), "unspecified") == 0)
result = Qunspecified;
else if (signal_p)
signal_error ("Invalid face attribute value from X resource", value);
CHECK_SYMBOL (attr);
CHECK_STRING (value);
- if (xstricmp (XSTRING (value)->data, "unspecified") == 0)
+ if (xstricmp (SDATA (value), "unspecified") == 0)
value = Qunspecified;
else if (EQ (attr, QCheight))
{
else if (EQ (attr, QCbold) || EQ (attr, QCitalic))
value = face_boolean_x_resource_value (value, 1);
else if (EQ (attr, QCweight) || EQ (attr, QCslant) || EQ (attr, QCwidth))
- value = intern (XSTRING (value)->data);
+ value = intern (SDATA (value));
else if (EQ (attr, QCreverse_video) || EQ (attr, QCinverse_video))
value = face_boolean_x_resource_value (value, 1);
else if (EQ (attr, QCunderline)
char line[512];
Lisp_Object lface = lface_from_face_name (f, Qmenu, 1);
struct face *face = FACE_FROM_ID (f, MENU_FACE_ID);
- char *myname = XSTRING (Vx_resource_name)->data;
+ const char *myname = SDATA (Vx_resource_name);
int changed_p = 0;
#ifdef USE_MOTIF
const char *popup_path = "popup_menu";
#else
const char *popup_path = "menu.popup";
#endif
-
+
if (STRINGP (LFACE_FOREGROUND (lface)))
{
sprintf (line, "%s.%s*foreground: %s",
myname, popup_path,
- XSTRING (LFACE_FOREGROUND (lface))->data);
+ SDATA (LFACE_FOREGROUND (lface)));
XrmPutLineResource (&rdb, line);
sprintf (line, "%s.pane.menubar*foreground: %s",
- myname, XSTRING (LFACE_FOREGROUND (lface))->data);
+ myname, SDATA (LFACE_FOREGROUND (lface)));
XrmPutLineResource (&rdb, line);
changed_p = 1;
}
{
sprintf (line, "%s.%s*background: %s",
myname, popup_path,
- XSTRING (LFACE_BACKGROUND (lface))->data);
+ SDATA (LFACE_BACKGROUND (lface)));
XrmPutLineResource (&rdb, line);
sprintf (line, "%s.pane.menubar*background: %s",
- myname, XSTRING (LFACE_BACKGROUND (lface))->data);
+ myname, SDATA (LFACE_BACKGROUND (lface)));
XrmPutLineResource (&rdb, line);
changed_p = 1;
}
-
+
if (face->font_name
&& (!UNSPECIFIEDP (LFACE_FAMILY (lface))
|| !UNSPECIFIEDP (LFACE_SWIDTH (lface))
#endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
-DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p,
+DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p,
Sface_attribute_relative_p,
2, 2, 0,
doc: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
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);
else
{
struct frame *f = frame_or_selected_frame (frame, 1);
- int face_id = lookup_named_face (f, face, 0);
+ int face_id = lookup_named_face (f, face);
struct face *face = FACE_FROM_ID (f, face_id);
return face ? build_string (face->font_name) : Qnil;
}
switch (XTYPE (a))
{
case Lisp_String:
- equal_p = ((STRING_BYTES (XSTRING (a))
- == STRING_BYTES (XSTRING (b)))
- && bcmp (XSTRING (a)->data, XSTRING (b)->data,
- STRING_BYTES (XSTRING (a))) == 0);
+ equal_p = ((SBYTES (a)
+ == SBYTES (b))
+ && bcmp (SDATA (a), SDATA (b),
+ SBYTES (a)) == 0);
break;
case Lisp_Int:
hash_string_case_insensitive (string)
Lisp_Object string;
{
- unsigned char *s;
+ const unsigned char *s;
unsigned hash = 0;
xassert (STRINGP (string));
- for (s = XSTRING (string)->data; *s; ++s)
+ for (s = SDATA (string); *s; ++s)
hash = (hash << 1) ^ tolower (*s);
return hash;
}
/* 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)
{
xassert (lface_fully_specified_p (lface1)
&& lface_fully_specified_p (lface2));
- return (xstricmp (XSTRING (lface1[LFACE_FAMILY_INDEX])->data,
- XSTRING (lface2[LFACE_FAMILY_INDEX])->data) == 0
+ return (xstricmp (SDATA (lface1[LFACE_FAMILY_INDEX]),
+ SDATA (lface2[LFACE_FAMILY_INDEX])) == 0
&& EQ (lface1[LFACE_HEIGHT_INDEX], lface2[LFACE_HEIGHT_INDEX])
&& EQ (lface1[LFACE_SWIDTH_INDEX], lface2[LFACE_SWIDTH_INDEX])
&& EQ (lface1[LFACE_AVGWIDTH_INDEX], lface2[LFACE_AVGWIDTH_INDEX])
&& (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 (XSTRING (lface1[LFACE_FONT_INDEX])->data,
- XSTRING (lface2[LFACE_FONT_INDEX])->data)))
++ && ! 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 (XSTRING (lface1[LFACE_FONTSET_INDEX])->data,
- XSTRING (lface2[LFACE_FONTSET_INDEX])->data)))
++ && ! 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;
#ifdef WINDOWSNT
xgcv.font = face->font;
#endif
-#ifdef macintosh
+#ifdef MAC_OS
xgcv.font = face->font;
#endif
mask |= GCFont;
#endif /* HAVE_WINDOW_SYSTEM */
}
+\f
+/* Returns the `distance' between the colors X and Y. */
+
+static int
+color_distance (x, y)
+ XColor *x, *y;
+{
+ /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
+ Quoting from that paper:
+
+ This formula has results that are very close to L*u*v* (with the
+ modified lightness curve) and, more importantly, it is a more even
+ algorithm: it does not have a range of colours where it suddenly
+ gives far from optimal results.
+
+ See <http://www.compuphase.com/cmetric.htm> for more info. */
+
+ long r = (x->red - y->red) >> 8;
+ long g = (x->green - y->green) >> 8;
+ long b = (x->blue - y->blue) >> 8;
+ long r_mean = (x->red + y->red) >> 9;
+
+ return
+ (((512 + r_mean) * r * r) >> 8)
+ + 4 * g * g
+ + (((767 - r_mean) * b * b) >> 8);
+}
+
+
+DEFUN ("color-distance", Fcolor_distance, Scolor_distance, 2, 3, 0,
+ doc: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
+COLOR1 and COLOR2 may be either strings containing the color name,
+or lists of the form (RED GREEN BLUE).
+If FRAME is unspecified or nil, the current frame is used. */)
+ (color1, color2, frame)
+ Lisp_Object color1, color2, frame;
+{
+ struct frame *f;
+ XColor cdef1, cdef2;
+
+ if (NILP (frame))
+ frame = selected_frame;
+ CHECK_LIVE_FRAME (frame);
+ f = XFRAME (frame);
+
+ if ((CONSP (color1) && !parse_rgb_list (color1, &cdef1))
+ || !STRINGP (color1)
+ || !defined_color (f, SDATA (color1), &cdef1, 0))
+ signal_error ("Invalid color", color1);
+ if ((CONSP (color2) && !parse_rgb_list (color2, &cdef2))
+ || !STRINGP (color2)
+ || !defined_color (f, SDATA (color2), &cdef2, 0))
+ signal_error ("Invalid color", color2);
+
+ return make_number (color_distance (&cdef1, &cdef2));
+}
+
+\f
+/***********************************************************************
+ Face capability testing for ttys
+ ***********************************************************************/
+
+
+/* If the distance (as returned by color_distance) between two colors is
+ less than this, then they are considered the same, for determining
+ whether a color is supported or not. The range of values is 0-65535. */
+
+#define TTY_SAME_COLOR_THRESHOLD 10000
+
+
+DEFUN ("tty-supports-face-attributes-p",
+ Ftty_supports_face_attributes_p, Stty_supports_face_attributes_p,
+ 1, 2, 0,
+ doc: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
+The optional argument FRAME is the frame on which to test; if it is nil
+or unspecified, then the current frame is used. If FRAME is not a tty
+frame, then nil is returned.
+
+The definition of `supported' is somewhat heuristic, but basically means
+that a face containing all the attributes in ATTRIBUTES, when merged
+with the default face for display, can be represented in a way that's
+
+ \(1) different in appearance than the default face, and
+ \(2) `close in spirit' to what the attributes specify, if not exact.
+
+Point (2) implies that a `:weight black' attribute will be satisified
+by any terminal that can display bold, and a `:foreground "yellow"' as
+long as the terminal can display a yellowish color, but `:slant italic'
+will _not_ be satisified by the tty display code's automatic
+substitution of a `dim' face for italic. */)
+ (attributes, frame)
+ Lisp_Object attributes, frame;
+{
+ int weight, i;
+ struct frame *f;
+ Lisp_Object val, fg, bg;
+ XColor fg_tty_color, fg_std_color;
+ XColor bg_tty_color, bg_std_color;
+ Lisp_Object attrs[LFACE_VECTOR_SIZE];
+ unsigned test_caps = 0;
+
+ if (NILP (frame))
+ frame = selected_frame;
+ CHECK_LIVE_FRAME (frame);
+ f = XFRAME (frame);
+
+ for (i = 0; i < LFACE_VECTOR_SIZE; i++)
+ attrs[i] = Qunspecified;
+ merge_face_vector_with_property (f, attrs, attributes);
+
+ /* This function only works on ttys. */
+ if (!FRAME_TERMCAP_P (f) && !FRAME_MSDOS_P (f))
+ return Qnil;
+
+ /* First check some easy-to-check stuff; ttys support none of the
+ following attributes, so we can just return nil if any are requested. */
+
+ /* stipple */
+ val = attrs[LFACE_STIPPLE_INDEX];
+ if (!UNSPECIFIEDP (val) && !NILP (val))
+ return Qnil;
+
+ /* font height */
+ val = attrs[LFACE_HEIGHT_INDEX];
+ if (!UNSPECIFIEDP (val) && !NILP (val))
+ return Qnil;
+
+ /* font width */
+ val = attrs[LFACE_SWIDTH_INDEX];
+ if (!UNSPECIFIEDP (val) && !NILP (val)
+ && face_numeric_swidth (val) != XLFD_SWIDTH_MEDIUM)
+ return Qnil;
+
+ /* overline */
+ val = attrs[LFACE_OVERLINE_INDEX];
+ if (!UNSPECIFIEDP (val) && !NILP (val))
+ return Qnil;
+
+ /* strike-through */
+ val = attrs[LFACE_STRIKE_THROUGH_INDEX];
+ if (!UNSPECIFIEDP (val) && !NILP (val))
+ return Qnil;
+
+ /* boxes */
+ val = attrs[LFACE_BOX_INDEX];
+ if (!UNSPECIFIEDP (val) && !NILP (val))
+ return Qnil;
+
+ /* slant (italics/oblique); We consider any non-default value
+ unsupportable on ttys, even though the face code actually `fakes'
+ them using a dim attribute if possible. This is because the faked
+ result is too different from what the face specifies. */
+ val = attrs[LFACE_SLANT_INDEX];
+ if (!UNSPECIFIEDP (val) && !NILP (val)
+ && face_numeric_slant (val) != XLFD_SLANT_ROMAN)
+ return Qnil;
+
+
+ /* Test for terminal `capabilities' (non-color character attributes). */
+
+ /* font weight (bold/dim) */
+ weight = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
+ if (weight >= 0)
+ {
+ if (weight > XLFD_WEIGHT_MEDIUM)
+ test_caps = TTY_CAP_BOLD;
+ else if (weight < XLFD_WEIGHT_MEDIUM)
+ test_caps = TTY_CAP_DIM;
+ }
+
+ /* underlining */
+ val = attrs[LFACE_UNDERLINE_INDEX];
+ if (!UNSPECIFIEDP (val) && !NILP (val))
+ {
+ if (STRINGP (val))
+ return Qnil; /* ttys don't support colored underlines */
+ else
+ test_caps |= TTY_CAP_UNDERLINE;
+ }
+
+ /* inverse video */
+ val = attrs[LFACE_INVERSE_INDEX];
+ if (!UNSPECIFIEDP (val) && !NILP (val))
+ test_caps |= TTY_CAP_INVERSE;
+
+
+ /* Color testing. */
+
+ /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
+ we use them when calling `tty_capable_p' below, even if the face
+ specifies no colors. */
+ fg_tty_color.pixel = FACE_TTY_DEFAULT_FG_COLOR;
+ bg_tty_color.pixel = FACE_TTY_DEFAULT_BG_COLOR;
+
+ /* Check if foreground color is close enough. */
+ fg = attrs[LFACE_FOREGROUND_INDEX];
+ if (STRINGP (fg))
+ {
+ if (! tty_lookup_color (f, fg, &fg_tty_color, &fg_std_color))
+ return Qnil;
+ else if (color_distance (&fg_tty_color, &fg_std_color)
+ > TTY_SAME_COLOR_THRESHOLD)
+ return Qnil;
+ }
+
+ /* Check if background color is close enough. */
+ bg = attrs[LFACE_BACKGROUND_INDEX];
+ if (STRINGP (bg))
+ {
+ if (! tty_lookup_color (f, bg, &bg_tty_color, &bg_std_color))
+ return Qnil;
+ else if (color_distance (&bg_tty_color, &bg_std_color)
+ > TTY_SAME_COLOR_THRESHOLD)
+ return Qnil;
+ }
+
+ /* If both foreground and background are requested, see if the
+ distance between them is OK. We just check to see if the distance
+ between the tty's foreground and background is close enough to the
+ distance between the standard foreground and background. */
+ if (STRINGP (fg) && STRINGP (bg))
+ {
+ int delta_delta
+ = (color_distance (&fg_std_color, &bg_std_color)
+ - color_distance (&fg_tty_color, &bg_tty_color));
+ if (delta_delta > TTY_SAME_COLOR_THRESHOLD
+ || delta_delta < -TTY_SAME_COLOR_THRESHOLD)
+ return Qnil;
+ }
+
+
+ /* See if the capabilities we selected above are supported, with the
+ given colors. */
+ if (test_caps != 0 &&
+ ! tty_capable_p (f, test_caps, fg_tty_color.pixel, bg_tty_color.pixel))
+ return Qnil;
+
+
+ /* Hmmm, everything checks out, this terminal must support this face. */
+ return Qt;
+}
+
+
\f
/***********************************************************************
Face Cache
}
- /* 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));
-
- /* 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
#endif /* GLYPH_DEBUG */
return face->id;
}
-INLINE int
+ /* 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;
+ }
+
/* 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)
+ lookup_named_face (f, symbol)
struct frame *f;
Lisp_Object symbol;
- int c;
{
Lisp_Object attrs[LFACE_VECTOR_SIZE];
Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
get_lface_attributes (f, symbol, symbol_attrs, 1);
bcopy (default_face->lface, attrs, sizeof attrs);
merge_face_vectors (f, symbol_attrs, attrs, Qnil);
- 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);
+ face_id = lookup_named_face (f, face_name);
}
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)
+ lookup_derived_face (f, symbol, face_id)
struct frame *f;
Lisp_Object symbol;
- int c;
int face_id;
{
Lisp_Object attrs[LFACE_VECTOR_SIZE];
get_lface_attributes (f, symbol, symbol_attrs, 1);
bcopy (default_face->lface, attrs, sizeof attrs);
merge_face_vectors (f, symbol_attrs, attrs, Qnil);
- return lookup_face (f, attrs, c, default_face);
+ return lookup_face (f, attrs);
}
DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector,
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.
struct font_name *font;
int specified_pt;
{
- char point_size[20], pixel_size[20];
+ char pixel_size[20];
int pixel_value;
double resy = FRAME_X_DISPLAY_INFO (f)->resy;
double pt;
/* We should keep POINT_SIZE 0. Otherwise, X server can't open a
font of the specified PIXEL_SIZE. */
#if 0
- /* Set point size of the font. */
- sprintf (point_size, "%d", (int) pt);
- font->fields[XLFD_POINT_SIZE] = point_size;
- font->numeric[XLFD_POINT_SIZE] = pt;
+ { /* Set point size of the font. */
+ char point_size[20];
+ sprintf (point_size, "%d", (int) pt);
+ font->fields[XLFD_POINT_SIZE] = point_size;
+ font->numeric[XLFD_POINT_SIZE] = pt;
+ }
#endif
/* Set pixel size. */
static int
may_use_scalable_font_p (font)
- char *font;
+ const char *font;
{
if (EQ (Vscalable_fonts_allowed, Qt))
return 1;
widths if ATTRS specifies such a width.
Value is a font name which is allocated from the heap. FONTS is
- freed by this function. */
+ freed by this function.
+
+ 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. */
static char *
-best_matching_font (f, attrs, fonts, nfonts, width_ratio)
+best_matching_font (f, attrs, fonts, nfonts, width_ratio, needs_overstrike)
struct frame *f;
Lisp_Object *attrs;
struct font_name *fonts;
int nfonts;
int width_ratio;
+ int *needs_overstrike;
{
char *font_name;
struct font_name *best;
exact_p = 0;
+ if (needs_overstrike)
+ *needs_overstrike = 0;
+
/* Start with the first non-scalable font in the list. */
for (i = 0; i < nfonts; ++i)
if (!font_scalable_p (fonts + i))
if (exact_p)
break;
}
-
}
else
best = NULL;
&& !better_font_p (specified, best, fonts + i, 0, 0)))
best = fonts + i;
}
+
+ if (needs_overstrike)
+ {
+ enum xlfd_weight want_weight = specified[XLFD_WEIGHT];
+ enum xlfd_weight got_weight = best->numeric[XLFD_WEIGHT];
+
+ if (want_weight > XLFD_WEIGHT_MEDIUM && want_weight > got_weight)
+ {
+ /* We want a bold font, but didn't get one; try to use
+ overstriking instead to simulate bold-face. However,
+ don't overstrike an already-bold fontn unless the
+ desired weight grossly exceeds the available weight. */
+ if (got_weight > XLFD_WEIGHT_MEDIUM)
+ *needs_overstrike = (got_weight - want_weight) > 2;
+ else
+ *needs_overstrike = 1;
+ }
+ }
}
if (font_scalable_p (best))
REGISTRY, if a string, specifies a font registry and encoding to
match. A value of nil means include fonts of any registry and
encoding.
-
+
Return in *FONTS a pointer to a vector of font_name structures for
the fonts matched. Value is the number of fonts found. */
nfonts = font_list (f, Qnil, XCAR (alter), registry, fonts);
}
}
-
- /* Try scalable fonts before giving up. */
+
+ /* Try all scalable fonts before giving up. */
if (nfonts == 0 && ! EQ (Vscalable_fonts_allowed, Qt))
{
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
specbind (Qscalable_fonts_allowed, Qt);
nfonts = try_alternative_families (f, family, registry, fonts);
unbind_to (count, Qnil);
/* 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
- /* 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. */
- if (nfonts == 0 && STRINGP (try_family) && STRINGP (registry)
- && xstricmp (SDATA (registry), "mac-roman") == 0)
- nfonts = try_alternative_families (f, try_family, Qnil, fonts);
- #endif
+ if (STRINGP (pattern))
+ nfonts = font_list (f, pattern, Qnil, Qnil, fonts);
+ 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 = font_list (f, Qnil, family, registry, fonts);
++ 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 = font_list (f, Qnil, Qnil, registry, fonts);
++ nfonts = try_alternative_families (f, Qnil, registry, fonts);
}
- /* Try any family with the given registry. */
- if (nfonts == 0)
- nfonts = font_list (f, Qnil, Qnil, registry, fonts);
-
return nfonts;
}
Lisp_Object *attrs;
{
Lisp_Object name;
- int fontset;
- 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 a list
+ [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
+ 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)
++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;
- /* 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 (needs_overstrike)
+ *needs_overstrike = 0;
+
- return xstrdup (XSTRING (attrs[LFACE_FONT_INDEX])->data);
+ /* 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 (STRINGP (AREF (font_spec, FONT_SPEC_FAMILY_INDEX)))
+ family = Fcons (AREF (font_spec, FONT_SPEC_FAMILY_INDEX), family);
+ adstyle = AREF (font_spec, FONT_SPEC_ADSTYLE_INDEX);
+ registry = Fcons (AREF (font_spec, FONT_SPEC_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 = STRING_BYTES (XSTRING (ascii));
++ len = SBYTES (ascii);
+ if (len < 9
- || strcmp (XSTRING (ascii)->data + len - 9, "iso8859-1"))
++ || 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));
++ font_name = best_matching_font (f, attrs, fonts, nfonts, NILP (font_spec),
+ needs_overstrike);
return font_name;
}
struct frame *f;
{
int success_p = 0;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
/* Block input here so that we won't be surprised by an X expose
event, for instance, without having the faces set up. */
x_update_menu_appearance (f);
#endif
}
-
+
success_p = 1;
}
/* If the `default' face is not yet known, create it. */
lface = lface_from_face_name (f, Qdefault, 0);
if (NILP (lface))
- {
- Lisp_Object frame;
- XSETFRAME (frame, f);
- lface = Finternal_make_lisp_face (Qdefault, frame);
- }
+ {
+ Lisp_Object frame;
+ XSETFRAME (frame, f);
+ lface = Finternal_make_lisp_face (Qdefault, frame);
+ }
+
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
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, 1, 1);
+ set_lface_from_font_name (f, lface, frame_font,
+ f->default_face_done_p, 1);
+ 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);
return 1;
}
merge_face_vectors (f, symbol_attrs, attrs, Qnil);
/* 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
abort ();
/* Insert the new face. */
cache_face (cache, face, lface_hash (attrs));
- #ifdef HAVE_WINDOW_SYSTEM
- if (FRAME_WINDOW_P (cache->f) && face->font == NULL)
- load_face_font (cache->f, face, c);
- #endif /* HAVE_WINDOW_SYSTEM */
+ return face;
+ }
+
+
+ /* 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 face *face;
+ struct font_info *font_info;
+
+ face = (struct face *) xmalloc (sizeof *face);
+ *face = *base_face;
+ face->gc = 0;
+
+ /* 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;
}
/* 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;
{
#ifdef HAVE_WINDOW_SYSTEM
struct face *face, *default_face;
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;
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 ();
- face->font = NULL; /* to force realize_face to load font */
-
-#ifdef macintosh
- /* Load the font if it is specified in ATTRS. This fixes
- changing frame font on the Mac. */
- if (STRINGP (attrs[LFACE_FONT_INDEX]))
- {
- struct font_info *font_info =
- FS_LOAD_FONT (f, XSTRING (attrs[LFACE_FONT_INDEX])->data);
- if (font_info)
- face->font = font_info->font;
- }
-#endif
- if (! face->font)
- load_face_font (f, face);
++ load_face_font (f, face);
+ face->fontset = make_fontset_for_ascii_face (f, fontset, face);
}
/* Load colors, and set remaining attributes. */
if (!NILP (stipple))
face->stipple = load_pixmap (f, stipple, &face->pixmap_w, &face->pixmap_h);
-- xassert (FACE_SUITABLE_FOR_CHAR_P (face, c));
return face;
#endif /* HAVE_WINDOW_SYSTEM */
}
pixel = default_pixel = FACE_TTY_DEFAULT_BG_COLOR;
default_other_pixel = FACE_TTY_DEFAULT_FG_COLOR;
}
-
+
XSETFRAME (frame, f);
color = face->lface[idx];
-
+
if (STRINGP (color)
- && XSTRING (color)->size
+ && SCHARS (color)
&& CONSP (Vtty_defined_color_alist)
&& (def = assq_no_quit (color, call1 (Qtty_color_alist, frame)),
CONSP (def)))
/* 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;
/* Map color names to color indices. */
map_tty_color (f, face, LFACE_FOREGROUND_INDEX, &face_colors_defaulted);
map_tty_color (f, face, LFACE_BACKGROUND_INDEX, &face_colors_defaulted);
-
+
/* Swap colors if face is inverse-video. If the colors are taken
from the frame colors, they are already inverted, since the
frame-creation function calls x-handle-reverse-video. */
else
{
Lisp_Object attrs[LFACE_VECTOR_SIZE];
- struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
- bcopy (default_face->lface, attrs, sizeof attrs);
+ struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ bcopy (face->lface, attrs, sizeof attrs);
merge_face_vector_with_property (f, attrs, prop);
- face_id = lookup_face (f, attrs, ch, NULL);
+ face_id = lookup_face (f, attrs);
+ if (! ASCII_CHAR_P (ch))
+ {
+ face = FACE_FROM_ID (f, face_id);
+ face_id = FACE_FOR_CHAR (f, face, ch);
+ }
}
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);
}
Limit is the maximum position up to which to check for property
changes in Fnext_single_property_change. Strings are usually
short, so set the limit to the end of the string. */
- XSETFASTINT (limit, XSTRING (string)->size);
+ XSETFASTINT (limit, SCHARS (string));
end = Fnext_single_property_change (position, prop_name, string, limit);
if (INTEGERP (end))
*endptr = XFASTINT (end);
/* 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);
}
#endif
fprintf (stderr, "foreground: 0x%lx (%s)\n",
face->foreground,
- XSTRING (face->lface[LFACE_FOREGROUND_INDEX])->data);
+ SDATA (face->lface[LFACE_FOREGROUND_INDEX]));
fprintf (stderr, "background: 0x%lx (%s)\n",
face->background,
- XSTRING (face->lface[LFACE_BACKGROUND_INDEX])->data);
+ SDATA (face->lface[LFACE_BACKGROUND_INDEX]));
fprintf (stderr, "font_name: %s (%s)\n",
face->font_name,
- XSTRING (face->lface[LFACE_FAMILY_INDEX])->data);
+ SDATA (face->lface[LFACE_FAMILY_INDEX]));
#ifdef HAVE_X_WINDOWS
fprintf (stderr, "font = %p\n", face->font);
#endif
fprintf (stderr, "fontset: %d\n", face->fontset);
fprintf (stderr, "underline: %d (%s)\n",
face->underline_p,
- XSTRING (Fsymbol_name (face->lface[LFACE_UNDERLINE_INDEX]))->data);
+ 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");
staticpro (&Qmode_line_inactive);
Qtty_color_desc = intern ("tty-color-desc");
staticpro (&Qtty_color_desc);
+ Qtty_color_standard_values = intern ("tty-color-standard-values");
+ staticpro (&Qtty_color_standard_values);
Qtty_color_by_index = intern ("tty-color-by-index");
staticpro (&Qtty_color_by_index);
Qtty_color_alist = intern ("tty-color-alist");
defsubr (&Sinternal_merge_in_global_face);
defsubr (&Sface_font);
defsubr (&Sframe_face_alist);
+ defsubr (&Stty_supports_face_attributes_p);
+ defsubr (&Scolor_distance);
defsubr (&Sinternal_set_font_selection_order);
defsubr (&Sinternal_set_alternative_font_family_alist);
defsubr (&Sinternal_set_alternative_font_registry_alist);
ignore. */);
Vface_ignored_fonts = Qnil;
-
DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist,
doc: /* Alist of fonts vs the rescaling factors.
Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
/* Functions for the X window system.
- Copyright (C) 1989, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 01, 02
+ Copyright (C) 1989, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 01, 02, 03
Free Software Foundation.
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 "[.bitmaps]gray.xbm"
#endif
+#ifdef USE_GTK
+#include "gtkutil.h"
+#endif
+
#ifdef USE_X_TOOLKIT
#include <X11/Shell.h>
int gray_bitmap_height = gray_height;
char *gray_bitmap_bits = gray_bits;
-/* The name we're using in resource queries. Most often "emacs". */
-
-Lisp_Object Vx_resource_name;
-
-/* The application class we're using in resource queries.
- Normally "Emacs". */
-
-Lisp_Object Vx_resource_class;
-
/* Non-zero means we're allowed to display an hourglass cursor. */
int display_hourglass_p;
Lisp_Object Vx_pixel_size_width_font_regexp;
-Lisp_Object Qauto_raise;
-Lisp_Object Qauto_lower;
-Lisp_Object Qbar;
-Lisp_Object Qborder_color;
-Lisp_Object Qborder_width;
-Lisp_Object Qbox;
-Lisp_Object Qcursor_color;
-Lisp_Object Qcursor_type;
-Lisp_Object Qgeometry;
-Lisp_Object Qicon_left;
-Lisp_Object Qicon_top;
-Lisp_Object Qicon_type;
-Lisp_Object Qicon_name;
-Lisp_Object Qinternal_border_width;
-Lisp_Object Qleft;
-Lisp_Object Qright;
-Lisp_Object Qmouse_color;
Lisp_Object Qnone;
-Lisp_Object Qouter_window_id;
-Lisp_Object Qparent_id;
-Lisp_Object Qscroll_bar_width;
Lisp_Object Qsuppress_icon;
-extern Lisp_Object Qtop;
Lisp_Object Qundefined_color;
-Lisp_Object Qvertical_scroll_bars;
-Lisp_Object Qvisibility;
-Lisp_Object Qwindow_id;
-Lisp_Object Qx_frame_parameter;
-Lisp_Object Qx_resource_name;
-Lisp_Object Quser_position;
-Lisp_Object Quser_size;
-extern Lisp_Object Qdisplay;
-Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
-Lisp_Object Qscreen_gamma, Qline_spacing, Qcenter;
+Lisp_Object Qcenter;
Lisp_Object Qcompound_text, Qcancel_timer;
-Lisp_Object Qwait_for_wm;
-Lisp_Object Qfullscreen;
-Lisp_Object Qfullwidth;
-Lisp_Object Qfullheight;
-Lisp_Object Qfullboth;
-
-/* The below are defined in frame.c. */
-extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
-extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
-extern Lisp_Object Qtool_bar_lines;
+/* In dispnew.c */
extern Lisp_Object Vwindow_system_version;
-Lisp_Object Qface_set_after_frame_default;
+/* The below are defined in frame.c. */
#if GLYPH_DEBUG
int image_cache_refcount, dpyinfo_refcount;
nil stands for the selected frame--or, if that is not an X frame,
the first X display on the list. */
-static struct x_display_info *
+struct x_display_info *
check_x_display_info (frame)
Lisp_Object frame;
{
struct x_display_info *dpyinfo = NULL;
-
+
if (NILP (frame))
{
struct frame *sf = XFRAME (selected_frame);
-
+
if (FRAME_X_P (sf) && FRAME_LIVE_P (sf))
dpyinfo = FRAME_X_DISPLAY_INFO (sf);
else if (x_display_list != 0)
dpyinfo = x_display_info_for_name (frame);
else
{
- FRAME_PTR f;
-
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
- if (! FRAME_X_P (f))
- error ("Non-X frame used");
+ FRAME_PTR f = check_x_frame (frame);
dpyinfo = FRAME_X_DISPLAY_INFO (f);
}
if (f->output_data.x->hourglass_window == wdesc)
return f;
#ifdef USE_X_TOOLKIT
- if ((f->output_data.x->edit_widget
+ if ((f->output_data.x->edit_widget
&& XtWindow (f->output_data.x->edit_widget) == wdesc)
/* A tooltip frame? */
|| (!f->output_data.x->edit_widget
|| f->output_data.x->icon_desc == wdesc)
return f;
#else /* not USE_X_TOOLKIT */
+#ifdef USE_GTK
+ if (f->output_data.x->edit_widget)
+ {
+ GtkWidget *gwdesc = xg_win_to_widget (wdesc);
+ struct x_output *x = f->output_data.x;
+ if (gwdesc != 0 && gwdesc == x->edit_widget)
+ return f;
+ }
+#endif /* USE_GTK */
if (FRAME_X_WINDOW (f) == wdesc
|| f->output_data.x->icon_desc == wdesc)
return f;
return 0;
}
-#ifdef USE_X_TOOLKIT
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
/* Like x_window_to_frame but also compares the window with the widget's
windows. */
frame = XCAR (tail);
if (!GC_FRAMEP (frame))
continue;
-
+
f = XFRAME (frame);
if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo)
{
found = f;
else if (x->widget)
{
- if (wdesc == XtWindow (x->widget)
- || wdesc == XtWindow (x->column_widget)
+#ifdef USE_GTK
+ GtkWidget *gwdesc = xg_win_to_widget (wdesc);
+ if (gwdesc != 0
+ && (gwdesc == x->widget
+ || gwdesc == x->edit_widget
+ || gwdesc == x->vbox_widget
+ || gwdesc == x->menubar_widget))
+ found = f;
+#else
+ if (wdesc == XtWindow (x->widget)
+ || wdesc == XtWindow (x->column_widget)
|| wdesc == XtWindow (x->edit_widget))
found = f;
/* Match if the window is this frame's menubar. */
else if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
found = f;
+#endif
}
else if (FRAME_X_WINDOW (f) == wdesc)
/* A tooltip frame. */
found = f;
}
}
-
+
return found;
}
return f;
else if (x->widget)
{
- if (wdesc == XtWindow (x->widget)
- || wdesc == XtWindow (x->column_widget)
+#ifdef USE_GTK
+ GtkWidget *gwdesc = xg_win_to_widget (wdesc);
+ if (gwdesc != 0
+ && (gwdesc == x->widget
+ || gwdesc == x->edit_widget
+ || gwdesc == x->vbox_widget))
+ return f;
+#else
+ if (wdesc == XtWindow (x->widget)
+ || wdesc == XtWindow (x->column_widget)
|| wdesc == XtWindow (x->edit_widget))
return f;
+#endif
}
else if (FRAME_X_WINDOW (f) == wdesc)
/* A tooltip frame. */
continue;
x = f->output_data.x;
/* Match if the window is this frame's menubar. */
+#ifdef USE_GTK
+ if (x->menubar_widget)
+ {
+ GtkWidget *gwdesc = xg_win_to_widget (wdesc);
+ int found = 0;
+
+ BLOCK_INPUT;
+ if (gwdesc != 0
+ && (gwdesc == x->menubar_widget
+ || gtk_widget_get_parent (gwdesc) == x->menubar_widget))
+ found = 1;
+ UNBLOCK_INPUT;
+ if (found) return f;
+ }
+#else
if (x->menubar_widget
&& lw_window_is_in_menubar (wdesc, x->menubar_widget))
return f;
+#endif
}
return 0;
}
if (x->widget)
{
/* This frame matches if the window is its topmost widget. */
+#ifdef USE_GTK
+ GtkWidget *gwdesc = xg_win_to_widget (wdesc);
+ if (gwdesc == x->widget)
+ return f;
+#else
if (wdesc == XtWindow (x->widget))
return f;
#if 0 /* I don't know why it did this,
but it seems logically wrong,
and it causes trouble for MapNotify events. */
/* Match if the window is this frame's menubar. */
- if (x->menubar_widget
+ if (x->menubar_widget
&& wdesc == XtWindow (x->menubar_widget))
return f;
+#endif
#endif
}
else if (FRAME_X_WINDOW (f) == wdesc)
}
return 0;
}
-#endif /* USE_X_TOOLKIT */
+#endif /* USE_X_TOOLKIT || USE_GTK */
\f
return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
}
+int
+x_bitmap_mask (f, id)
+ FRAME_PTR f;
+ int id;
+{
+ return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].mask;
+}
+
/* Allocate a new bitmap record. Returns index of new record. */
bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
bits, width, height);
+
+
if (! bitmap)
return -1;
id = x_allocate_bitmap_record (f);
dpyinfo->bitmaps[id - 1].pixmap = bitmap;
+ dpyinfo->bitmaps[id - 1].have_mask = 0;
dpyinfo->bitmaps[id - 1].file = NULL;
dpyinfo->bitmaps[id - 1].refcount = 1;
dpyinfo->bitmaps[id - 1].depth = 1;
{
if (dpyinfo->bitmaps[id].refcount
&& dpyinfo->bitmaps[id].file
- && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
+ && !strcmp (dpyinfo->bitmaps[id].file, (char *) SDATA (file)))
{
++dpyinfo->bitmaps[id].refcount;
return id + 1;
}
/* Search bitmap-file-path for the file, if appropriate. */
- fd = openp (Vx_bitmap_file_path, file, Qnil, &found, 0);
+ fd = openp (Vx_bitmap_file_path, file, Qnil, &found, Qnil);
if (fd < 0)
return -1;
emacs_close (fd);
- filename = (char *) XSTRING (found)->data;
+ filename = (char *) SDATA (found);
result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
filename, &width, &height, &bitmap, &xhot, &yhot);
id = x_allocate_bitmap_record (f);
dpyinfo->bitmaps[id - 1].pixmap = bitmap;
+ dpyinfo->bitmaps[id - 1].have_mask = 0;
dpyinfo->bitmaps[id - 1].refcount = 1;
dpyinfo->bitmaps[id - 1].file
- = (char *) xmalloc (STRING_BYTES (XSTRING (file)) + 1);
+ = (char *) xmalloc (SBYTES (file) + 1);
dpyinfo->bitmaps[id - 1].depth = 1;
dpyinfo->bitmaps[id - 1].height = height;
dpyinfo->bitmaps[id - 1].width = width;
- strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
+ strcpy (dpyinfo->bitmaps[id - 1].file, SDATA (file));
return id;
}
{
BLOCK_INPUT;
XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
+ if (dpyinfo->bitmaps[id - 1].have_mask)
+ XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].mask);
if (dpyinfo->bitmaps[id - 1].file)
{
xfree (dpyinfo->bitmaps[id - 1].file);
if (dpyinfo->bitmaps[i].refcount > 0)
{
XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
+ if (dpyinfo->bitmaps[i].have_mask)
+ XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].mask);
if (dpyinfo->bitmaps[i].file)
xfree (dpyinfo->bitmaps[i].file);
}
dpyinfo->bitmaps_last = 0;
}
\f
-/* Connect the frame-parameter names for X frames
- to the ways of passing the parameter values to the window system.
- The name of a parameter, as a Lisp symbol,
- has an `x-frame-parameter' property which is an integer in Lisp
- that is an index in this table. */
-struct x_frame_parm_table
+
+/* Useful functions defined in the section
+ `Image type independent image structures' below. */
+
+static unsigned long four_corners_best P_ ((XImage *ximg, unsigned long width,
+ unsigned long height));
+
+static int x_create_x_image_and_pixmap P_ ((struct frame *f, int width, int height,
+ int depth, XImage **ximg,
+ Pixmap *pixmap));
+
+static void x_destroy_x_image P_ ((XImage *ximg));
+
+
+/* Create a mask of a bitmap. Note is this not a perfect mask.
+ It's nicer with some borders in this context */
+
+int
+x_create_bitmap_mask(f, id)
+ struct frame *f;
+ int id;
{
- char *name;
- void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
-};
+ Pixmap pixmap, mask;
+ XImage *ximg, *mask_img;
+ unsigned long width, height;
+ int result;
+ unsigned long bg;
+ unsigned long x, y, xp, xm, yp, ym;
+ GC gc;
+
+ int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
+ struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+
+ if (!(id > 0))
+ return -1;
+
+ pixmap = x_bitmap_pixmap(f, id);
+ width = x_bitmap_width(f, id);
+ height = x_bitmap_height(f, id);
+
+ BLOCK_INPUT;
+ ximg = XGetImage (FRAME_X_DISPLAY (f), pixmap, 0, 0, width, height,
+ ~0, ZPixmap);
+
+ if (!ximg)
+ {
+ UNBLOCK_INPUT;
+ return -1;
+ }
+
+ result = x_create_x_image_and_pixmap (f, width, height, 1, &mask_img, &mask);
+
+ UNBLOCK_INPUT;
+ if (!result)
+ {
+ XDestroyImage(ximg);
+ return -1;
+ }
+
+ bg = four_corners_best (ximg, width, height);
+
+ for (y = 0; y < ximg->height; ++y)
+ {
+ for (x = 0; x < ximg->width; ++x)
+ {
+ xp = x != ximg->width - 1 ? x + 1 : 0;
+ xm = x != 0 ? x - 1 : ximg->width - 1;
+ yp = y != ximg->height - 1 ? y + 1 : 0;
+ ym = y != 0 ? y - 1 : ximg->height - 1;
+ if (XGetPixel (ximg, x, y) == bg
+ && XGetPixel (ximg, x, yp) == bg
+ && XGetPixel (ximg, x, ym) == bg
+ && XGetPixel (ximg, xp, y) == bg
+ && XGetPixel (ximg, xp, yp) == bg
+ && XGetPixel (ximg, xp, ym) == bg
+ && XGetPixel (ximg, xm, y) == bg
+ && XGetPixel (ximg, xm, yp) == bg
+ && XGetPixel (ximg, xm, ym) == bg)
+ XPutPixel (mask_img, x, y, 0);
+ else
+ XPutPixel (mask_img, x, y, 1);
+ }
+ }
+
+ xassert (interrupt_input_blocked);
+ gc = XCreateGC (FRAME_X_DISPLAY (f), mask, 0, NULL);
+ XPutImage (FRAME_X_DISPLAY (f), mask, gc, mask_img, 0, 0, 0, 0,
+ width, height);
+ XFreeGC (FRAME_X_DISPLAY (f), gc);
+
+ dpyinfo->bitmaps[id - 1].have_mask = 1;
+ dpyinfo->bitmaps[id - 1].mask = mask;
+
+ XDestroyImage (ximg);
+ x_destroy_x_image(mask_img);
+
+ return 0;
+}
static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
-static void x_change_window_heights P_ ((Lisp_Object, int));
static void x_disable_image P_ ((struct frame *, struct image *));
+
void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
-static void x_set_line_spacing P_ ((struct frame *, Lisp_Object, Lisp_Object));
static void x_set_wait_for_wm P_ ((struct frame *, Lisp_Object, Lisp_Object));
-static void x_set_fullscreen P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
-static void x_set_fringe_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
-void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
-void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
-void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
- Lisp_Object));
void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
-void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
-void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
-void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
- Lisp_Object));
-void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
-void x_set_scroll_bar_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
-void x_set_unsplittable P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
Lisp_Object));
Lisp_Object,
char *, char *,
int));
-static void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object));
static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
Lisp_Object));
static void init_color_table P_ ((void));
-static struct x_frame_parm_table x_frame_parms[] =
-{
- {"auto-raise", x_set_autoraise},
- {"auto-lower", x_set_autolower},
- {"background-color", x_set_background_color},
- {"border-color", x_set_border_color},
- {"border-width", x_set_border_width},
- {"cursor-color", x_set_cursor_color},
- {"cursor-type", x_set_cursor_type},
- {"font", x_set_font},
- {"foreground-color", x_set_foreground_color},
- {"icon-name", x_set_icon_name},
- {"icon-type", x_set_icon_type},
- {"internal-border-width", x_set_internal_border_width},
- {"menu-bar-lines", x_set_menu_bar_lines},
- {"mouse-color", x_set_mouse_color},
- {"name", x_explicitly_set_name},
- {"scroll-bar-width", x_set_scroll_bar_width},
- {"title", x_set_title},
- {"unsplittable", x_set_unsplittable},
- {"vertical-scroll-bars", x_set_vertical_scroll_bars},
- {"visibility", x_set_visibility},
- {"tool-bar-lines", x_set_tool_bar_lines},
- {"scroll-bar-foreground", x_set_scroll_bar_foreground},
- {"scroll-bar-background", x_set_scroll_bar_background},
- {"screen-gamma", x_set_screen_gamma},
- {"line-spacing", x_set_line_spacing},
- {"left-fringe", x_set_fringe_width},
- {"right-fringe", x_set_fringe_width},
- {"wait-for-wm", x_set_wait_for_wm},
- {"fullscreen", x_set_fullscreen},
-
-};
-
-/* Attach the `x-frame-parameter' properties to
- the Lisp symbol names of parameters relevant to X. */
-
-void
-init_x_parm_symbols ()
-{
- int i;
-
- for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
- Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
- make_number (i));
-}
\f
-/* Really try to move where we want to be in case of fullscreen. Some WMs
- moves the window where we tell them. Some (mwm, twm) moves the outer
- window manager window there instead.
- Try to compensate for those WM here. */
-static void
-x_fullscreen_move (f, new_top, new_left)
- struct frame *f;
- int new_top;
- int new_left;
-{
- if (new_top != f->output_data.x->top_pos
- || new_left != f->output_data.x->left_pos)
- {
- int move_x = new_left + f->output_data.x->x_pixels_outer_diff;
- int move_y = new_top + f->output_data.x->y_pixels_outer_diff;
-
- f->output_data.x->want_fullscreen |= FULLSCREEN_MOVE_WAIT;
- x_set_offset (f, move_x, move_y, 1);
- }
-}
-
-/* Change the parameters of frame F as specified by ALIST.
- If a parameter is not specially recognized, do nothing special;
- otherwise call the `x_set_...' function for that parameter.
- Except for certain geometry properties, always call store_frame_param
- to store the new value in the parameter alist. */
-
-void
-x_set_frame_parameters (f, alist)
- FRAME_PTR f;
- Lisp_Object alist;
-{
- Lisp_Object tail;
-
- /* If both of these parameters are present, it's more efficient to
- set them both at once. So we wait until we've looked at the
- entire list before we set them. */
- int width, height;
-
- /* Same here. */
- Lisp_Object left, top;
-
- /* Same with these. */
- Lisp_Object icon_left, icon_top;
-
- /* Record in these vectors all the parms specified. */
- Lisp_Object *parms;
- Lisp_Object *values;
- int i, p;
- int left_no_change = 0, top_no_change = 0;
- int icon_left_no_change = 0, icon_top_no_change = 0;
- int fullscreen_is_being_set = 0;
-
- struct gcpro gcpro1, gcpro2;
-
- i = 0;
- for (tail = alist; CONSP (tail); tail = Fcdr (tail))
- i++;
-
- parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
- values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
-
- /* Extract parm names and values into those vectors. */
-
- i = 0;
- for (tail = alist; CONSP (tail); tail = Fcdr (tail))
- {
- Lisp_Object elt;
-
- elt = Fcar (tail);
- parms[i] = Fcar (elt);
- values[i] = Fcdr (elt);
- i++;
- }
- /* TAIL and ALIST are not used again below here. */
- alist = tail = Qnil;
-
- GCPRO2 (*parms, *values);
- gcpro1.nvars = i;
- gcpro2.nvars = i;
-
- /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
- because their values appear in VALUES and strings are not valid. */
- top = left = Qunbound;
- icon_left = icon_top = Qunbound;
-
- /* Provide default values for HEIGHT and WIDTH. */
- if (FRAME_NEW_WIDTH (f))
- width = FRAME_NEW_WIDTH (f);
- else
- width = FRAME_WIDTH (f);
-
- if (FRAME_NEW_HEIGHT (f))
- height = FRAME_NEW_HEIGHT (f);
- else
- height = FRAME_HEIGHT (f);
-
- /* Process foreground_color and background_color before anything else.
- They are independent of other properties, but other properties (e.g.,
- cursor_color) are dependent upon them. */
- /* Process default font as well, since fringe widths depends on it. */
- /* Also, process fullscreen, width and height depend upon that */
- for (p = 0; p < i; p++)
- {
- Lisp_Object prop, val;
-
- prop = parms[p];
- val = values[p];
- if (EQ (prop, Qforeground_color)
- || EQ (prop, Qbackground_color)
- || EQ (prop, Qfont)
- || EQ (prop, Qfullscreen))
- {
- register Lisp_Object param_index, old_value;
-
- old_value = get_frame_param (f, prop);
- fullscreen_is_being_set |= EQ (prop, Qfullscreen);
-
- if (NILP (Fequal (val, old_value)))
- {
- store_frame_param (f, prop, val);
-
- param_index = Fget (prop, Qx_frame_parameter);
- if (NATNUMP (param_index)
- && (XFASTINT (param_index)
- < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
- (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
- }
- }
- }
-
- /* Now process them in reverse of specified order. */
- for (i--; i >= 0; i--)
- {
- Lisp_Object prop, val;
-
- prop = parms[i];
- val = values[i];
-
- if (EQ (prop, Qwidth) && NUMBERP (val))
- width = XFASTINT (val);
- else if (EQ (prop, Qheight) && NUMBERP (val))
- height = XFASTINT (val);
- else if (EQ (prop, Qtop))
- top = val;
- else if (EQ (prop, Qleft))
- left = val;
- else if (EQ (prop, Qicon_top))
- icon_top = val;
- else if (EQ (prop, Qicon_left))
- icon_left = val;
- else if (EQ (prop, Qforeground_color)
- || EQ (prop, Qbackground_color)
- || EQ (prop, Qfont)
- || EQ (prop, Qfullscreen))
- /* Processed above. */
- continue;
- else
- {
- register Lisp_Object param_index, old_value;
-
- old_value = get_frame_param (f, prop);
-
- store_frame_param (f, prop, val);
-
- param_index = Fget (prop, Qx_frame_parameter);
- if (NATNUMP (param_index)
- && (XFASTINT (param_index)
- < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
- (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
- }
- }
-
- /* Don't die if just one of these was set. */
- if (EQ (left, Qunbound))
- {
- left_no_change = 1;
- if (f->output_data.x->left_pos < 0)
- left = Fcons (Qplus, Fcons (make_number (f->output_data.x->left_pos), Qnil));
- else
- XSETINT (left, f->output_data.x->left_pos);
- }
- if (EQ (top, Qunbound))
- {
- top_no_change = 1;
- if (f->output_data.x->top_pos < 0)
- top = Fcons (Qplus, Fcons (make_number (f->output_data.x->top_pos), Qnil));
- else
- XSETINT (top, f->output_data.x->top_pos);
- }
-
- /* If one of the icon positions was not set, preserve or default it. */
- if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
- {
- icon_left_no_change = 1;
- icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
- if (NILP (icon_left))
- XSETINT (icon_left, 0);
- }
- if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
- {
- icon_top_no_change = 1;
- icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
- if (NILP (icon_top))
- XSETINT (icon_top, 0);
- }
-
- if (FRAME_VISIBLE_P (f) && fullscreen_is_being_set)
- {
- /* If the frame is visible already and the fullscreen parameter is
- being set, it is too late to set WM manager hints to specify
- size and position.
- Here we first get the width, height and position that applies to
- fullscreen. We then move the frame to the appropriate
- position. Resize of the frame is taken care of in the code after
- this if-statement. */
- int new_left, new_top;
-
- x_fullscreen_adjust (f, &width, &height, &new_top, &new_left);
- x_fullscreen_move (f, new_top, new_left);
- }
-
- /* Don't set these parameters unless they've been explicitly
- specified. The window might be mapped or resized while we're in
- this function, and we don't want to override that unless the lisp
- code has asked for it.
-
- Don't set these parameters unless they actually differ from the
- window's current parameters; the window may not actually exist
- yet. */
- {
- Lisp_Object frame;
-
- check_frame_size (f, &height, &width);
-
- XSETFRAME (frame, f);
-
- if (width != FRAME_WIDTH (f)
- || height != FRAME_HEIGHT (f)
- || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
- Fset_frame_size (frame, make_number (width), make_number (height));
-
- if ((!NILP (left) || !NILP (top))
- && ! (left_no_change && top_no_change)
- && ! (NUMBERP (left) && XINT (left) == f->output_data.x->left_pos
- && NUMBERP (top) && XINT (top) == f->output_data.x->top_pos))
- {
- int leftpos = 0;
- int toppos = 0;
-
- /* Record the signs. */
- f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative);
- if (EQ (left, Qminus))
- f->output_data.x->size_hint_flags |= XNegative;
- else if (INTEGERP (left))
- {
- leftpos = XINT (left);
- if (leftpos < 0)
- f->output_data.x->size_hint_flags |= XNegative;
- }
- else if (CONSP (left) && EQ (XCAR (left), Qminus)
- && CONSP (XCDR (left))
- && INTEGERP (XCAR (XCDR (left))))
- {
- leftpos = - XINT (XCAR (XCDR (left)));
- f->output_data.x->size_hint_flags |= XNegative;
- }
- else if (CONSP (left) && EQ (XCAR (left), Qplus)
- && CONSP (XCDR (left))
- && INTEGERP (XCAR (XCDR (left))))
- {
- leftpos = XINT (XCAR (XCDR (left)));
- }
-
- if (EQ (top, Qminus))
- f->output_data.x->size_hint_flags |= YNegative;
- else if (INTEGERP (top))
- {
- toppos = XINT (top);
- if (toppos < 0)
- f->output_data.x->size_hint_flags |= YNegative;
- }
- else if (CONSP (top) && EQ (XCAR (top), Qminus)
- && CONSP (XCDR (top))
- && INTEGERP (XCAR (XCDR (top))))
- {
- toppos = - XINT (XCAR (XCDR (top)));
- f->output_data.x->size_hint_flags |= YNegative;
- }
- else if (CONSP (top) && EQ (XCAR (top), Qplus)
- && CONSP (XCDR (top))
- && INTEGERP (XCAR (XCDR (top))))
- {
- toppos = XINT (XCAR (XCDR (top)));
- }
-
-
- /* Store the numeric value of the position. */
- f->output_data.x->top_pos = toppos;
- f->output_data.x->left_pos = leftpos;
-
- f->output_data.x->win_gravity = NorthWestGravity;
-
- /* Actually set that position, and convert to absolute. */
- x_set_offset (f, leftpos, toppos, -1);
- }
-
- if ((!NILP (icon_left) || !NILP (icon_top))
- && ! (icon_left_no_change && icon_top_no_change))
- x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
- }
-
- UNGCPRO;
-}
-
/* Store the screen positions of frame F into XPTR and YPTR.
These are the positions of the containing window manager window,
not Emacs's own window. */
Window wm_window, rootw;
Window *tmp_children;
unsigned int tmp_nchildren;
+ int success;
- XQueryTree (FRAME_X_DISPLAY (f), win, &rootw,
- &wm_window, &tmp_children, &tmp_nchildren);
- XFree ((char *) tmp_children);
+ success = XQueryTree (FRAME_X_DISPLAY (f), win, &rootw,
+ &wm_window, &tmp_children, &tmp_nchildren);
had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
+ /* Don't free tmp_children if XQueryTree failed. */
+ if (! success)
+ break;
+
+ XFree ((char *) tmp_children);
+
if (wm_window == rootw || had_errors)
break;
win = wm_window;
}
-
+
if (! had_errors)
{
int ign;
Window child, rootw;
-
+
/* Get the real coordinates for the WM window upper left corner */
XGetGeometry (FRAME_X_DISPLAY (f), win,
&rootw, &real_x, &real_y, &ign, &ign, &ign, &ign);
/* From-window, to-window. */
FRAME_X_DISPLAY_INFO (f)->root_window,
FRAME_OUTER_WINDOW (f),
-
+
/* From-position, to-position. */
real_x, real_y, &outer_x, &outer_y,
-
+
/* Child of win. */
&child);
- }
+ }
had_errors = x_had_errors_p (FRAME_X_DISPLAY (f));
}
-
+
x_uncatch_errors (FRAME_X_DISPLAY (f), count);
-
+
UNBLOCK_INPUT;
if (had_errors) return;
-
- f->output_data.x->x_pixels_diff = -win_x;
- f->output_data.x->y_pixels_diff = -win_y;
- f->output_data.x->x_pixels_outer_diff = -outer_x;
- f->output_data.x->y_pixels_outer_diff = -outer_y;
+
+ f->x_pixels_diff = -win_x;
+ f->y_pixels_diff = -win_y;
+
+ FRAME_X_OUTPUT (f)->x_pixels_outer_diff = -outer_x;
+ FRAME_X_OUTPUT (f)->y_pixels_outer_diff = -outer_y;
*xptr = real_x;
*yptr = real_y;
}
-/* Insert a description of internally-recorded parameters of frame X
- into the parameter alist *ALISTPTR that is to be given to the user.
- Only parameters that are specific to the X window system
- and whose values are not correctly recorded in the frame's
- param_alist need to be considered here. */
-
-void
-x_report_frame_params (f, alistptr)
- struct frame *f;
- Lisp_Object *alistptr;
-{
- char buf[16];
- Lisp_Object tem;
-
- /* Represent negative positions (off the top or left screen edge)
- in a way that Fmodify_frame_parameters will understand correctly. */
- XSETINT (tem, f->output_data.x->left_pos);
- if (f->output_data.x->left_pos >= 0)
- store_in_alist (alistptr, Qleft, tem);
- else
- store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
-
- XSETINT (tem, f->output_data.x->top_pos);
- if (f->output_data.x->top_pos >= 0)
- store_in_alist (alistptr, Qtop, tem);
- else
- store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
-
- store_in_alist (alistptr, Qborder_width,
- make_number (f->output_data.x->border_width));
- store_in_alist (alistptr, Qinternal_border_width,
- make_number (f->output_data.x->internal_border_width));
- store_in_alist (alistptr, Qleft_fringe,
- make_number (f->output_data.x->left_fringe_width));
- store_in_alist (alistptr, Qright_fringe,
- make_number (f->output_data.x->right_fringe_width));
- store_in_alist (alistptr, Qscroll_bar_width,
- make_number (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
- ? FRAME_SCROLL_BAR_PIXEL_WIDTH(f)
- : 0));
- sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
- store_in_alist (alistptr, Qwindow_id,
- build_string (buf));
-#ifdef USE_X_TOOLKIT
- /* Tooltip frame may not have this widget. */
- if (f->output_data.x->widget)
-#endif
- sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
- store_in_alist (alistptr, Qouter_window_id,
- build_string (buf));
- store_in_alist (alistptr, Qicon_name, f->icon_name);
- FRAME_SAMPLE_VISIBILITY (f);
- store_in_alist (alistptr, Qvisibility,
- (FRAME_VISIBLE_P (f) ? Qt
- : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
- store_in_alist (alistptr, Qdisplay,
- XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
-
- if (f->output_data.x->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
- tem = Qnil;
- else
- XSETFASTINT (tem, f->output_data.x->parent_desc);
- store_in_alist (alistptr, Qparent_id, tem);
-}
\f
#if 0 /* Don't do this. It's wrong when we're not using the default
colormap, it makes freeing difficult, and it's probably not
an important optimization. */
- if (strcmp (XSTRING (color_name)->data, "black") == 0)
+ if (strcmp (SDATA (color_name), "black") == 0)
return BLACK_PIX_DEFAULT (f);
- else if (strcmp (XSTRING (color_name)->data, "white") == 0)
+ else if (strcmp (SDATA (color_name), "white") == 0)
return WHITE_PIX_DEFAULT (f);
#endif
/* x_defined_color is responsible for coping with failures
by looking for a near-miss. */
- if (x_defined_color (f, XSTRING (color_name)->data, &cdef, 1))
+ if (x_defined_color (f, SDATA (color_name), &cdef, 1))
return cdef.pixel;
Fsignal (Qerror, Fcons (build_string ("Undefined color"),
\f
-/* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
- the previous value of that parameter, NEW_VALUE is the new value. */
-
-static void
-x_set_line_spacing (f, new_value, old_value)
- struct frame *f;
- Lisp_Object new_value, old_value;
-{
- if (NILP (new_value))
- f->extra_line_spacing = 0;
- else if (NATNUMP (new_value))
- f->extra_line_spacing = XFASTINT (new_value);
- else
- Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"),
- Fcons (new_value, Qnil)));
- if (FRAME_VISIBLE_P (f))
- redraw_frame (f);
-}
-
-
/* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
the previous value of that parameter, NEW_VALUE is the new value.
See also the comment of wait_for_wm in struct x_output. */
f->output_data.x->wait_for_wm = !NILP (new_value);
}
+#ifdef USE_GTK
-/* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
- the previous value of that parameter, NEW_VALUE is the new value. */
+static Lisp_Object x_find_image_file P_ ((Lisp_Object file));
-static void
-x_set_fullscreen (f, new_value, old_value)
- struct frame *f;
- Lisp_Object new_value, old_value;
-{
- if (NILP (new_value))
- f->output_data.x->want_fullscreen = FULLSCREEN_NONE;
- else if (EQ (new_value, Qfullboth))
- f->output_data.x->want_fullscreen = FULLSCREEN_BOTH;
- else if (EQ (new_value, Qfullwidth))
- f->output_data.x->want_fullscreen = FULLSCREEN_WIDTH;
- else if (EQ (new_value, Qfullheight))
- f->output_data.x->want_fullscreen = FULLSCREEN_HEIGHT;
-}
+/* Set icon from FILE for frame F. By using GTK functions the icon
+ may be any format that GdkPixbuf knows about, i.e. not just bitmaps. */
+int
+xg_set_icon(f, file)
+ FRAME_PTR f;
+ Lisp_Object file;
+{
+ struct gcpro gcpro1;
+ int result = 0;
+ Lisp_Object found;
-/* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
- the previous value of that parameter, NEW_VALUE is the new
- value. */
+ GCPRO1 (found);
-static void
-x_set_screen_gamma (f, new_value, old_value)
- struct frame *f;
- Lisp_Object new_value, old_value;
-{
- if (NILP (new_value))
- f->gamma = 0;
- else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
- /* The value 0.4545 is the normal viewing gamma. */
- f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
- else
- Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"),
- Fcons (new_value, Qnil)));
+ found = x_find_image_file (file);
- clear_face_cache (0);
-}
+ if (! NILP (found))
+ {
+ GdkPixbuf *pixbuf;
+ GError *err = NULL;
+ char *filename;
+ filename = SDATA (found);
+ BLOCK_INPUT;
-/* Functions called only from `x_set_frame_param'
- to set individual parameters.
+ pixbuf = gdk_pixbuf_new_from_file (filename, &err);
- If FRAME_X_WINDOW (f) is 0,
- the frame is being created and its X-window does not exist yet.
- In that case, just record the parameter's new value
- in the standard place; do not attempt to change the window. */
+ if (pixbuf)
+ {
+ gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
+ pixbuf);
+ g_object_unref (pixbuf);
+
+ result = 1;
+ }
+ else
+ g_error_free (err);
+
+ UNBLOCK_INPUT;
+ }
+
+ UNGCPRO;
+ return result;
+}
+#endif /* USE_GTK */
+
+
+/* Functions called only from `x_set_frame_param'
+ to set individual parameters.
+
+ If FRAME_X_WINDOW (f) is 0,
+ the frame is being created and its X-window does not exist yet.
+ In that case, just record the parameter's new value
+ in the standard place; do not attempt to change the window. */
void
x_set_foreground_color (f, arg, oldval)
if (FRAME_X_WINDOW (f) != 0)
{
Display *dpy = FRAME_X_DISPLAY (f);
-
+
BLOCK_INPUT;
XSetForeground (dpy, x->normal_gc, fg);
XSetBackground (dpy, x->reverse_gc, fg);
x->cursor_pixel = x_copy_color (f, fg);
XSetBackground (dpy, x->cursor_gc, x->cursor_pixel);
}
-
+
UNBLOCK_INPUT;
-
+
update_face_from_frame_parameter (f, Qforeground_color, arg);
-
+
if (FRAME_VISIBLE_P (f))
redraw_frame (f);
}
-
+
unload_color (f, old_fg);
}
if (FRAME_X_WINDOW (f) != 0)
{
Display *dpy = FRAME_X_DISPLAY (f);
-
+
BLOCK_INPUT;
XSetBackground (dpy, x->normal_gc, bg);
XSetForeground (dpy, x->reverse_gc, bg);
XSetWindowBackground (dpy, FRAME_X_WINDOW (f), bg);
XSetForeground (dpy, x->cursor_gc, bg);
+#ifdef USE_GTK
+ xg_set_background_color (f, bg);
+#endif
+
#ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
toolkit scroll bars. */
{
{
struct x_output *x = f->output_data.x;
Display *dpy = FRAME_X_DISPLAY (f);
- Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
+ Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
Cursor hourglass_cursor, horizontal_drag_cursor;
int count;
unsigned long pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
else
hourglass_cursor = XCreateFontCursor (dpy, XC_watch);
x_check_errors (dpy, "bad hourglass pointer cursor: %s");
-
+
x_check_errors (dpy, "bad nontext pointer cursor: %s");
if (!NILP (Vx_mode_pointer_shape))
{
if (!NILP (Vx_sensitive_text_pointer_shape))
{
CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
- cross_cursor
+ hand_cursor
= XCreateFontCursor (dpy, XINT (Vx_sensitive_text_pointer_shape));
}
else
- cross_cursor = XCreateFontCursor (dpy, XC_crosshair);
+ hand_cursor = XCreateFontCursor (dpy, XC_hand2);
if (!NILP (Vx_window_horizontal_drag_shape))
{
x_query_color (f, &fore_color);
back_color.pixel = mask_color;
x_query_color (f, &back_color);
-
+
XRecolorCursor (dpy, cursor, &fore_color, &back_color);
XRecolorCursor (dpy, nontext_cursor, &fore_color, &back_color);
XRecolorCursor (dpy, mode_cursor, &fore_color, &back_color);
- XRecolorCursor (dpy, cross_cursor, &fore_color, &back_color);
+ XRecolorCursor (dpy, hand_cursor, &fore_color, &back_color);
XRecolorCursor (dpy, hourglass_cursor, &fore_color, &back_color);
XRecolorCursor (dpy, horizontal_drag_cursor, &fore_color, &back_color);
}
&& x->modeline_cursor != 0)
XFreeCursor (dpy, f->output_data.x->modeline_cursor);
x->modeline_cursor = mode_cursor;
-
- if (cross_cursor != x->cross_cursor
- && x->cross_cursor != 0)
- XFreeCursor (dpy, x->cross_cursor);
- x->cross_cursor = cross_cursor;
+
+ if (hand_cursor != x->hand_cursor
+ && x->hand_cursor != 0)
+ XFreeCursor (dpy, x->hand_cursor);
+ x->hand_cursor = hand_cursor;
if (horizontal_drag_cursor != x->horizontal_drag_cursor
&& x->horizontal_drag_cursor != 0)
}
else
fore_pixel = x->background_pixel;
-
+
pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
pixel_allocated_p = 1;
x_free_colors (f, &pixel, 1);
pixel_allocated_p = 0;
}
-
+
pixel = x->mouse_pixel;
if (pixel == fore_pixel)
{
update_face_from_frame_parameter (f, Qcursor_color, arg);
}
\f
-/* Set the border-color of frame F to value described by ARG.
- ARG can be a string naming a color.
- The border-color is used for the border that is drawn by the X server.
- Note that this does not fully take effect if done before
- F has an x-window; it must be redone when the window is created.
-
- Note: this is done in two routines because of the way X10 works.
-
- Note: under X11, this is normally the province of the window manager,
- and so emacs' border colors may be overridden. */
-
-void
-x_set_border_color (f, arg, oldval)
- struct frame *f;
- Lisp_Object arg, oldval;
-{
- int pix;
-
- CHECK_STRING (arg);
- pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
- x_set_border_pixel (f, pix);
- update_face_from_frame_parameter (f, Qborder_color, arg);
-}
-
/* Set the border-color of frame F to pixel value PIX.
Note that this does not fully take effect if done before
F has an x-window. */
unload_color (f, f->output_data.x->border_pixel);
f->output_data.x->border_pixel = pix;
- if (FRAME_X_WINDOW (f) != 0 && f->output_data.x->border_width > 0)
+ if (FRAME_X_WINDOW (f) != 0 && f->border_width > 0)
{
BLOCK_INPUT;
XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
}
}
+/* Set the border-color of frame F to value described by ARG.
+ ARG can be a string naming a color.
+ The border-color is used for the border that is drawn by the X server.
+ Note that this does not fully take effect if done before
+ F has an x-window; it must be redone when the window is created.
-/* Value is the internal representation of the specified cursor type
- ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
- of the bar cursor. */
+ Note: this is done in two routines because of the way X10 works.
-enum text_cursor_kinds
-x_specified_cursor_type (arg, width)
- Lisp_Object arg;
- int *width;
+ Note: under X11, this is normally the province of the window manager,
+ and so emacs' border colors may be overridden. */
+
+void
+x_set_border_color (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
{
- enum text_cursor_kinds type;
-
- if (EQ (arg, Qbar))
- {
- type = BAR_CURSOR;
- *width = 2;
- }
- else if (CONSP (arg)
- && EQ (XCAR (arg), Qbar)
- && INTEGERP (XCDR (arg))
- && XINT (XCDR (arg)) >= 0)
- {
- type = BAR_CURSOR;
- *width = XINT (XCDR (arg));
- }
- else if (NILP (arg))
- type = NO_CURSOR;
- else
- /* Treat anything unknown as "box cursor".
- It was bad to signal an error; people have trouble fixing
- .Xdefaults with Emacs, when it has something bad in it. */
- type = FILLED_BOX_CURSOR;
+ int pix;
- return type;
+ CHECK_STRING (arg);
+ pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
+ x_set_border_pixel (f, pix);
+ update_face_from_frame_parameter (f, Qborder_color, arg);
}
+
void
x_set_cursor_type (f, arg, oldval)
FRAME_PTR f;
Lisp_Object arg, oldval;
{
- int width;
-
- FRAME_DESIRED_CURSOR (f) = x_specified_cursor_type (arg, &width);
- f->output_data.x->cursor_width = width;
+ set_frame_cursor_types (f, arg);
- /* Make sure the cursor gets redrawn. This is overkill, but how
- often do people change cursor types? */
- update_mode_lines++;
+ /* Make sure the cursor gets redrawn. */
+ cursor_type_changed = 1;
}
\f
void
BLOCK_INPUT;
if (NILP (arg))
result = x_text_icon (f,
- (char *) XSTRING ((!NILP (f->icon_name)
+ (char *) SDATA ((!NILP (f->icon_name)
? f->icon_name
- : f->name))->data);
+ : f->name)));
else
result = x_bitmap_icon (f, arg);
UNBLOCK_INPUT;
}
-/* Return non-nil if frame F wants a bitmap icon. */
-
-Lisp_Object
-x_icon_type (f)
- FRAME_PTR f;
-{
- Lisp_Object tem;
-
- tem = assq_no_quit (Qicon_type, f->param_alist);
- if (CONSP (tem))
- return XCDR (tem);
- else
- return Qnil;
-}
-
void
x_set_icon_name (f, arg, oldval)
struct frame *f;
BLOCK_INPUT;
result = x_text_icon (f,
- (char *) XSTRING ((!NILP (f->icon_name)
- ? f->icon_name
- : !NILP (f->title)
- ? f->title
- : f->name))->data);
+ (char *) SDATA ((!NILP (f->icon_name)
+ ? f->icon_name
+ : !NILP (f->title)
+ ? f->title
+ : f->name)));
if (result)
{
XFlush (FRAME_X_DISPLAY (f));
UNBLOCK_INPUT;
}
-\f
-void
-x_set_font (f, arg, oldval)
- struct frame *f;
- Lisp_Object arg, oldval;
-{
- Lisp_Object result;
- Lisp_Object fontset_name;
- Lisp_Object frame;
- int old_fontset = f->output_data.x->fontset;
-
- CHECK_STRING (arg);
-
- fontset_name = Fquery_fontset (arg, Qnil);
-
- BLOCK_INPUT;
- result = (STRINGP (fontset_name)
- ? x_new_fontset (f, fontset_name)
- : x_new_fontset (f, arg));
- UNBLOCK_INPUT;
-
- if (EQ (result, Qnil))
- error ("Font `%s' is not defined", XSTRING (arg)->data);
- else if (EQ (result, Qt))
- error ("The default fontset can't be used for a frame font");
- else if (STRINGP (result))
- {
- if (STRINGP (fontset_name))
- {
- /* Fontset names are built from ASCII font names, so the
- names may be equal despite there was a change. */
- if (old_fontset == f->output_data.x->fontset)
- return;
- }
- store_frame_param (f, Qfont, result);
- if (!NILP (Fequal (result, oldval)))
- return;
-
- recompute_basic_faces (f);
- }
- else
- abort ();
-
- do_pending_window_change (0);
-
- /* Don't call `face-set-after-frame-default' when faces haven't been
- initialized yet. This is the case when called from
- Fx_create_frame. In that case, the X widget or window doesn't
- exist either, and we can end up in x_report_frame_params with a
- null widget which gives a segfault. */
- if (FRAME_FACE_CACHE (f))
- {
- XSETFRAME (frame, f);
- call1 (Qface_set_after_frame_default, frame);
- }
-}
-
-static void
-x_set_fringe_width (f, new_value, old_value)
- struct frame *f;
- Lisp_Object new_value, old_value;
-{
- x_compute_fringe_widths (f, 1);
-}
-
-void
-x_set_border_width (f, arg, oldval)
- struct frame *f;
- Lisp_Object arg, oldval;
-{
- CHECK_NUMBER (arg);
-
- if (XINT (arg) == f->output_data.x->border_width)
- return;
-
- if (FRAME_X_WINDOW (f) != 0)
- error ("Cannot change the border width of a window");
-
- f->output_data.x->border_width = XINT (arg);
-}
-
-void
-x_set_internal_border_width (f, arg, oldval)
- struct frame *f;
- Lisp_Object arg, oldval;
-{
- int old = f->output_data.x->internal_border_width;
-
- CHECK_NUMBER (arg);
- f->output_data.x->internal_border_width = XINT (arg);
- if (f->output_data.x->internal_border_width < 0)
- f->output_data.x->internal_border_width = 0;
-
-#ifdef USE_X_TOOLKIT
- if (f->output_data.x->edit_widget)
- widget_store_internal_border (f->output_data.x->edit_widget);
-#endif
-
- if (f->output_data.x->internal_border_width == old)
- return;
-
- if (FRAME_X_WINDOW (f) != 0)
- {
- x_set_window_size (f, 0, f->width, f->height);
- SET_FRAME_GARBAGED (f);
- do_pending_window_change (0);
- }
- else
- SET_FRAME_GARBAGED (f);
-}
-
-void
-x_set_visibility (f, value, oldval)
- struct frame *f;
- Lisp_Object value, oldval;
-{
- Lisp_Object frame;
- XSETFRAME (frame, f);
-
- if (NILP (value))
- Fmake_frame_invisible (frame, Qt);
- else if (EQ (value, Qicon))
- Ficonify_frame (frame);
- else
- Fmake_frame_visible (frame);
-}
\f
-/* Change window heights in windows rooted in WINDOW by N lines. */
-
-static void
-x_change_window_heights (window, n)
- Lisp_Object window;
- int n;
-{
- struct window *w = XWINDOW (window);
-
- XSETFASTINT (w->top, XFASTINT (w->top) + n);
- XSETFASTINT (w->height, XFASTINT (w->height) - n);
-
- if (INTEGERP (w->orig_top))
- XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n);
- if (INTEGERP (w->orig_height))
- XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n);
-
- /* Handle just the top child in a vertical split. */
- if (!NILP (w->vchild))
- x_change_window_heights (w->vchild, n);
-
- /* Adjust all children in a horizontal split. */
- for (window = w->hchild; !NILP (window); window = w->next)
- {
- w = XWINDOW (window);
- x_change_window_heights (window, n);
- }
-}
-
void
x_set_menu_bar_lines (f, value, oldval)
struct frame *f;
/* Make sure we redisplay all windows in this frame. */
windows_or_buffers_changed++;
-#ifdef USE_X_TOOLKIT
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
FRAME_MENU_BAR_LINES (f) = 0;
if (nlines)
{
if (FRAME_X_P (f))
f->output_data.x->menubar_widget = 0;
}
-#else /* not USE_X_TOOLKIT */
+#else /* not USE_X_TOOLKIT && not USE_GTK */
FRAME_MENU_BAR_LINES (f) = nlines;
- x_change_window_heights (f->root_window, nlines - olines);
+ change_window_heights (f->root_window, nlines - olines);
#endif /* not USE_X_TOOLKIT */
adjust_glyphs (f);
}
else
nlines = 0;
- /* Make sure we redisplay all windows in this frame. */
+#ifdef USE_GTK
+ FRAME_TOOL_BAR_LINES (f) = 0;
+ if (nlines)
+ {
+ FRAME_EXTERNAL_TOOL_BAR (f) = 1;
+ if (FRAME_X_P (f) && f->output_data.x->toolbar_widget == 0)
+ /* Make sure next redisplay shows the tool bar. */
+ XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
+ update_frame_tool_bar (f);
+ }
+ else
+ {
+ if (FRAME_EXTERNAL_TOOL_BAR (f))
+ free_frame_tool_bar (f);
+ FRAME_EXTERNAL_TOOL_BAR (f) = 0;
+ }
+
+ return;
+#endif
+
+ /* Make sure we redisplay all windows in this frame. */
++windows_or_buffers_changed;
delta = nlines - FRAME_TOOL_BAR_LINES (f);
/* Don't resize the tool-bar to more than we have room for. */
root_window = FRAME_ROOT_WINDOW (f);
- root_height = XINT (XWINDOW (root_window)->height);
+ root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
if (root_height - delta < 1)
{
delta = root_height - 1;
}
FRAME_TOOL_BAR_LINES (f) = nlines;
- x_change_window_heights (root_window, delta);
+ change_window_heights (root_window, delta);
adjust_glyphs (f);
-
+
/* We also have to make sure that the internal border at the top of
the frame, below the menu bar or tool bar, is redrawn when the
tool bar disappears. This is so because the internal border is
if (delta < 0)
{
int height = FRAME_INTERNAL_BORDER_WIDTH (f);
- int width = PIXEL_WIDTH (f);
- int y = nlines * CANON_Y_UNIT (f);
+ int width = FRAME_PIXEL_WIDTH (f);
+ int y = nlines * FRAME_LINE_HEIGHT (f);
BLOCK_INPUT;
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
Lisp_Object value, oldval;
{
unsigned long pixel;
-
+
if (STRINGP (value))
pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
else
if (f->output_data.x->scroll_bar_foreground_pixel != -1)
unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
-
+
f->output_data.x->scroll_bar_foreground_pixel = pixel;
if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
{
pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
else
pixel = -1;
-
+
if (f->output_data.x->scroll_bar_background_pixel != -1)
unload_color (f, f->output_data.x->scroll_bar_background_pixel);
-
+
#ifdef USE_TOOLKIT_SCROLL_BARS
/* Scrollbar shadow colors. */
if (f->output_data.x->scroll_bar_top_shadow_pixel != -1)
(*condemn_scroll_bars_hook) (f);
if (judge_scroll_bars_hook)
(*judge_scroll_bars_hook) (f);
-
+
update_face_from_frame_parameter (f, Qscroll_bar_background, value);
redraw_frame (f);
}
int *text_bytes, *stringp;
int selectionp;
{
- 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 = STRING_BYTES (XSTRING (string));
++ *text_bytes = SBYTES (string);
*stringp = 1;
- return str;
- return XSTRING (string)->data;
++ return SDATA (string);
}
setup_coding_system (coding_system, &coding);
- if (selectionp
- && SYMBOLP (coding.pre_write_conversion)
- && !NILP (Ffboundp (coding.pre_write_conversion)))
- {
- string = run_pre_post_conversion_on_str (string, &coding, 1);
- 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 = XSTRING (string)->size * 2;
++ coding.dst_bytes = SCHARS (string) * 2;
+ coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
+ encode_coding_object (&coding, string, 0, 0,
- XSTRING (string)->size,
- STRING_BYTES (XSTRING (string)), Qnil);
++ 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)));
- return buf;
+ *stringp = (result == 1 || !EQ (coding_system, Qcompound_text));
+ return coding.destination;
}
\f
Lisp_Object name;
int explicit;
{
- /* Make sure that requests from lisp code override requests from
+ /* Make sure that requests from lisp code override requests from
Emacs redisplay code. */
if (explicit)
{
/* Check for no change needed in this very common case
before we do any consing. */
if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
- XSTRING (f->name)->data))
+ SDATA (f->name)))
return;
name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
}
int bytes, stringp;
Lisp_Object coding_system;
- coding_system = Vlocale_coding_system;
- if (NILP (coding_system))
- coding_system = Qcompound_text;
+ /* Note: Encoding strategy
+
+ We encode NAME by compound-text and use "COMPOUND-TEXT" in
+ text.encoding. But, there are non-internationalized window
+ managers which don't support that encoding. So, if NAME
+ contains only ASCII and 8859-1 characters, encode it by
+ iso-latin-1, and use "STRING" in text.encoding hoping that
+ such window managers at least analyze this format correctly,
+ i.e. treat 8-bit bytes as 8859-1 characters.
+
+ We may also be able to use "UTF8_STRING" in text.encoding
+ in the future which can encode all Unicode characters.
+ But, for the moment, there's no way to know that the
+ current window manager supports it or not. */
+ coding_system = Qcompound_text;
text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
text.encoding = (stringp ? XA_STRING
: FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
}
else
{
+ /* See the above comment "Note: Encoding strategy". */
icon.value = x_encode_text (f->icon_name, coding_system, 0,
&bytes, &stringp);
icon.encoding = (stringp ? XA_STRING
icon.format = 8;
icon.nitems = bytes;
}
-#ifdef USE_X_TOOLKIT
- XSetWMName (FRAME_X_DISPLAY (f),
- XtWindow (f->output_data.x->widget), &text);
- XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
- &icon);
-#else /* not USE_X_TOOLKIT */
- XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
- XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
-#endif /* not USE_X_TOOLKIT */
+#ifdef USE_GTK
+ gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
+ SDATA (name));
+#else /* not USE_GTK */
+ XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
+#endif /* not USE_GTK */
+
+ XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &icon);
+
if (!NILP (f->icon_name)
- && icon.value != XSTRING (f->icon_name)->data)
+ && icon.value != (unsigned char *) SDATA (f->icon_name))
xfree (icon.value);
- if (text.value != XSTRING (name)->data)
+ if (text.value != (unsigned char *) SDATA (name))
xfree (text.value);
}
#else /* not HAVE_X11R4 */
XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- XSTRING (name)->data);
+ SDATA (name));
XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- XSTRING (name)->data);
+ SDATA (name));
#endif /* not HAVE_X11R4 */
UNBLOCK_INPUT;
}
/* This function should be called by Emacs redisplay code to set the
name; names set this way will never override names set by the user's
lisp code. */
-void
-x_implicitly_set_name (f, arg, oldval)
- FRAME_PTR f;
- Lisp_Object arg, oldval;
-{
- x_set_name (f, arg, 0);
-}
-\f
-/* Change the title of frame F to NAME.
- If NAME is nil, use the frame name as the title.
-
- If EXPLICIT is non-zero, that indicates that lisp code is setting the
- name; if NAME is a string, set F's name to NAME and set
- F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
-
- If EXPLICIT is zero, that indicates that Emacs redisplay code is
- suggesting a new name, which lisp code should override; if
- F->explicit_name is set, ignore the new name; otherwise, set it. */
-
-void
-x_set_title (f, name, old_name)
- struct frame *f;
- Lisp_Object name, old_name;
-{
- /* Don't change the title if it's already NAME. */
- if (EQ (name, f->title))
- return;
-
- update_mode_lines = 1;
-
- f->title = name;
-
- if (NILP (name))
- name = f->name;
- else
- CHECK_STRING (name);
-
- if (FRAME_X_WINDOW (f))
- {
- BLOCK_INPUT;
-#ifdef HAVE_X11R4
- {
- XTextProperty text, icon;
- int bytes, stringp;
- Lisp_Object coding_system;
-
- coding_system = Vlocale_coding_system;
- if (NILP (coding_system))
- coding_system = Qcompound_text;
- text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
- text.encoding = (stringp ? XA_STRING
- : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
- text.format = 8;
- text.nitems = bytes;
-
- if (NILP (f->icon_name))
- {
- icon = text;
- }
- else
- {
- icon.value = x_encode_text (f->icon_name, coding_system, 0,
- &bytes, &stringp);
- icon.encoding = (stringp ? XA_STRING
- : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
- icon.format = 8;
- icon.nitems = bytes;
- }
-#ifdef USE_X_TOOLKIT
- XSetWMName (FRAME_X_DISPLAY (f),
- XtWindow (f->output_data.x->widget), &text);
- XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
- &icon);
-#else /* not USE_X_TOOLKIT */
- XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
- XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
-#endif /* not USE_X_TOOLKIT */
- if (!NILP (f->icon_name)
- && icon.value != XSTRING (f->icon_name)->data)
- xfree (icon.value);
- if (text.value != XSTRING (name)->data)
- xfree (text.value);
- }
-#else /* not HAVE_X11R4 */
- XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- XSTRING (name)->data);
- XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- XSTRING (name)->data);
-#endif /* not HAVE_X11R4 */
- UNBLOCK_INPUT;
- }
-}
-\f
-void
-x_set_autoraise (f, arg, oldval)
- struct frame *f;
- Lisp_Object arg, oldval;
-{
- f->auto_raise = !EQ (Qnil, arg);
-}
-
-void
-x_set_autolower (f, arg, oldval)
- struct frame *f;
- Lisp_Object arg, oldval;
-{
- f->auto_lower = !EQ (Qnil, arg);
-}
-
-void
-x_set_unsplittable (f, arg, oldval)
- struct frame *f;
- Lisp_Object arg, oldval;
-{
- f->no_split = !NILP (arg);
-}
-
-void
-x_set_vertical_scroll_bars (f, arg, oldval)
- struct frame *f;
- Lisp_Object arg, oldval;
-{
- if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
- || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
- || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
- || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
- {
- FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
- = (NILP (arg)
- ? vertical_scroll_bar_none
- : EQ (Qright, arg)
- ? vertical_scroll_bar_right
- : vertical_scroll_bar_left);
-
- /* We set this parameter before creating the X window for the
- frame, so we can get the geometry right from the start.
- However, if the window hasn't been created yet, we shouldn't
- call x_set_window_size. */
- if (FRAME_X_WINDOW (f))
- x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
- do_pending_window_change (0);
- }
-}
-
-void
-x_set_scroll_bar_width (f, arg, oldval)
- struct frame *f;
- Lisp_Object arg, oldval;
-{
- int wid = FONT_WIDTH (f->output_data.x->font);
-
- if (NILP (arg))
- {
-#ifdef USE_TOOLKIT_SCROLL_BARS
- /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
- int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
- FRAME_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
- FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = width;
-#else
- /* Make the actual width at least 14 pixels and a multiple of a
- character width. */
- FRAME_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
-
- /* Use all of that space (aside from required margins) for the
- scroll bar. */
- FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
-#endif
-
- if (FRAME_X_WINDOW (f))
- x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
- do_pending_window_change (0);
- }
- else if (INTEGERP (arg) && XINT (arg) > 0
- && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
- {
- if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
- XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
-
- FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
- FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
- if (FRAME_X_WINDOW (f))
- x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
- }
-
- change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0, 0);
- XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
- XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
-}
-
-
-\f
-/* Subroutines of creating an X frame. */
-
-/* Make sure that Vx_resource_name is set to a reasonable value.
- Fix it up, or set it to `emacs' if it is too hopeless. */
-
-static void
-validate_x_resource_name ()
-{
- int len = 0;
- /* Number of valid characters in the resource name. */
- int good_count = 0;
- /* Number of invalid characters in the resource name. */
- int bad_count = 0;
- Lisp_Object new;
- int i;
-
- if (!STRINGP (Vx_resource_class))
- Vx_resource_class = build_string (EMACS_CLASS);
-
- if (STRINGP (Vx_resource_name))
- {
- unsigned char *p = XSTRING (Vx_resource_name)->data;
- int i;
-
- len = STRING_BYTES (XSTRING (Vx_resource_name));
-
- /* Only letters, digits, - and _ are valid in resource names.
- Count the valid characters and count the invalid ones. */
- for (i = 0; i < len; i++)
- {
- int c = p[i];
- if (! ((c >= 'a' && c <= 'z')
- || (c >= 'A' && c <= 'Z')
- || (c >= '0' && c <= '9')
- || c == '-' || c == '_'))
- bad_count++;
- else
- good_count++;
- }
- }
- else
- /* Not a string => completely invalid. */
- bad_count = 5, good_count = 0;
-
- /* If name is valid already, return. */
- if (bad_count == 0)
- return;
-
- /* If name is entirely invalid, or nearly so, use `emacs'. */
- if (good_count == 0
- || (good_count == 1 && bad_count > 0))
- {
- Vx_resource_name = build_string ("emacs");
- return;
- }
-
- /* Name is partly valid. Copy it and replace the invalid characters
- with underscores. */
-
- Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
-
- for (i = 0; i < len; i++)
- {
- int c = XSTRING (new)->data[i];
- if (! ((c >= 'a' && c <= 'z')
- || (c >= 'A' && c <= 'Z')
- || (c >= '0' && c <= '9')
- || c == '-' || c == '_'))
- XSTRING (new)->data[i] = '_';
- }
-}
-
-
-extern char *x_get_string_resource ();
-
-DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
- doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
-This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
-class, where INSTANCE is the name under which Emacs was invoked, or
-the name specified by the `-name' or `-rn' command-line arguments.
-
-The optional arguments COMPONENT and SUBCLASS add to the key and the
-class, respectively. You must specify both of them or neither.
-If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
-and the class is `Emacs.CLASS.SUBCLASS'. */)
- (attribute, class, component, subclass)
- Lisp_Object attribute, class, component, subclass;
-{
- register char *value;
- char *name_key;
- char *class_key;
-
- check_x ();
-
- CHECK_STRING (attribute);
- CHECK_STRING (class);
-
- if (!NILP (component))
- CHECK_STRING (component);
- if (!NILP (subclass))
- CHECK_STRING (subclass);
- if (NILP (component) != NILP (subclass))
- error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
-
- validate_x_resource_name ();
-
- /* Allocate space for the components, the dots which separate them,
- and the final '\0'. Make them big enough for the worst case. */
- name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
- + (STRINGP (component)
- ? STRING_BYTES (XSTRING (component)) : 0)
- + STRING_BYTES (XSTRING (attribute))
- + 3);
-
- class_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class))
- + STRING_BYTES (XSTRING (class))
- + (STRINGP (subclass)
- ? STRING_BYTES (XSTRING (subclass)) : 0)
- + 3);
-
- /* Start with emacs.FRAMENAME for the name (the specific one)
- and with `Emacs' for the class key (the general one). */
- strcpy (name_key, XSTRING (Vx_resource_name)->data);
- strcpy (class_key, XSTRING (Vx_resource_class)->data);
-
- strcat (class_key, ".");
- strcat (class_key, XSTRING (class)->data);
-
- if (!NILP (component))
- {
- strcat (class_key, ".");
- strcat (class_key, XSTRING (subclass)->data);
-
- strcat (name_key, ".");
- strcat (name_key, XSTRING (component)->data);
- }
-
- strcat (name_key, ".");
- strcat (name_key, XSTRING (attribute)->data);
-
- value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
- name_key, class_key);
-
- if (value != (char *) 0)
- return build_string (value);
- else
- return Qnil;
-}
-
-/* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
-
-Lisp_Object
-display_x_get_resource (dpyinfo, attribute, class, component, subclass)
- struct x_display_info *dpyinfo;
- Lisp_Object attribute, class, component, subclass;
-{
- register char *value;
- char *name_key;
- char *class_key;
-
- CHECK_STRING (attribute);
- CHECK_STRING (class);
-
- if (!NILP (component))
- CHECK_STRING (component);
- if (!NILP (subclass))
- CHECK_STRING (subclass);
- if (NILP (component) != NILP (subclass))
- error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
-
- validate_x_resource_name ();
-
- /* Allocate space for the components, the dots which separate them,
- and the final '\0'. Make them big enough for the worst case. */
- name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
- + (STRINGP (component)
- ? STRING_BYTES (XSTRING (component)) : 0)
- + STRING_BYTES (XSTRING (attribute))
- + 3);
-
- class_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class))
- + STRING_BYTES (XSTRING (class))
- + (STRINGP (subclass)
- ? STRING_BYTES (XSTRING (subclass)) : 0)
- + 3);
-
- /* Start with emacs.FRAMENAME for the name (the specific one)
- and with `Emacs' for the class key (the general one). */
- strcpy (name_key, XSTRING (Vx_resource_name)->data);
- strcpy (class_key, XSTRING (Vx_resource_class)->data);
-
- strcat (class_key, ".");
- strcat (class_key, XSTRING (class)->data);
-
- if (!NILP (component))
- {
- strcat (class_key, ".");
- strcat (class_key, XSTRING (subclass)->data);
-
- strcat (name_key, ".");
- strcat (name_key, XSTRING (component)->data);
- }
-
- strcat (name_key, ".");
- strcat (name_key, XSTRING (attribute)->data);
-
- value = x_get_string_resource (dpyinfo->xrdb, name_key, class_key);
-
- if (value != (char *) 0)
- return build_string (value);
- else
- return Qnil;
-}
-
-/* Used when C code wants a resource value. */
-
-char *
-x_get_resource_string (attribute, class)
- char *attribute, *class;
+void
+x_implicitly_set_name (f, arg, oldval)
+ FRAME_PTR f;
+ Lisp_Object arg, oldval;
{
- char *name_key;
- char *class_key;
- struct frame *sf = SELECTED_FRAME ();
-
- /* Allocate space for the components, the dots which separate them,
- and the final '\0'. */
- name_key = (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name))
- + strlen (attribute) + 2);
- class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
- + strlen (class) + 2);
-
- sprintf (name_key, "%s.%s",
- XSTRING (Vinvocation_name)->data,
- attribute);
- sprintf (class_key, "%s.%s", EMACS_CLASS, class);
-
- return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
- name_key, class_key);
+ x_set_name (f, arg, 0);
}
+\f
+/* Change the title of frame F to NAME.
+ If NAME is nil, use the frame name as the title.
-/* Types we might convert a resource string into. */
-enum resource_types
-{
- RES_TYPE_NUMBER,
- RES_TYPE_FLOAT,
- RES_TYPE_BOOLEAN,
- RES_TYPE_STRING,
- RES_TYPE_SYMBOL
-};
+ If EXPLICIT is non-zero, that indicates that lisp code is setting the
+ name; if NAME is a string, set F's name to NAME and set
+ F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
-/* Return the value of parameter PARAM.
+ If EXPLICIT is zero, that indicates that Emacs redisplay code is
+ suggesting a new name, which lisp code should override; if
+ F->explicit_name is set, ignore the new name; otherwise, set it. */
- First search ALIST, then Vdefault_frame_alist, then the X defaults
- database, using ATTRIBUTE as the attribute name and CLASS as its class.
+void
+x_set_title (f, name, old_name)
+ struct frame *f;
+ Lisp_Object name, old_name;
+{
+ /* Don't change the title if it's already NAME. */
+ if (EQ (name, f->title))
+ return;
- Convert the resource to the type specified by desired_type.
+ update_mode_lines = 1;
- If no default is specified, return Qunbound. If you call
- x_get_arg, make sure you deal with Qunbound in a reasonable way,
- and don't let it get stored in any Lisp-visible variables! */
+ f->title = name;
-static Lisp_Object
-x_get_arg (dpyinfo, alist, param, attribute, class, type)
- struct x_display_info *dpyinfo;
- Lisp_Object alist, param;
- char *attribute;
- char *class;
- enum resource_types type;
-{
- register Lisp_Object tem;
+ if (NILP (name))
+ name = f->name;
+ else
+ CHECK_STRING (name);
- tem = Fassq (param, alist);
- if (EQ (tem, Qnil))
- tem = Fassq (param, Vdefault_frame_alist);
- if (EQ (tem, Qnil))
+ if (FRAME_X_WINDOW (f))
{
+ BLOCK_INPUT;
+#ifdef HAVE_X11R4
+ {
+ XTextProperty text, icon;
+ int bytes, stringp;
+ Lisp_Object coding_system;
- if (attribute)
- {
- tem = display_x_get_resource (dpyinfo,
- build_string (attribute),
- build_string (class),
- Qnil, Qnil);
+ coding_system = Qcompound_text;
+ /* See the comment "Note: Encoding strategy" in x_set_name. */
+ text.value = x_encode_text (name, coding_system, 0, &bytes, &stringp);
+ text.encoding = (stringp ? XA_STRING
+ : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
+ text.format = 8;
+ text.nitems = bytes;
- if (NILP (tem))
- return Qunbound;
+ if (NILP (f->icon_name))
+ {
+ icon = text;
+ }
+ else
+ {
+ /* See the comment "Note: Encoding strategy" in x_set_name. */
+ icon.value = x_encode_text (f->icon_name, coding_system, 0,
+ &bytes, &stringp);
+ icon.encoding = (stringp ? XA_STRING
+ : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
+ icon.format = 8;
+ icon.nitems = bytes;
+ }
- switch (type)
- {
- case RES_TYPE_NUMBER:
- return make_number (atoi (XSTRING (tem)->data));
-
- case RES_TYPE_FLOAT:
- return make_float (atof (XSTRING (tem)->data));
-
- case RES_TYPE_BOOLEAN:
- tem = Fdowncase (tem);
- if (!strcmp (XSTRING (tem)->data, "on")
- || !strcmp (XSTRING (tem)->data, "true"))
- return Qt;
- else
- return Qnil;
-
- case RES_TYPE_STRING:
- return tem;
-
- case RES_TYPE_SYMBOL:
- /* As a special case, we map the values `true' and `on'
- to Qt, and `false' and `off' to Qnil. */
- {
- Lisp_Object lower;
- lower = Fdowncase (tem);
- if (!strcmp (XSTRING (lower)->data, "on")
- || !strcmp (XSTRING (lower)->data, "true"))
- return Qt;
- else if (!strcmp (XSTRING (lower)->data, "off")
- || !strcmp (XSTRING (lower)->data, "false"))
- return Qnil;
- else
- return Fintern (tem, Qnil);
- }
+#ifdef USE_GTK
+ gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
+ SDATA (name));
+#else /* not USE_GTK */
+ XSetWMName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
+#endif /* not USE_GTK */
- default:
- abort ();
- }
- }
- else
- return Qunbound;
+ XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ &icon);
+
+ if (!NILP (f->icon_name)
+ && icon.value != (unsigned char *) SDATA (f->icon_name))
+ xfree (icon.value);
+ if (text.value != (unsigned char *) SDATA (name))
+ xfree (text.value);
+ }
+#else /* not HAVE_X11R4 */
+ XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ SDATA (name));
+ XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ SDATA (name));
+#endif /* not HAVE_X11R4 */
+ UNBLOCK_INPUT;
}
- return Fcdr (tem);
}
-/* Like x_get_arg, but also record the value in f->param_alist. */
-
-static Lisp_Object
-x_get_and_record_arg (f, alist, param, attribute, class, type)
+void
+x_set_scroll_bar_default_width (f)
struct frame *f;
- Lisp_Object alist, param;
- char *attribute;
- char *class;
- enum resource_types type;
{
- Lisp_Object value;
-
- value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
- attribute, class, type);
- if (! NILP (value))
- store_frame_param (f, param, value);
-
- return value;
-}
-
-/* Record in frame F the specified or default value according to ALIST
- of the parameter named PROP (a Lisp symbol).
- If no value is specified for PROP, look for an X default for XPROP
- on the frame named NAME.
- If that is not found either, use the value DEFLT. */
+ int wid = FRAME_COLUMN_WIDTH (f);
-static Lisp_Object
-x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
- struct frame *f;
- Lisp_Object alist;
- Lisp_Object prop;
- Lisp_Object deflt;
- char *xprop;
- char *xclass;
- enum resource_types type;
-{
- Lisp_Object tem;
+#ifdef USE_TOOLKIT_SCROLL_BARS
+ /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
+ int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
+ FRAME_CONFIG_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
+ FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = width;
+#else
+ /* Make the actual width at least 14 pixels and a multiple of a
+ character width. */
+ FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
- tem = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, prop, xprop, xclass, type);
- if (EQ (tem, Qunbound))
- tem = deflt;
- x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
- return tem;
+ /* Use all of that space (aside from required margins) for the
+ scroll bar. */
+ FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = 0;
+#endif
}
-
+\f
/* Record in frame F the specified or default value according to ALIST
of the parameter named PROP (a Lisp symbol). If no value is
specified for PROP, look for an X default for XPROP on the frame
specified. */
tem = Qnil;
}
-
+
#else /* not USE_TOOLKIT_SCROLL_BARS */
-
+
tem = Qnil;
-
+
#endif /* not USE_TOOLKIT_SCROLL_BARS */
}
}
-\f
-DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
- doc: /* Parse an X-style geometry string STRING.
-Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
-The properties returned may include `top', `left', `height', and `width'.
-The value of `left' or `top' may be an integer,
-or a list (+ N) meaning N pixels relative to top/left corner,
-or a list (- N) meaning -N pixels relative to bottom/right corner. */)
- (string)
- Lisp_Object string;
-{
- int geometry, x, y;
- unsigned int width, height;
- Lisp_Object result;
-
- CHECK_STRING (string);
-
- geometry = XParseGeometry ((char *) XSTRING (string)->data,
- &x, &y, &width, &height);
-
-#if 0
- if (!!(geometry & XValue) != !!(geometry & YValue))
- error ("Must specify both x and y position, or neither");
-#endif
-
- result = Qnil;
- if (geometry & XValue)
- {
- Lisp_Object element;
-
- if (x >= 0 && (geometry & XNegative))
- element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
- else if (x < 0 && ! (geometry & XNegative))
- element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
- else
- element = Fcons (Qleft, make_number (x));
- result = Fcons (element, result);
- }
-
- if (geometry & YValue)
- {
- Lisp_Object element;
-
- if (y >= 0 && (geometry & YNegative))
- element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
- else if (y < 0 && ! (geometry & YNegative))
- element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
- else
- element = Fcons (Qtop, make_number (y));
- result = Fcons (element, result);
- }
-
- if (geometry & WidthValue)
- result = Fcons (Fcons (Qwidth, make_number (width)), result);
- if (geometry & HeightValue)
- result = Fcons (Fcons (Qheight, make_number (height)), result);
-
- return result;
-}
-
-/* Calculate the desired size and position of this window,
- and return the flags saying which aspects were specified.
-
- This function does not make the coordinates positive. */
-
-#define DEFAULT_ROWS 40
-#define DEFAULT_COLS 80
-
-static int
-x_figure_window_size (f, parms)
- struct frame *f;
- Lisp_Object parms;
-{
- register Lisp_Object tem0, tem1, tem2;
- long window_prompting = 0;
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
-
- /* Default values if we fall through.
- Actually, if that happens we should get
- window manager prompting. */
- SET_FRAME_WIDTH (f, DEFAULT_COLS);
- f->height = DEFAULT_ROWS;
- /* Window managers expect that if program-specified
- positions are not (0,0), they're intentional, not defaults. */
- f->output_data.x->top_pos = 0;
- f->output_data.x->left_pos = 0;
-
- tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
- tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
- tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
- if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
- {
- if (!EQ (tem0, Qunbound))
- {
- CHECK_NUMBER (tem0);
- f->height = XINT (tem0);
- }
- if (!EQ (tem1, Qunbound))
- {
- CHECK_NUMBER (tem1);
- SET_FRAME_WIDTH (f, XINT (tem1));
- }
- if (!NILP (tem2) && !EQ (tem2, Qunbound))
- window_prompting |= USSize;
- else
- window_prompting |= PSize;
- }
-
- f->output_data.x->vertical_scroll_bar_extra
- = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
- ? 0
- : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
-
- x_compute_fringe_widths (f, 0);
-
- f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
- f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
-
- tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
- tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
- tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
- if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
- {
- if (EQ (tem0, Qminus))
- {
- f->output_data.x->top_pos = 0;
- window_prompting |= YNegative;
- }
- else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
- && CONSP (XCDR (tem0))
- && INTEGERP (XCAR (XCDR (tem0))))
- {
- f->output_data.x->top_pos = - XINT (XCAR (XCDR (tem0)));
- window_prompting |= YNegative;
- }
- else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
- && CONSP (XCDR (tem0))
- && INTEGERP (XCAR (XCDR (tem0))))
- {
- f->output_data.x->top_pos = XINT (XCAR (XCDR (tem0)));
- }
- else if (EQ (tem0, Qunbound))
- f->output_data.x->top_pos = 0;
- else
- {
- CHECK_NUMBER (tem0);
- f->output_data.x->top_pos = XINT (tem0);
- if (f->output_data.x->top_pos < 0)
- window_prompting |= YNegative;
- }
-
- if (EQ (tem1, Qminus))
- {
- f->output_data.x->left_pos = 0;
- window_prompting |= XNegative;
- }
- else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
- && CONSP (XCDR (tem1))
- && INTEGERP (XCAR (XCDR (tem1))))
- {
- f->output_data.x->left_pos = - XINT (XCAR (XCDR (tem1)));
- window_prompting |= XNegative;
- }
- else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
- && CONSP (XCDR (tem1))
- && INTEGERP (XCAR (XCDR (tem1))))
- {
- f->output_data.x->left_pos = XINT (XCAR (XCDR (tem1)));
- }
- else if (EQ (tem1, Qunbound))
- f->output_data.x->left_pos = 0;
- else
- {
- CHECK_NUMBER (tem1);
- f->output_data.x->left_pos = XINT (tem1);
- if (f->output_data.x->left_pos < 0)
- window_prompting |= XNegative;
- }
-
- if (!NILP (tem2) && ! EQ (tem2, Qunbound))
- window_prompting |= USPosition;
- else
- window_prompting |= PPosition;
- }
-
- if (f->output_data.x->want_fullscreen != FULLSCREEN_NONE)
- {
- int left, top;
- int width, height;
-
- /* It takes both for some WM:s to place it where we want */
- window_prompting = USPosition | PPosition;
- x_fullscreen_adjust (f, &width, &height, &top, &left);
- f->width = width;
- f->height = height;
- f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
- f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
- f->output_data.x->left_pos = left;
- f->output_data.x->top_pos = top;
- }
-
- return window_prompting;
-}
#if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
char **missing_list;
int missing_count;
char *def_string;
-
+
xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
base_fontname, &missing_list,
&missing_count, &def_string);
if (missing_list)
XFreeStringList (missing_list);
-
+
/* No need to free def_string. */
return xfs;
}
if (FRAME_XIC (f))
return;
-
+
xim = FRAME_X_XIM (f);
if (xim)
{
{
/* Determine the base fontname from the ASCII font name of
FONTSET. */
- char *ascii_font = (char *) XSTRING (fontset_ascii (fontset))->data;
+ char *ascii_font = (char *) SDATA (fontset_ascii (fontset));
char *p = ascii_font;
int i;
XFree (preedit_attr);
XFree (status_attr);
}
-
+
FRAME_XIC (f) = xic;
FRAME_XIC_STYLE (f) = xic_style;
FRAME_XIC_FONTSET (f) = xfs;
{
if (FRAME_XIC (f) == NULL)
return;
-
+
XDestroyIC (FRAME_XIC (f));
if (FRAME_XIC_FONTSET (f))
XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
struct frame *f = XFRAME (w->frame);
XVaNestedList attr;
XPoint spot;
-
- spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x);
+
+ spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w);
spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
attr = XVaCreateNestedList (0, XNAreaNeeded, &area, NULL);
XSetICValues (xic, XNStatusAttributes, attr, NULL);
XFree (attr);
-
+
attr = XVaCreateNestedList (0, XNAreaNeeded, &needed, NULL);
XGetICValues (xic, XNStatusAttributes, attr, NULL);
XFree (attr);
area.width = needed->width;
area.height = needed->height;
- area.x = PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
- area.y = (PIXEL_HEIGHT (f) - area.height
- - FRAME_MENUBAR_HEIGHT (f) - FRAME_INTERNAL_BORDER_WIDTH (f));
+ area.x = FRAME_PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
+ area.y = (FRAME_PIXEL_HEIGHT (f) - area.height
+ - FRAME_MENUBAR_HEIGHT (f)
+ - FRAME_TOOLBAR_HEIGHT (f)
+ - FRAME_INTERNAL_BORDER_WIDTH (f));
XFree (needed);
attr = XVaCreateNestedList (0, XNArea, &area, NULL);
if (FRAME_XIC_STYLE (f) & XIMStatusArea)
XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL);
XFree (attr);
-
+
if (FRAME_XIC_FONTSET (f))
XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
FRAME_XIC_FONTSET (f) = xfs;
for the window manager, so GC relocation won't bother it.
Elsewhere we specify the window name for the window manager. */
-
+
{
- char *str = (char *) XSTRING (Vx_resource_name)->data;
+ char *str = (char *) SDATA (Vx_resource_name);
f->namebuf = (char *) xmalloc (strlen (str) + 1);
strcpy (f->namebuf, str);
}
XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
XtSetArg (al[ac], XtNinput, 1); ac++;
XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
- XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++;
+ XtSetArg (al[ac], XtNborderWidth, f->border_width); ac++;
XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
XtSetValues (pane_widget, al, ac);
f->output_data.x->column_widget = pane_widget;
- /* mappedWhenManaged to false tells to the paned window to not map/unmap
+ /* mappedWhenManaged to false tells to the paned window to not map/unmap
the emacs screen when changing menubar. This reduces flickering. */
ac = 0;
XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget,
al, ac);
-
+
f->output_data.x->edit_widget = frame_widget;
-
- XtManageChild (frame_widget);
+
+ XtManageChild (frame_widget);
/* Do some needed geometry management. */
{
Arg al[2];
int ac = 0;
int extra_borders = 0;
- int menubar_size
+ int menubar_size
= (f->output_data.x->menubar_widget
? (f->output_data.x->menubar_widget->core.height
+ f->output_data.x->menubar_widget->core.border_width)
is a user-specified or program-specified one.
We pass that information later, in x_wm_set_size_hints. */
{
- int left = f->output_data.x->left_pos;
+ int left = f->left_pos;
int xneg = window_prompting & XNegative;
- int top = f->output_data.x->top_pos;
+ int top = f->top_pos;
int yneg = window_prompting & YNegative;
if (xneg)
left = -left;
if (window_prompting & USPosition)
sprintf (shell_position, "=%dx%d%c%d%c%d",
- PIXEL_WIDTH (f) + extra_borders,
- PIXEL_HEIGHT (f) + menubar_size + extra_borders,
+ FRAME_PIXEL_WIDTH (f) + extra_borders,
+ FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders,
(xneg ? '-' : '+'), left,
(yneg ? '-' : '+'), top);
else
sprintf (shell_position, "=%dx%d",
- PIXEL_WIDTH (f) + extra_borders,
- PIXEL_HEIGHT (f) + menubar_size + extra_borders);
+ FRAME_PIXEL_WIDTH (f) + extra_borders,
+ FRAME_PIXEL_HEIGHT (f) + menubar_size + extra_borders);
}
len = strlen (shell_position) + 1;
XtManageChild (pane_widget);
XtRealizeWidget (shell_widget);
- FRAME_X_WINDOW (f) = XtWindow (frame_widget);
+ FRAME_X_WINDOW (f) = XtWindow (frame_widget);
validate_x_resource_name ();
- class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
- class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
+ class_hints.res_name = (char *) SDATA (Vx_resource_name);
+ class_hints.res_class = (char *) SDATA (Vx_resource_class);
XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
#ifdef HAVE_X_I18N
attributes.event_mask |= fevent;
}
#endif /* HAVE_X_I18N */
-
+
attribute_mask = CWEventMask;
XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
attribute_mask, &attributes);
}
#else /* not USE_X_TOOLKIT */
+#ifdef USE_GTK
+void
+x_window (f)
+ FRAME_PTR f;
+{
+ if (! xg_create_frame_widgets (f))
+ error ("Unable to create window");
+
+#ifdef HAVE_X_I18N
+ FRAME_XIC (f) = NULL;
+if (use_xim)
+ {
+ BLOCK_INPUT;
+ create_frame_xic (f);
+ if (FRAME_XIC (f))
+ {
+ /* XIM server might require some X events. */
+ unsigned long fevent = NoEventMask;
+ XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
+
+ if (fevent != NoEventMask)
+ {
+ XSetWindowAttributes attributes;
+ XWindowAttributes wattr;
+ unsigned long attribute_mask;
+
+ XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ &wattr);
+ attributes.event_mask = wattr.your_event_mask | fevent;
+ attribute_mask = CWEventMask;
+ XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ attribute_mask, &attributes);
+ }
+ }
+ UNBLOCK_INPUT;
+ }
+#endif
+}
+#else /*! USE_GTK */
/* Create and set up the X window for frame F. */
void
FRAME_X_WINDOW (f)
= XCreateWindow (FRAME_X_DISPLAY (f),
f->output_data.x->parent_desc,
- f->output_data.x->left_pos,
- f->output_data.x->top_pos,
- PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
- f->output_data.x->border_width,
+ f->left_pos,
+ f->top_pos,
+ FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
+ f->border_width,
CopyFromParent, /* depth */
InputOutput, /* class */
FRAME_X_VISUAL (f),
attribute_mask, &attributes);
#ifdef HAVE_X_I18N
- if use_xim
+ if (use_xim)
{
create_frame_xic (f);
if (FRAME_XIC (f))
}
}
#endif /* HAVE_X_I18N */
-
+
validate_x_resource_name ();
- class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
- class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
+ class_hints.res_name = (char *) SDATA (Vx_resource_name);
+ class_hints.res_class = (char *) SDATA (Vx_resource_class);
XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
/* The menubar is part of the ordinary display;
error ("Unable to create window");
}
+#endif /* not USE_GTK */
#endif /* not USE_X_TOOLKIT */
/* Handle the icon stuff for this window. Perhaps later we might
/* Set the position of the icon. Note that twm groups all
icons in an icon window. */
- icon_x = x_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
- icon_y = x_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
+ icon_x = x_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
+ icon_y = x_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
{
CHECK_NUMBER (icon_x);
? IconicState
: NormalState));
- x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
+ x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
? f->icon_name
- : f->name))->data);
+ : f->name)));
UNBLOCK_INPUT;
}
Note that many default values are used. */
/* Normal video */
- gc_values.font = f->output_data.x->font->fid;
+ gc_values.font = FRAME_FONT (f)->fid;
gc_values.foreground = f->output_data.x->foreground_pixel;
gc_values.background = f->output_data.x->background_pixel;
gc_values.line_width = 0; /* Means 1 using fast algorithm. */
this must be done on a per-frame basis. */
f->output_data.x->border_tile
= (XCreatePixmapFromBitmapData
- (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
+ (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
gray_bits, gray_width, gray_height,
f->output_data.x->foreground_pixel,
f->output_data.x->background_pixel,
Display *dpy = FRAME_X_DISPLAY (f);
BLOCK_INPUT;
-
+
if (f->output_data.x->normal_gc)
{
XFreeGC (dpy, f->output_data.x->normal_gc);
XFreeGC (dpy, f->output_data.x->reverse_gc);
f->output_data.x->reverse_gc = 0;
}
-
+
if (f->output_data.x->cursor_gc)
{
XFreeGC (dpy, f->output_data.x->cursor_gc);
#if GLYPH_DEBUG
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
#endif
-
+
x_free_frame_resources (f);
/* Check that reference counts are indeed correct. */
xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
return Qt;
}
-
+
return Qnil;
}
int minibuffer_only = 0;
long window_prompting = 0;
int width, height;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object display;
struct x_display_info *dpyinfo = NULL;
f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
bzero (f->output_data.x, sizeof (struct x_output));
f->output_data.x->icon_bitmap = -1;
- f->output_data.x->fontset = -1;
+ FRAME_FONTSET (f) = -1;
f->output_data.x->scroll_bar_foreground_pixel = -1;
f->output_data.x->scroll_bar_background_pixel = -1;
#ifdef USE_TOOLKIT_SCROLL_BARS
f->output_data.x->cursor_foreground_pixel = -1;
f->output_data.x->border_pixel = -1;
f->output_data.x->mouse_pixel = -1;
-
+
black = build_string ("black");
GCPRO1 (black);
f->output_data.x->foreground_pixel
{
Lisp_Object font;
- font = x_get_arg (dpyinfo, parms, Qfont,
- "font", "Font", RES_TYPE_STRING);
+ 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;
+ 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
/* Prevent lwlib/xlwmenu.c from crashing because of a bug
whereby it fails to get any font. */
- xlwmenu_default_font = f->output_data.x->font;
+ xlwmenu_default_font = FRAME_FONT (f);
#endif
x_default_parameter (f, parms, Qborder_width, make_number (2),
"borderWidth", "BorderWidth", RES_TYPE_NUMBER);
-
+
/* This defaults to 1 in order to match xterm. We recognize either
internalBorderWidth or internalBorder (which is what xterm calls
it). */
end up in init_iterator with a null face cache, which should not
happen. */
init_frame_faces (f);
-
+
x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
"menuBar", "MenuBar", RES_TYPE_NUMBER);
x_default_parameter (f, parms, Qtool_bar_lines, make_number (1),
f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
- /* Add the tool-bar height to the initial frame height so that the
- user gets a text display area of the size he specified with -g or
- via .Xdefaults. Later changes of the tool-bar height don't
- change the frame size. This is done so that users can create
- tall Emacs frames without having to guess how tall the tool-bar
- will get. */
- if (FRAME_TOOL_BAR_LINES (f))
- {
- int margin, relief, bar_height;
-
- relief = (tool_bar_button_relief >= 0
- ? tool_bar_button_relief
- : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
-
- if (INTEGERP (Vtool_bar_button_margin)
- && XINT (Vtool_bar_button_margin) > 0)
- margin = XFASTINT (Vtool_bar_button_margin);
- else if (CONSP (Vtool_bar_button_margin)
- && INTEGERP (XCDR (Vtool_bar_button_margin))
- && XINT (XCDR (Vtool_bar_button_margin)) > 0)
- margin = XFASTINT (XCDR (Vtool_bar_button_margin));
- else
- margin = 0;
-
- bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
- f->height += (bar_height + CANON_Y_UNIT (f) - 1) / CANON_Y_UNIT (f);
- }
-
/* Compute the size of the X window. */
- window_prompting = x_figure_window_size (f, parms);
-
- if (window_prompting & XNegative)
- {
- if (window_prompting & YNegative)
- f->output_data.x->win_gravity = SouthEastGravity;
- else
- f->output_data.x->win_gravity = NorthEastGravity;
- }
- else
- {
- if (window_prompting & YNegative)
- f->output_data.x->win_gravity = SouthWestGravity;
- else
- f->output_data.x->win_gravity = NorthWestGravity;
- }
-
- f->output_data.x->size_hint_flags = window_prompting;
+ window_prompting = x_figure_window_size (f, parms, 1);
tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
f->no_split = minibuffer_only || EQ (tem, Qt);
#else
x_window (f);
#endif
-
+
x_icon (f, parms);
x_make_gc (f);
"scrollBarWidth", "ScrollBarWidth",
RES_TYPE_NUMBER);
- /* Dimensions, especially f->height, must be done via change_frame_size.
+ /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
Change will not be effected unless different from the current
- f->height. */
- width = f->width;
- height = f->height;
-
- f->height = 0;
- SET_FRAME_WIDTH (f, 0);
- change_frame_size (f, height, width, 1, 0, 0);
+ FRAME_LINES (f). */
+ width = FRAME_COLS (f);
+ height = FRAME_LINES (f);
- /* Set up faces after all frame parameters are known. This call
- also merges in face attributes specified for new frames. If we
- don't do this, the `menu' face for instance won't have the right
- colors, and the menu bar won't appear in the specified colors for
- new frames. */
- call1 (Qface_set_after_frame_default, frame);
+ SET_FRAME_COLS (f, 0);
+ FRAME_LINES (f) = 0;
+ change_frame_size (f, height, width, 1, 0, 0);
-#ifdef USE_X_TOOLKIT
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
/* Create the menu bar. */
if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
{
frame and we didn't make it visible. */
initialize_frame_menubar (f);
+#ifndef USE_GTK
/* This is a no-op, except under Motif where it arranges the
main window for the widgets on it. */
lw_set_main_areas (f->output_data.x->column_widget,
f->output_data.x->menubar_widget,
f->output_data.x->edit_widget);
+#endif /* not USE_GTK */
}
-#endif /* USE_X_TOOLKIT */
+#endif /* USE_X_TOOLKIT || USE_GTK */
/* Tell the server what size and position, etc, we want, and how
badly we want them. This should be done after we have the menu
/* Make sure windows on this frame appear in calls to next-window
and similar functions. */
Vwindow_list = Qnil;
-
+
return unbind_to (count, frame);
}
RevertToParent, CurrentTime);
x_uncatch_errors (dpy, count);
UNBLOCK_INPUT;
-
+
return Qnil;
}
CHECK_STRING (color);
- if (x_defined_color (f, XSTRING (color)->data, &foo, 0))
+ if (x_defined_color (f, SDATA (color), &foo, 0))
return Qt;
else
return Qnil;
CHECK_STRING (color);
- if (x_defined_color (f, XSTRING (color)->data, &foo, 0))
+ if (x_defined_color (f, SDATA (color), &foo, 0))
{
Lisp_Object rgb[3];
error ("Display has an unknown visual class");
result = Qnil;
}
-
+
return result;
}
x_pixel_width (f)
register struct frame *f;
{
- return PIXEL_WIDTH (f);
+ return FRAME_PIXEL_WIDTH (f);
}
int
x_pixel_height (f)
register struct frame *f;
{
- return PIXEL_HEIGHT (f);
+ return FRAME_PIXEL_HEIGHT (f);
}
int
x_char_width (f)
register struct frame *f;
{
- return FONT_WIDTH (f->output_data.x->font);
+ return FRAME_COLUMN_WIDTH (f);
}
int
x_char_height (f)
register struct frame *f;
{
- return f->output_data.x->line_height;
+ return FRAME_LINE_HEIGHT (f);
}
int
/* VALUE should be of the form CLASS-DEPTH, where CLASS is one
of `PseudoColor', `TrueColor' etc. and DEPTH is the color
depth, a decimal number. NAME is compared with case ignored. */
- char *s = (char *) alloca (STRING_BYTES (XSTRING (value)) + 1);
+ char *s = (char *) alloca (SBYTES (value) + 1);
char *dash;
int i, class = -1;
XVisualInfo vinfo;
- strcpy (s, XSTRING (value)->data);
+ strcpy (s, SDATA (value));
dash = index (s, '-');
if (dash)
{
if (class == -1
|| !XMatchVisualInfo (dpy, XScreenNumberOfScreen (screen),
dpyinfo->n_planes, class, &vinfo))
- fatal ("Invalid visual specification `%s'", XSTRING (value)->data);
-
+ fatal ("Invalid visual specification `%s'", SDATA (value));
+
dpyinfo->visual = vinfo.visual;
}
else
{
int n_visuals;
XVisualInfo *vinfo, vinfo_template;
-
+
dpyinfo->visual = DefaultVisualOfScreen (screen);
#ifdef HAVE_X11R4
validate_x_resource_name ();
dpyinfo = x_term_init (name, (char *)0,
- (char *) XSTRING (Vx_resource_name)->data);
+ (char *) SDATA (Vx_resource_name));
if (dpyinfo == 0)
- error ("Cannot connect to X server %s", XSTRING (name)->data);
+ error ("Cannot connect to X server %s", SDATA (name));
x_in_use = 1;
XSETFASTINT (Vwindow_system_version, 11);
error ("Not using X Windows");
if (! NILP (xrm_string))
- xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
+ xrm_option = (unsigned char *) SDATA (xrm_string);
else
xrm_option = (unsigned char *) 0;
/* This is what opens the connection and sets x_current_display.
This also initializes many symbols, such as those used for input. */
dpyinfo = x_term_init (display, xrm_option,
- (char *) XSTRING (Vx_resource_name)->data);
+ (char *) SDATA (Vx_resource_name));
if (dpyinfo == 0)
{
if (!NILP (must_succeed))
fatal ("Cannot connect to X server %s.\n\
Check the DISPLAY environment variable or use `-d'.\n\
-Also use the `xhost' program to verify that it is set to permit\n\
-connections from your machine.\n",
- XSTRING (display)->data);
+Also use the `xauth' program to verify that you have the proper\n\
+authorization information needed to connect the X server.\n\
+An insecure way to solve the problem may be to use `xhost'.\n",
+ SDATA (display));
else
- error ("Cannot connect to X server %s", XSTRING (display)->data);
+ error ("Cannot connect to X server %s", SDATA (display));
}
x_in_use = 1;
/* Keywords. */
extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
-extern Lisp_Object QCdata;
-Lisp_Object QCtype, QCascent, QCmargin, QCrelief;
+extern Lisp_Object QCdata, QCtype;
+Lisp_Object QCascent, QCmargin, QCrelief;
Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
Lisp_Object object;
{
int valid_p = 0;
-
+
if (CONSP (object) && EQ (XCAR (object), Qimage))
{
Lisp_Object tem;
if (type)
valid_p = type->valid_p (object);
}
-
+
break;
}
}
/* Find key in KEYWORDS. Error if not found. */
for (i = 0; i < nkeywords; ++i)
- if (strcmp (keywords[i].name, XSYMBOL (key)->name->data) == 0)
+ if (strcmp (keywords[i].name, SDATA (SYMBOL_NAME (key))) == 0)
break;
if (i == nkeywords)
was found more than once, it's an error. */
keywords[i].value = value;
++keywords[i].count;
-
+
if (keywords[i].count > 1)
return 0;
&& XINT (value) <= 100)
break;
return 0;
-
+
case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
if (!INTEGERP (value) || XINT (value) < 0)
return 0;
case IMAGE_FUNCTION_VALUE:
value = indirect_function (value);
- if (SUBRP (value)
+ if (SUBRP (value)
|| COMPILEDP (value)
|| (CONSP (value) && EQ (XCAR (value), Qlambda)))
break;
int *found;
{
Lisp_Object tail;
-
+
xassert (valid_image_p (spec));
for (tail = XCDR (spec);
return XCAR (XCDR (tail));
}
}
-
+
if (found)
*found = 0;
return Qnil;
}
-
+
DEFUN ("image-size", Fimage_size, Simage_size, 1, 3, 0,
doc: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
struct image *img = IMAGE_FROM_ID (f, id);
int width = img->width + 2 * img->hmargin;
int height = img->height + 2 * img->vmargin;
-
+
if (NILP (pixels))
- size = Fcons (make_float ((double) width / CANON_X_UNIT (f)),
- make_float ((double) height / CANON_Y_UNIT (f)));
+ size = Fcons (make_float ((double) width / FRAME_COLUMN_WIDTH (f)),
+ make_float ((double) height / FRAME_LINE_HEIGHT (f)));
else
size = Fcons (make_number (width), make_number (height));
}
unsigned hash;
{
struct image *img = (struct image *) xmalloc (sizeof *img);
-
+
xassert (valid_image_p (spec));
bzero (img, sizeof *img);
img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
if (img->pixmap == None && !img->load_failed_p)
img->load_failed_p = img->type->load (f, img) == 0;
}
-
+
/* Value is the number of pixels for the ascent of image IMG when
drawn in face FACE. */
for (i = best_count = 0; i < 4; ++i)
{
int j, n;
-
+
for (j = n = 0; j < 4; ++j)
if (corners[i] == corners[j])
++n;
img->mask = None;
img->background_transparent_valid = 0;
}
-
+
if (colors_p && img->ncolors)
{
x_free_colors (f, img->colors, img->ncolors);
xassert (STRINGP (color_name));
- if (x_defined_color (f, XSTRING (color_name)->data, &color, 1))
+ if (x_defined_color (f, SDATA (color_name), &color, 1))
{
/* This isn't called frequently so we get away with simply
reallocating the color vector to the needed size, here. */
{
struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
int size;
-
+
bzero (c, sizeof *c);
c->size = 50;
c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
/* Cache should not be referenced by any frame when freed. */
xassert (c->refcount == 0);
-
+
for (i = 0; i < c->used; ++i)
free_image (f, c->images[i]);
xfree (c->images);
/* Block input so that we won't be interrupted by a SIGIO
while being in an inconsistent state. */
BLOCK_INPUT;
-
+
for (i = nfreed = 0; i < c->used; ++i)
{
struct image *img = c->images[i];
if (nfreed)
{
Lisp_Object tail, frame;
-
+
FOR_EACH_FRAME (tail, frame)
{
struct frame *f = XFRAME (frame);
if (EQ (frame, Qt))
{
Lisp_Object tail;
-
+
FOR_EACH_FRAME (tail, frame)
if (FRAME_X_P (XFRAME (frame)))
clear_image_cache (XFRAME (frame), 1);
Lisp_Object mask;
spec = img->spec;
-
+
/* `:heuristic-mask t'
`:mask heuristic'
means build a mask heuristically.
image.
`:mask nil'
means remove a mask, if any. */
-
+
mask = image_spec_value (spec, QCheuristic_mask, NULL);
if (!NILP (mask))
x_build_heuristic_mask (f, img, mask);
else
{
int found_p;
-
+
mask = image_spec_value (spec, QCmask, &found_p);
-
+
if (EQ (mask, Qheuristic))
x_build_heuristic_mask (f, img, Qt);
else if (CONSP (mask)
img->mask = None;
}
}
-
-
+
+
/* Should we apply an image transformation algorithm? */
conversion = image_spec_value (spec, QCconversion, NULL);
if (EQ (conversion, Qdisabled))
specification. */
xassert (FRAME_WINDOW_P (f));
xassert (valid_image_p (spec));
-
+
GCPRO1 (spec);
/* Look up SPEC in the hash table of the image cache. */
if (img == NULL)
{
extern Lisp_Object Qpostscript;
-
+
BLOCK_INPUT;
img = make_image (spec, hash);
cache_image (f, img);
img->ascent = XFASTINT (ascent);
else if (EQ (ascent, Qcenter))
img->ascent = CENTERED_IMAGE_ASCENT;
-
+
margin = image_spec_value (spec, QCmargin, NULL);
if (INTEGERP (margin) && XINT (margin) >= 0)
img->vmargin = img->hmargin = XFASTINT (margin);
if (XINT (XCDR (margin)) > 0)
img->vmargin = XFASTINT (XCDR (margin));
}
-
+
relief = image_spec_value (spec, QCrelief, NULL);
if (INTEGERP (relief))
{
/* We're using IMG, so set its timestamp to `now'. */
EMACS_GET_TIME (now);
img->timestamp = EMACS_SECS (now);
-
+
UNGCPRO;
-
+
/* Value is the image id. */
return img->id;
}
int width, height;
{
GC gc;
-
+
xassert (interrupt_input_blocked);
gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
GCPRO2 (file_found, search_path);
/* Try to find FILE in data-directory, then x-bitmap-file-path. */
- fd = openp (search_path, file, Qnil, &file_found, 0);
-
+ fd = openp (search_path, file, Qnil, &file_found, Qnil);
+
if (fd == -1)
file_found = Qnil;
else
buf = NULL;
}
}
-
+
return buf;
}
XBM_TK_NUMBER
};
-
+
/* Return non-zero if OBJECT is a valid XBM-type image specification.
A valid specification is a list starting with the symbol `image'
The rest of the list is a property list which must contain an
Lisp_Object object;
{
struct image_keyword kw[XBM_LAST];
-
+
bcopy (xbm_format, kw, sizeof kw);
if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
return 0;
data = kw[XBM_DATA].value;
width = XFASTINT (kw[XBM_WIDTH].value);
height = XFASTINT (kw[XBM_HEIGHT].value);
-
+
/* Check type of data, and width and height against contents of
data. */
if (VECTORP (data))
{
int i;
-
+
/* Number of elements of the vector must be >= height. */
if (XVECTOR (data)->size < height)
return 0;
if (STRINGP (elt))
{
- if (XSTRING (elt)->size
+ if (SCHARS (elt)
< (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
return 0;
}
}
else if (STRINGP (data))
{
- if (XSTRING (data)->size
+ if (SCHARS (data)
< (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
return 0;
}
int c;
loop:
-
+
/* Skip white space. */
while (*s < end && (c = *(*s)++, isspace (c)))
;
else if (isdigit (c))
{
int value = 0, digit;
-
+
if (c == '0' && *s < end)
{
c = *(*s)++;
if (LA1 != (TOKEN)) \
goto failure; \
else \
- match ()
+ match ()
#define expect_ident(IDENT) \
if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
{
if (strcmp (buffer, "unsigned") == 0)
{
- match ();
+ match ();
expect_ident ("char");
}
else if (strcmp (buffer, "short") == 0)
else
goto failure;
}
- else
+ else
goto failure;
expect (XBM_TK_IDENT);
*p++ = val;
if (!padding_p || ((i + 2) % bytes_per_line))
*p++ = value >> 8;
-
+
if (LA1 == ',' || LA1 == '}')
match ();
else
{
int val = value;
expect (XBM_TK_NUMBER);
-
+
*p++ = val;
-
+
if (LA1 == ',' || LA1 == '}')
match ();
else
return 1;
failure:
-
+
if (data && *data)
{
xfree (*data);
int rc;
unsigned char *data;
int success_p = 0;
-
+
rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
if (rc)
{
unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
unsigned long background = FRAME_BACKGROUND_PIXEL (f);
Lisp_Object value;
-
+
xassert (img->width > 0 && img->height > 0);
/* Get foreground and background colors, maybe allocate colors. */
{
int w, h;
return (STRINGP (data)
- && xbm_read_bitmap_data (XSTRING (data)->data,
- (XSTRING (data)->data
- + STRING_BYTES (XSTRING (data))),
+ && xbm_read_bitmap_data (SDATA (data),
+ (SDATA (data)
+ + SBYTES (data)),
&w, &h, NULL));
}
-
+
/* Fill image IMG which is used on frame F with pixmap data. Value is
non-zero if successful. */
char *contents;
int size;
struct gcpro gcpro1;
-
+
file = x_find_image_file (file_name);
GCPRO1 (file);
if (!STRINGP (file))
return 0;
}
- contents = slurp_file (XSTRING (file)->data, &size);
+ contents = slurp_file (SDATA (file), &size);
if (contents == NULL)
{
image_error ("Error loading XBM image `%s'", img->spec, Qnil);
background);
if (in_memory_file_p)
- success_p = xbm_load_image (f, img, XSTRING (data)->data,
- (XSTRING (data)->data
- + STRING_BYTES (XSTRING (data))));
+ success_p = xbm_load_image (f, img, SDATA (data),
+ (SDATA (data)
+ + SBYTES (data)));
else
{
if (VECTORP (data))
int i;
char *p;
int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
-
+
p = bits = (char *) alloca (nbytes * img->height);
for (i = 0; i < img->height; ++i, p += nbytes)
{
Lisp_Object line = XVECTOR (data)->contents[i];
if (STRINGP (line))
- bcopy (XSTRING (line)->data, p, nbytes);
+ bcopy (SDATA (line), p, nbytes);
else
bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
}
}
else if (STRINGP (data))
- bits = XSTRING (data)->data;
+ bits = SDATA (data);
else
bits = XBOOL_VECTOR (data)->data;
return success_p;
}
-
+
\f
/***********************************************************************
XPM images
***********************************************************************/
-#if HAVE_XPM
+#if HAVE_XPM
static int xpm_image_p P_ ((Lisp_Object object));
static int xpm_load P_ ((struct frame *f, struct image *img));
{
int i;
XColor color;
-
+
for (i = 0; i < attrs->numsymbols; ++i)
if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
attrs->colorsymbols[i].value, &color))
{
unsigned h = 0;
char *s;
-
+
for (s = color_name; *s; ++s)
h = (h << 2) ^ *s;
return h %= XPM_COLOR_CACHE_BUCKETS;
{
size_t nbytes;
struct xpm_cached_color *p;
-
+
if (bucket < 0)
bucket = xpm_color_bucket (color_name);
-
+
nbytes = sizeof *p + strlen (color_name);
p = (struct xpm_cached_color *) xmalloc (nbytes);
strcpy (p->name, color_name);
color->blue);
p = xpm_cache_color (f, color_name, color, h);
}
-
+ /* You get `opaque' at least from ImageMagick converting pbm to xpm
+ with transparency, and it's useful. */
+ else if (strcmp ("opaque", color_name) == 0)
+ {
+ bzero (color, sizeof (XColor)); /* Is this necessary/correct? */
+ color->pixel = FRAME_FOREGROUND_PIXEL (f);
+ p = xpm_cache_color (f, color_name, color, h);
+ }
+
return p != NULL;
}
Lisp_Object tail;
XpmColorSymbol *xpm_syms;
int i, size;
-
+
attrs.valuemask |= XpmColorSymbols;
/* Count number of symbols. */
{
Lisp_Object name = XCAR (XCAR (tail));
Lisp_Object color = XCDR (XCAR (tail));
- xpm_syms[i].name = (char *) alloca (XSTRING (name)->size + 1);
- strcpy (xpm_syms[i].name, XSTRING (name)->data);
- xpm_syms[i].value = (char *) alloca (XSTRING (color)->size + 1);
- strcpy (xpm_syms[i].value, XSTRING (color)->data);
+ xpm_syms[i].name = (char *) alloca (SCHARS (name) + 1);
+ strcpy (xpm_syms[i].name, SDATA (name));
+ xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1);
+ strcpy (xpm_syms[i].value, SDATA (color));
}
}
#ifdef ALLOC_XPM_COLORS
xpm_init_color_cache (f, &attrs);
#endif
-
+
specified_file = image_spec_value (img->spec, QCfile, NULL);
if (STRINGP (specified_file))
{
image_error ("Cannot find image file `%s'", specified_file, Qnil);
return 0;
}
-
+
rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- XSTRING (file)->data, &img->pixmap, &img->mask,
+ SDATA (file), &img->pixmap, &img->mask,
&attrs);
}
else
{
Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- XSTRING (buffer)->data,
+ SDATA (buffer),
&img->pixmap, &img->mask,
&attrs);
}
case XpmOpenFailed:
image_error ("Error opening XPM file (%s)", img->spec, Qnil);
break;
-
+
case XpmFileInvalid:
image_error ("Invalid XPM file (%s)", img->spec, Qnil);
break;
-
+
case XpmNoMemory:
image_error ("Out of memory (%s)", img->spec, Qnil);
break;
-
+
case XpmColorFailed:
image_error ("Color allocation error (%s)", img->spec, Qnil);
break;
-
+
default:
image_error ("Unknown error (%s)", img->spec, Qnil);
break;
color.red = r;
color.green = g;
color.blue = b;
-
+
cmap = FRAME_X_COLORMAP (f);
rc = x_alloc_nearest_color (f, cmap, &color);
if (rc)
{
++ct_colors_allocated;
-
+
p = (struct ct_color *) xmalloc (sizeof *p);
p->r = r;
p->g = g;
if (rc)
{
++ct_colors_allocated;
-
+
p = (struct ct_color *) xmalloc (sizeof *p);
p->r = color.red;
p->g = color.green;
else
return FRAME_FOREGROUND_PIXEL (f);
}
-
+
return p->pixel;
}
colors = (unsigned long *) xmalloc (ct_colors_allocated
* sizeof *colors);
*n = ct_colors_allocated;
-
+
for (i = j = 0; i < CT_SIZE; ++i)
for (p = ct_table[i]; p; p = p->next)
colors[j++] = p->pixel;
for (y = 0; y < img->height; ++y)
{
XColor *row = p;
-
+
for (x = 0; x < img->width; ++x, ++p)
p->pixel = XGetPixel (ximg, x, y);
XImage *oimg;
Pixmap pixmap;
XColor *p;
-
+
init_color_table ();
-
+
x_create_x_image_and_pixmap (f, img->width, img->height, 0,
&oimg, &pixmap);
p = colors;
MATRIX is a nine-element array specifying the transformation
matrix. See emboss_matrix for an example.
-
+
COLOR_ADJUST is a color adjustment added to each pixel of the
outgoing image. */
p = COLOR (new, img->width - 1, y);
p->red = p->green = p->blue = 0xffff/2;
}
-
+
for (x = 1; x < img->width - 1; ++x)
{
p = COLOR (new, x, 0);
for (y = 1; y < img->height - 1; ++y)
{
p = COLOR (new, 1, y);
-
+
for (x = 1; x < img->width - 1; ++x, ++p)
{
int r, g, b, y1, x1;
{
int i = 0;
int trans[9];
-
+
if (CONSP (matrix))
{
for (i = 0;
/* Determine the background color of ximg. If HOW is `(R G B)'
take that as color. Otherwise, use the image's background color. */
use_img_background = 1;
-
+
if (CONSP (how))
{
int rgb[3], i;
use_img_background = 0;
}
}
-
+
if (use_img_background)
bg = four_corners_best (ximg, img->width, img->height);
x_put_x_image (f, mask_img, img->mask, img->width, img->height);
x_destroy_x_image (mask_img);
XDestroyImage (ximg);
-
+
return 1;
}
Lisp_Object object;
{
struct image_keyword fmt[PBM_LAST];
-
+
bcopy (pbm_format, fmt, sizeof fmt);
-
+
if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm))
return 0;
/* Load PBM image IMG for use on frame F. */
-static int
+static int
pbm_load (f, img)
struct frame *f;
struct image *img;
return 0;
}
- contents = slurp_file (XSTRING (file)->data, &size);
+ contents = slurp_file (SDATA (file), &size);
if (contents == NULL)
{
image_error ("Error reading `%s'", file, Qnil);
{
Lisp_Object data;
data = image_spec_value (img->spec, QCdata, NULL);
- p = XSTRING (data)->data;
- end = p + STRING_BYTES (XSTRING (data));
+ p = SDATA (data);
+ end = p + SBYTES (data);
}
/* Check magic number. */
case '1':
raw_p = 0, type = PBM_MONO;
break;
-
+
case '2':
raw_p = 0, type = PBM_GRAY;
break;
case '4':
raw_p = 1, type = PBM_MONO;
break;
-
+
case '5':
raw_p = 1, type = PBM_GRAY;
break;
-
+
case '6':
raw_p = 1, type = PBM_COLOR;
break;
if (raw_p && max_color_idx > 255)
max_color_idx = 255;
}
-
+
if (width < 0
|| height < 0
|| (type != PBM_MONO && max_color_idx < 0))
if (!x_create_x_image_and_pixmap (f, width, height, 0,
&ximg, &img->pixmap))
goto error;
-
+
/* Initialize the color hash table. */
init_color_table ();
/* Parse the image specification. */
bcopy (pbm_format, fmt, sizeof fmt);
parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
-
+
/* Get foreground and background colors, maybe allocate colors. */
if (fmt[PBM_FOREGROUND].count
&& STRINGP (fmt[PBM_FOREGROUND].value))
img->background = bg;
img->background_valid = 1;
}
-
+
for (y = 0; y < height; ++y)
for (x = 0; x < width; ++x)
{
for (x = 0; x < width; ++x)
{
int r, g, b;
-
+
if (type == PBM_GRAY)
r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
else if (raw_p)
g = pbm_scan_number (&p, end);
b = pbm_scan_number (&p, end);
}
-
+
if (r < 0 || g < 0 || b < 0)
{
xfree (ximg->data);
img->spec, Qnil);
goto error;
}
-
+
/* RGB values are now in the range 0..max_color_idx.
Scale this to the range 0..0xffff supported by X. */
r = (double) r * 65535 / max_color_idx;
XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
}
}
-
+
/* Store in IMG->colors the colors allocated for the image, and
free the color table. */
img->colors = colors_in_color_table (&img->ncolors);
/* Maybe fill in the background field while we have ximg handy. */
if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
IMAGE_BACKGROUND (img, f, ximg);
-
+
/* Put the image into a pixmap. */
x_put_x_image (f, ximg, img->pixmap, width, height);
x_destroy_x_image (ximg);
-
+
img->width = width;
img->height = height;
#if HAVE_PNG
-#include <png.h>
+#if defined HAVE_LIBPNG_PNG_H
+# include <libpng/png.h>
+#else
+# include <png.h>
+#endif
/* Function prototypes. */
{
struct image_keyword fmt[PNG_LAST];
bcopy (png_format, fmt, sizeof fmt);
-
+
if (!parse_image_spec (object, fmt, PNG_LAST, Qpng))
return 0;
if (length > tbr->len - tbr->index)
png_error (png_ptr, "Read error");
-
+
bcopy (tbr->bytes + tbr->index, data, length);
tbr->index = tbr->index + length;
}
png_byte channels;
png_uint_32 row_bytes;
int transparent_p;
- char *gamma_str;
- double screen_gamma, image_gamma;
- int intent;
+ double screen_gamma;
struct png_memory_storage tbr; /* Data to be read */
/* Find out what file to load. */
}
/* Open the image file. */
- fp = fopen (XSTRING (file)->data, "rb");
+ fp = fopen (SDATA (file), "rb");
if (!fp)
{
image_error ("Cannot open image file `%s'", file, Qnil);
else
{
/* Read from memory. */
- tbr.bytes = XSTRING (specified_data)->data;
- tbr.len = STRING_BYTES (XSTRING (specified_data));
+ tbr.bytes = SDATA (specified_data);
+ tbr.len = SBYTES (specified_data);
tbr.index = 0;
/* Check PNG signature. */
png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
&interlace_type, NULL, NULL);
- /* If image contains simply transparency data, we prefer to
+ /* If image contains simply transparency data, we prefer to
construct a clipping mask. */
if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
transparent_p = 1;
else
transparent_p = 0;
- /* This function is easier to write if we only have to handle
+ /* This function is easier to write if we only have to handle
one data format: RGB or RGBA with 8 bits per channel. Let's
transform other formats into that format. */
png_set_expand (png_ptr);
/* Convert grayscale images to RGB. */
- if (color_type == PNG_COLOR_TYPE_GRAY
+ if (color_type == PNG_COLOR_TYPE_GRAY
|| color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
png_set_gray_to_rgb (png_ptr);
- /* The value 2.2 is a guess for PC monitors from PNG example.c. */
- gamma_str = getenv ("SCREEN_GAMMA");
- screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
-
- /* Tell the PNG lib to handle gamma correction for us. */
+ screen_gamma = (f->gamma ? 1 / f->gamma / 0.45455 : 2.2);
+#if 0 /* Avoid double gamma correction for PNG images. */
+ { /* Tell the PNG lib to handle gamma correction for us. */
+ int intent;
+ double image_gamma;
#if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
- if (png_get_sRGB (png_ptr, info_ptr, &intent))
- /* There is a special chunk in the image specifying the gamma. */
- png_set_sRGB (png_ptr, info_ptr, intent);
- else
+ if (png_get_sRGB (png_ptr, info_ptr, &intent))
+ /* The libpng documentation says this is right in this case. */
+ png_set_gamma (png_ptr, screen_gamma, 0.45455);
+ else
#endif
- if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
- /* Image contains gamma information. */
- png_set_gamma (png_ptr, screen_gamma, image_gamma);
- else
- /* Use a default of 0.5 for the image gamma. */
- png_set_gamma (png_ptr, screen_gamma, 0.5);
+ if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
+ /* Image contains gamma information. */
+ png_set_gamma (png_ptr, screen_gamma, image_gamma);
+ else
+ /* Use the standard default for the image gamma. */
+ png_set_gamma (png_ptr, screen_gamma, 0.45455);
+ }
+#endif /* if 0 */
/* Handle alpha channel by combining the image with a background
color. Do this only if a real alpha channel is supplied. For
/* The user specified `:background', use that. */
{
XColor color;
- if (x_defined_color (f, XSTRING (specified_bg)->data, &color, 0))
+ if (x_defined_color (f, SDATA (specified_bg), &color, 0))
{
png_color_16 user_bg;
}
}
else if (png_get_bKGD (png_ptr, info_ptr, &image_bg))
- /* Image contains a background color with which to
+ /* Image contains a background color with which to
combine the image. */
png_set_background (png_ptr, image_bg,
PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
else
{
/* Image does not contain a background color with which
- to combine the image data via an alpha channel. Use
+ to combine the image data via an alpha channel. Use
the frame's background instead. */
XColor color;
Colormap cmap;
fclose (fp);
fp = NULL;
}
-
+
/* Create the X image and pixmap. */
if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
&img->pixmap))
goto error;
-
+
/* Create an image and pixmap serving as mask if the PNG image
contains an alpha channel. */
if (channels == 4
XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
/* An alpha channel, aka mask channel, associates variable
- transparency with an image. Where other image formats
- support binary transparency---fully transparent or fully
+ transparency with an image. Where other image formats
+ support binary transparency---fully transparent or fully
opaque---PNG allows up to 254 levels of partial transparency.
The PNG library implements partial transparency by combining
the image with a specified background color.
I'm not sure how to handle this here nicely: because the
background on which the image is displayed may change, for
- real alpha channel support, it would be necessary to create
- a new image for each possible background.
+ real alpha channel support, it would be necessary to create
+ a new image for each possible background.
What I'm doing now is that a mask is created if we have
boolean transparency information. Otherwise I'm using
/* Work around a warning about HAVE_STDLIB_H being redefined in
jconfig.h. */
#ifdef HAVE_STDLIB_H
-# undef HAVE_STDLIB_H
-# include <jpeglib.h>
-# undef HAVE_STDLIB_H
-# define HAVE_STDLIB_H 1
-#else
-# include <jpeglib.h>
-#endif /* HAVE_STDLIB_H */
-#include <jerror.h>
+#define HAVE_STDLIB_H_1
+#undef HAVE_STDLIB_H
+#endif /* HAVE_STLIB_H */
+#include <jpeglib.h>
+#include <jerror.h>
#include <setjmp.h>
+#ifdef HAVE_STLIB_H_1
+#define HAVE_STDLIB_H 1
+#endif
+
static int jpeg_image_p P_ ((Lisp_Object object));
static int jpeg_load P_ ((struct frame *f, struct image *img));
Lisp_Object object;
{
struct image_keyword fmt[JPEG_LAST];
-
+
bcopy (jpeg_format, fmt, sizeof fmt);
-
+
if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg))
return 0;
{
if (num_bytes > src->bytes_in_buffer)
ERREXIT (cinfo, JERR_INPUT_EOF);
-
+
src->bytes_in_buffer -= num_bytes;
src->next_input_byte += num_bytes;
}
src = (struct jpeg_source_mgr *) cinfo->src;
src->next_input_byte = data;
}
-
+
src = (struct jpeg_source_mgr *) cinfo->src;
src->init_source = our_init_source;
src->fill_input_buffer = our_fill_input_buffer;
/* Load image IMG for use on frame F. Patterned after example.c
from the JPEG lib. */
-static int
+static int
jpeg_load (f, img)
struct frame *f;
struct image *img;
UNGCPRO;
return 0;
}
-
- fp = fopen (XSTRING (file)->data, "r");
+
+ fp = fopen (SDATA (file), "r");
if (fp == NULL)
{
image_error ("Cannot open `%s'", file, Qnil);
error is detected. This function will perform a longjmp. */
cinfo.err = jpeg_std_error (&mgr.pub);
mgr.pub.error_exit = my_error_exit;
-
+
if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
{
if (rc == 1)
image_error ("Error reading JPEG image `%s': %s", img->spec,
build_string (buffer));
}
-
+
/* Close the input file and destroy the JPEG object. */
if (fp)
fclose ((FILE *) fp);
/* Free pixmap and colors. */
x_clear_image (f, img);
-
+
UNGCPRO;
return 0;
}
if (NILP (specified_data))
jpeg_stdio_src (&cinfo, (FILE *) fp);
else
- jpeg_memory_src (&cinfo, XSTRING (specified_data)->data,
- STRING_BYTES (XSTRING (specified_data)));
+ jpeg_memory_src (&cinfo, SDATA (specified_data),
+ SBYTES (specified_data));
jpeg_read_header (&cinfo, TRUE);
init_color_table ();
colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
* sizeof *colors);
-
+
for (i = 0; i < cinfo.actual_number_of_colors; ++i)
{
/* Multiply RGB values with 255 because X expects RGB values
/* Maybe fill in the background field while we have ximg handy. */
if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
IMAGE_BACKGROUND (img, f, ximg);
-
+
/* Put the image into the pixmap. */
x_put_x_image (f, ximg, img->pixmap, width, height);
x_destroy_x_image (ximg);
{
struct image_keyword fmt[TIFF_LAST];
bcopy (tiff_format, fmt, sizeof fmt);
-
+
if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff))
return 0;
-
+
/* Must specify either the :data or :file keyword. */
return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
}
case SEEK_SET: /* Go from beginning of source. */
idx = off;
break;
-
+
case SEEK_END: /* Go from end of source. */
idx = src->len + off;
break;
-
+
case SEEK_CUR: /* Go from current position. */
idx = src->index + off;
break;
-
+
default: /* Invalid `whence'. */
return -1;
}
-
+
if (idx > src->len || idx < 0)
return -1;
-
+
src->index = idx;
return src->index;
}
{
char buf[512];
int len;
-
+
len = sprintf (buf, "TIFF error: %s ", title);
vsprintf (buf + len, format, ap);
add_to_log (buf, Qnil, Qnil);
{
char buf[512];
int len;
-
+
len = sprintf (buf, "TIFF warning: %s ", title);
vsprintf (buf + len, format, ap);
add_to_log (buf, Qnil, Qnil);
UNGCPRO;
return 0;
}
-
+
/* Try to open the image file. */
- tiff = TIFFOpen (XSTRING (file)->data, "r");
+ tiff = TIFFOpen (SDATA (file), "r");
if (tiff == NULL)
{
image_error ("Cannot open `%s'", file, Qnil);
else
{
/* Memory source! */
- memsrc.bytes = XSTRING (specified_data)->data;
- memsrc.len = STRING_BYTES (XSTRING (specified_data));
+ memsrc.bytes = SDATA (specified_data);
+ memsrc.len = SBYTES (specified_data);
memsrc.index = 0;
tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
buf = (uint32 *) xmalloc (width * height * sizeof *buf);
-
+
rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
TIFFClose (tiff);
if (!rc)
for (y = 0; y < height; ++y)
{
uint32 *row = buf + y * width;
-
+
for (x = 0; x < width; ++x)
{
uint32 abgr = row[x];
int r = TIFFGetR (abgr) << 8;
int g = TIFFGetG (abgr) << 8;
int b = TIFFGetB (abgr) << 8;
- XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
+ XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
}
}
/* Remember the colors allocated for the image. Free the color table. */
img->colors = colors_in_color_table (&img->ncolors);
free_color_table ();
-
+
img->width = width;
img->height = height;
{
struct image_keyword fmt[GIF_LAST];
bcopy (gif_format, fmt, sizeof fmt);
-
+
if (!parse_image_spec (object, fmt, GIF_LAST, Qgif))
return 0;
-
+
/* Must specify either the :data or :file keyword. */
return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
}
UNGCPRO;
return 0;
}
-
+
/* Open the GIF file. */
- gif = DGifOpenFileName (XSTRING (file)->data);
+ gif = DGifOpenFileName (SDATA (file));
if (gif == NULL)
{
image_error ("Cannot open `%s'", file, Qnil);
{
/* Read from memory! */
current_gif_memory_src = &memsrc;
- memsrc.bytes = XSTRING (specified_data)->data;
- memsrc.len = STRING_BYTES (XSTRING (specified_data));
+ memsrc.bytes = SDATA (specified_data);
+ memsrc.len = SBYTES (specified_data);
memsrc.index = 0;
gif = DGifOpen(&memsrc, gif_read_from_memory);
UNGCPRO;
return 0;
}
-
+
/* Allocate colors. */
gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
if (!gif_color_map)
gif_color_map = gif->SColorMap;
init_color_table ();
bzero (pixel_colors, sizeof pixel_colors);
-
+
for (i = 0; i < gif_color_map->ColorCount; ++i)
{
int r = gif_color_map->Colors[i].Red << 8;
free_color_table ();
/* Clear the part of the screen image that are not covered by
- the image from the GIF file. Full animated GIF support
+ the image from the GIF file. Full animated GIF support
requires more than can be done here (see the gif89 spec,
disposal methods). Let's simply assume that the part
not covered by a sub-image is in the frame's background color. */
`raster' here because RasterBits below is a char *, and invites
problems with bytes >= 0x80. */
raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
-
+
if (gif->SavedImages[ino].ImageDesc.Interlace)
{
static int interlace_start[] = {0, 4, 2, 1};
while (row >= image_height)
row = interlace_start[++pass];
}
-
+
for (x = 0; x < image_width; x++)
{
int i = raster[(y * image_width) + x];
XPutPixel (ximg, x + image_left, row + image_top,
pixel_colors[i]);
}
-
+
row += interlace_increment[pass];
}
}
XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
}
}
-
+
DGifCloseFile (gif);
/* Maybe fill in the background field while we have ximg handy. */
if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
IMAGE_BACKGROUND (img, f, ximg);
-
+
/* Put the image into the pixmap, then free the X image and its buffer. */
x_put_x_image (f, ximg, img->pixmap, width, height);
x_destroy_x_image (ximg);
-
+
UNGCPRO;
return 1;
}
struct image_keyword fmt[GS_LAST];
Lisp_Object tem;
int i;
-
+
bcopy (gs_format, fmt, sizeof fmt);
-
+
if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript))
return 0;
image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
return 0;
}
-
+
/* Call the loader to fill the pixmap. It returns a process object
if successful. We do not record_unwind_protect here because
other places in redisplay like calling window scroll functions
(unsigned long) FRAME_X_WINDOW (f),
(unsigned long) img->pixmap);
window_and_pixmap_id = build_string (buffer);
-
+
sprintf (buffer, "%lu %lu",
FRAME_FOREGROUND_PIXEL (f),
FRAME_BACKGROUND_PIXEL (f));
pixel_colors = build_string (buffer);
-
+
XSETFRAME (frame, f);
loader = image_spec_value (img->spec, QCloader, NULL);
if (NILP (loader))
instance, give up. */
if (i == c->used)
return;
-
+
/* Kill the GS process. We should have found PIXMAP in the image
cache and its image should contain a process object. */
img = c->images[i];
if (ximg)
{
int x, y;
-
+
/* Initialize the color table. */
init_color_table ();
-
+
/* For each pixel of the image, look its color up in the
color table. After having done so, the color table will
contain an entry for each color used by the image. */
else
image_error ("Cannot get X image of `%s'; colors will not be freed",
img->spec, Qnil);
-
+
UNBLOCK_INPUT;
}
CHECK_STRING (value);
BLOCK_INPUT;
- prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
+ prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
prop_atom, XA_STRING, 8, PropModeReplace,
- XSTRING (value)->data, XSTRING (value)->size);
+ SDATA (value), SCHARS (value));
/* Make sure the property is set when we return. */
XFlush (FRAME_X_DISPLAY (f));
CHECK_STRING (prop);
BLOCK_INPUT;
- prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
+ prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
/* Make sure the property is removed when we return. */
CHECK_STRING (prop);
BLOCK_INPUT;
- prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
+ prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
prop_atom, 0, 0, False, XA_STRING,
&actual_type, &actual_format, &actual_size,
rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
prop_atom, 0, bytes_remaining,
False, XA_STRING,
- &actual_type, &actual_format,
- &actual_size, &bytes_remaining,
+ &actual_type, &actual_format,
+ &actual_size, &bytes_remaining,
(unsigned char **) &tmp_data);
if (rc == Success && tmp_data)
prop_value = make_string (tmp_data, size);
{
EMACS_TIME delay;
int secs, usecs = 0;
-
+
cancel_hourglass ();
if (INTEGERP (Vhourglass_delay)
}
else
secs = DEFAULT_HOURGLASS_DELAY;
-
+
EMACS_SET_SECS_USECS (delay, secs, usecs);
hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
show_hourglass, NULL);
cancel_atimer (hourglass_atimer);
hourglass_atimer = NULL;
}
-
+
if (hourglass_shown_p)
hide_hourglass ();
}
if (!hourglass_shown_p)
{
Lisp_Object rest, frame;
-
+
BLOCK_INPUT;
-
+
FOR_EACH_FRAME (rest, frame)
{
struct frame *f = XFRAME (frame);
-
+
if (FRAME_LIVE_P (f) && FRAME_X_P (f) && FRAME_X_DISPLAY (f))
{
Display *dpy = FRAME_X_DISPLAY (f);
-
+
#ifdef USE_X_TOOLKIT
if (f->output_data.x->widget)
#else
#endif
{
f->output_data.x->hourglass_p = 1;
-
+
if (!f->output_data.x->hourglass_window)
{
unsigned long mask = CWCursor;
XSetWindowAttributes attrs;
-
+
attrs.cursor = f->output_data.x->hourglass_cursor;
-
+
f->output_data.x->hourglass_window
= XCreateWindow (dpy, FRAME_OUTER_WINDOW (f),
0, 0, 32000, 32000, 0, 0,
CopyFromParent,
mask, &attrs);
}
-
+
XMapRaised (dpy, f->output_data.x->hourglass_window);
XFlush (dpy);
}
FOR_EACH_FRAME (rest, frame)
{
struct frame *f = XFRAME (frame);
-
+
if (FRAME_X_P (f)
/* Watch out for newly created frames. */
&& f->output_data.x->hourglass_window)
Lisp_Object, Lisp_Object));
static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
Lisp_Object, int, int, int *, int *));
-
+
/* The frame of a currently visible tooltip. */
Lisp_Object tip_frame;
tip_window = None;
tip_frame = Qnil;
}
-
+
return deleted;
}
Lisp_Object name;
long window_prompting = 0;
int width, height;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
struct kboard *kb;
int face_change_count_before = face_change_count;
XSETFRAME (frame, f);
buffer = Fget_buffer_create (build_string (" *tip*"));
- Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
+ Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
old_buffer = current_buffer;
set_buffer_internal_1 (XBUFFER (buffer));
current_buffer->truncate_lines = Qnil;
Ferase_buffer ();
Finsert (1, &text);
set_buffer_internal_1 (old_buffer);
-
+
FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
record_unwind_protect (unwind_create_tip_frame, frame);
f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
bzero (f->output_data.x, sizeof (struct x_output));
f->output_data.x->icon_bitmap = -1;
- f->output_data.x->fontset = -1;
+ FRAME_FONTSET (f) = -1;
f->output_data.x->scroll_bar_foreground_pixel = -1;
f->output_data.x->scroll_bar_background_pixel = -1;
#ifdef USE_TOOLKIT_SCROLL_BARS
{
Lisp_Object black;
struct gcpro gcpro1;
-
+
black = build_string ("black");
GCPRO1 (black);
f->output_data.x->foreground_pixel
{
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_fontset (f, font);
+ 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");
x_default_parameter (f, parms, Qborder_width, make_number (2),
"borderWidth", "BorderWidth", RES_TYPE_NUMBER);
-
+
/* This defaults to 2 in order to match xterm. We recognize either
internalBorderWidth or internalBorder (which is what xterm calls
it). */
end up in init_iterator with a null face cache, which should not
happen. */
init_frame_faces (f);
-
+
f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
- window_prompting = x_figure_window_size (f, parms);
- if (window_prompting & XNegative)
- {
- if (window_prompting & YNegative)
- f->output_data.x->win_gravity = SouthEastGravity;
- else
- f->output_data.x->win_gravity = NorthEastGravity;
- }
- else
- {
- if (window_prompting & YNegative)
- f->output_data.x->win_gravity = SouthWestGravity;
- else
- f->output_data.x->win_gravity = NorthWestGravity;
- }
+ window_prompting = x_figure_window_size (f, parms, 0);
- f->output_data.x->size_hint_flags = window_prompting;
{
XSetWindowAttributes attrs;
unsigned long mask;
-
+
BLOCK_INPUT;
mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
if (DoesSaveUnders (dpyinfo->screen))
mask |= CWSaveUnder;
-
+
/* Window managers look at the override-redirect flag to determine
whether or net to give windows a decoration (Xlib spec, chapter
3.2.8). */
x_default_parameter (f, parms, Qcursor_type, Qbox,
"cursorType", "CursorType", RES_TYPE_SYMBOL);
- /* Dimensions, especially f->height, must be done via change_frame_size.
+ /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
Change will not be effected unless different from the current
- f->height. */
- width = f->width;
- height = f->height;
- f->height = 0;
- SET_FRAME_WIDTH (f, 0);
+ FRAME_LINES (f). */
+ width = FRAME_COLS (f);
+ height = FRAME_LINES (f);
+ SET_FRAME_COLS (f, 0);
+ FRAME_LINES (f) = 0;
change_frame_size (f, height, width, 1, 0, 0);
+ /* Add `tooltip' frame parameter's default value. */
+ if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
+ Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
+ Qnil));
+
/* Set up faces after all frame parameters are known. This call
also merges in face attributes specified for new frames.
/* Set tip_frame here, so that */
tip_frame = frame;
call1 (Qface_set_after_frame_default, frame);
-
+
if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
Qnil));
}
-
+
f->no_split = 1;
UNGCPRO;
int win_x, win_y;
Window root, child;
unsigned pmask;
-
+
/* User-specified position? */
left = Fcdr (Fassq (Qleft, parms));
top = Fcdr (Fassq (Qtop, parms));
-
+
/* Move the tooltip window where the mouse pointer is. Resize and
show it. */
if (!INTEGERP (left) || !INTEGERP (top))
int i, width, height;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
- int count = BINDING_STACK_SIZE ();
-
+ int count = SPECPDL_INDEX ();
+
specbind (Qinhibit_redisplay, Qt);
GCPRO4 (string, parms, frame, timeout);
timeout = make_number (5);
else
CHECK_NATNUM (timeout);
-
+
if (NILP (dx))
dx = make_number (5);
else
CHECK_NUMBER (dx);
-
+
if (NILP (dy))
dy = make_number (-10);
else
&& !NILP (Fequal (last_parms, parms)))
{
struct frame *f = XFRAME (tip_frame);
-
+
/* Only DX and DY have changed. */
if (!NILP (tip_timer))
{
}
BLOCK_INPUT;
- compute_tip_xy (f, parms, dx, dy, PIXEL_WIDTH (f),
- PIXEL_HEIGHT (f), &root_x, &root_y);
+ compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
+ FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
root_x, root_y);
UNBLOCK_INPUT;
/* Set up the frame's root window. */
w = XWINDOW (FRAME_ROOT_WINDOW (f));
- w->left = w->top = make_number (0);
-
+ w->left_col = w->top_line = make_number (0);
+
if (CONSP (Vx_max_tooltip_size)
&& INTEGERP (XCAR (Vx_max_tooltip_size))
&& XINT (XCAR (Vx_max_tooltip_size)) > 0
&& INTEGERP (XCDR (Vx_max_tooltip_size))
&& XINT (XCDR (Vx_max_tooltip_size)) > 0)
{
- w->width = XCAR (Vx_max_tooltip_size);
- w->height = XCDR (Vx_max_tooltip_size);
+ w->total_cols = XCAR (Vx_max_tooltip_size);
+ w->total_lines = XCDR (Vx_max_tooltip_size);
}
else
{
- w->width = make_number (80);
- w->height = make_number (40);
+ w->total_cols = make_number (80);
+ w->total_lines = make_number (40);
}
-
- f->window_width = XINT (w->width);
+
+ FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
adjust_glyphs (f);
w->pseudo_window_p = 1;
}
else
row_width = row->pixel_width;
-
+
height += row->height;
width = max (width, row_width);
}
root_x, root_y, width, height);
XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
UNBLOCK_INPUT;
-
+
/* Draw into the window. */
w->must_be_updated_p = 1;
update_single_window (w, 1);
/* Return quickly if nothing to do. */
if (NILP (tip_timer) && NILP (tip_frame))
return Qnil;
-
+
frame = tip_frame;
timer = tip_timer;
GCPRO2 (frame, timer);
tip_frame = tip_timer = deleted = Qnil;
-
- count = BINDING_STACK_SIZE ();
+
+ count = SPECPDL_INDEX ();
specbind (Qinhibit_redisplay, Qt);
specbind (Qinhibit_quit, Qt);
-
+
if (!NILP (timer))
call1 (Qcancel_timer, timer);
int ac = 0;
extern XtAppContext Xt_app_con;
XmString dir_xmstring, pattern_xmstring;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
GCPRO5 (prompt, dir, default_filename, mustmatch, file);
/* Create the dialog with PROMPT as title, using DIR as initial
directory and using "*" as pattern. */
dir = Fexpand_file_name (dir, Qnil);
- dir_xmstring = XmStringCreateLocalized (XSTRING (dir)->data);
+ dir_xmstring = XmStringCreateLocalized (SDATA (dir));
pattern_xmstring = XmStringCreateLocalized ("*");
-
- XtSetArg (al[ac], XmNtitle, XSTRING (prompt)->data); ++ac;
+
+ XtSetArg (al[ac], XmNtitle, SDATA (prompt)); ++ac;
XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
XtSetSensitive (help, False);
- /* Mark OK button as default. */
+ /* Mark OK button as default. */
XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
XmNshowAsDefault, True, NULL);
int item_pos;
default_xmstring
- = XmStringCreateLocalized (XSTRING (default_filename)->data);
+ = XmStringCreateLocalized (SDATA (default_filename));
if (!XmListItemExists (list, default_xmstring))
{
XmListSetPos (list, item_pos);
}
- /* Process events until the user presses Cancel or OK. Block
- and unblock input here so that we get a chance of processing
- expose events. */
- UNBLOCK_INPUT;
+ /* Process events until the user presses Cancel or OK. */
result = 0;
while (result == 0)
{
- BLOCK_INPUT;
- XtAppProcessEvent (Xt_app_con, XtIMAll);
- UNBLOCK_INPUT;
+ XEvent event;
+ XtAppNextEvent (Xt_app_con, &event);
+ (void) x_dispatch_event (&event, FRAME_X_DISPLAY (f) );
}
- BLOCK_INPUT;
/* Get the result. */
if (result == XmCR_OK)
{
XmString text;
String data;
-
+
XtVaGetValues (dialog, XmNtextString, &text, NULL);
XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
XmStringFree (text);
/* Make "Cancel" equivalent to C-g. */
if (NILP (file))
Fsignal (Qquit, Qnil);
-
+
return unbind_to (count, file);
}
#endif /* USE_MOTIF */
+#ifdef USE_GTK
+
+DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
+ "Read file name, prompting with PROMPT in directory DIR.\n\
+Use a file selection dialog.\n\
+Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
+specified. Don't let the user enter a file name in the file\n\
+selection dialog's entry field, if MUSTMATCH is non-nil.")
+ (prompt, dir, default_filename, mustmatch)
+ Lisp_Object prompt, dir, default_filename, mustmatch;
+{
+ FRAME_PTR f = SELECTED_FRAME ();
+ char *fn;
+ Lisp_Object file = Qnil;
+ int count = specpdl_ptr - specpdl;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+ char *cdef_file;
+ char *cprompt;
+
+ GCPRO5 (prompt, dir, default_filename, mustmatch, file);
+ CHECK_STRING (prompt);
+ CHECK_STRING (dir);
+
+ /* Prevent redisplay. */
+ specbind (Qinhibit_redisplay, Qt);
+
+ BLOCK_INPUT;
+
+ if (STRINGP (default_filename))
+ cdef_file = SDATA (default_filename);
+ else
+ cdef_file = SDATA (dir);
+
+ fn = xg_get_file_name (f, SDATA (prompt), cdef_file, ! NILP (mustmatch));
+
+ if (fn)
+ {
+ file = build_string (fn);
+ xfree (fn);
+ }
+
+ UNBLOCK_INPUT;
+ UNGCPRO;
+
+ /* Make "Cancel" equivalent to C-g. */
+ if (NILP (file))
+ Fsignal (Qquit, Qnil);
+
+ return unbind_to (count, file);
+}
+
+#endif /* USE_GTK */
\f
/***********************************************************************
UNBLOCK_INPUT;
return Qnil;
}
-
+
have_keys = Qnil;
kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
if (kb)
}
XkbFreeClientMap (kb, 0, True);
-
+
if (delete_keycode
&& backspace_keycode
&& XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
Initialization
***********************************************************************/
+/* Keep this list in the same order as frame_parms in frame.c.
+ Use 0 for unsupported frame parameters. */
+
+frame_parm_handler x_frame_parm_handlers[] =
+{
+ x_set_autoraise,
+ x_set_autolower,
+ x_set_background_color,
+ x_set_border_color,
+ x_set_border_width,
+ x_set_cursor_color,
+ x_set_cursor_type,
+ x_set_font,
+ x_set_foreground_color,
+ x_set_icon_name,
+ x_set_icon_type,
+ x_set_internal_border_width,
+ x_set_menu_bar_lines,
+ x_set_mouse_color,
+ x_explicitly_set_name,
+ x_set_scroll_bar_width,
+ x_set_title,
+ x_set_unsplittable,
+ x_set_vertical_scroll_bars,
+ x_set_visibility,
+ x_set_tool_bar_lines,
+ x_set_scroll_bar_foreground,
+ x_set_scroll_bar_background,
+ x_set_screen_gamma,
+ x_set_line_spacing,
+ x_set_fringe_width,
+ x_set_fringe_width,
+ x_set_wait_for_wm,
+ x_set_fullscreen,
+};
+
void
syms_of_xfns ()
{
/* The section below is built by the lisp expression at the top of the file,
just above where these variables are declared. */
/*&&& init symbols here &&&*/
- Qauto_raise = intern ("auto-raise");
- staticpro (&Qauto_raise);
- Qauto_lower = intern ("auto-lower");
- staticpro (&Qauto_lower);
- Qbar = intern ("bar");
- staticpro (&Qbar);
- Qborder_color = intern ("border-color");
- staticpro (&Qborder_color);
- Qborder_width = intern ("border-width");
- staticpro (&Qborder_width);
- Qbox = intern ("box");
- staticpro (&Qbox);
- Qcursor_color = intern ("cursor-color");
- staticpro (&Qcursor_color);
- Qcursor_type = intern ("cursor-type");
- staticpro (&Qcursor_type);
- Qgeometry = intern ("geometry");
- staticpro (&Qgeometry);
- Qicon_left = intern ("icon-left");
- staticpro (&Qicon_left);
- Qicon_top = intern ("icon-top");
- staticpro (&Qicon_top);
- Qicon_type = intern ("icon-type");
- staticpro (&Qicon_type);
- Qicon_name = intern ("icon-name");
- staticpro (&Qicon_name);
- Qinternal_border_width = intern ("internal-border-width");
- staticpro (&Qinternal_border_width);
- Qleft = intern ("left");
- staticpro (&Qleft);
- Qright = intern ("right");
- staticpro (&Qright);
- Qmouse_color = intern ("mouse-color");
- staticpro (&Qmouse_color);
Qnone = intern ("none");
staticpro (&Qnone);
- Qparent_id = intern ("parent-id");
- staticpro (&Qparent_id);
- Qscroll_bar_width = intern ("scroll-bar-width");
- staticpro (&Qscroll_bar_width);
Qsuppress_icon = intern ("suppress-icon");
staticpro (&Qsuppress_icon);
Qundefined_color = intern ("undefined-color");
staticpro (&Qundefined_color);
- Qvertical_scroll_bars = intern ("vertical-scroll-bars");
- staticpro (&Qvertical_scroll_bars);
- Qvisibility = intern ("visibility");
- staticpro (&Qvisibility);
- Qwindow_id = intern ("window-id");
- staticpro (&Qwindow_id);
- Qouter_window_id = intern ("outer-window-id");
- staticpro (&Qouter_window_id);
- Qx_frame_parameter = intern ("x-frame-parameter");
- staticpro (&Qx_frame_parameter);
- Qx_resource_name = intern ("x-resource-name");
- staticpro (&Qx_resource_name);
- Quser_position = intern ("user-position");
- staticpro (&Quser_position);
- Quser_size = intern ("user-size");
- staticpro (&Quser_size);
- Qscroll_bar_foreground = intern ("scroll-bar-foreground");
- staticpro (&Qscroll_bar_foreground);
- Qscroll_bar_background = intern ("scroll-bar-background");
- staticpro (&Qscroll_bar_background);
- Qscreen_gamma = intern ("screen-gamma");
- staticpro (&Qscreen_gamma);
- Qline_spacing = intern ("line-spacing");
- staticpro (&Qline_spacing);
Qcenter = intern ("center");
staticpro (&Qcenter);
Qcompound_text = intern ("compound-text");
staticpro (&Qcompound_text);
Qcancel_timer = intern ("cancel-timer");
staticpro (&Qcancel_timer);
- Qwait_for_wm = intern ("wait-for-wm");
- staticpro (&Qwait_for_wm);
- Qfullscreen = intern ("fullscreen");
- staticpro (&Qfullscreen);
- Qfullwidth = intern ("fullwidth");
- staticpro (&Qfullwidth);
- Qfullheight = intern ("fullheight");
- staticpro (&Qfullheight);
- Qfullboth = intern ("fullboth");
- staticpro (&Qfullboth);
/* This is the end of symbol initialization. */
/* Text property `display' should be nonsticky by default. */
staticpro (&QCcolor_adjustment);
QCmask = intern (":mask");
staticpro (&QCmask);
-
- Qface_set_after_frame_default = intern ("face-set-after-frame-default");
- staticpro (&Qface_set_after_frame_default);
Fput (Qundefined_color, Qerror_conditions,
Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
Fput (Qundefined_color, Qerror_message,
build_string ("Undefined color"));
- init_x_parm_symbols ();
-
DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images,
doc: /* Non-nil means always draw a cross over disabled images.
Disabled images are those having an `:conversion disabled' property.
cross_disabled_images = 0;
DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
- doc: /* List of directories to search for bitmap files for X. */);
+ doc: /* List of directories to search for window system bitmap files. */);
Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
unless you set the mouse color. */);
Vx_pointer_shape = Qnil;
- DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
- doc: /* The name Emacs uses to look up X resources.
-`x-get-resource' uses this as the first component of the instance name
-when requesting resource values.
-Emacs initially sets `x-resource-name' to the name under which Emacs
-was invoked, or to the value specified with the `-name' or `-rn'
-switches, if present.
-
-It may be useful to bind this variable locally around a call
-to `x-get-resource'. See also the variable `x-resource-class'. */);
- Vx_resource_name = Qnil;
-
- DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
- doc: /* The class Emacs uses to look up X resources.
-`x-get-resource' uses this as the first component of the instance class
-when requesting resource values.
-
-Emacs initially sets `x-resource-class' to "Emacs".
-
-Setting this variable permanently is not a reasonable thing to do,
-but binding this variable locally around a call to `x-get-resource'
-is a reasonable practice. See also the variable `x-resource-name'. */);
- Vx_resource_class = build_string (EMACS_CLASS);
-
#if 0 /* This doesn't really do anything. */
DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
doc: /* The shape of the pointer when not over text.
DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
display_hourglass_p = 1;
-
+
DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
doc: /* *Seconds to wait before displaying an hourglass pointer.
Value must be an integer or float. */);
doc: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
Text larger than this is clipped. */);
Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
-
+
DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
doc: /* Non-nil if no X window manager is in use.
Emacs doesn't try to figure this out; this is always nil
#endif /* USE_MOTIF */
#endif /* USE_X_TOOLKIT */
- defsubr (&Sx_get_resource);
-
/* X window properties. */
defsubr (&Sx_change_window_property);
defsubr (&Sx_delete_window_property);
defsubr (&Sx_display_visual_class);
defsubr (&Sx_display_backing_store);
defsubr (&Sx_display_save_under);
- defsubr (&Sx_parse_geometry);
defsubr (&Sx_create_frame);
defsubr (&Sx_open_connection);
defsubr (&Sx_close_connection);
defsubr (&Sx_synchronize);
defsubr (&Sx_focus_frame);
defsubr (&Sx_backspace_delete_keys_p);
-
+
/* Setting callback functions for fontset handler. */
get_font_info_func = x_get_font_info;
And the pointer assigned has the wrong type, anyway. */
list_fonts_func = x_list_fonts;
#endif
-
+
load_font_func = x_load_font;
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;
/* Images. */
Qxbm = intern ("xbm");
staticpro (&Qxbm);
- QCtype = intern (":type");
- staticpro (&QCtype);
QCconversion = intern (":conversion");
staticpro (&QCconversion);
QCheuristic_mask = intern (":heuristic-mask");
Qxpm = intern ("xpm");
staticpro (&Qxpm);
#endif
-
+
#if HAVE_JPEG
Qjpeg = intern ("jpeg");
staticpro (&Qjpeg);
-#endif
+#endif
#if HAVE_TIFF
Qtiff = intern ("tiff");
staticpro (&Qtiff);
-#endif
+#endif
#if HAVE_GIF
Qgif = intern ("gif");
{
image_types = NULL;
Vimage_types = Qnil;
-
+
define_image_type (&xbm_type);
define_image_type (&gs_type);
define_image_type (&pbm_type);
-
+
#if HAVE_XPM
define_image_type (&xpm_type);
#endif
-
+
#if HAVE_JPEG
define_image_type (&jpeg_type);
#endif
-
+
#if HAVE_TIFF
define_image_type (&tiff_type);
#endif
-
+
#if HAVE_GIF
define_image_type (&gif_type);
#endif
-
+
#if HAVE_PNG
define_image_type (&png_type);
#endif
/* X Communication module for terminals which understand the X protocol.
- Copyright (C) 1989, 93, 94, 95, 96, 1997, 1998, 1999, 2000, 01, 02
+ Copyright (C) 1989, 93, 94, 95, 96, 97, 98, 1999, 2000, 01, 02, 2003
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 <unistd.h>
#endif
+#ifdef USE_GTK
+#include "gtkutil.h"
+#endif
+
#ifdef USE_LUCID
extern int xlwmenu_window_p P_ ((Widget w, Window window));
extern void xlwmenu_redisplay P_ ((Widget));
#endif
-#ifdef USE_X_TOOLKIT
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
extern void free_frame_menubar P_ ((struct frame *));
extern struct frame *x_menubar_window_to_frame P_ ((struct x_display_info *,
int));
+#endif
+#ifdef USE_X_TOOLKIT
#if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
#define HACK_EDITRES
extern void _XEditResCheckMessages ();
#endif /* USE_X_TOOLKIT */
-#ifndef USE_X_TOOLKIT
+#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
#define x_any_window_to_frame x_window_to_frame
#define x_top_window_to_frame x_window_to_frame
#endif
#endif
#endif
-#ifdef HAVE_X11R6
-/* This isn't prototyped in OSF 5.0 or or XFree 4.1. */
-extern char * XSetIMValues P_ ((XIM, ...));
-#endif
-
#define abs(x) ((x) < 0 ? -(x) : (x))
-#define BETWEEN(X, LOWER, UPPER) ((X) >= (LOWER) && (X) < (UPPER))
-
-\f
-/* Fringe bitmaps. */
-
-enum fringe_bitmap_type
-{
- NO_FRINGE_BITMAP,
- LEFT_TRUNCATION_BITMAP,
- RIGHT_TRUNCATION_BITMAP,
- OVERLAY_ARROW_BITMAP,
- CONTINUED_LINE_BITMAP,
- CONTINUATION_LINE_BITMAP,
- ZV_LINE_BITMAP
-};
-
-/* Bitmap drawn to indicate lines not displaying text if
- `indicate-empty-lines' is non-nil. */
-
-#define zv_width 8
-#define zv_height 72
-#define zv_period 3
-static unsigned char zv_bits[] = {
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00,
- 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x3c, 0x00};
-
-/* An arrow like this: `<-'. */
-
-#define left_width 8
-#define left_height 8
-static unsigned char left_bits[] = {
- 0x18, 0x0c, 0x06, 0x3f, 0x3f, 0x06, 0x0c, 0x18};
-
-/* Right truncation arrow bitmap `->'. */
-
-#define right_width 8
-#define right_height 8
-static unsigned char right_bits[] = {
- 0x18, 0x30, 0x60, 0xfc, 0xfc, 0x60, 0x30, 0x18};
-
-/* Marker for continued lines. */
-
-#define continued_width 8
-#define continued_height 8
-static unsigned char continued_bits[] = {
- 0x3c, 0x7c, 0xc0, 0xe4, 0xfc, 0x7c, 0x3c, 0x7c};
-
-/* Marker for continuation lines. */
-
-#define continuation_width 8
-#define continuation_height 8
-static unsigned char continuation_bits[] = {
- 0x3c, 0x3e, 0x03, 0x27, 0x3f, 0x3e, 0x3c, 0x3e};
-
-/* Overlay arrow bitmap. */
-
-#if 0
-/* A bomb. */
-#define ov_width 8
-#define ov_height 8
-static unsigned char ov_bits[] = {
- 0x30, 0x08, 0x3c, 0x7e, 0x7a, 0x7a, 0x62, 0x3c};
+/* Default to using XIM if available. */
+#ifdef USE_XIM
+int use_xim = 1;
#else
-/* A triangular arrow. */
-#define ov_width 8
-#define ov_height 8
-static unsigned char ov_bits[] = {
- 0x03, 0x0f, 0x1f, 0x3f, 0x3f, 0x1f, 0x0f, 0x03};
-
+int use_xim = 0; /* configure --without-xim */
#endif
-extern Lisp_Object Qhelp_echo;
-
-/* Default to using XIM if available. */
-int use_xim = 1;
\f
+
/* Non-nil means Emacs uses toolkit scroll bars. */
Lisp_Object Vx_toolkit_scroll_bars;
-/* If a string, XTread_socket generates an event to display that string.
- (The display is done in read_char.) */
-
-static Lisp_Object help_echo;
-static Lisp_Object help_echo_window;
-static Lisp_Object help_echo_object;
-static int help_echo_pos;
-
-/* Temporary variable for XTread_socket. */
-
-static Lisp_Object previous_help_echo;
-
/* Non-zero means that a HELP_EVENT has been generated since Emacs
start. */
static int any_help_event_p;
-/* Non-zero means autoselect window with the mouse cursor. */
-
-int x_autoselect_window_p;
-
-/* Non-zero means draw block and hollow cursor as wide as the glyph
- under it. For example, if a block cursor is over a tab, it will be
- drawn as wide as that tab on the display. */
-
-int x_stretch_cursor_p;
+/* Last window where we saw the mouse. Used by mouse-autoselect-window. */
+static Lisp_Object last_window;
/* Non-zero means make use of UNDERLINE_POSITION font properties. */
static String Xt_default_resources[] = {0};
#endif /* USE_X_TOOLKIT */
-/* Nominal cursor position -- where to draw output.
- HPOS and VPOS are window relative glyph matrix coordinates.
- X and Y are window relative pixel coordinates. */
-
-struct cursor_pos output_cursor;
-
/* Non-zero means user is interacting with a toolkit scroll bar. */
static int toolkit_scroll_bar_interaction;
/* Where the mouse was last time we reported a mouse event. */
-FRAME_PTR last_mouse_frame;
static XRectangle last_mouse_glyph;
static Lisp_Object last_mouse_press_frame;
/* A mask of extra modifier bits to put into every keyboard char. */
-extern int extra_keyboard_modifiers;
+extern EMACS_INT extra_keyboard_modifiers;
/* The keysyms to use for the various modifiers. */
static Lisp_Object Qalt, Qhyper, Qmeta, Qsuper, Qmodifier_value;
static Lisp_Object Qvendor_specific_keysyms;
+static Lisp_Object Qlatin_1;
extern XrmDatabase x_load_resources P_ ((Display *, char *, char *, char *));
-extern Lisp_Object x_icon_type P_ ((struct frame *));
-
-
-/* Enumeration for overriding/changing the face to use for drawing
- glyphs in x_draw_glyphs. */
-enum draw_glyphs_face
-{
- DRAW_NORMAL_TEXT,
- DRAW_INVERSE_VIDEO,
- DRAW_CURSOR,
- DRAW_MOUSE_FACE,
- DRAW_IMAGE_RAISED,
- DRAW_IMAGE_SUNKEN
-};
-static int cursor_in_mouse_face_p P_ ((struct window *));
-static int clear_mouse_face P_ ((struct x_display_info *));
static int x_alloc_nearest_color_1 P_ ((Display *, Colormap, XColor *));
static void x_set_window_size_1 P_ ((struct frame *, int, int, int));
static const XColor *x_color_cells P_ ((Display *, int *));
static void x_update_window_end P_ ((struct window *, int, int));
-static void frame_to_window_pixel_xy P_ ((struct window *, int *, int *));
void x_delete_display P_ ((struct x_display_info *));
static unsigned int x_x_to_emacs_modifiers P_ ((struct x_display_info *,
unsigned));
-static int fast_find_position P_ ((struct window *, int, int *, int *,
- int *, int *, Lisp_Object));
-static int fast_find_string_pos P_ ((struct window *, int, Lisp_Object,
- int *, int *, int *, int *, int));
-static void set_output_cursor P_ ((struct cursor_pos *));
-static struct glyph *x_y_to_hpos_vpos P_ ((struct window *, int, int,
- int *, int *, int *, int));
-static void note_mode_line_highlight P_ ((struct window *, int, int));
-static void note_mouse_highlight P_ ((struct frame *, int, int));
-static void note_tool_bar_highlight P_ ((struct frame *f, int, int));
-static void x_handle_tool_bar_click P_ ((struct frame *, XButtonEvent *));
-static void show_mouse_face P_ ((struct x_display_info *,
- enum draw_glyphs_face));
static int x_io_error_quitter P_ ((Display *));
int x_catch_errors P_ ((Display *));
void x_uncatch_errors P_ ((Display *, int));
void x_initialize P_ ((void));
static void x_font_min_bounds P_ ((XFontStruct *, int *, int *));
static int x_compute_min_glyph_bounds P_ ((struct frame *));
-static void x_draw_phys_cursor_glyph P_ ((struct window *,
- struct glyph_row *,
- enum draw_glyphs_face));
static void x_update_end P_ ((struct frame *));
static void XTframe_up_to_date P_ ((struct frame *));
static void XTset_terminal_modes P_ ((void));
static void XTreset_terminal_modes P_ ((void));
-static void XTcursor_to P_ ((int, int, int, int));
-static void x_write_glyphs P_ ((struct glyph *, int));
-static void x_clear_end_of_line P_ ((int));
static void x_clear_frame P_ ((void));
-static void x_clear_cursor P_ ((struct window *));
static void frame_highlight P_ ((struct frame *));
static void frame_unhighlight P_ ((struct frame *));
static void x_new_focus_frame P_ ((struct x_display_info *, struct frame *));
+static int x_focus_changed P_ ((int,
+ int,
+ struct x_display_info *,
+ struct frame *,
+ struct input_event *,
+ int));
+static int x_detect_focus_change P_ ((struct x_display_info *,
+ XEvent *,
+ struct input_event *,
+ int));
static void XTframe_rehighlight P_ ((struct frame *));
static void x_frame_rehighlight P_ ((struct x_display_info *));
static void x_draw_hollow_cursor P_ ((struct window *, struct glyph_row *));
-static void x_draw_bar_cursor P_ ((struct window *, struct glyph_row *, int));
-static int x_intersect_rectangles P_ ((XRectangle *, XRectangle *,
- XRectangle *));
-static void expose_frame P_ ((struct frame *, int, int, int, int));
-static int expose_window_tree P_ ((struct window *, XRectangle *));
-static int expose_window P_ ((struct window *, XRectangle *));
-static void expose_area P_ ((struct window *, struct glyph_row *,
- XRectangle *, enum glyph_row_area));
-static int expose_line P_ ((struct window *, struct glyph_row *,
- XRectangle *));
-static void x_update_cursor_in_window_tree P_ ((struct window *, int));
-static void x_update_window_cursor P_ ((struct window *, int));
-static void x_erase_phys_cursor P_ ((struct window *));
-void x_display_and_set_cursor P_ ((struct window *, int, int, int, int, int));
-static void x_draw_fringe_bitmap P_ ((struct window *, struct glyph_row *,
- enum fringe_bitmap_type, int left_p));
-
-static void x_clip_to_row P_ ((struct window *, struct glyph_row *,
- GC, int));
-static int x_phys_cursor_in_rect_p P_ ((struct window *, XRectangle *));
-static void x_draw_row_fringe_bitmaps P_ ((struct window *, struct glyph_row *));
-static void notice_overwritten_cursor P_ ((struct window *, enum glyph_row_area,
- int, int, int, int));
+static void x_draw_bar_cursor P_ ((struct window *, struct glyph_row *, int,
+ enum text_cursor_kinds));
+
+static void x_clip_to_row P_ ((struct window *, struct glyph_row *, GC));
static void x_flush P_ ((struct frame *f));
static void x_update_begin P_ ((struct frame *));
static void x_update_window_begin P_ ((struct window *));
-static void x_draw_vertical_border P_ ((struct window *));
static void x_after_update_window_line P_ ((struct glyph_row *));
-static INLINE void take_vertical_position_into_account P_ ((struct it *));
-static void x_produce_stretch_glyph P_ ((struct it *));
static struct scroll_bar *x_window_to_scroll_bar P_ ((Window));
static void x_scroll_bar_report_motion P_ ((struct frame **, Lisp_Object *,
enum scroll_bar_part *,
unsigned long *));
static void x_check_fullscreen P_ ((struct frame *));
static void x_check_fullscreen_move P_ ((struct frame *));
+static int handle_one_xevent P_ ((struct x_display_info *,
+ XEvent *,
+ struct input_event **,
+ int *,
+ int *));
+
/* Flush display of frame F, or of all frames if F is null. */
XTread_socket calls XPending. Removing XFlush improves
performance. */
-#define XFlush(DISPLAY) (void) 0
+#define XFlush(DISPLAY) (void) 0
\f
/***********************************************************************
/* This is a function useful for recording debugging information about
the sequence of occurrences in this file. */
-struct record
+struct record
{
char *locus;
int type;
/***********************************************************************
Starting and ending an update
***********************************************************************/
-
+
/* Start an update of frame F. This function is installed as a hook
for update_begin, i.e. it is called when update_begin is called.
This function is called prior to calls to x_update_window_begin for
{
struct frame *f = XFRAME (WINDOW_FRAME (w));
struct x_display_info *display_info = FRAME_X_DISPLAY_INFO (f);
-
+
updated_window = w;
set_output_cursor (&w->cursor);
flag set. So, rows containing mouse-face glyphs are never
scrolled, and we don't have to switch the mouse highlight off
here to prevent it from being scrolled. */
-
+
/* Can we tell that this update does not affect the window
where the mouse highlight is? If so, no need to turn off.
Likewise, don't do anything if the frame is garbaged;
}
-/* Draw a vertical window border to the right of window W if W doesn't
- have vertical scroll bars. */
+/* Draw a vertical window border from (x,y0) to (x,y1) */
static void
-x_draw_vertical_border (w)
+x_draw_vertical_window_border (w, x, y0, y1)
struct window *w;
+ int x, y0, y1;
{
struct frame *f = XFRAME (WINDOW_FRAME (w));
-
- /* Redraw borders between horizontally adjacent windows. Don't
- do it for frames with vertical scroll bars because either the
- right scroll bar of a window, or the left scroll bar of its
- neighbor will suffice as a border. */
- if (!WINDOW_RIGHTMOST_P (w)
- && !FRAME_HAS_VERTICAL_SCROLL_BARS (f))
- {
- int x0, x1, y0, y1;
-
- window_box_edges (w, -1, &x0, &y0, &x1, &y1);
- x1 += FRAME_X_RIGHT_FRINGE_WIDTH (f);
- y1 -= 1;
-
- XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- f->output_data.x->normal_gc, x1, y0, x1, y1);
- }
-}
-
-
+
+ XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ f->output_data.x->normal_gc, x, y0, x, y1);
+}
+
/* End update of window W (which is equal to updated_window).
Draw vertical borders between horizontally adjacent windows, and
int cursor_on_p, mouse_face_overwritten_p;
{
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (XFRAME (w->frame));
-
+
if (!w->pseudo_window_p)
{
BLOCK_INPUT;
if (cursor_on_p)
- x_display_and_set_cursor (w, 1, output_cursor.hpos,
- output_cursor.vpos,
- output_cursor.x, output_cursor.y);
-
+ display_and_set_cursor (w, 1, output_cursor.hpos,
+ output_cursor.vpos,
+ output_cursor.x, output_cursor.y);
+
x_draw_vertical_border (w);
UNBLOCK_INPUT;
}
-
+
/* If a row with mouse-face was overwritten, arrange for
XTframe_up_to_date to redisplay the mouse highlight. */
if (mouse_face_overwritten_p)
dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1;
dpyinfo->mouse_face_window = Qnil;
}
-
+
updated_window = NULL;
}
/* Mouse highlight may be displayed again. */
FRAME_X_DISPLAY_INFO (f)->mouse_face_defer = 0;
+#ifndef XFlush
BLOCK_INPUT;
XFlush (FRAME_X_DISPLAY (f));
UNBLOCK_INPUT;
+#endif
}
struct window *w = updated_window;
struct frame *f;
int width, height;
-
+
xassert (w);
-
+
if (!desired_row->mode_line_p && !w->pseudo_window_p)
{
BLOCK_INPUT;
- x_draw_row_fringe_bitmaps (w, desired_row);
+ draw_row_fringe_bitmaps (w, desired_row);
UNBLOCK_INPUT;
}
-
+
/* When a window has disappeared, make sure that no rest of
full-width rows stays visible in the internal border. Could
check here if updated_window is the leftmost/rightmost window,
if (WINDOWP (f->tool_bar_window)
&& w == XWINDOW (f->tool_bar_window))
y -= width;
-
+
BLOCK_INPUT;
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
0, y, width, height, False);
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- f->output_data.x->pixel_width - width,
+ FRAME_PIXEL_WIDTH (f) - width,
y, width, height, False);
UNBLOCK_INPUT;
}
}
-
-/* Draw the bitmap WHICH in one of the left or right fringes of
- window W. ROW is the glyph row for which to display the bitmap; it
- determines the vertical position at which the bitmap has to be
- drawn. */
-
static void
-x_draw_fringe_bitmap (w, row, which, left_p)
+x_draw_fringe_bitmap (w, row, p)
struct window *w;
struct glyph_row *row;
- enum fringe_bitmap_type which;
- int left_p;
+ struct draw_fringe_bitmap_params *p;
{
struct frame *f = XFRAME (WINDOW_FRAME (w));
Display *display = FRAME_X_DISPLAY (f);
Window window = FRAME_X_WINDOW (f);
- int x, y, wd, h, dy;
- int b1, b2;
- unsigned char *bits;
- Pixmap pixmap;
GC gc = f->output_data.x->normal_gc;
- struct face *face;
- int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
+ struct face *face = p->face;
/* Must clip because of partially visible lines. */
- x_clip_to_row (w, row, gc, 1);
-
- /* Convert row to frame coordinates. */
- y = WINDOW_TO_FRAME_PIXEL_Y (w, row->y);
-
- switch (which)
- {
- case NO_FRINGE_BITMAP:
- wd = 0;
- h = 0;
- break;
-
- case LEFT_TRUNCATION_BITMAP:
- wd = left_width;
- h = left_height;
- bits = left_bits;
- break;
-
- case OVERLAY_ARROW_BITMAP:
- wd = ov_width;
- h = ov_height;
- bits = ov_bits;
- break;
-
- case RIGHT_TRUNCATION_BITMAP:
- wd = right_width;
- h = right_height;
- bits = right_bits;
- break;
-
- case CONTINUED_LINE_BITMAP:
- wd = continued_width;
- h = continued_height;
- bits = continued_bits;
- break;
-
- case CONTINUATION_LINE_BITMAP:
- wd = continuation_width;
- h = continuation_height;
- bits = continuation_bits;
- break;
-
- case ZV_LINE_BITMAP:
- wd = zv_width;
- h = zv_height - (y % zv_period);
- bits = zv_bits + (y % zv_period);
- break;
-
- default:
- abort ();
- }
-
- /* Clip bitmap if too high. */
- if (h > row->height)
- h = row->height;
-
- /* Set dy to the offset in the row to start drawing the bitmap. */
- dy = (row->height - h) / 2;
-
- face = FACE_FROM_ID (f, FRINGE_FACE_ID);
- PREPARE_FACE_FOR_DISPLAY (f, face);
-
- /* Clear left fringe if no bitmap to draw or if bitmap doesn't fill
- the fringe. */
- b1 = b2 = -1;
- if (left_p)
- {
- if (wd > FRAME_X_LEFT_FRINGE_WIDTH (f))
- wd = FRAME_X_LEFT_FRINGE_WIDTH (f);
- x = (WINDOW_TO_FRAME_PIXEL_X (w, 0)
- - wd
- - (FRAME_X_LEFT_FRINGE_WIDTH (f) - wd) / 2);
- if (wd < FRAME_X_LEFT_FRINGE_WIDTH (f) || row->height > h)
- {
- /* If W has a vertical border to its left, don't draw over it. */
- int border = ((XFASTINT (w->left) > 0
- && !FRAME_HAS_VERTICAL_SCROLL_BARS (f))
- ? 1 : 0);
- b1 = (window_box_left (w, -1)
- - FRAME_X_LEFT_FRINGE_WIDTH (f)
- + border);
- b2 = (FRAME_X_LEFT_FRINGE_WIDTH (f) - border);
- }
- }
- else
- {
- if (wd > FRAME_X_RIGHT_FRINGE_WIDTH (f))
- wd = FRAME_X_RIGHT_FRINGE_WIDTH (f);
- x = (window_box_right (w, -1)
- + (FRAME_X_RIGHT_FRINGE_WIDTH (f) - wd) / 2);
- /* Clear right fringe if no bitmap to draw of if bitmap doesn't fill
- the fringe. */
- if (wd < FRAME_X_RIGHT_FRINGE_WIDTH (f) || row->height > h)
- {
- b1 = window_box_right (w, -1);
- b2 = FRAME_X_RIGHT_FRINGE_WIDTH (f);
- }
- }
+ x_clip_to_row (w, row, gc);
- if (b1 >= 0)
+ if (p->bx >= 0)
{
- int header_line_height = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w);
-
/* In case the same realized face is used for fringes and
for something displayed in the text (e.g. face `region' on
mono-displays, the fill style may have been changed to
XSetFillStyle (display, face->gc, FillOpaqueStippled);
else
XSetForeground (display, face->gc, face->background);
-
+
XFillRectangle (display, window, face->gc,
- b1,
- WINDOW_TO_FRAME_PIXEL_Y (w, max (header_line_height,
- row->y)),
- b2,
- row->visible_height);
+ p->bx, p->by, p->nx, p->ny);
+
if (!face->stipple)
XSetForeground (display, face->gc, face->foreground);
}
- if (which != NO_FRINGE_BITMAP)
+ if (p->which != NO_FRINGE_BITMAP)
{
+ unsigned char *bits = fringe_bitmaps[p->which].bits + p->dh;
+ Pixmap pixmap;
+ int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
+
/* Draw the bitmap. I believe these small pixmaps can be cached
by the server. */
- pixmap = XCreatePixmapFromBitmapData (display, window, bits, wd, h,
+ pixmap = XCreatePixmapFromBitmapData (display, window, bits, p->wd, p->h,
face->foreground,
face->background, depth);
- XCopyArea (display, pixmap, window, gc, 0, 0, wd, h, x, y + dy);
+ XCopyArea (display, pixmap, window, gc, 0, 0,
+ p->wd, p->h, p->x, p->y);
XFreePixmap (display, pixmap);
}
-
- XSetClipMask (display, gc, None);
-}
-
-
-/* Draw fringe bitmaps for glyph row ROW on window W. Call this
- function with input blocked. */
-
-static void
-x_draw_row_fringe_bitmaps (w, row)
- struct window *w;
- struct glyph_row *row;
-{
- struct frame *f = XFRAME (w->frame);
- enum fringe_bitmap_type bitmap;
-
- xassert (interrupt_input_blocked);
-
- /* If row is completely invisible, because of vscrolling, we
- don't have to draw anything. */
- if (row->visible_height <= 0)
- return;
-
- if (FRAME_X_LEFT_FRINGE_WIDTH (f) != 0)
- {
- /* Decide which bitmap to draw in the left fringe. */
- if (row->overlay_arrow_p)
- bitmap = OVERLAY_ARROW_BITMAP;
- else if (row->truncated_on_left_p)
- bitmap = LEFT_TRUNCATION_BITMAP;
- else if (MATRIX_ROW_CONTINUATION_LINE_P (row))
- bitmap = CONTINUATION_LINE_BITMAP;
- else if (row->indicate_empty_line_p)
- bitmap = ZV_LINE_BITMAP;
- else
- bitmap = NO_FRINGE_BITMAP;
-
- x_draw_fringe_bitmap (w, row, bitmap, 1);
- }
-
- if (FRAME_X_RIGHT_FRINGE_WIDTH (f) != 0)
- {
- /* Decide which bitmap to draw in the right fringe. */
- if (row->truncated_on_right_p)
- bitmap = RIGHT_TRUNCATION_BITMAP;
- else if (row->continued_p)
- bitmap = CONTINUED_LINE_BITMAP;
- else if (row->indicate_empty_line_p && FRAME_X_LEFT_FRINGE_WIDTH (f) == 0)
- bitmap = ZV_LINE_BITMAP;
- else
- bitmap = NO_FRINGE_BITMAP;
- x_draw_fringe_bitmap (w, row, bitmap, 0);
- }
+ XSetClipMask (display, gc, None);
}
\f
}
-\f
-/***********************************************************************
- Output Cursor
- ***********************************************************************/
-
-/* Set the global variable output_cursor to CURSOR. All cursor
- positions are relative to updated_window. */
-
-static void
-set_output_cursor (cursor)
- struct cursor_pos *cursor;
-{
- output_cursor.hpos = cursor->hpos;
- output_cursor.vpos = cursor->vpos;
- output_cursor.x = cursor->x;
- output_cursor.y = cursor->y;
-}
-
-
-/* Set a nominal cursor position.
-
- HPOS and VPOS are column/row positions in a window glyph matrix. X
- and Y are window text area relative pixel positions.
-
- If this is done during an update, updated_window will contain the
- window that is being updated and the position is the future output
- cursor position for that window. If updated_window is null, use
- selected_window and display the cursor at the given position. */
-
-static void
-XTcursor_to (vpos, hpos, y, x)
- int vpos, hpos, y, x;
-{
- struct window *w;
-
- /* If updated_window is not set, work on selected_window. */
- if (updated_window)
- w = updated_window;
- else
- w = XWINDOW (selected_window);
-
- /* Set the output cursor. */
- output_cursor.hpos = hpos;
- output_cursor.vpos = vpos;
- output_cursor.x = x;
- output_cursor.y = y;
-
- /* If not called as part of an update, really display the cursor.
- This will also set the cursor position of W. */
- if (updated_window == NULL)
- {
- BLOCK_INPUT;
- x_display_cursor (w, 1, hpos, vpos, x, y);
- XFlush (FRAME_X_DISPLAY (SELECTED_FRAME ()));
- UNBLOCK_INPUT;
- }
-}
-
-
\f
/***********************************************************************
Display Iterator
/* Function prototypes of this page. */
- static int x_encode_char P_ ((int, XChar2b *, struct font_info *, int *));
-static struct face *x_get_glyph_face_and_encoding P_ ((struct frame *,
- struct glyph *,
- XChar2b *,
- int *));
-static struct face *x_get_char_face_and_encoding P_ ((struct frame *, int,
- int, XChar2b *, int));
-static XCharStruct *x_per_char_metric P_ ((XFontStruct *, XChar2b *));
-static void x_encode_char P_ ((int, XChar2b *, struct font_info *,
- struct charset *));
-static void x_append_glyph P_ ((struct it *));
-static void x_append_composite_glyph P_ ((struct it *));
-static void x_append_stretch_glyph P_ ((struct it *it, Lisp_Object,
- int, int, double));
-static void x_produce_glyphs P_ ((struct it *));
-static void x_produce_image_glyph P_ ((struct it *it));
++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
is not contained in the font. */
-static INLINE XCharStruct *
-x_per_char_metric (font, char2b)
+static XCharStruct *
+x_per_char_metric (font, char2b, font_type)
XFontStruct *font;
XChar2b *char2b;
+ int font_type; /* unused on X */
{
/* The result metric information. */
XCharStruct *pcm = NULL;
/* Encode CHAR2B using encoding information from FONT_INFO. CHAR2B is
the two-byte form of C. Encoding is returned in *CHAR2B. */
-static INLINE void
-x_encode_char (c, char2b, font_info, charset)
+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.
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)
char2b->byte1 |= 0x80;
-
+
if (enc == 1 || enc == 3)
char2b->byte2 |= 0x80;
}
+
+ if (two_byte_p)
+ *two_byte_p = ((XFontStruct *) (font_info->font))->max_byte1 > 0;
+
+ return FONT_TYPE_UNKNOWN;
}
-/* 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. Value is a pointer to a
- realized face that is ready for display. */
+\f
+/***********************************************************************
+ Glyph display
+ ***********************************************************************/
-static INLINE struct face *
-x_get_char_face_and_encoding (f, c, face_id, char2b, multibyte_p)
- struct frame *f;
- int c, face_id;
- XChar2b *char2b;
- int multibyte_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. */
- char2b->byte1 = 0;
- char2b->byte2 = c;
- face_id = FACE_FOR_CHAR (f, face, c);
- face = FACE_FROM_ID (f, face_id);
- }
- else if (c < 128 && face_id < BASIC_FACE_ID_SENTINEL)
- {
- /* Case of ASCII in a face known to fit ASCII. */
- char2b->byte1 = 0;
- char2b->byte2 = 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)
- char2b->byte1 = 0, char2b->byte2 = code;
- else
- char2b->byte1 = code >> 8, char2b->byte2 = code & 0xFF;
- /* Maybe encode the character in *CHAR2B. */
- x_encode_char (c, char2b, font_info, charset);
- }
+static void x_set_glyph_string_clipping P_ ((struct glyph_string *));
+static void x_set_glyph_string_gc P_ ((struct glyph_string *));
+static void x_draw_glyph_string_background P_ ((struct glyph_string *,
+ int));
+static void x_draw_glyph_string_foreground P_ ((struct glyph_string *));
+static void x_draw_composite_glyph_string_foreground P_ ((struct glyph_string *));
+static void x_draw_glyph_string_box P_ ((struct glyph_string *));
+static void x_draw_glyph_string P_ ((struct glyph_string *));
+static void x_compute_glyph_string_overhangs P_ ((struct glyph_string *));
+static void x_set_cursor_gc P_ ((struct glyph_string *));
+static void x_set_mode_line_face_gc P_ ((struct glyph_string *));
+static void x_set_mouse_face_gc P_ ((struct glyph_string *));
+static int x_alloc_lighter_color P_ ((struct frame *, Display *, Colormap,
+ unsigned long *, double, int));
+static void x_setup_relief_color P_ ((struct frame *, struct relief *,
+ double, int, unsigned long));
+static void x_setup_relief_colors P_ ((struct glyph_string *));
+static void x_draw_image_glyph_string P_ ((struct glyph_string *));
+static void x_draw_image_relief P_ ((struct glyph_string *));
+static void x_draw_image_foreground P_ ((struct glyph_string *));
+static void x_draw_image_foreground_1 P_ ((struct glyph_string *, Pixmap));
+static void x_clear_glyph_string_rect P_ ((struct glyph_string *, int,
+ int, int, int));
+static void x_draw_relief_rect P_ ((struct frame *, int, int, int, int,
+ int, int, int, int, XRectangle *));
+static void x_draw_box_rect P_ ((struct glyph_string *, int, int, int, int,
+ int, int, int, XRectangle *));
- /* Make sure X resources of the face are allocated. */
- xassert (face != NULL);
- PREPARE_FACE_FOR_DISPLAY (f, face);
-
- return face;
-}
+#if GLYPH_DEBUG
+static void x_check_font P_ ((struct frame *, XFontStruct *));
+#endif
-/* 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. */
+/* Set S->gc to a suitable GC for drawing glyph string S in cursor
+ face. */
-static INLINE struct face *
-x_get_glyph_face_and_encoding (f, glyph, char2b, two_byte_p)
- struct frame *f;
- struct glyph *glyph;
- XChar2b *char2b;
- int *two_byte_p;
+static void
+x_set_cursor_gc (s)
+ struct glyph_string *s;
{
- struct face *face;
+ if (s->font == FRAME_FONT (s->f)
+ && s->face->background == FRAME_BACKGROUND_PIXEL (s->f)
+ && s->face->foreground == FRAME_FOREGROUND_PIXEL (s->f)
+ && !s->cmp)
+ s->gc = s->f->output_data.x->cursor_gc;
+ else
+ {
+ /* Cursor on non-default face: must merge. */
+ XGCValues xgcv;
+ unsigned long mask;
- xassert (glyph->type == CHAR_GLYPH);
- face = FACE_FROM_ID (f, glyph->face_id);
+ xgcv.background = s->f->output_data.x->cursor_pixel;
+ xgcv.foreground = s->face->background;
- if (two_byte_p)
- *two_byte_p = 0;
+ /* If the glyph would be invisible, try a different foreground. */
+ if (xgcv.foreground == xgcv.background)
+ xgcv.foreground = s->face->foreground;
+ if (xgcv.foreground == xgcv.background)
+ xgcv.foreground = s->f->output_data.x->cursor_foreground_pixel;
+ if (xgcv.foreground == xgcv.background)
+ xgcv.foreground = s->face->foreground;
- if (!glyph->multibyte_p)
- {
- /* Unibyte case. We don't have to encode, but we have to make
- sure to use a face suitable for unibyte. */
- char2b->byte1 = 0;
- char2b->byte2 = glyph->u.ch;
- }
- else if (glyph->u.ch < 128
- && glyph->face_id < BASIC_FACE_ID_SENTINEL)
- {
- /* Case of ASCII in a face known to fit ASCII. */
- char2b->byte1 = 0;
- char2b->byte2 = glyph->u.ch;
- }
- else
- {
- struct font_info *font_info
- = FONT_INFO_FROM_ID (f, face->font_info_id);
- if (font_info)
+ /* Make sure the cursor is distinct from text in this face. */
+ if (xgcv.background == s->face->background
+ && xgcv.foreground == s->face->foreground)
{
- struct charset *charset = CHARSET_FROM_ID (font_info->charset);
- unsigned code = ENCODE_CHAR (charset, glyph->u.ch);
-
- if (CHARSET_DIMENSION (charset) == 1)
- char2b->byte1 = 0, char2b->byte2 = code;
- else
- char2b->byte1 = code >> 8, char2b->byte2 = code & 0xFF;
-
- /* Maybe encode the character in *CHAR2B. */
- if (CHARSET_ID (charset) != charset_ascii)
- {
- x_encode_char (glyph->u.ch, char2b, font_info, charset);
- if (two_byte_p)
- *two_byte_p
- = ((XFontStruct *) (font_info->font))->max_byte1 > 0;
- }
+ xgcv.background = s->face->foreground;
+ xgcv.foreground = s->face->background;
}
- }
-
- /* Make sure X resources of the face are allocated. */
- xassert (face != NULL);
- PREPARE_FACE_FOR_DISPLAY (f, face);
- return face;
-}
+ IF_DEBUG (x_check_font (s->f, s->font));
+ xgcv.font = s->font->fid;
+ xgcv.graphics_exposures = False;
+ mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
-/* Store one glyph for IT->char_to_display in IT->glyph_row.
- Called from x_produce_glyphs when IT->glyph_row is non-null. */
-
-static INLINE void
-x_append_glyph (it)
- struct it *it;
-{
- struct glyph *glyph;
- enum glyph_row_area area = it->area;
-
- xassert (it->glyph_row);
- xassert (it->char_to_display != '\n' && it->char_to_display != '\t');
-
- glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
- if (glyph < it->glyph_row->glyphs[area + 1])
- {
- glyph->charpos = CHARPOS (it->position);
- glyph->object = it->object;
- glyph->pixel_width = it->pixel_width;
- glyph->voffset = it->voffset;
- glyph->type = CHAR_GLYPH;
- glyph->multibyte_p = it->multibyte_p;
- glyph->left_box_line_p = it->start_of_box_run_p;
- glyph->right_box_line_p = it->end_of_box_run_p;
- glyph->overlaps_vertically_p = (it->phys_ascent > it->ascent
- || it->phys_descent > it->descent);
- glyph->padding_p = 0;
- glyph->glyph_not_available_p = it->glyph_not_available_p;
- glyph->face_id = it->face_id;
- glyph->u.ch = it->char_to_display;
- ++it->glyph_row->used[area];
- }
-}
-
-/* Store one glyph for the composition IT->cmp_id in IT->glyph_row.
- Called from x_produce_glyphs when IT->glyph_row is non-null. */
-
-static INLINE void
-x_append_composite_glyph (it)
- struct it *it;
-{
- struct glyph *glyph;
- enum glyph_row_area area = it->area;
-
- xassert (it->glyph_row);
-
- glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
- if (glyph < it->glyph_row->glyphs[area + 1])
- {
- glyph->charpos = CHARPOS (it->position);
- glyph->object = it->object;
- glyph->pixel_width = it->pixel_width;
- glyph->voffset = it->voffset;
- glyph->type = COMPOSITE_GLYPH;
- glyph->multibyte_p = it->multibyte_p;
- glyph->left_box_line_p = it->start_of_box_run_p;
- glyph->right_box_line_p = it->end_of_box_run_p;
- glyph->overlaps_vertically_p = (it->phys_ascent > it->ascent
- || it->phys_descent > it->descent);
- glyph->padding_p = 0;
- glyph->glyph_not_available_p = 0;
- glyph->face_id = it->face_id;
- glyph->u.cmp_id = it->cmp_id;
- ++it->glyph_row->used[area];
- }
-}
-
-
-/* Change IT->ascent and IT->height according to the setting of
- IT->voffset. */
-
-static INLINE void
-take_vertical_position_into_account (it)
- struct it *it;
-{
- if (it->voffset)
- {
- if (it->voffset < 0)
- /* Increase the ascent so that we can display the text higher
- in the line. */
- it->ascent += abs (it->voffset);
+ if (FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc)
+ XChangeGC (s->display, FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc,
+ mask, &xgcv);
else
- /* Increase the descent so that we can display the text lower
- in the line. */
- it->descent += it->voffset;
+ FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc
+ = XCreateGC (s->display, s->window, mask, &xgcv);
+
+ s->gc = FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc;
}
}
-/* Produce glyphs/get display metrics for the image IT is loaded with.
- See the description of struct display_iterator in dispextern.h for
- an overview of struct display_iterator. */
+/* Set up S->gc of glyph string S for drawing text in mouse face. */
static void
-x_produce_image_glyph (it)
- struct it *it;
+x_set_mouse_face_gc (s)
+ struct glyph_string *s;
{
- struct image *img;
+ int face_id;
struct face *face;
- xassert (it->what == IT_IMAGE);
+ /* What face has to be used last for the mouse face? */
+ face_id = FRAME_X_DISPLAY_INFO (s->f)->mouse_face_face_id;
+ face = FACE_FROM_ID (s->f, face_id);
+ if (face == NULL)
+ 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);
+ else
+ face_id = FACE_FOR_CHAR (s->f, face, 0);
+ s->face = FACE_FROM_ID (s->f, face_id);
+ PREPARE_FACE_FOR_DISPLAY (s->f, s->face);
- face = FACE_FROM_ID (it->f, it->face_id);
- img = IMAGE_FROM_ID (it->f, it->image_id);
- xassert (img);
+ /* If font in this face is same as S->font, use it. */
+ if (s->font == s->face->font)
+ s->gc = s->face->gc;
+ else
+ {
+ /* Otherwise construct scratch_cursor_gc with values from FACE
+ but font FONT. */
+ XGCValues xgcv;
+ unsigned long mask;
- /* Make sure X resources of the face and image are loaded. */
- PREPARE_FACE_FOR_DISPLAY (it->f, face);
- prepare_image_for_display (it->f, img);
+ xgcv.background = s->face->background;
+ xgcv.foreground = s->face->foreground;
+ IF_DEBUG (x_check_font (s->f, s->font));
+ xgcv.font = s->font->fid;
+ xgcv.graphics_exposures = False;
+ mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
- it->ascent = it->phys_ascent = image_ascent (img, face);
- it->descent = it->phys_descent = img->height + 2 * img->vmargin - it->ascent;
- it->pixel_width = img->width + 2 * img->hmargin;
+ if (FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc)
+ XChangeGC (s->display, FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc,
+ mask, &xgcv);
+ else
+ FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc
+ = XCreateGC (s->display, s->window, mask, &xgcv);
- it->nglyphs = 1;
-
- if (face->box != FACE_NO_BOX)
- {
- if (face->box_line_width > 0)
- {
- it->ascent += face->box_line_width;
- it->descent += face->box_line_width;
- }
-
- if (it->start_of_box_run_p)
- it->pixel_width += abs (face->box_line_width);
- if (it->end_of_box_run_p)
- it->pixel_width += abs (face->box_line_width);
- }
-
- take_vertical_position_into_account (it);
-
- if (it->glyph_row)
- {
- struct glyph *glyph;
- enum glyph_row_area area = it->area;
-
- glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
- if (glyph < it->glyph_row->glyphs[area + 1])
- {
- glyph->charpos = CHARPOS (it->position);
- glyph->object = it->object;
- glyph->pixel_width = it->pixel_width;
- glyph->voffset = it->voffset;
- glyph->type = IMAGE_GLYPH;
- glyph->multibyte_p = it->multibyte_p;
- glyph->left_box_line_p = it->start_of_box_run_p;
- glyph->right_box_line_p = it->end_of_box_run_p;
- glyph->overlaps_vertically_p = 0;
- glyph->padding_p = 0;
- glyph->glyph_not_available_p = 0;
- glyph->face_id = it->face_id;
- glyph->u.img_id = img->id;
- ++it->glyph_row->used[area];
- }
+ s->gc = FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc;
}
+
+ xassert (s->gc != 0);
}
-/* Append a stretch glyph to IT->glyph_row. OBJECT is the source
- of the glyph, WIDTH and HEIGHT are the width and height of the
- stretch. ASCENT is the percentage/100 of HEIGHT to use for the
- ascent of the glyph (0 <= ASCENT <= 1). */
-
-static void
-x_append_stretch_glyph (it, object, width, height, ascent)
- struct it *it;
- Lisp_Object object;
- int width, height;
- double ascent;
+/* Set S->gc of glyph string S to a GC suitable for drawing a mode line.
+ Faces to use in the mode line have already been computed when the
+ matrix was built, so there isn't much to do, here. */
+
+static INLINE void
+x_set_mode_line_face_gc (s)
+ struct glyph_string *s;
+{
+ s->gc = s->face->gc;
+}
+
+
+/* Set S->gc of glyph string S for drawing that glyph string. Set
+ S->stippled_p to a non-zero value if the face of S has a stipple
+ pattern. */
+
+static INLINE void
+x_set_glyph_string_gc (s)
+ struct glyph_string *s;
{
- struct glyph *glyph;
- enum glyph_row_area area = it->area;
+ PREPARE_FACE_FOR_DISPLAY (s->f, s->face);
- xassert (ascent >= 0 && ascent <= 1);
-
- glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
- if (glyph < it->glyph_row->glyphs[area + 1])
+ if (s->hl == DRAW_NORMAL_TEXT)
{
- glyph->charpos = CHARPOS (it->position);
- glyph->object = object;
- glyph->pixel_width = width;
- glyph->voffset = it->voffset;
- glyph->type = STRETCH_GLYPH;
- glyph->multibyte_p = it->multibyte_p;
- glyph->left_box_line_p = it->start_of_box_run_p;
- glyph->right_box_line_p = it->end_of_box_run_p;
- glyph->overlaps_vertically_p = 0;
- glyph->padding_p = 0;
- glyph->glyph_not_available_p = 0;
- glyph->face_id = it->face_id;
- glyph->u.stretch.ascent = height * ascent;
- glyph->u.stretch.height = height;
- ++it->glyph_row->used[area];
+ s->gc = s->face->gc;
+ s->stippled_p = s->face->stipple != 0;
+ }
+ else if (s->hl == DRAW_INVERSE_VIDEO)
+ {
+ x_set_mode_line_face_gc (s);
+ s->stippled_p = s->face->stipple != 0;
+ }
+ else if (s->hl == DRAW_CURSOR)
+ {
+ x_set_cursor_gc (s);
+ s->stippled_p = 0;
+ }
+ else if (s->hl == DRAW_MOUSE_FACE)
+ {
+ x_set_mouse_face_gc (s);
+ s->stippled_p = s->face->stipple != 0;
+ }
+ else if (s->hl == DRAW_IMAGE_RAISED
+ || s->hl == DRAW_IMAGE_SUNKEN)
+ {
+ s->gc = s->face->gc;
+ s->stippled_p = s->face->stipple != 0;
+ }
+ else
+ {
+ s->gc = s->face->gc;
+ s->stippled_p = s->face->stipple != 0;
}
-}
+ /* GC must have been set. */
+ xassert (s->gc != 0);
+}
-/* Produce a stretch glyph for iterator IT. IT->object is the value
- of the glyph property displayed. The value must be a list
- `(space KEYWORD VALUE ...)' with the following KEYWORD/VALUE pairs
- being recognized:
- 1. `:width WIDTH' specifies that the space should be WIDTH *
- canonical char width wide. WIDTH may be an integer or floating
- point number.
+/* Set clipping for output of glyph string S. S may be part of a mode
+ line or menu if we don't have X toolkit support. */
- 2. `:relative-width FACTOR' specifies that the width of the stretch
- should be computed from the width of the first character having the
- `glyph' property, and should be FACTOR times that width.
+static INLINE void
+x_set_glyph_string_clipping (s)
+ struct glyph_string *s;
+{
+ XRectangle r;
+ get_glyph_string_clip_rect (s, &r);
+ XSetClipRectangles (s->display, s->gc, 0, 0, &r, 1, Unsorted);
+}
- 3. `:align-to HPOS' specifies that the space should be wide enough
- to reach HPOS, a value in canonical character units.
- Exactly one of the above pairs must be present.
+/* RIF:
+ Compute left and right overhang of glyph string S. If S is a glyph
+ string for a composition, assume overhangs don't exist. */
- 4. `:height HEIGHT' specifies that the height of the stretch produced
- should be HEIGHT, measured in canonical character units.
+static void
+x_compute_glyph_string_overhangs (s)
+ struct glyph_string *s;
+{
+ if (s->cmp == NULL
+ && s->first_glyph->type == CHAR_GLYPH)
+ {
+ XCharStruct cs;
+ int direction, font_ascent, font_descent;
+ 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;
+ }
+}
- 5. `:relative-height FACTOR' specifies that the height of the
- stretch should be FACTOR times the height of the characters having
- the glyph property.
- Either none or exactly one of 4 or 5 must be present.
+/* Fill rectangle X, Y, W, H with background color of glyph string S. */
- 6. `:ascent ASCENT' specifies that ASCENT percent of the height
- of the stretch should be used for the ascent of the stretch.
- ASCENT must be in the range 0 <= ASCENT <= 100. */
+static INLINE void
+x_clear_glyph_string_rect (s, x, y, w, h)
+ struct glyph_string *s;
+ int x, y, w, h;
+{
+ XGCValues xgcv;
+ XGetGCValues (s->display, s->gc, GCForeground | GCBackground, &xgcv);
+ XSetForeground (s->display, s->gc, xgcv.background);
+ XFillRectangle (s->display, s->window, s->gc, x, y, w, h);
+ XSetForeground (s->display, s->gc, xgcv.foreground);
+}
-#define NUMVAL(X) \
- ((INTEGERP (X) || FLOATP (X)) \
- ? XFLOATINT (X) \
- : - 1)
+/* Draw the background of glyph_string S. If S->background_filled_p
+ is non-zero don't draw it. FORCE_P non-zero means draw the
+ background even if it wouldn't be drawn normally. This is used
+ when a string preceding S draws into the background of S, or S
+ contains the first component of a composition. */
static void
-x_produce_stretch_glyph (it)
- struct it *it;
+x_draw_glyph_string_background (s, force_p)
+ struct glyph_string *s;
+ int force_p;
{
- /* (space :width WIDTH :height HEIGHT. */
-#if GLYPH_DEBUG
- extern Lisp_Object Qspace;
-#endif
- extern Lisp_Object QCwidth, QCheight, QCascent;
- extern Lisp_Object QCrelative_width, QCrelative_height;
- extern Lisp_Object QCalign_to;
- Lisp_Object prop, plist;
- double width = 0, height = 0, ascent = 0;
- struct face *face = FACE_FROM_ID (it->f, it->face_id);
- XFontStruct *font = face->font ? face->font : FRAME_FONT (it->f);
-
- PREPARE_FACE_FOR_DISPLAY (it->f, face);
-
- /* List should start with `space'. */
- xassert (CONSP (it->object) && EQ (XCAR (it->object), Qspace));
- plist = XCDR (it->object);
-
- /* Compute the width of the stretch. */
- if (prop = Fplist_get (plist, QCwidth),
- NUMVAL (prop) > 0)
- /* Absolute width `:width WIDTH' specified and valid. */
- width = NUMVAL (prop) * CANON_X_UNIT (it->f);
- else if (prop = Fplist_get (plist, QCrelative_width),
- NUMVAL (prop) > 0)
- {
- /* Relative width `:relative-width FACTOR' specified and valid.
- Compute the width of the characters having the `glyph'
- property. */
- struct it it2;
- unsigned char *p = BYTE_POS_ADDR (IT_BYTEPOS (*it));
-
- it2 = *it;
- if (it->multibyte_p)
+ /* Nothing to do if background has already been drawn or if it
+ shouldn't be drawn in the first place. */
+ if (!s->background_filled_p)
+ {
+ int box_line_width = max (s->face->box_line_width, 0);
+
+ if (s->stippled_p)
+ {
+ /* Fill background with a stipple pattern. */
+ XSetFillStyle (s->display, s->gc, FillOpaqueStippled);
+ XFillRectangle (s->display, s->window, s->gc, s->x,
+ s->y + box_line_width,
+ s->background_width,
+ s->height - 2 * box_line_width);
+ XSetFillStyle (s->display, s->gc, FillSolid);
+ s->background_filled_p = 1;
+ }
+ else if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width
+ || s->font_not_found_p
+ || s->extends_to_end_of_line_p
+ || force_p)
{
- int maxlen = ((IT_BYTEPOS (*it) >= GPT ? ZV : GPT)
- - IT_BYTEPOS (*it));
- it2.c = STRING_CHAR_AND_LENGTH (p, maxlen, it2.len);
+ x_clear_glyph_string_rect (s, s->x, s->y + box_line_width,
+ s->background_width,
+ s->height - 2 * box_line_width);
+ s->background_filled_p = 1;
}
- else
- it2.c = *p, it2.len = 1;
-
- it2.glyph_row = NULL;
- it2.what = IT_CHARACTER;
- x_produce_glyphs (&it2);
- width = NUMVAL (prop) * it2.pixel_width;
}
- else if (prop = Fplist_get (plist, QCalign_to),
- NUMVAL (prop) > 0)
- width = NUMVAL (prop) * CANON_X_UNIT (it->f) - it->current_x;
- else
- /* Nothing specified -> width defaults to canonical char width. */
- width = CANON_X_UNIT (it->f);
-
- /* Compute height. */
- if (prop = Fplist_get (plist, QCheight),
- NUMVAL (prop) > 0)
- height = NUMVAL (prop) * CANON_Y_UNIT (it->f);
- else if (prop = Fplist_get (plist, QCrelative_height),
- NUMVAL (prop) > 0)
- height = FONT_HEIGHT (font) * NUMVAL (prop);
- else
- height = FONT_HEIGHT (font);
-
- /* Compute percentage of height used for ascent. If
- `:ascent ASCENT' is present and valid, use that. Otherwise,
- derive the ascent from the font in use. */
- if (prop = Fplist_get (plist, QCascent),
- NUMVAL (prop) > 0 && NUMVAL (prop) <= 100)
- ascent = NUMVAL (prop) / 100.0;
- else
- ascent = (double) font->ascent / FONT_HEIGHT (font);
+}
- if (width <= 0)
- width = 1;
- if (height <= 0)
- height = 1;
- if (it->glyph_row)
- {
- Lisp_Object object = it->stack[it->sp - 1].string;
- if (!STRINGP (object))
- object = it->w->buffer;
- x_append_stretch_glyph (it, object, width, height, ascent);
- }
+/* Draw the foreground of glyph string S. */
+
+static void
+x_draw_glyph_string_foreground (s)
+ struct glyph_string *s;
+{
+ int i, x;
- it->pixel_width = width;
- it->ascent = it->phys_ascent = height * ascent;
- it->descent = it->phys_descent = height - it->ascent;
- it->nglyphs = 1;
+ /* 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
+ && s->first_glyph->left_box_line_p)
+ x = s->x + abs (s->face->box_line_width);
+ else
+ x = s->x;
- if (face->box != FACE_NO_BOX)
+ /* Draw characters of S as rectangles if S's font could not be
+ loaded. */
+ if (s->font_not_found_p)
{
- if (face->box_line_width > 0)
+ for (i = 0; i < s->nchars; ++i)
{
- it->ascent += face->box_line_width;
- it->descent += face->box_line_width;
+ struct glyph *g = s->first_glyph + i;
+ XDrawRectangle (s->display, s->window,
+ s->gc, x, s->y, g->pixel_width - 1,
+ s->height - 1);
+ x += g->pixel_width;
}
-
- if (it->start_of_box_run_p)
- it->pixel_width += abs (face->box_line_width);
- if (it->end_of_box_run_p)
- it->pixel_width += abs (face->box_line_width);
- }
-
- take_vertical_position_into_account (it);
-}
-
-/* Return proper value to be used as baseline offset of font that has
- ASCENT and DESCENT to draw characters by the font at the vertical
- center of the line of frame F.
-
- Here, out task is to find the value of BOFF in the following figure;
-
- -------------------------+-----------+-
- -+-+---------+-+ | |
- | | | | | |
- | | | | F_ASCENT F_HEIGHT
- | | | ASCENT | |
- HEIGHT | | | | |
- | | |-|-+------+-----------|------- baseline
- | | | | BOFF | |
- | |---------|-+-+ | |
- | | | DESCENT | |
- -+-+---------+-+ F_DESCENT |
- -------------------------+-----------+-
-
- -BOFF + DESCENT + (F_HEIGHT - HEIGHT) / 2 = F_DESCENT
- BOFF = DESCENT + (F_HEIGHT - HEIGHT) / 2 - F_DESCENT
- DESCENT = FONT->descent
- HEIGHT = FONT_HEIGHT (FONT)
- F_DESCENT = (F->output_data.x->font->descent
- - F->output_data.x->baseline_offset)
- F_HEIGHT = FRAME_LINE_HEIGHT (F)
-*/
-
-#define VCENTER_BASELINE_OFFSET(FONT, F) \
- ((FONT)->descent \
- + (FRAME_LINE_HEIGHT ((F)) - FONT_HEIGHT ((FONT)) \
- + (FRAME_LINE_HEIGHT ((F)) > FONT_HEIGHT ((FONT)))) / 2 \
- - ((F)->output_data.x->font->descent - (F)->output_data.x->baseline_offset))
-
-/* Produce glyphs/get display metrics for the display element IT is
- loaded with. See the description of struct display_iterator in
- dispextern.h for an overview of struct display_iterator. */
+ }
+ else
+ {
+ char *char1b = (char *) s->char2b;
+ int boff = s->font_info->baseline_offset;
-static void
-x_produce_glyphs (it)
- struct it *it;
-{
- it->glyph_not_available_p = 0;
-
- if (it->what == IT_CHARACTER)
- {
- XChar2b char2b;
- XFontStruct *font;
- 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 */
- /* We may change it->multibyte_p upon unibyte<->multibyte
- conversion. So, save the current value now and restore it
- later.
-
- Note: It seems that we don't have to record multibyte_p in
- struct glyph because the character code itself tells if or
- not the character is multibyte. Thus, in the future, we must
- consider eliminating the field `multibyte_p' in the struct
- glyph. */
- int saved_multibyte_p = it->multibyte_p;
-
- /* Maybe translate single-byte characters to multibyte, or the
- other way. */
- it->char_to_display = it->c;
- if (! ASCII_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->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);
- }
- }
-
- /* Get font to use. Encode IT->char_to_display. */
- x_get_char_face_and_encoding (it->f, it->char_to_display,
- it->face_id, &char2b,
- it->multibyte_p);
- font = face->font;
-
- /* When no suitable font found, use the default font. */
- font_not_found_p = font == NULL;
- if (font_not_found_p)
+ if (s->font_info->vertical_centering)
+ boff = VCENTER_BASELINE_OFFSET (s->font, s->f) - boff;
+
+ /* If we can use 8-bit functions, condense S->char2b. */
+ if (!s->two_byte_p)
+ for (i = 0; i < s->nchars; ++i)
+ char1b[i] = s->char2b[i].byte2;
+
+ /* Draw text with XDrawString if background has already been
+ filled. Otherwise, use XDrawImageString. (Note that
+ XDrawImageString is usually faster than XDrawString.) Always
+ use XDrawImageString when drawing the cursor so that there is
+ no chance that characters under a box cursor are invisible. */
+ if (s->for_overlaps_p
+ || (s->background_filled_p && s->hl != DRAW_CURSOR))
{
- font = FRAME_FONT (it->f);
- boff = it->f->output_data.x->baseline_offset;
- font_info = NULL;
+ /* Draw characters with 16-bit or 8-bit functions. */
+ if (s->two_byte_p)
+ XDrawString16 (s->display, s->window, s->gc, x,
+ s->ybase - boff, s->char2b, s->nchars);
+ else
+ XDrawString (s->display, s->window, s->gc, x,
+ s->ybase - boff, char1b, s->nchars);
}
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;
+ if (s->two_byte_p)
+ XDrawImageString16 (s->display, s->window, s->gc, x,
+ s->ybase - boff, s->char2b, s->nchars);
+ else
+ XDrawImageString (s->display, s->window, s->gc, x,
+ s->ybase - boff, char1b, s->nchars);
}
- if (it->char_to_display >= ' '
- && (!it->multibyte_p || it->char_to_display < 128))
+ if (s->face->overstrike)
{
- /* Either unibyte or ASCII. */
- int stretched_p;
-
- it->nglyphs = 1;
-
- pcm = x_per_char_metric (font, &char2b);
- it->ascent = font->ascent + boff;
- it->descent = font->descent - boff;
-
- if (pcm)
- {
- it->phys_ascent = pcm->ascent + boff;
- it->phys_descent = pcm->descent - boff;
- it->pixel_width = pcm->width;
- }
+ /* For overstriking (to simulate bold-face), draw the
+ characters again shifted to the right by one pixel. */
+ if (s->two_byte_p)
+ XDrawString16 (s->display, s->window, s->gc, x + 1,
+ s->ybase - boff, s->char2b, s->nchars);
else
- {
- it->glyph_not_available_p = 1;
- it->phys_ascent = font->ascent + boff;
- it->phys_descent = font->descent - boff;
- it->pixel_width = FONT_WIDTH (font);
- }
-
- /* If this is a space inside a region of text with
- `space-width' property, change its width. */
- stretched_p = it->char_to_display == ' ' && !NILP (it->space_width);
- if (stretched_p)
- it->pixel_width *= XFLOATINT (it->space_width);
+ XDrawString (s->display, s->window, s->gc, x + 1,
+ s->ybase - boff, char1b, s->nchars);
+ }
+ }
+}
- /* If face has a box, add the box thickness to the character
- height. If character has a box line to the left and/or
- right, add the box line width to the character's width. */
- if (face->box != FACE_NO_BOX)
- {
- int thick = face->box_line_width;
-
- if (thick > 0)
- {
- it->ascent += thick;
- it->descent += thick;
- }
- else
- thick = -thick;
+/* Draw the foreground of composite glyph string S. */
- if (it->start_of_box_run_p)
- it->pixel_width += thick;
- if (it->end_of_box_run_p)
- it->pixel_width += thick;
- }
+static void
+x_draw_composite_glyph_string_foreground (s)
+ struct glyph_string *s;
+{
+ int i, x;
- /* If face has an overline, add the height of the overline
- (1 pixel) and a 1 pixel margin to the character height. */
- if (face->overline_p)
- it->ascent += 2;
+ /* 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
+ && s->first_glyph->left_box_line_p)
+ x = s->x + abs (s->face->box_line_width);
+ else
+ x = s->x;
- take_vertical_position_into_account (it);
-
- /* If we have to actually produce glyphs, do it. */
- if (it->glyph_row)
- {
- if (stretched_p)
- {
- /* Translate a space with a `space-width' property
- into a stretch glyph. */
- double ascent = (double) font->ascent / FONT_HEIGHT (font);
- x_append_stretch_glyph (it, it->object, it->pixel_width,
- it->ascent + it->descent, ascent);
- }
- else
- x_append_glyph (it);
+ /* S is a glyph string for a composition. S->gidx is the index of
+ the first character drawn for glyphs of this composition.
+ S->gidx == 0 means we are drawing the very first character of
+ this composition. */
- /* If characters with lbearing or rbearing are displayed
- in this line, record that fact in a flag of the
- glyph row. This is used to optimize X output code. */
- if (pcm && (pcm->lbearing < 0 || pcm->rbearing > pcm->width))
- it->glyph_row->contains_overlapping_glyphs_p = 1;
- }
- }
- else if (it->char_to_display == '\n')
- {
- /* A newline has no width but we need the height of the line. */
- it->pixel_width = 0;
- it->nglyphs = 0;
- it->ascent = it->phys_ascent = font->ascent + boff;
- it->descent = it->phys_descent = font->descent - boff;
-
- if (face->box != FACE_NO_BOX
- && face->box_line_width > 0)
- {
- it->ascent += face->box_line_width;
- it->descent += face->box_line_width;
- }
- }
- else if (it->char_to_display == '\t')
+ /* Draw a rectangle for the composition if the font for the very
+ first character of the composition could not be loaded. */
+ if (s->font_not_found_p)
+ {
+ if (s->gidx == 0)
+ XDrawRectangle (s->display, s->window, s->gc, x, s->y,
+ s->width - 1, s->height - 1);
+ }
+ else
+ {
+ for (i = 0; i < s->nchars; i++, ++s->gidx)
{
- int tab_width = it->tab_width * CANON_X_UNIT (it->f);
- int x = it->current_x + it->continuation_lines_width;
- int next_tab_x = ((1 + x + tab_width - 1) / tab_width) * tab_width;
-
- /* If the distance from the current position to the next tab
- stop is less than a canonical character width, use the
- tab stop after that. */
- if (next_tab_x - x < CANON_X_UNIT (it->f))
- next_tab_x += tab_width;
-
- it->pixel_width = next_tab_x - x;
- it->nglyphs = 1;
- it->ascent = it->phys_ascent = font->ascent + boff;
- it->descent = it->phys_descent = font->descent - boff;
-
- if (it->glyph_row)
- {
- double ascent = (double) it->ascent / (it->ascent + it->descent);
- x_append_stretch_glyph (it, it->object, it->pixel_width,
- it->ascent + it->descent, ascent);
- }
+ 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);
}
- else
- {
- /* A multi-byte character. Assume that the display width of the
- character is the width of the character multiplied by the
- width of the font. */
-
- /* 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 by
- multiplying the width of font by the width of the
- character. */
- pcm = x_per_char_metric (font, &char2b);
- if (font_not_found_p || !pcm)
- {
- it->glyph_not_available_p = 1;
- it->pixel_width = (FONT_WIDTH (FRAME_FONT (it->f))
- * CHAR_WIDTH (it->char_to_display));
- it->phys_ascent = font->ascent + boff;
- it->phys_descent = font->descent - boff;
- }
- else
- {
- it->pixel_width = pcm->width;
- it->phys_ascent = pcm->ascent + boff;
- it->phys_descent = pcm->descent - boff;
- if (it->glyph_row
- && (pcm->lbearing < 0
- || pcm->rbearing > pcm->width))
- it->glyph_row->contains_overlapping_glyphs_p = 1;
- }
- it->nglyphs = 1;
- it->ascent = font->ascent + boff;
- it->descent = font->descent - boff;
- if (face->box != FACE_NO_BOX)
- {
- int thick = face->box_line_width;
+ }
+}
- if (thick > 0)
- {
- it->ascent += thick;
- it->descent += thick;
- }
- else
- thick = - thick;
-
- if (it->start_of_box_run_p)
- it->pixel_width += thick;
- if (it->end_of_box_run_p)
- it->pixel_width += thick;
- }
-
- /* If face has an overline, add the height of the overline
- (1 pixel) and a 1 pixel margin to the character height. */
- if (face->overline_p)
- it->ascent += 2;
-
- take_vertical_position_into_account (it);
-
- if (it->glyph_row)
- x_append_glyph (it);
- }
- it->multibyte_p = saved_multibyte_p;
- }
- 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;
- 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];
-
- /* Maybe translate single-byte characters to multibyte. */
- it->char_to_display = it->c;
- if (unibyte_display_via_language_environment
- && it->c >= 0200)
- {
- 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);
- x_get_char_face_and_encoding (it->f, it->char_to_display,
- it->face_id, &char2b, it->multibyte_p);
- font = face->font;
-
- /* When no suitable font found, use the default font. */
- font_not_found_p = font == NULL;
- if (font_not_found_p)
- {
- font = FRAME_FONT (it->f);
- boff = it->f->output_data.x->baseline_offset;
- font_info = NULL;
- }
- 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;
-
- /* 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->ascent + boff;
- int font_descent = font->descent - boff;
- /* Bounding box of the overall glyphs. */
- int leftmost, rightmost, lowest, highest;
- int i, width, ascent, descent;
-
- cmp->font = (void *) font;
-
- /* Initialize the bounding box. */
- if (font_info
- && (pcm = x_per_char_metric (font, &char2b)))
- {
- width = pcm->width;
- ascent = pcm->ascent;
- descent = pcm->descent;
- }
- else
- {
- width = FONT_WIDTH (font);
- ascent = font->ascent;
- descent = font->descent;
- }
-
- rightmost = width;
- lowest = - descent + boff;
- highest = ascent + boff;
- leftmost = 0;
-
- if (font_info
- && font_info->default_ascent
- && CHAR_TABLE_P (Vuse_default_ascent)
- && !NILP (Faref (Vuse_default_ascent,
- make_number (it->char_to_display))))
- 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;
-
- /* Set cmp->offsets for the remaining glyphs. */
- for (i = 1; i < cmp->glyph_len; i++)
- {
- int left, right, btm, top;
- int ch = COMPOSITION_GLYPH (cmp, i);
- int face_id = FACE_FOR_CHAR (it->f, face, ch);
-
- face = FACE_FROM_ID (it->f, face_id);
- x_get_char_face_and_encoding (it->f, ch, face->id, &char2b,
- it->multibyte_p);
- font = face->font;
- if (font == NULL)
- {
- font = FRAME_FONT (it->f);
- boff = it->f->output_data.x->baseline_offset;
- font_info = NULL;
- }
- 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;
- }
+#ifdef USE_X_TOOLKIT
- if (font_info
- && (pcm = x_per_char_metric (font, &char2b)))
- {
- width = pcm->width;
- ascent = pcm->ascent;
- descent = pcm->descent;
- }
- else
- {
- width = FONT_WIDTH (font);
- ascent = 1;
- descent = 0;
- }
+static struct frame *x_frame_of_widget P_ ((Widget));
+static Boolean cvt_string_to_pixel P_ ((Display *, XrmValue *, Cardinal *,
+ XrmValue *, XrmValue *, XtPointer *));
+static void cvt_pixel_dtor P_ ((XtAppContext, XrmValue *, XtPointer,
+ XrmValue *, Cardinal *));
- 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;
-
- 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));
- }
+/* Return the frame on which widget WIDGET is used.. Abort if frame
+ cannot be determined. */
- 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;
- }
+static struct frame *
+x_frame_of_widget (widget)
+ Widget widget;
+{
+ struct x_display_info *dpyinfo;
+ Lisp_Object tail;
+ struct frame *f;
- /* If there are glyphs whose x-offsets are negative,
- shift all glyphs to the right and make all x-offsets
- non-negative. */
- if (leftmost < 0)
- {
- for (i = 0; i < cmp->glyph_len; i++)
- cmp->offsets[i * 2] -= leftmost;
- rightmost -= leftmost;
- }
+ dpyinfo = x_display_info_for_display (XtDisplay (widget));
- cmp->pixel_width = rightmost;
- cmp->ascent = highest;
- cmp->descent = - lowest;
- if (cmp->ascent < font_ascent)
- cmp->ascent = font_ascent;
- if (cmp->descent < font_descent)
- cmp->descent = font_descent;
- }
+ /* Find the top-level shell of the widget. Note that this function
+ can be called when the widget is not yet realized, so XtWindow
+ (widget) == 0. That's the reason we can't simply use
+ x_any_window_to_frame. */
+ while (!XtIsTopLevelShell (widget))
+ widget = XtParent (widget);
- it->pixel_width = cmp->pixel_width;
- it->ascent = it->phys_ascent = cmp->ascent;
- it->descent = it->phys_descent = cmp->descent;
+ /* 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))
+ && (f = XFRAME (XCAR (tail)),
+ (f->output_data.nothing != 1
+ && FRAME_X_DISPLAY_INFO (f) == dpyinfo))
+ && f->output_data.x->widget == widget)
+ return f;
- if (face->box != FACE_NO_BOX)
- {
- int thick = face->box_line_width;
+ abort ();
+}
- if (thick > 0)
- {
- it->ascent += thick;
- it->descent += thick;
- }
- else
- thick = - thick;
-
- if (it->start_of_box_run_p)
- it->pixel_width += thick;
- if (it->end_of_box_run_p)
- it->pixel_width += thick;
- }
-
- /* If face has an overline, add the height of the overline
- (1 pixel) and a 1 pixel margin to the character height. */
- if (face->overline_p)
- it->ascent += 2;
-
- take_vertical_position_into_account (it);
-
- if (it->glyph_row)
- x_append_composite_glyph (it);
- }
- else if (it->what == IT_IMAGE)
- x_produce_image_glyph (it);
- else if (it->what == IT_STRETCH)
- x_produce_stretch_glyph (it);
-
- /* Accumulate dimensions. Note: can't assume that it->descent > 0
- because this isn't true for images with `:ascent 100'. */
- xassert (it->ascent >= 0 && it->descent >= 0);
- if (it->area == TEXT_AREA)
- it->current_x += it->pixel_width;
-
- it->descent += it->extra_line_spacing;
-
- it->max_ascent = max (it->max_ascent, it->ascent);
- it->max_descent = max (it->max_descent, it->descent);
- it->max_phys_ascent = max (it->max_phys_ascent, it->phys_ascent);
- it->max_phys_descent = max (it->max_phys_descent, it->phys_descent);
-}
-
-
-/* Estimate the pixel height of the mode or top line on frame F.
- FACE_ID specifies what line's height to estimate. */
+
+/* Allocate the color COLOR->pixel on the screen and display of
+ widget WIDGET in colormap CMAP. If an exact match cannot be
+ allocated, try the nearest color available. Value is non-zero
+ if successful. This is called from lwlib. */
int
-x_estimate_mode_line_height (f, face_id)
- struct frame *f;
- enum face_id face_id;
+x_alloc_nearest_color_for_widget (widget, cmap, color)
+ Widget widget;
+ Colormap cmap;
+ XColor *color;
{
- int height = FONT_HEIGHT (FRAME_FONT (f));
-
- /* This function is called so early when Emacs starts that the face
- cache and mode line face are not yet initialized. */
- if (FRAME_FACE_CACHE (f))
- {
- struct face *face = FACE_FROM_ID (f, face_id);
- if (face)
- {
- if (face->font)
- height = FONT_HEIGHT (face->font);
- if (face->box_line_width > 0)
- height += 2 * face->box_line_width;
- }
- }
-
- return height;
+ struct frame *f = x_frame_of_widget (widget);
+ return x_alloc_nearest_color (f, cmap, color);
}
-\f
-/***********************************************************************
- Glyph display
- ***********************************************************************/
-
-/* A sequence of glyphs to be drawn in the same face.
- This data structure is not really completely X specific, so it
- could possibly, at least partially, be useful for other systems. It
- is currently not part of the external redisplay interface because
- it's not clear what other systems will need. */
+/* Allocate a color which is lighter or darker than *PIXEL by FACTOR
+ or DELTA. Try a color with RGB values multiplied by FACTOR first.
+ If this produces the same color as PIXEL, try a color where all RGB
+ values have DELTA added. Return the allocated color in *PIXEL.
+ DISPLAY is the X display, CMAP is the colormap to operate on.
+ Value is non-zero if successful. */
-struct glyph_string
+int
+x_alloc_lighter_color_for_widget (widget, display, cmap, pixel, factor, delta)
+ Widget widget;
+ Display *display;
+ Colormap cmap;
+ unsigned long *pixel;
+ double factor;
+ int delta;
{
- /* X-origin of the string. */
- int x;
-
- /* Y-origin and y-position of the base line of this string. */
- int y, ybase;
-
- /* The width of the string, not including a face extension. */
- int width;
-
- /* The width of the string, including a face extension. */
- int background_width;
-
- /* The height of this string. This is the height of the line this
- string is drawn in, and can be different from the height of the
- font the string is drawn in. */
- int height;
-
- /* Number of pixels this string overwrites in front of its x-origin.
- This number is zero if the string has an lbearing >= 0; it is
- -lbearing, if the string has an lbearing < 0. */
- int left_overhang;
-
- /* Number of pixels this string overwrites past its right-most
- nominal x-position, i.e. x + width. Zero if the string's
- rbearing is <= its nominal width, rbearing - width otherwise. */
- int right_overhang;
-
- /* The frame on which the glyph string is drawn. */
- struct frame *f;
-
- /* The window on which the glyph string is drawn. */
- struct window *w;
-
- /* X display and window for convenience. */
- Display *display;
- Window window;
-
- /* The glyph row for which this string was built. It determines the
- y-origin and height of the string. */
- struct glyph_row *row;
-
- /* The area within row. */
- enum glyph_row_area area;
-
- /* Characters to be drawn, and number of characters. */
- XChar2b *char2b;
- int nchars;
-
- /* A face-override for drawing cursors, mouse face and similar. */
- enum draw_glyphs_face hl;
-
- /* Face in which this string is to be drawn. */
- struct face *face;
+ struct frame *f = x_frame_of_widget (widget);
+ return x_alloc_lighter_color (f, display, cmap, pixel, factor, delta);
+}
- /* Font in which this string is to be drawn. */
- XFontStruct *font;
- /* Font info for this string. */
- struct font_info *font_info;
+/* Structure specifying which arguments should be passed by Xt to
+ cvt_string_to_pixel. We want the widget's screen and colormap. */
- /* Non-null means this string describes (part of) a composition.
- All characters from char2b are drawn composed. */
- struct composition *cmp;
+static XtConvertArgRec cvt_string_to_pixel_args[] =
+ {
+ {XtWidgetBaseOffset, (XtPointer) XtOffset (Widget, core.screen),
+ sizeof (Screen *)},
+ {XtWidgetBaseOffset, (XtPointer) XtOffset (Widget, core.colormap),
+ sizeof (Colormap)}
+ };
- /* Index of this glyph string's first character in the glyph
- definition of CMP. If this is zero, this glyph string describes
- the first character of a composition. */
- int gidx;
- /* 1 means this glyph strings face has to be drawn to the right end
- of the window's drawing area. */
- unsigned extends_to_end_of_line_p : 1;
+/* The address of this variable is returned by
+ cvt_string_to_pixel. */
- /* 1 means the background of this string has been drawn. */
- unsigned background_filled_p : 1;
+static Pixel cvt_string_to_pixel_value;
- /* 1 means glyph string must be drawn with 16-bit functions. */
- unsigned two_byte_p : 1;
- /* 1 means that the original font determined for drawing this glyph
- string could not be loaded. The member `font' has been set to
- the frame's default font in this case. */
- unsigned font_not_found_p : 1;
+/* Convert a color name to a pixel color.
- /* 1 means that the face in which this glyph string is drawn has a
- stipple pattern. */
- unsigned stippled_p : 1;
+ DPY is the display we are working on.
- /* 1 means only the foreground of this glyph string must be drawn,
- and we should use the physical height of the line this glyph
- string appears in as clip rect. */
- unsigned for_overlaps_p : 1;
+ ARGS is an array of *NARGS XrmValue structures holding additional
+ information about the widget for which the conversion takes place.
+ The contents of this array are determined by the specification
+ in cvt_string_to_pixel_args.
- /* The GC to use for drawing this glyph string. */
- GC gc;
+ FROM is a pointer to an XrmValue which points to the color name to
+ convert. TO is an XrmValue in which to return the pixel color.
- /* A pointer to the first glyph in the string. This glyph
- corresponds to char2b[0]. Needed to draw rectangles if
- font_not_found_p is 1. */
- struct glyph *first_glyph;
+ CLOSURE_RET is a pointer to user-data, in which we record if
+ we allocated the color or not.
- /* Image, if any. */
- struct image *img;
+ Value is True if successful, False otherwise. */
- struct glyph_string *next, *prev;
-};
+static Boolean
+cvt_string_to_pixel (dpy, args, nargs, from, to, closure_ret)
+ Display *dpy;
+ XrmValue *args;
+ Cardinal *nargs;
+ XrmValue *from, *to;
+ XtPointer *closure_ret;
+{
+ Screen *screen;
+ Colormap cmap;
+ Pixel pixel;
+ String color_name;
+ XColor color;
+ if (*nargs != 2)
+ {
+ XtAppWarningMsg (XtDisplayToApplicationContext (dpy),
+ "wrongParameters", "cvt_string_to_pixel",
+ "XtToolkitError",
+ "Screen and colormap args required", NULL, NULL);
+ return False;
+ }
-#if GLYPH_DEBUG
+ screen = *(Screen **) args[0].addr;
+ cmap = *(Colormap *) args[1].addr;
+ color_name = (String) from->addr;
-static void
-x_dump_glyph_string (s)
- struct glyph_string *s;
-{
- fprintf (stderr, "glyph string\n");
- fprintf (stderr, " x, y, w, h = %d, %d, %d, %d\n",
- s->x, s->y, s->width, s->height);
- fprintf (stderr, " ybase = %d\n", s->ybase);
- fprintf (stderr, " hl = %d\n", s->hl);
- fprintf (stderr, " left overhang = %d, right = %d\n",
- s->left_overhang, s->right_overhang);
- fprintf (stderr, " nchars = %d\n", s->nchars);
- fprintf (stderr, " extends to end of line = %d\n",
- s->extends_to_end_of_line_p);
- fprintf (stderr, " font height = %d\n", FONT_HEIGHT (s->font));
- fprintf (stderr, " bg width = %d\n", s->background_width);
-}
-
-#endif /* GLYPH_DEBUG */
-
-
-
-static void x_append_glyph_string_lists P_ ((struct glyph_string **,
- struct glyph_string **,
- struct glyph_string *,
- struct glyph_string *));
-static void x_prepend_glyph_string_lists P_ ((struct glyph_string **,
- struct glyph_string **,
- struct glyph_string *,
- struct glyph_string *));
-static void x_append_glyph_string P_ ((struct glyph_string **,
- struct glyph_string **,
- struct glyph_string *));
-static int x_left_overwritten P_ ((struct glyph_string *));
-static int x_left_overwriting P_ ((struct glyph_string *));
-static int x_right_overwritten P_ ((struct glyph_string *));
-static int x_right_overwriting P_ ((struct glyph_string *));
-static int x_fill_glyph_string P_ ((struct glyph_string *, int, int, int,
- int));
-static void x_init_glyph_string P_ ((struct glyph_string *,
- XChar2b *, struct window *,
- struct glyph_row *,
- enum glyph_row_area, int,
- enum draw_glyphs_face));
-static int x_draw_glyphs P_ ((struct window *, int , struct glyph_row *,
- enum glyph_row_area, int, int,
- enum draw_glyphs_face, int));
-static void x_set_glyph_string_clipping P_ ((struct glyph_string *));
-static void x_set_glyph_string_gc P_ ((struct glyph_string *));
-static void x_draw_glyph_string_background P_ ((struct glyph_string *,
- int));
-static void x_draw_glyph_string_foreground P_ ((struct glyph_string *));
-static void x_draw_composite_glyph_string_foreground P_ ((struct glyph_string *));
-static void x_draw_glyph_string_box P_ ((struct glyph_string *));
-static void x_draw_glyph_string P_ ((struct glyph_string *));
-static void x_compute_glyph_string_overhangs P_ ((struct glyph_string *));
-static void x_set_cursor_gc P_ ((struct glyph_string *));
-static void x_set_mode_line_face_gc P_ ((struct glyph_string *));
-static void x_set_mouse_face_gc P_ ((struct glyph_string *));
-static void x_get_glyph_overhangs P_ ((struct glyph *, struct frame *,
- int *, int *));
-static void x_compute_overhangs_and_x P_ ((struct glyph_string *, int, int));
-static int x_alloc_lighter_color P_ ((struct frame *, Display *, Colormap,
- unsigned long *, double, int));
-static void x_setup_relief_color P_ ((struct frame *, struct relief *,
- double, int, unsigned long));
-static void x_setup_relief_colors P_ ((struct glyph_string *));
-static void x_draw_image_glyph_string P_ ((struct glyph_string *));
-static void x_draw_image_relief P_ ((struct glyph_string *));
-static void x_draw_image_foreground P_ ((struct glyph_string *));
-static void x_draw_image_foreground_1 P_ ((struct glyph_string *, Pixmap));
-static void x_fill_image_glyph_string P_ ((struct glyph_string *));
-static void x_clear_glyph_string_rect P_ ((struct glyph_string *, int,
- int, int, int));
-static void x_draw_relief_rect P_ ((struct frame *, int, int, int, int,
- int, int, int, int, XRectangle *));
-static void x_draw_box_rect P_ ((struct glyph_string *, int, int, int, int,
- int, int, int, XRectangle *));
-static void x_fix_overlapping_area P_ ((struct window *, struct glyph_row *,
- enum glyph_row_area));
-static int x_fill_stretch_glyph_string P_ ((struct glyph_string *,
- struct glyph_row *,
- enum glyph_row_area, int, int));
-
-#if GLYPH_DEBUG
-static void x_check_font P_ ((struct frame *, XFontStruct *));
-#endif
-
-
-/* Append the list of glyph strings with head H and tail T to the list
- with head *HEAD and tail *TAIL. Set *HEAD and *TAIL to the result. */
-
-static INLINE void
-x_append_glyph_string_lists (head, tail, h, t)
- struct glyph_string **head, **tail;
- struct glyph_string *h, *t;
-{
- if (h)
+ if (strcmp (color_name, XtDefaultBackground) == 0)
{
- if (*head)
- (*tail)->next = h;
- else
- *head = h;
- h->prev = *tail;
- *tail = t;
+ *closure_ret = (XtPointer) False;
+ pixel = WhitePixelOfScreen (screen);
}
-}
+ else if (strcmp (color_name, XtDefaultForeground) == 0)
+ {
+ *closure_ret = (XtPointer) False;
+ pixel = BlackPixelOfScreen (screen);
+ }
+ else if (XParseColor (dpy, cmap, color_name, &color)
+ && x_alloc_nearest_color_1 (dpy, cmap, &color))
+ {
+ pixel = color.pixel;
+ *closure_ret = (XtPointer) True;
+ }
+ else
+ {
+ String params[1];
+ Cardinal nparams = 1;
+ params[0] = color_name;
+ XtAppWarningMsg (XtDisplayToApplicationContext (dpy),
+ "badValue", "cvt_string_to_pixel",
+ "XtToolkitError", "Invalid color `%s'",
+ params, &nparams);
+ return False;
+ }
-/* Prepend the list of glyph strings with head H and tail T to the
- list with head *HEAD and tail *TAIL. Set *HEAD and *TAIL to the
- result. */
+ if (to->addr != NULL)
+ {
+ if (to->size < sizeof (Pixel))
+ {
+ to->size = sizeof (Pixel);
+ return False;
+ }
-static INLINE void
-x_prepend_glyph_string_lists (head, tail, h, t)
- struct glyph_string **head, **tail;
- struct glyph_string *h, *t;
-{
- if (h)
+ *(Pixel *) to->addr = pixel;
+ }
+ else
{
- if (*head)
- (*head)->prev = t;
- else
- *tail = t;
- t->next = *head;
- *head = h;
+ cvt_string_to_pixel_value = pixel;
+ to->addr = (XtPointer) &cvt_string_to_pixel_value;
}
+
+ to->size = sizeof (Pixel);
+ return True;
}
-/* Append glyph string S to the list with head *HEAD and tail *TAIL.
- Set *HEAD and *TAIL to the resulting list. */
+/* Free a pixel color which was previously allocated via
+ cvt_string_to_pixel. This is registered as the destructor
+ for this type of resource via XtSetTypeConverter.
-static INLINE void
-x_append_glyph_string (head, tail, s)
- struct glyph_string **head, **tail;
- struct glyph_string *s;
-{
- s->next = s->prev = NULL;
- x_append_glyph_string_lists (head, tail, s, s);
-}
+ APP is the application context in which we work.
+ TO is a pointer to an XrmValue holding the color to free.
+ CLOSURE is the value we stored in CLOSURE_RET for this color
+ in cvt_string_to_pixel.
-/* Set S->gc to a suitable GC for drawing glyph string S in cursor
- face. */
+ ARGS and NARGS are like for cvt_string_to_pixel. */
static void
-x_set_cursor_gc (s)
- struct glyph_string *s;
+cvt_pixel_dtor (app, to, closure, args, nargs)
+ XtAppContext app;
+ XrmValuePtr to;
+ XtPointer closure;
+ XrmValuePtr args;
+ Cardinal *nargs;
{
- if (s->font == FRAME_FONT (s->f)
- && s->face->background == FRAME_BACKGROUND_PIXEL (s->f)
- && s->face->foreground == FRAME_FOREGROUND_PIXEL (s->f)
- && !s->cmp)
- s->gc = s->f->output_data.x->cursor_gc;
- else
+ if (*nargs != 2)
{
- /* Cursor on non-default face: must merge. */
- XGCValues xgcv;
- unsigned long mask;
-
- xgcv.background = s->f->output_data.x->cursor_pixel;
- xgcv.foreground = s->face->background;
+ XtAppWarningMsg (app, "wrongParameters", "cvt_pixel_dtor",
+ "XtToolkitError",
+ "Screen and colormap arguments required",
+ NULL, NULL);
+ }
+ else if (closure != NULL)
+ {
+ /* We did allocate the pixel, so free it. */
+ Screen *screen = *(Screen **) args[0].addr;
+ Colormap cmap = *(Colormap *) args[1].addr;
+ x_free_dpy_colors (DisplayOfScreen (screen), screen, cmap,
+ (Pixel *) to->addr, 1);
+ }
+}
- /* If the glyph would be invisible, try a different foreground. */
- if (xgcv.foreground == xgcv.background)
- xgcv.foreground = s->face->foreground;
- if (xgcv.foreground == xgcv.background)
- xgcv.foreground = s->f->output_data.x->cursor_foreground_pixel;
- if (xgcv.foreground == xgcv.background)
- xgcv.foreground = s->face->foreground;
- /* Make sure the cursor is distinct from text in this face. */
- if (xgcv.background == s->face->background
- && xgcv.foreground == s->face->foreground)
- {
- xgcv.background = s->face->foreground;
- xgcv.foreground = s->face->background;
- }
+#endif /* USE_X_TOOLKIT */
- IF_DEBUG (x_check_font (s->f, s->font));
- xgcv.font = s->font->fid;
- xgcv.graphics_exposures = False;
- mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
- if (FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc)
- XChangeGC (s->display, FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc,
- mask, &xgcv);
- else
- FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc
- = XCreateGC (s->display, s->window, mask, &xgcv);
+/* Value is an array of XColor structures for the contents of the
+ color map of display DPY. Set *NCELLS to the size of the array.
+ Note that this probably shouldn't be called for large color maps,
+ say a 24-bit TrueColor map. */
- s->gc = FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc;
- }
-}
+static const XColor *
+x_color_cells (dpy, ncells)
+ Display *dpy;
+ int *ncells;
+{
+ struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
+ if (dpyinfo->color_cells == NULL)
+ {
+ Screen *screen = dpyinfo->screen;
+ int i;
-/* Set up S->gc of glyph string S for drawing text in mouse face. */
-
-static void
-x_set_mouse_face_gc (s)
- struct glyph_string *s;
-{
- int face_id;
- struct face *face;
+ dpyinfo->ncolor_cells
+ = XDisplayCells (dpy, XScreenNumberOfScreen (screen));
+ dpyinfo->color_cells
+ = (XColor *) xmalloc (dpyinfo->ncolor_cells
+ * sizeof *dpyinfo->color_cells);
- /* What face has to be used last for the mouse face? */
- face_id = FRAME_X_DISPLAY_INFO (s->f)->mouse_face_face_id;
- face = FACE_FROM_ID (s->f, face_id);
- if (face == NULL)
- 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);
- else
- face_id = FACE_FOR_CHAR (s->f, face, 0);
- s->face = FACE_FROM_ID (s->f, face_id);
- PREPARE_FACE_FOR_DISPLAY (s->f, s->face);
+ for (i = 0; i < dpyinfo->ncolor_cells; ++i)
+ dpyinfo->color_cells[i].pixel = i;
- /* If font in this face is same as S->font, use it. */
- if (s->font == s->face->font)
- s->gc = s->face->gc;
- else
- {
- /* Otherwise construct scratch_cursor_gc with values from FACE
- but font FONT. */
- XGCValues xgcv;
- unsigned long mask;
-
- xgcv.background = s->face->background;
- xgcv.foreground = s->face->foreground;
- IF_DEBUG (x_check_font (s->f, s->font));
- xgcv.font = s->font->fid;
- xgcv.graphics_exposures = False;
- mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
-
- if (FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc)
- XChangeGC (s->display, FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc,
- mask, &xgcv);
- else
- FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc
- = XCreateGC (s->display, s->window, mask, &xgcv);
-
- s->gc = FRAME_X_DISPLAY_INFO (s->f)->scratch_cursor_gc;
+ XQueryColors (dpy, dpyinfo->cmap,
+ dpyinfo->color_cells, dpyinfo->ncolor_cells);
}
- xassert (s->gc != 0);
+ *ncells = dpyinfo->ncolor_cells;
+ return dpyinfo->color_cells;
}
-/* Set S->gc of glyph string S to a GC suitable for drawing a mode line.
- Faces to use in the mode line have already been computed when the
- matrix was built, so there isn't much to do, here. */
+/* On frame F, translate pixel colors to RGB values for the NCOLORS
+ colors in COLORS. Use cached information, if available. */
-static INLINE void
-x_set_mode_line_face_gc (s)
- struct glyph_string *s;
-{
- s->gc = s->face->gc;
+void
+x_query_colors (f, colors, ncolors)
+ struct frame *f;
+ XColor *colors;
+ int ncolors;
+{
+ struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+
+ if (dpyinfo->color_cells)
+ {
+ int i;
+ for (i = 0; i < ncolors; ++i)
+ {
+ unsigned long pixel = colors[i].pixel;
+ xassert (pixel < dpyinfo->ncolor_cells);
+ xassert (dpyinfo->color_cells[pixel].pixel == pixel);
+ colors[i] = dpyinfo->color_cells[pixel];
+ }
+ }
+ else
+ XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), colors, ncolors);
}
-/* Set S->gc of glyph string S for drawing that glyph string. Set
- S->stippled_p to a non-zero value if the face of S has a stipple
- pattern. */
+/* On frame F, translate pixel color to RGB values for the color in
+ COLOR. Use cached information, if available. */
-static INLINE void
-x_set_glyph_string_gc (s)
- struct glyph_string *s;
+void
+x_query_color (f, color)
+ struct frame *f;
+ XColor *color;
{
- PREPARE_FACE_FOR_DISPLAY (s->f, s->face);
-
- if (s->hl == DRAW_NORMAL_TEXT)
- {
- s->gc = s->face->gc;
- s->stippled_p = s->face->stipple != 0;
- }
- else if (s->hl == DRAW_INVERSE_VIDEO)
- {
- x_set_mode_line_face_gc (s);
- s->stippled_p = s->face->stipple != 0;
- }
- else if (s->hl == DRAW_CURSOR)
- {
- x_set_cursor_gc (s);
- s->stippled_p = 0;
- }
- else if (s->hl == DRAW_MOUSE_FACE)
- {
- x_set_mouse_face_gc (s);
- s->stippled_p = s->face->stipple != 0;
- }
- else if (s->hl == DRAW_IMAGE_RAISED
- || s->hl == DRAW_IMAGE_SUNKEN)
- {
- s->gc = s->face->gc;
- s->stippled_p = s->face->stipple != 0;
- }
- else
- {
- s->gc = s->face->gc;
- s->stippled_p = s->face->stipple != 0;
- }
-
- /* GC must have been set. */
- xassert (s->gc != 0);
+ x_query_colors (f, color, 1);
}
-/* Return in *R the clipping rectangle for glyph string S. */
+/* Allocate the color COLOR->pixel on DISPLAY, colormap CMAP. If an
+ exact match can't be allocated, try the nearest color available.
+ Value is non-zero if successful. Set *COLOR to the color
+ allocated. */
-static void
-x_get_glyph_string_clip_rect (s, r)
- struct glyph_string *s;
- XRectangle *r;
+static int
+x_alloc_nearest_color_1 (dpy, cmap, color)
+ Display *dpy;
+ Colormap cmap;
+ XColor *color;
{
- if (s->row->full_width_p)
+ int rc;
+
+ rc = XAllocColor (dpy, cmap, color);
+ if (rc == 0)
{
- /* Draw full-width. X coordinates are relative to S->w->left. */
- int canon_x = CANON_X_UNIT (s->f);
-
- r->x = WINDOW_LEFT_MARGIN (s->w) * canon_x;
- r->width = XFASTINT (s->w->width) * canon_x;
+ /* If we got to this point, the colormap is full, so we're going
+ to try to get the next closest color. The algorithm used is
+ a least-squares matching, which is what X uses for closest
+ color matching with StaticColor visuals. */
+ int nearest, i;
+ unsigned long nearest_delta = ~0;
+ int ncells;
+ const XColor *cells = x_color_cells (dpy, &ncells);
- if (FRAME_HAS_VERTICAL_SCROLL_BARS (s->f))
+ for (nearest = i = 0; i < ncells; ++i)
{
- int width = FRAME_SCROLL_BAR_WIDTH (s->f) * canon_x;
- if (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (s->f))
- r->x -= width;
+ long dred = (color->red >> 8) - (cells[i].red >> 8);
+ long dgreen = (color->green >> 8) - (cells[i].green >> 8);
+ long dblue = (color->blue >> 8) - (cells[i].blue >> 8);
+ unsigned long delta = dred * dred + dgreen * dgreen + dblue * dblue;
+
+ if (delta < nearest_delta)
+ {
+ nearest = i;
+ nearest_delta = delta;
+ }
}
-
- r->x += FRAME_INTERNAL_BORDER_WIDTH (s->f);
-
- /* Unless displaying a mode or menu bar line, which are always
- fully visible, clip to the visible part of the row. */
- if (s->w->pseudo_window_p)
- r->height = s->row->visible_height;
- else
- r->height = s->height;
- }
- else
- {
- /* This is a text line that may be partially visible. */
- r->x = WINDOW_AREA_TO_FRAME_PIXEL_X (s->w, s->area, 0);
- r->width = window_box_width (s->w, s->area);
- r->height = s->row->visible_height;
- }
- /* If S draws overlapping rows, it's sufficient to use the top and
- bottom of the window for clipping because this glyph string
- intentionally draws over other lines. */
- if (s->for_overlaps_p)
- {
- r->y = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (s->w);
- r->height = window_text_bottom_y (s->w) - r->y;
+ color->red = cells[nearest].red;
+ color->green = cells[nearest].green;
+ color->blue = cells[nearest].blue;
+ rc = XAllocColor (dpy, cmap, color);
}
else
{
- /* Don't use S->y for clipping because it doesn't take partially
- visible lines into account. For example, it can be negative for
- partially visible lines at the top of a window. */
- if (!s->row->full_width_p
- && MATRIX_ROW_PARTIALLY_VISIBLE_AT_TOP_P (s->w, s->row))
- r->y = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (s->w);
- else
- r->y = max (0, s->row->y);
+ /* If allocation succeeded, and the allocated pixel color is not
+ equal to a cached pixel color recorded earlier, there was a
+ change in the colormap, so clear the color cache. */
+ struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
+ XColor *cached_color;
- /* If drawing a tool-bar window, draw it over the internal border
- at the top of the window. */
- if (s->w == XWINDOW (s->f->tool_bar_window))
- r->y -= s->f->output_data.x->internal_border_width;
+ if (dpyinfo->color_cells
+ && (cached_color = &dpyinfo->color_cells[color->pixel],
+ (cached_color->red != color->red
+ || cached_color->blue != color->blue
+ || cached_color->green != color->green)))
+ {
+ xfree (dpyinfo->color_cells);
+ dpyinfo->color_cells = NULL;
+ dpyinfo->ncolor_cells = 0;
+ }
}
- r->y = WINDOW_TO_FRAME_PIXEL_Y (s->w, r->y);
-}
-
-
-/* Set clipping for output of glyph string S. S may be part of a mode
- line or menu if we don't have X toolkit support. */
+#ifdef DEBUG_X_COLORS
+ if (rc)
+ register_color (color->pixel);
+#endif /* DEBUG_X_COLORS */
-static INLINE void
-x_set_glyph_string_clipping (s)
- struct glyph_string *s;
-{
- XRectangle r;
- x_get_glyph_string_clip_rect (s, &r);
- XSetClipRectangles (s->display, s->gc, 0, 0, &r, 1, Unsorted);
+ return rc;
}
-/* Compute left and right overhang of glyph string S. If S is a glyph
- string for a composition, assume overhangs don't exist. */
-
-static INLINE void
-x_compute_glyph_string_overhangs (s)
- struct glyph_string *s;
-{
- if (s->cmp == NULL
- && s->first_glyph->type == CHAR_GLYPH)
- {
- XCharStruct cs;
- int direction, font_ascent, font_descent;
- 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;
- }
-}
-
+/* Allocate the color COLOR->pixel on frame F, colormap CMAP. If an
+ exact match can't be allocated, try the nearest color available.
+ Value is non-zero if successful. Set *COLOR to the color
+ allocated. */
-/* Compute overhangs and x-positions for glyph string S and its
- predecessors, or successors. X is the starting x-position for S.
- BACKWARD_P non-zero means process predecessors. */
-
-static void
-x_compute_overhangs_and_x (s, x, backward_p)
- struct glyph_string *s;
- int x;
- int backward_p;
+int
+x_alloc_nearest_color (f, cmap, color)
+ struct frame *f;
+ Colormap cmap;
+ XColor *color;
{
- if (backward_p)
- {
- while (s)
- {
- x_compute_glyph_string_overhangs (s);
- x -= s->width;
- s->x = x;
- s = s->prev;
- }
- }
- else
- {
- while (s)
- {
- x_compute_glyph_string_overhangs (s);
- s->x = x;
- x += s->width;
- s = s->next;
- }
- }
+ gamma_correct (f, color);
+ return x_alloc_nearest_color_1 (FRAME_X_DISPLAY (f), cmap, color);
}
-/* Set *LEFT and *RIGHT to the left and right overhang of GLYPH on
- frame F. Overhangs of glyphs other than type CHAR_GLYPH are
- assumed to be zero. */
+/* Allocate color PIXEL on frame F. PIXEL must already be allocated.
+ It's necessary to do this instead of just using PIXEL directly to
+ get color reference counts right. */
-static void
-x_get_glyph_overhangs (glyph, f, left, right)
- struct glyph *glyph;
+unsigned long
+x_copy_color (f, pixel)
struct frame *f;
- int *left, *right;
-{
- *left = *right = 0;
-
- if (glyph->type == CHAR_GLYPH)
- {
- XFontStruct *font;
- struct face *face;
- struct font_info *font_info;
- XChar2b char2b;
- XCharStruct *pcm;
-
- face = x_get_glyph_face_and_encoding (f, glyph, &char2b, NULL);
- font = face->font;
- font_info = FONT_INFO_FROM_ID (f, face->font_info_id);
- if (font
- && (pcm = x_per_char_metric (font, &char2b)))
- {
- if (pcm->rbearing > pcm->width)
- *right = pcm->rbearing - pcm->width;
- if (pcm->lbearing < 0)
- *left = -pcm->lbearing;
- }
- }
-}
-
-
-/* Return the index of the first glyph preceding glyph string S that
- is overwritten by S because of S's left overhang. Value is -1
- if no glyphs are overwritten. */
-
-static int
-x_left_overwritten (s)
- struct glyph_string *s;
+ unsigned long pixel;
{
- int k;
-
- if (s->left_overhang)
- {
- int x = 0, i;
- struct glyph *glyphs = s->row->glyphs[s->area];
- int first = s->first_glyph - glyphs;
-
- for (i = first - 1; i >= 0 && x > -s->left_overhang; --i)
- x -= glyphs[i].pixel_width;
-
- k = i + 1;
- }
- else
- k = -1;
+ XColor color;
- return k;
+ color.pixel = pixel;
+ BLOCK_INPUT;
+ x_query_color (f, &color);
+ XAllocColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), &color);
+ UNBLOCK_INPUT;
+#ifdef DEBUG_X_COLORS
+ register_color (pixel);
+#endif
+ return color.pixel;
}
-/* Return the index of the first glyph preceding glyph string S that
- is overwriting S because of its right overhang. Value is -1 if no
- glyph in front of S overwrites S. */
+/* Allocate color PIXEL on display DPY. PIXEL must already be allocated.
+ It's necessary to do this instead of just using PIXEL directly to
+ get color reference counts right. */
-static int
-x_left_overwriting (s)
- struct glyph_string *s;
+unsigned long
+x_copy_dpy_color (dpy, cmap, pixel)
+ Display *dpy;
+ Colormap cmap;
+ unsigned long pixel;
{
- int i, k, x;
- struct glyph *glyphs = s->row->glyphs[s->area];
- int first = s->first_glyph - glyphs;
-
- k = -1;
- x = 0;
- for (i = first - 1; i >= 0; --i)
- {
- int left, right;
- x_get_glyph_overhangs (glyphs + i, s->f, &left, &right);
- if (x + right > 0)
- k = i;
- x -= glyphs[i].pixel_width;
- }
+ XColor color;
- return k;
+ color.pixel = pixel;
+ BLOCK_INPUT;
+ XQueryColor (dpy, cmap, &color);
+ XAllocColor (dpy, cmap, &color);
+ UNBLOCK_INPUT;
+#ifdef DEBUG_X_COLORS
+ register_color (pixel);
+#endif
+ return color.pixel;
}
-/* Return the index of the last glyph following glyph string S that is
- not overwritten by S because of S's right overhang. Value is -1 if
- no such glyph is found. */
-
-static int
-x_right_overwritten (s)
- struct glyph_string *s;
-{
- int k = -1;
-
- if (s->right_overhang)
- {
- int x = 0, i;
- struct glyph *glyphs = s->row->glyphs[s->area];
- int first = (s->first_glyph - glyphs) + (s->cmp ? 1 : s->nchars);
- int end = s->row->used[s->area];
-
- for (i = first; i < end && s->right_overhang > x; ++i)
- x += glyphs[i].pixel_width;
+/* Brightness beyond which a color won't have its highlight brightness
+ boosted.
- k = i;
- }
+ Nominally, highlight colors for `3d' faces are calculated by
+ brightening an object's color by a constant scale factor, but this
+ doesn't yield good results for dark colors, so for colors who's
+ brightness is less than this value (on a scale of 0-65535) have an
+ use an additional additive factor.
- return k;
-}
+ The value here is set so that the default menu-bar/mode-line color
+ (grey75) will not have its highlights changed at all. */
+#define HIGHLIGHT_COLOR_DARK_BOOST_LIMIT 48000
-/* Return the index of the last glyph following glyph string S that
- overwrites S because of its left overhang. Value is negative
- if no such glyph is found. */
+/* Allocate a color which is lighter or darker than *PIXEL by FACTOR
+ or DELTA. Try a color with RGB values multiplied by FACTOR first.
+ If this produces the same color as PIXEL, try a color where all RGB
+ values have DELTA added. Return the allocated color in *PIXEL.
+ DISPLAY is the X display, CMAP is the colormap to operate on.
+ Value is non-zero if successful. */
static int
-x_right_overwriting (s)
- struct glyph_string *s;
+x_alloc_lighter_color (f, display, cmap, pixel, factor, delta)
+ struct frame *f;
+ Display *display;
+ Colormap cmap;
+ unsigned long *pixel;
+ double factor;
+ int delta;
{
- int i, k, x;
- int end = s->row->used[s->area];
- struct glyph *glyphs = s->row->glyphs[s->area];
- int first = (s->first_glyph - glyphs) + (s->cmp ? 1 : s->nchars);
-
- k = -1;
- x = 0;
- for (i = first; i < end; ++i)
- {
- int left, right;
- x_get_glyph_overhangs (glyphs + i, s->f, &left, &right);
- if (x - left < 0)
- k = i;
- x += glyphs[i].pixel_width;
- }
+ XColor color, new;
+ long bright;
+ int success_p;
- return k;
-}
-
-
-/* Fill rectangle X, Y, W, H with background color of glyph string S. */
-
-static INLINE void
-x_clear_glyph_string_rect (s, x, y, w, h)
- struct glyph_string *s;
- int x, y, w, h;
-{
- XGCValues xgcv;
- XGetGCValues (s->display, s->gc, GCForeground | GCBackground, &xgcv);
- XSetForeground (s->display, s->gc, xgcv.background);
- XFillRectangle (s->display, s->window, s->gc, x, y, w, h);
- XSetForeground (s->display, s->gc, xgcv.foreground);
-}
+ /* Get RGB color values. */
+ color.pixel = *pixel;
+ x_query_color (f, &color);
+ /* Change RGB values by specified FACTOR. Avoid overflow! */
+ xassert (factor >= 0);
+ new.red = min (0xffff, factor * color.red);
+ new.green = min (0xffff, factor * color.green);
+ new.blue = min (0xffff, factor * color.blue);
-/* Draw the background of glyph_string S. If S->background_filled_p
- is non-zero don't draw it. FORCE_P non-zero means draw the
- background even if it wouldn't be drawn normally. This is used
- when a string preceding S draws into the background of S, or S
- contains the first component of a composition. */
+ /* Calculate brightness of COLOR. */
+ bright = (2 * color.red + 3 * color.green + color.blue) / 6;
-static void
-x_draw_glyph_string_background (s, force_p)
- struct glyph_string *s;
- int force_p;
-{
- /* Nothing to do if background has already been drawn or if it
- shouldn't be drawn in the first place. */
- if (!s->background_filled_p)
+ /* We only boost colors that are darker than
+ HIGHLIGHT_COLOR_DARK_BOOST_LIMIT. */
+ if (bright < HIGHLIGHT_COLOR_DARK_BOOST_LIMIT)
+ /* Make an additive adjustment to NEW, because it's dark enough so
+ that scaling by FACTOR alone isn't enough. */
{
- int box_line_width = max (s->face->box_line_width, 0);
+ /* How far below the limit this color is (0 - 1, 1 being darker). */
+ double dimness = 1 - (double)bright / HIGHLIGHT_COLOR_DARK_BOOST_LIMIT;
+ /* The additive adjustment. */
+ int min_delta = delta * dimness * factor / 2;
- if (s->stippled_p)
+ if (factor < 1)
{
- /* Fill background with a stipple pattern. */
- XSetFillStyle (s->display, s->gc, FillOpaqueStippled);
- XFillRectangle (s->display, s->window, s->gc, s->x,
- s->y + box_line_width,
- s->background_width,
- s->height - 2 * box_line_width);
- XSetFillStyle (s->display, s->gc, FillSolid);
- s->background_filled_p = 1;
+ new.red = max (0, new.red - min_delta);
+ new.green = max (0, new.green - min_delta);
+ new.blue = max (0, new.blue - min_delta);
}
- else if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width
- || s->font_not_found_p
- || s->extends_to_end_of_line_p
- || force_p)
+ else
{
- x_clear_glyph_string_rect (s, s->x, s->y + box_line_width,
- s->background_width,
- s->height - 2 * box_line_width);
- s->background_filled_p = 1;
+ new.red = min (0xffff, min_delta + new.red);
+ new.green = min (0xffff, min_delta + new.green);
+ new.blue = min (0xffff, min_delta + new.blue);
+ }
+ }
+
+ /* Try to allocate the color. */
+ success_p = x_alloc_nearest_color (f, cmap, &new);
+ if (success_p)
+ {
+ if (new.pixel == *pixel)
+ {
+ /* If we end up with the same color as before, try adding
+ delta to the RGB values. */
+ x_free_colors (f, &new.pixel, 1);
+
+ new.red = min (0xffff, delta + color.red);
+ new.green = min (0xffff, delta + color.green);
+ new.blue = min (0xffff, delta + color.blue);
+ success_p = x_alloc_nearest_color (f, cmap, &new);
}
+ else
+ success_p = 1;
+ *pixel = new.pixel;
}
+
+ return success_p;
}
-/* Draw the foreground of glyph string S. */
+/* Set up the foreground color for drawing relief lines of glyph
+ string S. RELIEF is a pointer to a struct relief containing the GC
+ with which lines will be drawn. Use a color that is FACTOR or
+ DELTA lighter or darker than the relief's background which is found
+ in S->f->output_data.x->relief_background. If such a color cannot
+ be allocated, use DEFAULT_PIXEL, instead. */
static void
-x_draw_glyph_string_foreground (s)
- struct glyph_string *s;
+x_setup_relief_color (f, relief, factor, delta, default_pixel)
+ struct frame *f;
+ struct relief *relief;
+ double factor;
+ int delta;
+ unsigned long default_pixel;
{
- int i, x;
+ XGCValues xgcv;
+ struct x_output *di = f->output_data.x;
+ unsigned long mask = GCForeground | GCLineWidth | GCGraphicsExposures;
+ unsigned long pixel;
+ unsigned long background = di->relief_background;
+ Colormap cmap = FRAME_X_COLORMAP (f);
+ struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ Display *dpy = FRAME_X_DISPLAY (f);
- /* 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
- && s->first_glyph->left_box_line_p)
- x = s->x + abs (s->face->box_line_width);
- else
- x = s->x;
+ xgcv.graphics_exposures = False;
+ xgcv.line_width = 1;
- /* Draw characters of S as rectangles if S's font could not be
- loaded. */
- if (s->font_not_found_p)
+ /* Free previously allocated color. The color cell will be reused
+ when it has been freed as many times as it was allocated, so this
+ doesn't affect faces using the same colors. */
+ if (relief->gc
+ && relief->allocated_p)
{
- for (i = 0; i < s->nchars; ++i)
- {
- struct glyph *g = s->first_glyph + i;
- XDrawRectangle (s->display, s->window,
- s->gc, x, s->y, g->pixel_width - 1,
- s->height - 1);
- x += g->pixel_width;
- }
+ x_free_colors (f, &relief->pixel, 1);
+ relief->allocated_p = 0;
}
- else
- {
- char *char1b = (char *) s->char2b;
- int boff = s->font_info->baseline_offset;
-
- if (s->font_info->vertical_centering)
- boff = VCENTER_BASELINE_OFFSET (s->font, s->f) - boff;
- /* If we can use 8-bit functions, condense S->char2b. */
- if (!s->two_byte_p)
- for (i = 0; i < s->nchars; ++i)
- char1b[i] = s->char2b[i].byte2;
+ /* Allocate new color. */
+ xgcv.foreground = default_pixel;
+ pixel = background;
+ if (dpyinfo->n_planes != 1
+ && x_alloc_lighter_color (f, dpy, cmap, &pixel, factor, delta))
+ {
+ relief->allocated_p = 1;
+ xgcv.foreground = relief->pixel = pixel;
+ }
- /* Draw text with XDrawString if background has already been
- filled. Otherwise, use XDrawImageString. (Note that
- XDrawImageString is usually faster than XDrawString.) Always
- use XDrawImageString when drawing the cursor so that there is
- no chance that characters under a box cursor are invisible. */
- if (s->for_overlaps_p
- || (s->background_filled_p && s->hl != DRAW_CURSOR))
- {
- /* Draw characters with 16-bit or 8-bit functions. */
- if (s->two_byte_p)
- XDrawString16 (s->display, s->window, s->gc, x,
- s->ybase - boff, s->char2b, s->nchars);
- else
- XDrawString (s->display, s->window, s->gc, x,
- s->ybase - boff, char1b, s->nchars);
- }
- else
- {
- if (s->two_byte_p)
- XDrawImageString16 (s->display, s->window, s->gc, x,
- s->ybase - boff, s->char2b, s->nchars);
- else
- XDrawImageString (s->display, s->window, s->gc, x,
- s->ybase - boff, char1b, s->nchars);
- }
+ if (relief->gc == 0)
+ {
+ xgcv.stipple = dpyinfo->gray;
+ mask |= GCStipple;
+ relief->gc = XCreateGC (dpy, FRAME_X_WINDOW (f), mask, &xgcv);
}
+ else
+ XChangeGC (dpy, relief->gc, mask, &xgcv);
}
-/* Draw the foreground of composite glyph string S. */
+
+/* Set up colors for the relief lines around glyph string S. */
static void
-x_draw_composite_glyph_string_foreground (s)
+x_setup_relief_colors (s)
struct glyph_string *s;
{
- int i, x;
+ struct x_output *di = s->f->output_data.x;
+ unsigned long color;
- /* 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
- && s->first_glyph->left_box_line_p)
- x = s->x + abs (s->face->box_line_width);
+ if (s->face->use_box_color_for_shadows_p)
+ color = s->face->box_color;
+ else if (s->first_glyph->type == IMAGE_GLYPH
+ && s->img->pixmap
+ && !IMAGE_BACKGROUND_TRANSPARENT (s->img, s->f, 0))
+ color = IMAGE_BACKGROUND (s->img, s->f, 0);
else
- x = s->x;
-
- /* S is a glyph string for a composition. S->gidx is the index of
- the first character drawn for glyphs of this composition.
- S->gidx == 0 means we are drawing the very first character of
- this composition. */
-
- /* Draw a rectangle for the composition if the font for the very
- first character of the composition could not be loaded. */
- if (s->font_not_found_p)
{
- if (s->gidx == 0)
- XDrawRectangle (s->display, s->window, s->gc, x, s->y,
- s->width - 1, s->height - 1);
+ XGCValues xgcv;
+
+ /* Get the background color of the face. */
+ XGetGCValues (s->display, s->gc, GCBackground, &xgcv);
+ color = xgcv.background;
}
- else
+
+ if (di->white_relief.gc == 0
+ || color != di->relief_background)
{
- for (i = 0; i < s->nchars; i++, ++s->gidx)
- 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);
+ di->relief_background = color;
+ x_setup_relief_color (s->f, &di->white_relief, 1.2, 0x8000,
+ WHITE_PIX_DEFAULT (s->f));
+ x_setup_relief_color (s->f, &di->black_relief, 0.6, 0x4000,
+ BLACK_PIX_DEFAULT (s->f));
}
}
-#ifdef USE_X_TOOLKIT
-
-static struct frame *x_frame_of_widget P_ ((Widget));
-static Boolean cvt_string_to_pixel P_ ((Display *, XrmValue *, Cardinal *,
- XrmValue *, XrmValue *, XtPointer *));
-static void cvt_pixel_dtor P_ ((XtAppContext, XrmValue *, XtPointer,
- XrmValue *, Cardinal *));
+/* Draw a relief on frame F inside the rectangle given by LEFT_X,
+ TOP_Y, RIGHT_X, and BOTTOM_Y. WIDTH is the thickness of the relief
+ to draw, it must be >= 0. RAISED_P non-zero means draw a raised
+ relief. LEFT_P non-zero means draw a relief on the left side of
+ the rectangle. RIGHT_P non-zero means draw a relief on the right
+ side of the rectangle. CLIP_RECT is the clipping rectangle to use
+ when drawing. */
+static void
+x_draw_relief_rect (f, left_x, top_y, right_x, bottom_y, width,
+ raised_p, left_p, right_p, clip_rect)
+ struct frame *f;
+ int left_x, top_y, right_x, bottom_y, width, left_p, right_p, raised_p;
+ XRectangle *clip_rect;
+{
+ Display *dpy = FRAME_X_DISPLAY (f);
+ Window window = FRAME_X_WINDOW (f);
+ int i;
+ GC gc;
-/* Return the frame on which widget WIDGET is used.. Abort if frame
- cannot be determined. */
+ if (raised_p)
+ gc = f->output_data.x->white_relief.gc;
+ else
+ gc = f->output_data.x->black_relief.gc;
+ XSetClipRectangles (dpy, gc, 0, 0, clip_rect, 1, Unsorted);
-static struct frame *
-x_frame_of_widget (widget)
- Widget widget;
-{
- struct x_display_info *dpyinfo;
- Lisp_Object tail;
- struct frame *f;
-
- dpyinfo = x_display_info_for_display (XtDisplay (widget));
-
- /* Find the top-level shell of the widget. Note that this function
- can be called when the widget is not yet realized, so XtWindow
- (widget) == 0. That's the reason we can't simply use
- x_any_window_to_frame. */
- while (!XtIsTopLevelShell (widget))
- widget = XtParent (widget);
+ /* Top. */
+ for (i = 0; i < width; ++i)
+ XDrawLine (dpy, window, gc,
+ left_x + i * left_p, top_y + i,
+ right_x + 1 - i * right_p, top_y + i);
- /* 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))
- && (f = XFRAME (XCAR (tail)),
- (f->output_data.nothing != 1
- && FRAME_X_DISPLAY_INFO (f) == dpyinfo))
- && f->output_data.x->widget == widget)
- return f;
+ /* Left. */
+ if (left_p)
+ for (i = 0; i < width; ++i)
+ XDrawLine (dpy, window, gc,
+ left_x + i, top_y + i, left_x + i, bottom_y - i + 1);
- abort ();
-}
+ XSetClipMask (dpy, gc, None);
+ if (raised_p)
+ gc = f->output_data.x->black_relief.gc;
+ else
+ gc = f->output_data.x->white_relief.gc;
+ XSetClipRectangles (dpy, gc, 0, 0, clip_rect, 1, Unsorted);
+ /* Bottom. */
+ for (i = 0; i < width; ++i)
+ XDrawLine (dpy, window, gc,
+ left_x + i * left_p, bottom_y - i,
+ right_x + 1 - i * right_p, bottom_y - i);
-/* Allocate the color COLOR->pixel on the screen and display of
- widget WIDGET in colormap CMAP. If an exact match cannot be
- allocated, try the nearest color available. Value is non-zero
- if successful. This is called from lwlib. */
+ /* Right. */
+ if (right_p)
+ for (i = 0; i < width; ++i)
+ XDrawLine (dpy, window, gc,
+ right_x - i, top_y + i + 1, right_x - i, bottom_y - i);
-int
-x_alloc_nearest_color_for_widget (widget, cmap, color)
- Widget widget;
- Colormap cmap;
- XColor *color;
-{
- struct frame *f = x_frame_of_widget (widget);
- return x_alloc_nearest_color (f, cmap, color);
+ XSetClipMask (dpy, gc, None);
}
-/* Allocate a color which is lighter or darker than *PIXEL by FACTOR
- or DELTA. Try a color with RGB values multiplied by FACTOR first.
- If this produces the same color as PIXEL, try a color where all RGB
- values have DELTA added. Return the allocated color in *PIXEL.
- DISPLAY is the X display, CMAP is the colormap to operate on.
- Value is non-zero if successful. */
+/* Draw a box on frame F inside the rectangle given by LEFT_X, TOP_Y,
+ RIGHT_X, and BOTTOM_Y. WIDTH is the thickness of the lines to
+ draw, it must be >= 0. LEFT_P non-zero means draw a line on the
+ left side of the rectangle. RIGHT_P non-zero means draw a line
+ on the right side of the rectangle. CLIP_RECT is the clipping
+ rectangle to use when drawing. */
-int
-x_alloc_lighter_color_for_widget (widget, display, cmap, pixel, factor, delta)
- Widget widget;
- Display *display;
- Colormap cmap;
- unsigned long *pixel;
- double factor;
- int delta;
+static void
+x_draw_box_rect (s, left_x, top_y, right_x, bottom_y, width,
+ left_p, right_p, clip_rect)
+ struct glyph_string *s;
+ int left_x, top_y, right_x, bottom_y, width, left_p, right_p;
+ XRectangle *clip_rect;
{
- struct frame *f = x_frame_of_widget (widget);
- return x_alloc_lighter_color (f, display, cmap, pixel, factor, delta);
-}
+ XGCValues xgcv;
+ XGetGCValues (s->display, s->gc, GCForeground, &xgcv);
+ XSetForeground (s->display, s->gc, s->face->box_color);
+ XSetClipRectangles (s->display, s->gc, 0, 0, clip_rect, 1, Unsorted);
-/* Structure specifying which arguments should be passed by Xt to
- cvt_string_to_pixel. We want the widget's screen and colormap. */
+ /* Top. */
+ XFillRectangle (s->display, s->window, s->gc,
+ left_x, top_y, right_x - left_x + 1, width);
-static XtConvertArgRec cvt_string_to_pixel_args[] =
- {
- {XtWidgetBaseOffset, (XtPointer) XtOffset (Widget, core.screen),
- sizeof (Screen *)},
- {XtWidgetBaseOffset, (XtPointer) XtOffset (Widget, core.colormap),
- sizeof (Colormap)}
- };
+ /* Left. */
+ if (left_p)
+ XFillRectangle (s->display, s->window, s->gc,
+ left_x, top_y, width, bottom_y - top_y + 1);
+ /* Bottom. */
+ XFillRectangle (s->display, s->window, s->gc,
+ left_x, bottom_y - width + 1, right_x - left_x + 1, width);
-/* The address of this variable is returned by
- cvt_string_to_pixel. */
+ /* Right. */
+ if (right_p)
+ XFillRectangle (s->display, s->window, s->gc,
+ right_x - width + 1, top_y, width, bottom_y - top_y + 1);
-static Pixel cvt_string_to_pixel_value;
+ XSetForeground (s->display, s->gc, xgcv.foreground);
+ XSetClipMask (s->display, s->gc, None);
+}
-/* Convert a color name to a pixel color.
+/* Draw a box around glyph string S. */
- DPY is the display we are working on.
+static void
+x_draw_glyph_string_box (s)
+ struct glyph_string *s;
+{
+ int width, left_x, right_x, top_y, bottom_y, last_x, raised_p;
+ int left_p, right_p;
+ struct glyph *last_glyph;
+ XRectangle clip_rect;
- ARGS is an array of *NARGS XrmValue structures holding additional
- information about the widget for which the conversion takes place.
- The contents of this array are determined by the specification
- in cvt_string_to_pixel_args.
+ last_x = window_box_right (s->w, s->area);
+ if (s->row->full_width_p
+ && !s->w->pseudo_window_p)
+ {
+ last_x += WINDOW_RIGHT_SCROLL_BAR_AREA_WIDTH (s->w);
+ if (s->area != RIGHT_MARGIN_AREA
+ || WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (s->w))
+ last_x += WINDOW_RIGHT_FRINGE_WIDTH (s->w);
+ }
- FROM is a pointer to an XrmValue which points to the color name to
- convert. TO is an XrmValue in which to return the pixel color.
+ /* The glyph that may have a right box line. */
+ last_glyph = (s->cmp || s->img
+ ? s->first_glyph
+ : s->first_glyph + s->nchars - 1);
- CLOSURE_RET is a pointer to user-data, in which we record if
- we allocated the color or not.
+ width = abs (s->face->box_line_width);
+ raised_p = s->face->box == FACE_RAISED_BOX;
+ left_x = s->x;
+ right_x = (s->row->full_width_p && s->extends_to_end_of_line_p
+ ? last_x - 1
+ : min (last_x, s->x + s->background_width) - 1);
+ top_y = s->y;
+ bottom_y = top_y + s->height - 1;
- Value is True if successful, False otherwise. */
+ left_p = (s->first_glyph->left_box_line_p
+ || (s->hl == DRAW_MOUSE_FACE
+ && (s->prev == NULL
+ || s->prev->hl != s->hl)));
+ right_p = (last_glyph->right_box_line_p
+ || (s->hl == DRAW_MOUSE_FACE
+ && (s->next == NULL
+ || s->next->hl != s->hl)));
-static Boolean
-cvt_string_to_pixel (dpy, args, nargs, from, to, closure_ret)
- Display *dpy;
- XrmValue *args;
- Cardinal *nargs;
- XrmValue *from, *to;
- XtPointer *closure_ret;
-{
- Screen *screen;
- Colormap cmap;
- Pixel pixel;
- String color_name;
- XColor color;
+ get_glyph_string_clip_rect (s, &clip_rect);
- if (*nargs != 2)
+ if (s->face->box == FACE_SIMPLE_BOX)
+ x_draw_box_rect (s, left_x, top_y, right_x, bottom_y, width,
+ left_p, right_p, &clip_rect);
+ else
{
- XtAppWarningMsg (XtDisplayToApplicationContext (dpy),
- "wrongParameters", "cvt_string_to_pixel",
- "XtToolkitError",
- "Screen and colormap args required", NULL, NULL);
- return False;
+ x_setup_relief_colors (s);
+ x_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y,
+ width, raised_p, left_p, right_p, &clip_rect);
}
+}
- screen = *(Screen **) args[0].addr;
- cmap = *(Colormap *) args[1].addr;
- color_name = (String) from->addr;
- if (strcmp (color_name, XtDefaultBackground) == 0)
- {
- *closure_ret = (XtPointer) False;
- pixel = WhitePixelOfScreen (screen);
- }
- else if (strcmp (color_name, XtDefaultForeground) == 0)
- {
- *closure_ret = (XtPointer) False;
- pixel = BlackPixelOfScreen (screen);
- }
- else if (XParseColor (dpy, cmap, color_name, &color)
- && x_alloc_nearest_color_1 (dpy, cmap, &color))
- {
- pixel = color.pixel;
- *closure_ret = (XtPointer) True;
- }
- else
- {
- String params[1];
- Cardinal nparams = 1;
-
- params[0] = color_name;
- XtAppWarningMsg (XtDisplayToApplicationContext (dpy),
- "badValue", "cvt_string_to_pixel",
- "XtToolkitError", "Invalid color `%s'",
- params, &nparams);
- return False;
- }
+/* Draw foreground of image glyph string S. */
- if (to->addr != NULL)
- {
- if (to->size < sizeof (Pixel))
- {
- to->size = sizeof (Pixel);
- return False;
- }
-
- *(Pixel *) to->addr = pixel;
- }
+static void
+x_draw_image_foreground (s)
+ struct glyph_string *s;
+{
+ int x;
+ int y = s->ybase - image_ascent (s->img, s->face);
+
+ /* If first glyph of S has a left box line, start drawing it to the
+ right of that line. */
+ if (s->face->box != FACE_NO_BOX
+ && s->first_glyph->left_box_line_p)
+ x = s->x + abs (s->face->box_line_width);
else
- {
- cvt_string_to_pixel_value = pixel;
- to->addr = (XtPointer) &cvt_string_to_pixel_value;
- }
-
- to->size = sizeof (Pixel);
- return True;
-}
+ x = s->x;
+ /* If there is a margin around the image, adjust x- and y-position
+ by that margin. */
+ x += s->img->hmargin;
+ y += s->img->vmargin;
-/* Free a pixel color which was previously allocated via
- cvt_string_to_pixel. This is registered as the destructor
- for this type of resource via XtSetTypeConverter.
+ if (s->img->pixmap)
+ {
+ if (s->img->mask)
+ {
+ /* We can't set both a clip mask and use XSetClipRectangles
+ because the latter also sets a clip mask. We also can't
+ trust on the shape extension to be available
+ (XShapeCombineRegion). So, compute the rectangle to draw
+ manually. */
+ unsigned long mask = (GCClipMask | GCClipXOrigin | GCClipYOrigin
+ | GCFunction);
+ XGCValues xgcv;
+ XRectangle clip_rect, image_rect, r;
- APP is the application context in which we work.
+ xgcv.clip_mask = s->img->mask;
+ xgcv.clip_x_origin = x;
+ xgcv.clip_y_origin = y;
+ xgcv.function = GXcopy;
+ XChangeGC (s->display, s->gc, mask, &xgcv);
- TO is a pointer to an XrmValue holding the color to free.
- CLOSURE is the value we stored in CLOSURE_RET for this color
- in cvt_string_to_pixel.
+ get_glyph_string_clip_rect (s, &clip_rect);
+ image_rect.x = x;
+ image_rect.y = y;
+ image_rect.width = s->img->width;
+ image_rect.height = s->img->height;
+ if (x_intersect_rectangles (&clip_rect, &image_rect, &r))
+ XCopyArea (s->display, s->img->pixmap, s->window, s->gc,
+ r.x - x, r.y - y, r.width, r.height, r.x, r.y);
+ }
+ else
+ {
+ XRectangle clip_rect, image_rect, r;
- ARGS and NARGS are like for cvt_string_to_pixel. */
+ get_glyph_string_clip_rect (s, &clip_rect);
+ image_rect.x = x;
+ image_rect.y = y;
+ image_rect.width = s->img->width;
+ image_rect.height = s->img->height;
+ if (x_intersect_rectangles (&clip_rect, &image_rect, &r))
+ XCopyArea (s->display, s->img->pixmap, s->window, s->gc,
+ r.x - x, r.y - y, r.width, r.height, r.x, r.y);
-static void
-cvt_pixel_dtor (app, to, closure, args, nargs)
- XtAppContext app;
- XrmValuePtr to;
- XtPointer closure;
- XrmValuePtr args;
- Cardinal *nargs;
-{
- if (*nargs != 2)
- {
- XtAppWarningMsg (app, "wrongParameters", "cvt_pixel_dtor",
- "XtToolkitError",
- "Screen and colormap arguments required",
- NULL, NULL);
- }
- else if (closure != NULL)
- {
- /* We did allocate the pixel, so free it. */
- Screen *screen = *(Screen **) args[0].addr;
- Colormap cmap = *(Colormap *) args[1].addr;
- x_free_dpy_colors (DisplayOfScreen (screen), screen, cmap,
- (Pixel *) to->addr, 1);
+ /* When the image has a mask, we can expect that at
+ least part of a mouse highlight or a block cursor will
+ be visible. If the image doesn't have a mask, make
+ a block cursor visible by drawing a rectangle around
+ the image. I believe it's looking better if we do
+ nothing here for mouse-face. */
+ if (s->hl == DRAW_CURSOR)
+ {
+ int r = s->img->relief;
+ if (r < 0) r = -r;
+ XDrawRectangle (s->display, s->window, s->gc, x - r, y - r,
+ s->img->width + r*2 - 1, s->img->height + r*2 - 1);
+ }
+ }
}
+ else
+ /* Draw a rectangle if image could not be loaded. */
+ XDrawRectangle (s->display, s->window, s->gc, x, y,
+ s->img->width - 1, s->img->height - 1);
}
-#endif /* USE_X_TOOLKIT */
+/* Draw a relief around the image glyph string S. */
+static void
+x_draw_image_relief (s)
+ struct glyph_string *s;
+{
+ int x0, y0, x1, y1, thick, raised_p;
+ XRectangle r;
+ int x;
+ int y = s->ybase - image_ascent (s->img, s->face);
-/* Value is an array of XColor structures for the contents of the
- color map of display DPY. Set *NCELLS to the size of the array.
- Note that this probably shouldn't be called for large color maps,
- say a 24-bit TrueColor map. */
+ /* If first glyph of S has a left box line, start drawing it to the
+ right of that line. */
+ if (s->face->box != FACE_NO_BOX
+ && s->first_glyph->left_box_line_p)
+ x = s->x + abs (s->face->box_line_width);
+ else
+ x = s->x;
-static const XColor *
-x_color_cells (dpy, ncells)
- Display *dpy;
- int *ncells;
-{
- struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
+ /* If there is a margin around the image, adjust x- and y-position
+ by that margin. */
+ x += s->img->hmargin;
+ y += s->img->vmargin;
- if (dpyinfo->color_cells == NULL)
+ if (s->hl == DRAW_IMAGE_SUNKEN
+ || s->hl == DRAW_IMAGE_RAISED)
{
- Screen *screen = dpyinfo->screen;
- int i;
-
- dpyinfo->ncolor_cells
- = XDisplayCells (dpy, XScreenNumberOfScreen (screen));
- dpyinfo->color_cells
- = (XColor *) xmalloc (dpyinfo->ncolor_cells
- * sizeof *dpyinfo->color_cells);
-
- for (i = 0; i < dpyinfo->ncolor_cells; ++i)
- dpyinfo->color_cells[i].pixel = i;
-
- XQueryColors (dpy, dpyinfo->cmap,
- dpyinfo->color_cells, dpyinfo->ncolor_cells);
+ thick = tool_bar_button_relief >= 0 ? tool_bar_button_relief : DEFAULT_TOOL_BAR_BUTTON_RELIEF;
+ raised_p = s->hl == DRAW_IMAGE_RAISED;
+ }
+ else
+ {
+ thick = abs (s->img->relief);
+ raised_p = s->img->relief > 0;
}
- *ncells = dpyinfo->ncolor_cells;
- return dpyinfo->color_cells;
+ x0 = x - thick;
+ y0 = y - thick;
+ x1 = x + s->img->width + thick - 1;
+ y1 = y + s->img->height + thick - 1;
+
+ x_setup_relief_colors (s);
+ get_glyph_string_clip_rect (s, &r);
+ x_draw_relief_rect (s->f, x0, y0, x1, y1, thick, raised_p, 1, 1, &r);
}
-/* On frame F, translate pixel colors to RGB values for the NCOLORS
- colors in COLORS. Use cached information, if available. */
+/* Draw the foreground of image glyph string S to PIXMAP. */
-void
-x_query_colors (f, colors, ncolors)
- struct frame *f;
- XColor *colors;
- int ncolors;
+static void
+x_draw_image_foreground_1 (s, pixmap)
+ struct glyph_string *s;
+ Pixmap pixmap;
{
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ int x;
+ int y = s->ybase - s->y - image_ascent (s->img, s->face);
- if (dpyinfo->color_cells)
+ /* If first glyph of S has a left box line, start drawing it to the
+ right of that line. */
+ if (s->face->box != FACE_NO_BOX
+ && s->first_glyph->left_box_line_p)
+ x = abs (s->face->box_line_width);
+ else
+ x = 0;
+
+ /* If there is a margin around the image, adjust x- and y-position
+ by that margin. */
+ x += s->img->hmargin;
+ y += s->img->vmargin;
+
+ if (s->img->pixmap)
{
- int i;
- for (i = 0; i < ncolors; ++i)
+ if (s->img->mask)
{
- unsigned long pixel = colors[i].pixel;
- xassert (pixel < dpyinfo->ncolor_cells);
- xassert (dpyinfo->color_cells[pixel].pixel == pixel);
- colors[i] = dpyinfo->color_cells[pixel];
+ /* We can't set both a clip mask and use XSetClipRectangles
+ because the latter also sets a clip mask. We also can't
+ trust on the shape extension to be available
+ (XShapeCombineRegion). So, compute the rectangle to draw
+ manually. */
+ unsigned long mask = (GCClipMask | GCClipXOrigin | GCClipYOrigin
+ | GCFunction);
+ XGCValues xgcv;
+
+ xgcv.clip_mask = s->img->mask;
+ xgcv.clip_x_origin = x;
+ xgcv.clip_y_origin = y;
+ xgcv.function = GXcopy;
+ XChangeGC (s->display, s->gc, mask, &xgcv);
+
+ XCopyArea (s->display, s->img->pixmap, pixmap, s->gc,
+ 0, 0, s->img->width, s->img->height, x, y);
+ XSetClipMask (s->display, s->gc, None);
+ }
+ else
+ {
+ XCopyArea (s->display, s->img->pixmap, pixmap, s->gc,
+ 0, 0, s->img->width, s->img->height, x, y);
+
+ /* When the image has a mask, we can expect that at
+ least part of a mouse highlight or a block cursor will
+ be visible. If the image doesn't have a mask, make
+ a block cursor visible by drawing a rectangle around
+ the image. I believe it's looking better if we do
+ nothing here for mouse-face. */
+ if (s->hl == DRAW_CURSOR)
+ {
+ int r = s->img->relief;
+ if (r < 0) r = -r;
+ XDrawRectangle (s->display, s->window, s->gc, x - r, y - r,
+ s->img->width + r*2 - 1, s->img->height + r*2 - 1);
+ }
}
}
else
- XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), colors, ncolors);
+ /* Draw a rectangle if image could not be loaded. */
+ XDrawRectangle (s->display, pixmap, s->gc, x, y,
+ s->img->width - 1, s->img->height - 1);
}
-/* On frame F, translate pixel color to RGB values for the color in
- COLOR. Use cached information, if available. */
+/* Draw part of the background of glyph string S. X, Y, W, and H
+ give the rectangle to draw. */
-void
-x_query_color (f, color)
- struct frame *f;
- XColor *color;
+static void
+x_draw_glyph_string_bg_rect (s, x, y, w, h)
+ struct glyph_string *s;
+ int x, y, w, h;
{
- x_query_colors (f, color, 1);
-}
-
-
-/* Allocate the color COLOR->pixel on DISPLAY, colormap CMAP. If an
- exact match can't be allocated, try the nearest color available.
- Value is non-zero if successful. Set *COLOR to the color
- allocated. */
-
-static int
-x_alloc_nearest_color_1 (dpy, cmap, color)
- Display *dpy;
- Colormap cmap;
- XColor *color;
-{
- int rc;
-
- rc = XAllocColor (dpy, cmap, color);
- if (rc == 0)
- {
- /* If we got to this point, the colormap is full, so we're going
- to try to get the next closest color. The algorithm used is
- a least-squares matching, which is what X uses for closest
- color matching with StaticColor visuals. */
- int nearest, i;
- unsigned long nearest_delta = ~0;
- int ncells;
- const XColor *cells = x_color_cells (dpy, &ncells);
-
- for (nearest = i = 0; i < ncells; ++i)
- {
- long dred = (color->red >> 8) - (cells[i].red >> 8);
- long dgreen = (color->green >> 8) - (cells[i].green >> 8);
- long dblue = (color->blue >> 8) - (cells[i].blue >> 8);
- unsigned long delta = dred * dred + dgreen * dgreen + dblue * dblue;
-
- if (delta < nearest_delta)
- {
- nearest = i;
- nearest_delta = delta;
- }
- }
-
- color->red = cells[nearest].red;
- color->green = cells[nearest].green;
- color->blue = cells[nearest].blue;
- rc = XAllocColor (dpy, cmap, color);
- }
- else
- {
- /* If allocation succeeded, and the allocated pixel color is not
- equal to a cached pixel color recorded earlier, there was a
- change in the colormap, so clear the color cache. */
- struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
- XColor *cached_color;
-
- if (dpyinfo->color_cells
- && (cached_color = &dpyinfo->color_cells[color->pixel],
- (cached_color->red != color->red
- || cached_color->blue != color->blue
- || cached_color->green != color->green)))
- {
- xfree (dpyinfo->color_cells);
- dpyinfo->color_cells = NULL;
- dpyinfo->ncolor_cells = 0;
- }
- }
-
-#ifdef DEBUG_X_COLORS
- if (rc)
- register_color (color->pixel);
-#endif /* DEBUG_X_COLORS */
-
- return rc;
-}
-
-
-/* Allocate the color COLOR->pixel on frame F, colormap CMAP. If an
- exact match can't be allocated, try the nearest color available.
- Value is non-zero if successful. Set *COLOR to the color
- allocated. */
-
-int
-x_alloc_nearest_color (f, cmap, color)
- struct frame *f;
- Colormap cmap;
- XColor *color;
-{
- gamma_correct (f, color);
- return x_alloc_nearest_color_1 (FRAME_X_DISPLAY (f), cmap, color);
-}
-
-
-/* Allocate color PIXEL on frame F. PIXEL must already be allocated.
- It's necessary to do this instead of just using PIXEL directly to
- get color reference counts right. */
-
-unsigned long
-x_copy_color (f, pixel)
- struct frame *f;
- unsigned long pixel;
-{
- XColor color;
-
- color.pixel = pixel;
- BLOCK_INPUT;
- x_query_color (f, &color);
- XAllocColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), &color);
- UNBLOCK_INPUT;
-#ifdef DEBUG_X_COLORS
- register_color (pixel);
-#endif
- return color.pixel;
-}
-
-
-/* Allocate color PIXEL on display DPY. PIXEL must already be allocated.
- It's necessary to do this instead of just using PIXEL directly to
- get color reference counts right. */
-
-unsigned long
-x_copy_dpy_color (dpy, cmap, pixel)
- Display *dpy;
- Colormap cmap;
- unsigned long pixel;
-{
- XColor color;
-
- color.pixel = pixel;
- BLOCK_INPUT;
- XQueryColor (dpy, cmap, &color);
- XAllocColor (dpy, cmap, &color);
- UNBLOCK_INPUT;
-#ifdef DEBUG_X_COLORS
- register_color (pixel);
-#endif
- return color.pixel;
-}
-
-
-/* Brightness beyond which a color won't have its highlight brightness
- boosted.
-
- Nominally, highlight colors for `3d' faces are calculated by
- brightening an object's color by a constant scale factor, but this
- doesn't yield good results for dark colors, so for colors who's
- brightness is less than this value (on a scale of 0-65535) have an
- use an additional additive factor.
-
- The value here is set so that the default menu-bar/mode-line color
- (grey75) will not have its highlights changed at all. */
-#define HIGHLIGHT_COLOR_DARK_BOOST_LIMIT 48000
-
-
-/* Allocate a color which is lighter or darker than *PIXEL by FACTOR
- or DELTA. Try a color with RGB values multiplied by FACTOR first.
- If this produces the same color as PIXEL, try a color where all RGB
- values have DELTA added. Return the allocated color in *PIXEL.
- DISPLAY is the X display, CMAP is the colormap to operate on.
- Value is non-zero if successful. */
-
-static int
-x_alloc_lighter_color (f, display, cmap, pixel, factor, delta)
- struct frame *f;
- Display *display;
- Colormap cmap;
- unsigned long *pixel;
- double factor;
- int delta;
-{
- XColor color, new;
- long bright;
- int success_p;
-
- /* Get RGB color values. */
- color.pixel = *pixel;
- x_query_color (f, &color);
-
- /* Change RGB values by specified FACTOR. Avoid overflow! */
- xassert (factor >= 0);
- new.red = min (0xffff, factor * color.red);
- new.green = min (0xffff, factor * color.green);
- new.blue = min (0xffff, factor * color.blue);
-
- /* Calculate brightness of COLOR. */
- bright = (2 * color.red + 3 * color.green + color.blue) / 6;
-
- /* We only boost colors that are darker than
- HIGHLIGHT_COLOR_DARK_BOOST_LIMIT. */
- if (bright < HIGHLIGHT_COLOR_DARK_BOOST_LIMIT)
- /* Make an additive adjustment to NEW, because it's dark enough so
- that scaling by FACTOR alone isn't enough. */
- {
- /* How far below the limit this color is (0 - 1, 1 being darker). */
- double dimness = 1 - (double)bright / HIGHLIGHT_COLOR_DARK_BOOST_LIMIT;
- /* The additive adjustment. */
- int min_delta = delta * dimness * factor / 2;
-
- if (factor < 1)
- {
- new.red = max (0, new.red - min_delta);
- new.green = max (0, new.green - min_delta);
- new.blue = max (0, new.blue - min_delta);
- }
- else
- {
- new.red = min (0xffff, min_delta + new.red);
- new.green = min (0xffff, min_delta + new.green);
- new.blue = min (0xffff, min_delta + new.blue);
- }
- }
-
- /* Try to allocate the color. */
- success_p = x_alloc_nearest_color (f, cmap, &new);
- if (success_p)
- {
- if (new.pixel == *pixel)
- {
- /* If we end up with the same color as before, try adding
- delta to the RGB values. */
- x_free_colors (f, &new.pixel, 1);
-
- new.red = min (0xffff, delta + color.red);
- new.green = min (0xffff, delta + color.green);
- new.blue = min (0xffff, delta + color.blue);
- success_p = x_alloc_nearest_color (f, cmap, &new);
- }
- else
- success_p = 1;
- *pixel = new.pixel;
- }
-
- return success_p;
-}
-
-
-/* Set up the foreground color for drawing relief lines of glyph
- string S. RELIEF is a pointer to a struct relief containing the GC
- with which lines will be drawn. Use a color that is FACTOR or
- DELTA lighter or darker than the relief's background which is found
- in S->f->output_data.x->relief_background. If such a color cannot
- be allocated, use DEFAULT_PIXEL, instead. */
-
-static void
-x_setup_relief_color (f, relief, factor, delta, default_pixel)
- struct frame *f;
- struct relief *relief;
- double factor;
- int delta;
- unsigned long default_pixel;
-{
- XGCValues xgcv;
- struct x_output *di = f->output_data.x;
- unsigned long mask = GCForeground | GCLineWidth | GCGraphicsExposures;
- unsigned long pixel;
- unsigned long background = di->relief_background;
- Colormap cmap = FRAME_X_COLORMAP (f);
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
- Display *dpy = FRAME_X_DISPLAY (f);
-
- xgcv.graphics_exposures = False;
- xgcv.line_width = 1;
-
- /* Free previously allocated color. The color cell will be reused
- when it has been freed as many times as it was allocated, so this
- doesn't affect faces using the same colors. */
- if (relief->gc
- && relief->allocated_p)
- {
- x_free_colors (f, &relief->pixel, 1);
- relief->allocated_p = 0;
- }
-
- /* Allocate new color. */
- xgcv.foreground = default_pixel;
- pixel = background;
- if (dpyinfo->n_planes != 1
- && x_alloc_lighter_color (f, dpy, cmap, &pixel, factor, delta))
- {
- relief->allocated_p = 1;
- xgcv.foreground = relief->pixel = pixel;
- }
-
- if (relief->gc == 0)
- {
- xgcv.stipple = dpyinfo->gray;
- mask |= GCStipple;
- relief->gc = XCreateGC (dpy, FRAME_X_WINDOW (f), mask, &xgcv);
- }
- else
- XChangeGC (dpy, relief->gc, mask, &xgcv);
-}
-
-
-/* Set up colors for the relief lines around glyph string S. */
-
-static void
-x_setup_relief_colors (s)
- struct glyph_string *s;
-{
- struct x_output *di = s->f->output_data.x;
- unsigned long color;
-
- if (s->face->use_box_color_for_shadows_p)
- color = s->face->box_color;
- else if (s->first_glyph->type == IMAGE_GLYPH
- && s->img->pixmap
- && !IMAGE_BACKGROUND_TRANSPARENT (s->img, s->f, 0))
- color = IMAGE_BACKGROUND (s->img, s->f, 0);
- else
- {
- XGCValues xgcv;
-
- /* Get the background color of the face. */
- XGetGCValues (s->display, s->gc, GCBackground, &xgcv);
- color = xgcv.background;
- }
-
- if (di->white_relief.gc == 0
- || color != di->relief_background)
- {
- di->relief_background = color;
- x_setup_relief_color (s->f, &di->white_relief, 1.2, 0x8000,
- WHITE_PIX_DEFAULT (s->f));
- x_setup_relief_color (s->f, &di->black_relief, 0.6, 0x4000,
- BLACK_PIX_DEFAULT (s->f));
- }
-}
-
-
-/* Draw a relief on frame F inside the rectangle given by LEFT_X,
- TOP_Y, RIGHT_X, and BOTTOM_Y. WIDTH is the thickness of the relief
- to draw, it must be >= 0. RAISED_P non-zero means draw a raised
- relief. LEFT_P non-zero means draw a relief on the left side of
- the rectangle. RIGHT_P non-zero means draw a relief on the right
- side of the rectangle. CLIP_RECT is the clipping rectangle to use
- when drawing. */
-
-static void
-x_draw_relief_rect (f, left_x, top_y, right_x, bottom_y, width,
- raised_p, left_p, right_p, clip_rect)
- struct frame *f;
- int left_x, top_y, right_x, bottom_y, left_p, right_p, raised_p;
- XRectangle *clip_rect;
-{
- Display *dpy = FRAME_X_DISPLAY (f);
- Window window = FRAME_X_WINDOW (f);
- int i;
- GC gc;
-
- if (raised_p)
- gc = f->output_data.x->white_relief.gc;
- else
- gc = f->output_data.x->black_relief.gc;
- XSetClipRectangles (dpy, gc, 0, 0, clip_rect, 1, Unsorted);
-
- /* Top. */
- for (i = 0; i < width; ++i)
- XDrawLine (dpy, window, gc,
- left_x + i * left_p, top_y + i,
- right_x + 1 - i * right_p, top_y + i);
-
- /* Left. */
- if (left_p)
- for (i = 0; i < width; ++i)
- XDrawLine (dpy, window, gc,
- left_x + i, top_y + i, left_x + i, bottom_y - i + 1);
-
- XSetClipMask (dpy, gc, None);
- if (raised_p)
- gc = f->output_data.x->black_relief.gc;
- else
- gc = f->output_data.x->white_relief.gc;
- XSetClipRectangles (dpy, gc, 0, 0, clip_rect, 1, Unsorted);
-
- /* Bottom. */
- for (i = 0; i < width; ++i)
- XDrawLine (dpy, window, gc,
- left_x + i * left_p, bottom_y - i,
- right_x + 1 - i * right_p, bottom_y - i);
-
- /* Right. */
- if (right_p)
- for (i = 0; i < width; ++i)
- XDrawLine (dpy, window, gc,
- right_x - i, top_y + i + 1, right_x - i, bottom_y - i);
-
- XSetClipMask (dpy, gc, None);
-}
-
-
-/* Draw a box on frame F inside the rectangle given by LEFT_X, TOP_Y,
- RIGHT_X, and BOTTOM_Y. WIDTH is the thickness of the lines to
- draw, it must be >= 0. LEFT_P non-zero means draw a line on the
- left side of the rectangle. RIGHT_P non-zero means draw a line
- on the right side of the rectangle. CLIP_RECT is the clipping
- rectangle to use when drawing. */
-
-static void
-x_draw_box_rect (s, left_x, top_y, right_x, bottom_y, width,
- left_p, right_p, clip_rect)
- struct glyph_string *s;
- int left_x, top_y, right_x, bottom_y, left_p, right_p;
- XRectangle *clip_rect;
-{
- XGCValues xgcv;
-
- XGetGCValues (s->display, s->gc, GCForeground, &xgcv);
- XSetForeground (s->display, s->gc, s->face->box_color);
- XSetClipRectangles (s->display, s->gc, 0, 0, clip_rect, 1, Unsorted);
-
- /* Top. */
- XFillRectangle (s->display, s->window, s->gc,
- left_x, top_y, right_x - left_x + 1, width);
-
- /* Left. */
- if (left_p)
- XFillRectangle (s->display, s->window, s->gc,
- left_x, top_y, width, bottom_y - top_y + 1);
-
- /* Bottom. */
- XFillRectangle (s->display, s->window, s->gc,
- left_x, bottom_y - width + 1, right_x - left_x + 1, width);
-
- /* Right. */
- if (right_p)
- XFillRectangle (s->display, s->window, s->gc,
- right_x - width + 1, top_y, width, bottom_y - top_y + 1);
-
- XSetForeground (s->display, s->gc, xgcv.foreground);
- XSetClipMask (s->display, s->gc, None);
-}
-
-
-/* Draw a box around glyph string S. */
-
-static void
-x_draw_glyph_string_box (s)
- struct glyph_string *s;
-{
- int width, left_x, right_x, top_y, bottom_y, last_x, raised_p;
- int left_p, right_p;
- struct glyph *last_glyph;
- XRectangle clip_rect;
-
- last_x = window_box_right (s->w, s->area);
- if (s->row->full_width_p
- && !s->w->pseudo_window_p)
- {
- last_x += FRAME_X_RIGHT_FRINGE_WIDTH (s->f);
- if (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (s->f))
- last_x += FRAME_SCROLL_BAR_WIDTH (s->f) * CANON_X_UNIT (s->f);
- }
-
- /* The glyph that may have a right box line. */
- last_glyph = (s->cmp || s->img
- ? s->first_glyph
- : s->first_glyph + s->nchars - 1);
-
- width = abs (s->face->box_line_width);
- raised_p = s->face->box == FACE_RAISED_BOX;
- left_x = s->x;
- right_x = (s->row->full_width_p && s->extends_to_end_of_line_p
- ? last_x - 1
- : min (last_x, s->x + s->background_width) - 1);
- top_y = s->y;
- bottom_y = top_y + s->height - 1;
-
- left_p = (s->first_glyph->left_box_line_p
- || (s->hl == DRAW_MOUSE_FACE
- && (s->prev == NULL
- || s->prev->hl != s->hl)));
- right_p = (last_glyph->right_box_line_p
- || (s->hl == DRAW_MOUSE_FACE
- && (s->next == NULL
- || s->next->hl != s->hl)));
-
- x_get_glyph_string_clip_rect (s, &clip_rect);
-
- if (s->face->box == FACE_SIMPLE_BOX)
- x_draw_box_rect (s, left_x, top_y, right_x, bottom_y, width,
- left_p, right_p, &clip_rect);
- else
- {
- x_setup_relief_colors (s);
- x_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y,
- width, raised_p, left_p, right_p, &clip_rect);
- }
-}
-
-
-/* Draw foreground of image glyph string S. */
-
-static void
-x_draw_image_foreground (s)
- struct glyph_string *s;
-{
- int x;
- int y = s->ybase - image_ascent (s->img, s->face);
-
- /* If first glyph of S has a left box line, start drawing it to the
- right of that line. */
- if (s->face->box != FACE_NO_BOX
- && s->first_glyph->left_box_line_p)
- x = s->x + abs (s->face->box_line_width);
- else
- x = s->x;
-
- /* If there is a margin around the image, adjust x- and y-position
- by that margin. */
- x += s->img->hmargin;
- y += s->img->vmargin;
-
- if (s->img->pixmap)
- {
- if (s->img->mask)
- {
- /* We can't set both a clip mask and use XSetClipRectangles
- because the latter also sets a clip mask. We also can't
- trust on the shape extension to be available
- (XShapeCombineRegion). So, compute the rectangle to draw
- manually. */
- unsigned long mask = (GCClipMask | GCClipXOrigin | GCClipYOrigin
- | GCFunction);
- XGCValues xgcv;
- XRectangle clip_rect, image_rect, r;
-
- xgcv.clip_mask = s->img->mask;
- xgcv.clip_x_origin = x;
- xgcv.clip_y_origin = y;
- xgcv.function = GXcopy;
- XChangeGC (s->display, s->gc, mask, &xgcv);
-
- x_get_glyph_string_clip_rect (s, &clip_rect);
- image_rect.x = x;
- image_rect.y = y;
- image_rect.width = s->img->width;
- image_rect.height = s->img->height;
- if (x_intersect_rectangles (&clip_rect, &image_rect, &r))
- XCopyArea (s->display, s->img->pixmap, s->window, s->gc,
- r.x - x, r.y - y, r.width, r.height, r.x, r.y);
- }
- else
- {
- XRectangle clip_rect, image_rect, r;
-
- x_get_glyph_string_clip_rect (s, &clip_rect);
- image_rect.x = x;
- image_rect.y = y;
- image_rect.width = s->img->width;
- image_rect.height = s->img->height;
- if (x_intersect_rectangles (&clip_rect, &image_rect, &r))
- XCopyArea (s->display, s->img->pixmap, s->window, s->gc,
- r.x - x, r.y - y, r.width, r.height, r.x, r.y);
-
- /* When the image has a mask, we can expect that at
- least part of a mouse highlight or a block cursor will
- be visible. If the image doesn't have a mask, make
- a block cursor visible by drawing a rectangle around
- the image. I believe it's looking better if we do
- nothing here for mouse-face. */
- if (s->hl == DRAW_CURSOR)
- XDrawRectangle (s->display, s->window, s->gc, x, y,
- s->img->width - 1, s->img->height - 1);
- }
- }
- else
- /* Draw a rectangle if image could not be loaded. */
- XDrawRectangle (s->display, s->window, s->gc, x, y,
- s->img->width - 1, s->img->height - 1);
-}
-
-
-/* Draw a relief around the image glyph string S. */
-
-static void
-x_draw_image_relief (s)
- struct glyph_string *s;
-{
- int x0, y0, x1, y1, thick, raised_p;
- XRectangle r;
- int x;
- int y = s->ybase - image_ascent (s->img, s->face);
-
- /* If first glyph of S has a left box line, start drawing it to the
- right of that line. */
- if (s->face->box != FACE_NO_BOX
- && s->first_glyph->left_box_line_p)
- x = s->x + abs (s->face->box_line_width);
- else
- x = s->x;
-
- /* If there is a margin around the image, adjust x- and y-position
- by that margin. */
- x += s->img->hmargin;
- y += s->img->vmargin;
-
- if (s->hl == DRAW_IMAGE_SUNKEN
- || s->hl == DRAW_IMAGE_RAISED)
- {
- thick = tool_bar_button_relief >= 0 ? tool_bar_button_relief : DEFAULT_TOOL_BAR_BUTTON_RELIEF;
- raised_p = s->hl == DRAW_IMAGE_RAISED;
- }
- else
- {
- thick = abs (s->img->relief);
- raised_p = s->img->relief > 0;
- }
-
- x0 = x - thick;
- y0 = y - thick;
- x1 = x + s->img->width + thick - 1;
- y1 = y + s->img->height + thick - 1;
-
- x_setup_relief_colors (s);
- x_get_glyph_string_clip_rect (s, &r);
- x_draw_relief_rect (s->f, x0, y0, x1, y1, thick, raised_p, 1, 1, &r);
-}
-
-
-/* Draw the foreground of image glyph string S to PIXMAP. */
-
-static void
-x_draw_image_foreground_1 (s, pixmap)
- struct glyph_string *s;
- Pixmap pixmap;
-{
- int x;
- int y = s->ybase - s->y - image_ascent (s->img, s->face);
-
- /* If first glyph of S has a left box line, start drawing it to the
- right of that line. */
- if (s->face->box != FACE_NO_BOX
- && s->first_glyph->left_box_line_p)
- x = abs (s->face->box_line_width);
- else
- x = 0;
-
- /* If there is a margin around the image, adjust x- and y-position
- by that margin. */
- x += s->img->hmargin;
- y += s->img->vmargin;
-
- if (s->img->pixmap)
- {
- if (s->img->mask)
- {
- /* We can't set both a clip mask and use XSetClipRectangles
- because the latter also sets a clip mask. We also can't
- trust on the shape extension to be available
- (XShapeCombineRegion). So, compute the rectangle to draw
- manually. */
- unsigned long mask = (GCClipMask | GCClipXOrigin | GCClipYOrigin
- | GCFunction);
- XGCValues xgcv;
-
- xgcv.clip_mask = s->img->mask;
- xgcv.clip_x_origin = x;
- xgcv.clip_y_origin = y;
- xgcv.function = GXcopy;
- XChangeGC (s->display, s->gc, mask, &xgcv);
-
- XCopyArea (s->display, s->img->pixmap, pixmap, s->gc,
- 0, 0, s->img->width, s->img->height, x, y);
- XSetClipMask (s->display, s->gc, None);
- }
- else
- {
- XCopyArea (s->display, s->img->pixmap, pixmap, s->gc,
- 0, 0, s->img->width, s->img->height, x, y);
-
- /* When the image has a mask, we can expect that at
- least part of a mouse highlight or a block cursor will
- be visible. If the image doesn't have a mask, make
- a block cursor visible by drawing a rectangle around
- the image. I believe it's looking better if we do
- nothing here for mouse-face. */
- if (s->hl == DRAW_CURSOR)
- XDrawRectangle (s->display, pixmap, s->gc, x, y,
- s->img->width - 1, s->img->height - 1);
- }
- }
- else
- /* Draw a rectangle if image could not be loaded. */
- XDrawRectangle (s->display, pixmap, s->gc, x, y,
- s->img->width - 1, s->img->height - 1);
-}
-
-
-/* Draw part of the background of glyph string S. X, Y, W, and H
- give the rectangle to draw. */
-
-static void
-x_draw_glyph_string_bg_rect (s, x, y, w, h)
- struct glyph_string *s;
- int x, y, w, h;
-{
- if (s->stippled_p)
- {
- /* Fill background with a stipple pattern. */
- XSetFillStyle (s->display, s->gc, FillOpaqueStippled);
- XFillRectangle (s->display, s->window, s->gc, x, y, w, h);
- XSetFillStyle (s->display, s->gc, FillSolid);
- }
- else
- x_clear_glyph_string_rect (s, x, y, w, h);
-}
-
-
-/* Draw image glyph string S.
-
- s->y
- s->x +-------------------------
- | s->face->box
- |
- | +-------------------------
- | | s->img->margin
- | |
- | | +-------------------
- | | | the image
-
- */
-
-static void
-x_draw_image_glyph_string (s)
- struct glyph_string *s;
-{
- int x, y;
- int box_line_hwidth = abs (s->face->box_line_width);
- int box_line_vwidth = max (s->face->box_line_width, 0);
- int height;
- Pixmap pixmap = None;
-
- height = s->height - 2 * box_line_vwidth;
-
- /* Fill background with face under the image. Do it only if row is
- taller than image or if image has a clip mask to reduce
- flickering. */
- s->stippled_p = s->face->stipple != 0;
- if (height > s->img->height
- || s->img->hmargin
- || s->img->vmargin
- || s->img->mask
- || s->img->pixmap == 0
- || s->width != s->background_width)
- {
- if (box_line_hwidth && s->first_glyph->left_box_line_p)
- x = s->x + box_line_hwidth;
- else
- x = s->x;
-
- y = s->y + box_line_vwidth;
-
- if (s->img->mask)
- {
- /* Create a pixmap as large as the glyph string. Fill it
- with the background color. Copy the image to it, using
- its mask. Copy the temporary pixmap to the display. */
- Screen *screen = FRAME_X_SCREEN (s->f);
- int depth = DefaultDepthOfScreen (screen);
-
- /* Create a pixmap as large as the glyph string. */
- pixmap = XCreatePixmap (s->display, s->window,
- s->background_width,
- s->height, depth);
-
- /* Don't clip in the following because we're working on the
- pixmap. */
- XSetClipMask (s->display, s->gc, None);
-
- /* Fill the pixmap with the background color/stipple. */
- if (s->stippled_p)
- {
- /* Fill background with a stipple pattern. */
- XSetFillStyle (s->display, s->gc, FillOpaqueStippled);
- XFillRectangle (s->display, pixmap, s->gc,
- 0, 0, s->background_width, s->height);
- XSetFillStyle (s->display, s->gc, FillSolid);
- }
- else
- {
- XGCValues xgcv;
- XGetGCValues (s->display, s->gc, GCForeground | GCBackground,
- &xgcv);
- XSetForeground (s->display, s->gc, xgcv.background);
- XFillRectangle (s->display, pixmap, s->gc,
- 0, 0, s->background_width, s->height);
- XSetForeground (s->display, s->gc, xgcv.foreground);
- }
- }
- else
- x_draw_glyph_string_bg_rect (s, x, y, s->background_width, height);
-
- s->background_filled_p = 1;
- }
-
- /* Draw the foreground. */
- if (pixmap != None)
- {
- x_draw_image_foreground_1 (s, pixmap);
- x_set_glyph_string_clipping (s);
- XCopyArea (s->display, pixmap, s->window, s->gc,
- 0, 0, s->background_width, s->height, s->x, s->y);
- XFreePixmap (s->display, pixmap);
- }
- else
- x_draw_image_foreground (s);
-
- /* If we must draw a relief around the image, do it. */
- if (s->img->relief
- || s->hl == DRAW_IMAGE_RAISED
- || s->hl == DRAW_IMAGE_SUNKEN)
- x_draw_image_relief (s);
-}
-
-
-/* Draw stretch glyph string S. */
-
-static void
-x_draw_stretch_glyph_string (s)
- struct glyph_string *s;
-{
- xassert (s->first_glyph->type == STRETCH_GLYPH);
- s->stippled_p = s->face->stipple != 0;
-
- if (s->hl == DRAW_CURSOR
- && !x_stretch_cursor_p)
- {
- /* If `x-stretch-block-cursor' is nil, don't draw a block cursor
- as wide as the stretch glyph. */
- int width = min (CANON_X_UNIT (s->f), s->background_width);
-
- /* Draw cursor. */
- x_draw_glyph_string_bg_rect (s, s->x, s->y, width, s->height);
-
- /* Clear rest using the GC of the original non-cursor face. */
- if (width < s->background_width)
- {
- int x = s->x + width, y = s->y;
- int w = s->background_width - width, h = s->height;
- XRectangle r;
- GC gc;
-
- if (s->row->mouse_face_p
- && cursor_in_mouse_face_p (s->w))
- {
- x_set_mouse_face_gc (s);
- gc = s->gc;
- }
- else
- gc = s->face->gc;
-
- x_get_glyph_string_clip_rect (s, &r);
- XSetClipRectangles (s->display, gc, 0, 0, &r, 1, Unsorted);
-
- if (s->face->stipple)
- {
- /* Fill background with a stipple pattern. */
- XSetFillStyle (s->display, gc, FillOpaqueStippled);
- XFillRectangle (s->display, s->window, gc, x, y, w, h);
- XSetFillStyle (s->display, gc, FillSolid);
- }
- else
- {
- XGCValues xgcv;
- XGetGCValues (s->display, gc, GCForeground | GCBackground, &xgcv);
- XSetForeground (s->display, gc, xgcv.background);
- XFillRectangle (s->display, s->window, gc, x, y, w, h);
- XSetForeground (s->display, gc, xgcv.foreground);
- }
- }
- }
- else if (!s->background_filled_p)
- x_draw_glyph_string_bg_rect (s, s->x, s->y, s->background_width,
- s->height);
-
- s->background_filled_p = 1;
-}
-
-
-/* Draw glyph string S. */
-
-static void
-x_draw_glyph_string (s)
- struct glyph_string *s;
-{
- 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.
- This makes S->next use XDrawString instead of XDrawImageString. */
- if (s->next && s->right_overhang && !s->for_overlaps_p)
- {
- 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);
- }
-
- /* Set up S->gc, set clipping and draw S. */
- x_set_glyph_string_gc (s);
-
- /* Draw relief (if any) in advance for char/composition so that the
- glyph string can be drawn over it. */
- if (!s->for_overlaps_p
- && s->face->box != FACE_NO_BOX
- && (s->first_glyph->type == CHAR_GLYPH
- || s->first_glyph->type == COMPOSITE_GLYPH))
-
- {
- x_set_glyph_string_clipping (s);
- x_draw_glyph_string_background (s, 1);
- x_draw_glyph_string_box (s);
- x_set_glyph_string_clipping (s);
- relief_drawn_p = 1;
- }
- else
- x_set_glyph_string_clipping (s);
-
- switch (s->first_glyph->type)
- {
- case IMAGE_GLYPH:
- x_draw_image_glyph_string (s);
- break;
-
- case STRETCH_GLYPH:
- x_draw_stretch_glyph_string (s);
- break;
-
- case CHAR_GLYPH:
- if (s->for_overlaps_p)
- s->background_filled_p = 1;
- else
- x_draw_glyph_string_background (s, 0);
- x_draw_glyph_string_foreground (s);
- break;
-
- case COMPOSITE_GLYPH:
- if (s->for_overlaps_p || s->gidx > 0)
- s->background_filled_p = 1;
- else
- x_draw_glyph_string_background (s, 1);
- x_draw_composite_glyph_string_foreground (s);
- break;
-
- default:
- abort ();
- }
-
- if (!s->for_overlaps_p)
- {
- /* Draw underline. */
- if (s->face->underline_p)
- {
- unsigned long tem, h;
- int y;
-
- /* Get the underline thickness. Default is 1 pixel. */
- if (!XGetFontProperty (s->font, XA_UNDERLINE_THICKNESS, &h))
- h = 1;
-
- /* 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;
- else
- y = s->y + s->height - h;
-
- if (s->face->underline_defaulted_p)
- XFillRectangle (s->display, s->window, s->gc,
- s->x, y, s->width, h);
- else
- {
- XGCValues xgcv;
- XGetGCValues (s->display, s->gc, GCForeground, &xgcv);
- XSetForeground (s->display, s->gc, s->face->underline_color);
- XFillRectangle (s->display, s->window, s->gc,
- s->x, y, s->width, h);
- XSetForeground (s->display, s->gc, xgcv.foreground);
- }
- }
-
- /* Draw overline. */
- if (s->face->overline_p)
- {
- unsigned long dy = 0, h = 1;
-
- if (s->face->overline_color_defaulted_p)
- XFillRectangle (s->display, s->window, s->gc, s->x, s->y + dy,
- s->width, h);
- else
- {
- XGCValues xgcv;
- XGetGCValues (s->display, s->gc, GCForeground, &xgcv);
- XSetForeground (s->display, s->gc, s->face->overline_color);
- XFillRectangle (s->display, s->window, s->gc, s->x, s->y + dy,
- s->width, h);
- XSetForeground (s->display, s->gc, xgcv.foreground);
- }
- }
-
- /* Draw strike-through. */
- if (s->face->strike_through_p)
- {
- unsigned long h = 1;
- unsigned long dy = (s->height - h) / 2;
-
- if (s->face->strike_through_color_defaulted_p)
- XFillRectangle (s->display, s->window, s->gc, s->x, s->y + dy,
- s->width, h);
- else
- {
- XGCValues xgcv;
- XGetGCValues (s->display, s->gc, GCForeground, &xgcv);
- XSetForeground (s->display, s->gc, s->face->strike_through_color);
- XFillRectangle (s->display, s->window, s->gc, s->x, s->y + dy,
- s->width, h);
- XSetForeground (s->display, s->gc, xgcv.foreground);
- }
- }
-
- /* Draw relief if not yet drawn. */
- if (!relief_drawn_p && s->face->box != FACE_NO_BOX)
- x_draw_glyph_string_box (s);
- }
-
- /* Reset clipping. */
- XSetClipMask (s->display, s->gc, None);
-}
-
-
-static int x_fill_composite_glyph_string P_ ((struct glyph_string *,
- struct face **, int));
-
-
-/* Fill glyph string S with composition components specified by S->cmp.
-
- FACES is an array of faces for all components of this composition.
- S->gidx is the index of the first component for S.
- OVERLAPS_P non-zero means S should draw the foreground only, and
- use its physical height for clipping.
-
- Value is the index of a component not in S. */
-
-static int
-x_fill_composite_glyph_string (s, faces, overlaps_p)
- struct glyph_string *s;
- struct face **faces;
- int overlaps_p;
-{
- int i;
-
- xassert (s);
-
- s->for_overlaps_p = overlaps_p;
-
- s->face = faces[s->gidx];
- s->font = s->face->font;
- s->font_info = FONT_INFO_FROM_ID (s->f, s->face->font_info_id);
-
- /* 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;
-
- /* 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
- the glyph string so that we can draw rectangles for the
- characters of the glyph string. */
- if (s->font == NULL)
- {
- s->font_not_found_p = 1;
- s->font = FRAME_FONT (s->f);
- }
-
- /* 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;
-
- return s->gidx + s->nchars;
-}
-
-
-/* Fill glyph string S from a sequence of character glyphs.
-
- FACE_ID is the face id of the string. START is the index of the
- first glyph to consider, END is the index of the last + 1.
- OVERLAPS_P non-zero means S should draw the foreground only, and
- use its physical height for clipping.
-
- Value is the index of the first glyph not in S. */
-
-static int
-x_fill_glyph_string (s, face_id, start, end, overlaps_p)
- struct glyph_string *s;
- int face_id;
- int start, end, overlaps_p;
-{
- struct glyph *glyph, *last;
- int voffset;
- int glyph_not_available_p;
-
- xassert (s->f == XFRAME (s->w->frame));
- xassert (s->nchars == 0);
- xassert (start >= 0 && end > start);
-
- s->for_overlaps_p = overlaps_p,
- glyph = s->row->glyphs[s->area] + start;
- last = s->row->glyphs[s->area] + end;
- voffset = glyph->voffset;
-
- glyph_not_available_p = glyph->glyph_not_available_p;
-
- while (glyph < last
- && glyph->type == CHAR_GLYPH
- && glyph->voffset == voffset
- /* Same face id implies same font, nowadays. */
- && glyph->face_id == face_id
- && glyph->glyph_not_available_p == glyph_not_available_p)
- {
- int two_byte_p;
-
- s->face = x_get_glyph_face_and_encoding (s->f, glyph,
- s->char2b + s->nchars,
- &two_byte_p);
- s->two_byte_p = two_byte_p;
- ++s->nchars;
- xassert (s->nchars <= end - start);
- s->width += glyph->pixel_width;
- ++glyph;
- }
-
- s->font = s->face->font;
- s->font_info = FONT_INFO_FROM_ID (s->f, s->face->font_info_id);
-
- /* If the specified font could not be loaded, use the frame's font,
- but record the fact that we couldn't load it in
- S->font_not_found_p so that we can draw rectangles for the
- characters of the glyph string. */
- if (s->font == NULL || glyph_not_available_p)
- {
- s->font_not_found_p = 1;
- s->font = FRAME_FONT (s->f);
- }
-
- /* Adjust base line for subscript/superscript text. */
- s->ybase += voffset;
-
- xassert (s->face && s->face->gc);
- return glyph - s->row->glyphs[s->area];
-}
-
-
-/* Fill glyph string S from image glyph S->first_glyph. */
-
-static void
-x_fill_image_glyph_string (s)
- struct glyph_string *s;
-{
- xassert (s->first_glyph->type == IMAGE_GLYPH);
- s->img = IMAGE_FROM_ID (s->f, s->first_glyph->u.img_id);
- xassert (s->img);
- s->face = FACE_FROM_ID (s->f, s->first_glyph->face_id);
- s->font = s->face->font;
- s->width = s->first_glyph->pixel_width;
-
- /* Adjust base line for subscript/superscript text. */
- s->ybase += s->first_glyph->voffset;
-}
-
-
-/* Fill glyph string S from a sequence of stretch glyphs.
-
- ROW is the glyph row in which the glyphs are found, AREA is the
- area within the row. START is the index of the first glyph to
- consider, END is the index of the last + 1.
-
- Value is the index of the first glyph not in S. */
-
-static int
-x_fill_stretch_glyph_string (s, row, area, start, end)
- struct glyph_string *s;
- struct glyph_row *row;
- enum glyph_row_area area;
- int start, end;
-{
- struct glyph *glyph, *last;
- int voffset, face_id;
-
- xassert (s->first_glyph->type == STRETCH_GLYPH);
-
- glyph = s->row->glyphs[s->area] + start;
- last = s->row->glyphs[s->area] + end;
- 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->width = glyph->pixel_width;
- voffset = glyph->voffset;
-
- for (++glyph;
- (glyph < last
- && glyph->type == STRETCH_GLYPH
- && glyph->voffset == voffset
- && glyph->face_id == face_id);
- ++glyph)
- s->width += glyph->pixel_width;
-
- /* Adjust base line for subscript/superscript text. */
- s->ybase += voffset;
-
- /* The case that face->gc == 0 is handled when drawing the glyph
- string by calling PREPARE_FACE_FOR_DISPLAY. */
- xassert (s->face);
- return glyph - s->row->glyphs[s->area];
-}
-
-
-/* Initialize glyph string S. CHAR2B is a suitably allocated vector
- of XChar2b structures for S; it can't be allocated in
- x_init_glyph_string because it must be allocated via `alloca'. W
- is the window on which S is drawn. ROW and AREA are the glyph row
- and area within the row from which S is constructed. START is the
- index of the first glyph structure covered by S. HL is a
- face-override for drawing S. */
-
-static void
-x_init_glyph_string (s, char2b, w, row, area, start, hl)
- struct glyph_string *s;
- XChar2b *char2b;
- struct window *w;
- struct glyph_row *row;
- enum glyph_row_area area;
- int start;
- enum draw_glyphs_face hl;
-{
- bzero (s, sizeof *s);
- s->w = w;
- s->f = XFRAME (w->frame);
- s->display = FRAME_X_DISPLAY (s->f);
- s->window = FRAME_X_WINDOW (s->f);
- s->char2b = char2b;
- s->hl = hl;
- s->row = row;
- s->area = area;
- s->first_glyph = row->glyphs[area] + start;
- s->height = row->height;
- s->y = WINDOW_TO_FRAME_PIXEL_Y (w, row->y);
-
- /* Display the internal border below the tool-bar window. */
- if (s->w == XWINDOW (s->f->tool_bar_window))
- s->y -= s->f->output_data.x->internal_border_width;
-
- s->ybase = s->y + row->ascent;
-}
-
-
-/* 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. */
-
-static INLINE void
-x_set_glyph_string_background_width (s, start, last_x)
- struct glyph_string *s;
- int start;
- int last_x;
-{
- /* If the face of this glyph string has to be drawn to the end of
- the drawing area, set S->extends_to_end_of_line_p. */
- struct face *default_face = FACE_FROM_ID (s->f, DEFAULT_FACE_ID);
-
- if (start == s->row->used[s->area]
- && s->area == TEXT_AREA
- && ((s->hl == DRAW_NORMAL_TEXT
- && (s->row->fill_line_p
- || s->face->background != default_face->background
- || s->face->stipple != default_face->stipple
- || s->row->mouse_face_p))
- || s->hl == DRAW_MOUSE_FACE
- || ((s->hl == DRAW_IMAGE_RAISED || s->hl == DRAW_IMAGE_SUNKEN)
- && s->row->fill_line_p)))
- s->extends_to_end_of_line_p = 1;
-
- /* If S extends its face to the end of the line, set its
- background_width to the distance to the right edge of the drawing
- area. */
- if (s->extends_to_end_of_line_p)
- s->background_width = last_x - s->x + 1;
- else
- s->background_width = s->width;
-}
-
-
-/* Add a glyph string for a stretch glyph to the list of strings
- between HEAD and TAIL. START is the index of the stretch glyph in
- row area AREA of glyph row ROW. END is the index of the last glyph
- in that glyph row area. X is the current output position assigned
- to the new glyph string constructed. HL overrides that face of the
- glyph; e.g. it is DRAW_CURSOR if a cursor has to be drawn. LAST_X
- is the right-most x-position of the drawing area. */
-
-/* SunOS 4 bundled cc, barfed on continuations in the arg lists here
- and below -- keep them on one line. */
-#define BUILD_STRETCH_GLYPH_STRING(W, ROW, AREA, START, END, HEAD, TAIL, HL, X, LAST_X) \
- do \
- { \
- s = (struct glyph_string *) alloca (sizeof *s); \
- x_init_glyph_string (s, NULL, W, ROW, AREA, START, HL); \
- START = x_fill_stretch_glyph_string (s, ROW, AREA, START, END); \
- x_append_glyph_string (&HEAD, &TAIL, s); \
- s->x = (X); \
- } \
- while (0)
-
-
-/* Add a glyph string for an image glyph to the list of strings
- between HEAD and TAIL. START is the index of the image glyph in
- row area AREA of glyph row ROW. END is the index of the last glyph
- in that glyph row area. X is the current output position assigned
- to the new glyph string constructed. HL overrides that face of the
- glyph; e.g. it is DRAW_CURSOR if a cursor has to be drawn. LAST_X
- is the right-most x-position of the drawing area. */
-
-#define BUILD_IMAGE_GLYPH_STRING(W, ROW, AREA, START, END, HEAD, TAIL, HL, X, LAST_X) \
- do \
- { \
- s = (struct glyph_string *) alloca (sizeof *s); \
- x_init_glyph_string (s, NULL, W, ROW, AREA, START, HL); \
- x_fill_image_glyph_string (s); \
- x_append_glyph_string (&HEAD, &TAIL, s); \
- ++START; \
- s->x = (X); \
- } \
- while (0)
-
-
-/* Add a glyph string for a sequence of character glyphs to the list
- of strings between HEAD and TAIL. START is the index of the first
- glyph in row area AREA of glyph row ROW that is part of the new
- glyph string. END is the index of the last glyph in that glyph row
- area. X is the current output position assigned to the new glyph
- string constructed. HL overrides that face of the glyph; e.g. it
- is DRAW_CURSOR if a cursor has to be drawn. LAST_X is the
- right-most x-position of the drawing area. */
-
-#define BUILD_CHAR_GLYPH_STRINGS(W, ROW, AREA, START, END, HEAD, TAIL, HL, X, LAST_X, OVERLAPS_P) \
- do \
- { \
- int c, 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); \
- char2b = (XChar2b *) alloca ((END - START) * sizeof *char2b); \
- x_init_glyph_string (s, char2b, W, ROW, AREA, START, HL); \
- x_append_glyph_string (&HEAD, &TAIL, s); \
- s->x = (X); \
- START = x_fill_glyph_string (s, face_id, START, END, \
- OVERLAPS_P); \
- } \
- while (0)
-
-
-/* Add a glyph string for a composite sequence to the list of strings
- between HEAD and TAIL. START is the index of the first glyph in
- row area AREA of glyph row ROW that is part of the new glyph
- string. END is the index of the last glyph in that glyph row area.
- X is the current output position assigned to the new glyph string
- constructed. HL overrides that face of the glyph; e.g. it is
- DRAW_CURSOR if a cursor has to be drawn. LAST_X is the right-most
- x-position of the drawing area. */
-
-#define BUILD_COMPOSITE_GLYPH_STRING(W, ROW, AREA, START, END, HEAD, TAIL, HL, X, LAST_X, OVERLAPS_P) \
- 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 (XFRAME (w->frame), 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 (XFRAME (w->frame), base_face, c); \
- faces[n] = FACE_FROM_ID (XFRAME (w->frame), this_face_id); \
- x_get_char_face_and_encoding (XFRAME (w->frame), c, \
- this_face_id, char2b + n, 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); \
- x_init_glyph_string (s, char2b + n, W, ROW, AREA, START, HL); \
- x_append_glyph_string (&(HEAD), &(TAIL), s); \
- s->cmp = cmp; \
- s->gidx = n; \
- s->x = (X); \
- \
- if (n == 0) \
- first_s = s; \
- \
- n = x_fill_composite_glyph_string (s, faces, OVERLAPS_P); \
- } \
- \
- ++START; \
- s = first_s; \
- } while (0)
-
-
-/* Build a list of glyph strings between HEAD and TAIL for the glyphs
- of AREA of glyph row ROW on window W between indices START and END.
- HL overrides the face for drawing glyph strings, e.g. it is
- DRAW_CURSOR to draw a cursor. X and LAST_X are start and end
- x-positions of the drawing area.
-
- This is an ugly monster macro construct because we must use alloca
- to allocate glyph strings (because x_draw_glyphs can be called
- asynchronously). */
-
-#define BUILD_GLYPH_STRINGS(W, ROW, AREA, START, END, HEAD, TAIL, HL, X, LAST_X, OVERLAPS_P) \
- do \
- { \
- HEAD = TAIL = NULL; \
- while (START < END) \
- { \
- struct glyph *first_glyph = (ROW)->glyphs[AREA] + START; \
- switch (first_glyph->type) \
- { \
- case CHAR_GLYPH: \
- BUILD_CHAR_GLYPH_STRINGS (W, ROW, AREA, START, END, HEAD, \
- TAIL, HL, X, LAST_X, \
- OVERLAPS_P); \
- break; \
- \
- case COMPOSITE_GLYPH: \
- BUILD_COMPOSITE_GLYPH_STRING (W, ROW, AREA, START, END, \
- HEAD, TAIL, HL, X, LAST_X,\
- OVERLAPS_P); \
- break; \
- \
- case STRETCH_GLYPH: \
- BUILD_STRETCH_GLYPH_STRING (W, ROW, AREA, START, END, \
- HEAD, TAIL, HL, X, LAST_X); \
- break; \
- \
- case IMAGE_GLYPH: \
- BUILD_IMAGE_GLYPH_STRING (W, ROW, AREA, START, END, HEAD, \
- TAIL, HL, X, LAST_X); \
- break; \
- \
- default: \
- abort (); \
- } \
- \
- x_set_glyph_string_background_width (s, START, LAST_X); \
- (X) += s->width; \
- } \
- } \
- while (0)
-
-
-/* Draw glyphs between START and END in AREA of ROW on window W,
- starting at x-position X. X is relative to AREA in W. HL is a
- face-override with the following meaning:
-
- DRAW_NORMAL_TEXT draw normally
- DRAW_CURSOR draw in cursor face
- DRAW_MOUSE_FACE draw in mouse face.
- DRAW_INVERSE_VIDEO draw in mode line face
- DRAW_IMAGE_SUNKEN draw an image with a sunken relief around it
- DRAW_IMAGE_RAISED draw an image with a raised relief around it
-
- If OVERLAPS_P is non-zero, draw only the foreground of characters
- and clip to the physical height of ROW.
-
- Value is the x-position reached, relative to AREA of W. */
-
-static int
-x_draw_glyphs (w, x, row, area, start, end, hl, overlaps_p)
- struct window *w;
- int x;
- struct glyph_row *row;
- enum glyph_row_area area;
- int start, end;
- enum draw_glyphs_face hl;
- int overlaps_p;
-{
- struct glyph_string *head, *tail;
- struct glyph_string *s;
- int last_x, area_width;
- int x_reached;
- int i, j;
-
- /* Let's rather be paranoid than getting a SEGV. */
- end = min (end, row->used[area]);
- start = max (0, start);
- start = min (end, start);
-
- /* Translate X to frame coordinates. Set last_x to the right
- end of the drawing area. */
- if (row->full_width_p)
- {
- /* X is relative to the left edge of W, without scroll bars
- or fringes. */
- struct frame *f = XFRAME (w->frame);
- int window_left_x = WINDOW_LEFT_MARGIN (w) * CANON_X_UNIT (f);
-
- x += window_left_x;
- area_width = XFASTINT (w->width) * CANON_X_UNIT (f);
- last_x = window_left_x + area_width;
-
- if (FRAME_HAS_VERTICAL_SCROLL_BARS (f))
- {
- int width = FRAME_SCROLL_BAR_WIDTH (f) * CANON_X_UNIT (f);
- if (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
- last_x += width;
- else
- x -= width;
- }
-
- x += FRAME_INTERNAL_BORDER_WIDTH (f);
- last_x += FRAME_INTERNAL_BORDER_WIDTH (f);
- }
- else
- {
- x = WINDOW_AREA_TO_FRAME_PIXEL_X (w, area, x);
- area_width = window_box_width (w, area);
- last_x = WINDOW_AREA_TO_FRAME_PIXEL_X (w, area, area_width);
- }
-
- /* Build a doubly-linked list of glyph_string structures between
- head and tail from what we have to draw. Note that the macro
- BUILD_GLYPH_STRINGS will modify its start parameter. That's
- the reason we use a separate variable `i'. */
- i = start;
- BUILD_GLYPH_STRINGS (w, row, area, i, end, head, tail, hl, x, last_x,
- overlaps_p);
- if (tail)
- x_reached = tail->x + tail->background_width;
- else
- x_reached = x;
-
- /* If there are any glyphs with lbearing < 0 or rbearing > width in
- the row, redraw some glyphs in front or following the glyph
- strings built above. */
- if (head && !overlaps_p && row->contains_overlapping_glyphs_p)
- {
- int dummy_x = 0;
- struct glyph_string *h, *t;
-
- /* Compute overhangs for all glyph strings. */
- for (s = head; s; s = s->next)
- x_compute_glyph_string_overhangs (s);
-
- /* Prepend glyph strings for glyphs in front of the first glyph
- string that are overwritten because of the first glyph
- string's left overhang. The background of all strings
- prepended must be drawn because the first glyph string
- draws over it. */
- i = x_left_overwritten (head);
- if (i >= 0)
- {
- j = i;
- BUILD_GLYPH_STRINGS (w, row, area, j, start, h, t,
- DRAW_NORMAL_TEXT, dummy_x, last_x,
- overlaps_p);
- start = i;
- x_compute_overhangs_and_x (t, head->x, 1);
- x_prepend_glyph_string_lists (&head, &tail, h, t);
- }
-
- /* Prepend glyph strings for glyphs in front of the first glyph
- string that overwrite that glyph string because of their
- right overhang. For these strings, only the foreground must
- be drawn, because it draws over the glyph string at `head'.
- The background must not be drawn because this would overwrite
- right overhangs of preceding glyphs for which no glyph
- strings exist. */
- i = x_left_overwriting (head);
- if (i >= 0)
- {
- BUILD_GLYPH_STRINGS (w, row, area, i, start, h, t,
- DRAW_NORMAL_TEXT, dummy_x, last_x,
- overlaps_p);
- for (s = h; s; s = s->next)
- s->background_filled_p = 1;
- x_compute_overhangs_and_x (t, head->x, 1);
- x_prepend_glyph_string_lists (&head, &tail, h, t);
- }
-
- /* Append glyphs strings for glyphs following the last glyph
- string tail that are overwritten by tail. The background of
- these strings has to be drawn because tail's foreground draws
- over it. */
- i = x_right_overwritten (tail);
- if (i >= 0)
- {
- BUILD_GLYPH_STRINGS (w, row, area, end, i, h, t,
- DRAW_NORMAL_TEXT, x, last_x,
- overlaps_p);
- x_compute_overhangs_and_x (h, tail->x + tail->width, 0);
- x_append_glyph_string_lists (&head, &tail, h, t);
- }
-
- /* Append glyph strings for glyphs following the last glyph
- string tail that overwrite tail. The foreground of such
- glyphs has to be drawn because it writes into the background
- of tail. The background must not be drawn because it could
- paint over the foreground of following glyphs. */
- i = x_right_overwriting (tail);
- if (i >= 0)
- {
- BUILD_GLYPH_STRINGS (w, row, area, end, i, h, t,
- DRAW_NORMAL_TEXT, x, last_x,
- overlaps_p);
- for (s = h; s; s = s->next)
- s->background_filled_p = 1;
- x_compute_overhangs_and_x (h, tail->x + tail->width, 0);
- x_append_glyph_string_lists (&head, &tail, h, t);
- }
- }
-
- /* Draw all strings. */
- for (s = head; s; s = s->next)
- x_draw_glyph_string (s);
-
- if (area == TEXT_AREA
- && !row->full_width_p
- /* When drawing overlapping rows, only the glyph strings'
- foreground is drawn, which doesn't erase a cursor
- completely. */
- && !overlaps_p)
- {
- int x0 = head ? head->x : x;
- int x1 = tail ? tail->x + tail->background_width : x;
-
- x0 = FRAME_TO_WINDOW_PIXEL_X (w, x0);
- x1 = FRAME_TO_WINDOW_PIXEL_X (w, x1);
-
- if (XFASTINT (w->left_margin_width) != 0)
- {
- int left_area_width = window_box_width (w, LEFT_MARGIN_AREA);
- x0 -= left_area_width;
- x1 -= left_area_width;
- }
-
- notice_overwritten_cursor (w, area, x0, x1,
- row->y, MATRIX_ROW_BOTTOM_Y (row));
- }
-
- /* Value is the x-position up to which drawn, relative to AREA of W.
- This doesn't include parts drawn because of overhangs. */
- x_reached = FRAME_TO_WINDOW_PIXEL_X (w, x_reached);
- if (!row->full_width_p)
- {
- if (area > LEFT_MARGIN_AREA && XFASTINT (w->left_margin_width) != 0)
- x_reached -= window_box_width (w, LEFT_MARGIN_AREA);
- if (area > TEXT_AREA)
- x_reached -= window_box_width (w, TEXT_AREA);
- }
-
- return x_reached;
-}
-
-
-/* Fix the display of area AREA of overlapping row ROW in window W. */
-
-static void
-x_fix_overlapping_area (w, row, area)
- struct window *w;
- struct glyph_row *row;
- enum glyph_row_area area;
-{
- int i, x;
-
- BLOCK_INPUT;
-
- if (area == LEFT_MARGIN_AREA)
- x = 0;
- else if (area == TEXT_AREA)
- x = row->x + window_box_width (w, LEFT_MARGIN_AREA);
- else
- x = (window_box_width (w, LEFT_MARGIN_AREA)
- + window_box_width (w, TEXT_AREA));
-
- for (i = 0; i < row->used[area];)
- {
- if (row->glyphs[area][i].overlaps_vertically_p)
- {
- int start = i, start_x = x;
-
- do
- {
- x += row->glyphs[area][i].pixel_width;
- ++i;
- }
- while (i < row->used[area]
- && row->glyphs[area][i].overlaps_vertically_p);
-
- x_draw_glyphs (w, start_x, row, area, start, i,
- DRAW_NORMAL_TEXT, 1);
- }
- else
- {
- x += row->glyphs[area][i].pixel_width;
- ++i;
- }
- }
-
- UNBLOCK_INPUT;
-}
-
-
-/* Output LEN glyphs starting at START at the nominal cursor position.
- Advance the nominal cursor over the text. The global variable
- updated_window contains the window being updated, updated_row is
- the glyph row being updated, and updated_area is the area of that
- row being updated. */
-
-static void
-x_write_glyphs (start, len)
- struct glyph *start;
- int len;
-{
- int x, hpos;
-
- xassert (updated_window && updated_row);
- BLOCK_INPUT;
-
- /* Write glyphs. */
-
- hpos = start - updated_row->glyphs[updated_area];
- x = x_draw_glyphs (updated_window, output_cursor.x,
- updated_row, updated_area,
- hpos, hpos + len,
- DRAW_NORMAL_TEXT, 0);
-
- UNBLOCK_INPUT;
-
- /* Advance the output cursor. */
- output_cursor.hpos += len;
- output_cursor.x = x;
-}
-
-
-/* Insert LEN glyphs from START at the nominal cursor position. */
-
-static void
-x_insert_glyphs (start, len)
- struct glyph *start;
- register int len;
-{
- struct frame *f;
- struct window *w;
- int line_height, shift_by_width, shifted_region_width;
- struct glyph_row *row;
- struct glyph *glyph;
- int frame_x, frame_y, hpos;
-
- xassert (updated_window && updated_row);
- BLOCK_INPUT;
- w = updated_window;
- f = XFRAME (WINDOW_FRAME (w));
-
- /* Get the height of the line we are in. */
- row = updated_row;
- line_height = row->height;
-
- /* Get the width of the glyphs to insert. */
- shift_by_width = 0;
- for (glyph = start; glyph < start + len; ++glyph)
- shift_by_width += glyph->pixel_width;
-
- /* Get the width of the region to shift right. */
- shifted_region_width = (window_box_width (w, updated_area)
- - output_cursor.x
- - shift_by_width);
-
- /* Shift right. */
- frame_x = window_box_left (w, updated_area) + output_cursor.x;
- frame_y = WINDOW_TO_FRAME_PIXEL_Y (w, output_cursor.y);
- XCopyArea (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), FRAME_X_WINDOW (f),
- f->output_data.x->normal_gc,
- frame_x, frame_y,
- shifted_region_width, line_height,
- frame_x + shift_by_width, frame_y);
-
- /* Write the glyphs. */
- hpos = start - row->glyphs[updated_area];
- x_draw_glyphs (w, output_cursor.x, row, updated_area, hpos, hpos + len,
- DRAW_NORMAL_TEXT, 0);
-
- /* Advance the output cursor. */
- output_cursor.hpos += len;
- output_cursor.x += shift_by_width;
- UNBLOCK_INPUT;
-}
-
-
-/* Delete N glyphs at the nominal cursor position. Not implemented
- for X frames. */
-
-static void
-x_delete_glyphs (n)
- register int n;
-{
- abort ();
-}
-
-
-/* Like XClearArea, but check that WIDTH and HEIGHT are reasonable.
- If they are <= 0, this is probably an error. */
-
-void
-x_clear_area (dpy, window, x, y, width, height, exposures)
- Display *dpy;
- Window window;
- int x, y;
- int width, height;
- int exposures;
-{
- xassert (width > 0 && height > 0);
- XClearArea (dpy, window, x, y, width, height, exposures);
-}
-
-
-/* Erase the current text line from the nominal cursor position
- (inclusive) to pixel column TO_X (exclusive). The idea is that
- everything from TO_X onward is already erased.
-
- TO_X is a pixel position relative to updated_area of
- updated_window. TO_X == -1 means clear to the end of this area. */
-
-static void
-x_clear_end_of_line (to_x)
- int to_x;
-{
- struct frame *f;
- struct window *w = updated_window;
- int max_x, min_y, max_y;
- int from_x, from_y, to_y;
-
- xassert (updated_window && updated_row);
- f = XFRAME (w->frame);
-
- if (updated_row->full_width_p)
- {
- max_x = XFASTINT (w->width) * CANON_X_UNIT (f);
- if (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
- && !w->pseudo_window_p)
- max_x += FRAME_SCROLL_BAR_WIDTH (f) * CANON_X_UNIT (f);
- }
- else
- max_x = window_box_width (w, updated_area);
- max_y = window_text_bottom_y (w);
-
- /* TO_X == 0 means don't do anything. TO_X < 0 means clear to end
- of window. For TO_X > 0, truncate to end of drawing area. */
- if (to_x == 0)
- return;
- else if (to_x < 0)
- to_x = max_x;
- else
- to_x = min (to_x, max_x);
-
- to_y = min (max_y, output_cursor.y + updated_row->height);
-
- /* Notice if the cursor will be cleared by this operation. */
- if (!updated_row->full_width_p)
- notice_overwritten_cursor (w, updated_area,
- output_cursor.x, -1,
- updated_row->y,
- MATRIX_ROW_BOTTOM_Y (updated_row));
-
- from_x = output_cursor.x;
-
- /* Translate to frame coordinates. */
- if (updated_row->full_width_p)
- {
- from_x = WINDOW_TO_FRAME_PIXEL_X (w, from_x);
- to_x = WINDOW_TO_FRAME_PIXEL_X (w, to_x);
- }
- else
- {
- from_x = WINDOW_AREA_TO_FRAME_PIXEL_X (w, updated_area, from_x);
- to_x = WINDOW_AREA_TO_FRAME_PIXEL_X (w, updated_area, to_x);
- }
-
- min_y = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w);
- from_y = WINDOW_TO_FRAME_PIXEL_Y (w, max (min_y, output_cursor.y));
- to_y = WINDOW_TO_FRAME_PIXEL_Y (w, to_y);
-
- /* Prevent inadvertently clearing to end of the X window. */
- if (to_x > from_x && to_y > from_y)
- {
- BLOCK_INPUT;
- x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- from_x, from_y, to_x - from_x, to_y - from_y,
- False);
- UNBLOCK_INPUT;
- }
-}
-
-
-/* Clear entire frame. If updating_frame is non-null, clear that
- frame. Otherwise clear the selected frame. */
-
-static void
-x_clear_frame ()
-{
- struct frame *f;
-
- if (updating_frame)
- f = updating_frame;
- else
- f = SELECTED_FRAME ();
-
- /* Clearing the frame will erase any cursor, so mark them all as no
- longer visible. */
- mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f)));
- output_cursor.hpos = output_cursor.vpos = 0;
- output_cursor.x = -1;
-
- /* We don't set the output cursor here because there will always
- follow an explicit cursor_to. */
- BLOCK_INPUT;
- XClearWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
-
- /* We have to clear the scroll bars, too. If we have changed
- colors or something like that, then they should be notified. */
- x_scroll_bar_clear (f);
-
- XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
-}
-
-
-\f
-/* Invert the middle quarter of the frame for .15 sec. */
-
-/* We use the select system call to do the waiting, so we have to make
- sure it's available. If it isn't, we just won't do visual bells. */
-
-#if defined (HAVE_TIMEVAL) && defined (HAVE_SELECT)
-
-
-/* Subtract the `struct timeval' values X and Y, storing the result in
- *RESULT. Return 1 if the difference is negative, otherwise 0. */
-
-static int
-timeval_subtract (result, x, y)
- struct timeval *result, x, y;
-{
- /* Perform the carry for the later subtraction by updating y. This
- is safer because on some systems the tv_sec member is unsigned. */
- if (x.tv_usec < y.tv_usec)
- {
- int nsec = (y.tv_usec - x.tv_usec) / 1000000 + 1;
- y.tv_usec -= 1000000 * nsec;
- y.tv_sec += nsec;
- }
-
- if (x.tv_usec - y.tv_usec > 1000000)
- {
- int nsec = (y.tv_usec - x.tv_usec) / 1000000;
- y.tv_usec += 1000000 * nsec;
- y.tv_sec -= nsec;
- }
-
- /* Compute the time remaining to wait. tv_usec is certainly
- positive. */
- result->tv_sec = x.tv_sec - y.tv_sec;
- result->tv_usec = x.tv_usec - y.tv_usec;
-
- /* Return indication of whether the result should be considered
- negative. */
- return x.tv_sec < y.tv_sec;
-}
-
-void
-XTflash (f)
- struct frame *f;
-{
- BLOCK_INPUT;
-
- {
- GC gc;
-
- /* Create a GC that will use the GXxor function to flip foreground
- pixels into background pixels. */
- {
- XGCValues values;
-
- values.function = GXxor;
- values.foreground = (f->output_data.x->foreground_pixel
- ^ f->output_data.x->background_pixel);
-
- gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- GCFunction | GCForeground, &values);
- }
-
- {
- /* Get the height not including a menu bar widget. */
- int height = CHAR_TO_PIXEL_HEIGHT (f, FRAME_HEIGHT (f));
- /* Height of each line to flash. */
- int flash_height = FRAME_LINE_HEIGHT (f);
- /* These will be the left and right margins of the rectangles. */
- int flash_left = FRAME_INTERNAL_BORDER_WIDTH (f);
- int flash_right = PIXEL_WIDTH (f) - FRAME_INTERNAL_BORDER_WIDTH (f);
-
- int width;
-
- /* Don't flash the area between a scroll bar and the frame
- edge it is next to. */
- switch (FRAME_VERTICAL_SCROLL_BAR_TYPE (f))
- {
- case vertical_scroll_bar_left:
- flash_left += VERTICAL_SCROLL_BAR_WIDTH_TRIM;
- break;
-
- case vertical_scroll_bar_right:
- flash_right -= VERTICAL_SCROLL_BAR_WIDTH_TRIM;
- break;
-
- default:
- break;
- }
-
- width = flash_right - flash_left;
-
- /* If window is tall, flash top and bottom line. */
- if (height > 3 * FRAME_LINE_HEIGHT (f))
- {
- XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc,
- flash_left,
- (FRAME_INTERNAL_BORDER_WIDTH (f)
- + FRAME_TOOL_BAR_LINES (f) * CANON_Y_UNIT (f)),
- width, flash_height);
- XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc,
- flash_left,
- (height - flash_height
- - FRAME_INTERNAL_BORDER_WIDTH (f)),
- width, flash_height);
- }
- else
- /* If it is short, flash it all. */
- XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc,
- flash_left, FRAME_INTERNAL_BORDER_WIDTH (f),
- width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f));
-
- x_flush (f);
-
- {
- struct timeval wakeup;
-
- EMACS_GET_TIME (wakeup);
-
- /* Compute time to wait until, propagating carry from usecs. */
- wakeup.tv_usec += 150000;
- wakeup.tv_sec += (wakeup.tv_usec / 1000000);
- wakeup.tv_usec %= 1000000;
-
- /* Keep waiting until past the time wakeup or any input gets
- available. */
- while (! detect_input_pending ())
- {
- struct timeval current;
- struct timeval timeout;
-
- EMACS_GET_TIME (current);
-
- /* Break if result would be negative. */
- if (timeval_subtract (¤t, wakeup, current))
- break;
-
- /* How long `select' should wait. */
- timeout.tv_sec = 0;
- timeout.tv_usec = 10000;
-
- /* Try to wait that long--but we might wake up sooner. */
- select (0, NULL, NULL, NULL, &timeout);
- }
- }
-
- /* If window is tall, flash top and bottom line. */
- if (height > 3 * FRAME_LINE_HEIGHT (f))
- {
- XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc,
- flash_left,
- (FRAME_INTERNAL_BORDER_WIDTH (f)
- + FRAME_TOOL_BAR_LINES (f) * CANON_Y_UNIT (f)),
- width, flash_height);
- XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc,
- flash_left,
- (height - flash_height
- - FRAME_INTERNAL_BORDER_WIDTH (f)),
- width, flash_height);
- }
- else
- /* If it is short, flash it all. */
- XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc,
- flash_left, FRAME_INTERNAL_BORDER_WIDTH (f),
- width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f));
-
- XFreeGC (FRAME_X_DISPLAY (f), gc);
- x_flush (f);
- }
- }
-
- UNBLOCK_INPUT;
-}
-
-#endif /* defined (HAVE_TIMEVAL) && defined (HAVE_SELECT) */
-
-
-/* Make audible bell. */
-
-void
-XTring_bell ()
-{
- struct frame *f = SELECTED_FRAME ();
-
- if (FRAME_X_DISPLAY (f))
- {
-#if defined (HAVE_TIMEVAL) && defined (HAVE_SELECT)
- if (visible_bell)
- XTflash (f);
- else
-#endif
- {
- BLOCK_INPUT;
- XBell (FRAME_X_DISPLAY (f), 0);
- XFlush (FRAME_X_DISPLAY (f));
- UNBLOCK_INPUT;
- }
- }
-}
-
-\f
-/* Specify how many text lines, from the top of the window,
- should be affected by insert-lines and delete-lines operations.
- This, and those operations, are used only within an update
- that is bounded by calls to x_update_begin and x_update_end. */
-
-static void
-XTset_terminal_window (n)
- register int n;
-{
- /* This function intentionally left blank. */
-}
-
-
-\f
-/***********************************************************************
- Line Dance
- ***********************************************************************/
-
-/* Perform an insert-lines or delete-lines operation, inserting N
- lines or deleting -N lines at vertical position VPOS. */
-
-static void
-x_ins_del_lines (vpos, n)
- int vpos, n;
-{
- abort ();
-}
-
-
-/* Scroll part of the display as described by RUN. */
-
-static void
-x_scroll_run (w, run)
- struct window *w;
- struct run *run;
-{
- struct frame *f = XFRAME (w->frame);
- int x, y, width, height, from_y, to_y, bottom_y;
-
- /* Get frame-relative bounding box of the text display area of W,
- without mode lines. Include in this box the left and right
- fringe of W. */
- window_box (w, -1, &x, &y, &width, &height);
- width += FRAME_X_FRINGE_WIDTH (f);
- x -= FRAME_X_LEFT_FRINGE_WIDTH (f);
-
- from_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->current_y);
- to_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->desired_y);
- bottom_y = y + height;
-
- if (to_y < from_y)
- {
- /* Scrolling up. Make sure we don't copy part of the mode
- line at the bottom. */
- if (from_y + run->height > bottom_y)
- height = bottom_y - from_y;
- else
- height = run->height;
- }
- else
- {
- /* Scolling down. Make sure we don't copy over the mode line.
- at the bottom. */
- if (to_y + run->height > bottom_y)
- height = bottom_y - to_y;
- else
- height = run->height;
- }
-
- BLOCK_INPUT;
-
- /* Cursor off. Will be switched on again in x_update_window_end. */
- updated_window = w;
- x_clear_cursor (w);
-
- XCopyArea (FRAME_X_DISPLAY (f),
- FRAME_X_WINDOW (f), FRAME_X_WINDOW (f),
- f->output_data.x->normal_gc,
- x, from_y,
- width, height,
- x, to_y);
-
- UNBLOCK_INPUT;
-}
-
-
-\f
-/***********************************************************************
- Exposure Events
- ***********************************************************************/
-
-/* Redisplay an exposed area of frame F. X and Y are the upper-left
- corner of the exposed rectangle. W and H are width and height of
- the exposed area. All are pixel values. W or H zero means redraw
- the entire frame. */
-
-static void
-expose_frame (f, x, y, w, h)
- struct frame *f;
- int x, y, w, h;
-{
- XRectangle r;
- int mouse_face_overwritten_p = 0;
-
- TRACE ((stderr, "expose_frame "));
-
- /* No need to redraw if frame will be redrawn soon. */
- if (FRAME_GARBAGED_P (f))
- {
- TRACE ((stderr, " garbaged\n"));
- return;
- }
-
- /* If basic faces haven't been realized yet, there is no point in
- trying to redraw anything. This can happen when we get an expose
- event while Emacs is starting, e.g. by moving another window. */
- if (FRAME_FACE_CACHE (f) == NULL
- || FRAME_FACE_CACHE (f)->used < BASIC_FACE_ID_SENTINEL)
- {
- TRACE ((stderr, " no faces\n"));
- return;
- }
-
- if (w == 0 || h == 0)
- {
- r.x = r.y = 0;
- r.width = CANON_X_UNIT (f) * f->width;
- r.height = CANON_Y_UNIT (f) * f->height;
- }
- else
- {
- r.x = x;
- r.y = y;
- r.width = w;
- r.height = h;
- }
-
- TRACE ((stderr, "(%d, %d, %d, %d)\n", r.x, r.y, r.width, r.height));
- mouse_face_overwritten_p = expose_window_tree (XWINDOW (f->root_window), &r);
-
- if (WINDOWP (f->tool_bar_window))
- mouse_face_overwritten_p
- |= expose_window (XWINDOW (f->tool_bar_window), &r);
-
-#ifndef USE_X_TOOLKIT
- if (WINDOWP (f->menu_bar_window))
- mouse_face_overwritten_p
- |= expose_window (XWINDOW (f->menu_bar_window), &r);
-#endif /* not USE_X_TOOLKIT */
-
- /* Some window managers support a focus-follows-mouse style with
- delayed raising of frames. Imagine a partially obscured frame,
- and moving the mouse into partially obscured mouse-face on that
- frame. The visible part of the mouse-face will be highlighted,
- then the WM raises the obscured frame. With at least one WM, KDE
- 2.1, Emacs is not getting any event for the raising of the frame
- (even tried with SubstructureRedirectMask), only Expose events.
- These expose events will draw text normally, i.e. not
- highlighted. Which means we must redo the highlight here.
- Subsume it under ``we love X''. --gerd 2001-08-15 */
- if (mouse_face_overwritten_p && !FRAME_GARBAGED_P (f))
- {
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
- if (f == dpyinfo->mouse_face_mouse_frame)
- {
- int x = dpyinfo->mouse_face_mouse_x;
- int y = dpyinfo->mouse_face_mouse_y;
- clear_mouse_face (dpyinfo);
- note_mouse_highlight (f, x, y);
- }
- }
-}
-
-
-/* Redraw (parts) of all windows in the window tree rooted at W that
- intersect R. R contains frame pixel coordinates. Value is
- non-zero if the exposure overwrites mouse-face. */
-
-static int
-expose_window_tree (w, r)
- struct window *w;
- XRectangle *r;
-{
- struct frame *f = XFRAME (w->frame);
- int mouse_face_overwritten_p = 0;
-
- while (w && !FRAME_GARBAGED_P (f))
- {
- if (!NILP (w->hchild))
- mouse_face_overwritten_p
- |= expose_window_tree (XWINDOW (w->hchild), r);
- else if (!NILP (w->vchild))
- mouse_face_overwritten_p
- |= expose_window_tree (XWINDOW (w->vchild), r);
- else
- mouse_face_overwritten_p |= expose_window (w, r);
-
- w = NILP (w->next) ? NULL : XWINDOW (w->next);
- }
-
- return mouse_face_overwritten_p;
-}
-
-
-/* Redraw the part of glyph row area AREA of glyph row ROW on window W
- which intersects rectangle R. R is in window-relative coordinates. */
-
-static void
-expose_area (w, row, r, area)
- struct window *w;
- struct glyph_row *row;
- XRectangle *r;
- enum glyph_row_area area;
-{
- struct glyph *first = row->glyphs[area];
- struct glyph *end = row->glyphs[area] + row->used[area];
- struct glyph *last;
- int first_x, start_x, x;
-
- if (area == TEXT_AREA && row->fill_line_p)
- /* If row extends face to end of line write the whole line. */
- x_draw_glyphs (w, 0, row, area, 0, row->used[area],
- DRAW_NORMAL_TEXT, 0);
- else
+ if (s->stippled_p)
{
- /* Set START_X to the window-relative start position for drawing glyphs of
- AREA. The first glyph of the text area can be partially visible.
- The first glyphs of other areas cannot. */
- if (area == LEFT_MARGIN_AREA)
- start_x = 0;
- else if (area == TEXT_AREA)
- start_x = row->x + window_box_width (w, LEFT_MARGIN_AREA);
- else
- start_x = (window_box_width (w, LEFT_MARGIN_AREA)
- + window_box_width (w, TEXT_AREA));
- x = start_x;
-
- /* Find the first glyph that must be redrawn. */
- while (first < end
- && x + first->pixel_width < r->x)
- {
- x += first->pixel_width;
- ++first;
- }
-
- /* Find the last one. */
- last = first;
- first_x = x;
- while (last < end
- && x < r->x + r->width)
- {
- x += last->pixel_width;
- ++last;
- }
-
- /* Repaint. */
- if (last > first)
- x_draw_glyphs (w, first_x - start_x, row, area,
- first - row->glyphs[area],
- last - row->glyphs[area],
- DRAW_NORMAL_TEXT, 0);
+ /* Fill background with a stipple pattern. */
+ XSetFillStyle (s->display, s->gc, FillOpaqueStippled);
+ XFillRectangle (s->display, s->window, s->gc, x, y, w, h);
+ XSetFillStyle (s->display, s->gc, FillSolid);
}
-}
-
-
-/* Redraw the parts of the glyph row ROW on window W intersecting
- rectangle R. R is in window-relative coordinates. Value is
- non-zero if mouse-face was overwritten. */
-
-static int
-expose_line (w, row, r)
- struct window *w;
- struct glyph_row *row;
- XRectangle *r;
-{
- xassert (row->enabled_p);
-
- if (row->mode_line_p || w->pseudo_window_p)
- x_draw_glyphs (w, 0, row, TEXT_AREA, 0, row->used[TEXT_AREA],
- DRAW_NORMAL_TEXT, 0);
else
- {
- if (row->used[LEFT_MARGIN_AREA])
- expose_area (w, row, r, LEFT_MARGIN_AREA);
- if (row->used[TEXT_AREA])
- expose_area (w, row, r, TEXT_AREA);
- if (row->used[RIGHT_MARGIN_AREA])
- expose_area (w, row, r, RIGHT_MARGIN_AREA);
- x_draw_row_fringe_bitmaps (w, row);
- }
-
- return row->mouse_face_p;
+ x_clear_glyph_string_rect (s, x, y, w, h);
}
-/* Return non-zero if W's cursor intersects rectangle R. */
-
-static int
-x_phys_cursor_in_rect_p (w, r)
- struct window *w;
- XRectangle *r;
-{
- XRectangle cr, result;
- struct glyph *cursor_glyph;
-
- cursor_glyph = get_phys_cursor_glyph (w);
- if (cursor_glyph)
- {
- cr.x = w->phys_cursor.x;
- cr.y = w->phys_cursor.y;
- cr.width = cursor_glyph->pixel_width;
- cr.height = w->phys_cursor_height;
- return x_intersect_rectangles (&cr, r, &result);
- }
- else
- return 0;
-}
+/* Draw image glyph string S.
+ s->y
+ s->x +-------------------------
+ | s->face->box
+ |
+ | +-------------------------
+ | | s->img->margin
+ | |
+ | | +-------------------
+ | | | the image
-/* Redraw the part of window W intersection rectangle FR. Pixel
- coordinates in FR are frame-relative. Call this function with
- input blocked. Value is non-zero if the exposure overwrites
- mouse-face. */
+ */
-static int
-expose_window (w, fr)
- struct window *w;
- XRectangle *fr;
+static void
+x_draw_image_glyph_string (s)
+ struct glyph_string *s;
{
- struct frame *f = XFRAME (w->frame);
- XRectangle wr, r;
- int mouse_face_overwritten_p = 0;
-
- /* If window is not yet fully initialized, do nothing. This can
- happen when toolkit scroll bars are used and a window is split.
- Reconfiguring the scroll bar will generate an expose for a newly
- created window. */
- if (w->current_matrix == NULL)
- return 0;
-
- /* When we're currently updating the window, display and current
- matrix usually don't agree. Arrange for a thorough display
- later. */
- if (w == updated_window)
- {
- SET_FRAME_GARBAGED (f);
- return 0;
- }
+ int x, y;
+ int box_line_hwidth = abs (s->face->box_line_width);
+ int box_line_vwidth = max (s->face->box_line_width, 0);
+ int height;
+ Pixmap pixmap = None;
+
+ height = s->height - 2 * box_line_vwidth;
- /* Frame-relative pixel rectangle of W. */
- wr.x = XFASTINT (w->left) * CANON_X_UNIT (f);
- wr.y = XFASTINT (w->top) * CANON_Y_UNIT (f);
- wr.width = XFASTINT (w->width) * CANON_X_UNIT (f);
- wr.height = XFASTINT (w->height) * CANON_Y_UNIT (f);
- if (x_intersect_rectangles (fr, &wr, &r))
+ /* Fill background with face under the image. Do it only if row is
+ taller than image or if image has a clip mask to reduce
+ flickering. */
+ s->stippled_p = s->face->stipple != 0;
+ if (height > s->img->height
+ || s->img->hmargin
+ || s->img->vmargin
+ || s->img->mask
+ || s->img->pixmap == 0
+ || s->width != s->background_width)
{
- int yb = window_text_bottom_y (w);
- struct glyph_row *row;
- int cursor_cleared_p;
-
- TRACE ((stderr, "expose_window (%d, %d, %d, %d)\n",
- r.x, r.y, r.width, r.height));
-
- /* Convert to window coordinates. */
- r.x = FRAME_TO_WINDOW_PIXEL_X (w, r.x);
- r.y = FRAME_TO_WINDOW_PIXEL_Y (w, r.y);
-
- /* Turn off the cursor. */
- if (!w->pseudo_window_p
- && x_phys_cursor_in_rect_p (w, &r))
- {
- x_clear_cursor (w);
- cursor_cleared_p = 1;
- }
+ if (box_line_hwidth && s->first_glyph->left_box_line_p)
+ x = s->x + box_line_hwidth;
else
- cursor_cleared_p = 0;
-
- /* Find the first row intersecting the rectangle R. */
- for (row = w->current_matrix->rows;
- row->enabled_p;
- ++row)
- {
- int y0 = row->y;
- int y1 = MATRIX_ROW_BOTTOM_Y (row);
-
- if ((y0 >= r.y && y0 < r.y + r.height)
- || (y1 > r.y && y1 < r.y + r.height)
- || (r.y >= y0 && r.y < y1)
- || (r.y + r.height > y0 && r.y + r.height < y1))
- {
- if (expose_line (w, row, &r))
- mouse_face_overwritten_p = 1;
- }
-
- if (y1 >= yb)
- break;
- }
+ x = s->x;
- /* Display the mode line if there is one. */
- if (WINDOW_WANTS_MODELINE_P (w)
- && (row = MATRIX_MODE_LINE_ROW (w->current_matrix),
- row->enabled_p)
- && row->y < r.y + r.height)
- {
- if (expose_line (w, row, &r))
- mouse_face_overwritten_p = 1;
- }
+ y = s->y + box_line_vwidth;
- if (!w->pseudo_window_p)
+ if (s->img->mask)
{
- /* Draw border between windows. */
- x_draw_vertical_border (w);
-
- /* Turn the cursor on again. */
- if (cursor_cleared_p)
- x_update_window_cursor (w, 1);
- }
- }
-
- return mouse_face_overwritten_p;
-}
+ /* Create a pixmap as large as the glyph string. Fill it
+ with the background color. Copy the image to it, using
+ its mask. Copy the temporary pixmap to the display. */
+ Screen *screen = FRAME_X_SCREEN (s->f);
+ int depth = DefaultDepthOfScreen (screen);
+ /* Create a pixmap as large as the glyph string. */
+ pixmap = XCreatePixmap (s->display, s->window,
+ s->background_width,
+ s->height, depth);
-/* Determine the intersection of two rectangles R1 and R2. Return
- the intersection in *RESULT. Value is non-zero if RESULT is not
- empty. */
+ /* Don't clip in the following because we're working on the
+ pixmap. */
+ XSetClipMask (s->display, s->gc, None);
-static int
-x_intersect_rectangles (r1, r2, result)
- XRectangle *r1, *r2, *result;
-{
- XRectangle *left, *right;
- XRectangle *upper, *lower;
- int intersection_p = 0;
-
- /* Rearrange so that R1 is the left-most rectangle. */
- if (r1->x < r2->x)
- left = r1, right = r2;
- else
- left = r2, right = r1;
-
- /* X0 of the intersection is right.x0, if this is inside R1,
- otherwise there is no intersection. */
- if (right->x <= left->x + left->width)
- {
- result->x = right->x;
-
- /* The right end of the intersection is the minimum of the
- the right ends of left and right. */
- result->width = (min (left->x + left->width, right->x + right->width)
- - result->x);
-
- /* Same game for Y. */
- if (r1->y < r2->y)
- upper = r1, lower = r2;
+ /* Fill the pixmap with the background color/stipple. */
+ if (s->stippled_p)
+ {
+ /* Fill background with a stipple pattern. */
+ XSetFillStyle (s->display, s->gc, FillOpaqueStippled);
+ XFillRectangle (s->display, pixmap, s->gc,
+ 0, 0, s->background_width, s->height);
+ XSetFillStyle (s->display, s->gc, FillSolid);
+ }
+ else
+ {
+ XGCValues xgcv;
+ XGetGCValues (s->display, s->gc, GCForeground | GCBackground,
+ &xgcv);
+ XSetForeground (s->display, s->gc, xgcv.background);
+ XFillRectangle (s->display, pixmap, s->gc,
+ 0, 0, s->background_width, s->height);
+ XSetForeground (s->display, s->gc, xgcv.foreground);
+ }
+ }
else
- upper = r2, lower = r1;
+ x_draw_glyph_string_bg_rect (s, x, y, s->background_width, height);
- /* The upper end of the intersection is lower.y0, if this is inside
- of upper. Otherwise, there is no intersection. */
- if (lower->y <= upper->y + upper->height)
- {
- result->y = lower->y;
-
- /* The lower end of the intersection is the minimum of the lower
- ends of upper and lower. */
- result->height = (min (lower->y + lower->height,
- upper->y + upper->height)
- - result->y);
- intersection_p = 1;
- }
+ s->background_filled_p = 1;
}
- return intersection_p;
-}
-
-
-
+ /* Draw the foreground. */
+ if (pixmap != None)
+ {
+ x_draw_image_foreground_1 (s, pixmap);
+ x_set_glyph_string_clipping (s);
+ XCopyArea (s->display, pixmap, s->window, s->gc,
+ 0, 0, s->background_width, s->height, s->x, s->y);
+ XFreePixmap (s->display, pixmap);
+ }
+ else
+ x_draw_image_foreground (s);
-\f
-static void
-frame_highlight (f)
- struct frame *f;
-{
- /* We used to only do this if Vx_no_window_manager was non-nil, but
- the ICCCM (section 4.1.6) says that the window's border pixmap
- and border pixel are window attributes which are "private to the
- client", so we can always change it to whatever we want. */
- BLOCK_INPUT;
- XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- f->output_data.x->border_pixel);
- UNBLOCK_INPUT;
- x_update_cursor (f, 1);
+ /* If we must draw a relief around the image, do it. */
+ if (s->img->relief
+ || s->hl == DRAW_IMAGE_RAISED
+ || s->hl == DRAW_IMAGE_SUNKEN)
+ x_draw_image_relief (s);
}
-static void
-frame_unhighlight (f)
- struct frame *f;
-{
- /* We used to only do this if Vx_no_window_manager was non-nil, but
- the ICCCM (section 4.1.6) says that the window's border pixmap
- and border pixel are window attributes which are "private to the
- client", so we can always change it to whatever we want. */
- BLOCK_INPUT;
- XSetWindowBorderPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- f->output_data.x->border_tile);
- UNBLOCK_INPUT;
- x_update_cursor (f, 1);
-}
-/* The focus has changed. Update the frames as necessary to reflect
- the new situation. Note that we can't change the selected frame
- here, because the Lisp code we are interrupting might become confused.
- Each event gets marked with the frame in which it occurred, so the
- Lisp code can tell when the switch took place by examining the events. */
+/* Draw stretch glyph string S. */
static void
-x_new_focus_frame (dpyinfo, frame)
- struct x_display_info *dpyinfo;
- struct frame *frame;
+x_draw_stretch_glyph_string (s)
+ struct glyph_string *s;
{
- struct frame *old_focus = dpyinfo->x_focus_frame;
+ xassert (s->first_glyph->type == STRETCH_GLYPH);
+ s->stippled_p = s->face->stipple != 0;
- if (frame != dpyinfo->x_focus_frame)
+ if (s->hl == DRAW_CURSOR
+ && !x_stretch_cursor_p)
{
- /* Set this before calling other routines, so that they see
- the correct value of x_focus_frame. */
- dpyinfo->x_focus_frame = frame;
+ /* If `x-stretch-block-cursor' is nil, don't draw a block cursor
+ as wide as the stretch glyph. */
+ int width = min (FRAME_COLUMN_WIDTH (s->f), s->background_width);
- if (old_focus && old_focus->auto_lower)
- x_lower_frame (old_focus);
+ /* Draw cursor. */
+ x_draw_glyph_string_bg_rect (s, s->x, s->y, width, s->height);
-#if 0
- selected_frame = frame;
- XSETFRAME (XWINDOW (selected_frame->selected_window)->frame,
- selected_frame);
- Fselect_window (selected_frame->selected_window);
- choose_minibuf_frame ();
-#endif /* ! 0 */
+ /* Clear rest using the GC of the original non-cursor face. */
+ if (width < s->background_width)
+ {
+ int x = s->x + width, y = s->y;
+ int w = s->background_width - width, h = s->height;
+ XRectangle r;
+ GC gc;
- if (dpyinfo->x_focus_frame && dpyinfo->x_focus_frame->auto_raise)
- pending_autoraise_frame = dpyinfo->x_focus_frame;
- else
- pending_autoraise_frame = 0;
- }
+ if (s->row->mouse_face_p
+ && cursor_in_mouse_face_p (s->w))
+ {
+ x_set_mouse_face_gc (s);
+ gc = s->gc;
+ }
+ else
+ gc = s->face->gc;
- x_frame_rehighlight (dpyinfo);
-}
+ get_glyph_string_clip_rect (s, &r);
+ XSetClipRectangles (s->display, gc, 0, 0, &r, 1, Unsorted);
-/* Handle an event saying the mouse has moved out of an Emacs frame. */
+ if (s->face->stipple)
+ {
+ /* Fill background with a stipple pattern. */
+ XSetFillStyle (s->display, gc, FillOpaqueStippled);
+ XFillRectangle (s->display, s->window, gc, x, y, w, h);
+ XSetFillStyle (s->display, gc, FillSolid);
+ }
+ else
+ {
+ XGCValues xgcv;
+ XGetGCValues (s->display, gc, GCForeground | GCBackground, &xgcv);
+ XSetForeground (s->display, gc, xgcv.background);
+ XFillRectangle (s->display, s->window, gc, x, y, w, h);
+ XSetForeground (s->display, gc, xgcv.foreground);
+ }
+ }
+ }
+ else if (!s->background_filled_p)
+ x_draw_glyph_string_bg_rect (s, s->x, s->y, s->background_width,
+ s->height);
-void
-x_mouse_leave (dpyinfo)
- struct x_display_info *dpyinfo;
-{
- x_new_focus_frame (dpyinfo, dpyinfo->x_focus_event_frame);
+ s->background_filled_p = 1;
}
-/* The focus has changed, or we have redirected a frame's focus to
- another frame (this happens when a frame uses a surrogate
- mini-buffer frame). Shift the highlight as appropriate.
-
- The FRAME argument doesn't necessarily have anything to do with which
- frame is being highlighted or un-highlighted; we only use it to find
- the appropriate X display info. */
-static void
-XTframe_rehighlight (frame)
- struct frame *frame;
-{
- x_frame_rehighlight (FRAME_X_DISPLAY_INFO (frame));
-}
+/* Draw glyph string S. */
static void
-x_frame_rehighlight (dpyinfo)
- struct x_display_info *dpyinfo;
+x_draw_glyph_string (s)
+ struct glyph_string *s;
{
- struct frame *old_highlight = dpyinfo->x_highlight_frame;
+ int relief_drawn_p = 0;
- if (dpyinfo->x_focus_frame)
+ /* If S draws into the background of its successor, draw the
+ background of the successor 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_p)
{
- dpyinfo->x_highlight_frame
- = ((GC_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))
- {
- FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame) = Qnil;
- dpyinfo->x_highlight_frame = dpyinfo->x_focus_frame;
- }
+ 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);
}
- else
- dpyinfo->x_highlight_frame = 0;
- if (dpyinfo->x_highlight_frame != old_highlight)
- {
- if (old_highlight)
- frame_unhighlight (old_highlight);
- if (dpyinfo->x_highlight_frame)
- frame_highlight (dpyinfo->x_highlight_frame);
- }
-}
+ /* Set up S->gc, set clipping and draw S. */
+ x_set_glyph_string_gc (s);
+ /* Draw relief (if any) in advance for char/composition so that the
+ glyph string can be drawn over it. */
+ if (!s->for_overlaps_p
+ && s->face->box != FACE_NO_BOX
+ && (s->first_glyph->type == CHAR_GLYPH
+ || s->first_glyph->type == COMPOSITE_GLYPH))
-\f
-/* Keyboard processing - modifier keys, vendor-specific keysyms, etc. */
+ {
+ x_set_glyph_string_clipping (s);
+ x_draw_glyph_string_background (s, 1);
+ x_draw_glyph_string_box (s);
+ x_set_glyph_string_clipping (s);
+ relief_drawn_p = 1;
+ }
+ else
+ x_set_glyph_string_clipping (s);
-/* Initialize mode_switch_bit and modifier_meaning. */
-static void
-x_find_modifier_meanings (dpyinfo)
- struct x_display_info *dpyinfo;
-{
- int min_code, max_code;
- KeySym *syms;
- int syms_per_code;
- XModifierKeymap *mods;
+ switch (s->first_glyph->type)
+ {
+ case IMAGE_GLYPH:
+ x_draw_image_glyph_string (s);
+ break;
- dpyinfo->meta_mod_mask = 0;
- dpyinfo->shift_lock_mask = 0;
- dpyinfo->alt_mod_mask = 0;
- dpyinfo->super_mod_mask = 0;
- dpyinfo->hyper_mod_mask = 0;
+ case STRETCH_GLYPH:
+ x_draw_stretch_glyph_string (s);
+ break;
-#ifdef HAVE_X11R4
- XDisplayKeycodes (dpyinfo->display, &min_code, &max_code);
-#else
- min_code = dpyinfo->display->min_keycode;
- max_code = dpyinfo->display->max_keycode;
-#endif
+ case CHAR_GLYPH:
+ if (s->for_overlaps_p)
+ s->background_filled_p = 1;
+ else
+ x_draw_glyph_string_background (s, 0);
+ x_draw_glyph_string_foreground (s);
+ break;
- syms = XGetKeyboardMapping (dpyinfo->display,
- min_code, max_code - min_code + 1,
- &syms_per_code);
- mods = XGetModifierMapping (dpyinfo->display);
+ case COMPOSITE_GLYPH:
+ if (s->for_overlaps_p || s->gidx > 0)
+ s->background_filled_p = 1;
+ else
+ x_draw_glyph_string_background (s, 1);
+ x_draw_composite_glyph_string_foreground (s);
+ break;
- /* Scan the modifier table to see which modifier bits the Meta and
- Alt keysyms are on. */
- {
- int row, col; /* The row and column in the modifier table. */
+ default:
+ abort ();
+ }
- for (row = 3; row < 8; row++)
- for (col = 0; col < mods->max_keypermod; col++)
+ if (!s->for_overlaps_p)
+ {
+ /* Draw underline. */
+ if (s->face->underline_p)
{
- KeyCode code
- = mods->modifiermap[(row * mods->max_keypermod) + col];
-
- /* Zeroes are used for filler. Skip them. */
- if (code == 0)
- continue;
+ unsigned long tem, h;
+ int y;
- /* Are any of this keycode's keysyms a meta key? */
- {
- int code_col;
+ /* Get the underline thickness. Default is 1 pixel. */
+ if (!XGetFontProperty (s->font, XA_UNDERLINE_THICKNESS, &h))
+ h = 1;
- for (code_col = 0; code_col < syms_per_code; code_col++)
- {
- int sym = syms[((code - min_code) * syms_per_code) + code_col];
+ /* 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
- switch (sym)
- {
- case XK_Meta_L:
- case XK_Meta_R:
- dpyinfo->meta_mod_mask |= (1 << row);
- break;
+ ROUND ((maximum descent) / 2), with
+ ROUND(x) = floor (x + 0.5) */
- case XK_Alt_L:
- case XK_Alt_R:
- dpyinfo->alt_mod_mask |= (1 << row);
- break;
+ 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;
+ else
+ y = s->y + s->height - h;
- case XK_Hyper_L:
- case XK_Hyper_R:
- dpyinfo->hyper_mod_mask |= (1 << row);
- break;
+ if (s->face->underline_defaulted_p)
+ XFillRectangle (s->display, s->window, s->gc,
+ s->x, y, s->width, h);
+ else
+ {
+ XGCValues xgcv;
+ XGetGCValues (s->display, s->gc, GCForeground, &xgcv);
+ XSetForeground (s->display, s->gc, s->face->underline_color);
+ XFillRectangle (s->display, s->window, s->gc,
+ s->x, y, s->width, h);
+ XSetForeground (s->display, s->gc, xgcv.foreground);
+ }
+ }
- case XK_Super_L:
- case XK_Super_R:
- dpyinfo->super_mod_mask |= (1 << row);
- break;
+ /* Draw overline. */
+ if (s->face->overline_p)
+ {
+ unsigned long dy = 0, h = 1;
- case XK_Shift_Lock:
- /* Ignore this if it's not on the lock modifier. */
- if ((1 << row) == LockMask)
- dpyinfo->shift_lock_mask = LockMask;
- break;
- }
- }
- }
+ if (s->face->overline_color_defaulted_p)
+ XFillRectangle (s->display, s->window, s->gc, s->x, s->y + dy,
+ s->width, h);
+ else
+ {
+ XGCValues xgcv;
+ XGetGCValues (s->display, s->gc, GCForeground, &xgcv);
+ XSetForeground (s->display, s->gc, s->face->overline_color);
+ XFillRectangle (s->display, s->window, s->gc, s->x, s->y + dy,
+ s->width, h);
+ XSetForeground (s->display, s->gc, xgcv.foreground);
+ }
}
- }
- /* If we couldn't find any meta keys, accept any alt keys as meta keys. */
- if (! dpyinfo->meta_mod_mask)
- {
- dpyinfo->meta_mod_mask = dpyinfo->alt_mod_mask;
- dpyinfo->alt_mod_mask = 0;
- }
+ /* Draw strike-through. */
+ if (s->face->strike_through_p)
+ {
+ unsigned long h = 1;
+ unsigned long dy = (s->height - h) / 2;
- /* If some keys are both alt and meta,
- make them just meta, not alt. */
- if (dpyinfo->alt_mod_mask & dpyinfo->meta_mod_mask)
- {
- dpyinfo->alt_mod_mask &= ~dpyinfo->meta_mod_mask;
+ if (s->face->strike_through_color_defaulted_p)
+ XFillRectangle (s->display, s->window, s->gc, s->x, s->y + dy,
+ s->width, h);
+ else
+ {
+ XGCValues xgcv;
+ XGetGCValues (s->display, s->gc, GCForeground, &xgcv);
+ XSetForeground (s->display, s->gc, s->face->strike_through_color);
+ XFillRectangle (s->display, s->window, s->gc, s->x, s->y + dy,
+ s->width, h);
+ XSetForeground (s->display, s->gc, xgcv.foreground);
+ }
+ }
+
+ /* Draw relief if not yet drawn. */
+ if (!relief_drawn_p && s->face->box != FACE_NO_BOX)
+ x_draw_glyph_string_box (s);
}
- XFree ((char *) syms);
- XFreeModifiermap (mods);
+ /* Reset clipping. */
+ XSetClipMask (s->display, s->gc, None);
}
-/* Convert between the modifier bits X uses and the modifier bits
- Emacs uses. */
+/* Shift display to make room for inserted glyphs. */
-static unsigned int
-x_x_to_emacs_modifiers (dpyinfo, state)
- struct x_display_info *dpyinfo;
- unsigned int state;
+void
+x_shift_glyphs_for_insert (f, x, y, width, height, shift_by)
+ struct frame *f;
+ int x, y, width, height, shift_by;
{
- EMACS_UINT mod_meta = meta_modifier;
- EMACS_UINT mod_alt = alt_modifier;
- EMACS_UINT mod_hyper = hyper_modifier;
- EMACS_UINT mod_super = super_modifier;
- Lisp_Object tem;
-
- tem = Fget (Vx_alt_keysym, Qmodifier_value);
- if (! EQ (tem, Qnil)) mod_alt = XUINT (tem);
- tem = Fget (Vx_meta_keysym, Qmodifier_value);
- if (! EQ (tem, Qnil)) mod_meta = XUINT (tem);
- tem = Fget (Vx_hyper_keysym, Qmodifier_value);
- if (! EQ (tem, Qnil)) mod_hyper = XUINT (tem);
- tem = Fget (Vx_super_keysym, Qmodifier_value);
- if (! EQ (tem, Qnil)) mod_super = XUINT (tem);
-
-
- return ( ((state & (ShiftMask | dpyinfo->shift_lock_mask)) ? shift_modifier : 0)
- | ((state & ControlMask) ? ctrl_modifier : 0)
- | ((state & dpyinfo->meta_mod_mask) ? mod_meta : 0)
- | ((state & dpyinfo->alt_mod_mask) ? mod_alt : 0)
- | ((state & dpyinfo->super_mod_mask) ? mod_super : 0)
- | ((state & dpyinfo->hyper_mod_mask) ? mod_hyper : 0));
+ XCopyArea (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), FRAME_X_WINDOW (f),
+ f->output_data.x->normal_gc,
+ x, y, width, height,
+ x + shift_by, y);
}
-static unsigned int
-x_emacs_to_x_modifiers (dpyinfo, state)
- struct x_display_info *dpyinfo;
- unsigned int state;
+/* Delete N glyphs at the nominal cursor position. Not implemented
+ for X frames. */
+
+static void
+x_delete_glyphs (n)
+ register int n;
{
- EMACS_UINT mod_meta = meta_modifier;
- EMACS_UINT mod_alt = alt_modifier;
- EMACS_UINT mod_hyper = hyper_modifier;
- EMACS_UINT mod_super = super_modifier;
-
- Lisp_Object tem;
-
- tem = Fget (Vx_alt_keysym, Qmodifier_value);
- if (! EQ (tem, Qnil)) mod_alt = XUINT (tem);
- tem = Fget (Vx_meta_keysym, Qmodifier_value);
- if (! EQ (tem, Qnil)) mod_meta = XUINT (tem);
- tem = Fget (Vx_hyper_keysym, Qmodifier_value);
- if (! EQ (tem, Qnil)) mod_hyper = XUINT (tem);
- tem = Fget (Vx_super_keysym, Qmodifier_value);
- if (! EQ (tem, Qnil)) mod_super = XUINT (tem);
-
-
- return ( ((state & mod_alt) ? dpyinfo->alt_mod_mask : 0)
- | ((state & mod_super) ? dpyinfo->super_mod_mask : 0)
- | ((state & mod_hyper) ? dpyinfo->hyper_mod_mask : 0)
- | ((state & shift_modifier) ? ShiftMask : 0)
- | ((state & ctrl_modifier) ? ControlMask : 0)
- | ((state & mod_meta) ? dpyinfo->meta_mod_mask : 0));
+ abort ();
}
-/* Convert a keysym to its name. */
-
-char *
-x_get_keysym_name (keysym)
- KeySym keysym;
-{
- char *value;
- BLOCK_INPUT;
- value = XKeysymToString (keysym);
- UNBLOCK_INPUT;
+/* Like XClearArea, but check that WIDTH and HEIGHT are reasonable.
+ If they are <= 0, this is probably an error. */
- return value;
+void
+x_clear_area (dpy, window, x, y, width, height, exposures)
+ Display *dpy;
+ Window window;
+ int x, y;
+ int width, height;
+ int exposures;
+{
+ xassert (width > 0 && height > 0);
+ XClearArea (dpy, window, x, y, width, height, exposures);
}
-\f
-/* Mouse clicks and mouse movement. Rah. */
-
-/* Given a pixel position (PIX_X, PIX_Y) on frame F, return glyph
- co-ordinates in (*X, *Y). Set *BOUNDS to the rectangle that the
- glyph at X, Y occupies, if BOUNDS != 0. If NOCLIP is non-zero, do
- not force the value into range. */
+/* Clear entire frame. If updating_frame is non-null, clear that
+ frame. Otherwise clear the selected frame. */
-void
-pixel_to_glyph_coords (f, pix_x, pix_y, x, y, bounds, noclip)
- FRAME_PTR f;
- register int pix_x, pix_y;
- register int *x, *y;
- XRectangle *bounds;
- int noclip;
+static void
+x_clear_frame ()
{
- /* Arrange for the division in PIXEL_TO_CHAR_COL etc. to round down
- even for negative values. */
- if (pix_x < 0)
- pix_x -= FONT_WIDTH ((f)->output_data.x->font) - 1;
- if (pix_y < 0)
- pix_y -= (f)->output_data.x->line_height - 1;
+ struct frame *f;
- pix_x = PIXEL_TO_CHAR_COL (f, pix_x);
- pix_y = PIXEL_TO_CHAR_ROW (f, pix_y);
+ if (updating_frame)
+ f = updating_frame;
+ else
+ f = SELECTED_FRAME ();
- if (bounds)
- {
- bounds->width = FONT_WIDTH (f->output_data.x->font);
- bounds->height = f->output_data.x->line_height;
- bounds->x = CHAR_TO_PIXEL_COL (f, pix_x);
- bounds->y = CHAR_TO_PIXEL_ROW (f, pix_y);
- }
+ /* Clearing the frame will erase any cursor, so mark them all as no
+ longer visible. */
+ mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f)));
+ output_cursor.hpos = output_cursor.vpos = 0;
+ output_cursor.x = -1;
- if (!noclip)
- {
- if (pix_x < 0)
- pix_x = 0;
- else if (pix_x > FRAME_WINDOW_WIDTH (f))
- pix_x = FRAME_WINDOW_WIDTH (f);
+ /* We don't set the output cursor here because there will always
+ follow an explicit cursor_to. */
+ BLOCK_INPUT;
+ XClearWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
- if (pix_y < 0)
- pix_y = 0;
- else if (pix_y > f->height)
- pix_y = f->height;
- }
+ /* We have to clear the scroll bars, too. If we have changed
+ colors or something like that, then they should be notified. */
+ x_scroll_bar_clear (f);
+
+ XFlush (FRAME_X_DISPLAY (f));
+
+#ifdef USE_GTK
+ xg_frame_cleared (f);
+#endif
- *x = pix_x;
- *y = pix_y;
+ UNBLOCK_INPUT;
}
-/* Given HPOS/VPOS in the current matrix of W, return corresponding
- frame-relative pixel positions in *FRAME_X and *FRAME_Y. If we
- can't tell the positions because W's display is not up to date,
- return 0. */
+\f
+/* Invert the middle quarter of the frame for .15 sec. */
-int
-glyph_to_pixel_coords (w, hpos, vpos, frame_x, frame_y)
- struct window *w;
- int hpos, vpos;
- int *frame_x, *frame_y;
-{
- int success_p;
+/* We use the select system call to do the waiting, so we have to make
+ sure it's available. If it isn't, we just won't do visual bells. */
- xassert (hpos >= 0 && hpos < w->current_matrix->matrix_w);
- xassert (vpos >= 0 && vpos < w->current_matrix->matrix_h);
+#if defined (HAVE_TIMEVAL) && defined (HAVE_SELECT)
- if (display_completed)
- {
- struct glyph_row *row = MATRIX_ROW (w->current_matrix, vpos);
- struct glyph *glyph = row->glyphs[TEXT_AREA];
- struct glyph *end = glyph + min (hpos, row->used[TEXT_AREA]);
- *frame_y = row->y;
- *frame_x = row->x;
- while (glyph < end)
- {
- *frame_x += glyph->pixel_width;
- ++glyph;
- }
+/* Subtract the `struct timeval' values X and Y, storing the result in
+ *RESULT. Return 1 if the difference is negative, otherwise 0. */
- success_p = 1;
+static int
+timeval_subtract (result, x, y)
+ struct timeval *result, x, y;
+{
+ /* Perform the carry for the later subtraction by updating y. This
+ is safer because on some systems the tv_sec member is unsigned. */
+ if (x.tv_usec < y.tv_usec)
+ {
+ int nsec = (y.tv_usec - x.tv_usec) / 1000000 + 1;
+ y.tv_usec -= 1000000 * nsec;
+ y.tv_sec += nsec;
}
- else
+
+ if (x.tv_usec - y.tv_usec > 1000000)
{
- *frame_y = *frame_x = 0;
- success_p = 0;
+ int nsec = (y.tv_usec - x.tv_usec) / 1000000;
+ y.tv_usec += 1000000 * nsec;
+ y.tv_sec -= nsec;
}
- *frame_y = WINDOW_TO_FRAME_PIXEL_Y (w, *frame_y);
- *frame_x = WINDOW_TO_FRAME_PIXEL_X (w, *frame_x);
- return success_p;
+ /* Compute the time remaining to wait. tv_usec is certainly
+ positive. */
+ result->tv_sec = x.tv_sec - y.tv_sec;
+ result->tv_usec = x.tv_usec - y.tv_usec;
+
+ /* Return indication of whether the result should be considered
+ negative. */
+ return x.tv_sec < y.tv_sec;
}
+void
+XTflash (f)
+ struct frame *f;
+{
+ BLOCK_INPUT;
-/* Prepare a mouse-event in *RESULT for placement in the input queue.
+ {
+ GC gc;
- If the event is a button press, then note that we have grabbed
- the mouse. */
+ /* Create a GC that will use the GXxor function to flip foreground
+ pixels into background pixels. */
+ {
+ XGCValues values;
-static Lisp_Object
-construct_mouse_click (result, event, f)
- struct input_event *result;
- XButtonEvent *event;
- struct frame *f;
-{
- /* Make the event type no_event; we'll change that when we decide
- otherwise. */
- result->kind = mouse_click;
- result->code = event->button - Button1;
- result->timestamp = event->time;
- result->modifiers = (x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f),
- event->state)
- | (event->type == ButtonRelease
- ? up_modifier
- : down_modifier));
+ values.function = GXxor;
+ values.foreground = (f->output_data.x->foreground_pixel
+ ^ f->output_data.x->background_pixel);
- XSETINT (result->x, event->x);
- XSETINT (result->y, event->y);
- XSETFRAME (result->frame_or_window, f);
- result->arg = Qnil;
- return Qnil;
-}
+ gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ GCFunction | GCForeground, &values);
+ }
-\f
-/* Function to report a mouse movement to the mainstream Emacs code.
- The input handler calls this.
+ {
+ /* Get the height not including a menu bar widget. */
+ int height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, FRAME_LINES (f));
+ /* Height of each line to flash. */
+ int flash_height = FRAME_LINE_HEIGHT (f);
+ /* These will be the left and right margins of the rectangles. */
+ int flash_left = FRAME_INTERNAL_BORDER_WIDTH (f);
+ int flash_right = FRAME_PIXEL_WIDTH (f) - FRAME_INTERNAL_BORDER_WIDTH (f);
- We have received a mouse movement event, which is given in *event.
- If the mouse is over a different glyph than it was last time, tell
- the mainstream emacs code by setting mouse_moved. If not, ask for
- another motion event, so we can check again the next time it moves. */
+ int width;
-static XMotionEvent last_mouse_motion_event;
-static Lisp_Object last_mouse_motion_frame;
+ /* Don't flash the area between a scroll bar and the frame
+ edge it is next to. */
+ switch (FRAME_VERTICAL_SCROLL_BAR_TYPE (f))
+ {
+ case vertical_scroll_bar_left:
+ flash_left += VERTICAL_SCROLL_BAR_WIDTH_TRIM;
+ break;
-static void
-note_mouse_movement (frame, event)
- FRAME_PTR frame;
- XMotionEvent *event;
-{
- last_mouse_movement_time = event->time;
- last_mouse_motion_event = *event;
- XSETFRAME (last_mouse_motion_frame, frame);
+ case vertical_scroll_bar_right:
+ flash_right -= VERTICAL_SCROLL_BAR_WIDTH_TRIM;
+ break;
- if (x_autoselect_window_p)
- {
- int area;
- Lisp_Object window;
- static Lisp_Object last_window;
+ default:
+ break;
+ }
- window = window_from_coordinates (frame, event->x, event->y, &area, 0);
+ width = flash_right - flash_left;
- /* Window will be selected only when it is not selected now and
- last mouse movement event was not in it. Minubuffer window
- will be selected iff it is active. */
- if (!EQ (window, last_window)
- && !EQ (window, selected_window)
- && (!MINI_WINDOW_P (XWINDOW (window))
- || (EQ (window, minibuf_window) && minibuf_level > 0)))
- Fselect_window (window);
+ /* If window is tall, flash top and bottom line. */
+ if (height > 3 * FRAME_LINE_HEIGHT (f))
+ {
+ XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc,
+ flash_left,
+ (FRAME_INTERNAL_BORDER_WIDTH (f)
+ + FRAME_TOOL_BAR_LINES (f) * FRAME_LINE_HEIGHT (f)),
+ width, flash_height);
+ XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc,
+ flash_left,
+ (height - flash_height
+ - FRAME_INTERNAL_BORDER_WIDTH (f)),
+ width, flash_height);
+ }
+ else
+ /* If it is short, flash it all. */
+ XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc,
+ flash_left, FRAME_INTERNAL_BORDER_WIDTH (f),
+ width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f));
- last_window=window;
- }
+ x_flush (f);
- if (event->window != FRAME_X_WINDOW (frame))
- {
- frame->mouse_moved = 1;
- last_mouse_scroll_bar = Qnil;
- note_mouse_highlight (frame, -1, -1);
- }
+ {
+ struct timeval wakeup;
- /* Has the mouse moved off the glyph it was on at the last sighting? */
- else if (event->x < last_mouse_glyph.x
- || event->x >= last_mouse_glyph.x + last_mouse_glyph.width
- || event->y < last_mouse_glyph.y
- || event->y >= last_mouse_glyph.y + last_mouse_glyph.height)
- {
- frame->mouse_moved = 1;
- last_mouse_scroll_bar = Qnil;
- note_mouse_highlight (frame, event->x, event->y);
- }
-}
+ EMACS_GET_TIME (wakeup);
-\f
-/************************************************************************
- Mouse Face
- ************************************************************************/
+ /* Compute time to wait until, propagating carry from usecs. */
+ wakeup.tv_usec += 150000;
+ wakeup.tv_sec += (wakeup.tv_usec / 1000000);
+ wakeup.tv_usec %= 1000000;
-/* Find the glyph under window-relative coordinates X/Y in window W.
- Consider only glyphs from buffer text, i.e. no glyphs from overlay
- strings. Return in *HPOS and *VPOS the row and column number of
- the glyph found. Return in *AREA the glyph area containing X.
- Value is a pointer to the glyph found or null if X/Y is not on
- text, or we can't tell because W's current matrix is not up to
- date. */
+ /* Keep waiting until past the time wakeup or any input gets
+ available. */
+ while (! detect_input_pending ())
+ {
+ struct timeval current;
+ struct timeval timeout;
-static struct glyph *
-x_y_to_hpos_vpos (w, x, y, hpos, vpos, area, buffer_only_p)
- struct window *w;
- int x, y;
- int *hpos, *vpos, *area;
- int buffer_only_p;
-{
- struct glyph *glyph, *end;
- struct glyph_row *row = NULL;
- int x0, i, left_area_width;
+ EMACS_GET_TIME (current);
- /* Find row containing Y. Give up if some row is not enabled. */
- for (i = 0; i < w->current_matrix->nrows; ++i)
- {
- row = MATRIX_ROW (w->current_matrix, i);
- if (!row->enabled_p)
- return NULL;
- if (y >= row->y && y < MATRIX_ROW_BOTTOM_Y (row))
- break;
- }
+ /* Break if result would be negative. */
+ if (timeval_subtract (¤t, wakeup, current))
+ break;
- *vpos = i;
- *hpos = 0;
+ /* How long `select' should wait. */
+ timeout.tv_sec = 0;
+ timeout.tv_usec = 10000;
- /* Give up if Y is not in the window. */
- if (i == w->current_matrix->nrows)
- return NULL;
+ /* Try to wait that long--but we might wake up sooner. */
+ select (0, NULL, NULL, NULL, &timeout);
+ }
+ }
- /* Get the glyph area containing X. */
- if (w->pseudo_window_p)
- {
- *area = TEXT_AREA;
- x0 = 0;
- }
- else
- {
- left_area_width = window_box_width (w, LEFT_MARGIN_AREA);
- if (x < left_area_width)
- {
- *area = LEFT_MARGIN_AREA;
- x0 = 0;
- }
- else if (x < left_area_width + window_box_width (w, TEXT_AREA))
+ /* If window is tall, flash top and bottom line. */
+ if (height > 3 * FRAME_LINE_HEIGHT (f))
{
- *area = TEXT_AREA;
- x0 = row->x + left_area_width;
+ XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc,
+ flash_left,
+ (FRAME_INTERNAL_BORDER_WIDTH (f)
+ + FRAME_TOOL_BAR_LINES (f) * FRAME_LINE_HEIGHT (f)),
+ width, flash_height);
+ XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc,
+ flash_left,
+ (height - flash_height
+ - FRAME_INTERNAL_BORDER_WIDTH (f)),
+ width, flash_height);
}
else
- {
- *area = RIGHT_MARGIN_AREA;
- x0 = left_area_width + window_box_width (w, TEXT_AREA);
- }
- }
+ /* If it is short, flash it all. */
+ XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc,
+ flash_left, FRAME_INTERNAL_BORDER_WIDTH (f),
+ width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f));
- /* Find glyph containing X. */
- glyph = row->glyphs[*area];
- end = glyph + row->used[*area];
- while (glyph < end)
- {
- if (x < x0 + glyph->pixel_width)
- {
- if (w->pseudo_window_p)
- break;
- else if (!buffer_only_p || BUFFERP (glyph->object))
- break;
- }
-
- x0 += glyph->pixel_width;
- ++glyph;
+ XFreeGC (FRAME_X_DISPLAY (f), gc);
+ x_flush (f);
}
+ }
- if (glyph == end)
- return NULL;
-
- *hpos = glyph - row->glyphs[*area];
- return glyph;
+ UNBLOCK_INPUT;
}
-
-/* Convert frame-relative x/y to coordinates relative to window W.
- Takes pseudo-windows into account. */
-
-static void
-frame_to_window_pixel_xy (w, x, y)
- struct window *w;
- int *x, *y;
-{
- if (w->pseudo_window_p)
- {
- /* A pseudo-window is always full-width, and starts at the
- left edge of the frame, plus a frame border. */
- struct frame *f = XFRAME (w->frame);
- *x -= FRAME_INTERNAL_BORDER_WIDTH_SAFE (f);
- *y = FRAME_TO_WINDOW_PIXEL_Y (w, *y);
- }
- else
- {
- *x = FRAME_TO_WINDOW_PIXEL_X (w, *x);
- *y = FRAME_TO_WINDOW_PIXEL_Y (w, *y);
- }
-}
+#endif /* defined (HAVE_TIMEVAL) && defined (HAVE_SELECT) */
-/* Take proper action when mouse has moved to the mode or header line of
- window W, x-position X. MODE_LINE_P non-zero means mouse is on the
- mode line. X is relative to the start of the text display area of
- W, so the width of fringes and scroll bars must be subtracted
- to get a position relative to the start of the mode line. */
+/* Make audible bell. */
-static void
-note_mode_line_highlight (w, x, mode_line_p)
- struct window *w;
- int x, mode_line_p;
+void
+XTring_bell ()
{
- struct frame *f = XFRAME (w->frame);
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
- Cursor cursor = dpyinfo->vertical_scroll_bar_cursor;
- struct glyph_row *row;
-
- if (mode_line_p)
- row = MATRIX_MODE_LINE_ROW (w->current_matrix);
- else
- row = MATRIX_HEADER_LINE_ROW (w->current_matrix);
-
- if (row->enabled_p)
- {
- struct glyph *glyph, *end;
- Lisp_Object help, map;
- int x0;
-
- /* Find the glyph under X. */
- glyph = row->glyphs[TEXT_AREA];
- end = glyph + row->used[TEXT_AREA];
- x0 = - (FRAME_LEFT_SCROLL_BAR_WIDTH (f) * CANON_X_UNIT (f)
- + FRAME_X_LEFT_FRINGE_WIDTH (f));
-
- while (glyph < end
- && x >= x0 + glyph->pixel_width)
- {
- x0 += glyph->pixel_width;
- ++glyph;
- }
+ struct frame *f = SELECTED_FRAME ();
- if (glyph < end
- && STRINGP (glyph->object)
- && XSTRING (glyph->object)->intervals
- && glyph->charpos >= 0
- && glyph->charpos < XSTRING (glyph->object)->size)
+ if (FRAME_X_DISPLAY (f))
+ {
+#if defined (HAVE_TIMEVAL) && defined (HAVE_SELECT)
+ if (visible_bell)
+ XTflash (f);
+ else
+#endif
{
- /* If we're on a string with `help-echo' text property,
- arrange for the help to be displayed. This is done by
- setting the global variable help_echo to the help string. */
- help = Fget_text_property (make_number (glyph->charpos),
- Qhelp_echo, glyph->object);
- if (!NILP (help))
- {
- help_echo = help;
- XSETWINDOW (help_echo_window, w);
- help_echo_object = glyph->object;
- help_echo_pos = glyph->charpos;
- }
-
- /* Change the mouse pointer according to what is under X/Y. */
- map = Fget_text_property (make_number (glyph->charpos),
- Qlocal_map, glyph->object);
- if (KEYMAPP (map))
- cursor = f->output_data.x->nontext_cursor;
- else
- {
- map = Fget_text_property (make_number (glyph->charpos),
- Qkeymap, glyph->object);
- if (KEYMAPP (map))
- cursor = f->output_data.x->nontext_cursor;
- }
+ BLOCK_INPUT;
+ XBell (FRAME_X_DISPLAY (f), 0);
+ XFlush (FRAME_X_DISPLAY (f));
+ UNBLOCK_INPUT;
}
}
-
- XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
}
-
-/* Take proper action when the mouse has moved to position X, Y on
- frame F as regards highlighting characters that have mouse-face
- properties. Also de-highlighting chars where the mouse was before.
- X and Y can be negative or out of range. */
+\f
+/* Specify how many text lines, from the top of the window,
+ should be affected by insert-lines and delete-lines operations.
+ This, and those operations, are used only within an update
+ that is bounded by calls to x_update_begin and x_update_end. */
static void
-note_mouse_highlight (f, x, y)
- struct frame *f;
- int x, y;
+XTset_terminal_window (n)
+ register int n;
{
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
- int portion;
- Lisp_Object window;
- struct window *w;
- Cursor cursor = None;
- struct buffer *b;
+ /* This function intentionally left blank. */
+}
- /* When a menu is active, don't highlight because this looks odd. */
-#ifdef USE_X_TOOLKIT
- if (popup_activated ())
- return;
-#endif
- if (NILP (Vmouse_highlight)
- || !f->glyphs_initialized_p)
- return;
+\f
+/***********************************************************************
+ Line Dance
+ ***********************************************************************/
- dpyinfo->mouse_face_mouse_x = x;
- dpyinfo->mouse_face_mouse_y = y;
- dpyinfo->mouse_face_mouse_frame = f;
+/* Perform an insert-lines or delete-lines operation, inserting N
+ lines or deleting -N lines at vertical position VPOS. */
- if (dpyinfo->mouse_face_defer)
- return;
+static void
+x_ins_del_lines (vpos, n)
+ int vpos, n;
+{
+ abort ();
+}
- if (gc_in_progress)
- {
- dpyinfo->mouse_face_deferred_gc = 1;
- return;
- }
- /* Which window is that in? */
- window = window_from_coordinates (f, x, y, &portion, 1);
+/* Scroll part of the display as described by RUN. */
- /* If we were displaying active text in another window, clear that. */
- if (! EQ (window, dpyinfo->mouse_face_window))
- clear_mouse_face (dpyinfo);
+static void
+x_scroll_run (w, run)
+ struct window *w;
+ struct run *run;
+{
+ struct frame *f = XFRAME (w->frame);
+ int x, y, width, height, from_y, to_y, bottom_y;
- /* Not on a window -> return. */
- if (!WINDOWP (window))
- return;
+ /* Get frame-relative bounding box of the text display area of W,
+ without mode lines. Include in this box the left and right
+ fringe of W. */
+ window_box (w, -1, &x, &y, &width, &height);
- /* Convert to window-relative pixel coordinates. */
- w = XWINDOW (window);
- frame_to_window_pixel_xy (w, &x, &y);
+ from_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->current_y);
+ to_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->desired_y);
+ bottom_y = y + height;
- /* Handle tool-bar window differently since it doesn't display a
- buffer. */
- if (EQ (window, f->tool_bar_window))
+ if (to_y < from_y)
{
- note_tool_bar_highlight (f, x, y);
- return;
+ /* Scrolling up. Make sure we don't copy part of the mode
+ line at the bottom. */
+ if (from_y + run->height > bottom_y)
+ height = bottom_y - from_y;
+ else
+ height = run->height;
}
-
- /* Mouse is on the mode or header line? */
- if (portion == 1 || portion == 3)
+ else
{
- note_mode_line_highlight (w, x, portion == 1);
- return;
+ /* Scolling down. Make sure we don't copy over the mode line.
+ at the bottom. */
+ if (to_y + run->height > bottom_y)
+ height = bottom_y - to_y;
+ else
+ height = run->height;
}
-
- if (portion == 2)
- cursor = f->output_data.x->horizontal_drag_cursor;
- else
- cursor = f->output_data.x->text_cursor;
-
- /* Are we in a window whose display is up to date?
- And verify the buffer's text has not changed. */
- b = XBUFFER (w->buffer);
- if (/* Within text portion of the window. */
- portion == 0
- && EQ (w->window_end_valid, w->buffer)
- && XFASTINT (w->last_modified) == BUF_MODIFF (b)
- && XFASTINT (w->last_overlay_modified) == BUF_OVERLAY_MODIFF (b))
- {
- int hpos, vpos, pos, i, area;
- struct glyph *glyph;
- Lisp_Object object;
- Lisp_Object mouse_face = Qnil, overlay = Qnil, position;
- Lisp_Object *overlay_vec = NULL;
- int len, noverlays;
- struct buffer *obuf;
- int obegv, ozv, same_region;
-
- /* Find the glyph under X/Y. */
- glyph = x_y_to_hpos_vpos (w, x, y, &hpos, &vpos, &area, 0);
-
- /* Clear mouse face if X/Y not over text. */
- if (glyph == NULL
- || area != TEXT_AREA
- || !MATRIX_ROW (w->current_matrix, vpos)->displays_text_p)
- {
- if (clear_mouse_face (dpyinfo))
- cursor = None;
- goto set_cursor;
- }
-
- pos = glyph->charpos;
- object = glyph->object;
- if (!STRINGP (object) && !BUFFERP (object))
- goto set_cursor;
-
- /* If we get an out-of-range value, return now; avoid an error. */
- if (BUFFERP (object) && pos > BUF_Z (b))
- goto set_cursor;
-
- /* Make the window's buffer temporarily current for
- overlays_at and compute_char_face. */
- obuf = current_buffer;
- current_buffer = b;
- obegv = BEGV;
- ozv = ZV;
- BEGV = BEG;
- ZV = Z;
-
- /* Is this char mouse-active or does it have help-echo? */
- position = make_number (pos);
-
- if (BUFFERP (object))
- {
- /* Put all the overlays we want in a vector in overlay_vec.
- Store the length in len. If there are more than 10, make
- enough space for all, and try again. */
- len = 10;
- overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
- noverlays = overlays_at (pos, 0, &overlay_vec, &len, NULL, NULL, 0);
- if (noverlays > len)
- {
- len = noverlays;
- overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
- noverlays = overlays_at (pos, 0, &overlay_vec, &len, NULL, NULL,0);
- }
- /* Sort overlays into increasing priority order. */
- noverlays = sort_overlays (overlay_vec, noverlays, w);
- }
- else
- noverlays = 0;
-
- same_region = (EQ (window, dpyinfo->mouse_face_window)
- && vpos >= dpyinfo->mouse_face_beg_row
- && vpos <= dpyinfo->mouse_face_end_row
- && (vpos > dpyinfo->mouse_face_beg_row
- || hpos >= dpyinfo->mouse_face_beg_col)
- && (vpos < dpyinfo->mouse_face_end_row
- || hpos < dpyinfo->mouse_face_end_col
- || dpyinfo->mouse_face_past_end));
-
- if (same_region)
- cursor = None;
-
- /* Check mouse-face highlighting. */
- if (! same_region
- /* If there exists an overlay with mouse-face overlapping
- the one we are currently highlighting, we have to
- check if we enter the overlapping overlay, and then
- highlight only that. */
- || (OVERLAYP (dpyinfo->mouse_face_overlay)
- && mouse_face_overlay_overlaps (dpyinfo->mouse_face_overlay)))
- {
- /* Find the highest priority overlay that has a mouse-face
- property. */
- overlay = Qnil;
- for (i = noverlays - 1; i >= 0 && NILP (overlay); --i)
- {
- mouse_face = Foverlay_get (overlay_vec[i], Qmouse_face);
- if (!NILP (mouse_face))
- overlay = overlay_vec[i];
- }
-
- /* If we're actually highlighting the same overlay as
- before, there's no need to do that again. */
- if (!NILP (overlay)
- && EQ (overlay, dpyinfo->mouse_face_overlay))
- goto check_help_echo;
-
- dpyinfo->mouse_face_overlay = overlay;
-
- /* Clear the display of the old active region, if any. */
- if (clear_mouse_face (dpyinfo))
- cursor = None;
-
- /* If no overlay applies, get a text property. */
- if (NILP (overlay))
- mouse_face = Fget_text_property (position, Qmouse_face, object);
-
- /* Handle the overlay case. */
- if (!NILP (overlay))
- {
- /* Find the range of text around this char that
- should be active. */
- Lisp_Object before, after;
- int ignore;
-
- before = Foverlay_start (overlay);
- after = Foverlay_end (overlay);
- /* Record this as the current active region. */
- fast_find_position (w, XFASTINT (before),
- &dpyinfo->mouse_face_beg_col,
- &dpyinfo->mouse_face_beg_row,
- &dpyinfo->mouse_face_beg_x,
- &dpyinfo->mouse_face_beg_y, Qnil);
-
- dpyinfo->mouse_face_past_end
- = !fast_find_position (w, XFASTINT (after),
- &dpyinfo->mouse_face_end_col,
- &dpyinfo->mouse_face_end_row,
- &dpyinfo->mouse_face_end_x,
- &dpyinfo->mouse_face_end_y, Qnil);
- dpyinfo->mouse_face_window = window;
- dpyinfo->mouse_face_face_id
- = face_at_buffer_position (w, pos, 0, 0,
- &ignore, pos + 1, 1);
-
- /* Display it as active. */
- show_mouse_face (dpyinfo, DRAW_MOUSE_FACE);
- cursor = None;
- }
- /* Handle the text property case. */
- else if (!NILP (mouse_face) && BUFFERP (object))
- {
- /* Find the range of text around this char that
- should be active. */
- Lisp_Object before, after, beginning, end;
- int ignore;
-
- beginning = Fmarker_position (w->start);
- end = make_number (BUF_Z (XBUFFER (object))
- - XFASTINT (w->window_end_pos));
- before
- = Fprevious_single_property_change (make_number (pos + 1),
- Qmouse_face,
- object, beginning);
- after
- = Fnext_single_property_change (position, Qmouse_face,
- object, end);
-
- /* Record this as the current active region. */
- fast_find_position (w, XFASTINT (before),
- &dpyinfo->mouse_face_beg_col,
- &dpyinfo->mouse_face_beg_row,
- &dpyinfo->mouse_face_beg_x,
- &dpyinfo->mouse_face_beg_y, Qnil);
- dpyinfo->mouse_face_past_end
- = !fast_find_position (w, XFASTINT (after),
- &dpyinfo->mouse_face_end_col,
- &dpyinfo->mouse_face_end_row,
- &dpyinfo->mouse_face_end_x,
- &dpyinfo->mouse_face_end_y, Qnil);
- dpyinfo->mouse_face_window = window;
-
- if (BUFFERP (object))
- dpyinfo->mouse_face_face_id
- = face_at_buffer_position (w, pos, 0, 0,
- &ignore, pos + 1, 1);
-
- /* Display it as active. */
- show_mouse_face (dpyinfo, DRAW_MOUSE_FACE);
- cursor = None;
- }
- else if (!NILP (mouse_face) && STRINGP (object))
- {
- Lisp_Object b, e;
- int ignore;
-
- b = Fprevious_single_property_change (make_number (pos + 1),
- Qmouse_face,
- object, Qnil);
- e = Fnext_single_property_change (position, Qmouse_face,
- object, Qnil);
- if (NILP (b))
- b = make_number (0);
- if (NILP (e))
- e = make_number (XSTRING (object)->size - 1);
- fast_find_string_pos (w, XINT (b), object,
- &dpyinfo->mouse_face_beg_col,
- &dpyinfo->mouse_face_beg_row,
- &dpyinfo->mouse_face_beg_x,
- &dpyinfo->mouse_face_beg_y, 0);
- fast_find_string_pos (w, XINT (e), object,
- &dpyinfo->mouse_face_end_col,
- &dpyinfo->mouse_face_end_row,
- &dpyinfo->mouse_face_end_x,
- &dpyinfo->mouse_face_end_y, 1);
- dpyinfo->mouse_face_past_end = 0;
- dpyinfo->mouse_face_window = window;
- dpyinfo->mouse_face_face_id
- = face_at_string_position (w, object, pos, 0, 0, 0, &ignore,
- glyph->face_id, 1);
- show_mouse_face (dpyinfo, DRAW_MOUSE_FACE);
- cursor = None;
- }
- else if (STRINGP (object) && NILP (mouse_face))
- {
- /* A string which doesn't have mouse-face, but
- the text ``under'' it might have. */
- struct glyph_row *r = MATRIX_ROW (w->current_matrix, vpos);
- int start = MATRIX_ROW_START_CHARPOS (r);
-
- pos = string_buffer_position (w, object, start);
- if (pos > 0)
- mouse_face = get_char_property_and_overlay (make_number (pos),
- Qmouse_face,
- w->buffer,
- &overlay);
- if (!NILP (mouse_face) && !NILP (overlay))
- {
- Lisp_Object before = Foverlay_start (overlay);
- Lisp_Object after = Foverlay_end (overlay);
- int ignore;
-
- /* Note that we might not be able to find position
- BEFORE in the glyph matrix if the overlay is
- entirely covered by a `display' property. In
- this case, we overshoot. So let's stop in
- the glyph matrix before glyphs for OBJECT. */
- fast_find_position (w, XFASTINT (before),
- &dpyinfo->mouse_face_beg_col,
- &dpyinfo->mouse_face_beg_row,
- &dpyinfo->mouse_face_beg_x,
- &dpyinfo->mouse_face_beg_y,
- object);
-
- dpyinfo->mouse_face_past_end
- = !fast_find_position (w, XFASTINT (after),
- &dpyinfo->mouse_face_end_col,
- &dpyinfo->mouse_face_end_row,
- &dpyinfo->mouse_face_end_x,
- &dpyinfo->mouse_face_end_y,
- Qnil);
- dpyinfo->mouse_face_window = window;
- dpyinfo->mouse_face_face_id
- = face_at_buffer_position (w, pos, 0, 0,
- &ignore, pos + 1, 1);
-
- /* Display it as active. */
- show_mouse_face (dpyinfo, DRAW_MOUSE_FACE);
- cursor = None;
- }
- }
- }
+ BLOCK_INPUT;
- check_help_echo:
+ /* Cursor off. Will be switched on again in x_update_window_end. */
+ updated_window = w;
+ x_clear_cursor (w);
- /* Look for a `help-echo' property. */
- {
- Lisp_Object help, overlay;
+ XCopyArea (FRAME_X_DISPLAY (f),
+ FRAME_X_WINDOW (f), FRAME_X_WINDOW (f),
+ f->output_data.x->normal_gc,
+ x, from_y,
+ width, height,
+ x, to_y);
- /* Check overlays first. */
- help = overlay = Qnil;
- for (i = noverlays - 1; i >= 0 && NILP (help); --i)
- {
- overlay = overlay_vec[i];
- help = Foverlay_get (overlay, Qhelp_echo);
- }
+ UNBLOCK_INPUT;
+}
- if (!NILP (help))
- {
- help_echo = help;
- help_echo_window = window;
- help_echo_object = overlay;
- help_echo_pos = pos;
- }
- else
- {
- Lisp_Object object = glyph->object;
- int charpos = glyph->charpos;
-
- /* Try text properties. */
- if (STRINGP (object)
- && charpos >= 0
- && charpos < XSTRING (object)->size)
- {
- help = Fget_text_property (make_number (charpos),
- Qhelp_echo, object);
- if (NILP (help))
- {
- /* If the string itself doesn't specify a help-echo,
- see if the buffer text ``under'' it does. */
- struct glyph_row *r
- = MATRIX_ROW (w->current_matrix, vpos);
- int start = MATRIX_ROW_START_CHARPOS (r);
- int pos = string_buffer_position (w, object, start);
- if (pos > 0)
- {
- help = Fget_char_property (make_number (pos),
- Qhelp_echo, w->buffer);
- if (!NILP (help))
- {
- charpos = pos;
- object = w->buffer;
- }
- }
- }
- }
- else if (BUFFERP (object)
- && charpos >= BEGV
- && charpos < ZV)
- help = Fget_text_property (make_number (charpos), Qhelp_echo,
- object);
-
- if (!NILP (help))
- {
- help_echo = help;
- help_echo_window = window;
- help_echo_object = object;
- help_echo_pos = charpos;
- }
- }
- }
-
- BEGV = obegv;
- ZV = ozv;
- current_buffer = obuf;
- }
- set_cursor:
-
- if (cursor != None)
- XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
+\f
+/***********************************************************************
+ Exposure Events
+ ***********************************************************************/
+
+\f
+static void
+frame_highlight (f)
+ struct frame *f;
+{
+ /* We used to only do this if Vx_no_window_manager was non-nil, but
+ the ICCCM (section 4.1.6) says that the window's border pixmap
+ and border pixel are window attributes which are "private to the
+ client", so we can always change it to whatever we want. */
+ BLOCK_INPUT;
+ XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ f->output_data.x->border_pixel);
+ UNBLOCK_INPUT;
+ x_update_cursor (f, 1);
}
static void
-redo_mouse_highlight ()
+frame_unhighlight (f)
+ struct frame *f;
{
- if (!NILP (last_mouse_motion_frame)
- && FRAME_LIVE_P (XFRAME (last_mouse_motion_frame)))
- note_mouse_highlight (XFRAME (last_mouse_motion_frame),
- last_mouse_motion_event.x,
- last_mouse_motion_event.y);
+ /* We used to only do this if Vx_no_window_manager was non-nil, but
+ the ICCCM (section 4.1.6) says that the window's border pixmap
+ and border pixel are window attributes which are "private to the
+ client", so we can always change it to whatever we want. */
+ BLOCK_INPUT;
+ XSetWindowBorderPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ f->output_data.x->border_tile);
+ UNBLOCK_INPUT;
+ x_update_cursor (f, 1);
}
+/* The focus has changed. Update the frames as necessary to reflect
+ the new situation. Note that we can't change the selected frame
+ here, because the Lisp code we are interrupting might become confused.
+ Each event gets marked with the frame in which it occurred, so the
+ Lisp code can tell when the switch took place by examining the events. */
-\f
-/***********************************************************************
- Tool-bars
- ***********************************************************************/
+static void
+x_new_focus_frame (dpyinfo, frame)
+ struct x_display_info *dpyinfo;
+ struct frame *frame;
+{
+ struct frame *old_focus = dpyinfo->x_focus_frame;
-static int x_tool_bar_item P_ ((struct frame *, int, int,
- struct glyph **, int *, int *, int *));
+ if (frame != dpyinfo->x_focus_frame)
+ {
+ /* Set this before calling other routines, so that they see
+ the correct value of x_focus_frame. */
+ dpyinfo->x_focus_frame = frame;
-/* Tool-bar item index of the item on which a mouse button was pressed
- or -1. */
+ if (old_focus && old_focus->auto_lower)
+ x_lower_frame (old_focus);
-static int last_tool_bar_item;
+#if 0
+ selected_frame = frame;
+ XSETFRAME (XWINDOW (selected_frame->selected_window)->frame,
+ selected_frame);
+ Fselect_window (selected_frame->selected_window, Qnil);
+ choose_minibuf_frame ();
+#endif /* ! 0 */
+ if (dpyinfo->x_focus_frame && dpyinfo->x_focus_frame->auto_raise)
+ pending_autoraise_frame = dpyinfo->x_focus_frame;
+ else
+ pending_autoraise_frame = 0;
+ }
-/* Get information about the tool-bar item at position X/Y on frame F.
- Return in *GLYPH a pointer to the glyph of the tool-bar item in
- the current matrix of the tool-bar window of F, or NULL if not
- on a tool-bar item. Return in *PROP_IDX the index of the tool-bar
- item in F->tool_bar_items. Value is
+ x_frame_rehighlight (dpyinfo);
+}
- -1 if X/Y is not on a tool-bar item
- 0 if X/Y is on the same item that was highlighted before.
- 1 otherwise. */
+/* Handle FocusIn and FocusOut state changes for FRAME.
+ If FRAME has focus and there exists more than one frame, puts
+ a FOCUS_IN_EVENT into BUFP.
+ Returns number of events inserted into BUFP. */
static int
-x_tool_bar_item (f, x, y, glyph, hpos, vpos, prop_idx)
- struct frame *f;
- int x, y;
- struct glyph **glyph;
- int *hpos, *vpos, *prop_idx;
-{
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
- struct window *w = XWINDOW (f->tool_bar_window);
- int area;
-
- /* Find the glyph under X/Y. */
- *glyph = x_y_to_hpos_vpos (w, x, y, hpos, vpos, &area, 0);
- if (*glyph == NULL)
- return -1;
-
- /* Get the start of this tool-bar item's properties in
- f->tool_bar_items. */
- if (!tool_bar_item_info (f, *glyph, prop_idx))
- return -1;
-
- /* Is mouse on the highlighted item? */
- if (EQ (f->tool_bar_window, dpyinfo->mouse_face_window)
- && *vpos >= dpyinfo->mouse_face_beg_row
- && *vpos <= dpyinfo->mouse_face_end_row
- && (*vpos > dpyinfo->mouse_face_beg_row
- || *hpos >= dpyinfo->mouse_face_beg_col)
- && (*vpos < dpyinfo->mouse_face_end_row
- || *hpos < dpyinfo->mouse_face_end_col
- || dpyinfo->mouse_face_past_end))
- return 0;
-
- return 1;
-}
-
-
-/* Handle mouse button event on the tool-bar of frame F, at
- frame-relative coordinates X/Y. EVENT_TYPE is either ButtonPress
- or ButtonRelase. */
-
-static void
-x_handle_tool_bar_click (f, button_event)
- struct frame *f;
- XButtonEvent *button_event;
+x_focus_changed (type, state, dpyinfo, frame, bufp, numchars)
+ int type;
+ int state;
+ struct x_display_info *dpyinfo;
+ struct frame *frame;
+ struct input_event *bufp;
+ int numchars;
{
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
- struct window *w = XWINDOW (f->tool_bar_window);
- int hpos, vpos, prop_idx;
- struct glyph *glyph;
- Lisp_Object enabled_p;
- int x = button_event->x;
- int y = button_event->y;
-
- /* If not on the highlighted tool-bar item, return. */
- frame_to_window_pixel_xy (w, &x, &y);
- if (x_tool_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx) != 0)
- return;
+ int nr_events = 0;
- /* If item is disabled, do nothing. */
- enabled_p = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_ENABLED_P);
- if (NILP (enabled_p))
- return;
-
- if (button_event->type == ButtonPress)
+ if (type == FocusIn)
{
- /* Show item in pressed state. */
- show_mouse_face (dpyinfo, DRAW_IMAGE_SUNKEN);
- dpyinfo->mouse_face_image_state = DRAW_IMAGE_SUNKEN;
- last_tool_bar_item = prop_idx;
- }
- else
- {
- Lisp_Object key, frame;
- struct input_event event;
+ if (dpyinfo->x_focus_event_frame != frame)
+ {
+ x_new_focus_frame (dpyinfo, frame);
+ dpyinfo->x_focus_event_frame = frame;
+
+ /* Don't stop displaying the initial startup message
+ for a switch-frame event we don't need. */
+ if (numchars > 0
+ && GC_NILP (Vterminal_frame)
+ && GC_CONSP (Vframe_list)
+ && !GC_NILP (XCDR (Vframe_list)))
+ {
+ bufp->kind = FOCUS_IN_EVENT;
+ XSETFRAME (bufp->frame_or_window, frame);
+ bufp->arg = Qnil;
+ ++bufp;
+ numchars--;
+ ++nr_events;
+ }
+ }
- /* Show item in released state. */
- show_mouse_face (dpyinfo, DRAW_IMAGE_RAISED);
- dpyinfo->mouse_face_image_state = DRAW_IMAGE_RAISED;
+ frame->output_data.x->focus_state |= state;
- key = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_KEY);
+#ifdef HAVE_X_I18N
+ if (FRAME_XIC (frame))
+ XSetICFocus (FRAME_XIC (frame));
+#endif
+ }
+ else if (type == FocusOut)
+ {
+ frame->output_data.x->focus_state &= ~state;
- XSETFRAME (frame, f);
- event.kind = TOOL_BAR_EVENT;
- event.frame_or_window = frame;
- event.arg = frame;
- kbd_buffer_store_event (&event);
+ if (dpyinfo->x_focus_event_frame == frame)
+ {
+ dpyinfo->x_focus_event_frame = 0;
+ x_new_focus_frame (dpyinfo, 0);
+ }
- event.kind = TOOL_BAR_EVENT;
- event.frame_or_window = frame;
- event.arg = key;
- event.modifiers = x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f),
- button_event->state);
- kbd_buffer_store_event (&event);
- last_tool_bar_item = -1;
+#ifdef HAVE_X_I18N
+ if (FRAME_XIC (frame))
+ XUnsetICFocus (FRAME_XIC (frame));
+#endif
}
+
+ return nr_events;
}
+/* The focus may have changed. Figure out if it is a real focus change,
+ by checking both FocusIn/Out and Enter/LeaveNotify events.
-/* Possibly highlight a tool-bar item on frame F when mouse moves to
- tool-bar window-relative coordinates X/Y. Called from
- note_mouse_highlight. */
+ Returns number of events inserted into BUFP. */
-static void
-note_tool_bar_highlight (f, x, y)
- struct frame *f;
- int x, y;
-{
- Lisp_Object window = f->tool_bar_window;
- struct window *w = XWINDOW (window);
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
- int hpos, vpos;
- struct glyph *glyph;
- struct glyph_row *row;
- int i;
- Lisp_Object enabled_p;
- int prop_idx;
- enum draw_glyphs_face draw;
- int mouse_down_p, rc;
+static int
+x_detect_focus_change (dpyinfo, event, bufp, numchars)
+ struct x_display_info *dpyinfo;
+ XEvent *event;
+ struct input_event *bufp;
+ int numchars;
+{
+ struct frame *frame;
+ int nr_events = 0;
+
+ frame = x_any_window_to_frame (dpyinfo, event->xany.window);
+ if (! frame) return nr_events;
+
+ switch (event->type)
+ {
+ case EnterNotify:
+ case LeaveNotify:
+ if (event->xcrossing.detail != NotifyInferior
+ && event->xcrossing.focus
+ && ! (frame->output_data.x->focus_state & FOCUS_EXPLICIT))
+ nr_events = x_focus_changed ((event->type == EnterNotify
+ ? FocusIn : FocusOut),
+ FOCUS_IMPLICIT,
+ dpyinfo,
+ frame,
+ bufp,
+ numchars);
+ break;
- /* Function note_mouse_highlight is called with negative x(y
- values when mouse moves outside of the frame. */
- if (x <= 0 || y <= 0)
- {
- clear_mouse_face (dpyinfo);
- return;
+ case FocusIn:
+ case FocusOut:
+ nr_events = x_focus_changed (event->type,
+ (event->xfocus.detail == NotifyPointer
+ ? FOCUS_IMPLICIT : FOCUS_EXPLICIT),
+ dpyinfo,
+ frame,
+ bufp,
+ numchars);
+ break;
}
- rc = x_tool_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx);
- if (rc < 0)
- {
- /* Not on tool-bar item. */
- clear_mouse_face (dpyinfo);
- return;
- }
- else if (rc == 0)
- goto set_help_echo;
-
- clear_mouse_face (dpyinfo);
-
- /* Mouse is down, but on different tool-bar item? */
- mouse_down_p = (dpyinfo->grabbed
- && f == last_mouse_frame
- && FRAME_LIVE_P (f));
- if (mouse_down_p
- && last_tool_bar_item != prop_idx)
- return;
+ return nr_events;
+}
+
+
+/* Handle an event saying the mouse has moved out of an Emacs frame. */
- dpyinfo->mouse_face_image_state = DRAW_NORMAL_TEXT;
- draw = mouse_down_p ? DRAW_IMAGE_SUNKEN : DRAW_IMAGE_RAISED;
-
- /* If tool-bar item is not enabled, don't highlight it. */
- enabled_p = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_ENABLED_P);
- if (!NILP (enabled_p))
- {
- /* Compute the x-position of the glyph. In front and past the
- image is a space. We include this is the highlighted area. */
- row = MATRIX_ROW (w->current_matrix, vpos);
- for (i = x = 0; i < hpos; ++i)
- x += row->glyphs[TEXT_AREA][i].pixel_width;
-
- /* Record this as the current active region. */
- dpyinfo->mouse_face_beg_col = hpos;
- dpyinfo->mouse_face_beg_row = vpos;
- dpyinfo->mouse_face_beg_x = x;
- dpyinfo->mouse_face_beg_y = row->y;
- dpyinfo->mouse_face_past_end = 0;
-
- dpyinfo->mouse_face_end_col = hpos + 1;
- dpyinfo->mouse_face_end_row = vpos;
- dpyinfo->mouse_face_end_x = x + glyph->pixel_width;
- dpyinfo->mouse_face_end_y = row->y;
- dpyinfo->mouse_face_window = window;
- dpyinfo->mouse_face_face_id = TOOL_BAR_FACE_ID;
-
- /* Display it as active. */
- show_mouse_face (dpyinfo, draw);
- dpyinfo->mouse_face_image_state = draw;
- }
-
- set_help_echo:
-
- /* Set help_echo to a help string to display for this tool-bar item.
- XTread_socket does the rest. */
- help_echo_object = help_echo_window = Qnil;
- help_echo_pos = -1;
- help_echo = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_HELP);
- if (NILP (help_echo))
- help_echo = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_CAPTION);
+void
+x_mouse_leave (dpyinfo)
+ struct x_display_info *dpyinfo;
+{
+ x_new_focus_frame (dpyinfo, dpyinfo->x_focus_event_frame);
}
+/* The focus has changed, or we have redirected a frame's focus to
+ another frame (this happens when a frame uses a surrogate
+ mini-buffer frame). Shift the highlight as appropriate.
+
+ The FRAME argument doesn't necessarily have anything to do with which
+ frame is being highlighted or un-highlighted; we only use it to find
+ the appropriate X display info. */
-\f
-/* Find the glyph matrix position of buffer position CHARPOS in window
- *W. HPOS, *VPOS, *X, and *Y are set to the positions found. W's
- current glyphs must be up to date. If CHARPOS is above window
- start return (0, 0, 0, 0). If CHARPOS is after end of W, return end
- of last line in W. In the row containing CHARPOS, stop before glyphs
- having STOP as object. */
-
-#if 0 /* This is a version of fast_find_position that's more correct
- in the presence of hscrolling, for example. I didn't install
- it right away because the problem fixed is minor, it failed
- in 20.x as well, and I think it's too risky to install
- so near the release of 21.1. 2001-09-25 gerd. */
+static void
+XTframe_rehighlight (frame)
+ struct frame *frame;
+{
+ x_frame_rehighlight (FRAME_X_DISPLAY_INFO (frame));
+}
-static int
-fast_find_position (w, charpos, hpos, vpos, x, y, stop)
- struct window *w;
- int charpos;
- int *hpos, *vpos, *x, *y;
- Lisp_Object stop;
+static void
+x_frame_rehighlight (dpyinfo)
+ struct x_display_info *dpyinfo;
{
- struct glyph_row *row, *first;
- struct glyph *glyph, *end;
- int i, past_end = 0;
+ struct frame *old_highlight = dpyinfo->x_highlight_frame;
- first = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
- row = row_containing_pos (w, charpos, first, NULL, 0);
- if (row == NULL)
+ if (dpyinfo->x_focus_frame)
{
- if (charpos < MATRIX_ROW_START_CHARPOS (first))
- {
- *x = *y = *hpos = *vpos = 0;
- return 0;
- }
- else
+ dpyinfo->x_highlight_frame
+ = ((GC_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))
{
- row = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos));
- past_end = 1;
+ FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame) = Qnil;
+ dpyinfo->x_highlight_frame = dpyinfo->x_focus_frame;
}
}
+ else
+ dpyinfo->x_highlight_frame = 0;
- *x = row->x;
- *y = row->y;
- *vpos = MATRIX_ROW_VPOS (row, w->current_matrix);
-
- glyph = row->glyphs[TEXT_AREA];
- end = glyph + row->used[TEXT_AREA];
-
- /* Skip over glyphs not having an object at the start of the row.
- These are special glyphs like truncation marks on terminal
- frames. */
- if (row->displays_text_p)
- while (glyph < end
- && INTEGERP (glyph->object)
- && !EQ (stop, glyph->object)
- && glyph->charpos < 0)
- {
- *x += glyph->pixel_width;
- ++glyph;
- }
-
- while (glyph < end
- && !INTEGERP (glyph->object)
- && !EQ (stop, glyph->object)
- && (!BUFFERP (glyph->object)
- || glyph->charpos < charpos))
+ if (dpyinfo->x_highlight_frame != old_highlight)
{
- *x += glyph->pixel_width;
- ++glyph;
+ if (old_highlight)
+ frame_unhighlight (old_highlight);
+ if (dpyinfo->x_highlight_frame)
+ frame_highlight (dpyinfo->x_highlight_frame);
}
-
- *hpos = glyph - row->glyphs[TEXT_AREA];
- return past_end;
}
-#else /* not 0 */
-static int
-fast_find_position (w, pos, hpos, vpos, x, y, stop)
- struct window *w;
- int pos;
- int *hpos, *vpos, *x, *y;
- Lisp_Object stop;
+\f
+/* Keyboard processing - modifier keys, vendor-specific keysyms, etc. */
+
+/* Initialize mode_switch_bit and modifier_meaning. */
+static void
+x_find_modifier_meanings (dpyinfo)
+ struct x_display_info *dpyinfo;
{
- int i;
- int lastcol;
- int maybe_next_line_p = 0;
- int line_start_position;
- int yb = window_text_bottom_y (w);
- struct glyph_row *row, *best_row;
- int row_vpos, best_row_vpos;
- int current_x;
+ int min_code, max_code;
+ KeySym *syms;
+ int syms_per_code;
+ XModifierKeymap *mods;
- row = best_row = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
- row_vpos = best_row_vpos = MATRIX_ROW_VPOS (row, w->current_matrix);
+ dpyinfo->meta_mod_mask = 0;
+ dpyinfo->shift_lock_mask = 0;
+ dpyinfo->alt_mod_mask = 0;
+ dpyinfo->super_mod_mask = 0;
+ dpyinfo->hyper_mod_mask = 0;
- while (row->y < yb)
- {
- if (row->used[TEXT_AREA])
- line_start_position = row->glyphs[TEXT_AREA]->charpos;
- else
- line_start_position = 0;
+#ifdef HAVE_X11R4
+ XDisplayKeycodes (dpyinfo->display, &min_code, &max_code);
+#else
+ min_code = dpyinfo->display->min_keycode;
+ max_code = dpyinfo->display->max_keycode;
+#endif
- if (line_start_position > pos)
- break;
- /* If the position sought is the end of the buffer,
- don't include the blank lines at the bottom of the window. */
- else if (line_start_position == pos
- && pos == BUF_ZV (XBUFFER (w->buffer)))
- {
- maybe_next_line_p = 1;
- break;
- }
- else if (line_start_position > 0)
- {
- best_row = row;
- best_row_vpos = row_vpos;
- }
+ syms = XGetKeyboardMapping (dpyinfo->display,
+ min_code, max_code - min_code + 1,
+ &syms_per_code);
+ mods = XGetModifierMapping (dpyinfo->display);
- if (row->y + row->height >= yb)
- break;
-
- ++row;
- ++row_vpos;
- }
-
- /* Find the right column within BEST_ROW. */
- lastcol = 0;
- current_x = best_row->x;
- for (i = 0; i < best_row->used[TEXT_AREA]; i++)
- {
- struct glyph *glyph = best_row->glyphs[TEXT_AREA] + i;
- int charpos = glyph->charpos;
+ /* Scan the modifier table to see which modifier bits the Meta and
+ Alt keysyms are on. */
+ {
+ int row, col; /* The row and column in the modifier table. */
- if (BUFFERP (glyph->object))
+ for (row = 3; row < 8; row++)
+ for (col = 0; col < mods->max_keypermod; col++)
{
- if (charpos == pos)
- {
- *hpos = i;
- *vpos = best_row_vpos;
- *x = current_x;
- *y = best_row->y;
- return 1;
- }
- else if (charpos > pos)
- break;
+ KeyCode code
+ = mods->modifiermap[(row * mods->max_keypermod) + col];
+
+ /* Zeroes are used for filler. Skip them. */
+ if (code == 0)
+ continue;
+
+ /* Are any of this keycode's keysyms a meta key? */
+ {
+ int code_col;
+
+ for (code_col = 0; code_col < syms_per_code; code_col++)
+ {
+ int sym = syms[((code - min_code) * syms_per_code) + code_col];
+
+ switch (sym)
+ {
+ case XK_Meta_L:
+ case XK_Meta_R:
+ dpyinfo->meta_mod_mask |= (1 << row);
+ break;
+
+ case XK_Alt_L:
+ case XK_Alt_R:
+ dpyinfo->alt_mod_mask |= (1 << row);
+ break;
+
+ case XK_Hyper_L:
+ case XK_Hyper_R:
+ dpyinfo->hyper_mod_mask |= (1 << row);
+ break;
+
+ case XK_Super_L:
+ case XK_Super_R:
+ dpyinfo->super_mod_mask |= (1 << row);
+ break;
+
+ case XK_Shift_Lock:
+ /* Ignore this if it's not on the lock modifier. */
+ if ((1 << row) == LockMask)
+ dpyinfo->shift_lock_mask = LockMask;
+ break;
+ }
+ }
+ }
}
- else if (EQ (glyph->object, stop))
- break;
+ }
- if (charpos > 0)
- lastcol = i;
- current_x += glyph->pixel_width;
+ /* If we couldn't find any meta keys, accept any alt keys as meta keys. */
+ if (! dpyinfo->meta_mod_mask)
+ {
+ dpyinfo->meta_mod_mask = dpyinfo->alt_mod_mask;
+ dpyinfo->alt_mod_mask = 0;
}
- /* If we're looking for the end of the buffer,
- and we didn't find it in the line we scanned,
- use the start of the following line. */
- if (maybe_next_line_p)
+ /* If some keys are both alt and meta,
+ make them just meta, not alt. */
+ if (dpyinfo->alt_mod_mask & dpyinfo->meta_mod_mask)
{
- ++best_row;
- ++best_row_vpos;
- lastcol = 0;
- current_x = best_row->x;
+ dpyinfo->alt_mod_mask &= ~dpyinfo->meta_mod_mask;
}
- *vpos = best_row_vpos;
- *hpos = lastcol + 1;
- *x = current_x;
- *y = best_row->y;
- return 0;
+ XFree ((char *) syms);
+ XFreeModifiermap (mods);
}
-#endif /* not 0 */
-
+/* Convert between the modifier bits X uses and the modifier bits
+ Emacs uses. */
-/* Find the position of the glyph for position POS in OBJECT in
- window W's current matrix, and return in *X, *Y the pixel
- coordinates, and return in *HPOS, *VPOS the column/row of the glyph.
+static unsigned int
+x_x_to_emacs_modifiers (dpyinfo, state)
+ struct x_display_info *dpyinfo;
+ unsigned int state;
+{
+ EMACS_UINT mod_meta = meta_modifier;
+ EMACS_UINT mod_alt = alt_modifier;
+ EMACS_UINT mod_hyper = hyper_modifier;
+ EMACS_UINT mod_super = super_modifier;
+ Lisp_Object tem;
- RIGHT_P non-zero means return the position of the right edge of the
- glyph, RIGHT_P zero means return the left edge position.
+ tem = Fget (Vx_alt_keysym, Qmodifier_value);
+ if (! EQ (tem, Qnil)) mod_alt = XUINT (tem);
+ tem = Fget (Vx_meta_keysym, Qmodifier_value);
+ if (! EQ (tem, Qnil)) mod_meta = XUINT (tem);
+ tem = Fget (Vx_hyper_keysym, Qmodifier_value);
+ if (! EQ (tem, Qnil)) mod_hyper = XUINT (tem);
+ tem = Fget (Vx_super_keysym, Qmodifier_value);
+ if (! EQ (tem, Qnil)) mod_super = XUINT (tem);
- If no glyph for POS exists in the matrix, return the position of
- the glyph with the next smaller position that is in the matrix, if
- RIGHT_P is zero. If RIGHT_P is non-zero, and no glyph for POS
- exists in the matrix, return the position of the glyph with the
- next larger position in OBJECT.
- Value is non-zero if a glyph was found. */
+ return ( ((state & (ShiftMask | dpyinfo->shift_lock_mask)) ? shift_modifier : 0)
+ | ((state & ControlMask) ? ctrl_modifier : 0)
+ | ((state & dpyinfo->meta_mod_mask) ? mod_meta : 0)
+ | ((state & dpyinfo->alt_mod_mask) ? mod_alt : 0)
+ | ((state & dpyinfo->super_mod_mask) ? mod_super : 0)
+ | ((state & dpyinfo->hyper_mod_mask) ? mod_hyper : 0));
+}
-static int
-fast_find_string_pos (w, pos, object, hpos, vpos, x, y, right_p)
- struct window *w;
- int pos;
- Lisp_Object object;
- int *hpos, *vpos, *x, *y;
- int right_p;
-{
- int yb = window_text_bottom_y (w);
- struct glyph_row *r;
- struct glyph *best_glyph = NULL;
- struct glyph_row *best_row = NULL;
- int best_x = 0;
-
- for (r = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
- r->enabled_p && r->y < yb;
- ++r)
- {
- struct glyph *g = r->glyphs[TEXT_AREA];
- struct glyph *e = g + r->used[TEXT_AREA];
- int gx;
-
- for (gx = r->x; g < e; gx += g->pixel_width, ++g)
- if (EQ (g->object, object))
- {
- if (g->charpos == pos)
- {
- best_glyph = g;
- best_x = gx;
- best_row = r;
- goto found;
- }
- else if (best_glyph == NULL
- || ((abs (g->charpos - pos)
- < abs (best_glyph->charpos - pos))
- && (right_p
- ? g->charpos < pos
- : g->charpos > pos)))
- {
- best_glyph = g;
- best_x = gx;
- best_row = r;
- }
- }
- }
+static unsigned int
+x_emacs_to_x_modifiers (dpyinfo, state)
+ struct x_display_info *dpyinfo;
+ unsigned int state;
+{
+ EMACS_UINT mod_meta = meta_modifier;
+ EMACS_UINT mod_alt = alt_modifier;
+ EMACS_UINT mod_hyper = hyper_modifier;
+ EMACS_UINT mod_super = super_modifier;
- found:
+ Lisp_Object tem;
- if (best_glyph)
- {
- *x = best_x;
- *hpos = best_glyph - best_row->glyphs[TEXT_AREA];
+ tem = Fget (Vx_alt_keysym, Qmodifier_value);
+ if (! EQ (tem, Qnil)) mod_alt = XUINT (tem);
+ tem = Fget (Vx_meta_keysym, Qmodifier_value);
+ if (! EQ (tem, Qnil)) mod_meta = XUINT (tem);
+ tem = Fget (Vx_hyper_keysym, Qmodifier_value);
+ if (! EQ (tem, Qnil)) mod_hyper = XUINT (tem);
+ tem = Fget (Vx_super_keysym, Qmodifier_value);
+ if (! EQ (tem, Qnil)) mod_super = XUINT (tem);
- if (right_p)
- {
- *x += best_glyph->pixel_width;
- ++*hpos;
- }
-
- *y = best_row->y;
- *vpos = best_row - w->current_matrix->rows;
- }
- return best_glyph != NULL;
+ return ( ((state & mod_alt) ? dpyinfo->alt_mod_mask : 0)
+ | ((state & mod_super) ? dpyinfo->super_mod_mask : 0)
+ | ((state & mod_hyper) ? dpyinfo->hyper_mod_mask : 0)
+ | ((state & shift_modifier) ? ShiftMask : 0)
+ | ((state & ctrl_modifier) ? ControlMask : 0)
+ | ((state & mod_meta) ? dpyinfo->meta_mod_mask : 0));
}
+/* Convert a keysym to its name. */
-/* Display the active region described by mouse_face_*
- in its mouse-face if HL > 0, in its normal face if HL = 0. */
-
-static void
-show_mouse_face (dpyinfo, draw)
- struct x_display_info *dpyinfo;
- enum draw_glyphs_face draw;
+char *
+x_get_keysym_name (keysym)
+ KeySym keysym;
{
- struct window *w = XWINDOW (dpyinfo->mouse_face_window);
- struct frame *f = XFRAME (WINDOW_FRAME (w));
-
- if (/* If window is in the process of being destroyed, don't bother
- to do anything. */
- w->current_matrix != NULL
- /* Don't update mouse highlight if hidden */
- && (draw != DRAW_MOUSE_FACE || !dpyinfo->mouse_face_hidden)
- /* Recognize when we are called to operate on rows that don't exist
- anymore. This can happen when a window is split. */
- && dpyinfo->mouse_face_end_row < w->current_matrix->nrows)
- {
- int phys_cursor_on_p = w->phys_cursor_on_p;
- struct glyph_row *row, *first, *last;
-
- first = MATRIX_ROW (w->current_matrix, dpyinfo->mouse_face_beg_row);
- last = MATRIX_ROW (w->current_matrix, dpyinfo->mouse_face_end_row);
-
- for (row = first; row <= last && row->enabled_p; ++row)
- {
- int start_hpos, end_hpos, start_x;
+ char *value;
- /* For all but the first row, the highlight starts at column 0. */
- if (row == first)
- {
- start_hpos = dpyinfo->mouse_face_beg_col;
- start_x = dpyinfo->mouse_face_beg_x;
- }
- else
- {
- start_hpos = 0;
- start_x = 0;
- }
+ BLOCK_INPUT;
+ value = XKeysymToString (keysym);
+ UNBLOCK_INPUT;
- if (row == last)
- end_hpos = dpyinfo->mouse_face_end_col;
- else
- end_hpos = row->used[TEXT_AREA];
+ return value;
+}
- if (end_hpos > start_hpos)
- {
- x_draw_glyphs (w, start_x, row, TEXT_AREA,
- start_hpos, end_hpos, draw, 0);
- row->mouse_face_p
- = draw == DRAW_MOUSE_FACE || draw == DRAW_IMAGE_RAISED;
- }
- }
+\f
+/* Mouse clicks and mouse movement. Rah. */
- /* When we've written over the cursor, arrange for it to
- be displayed again. */
- if (phys_cursor_on_p && !w->phys_cursor_on_p)
- x_display_cursor (w, 1,
- w->phys_cursor.hpos, w->phys_cursor.vpos,
- w->phys_cursor.x, w->phys_cursor.y);
- }
-
- /* Change the mouse cursor. */
- if (draw == DRAW_NORMAL_TEXT)
- XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- f->output_data.x->text_cursor);
- else if (draw == DRAW_MOUSE_FACE)
- XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- f->output_data.x->cross_cursor);
- else
- XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- f->output_data.x->nontext_cursor);
-}
+/* Prepare a mouse-event in *RESULT for placement in the input queue.
-/* Clear out the mouse-highlighted active region.
- Redraw it un-highlighted first. Value is non-zero if mouse
- face was actually drawn unhighlighted. */
+ If the event is a button press, then note that we have grabbed
+ the mouse. */
-static int
-clear_mouse_face (dpyinfo)
- struct x_display_info *dpyinfo;
+static Lisp_Object
+construct_mouse_click (result, event, f)
+ struct input_event *result;
+ XButtonEvent *event;
+ struct frame *f;
{
- int cleared = 0;
-
- if (!NILP (dpyinfo->mouse_face_window))
- {
- show_mouse_face (dpyinfo, DRAW_NORMAL_TEXT);
- cleared = 1;
- }
+ /* Make the event type NO_EVENT; we'll change that when we decide
+ otherwise. */
+ result->kind = MOUSE_CLICK_EVENT;
+ result->code = event->button - Button1;
+ result->timestamp = event->time;
+ result->modifiers = (x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f),
+ event->state)
+ | (event->type == ButtonRelease
+ ? up_modifier
+ : down_modifier));
- dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1;
- dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1;
- dpyinfo->mouse_face_window = Qnil;
- dpyinfo->mouse_face_overlay = Qnil;
- return cleared;
+ XSETINT (result->x, event->x);
+ XSETINT (result->y, event->y);
+ XSETFRAME (result->frame_or_window, f);
+ result->arg = Qnil;
+ return Qnil;
}
+\f
+/* Function to report a mouse movement to the mainstream Emacs code.
+ The input handler calls this.
+
+ We have received a mouse movement event, which is given in *event.
+ If the mouse is over a different glyph than it was last time, tell
+ the mainstream emacs code by setting mouse_moved. If not, ask for
+ another motion event, so we can check again the next time it moves. */
-/* Clear any mouse-face on window W. This function is part of the
- redisplay interface, and is called from try_window_id and similar
- functions to ensure the mouse-highlight is off. */
+static XMotionEvent last_mouse_motion_event;
+static Lisp_Object last_mouse_motion_frame;
static void
-x_clear_mouse_face (w)
- struct window *w;
+note_mouse_movement (frame, event)
+ FRAME_PTR frame;
+ XMotionEvent *event;
{
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (XFRAME (w->frame));
- Lisp_Object window;
-
- BLOCK_INPUT;
- XSETWINDOW (window, w);
- if (EQ (window, dpyinfo->mouse_face_window))
- clear_mouse_face (dpyinfo);
- UNBLOCK_INPUT;
-}
-
-
-/* Just discard the mouse face information for frame F, if any.
- This is used when the size of F is changed. */
+ last_mouse_movement_time = event->time;
+ last_mouse_motion_event = *event;
+ XSETFRAME (last_mouse_motion_frame, frame);
-void
-cancel_mouse_face (f)
- FRAME_PTR f;
-{
- Lisp_Object window;
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ if (event->window != FRAME_X_WINDOW (frame))
+ {
+ frame->mouse_moved = 1;
+ last_mouse_scroll_bar = Qnil;
+ note_mouse_highlight (frame, -1, -1);
+ }
- window = dpyinfo->mouse_face_window;
- if (! NILP (window) && XFRAME (XWINDOW (window)->frame) == f)
+ /* Has the mouse moved off the glyph it was on at the last sighting? */
+ else if (event->x < last_mouse_glyph.x
+ || event->x >= last_mouse_glyph.x + last_mouse_glyph.width
+ || event->y < last_mouse_glyph.y
+ || event->y >= last_mouse_glyph.y + last_mouse_glyph.height)
{
- dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1;
- dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1;
- dpyinfo->mouse_face_window = Qnil;
+ frame->mouse_moved = 1;
+ last_mouse_scroll_bar = Qnil;
+ note_mouse_highlight (frame, event->x, event->y);
}
}
\f
+/************************************************************************
+ Mouse Face
+ ************************************************************************/
+
+static void
+redo_mouse_highlight ()
+{
+ if (!NILP (last_mouse_motion_frame)
+ && FRAME_LIVE_P (XFRAME (last_mouse_motion_frame)))
+ note_mouse_highlight (XFRAME (last_mouse_motion_frame),
+ last_mouse_motion_event.x,
+ last_mouse_motion_event.y);
+}
+
+
static int glyph_rect P_ ((struct frame *f, int, int, XRectangle *));
XRectangle *rect;
{
Lisp_Object window;
- int part, found = 0;
+ int found = 0;
- window = window_from_coordinates (f, x, y, &part, 0);
+ window = window_from_coordinates (f, x, y, 0, &x, &y, 0);
if (!NILP (window))
{
struct window *w = XWINDOW (window);
struct glyph_row *r = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
struct glyph_row *end = r + w->current_matrix->nrows - 1;
- frame_to_window_pixel_xy (w, &x, &y);
-
for (; !found && r < end && r->enabled_p; ++r)
if (r->y >= y)
{
struct glyph *g = r->glyphs[TEXT_AREA];
struct glyph *end = g + r->used[TEXT_AREA];
int gx;
-
+
for (gx = r->x; !found && g < end; gx += g->pixel_width, ++g)
if (gx >= x)
{
int width, height, gx, gy;
XRectangle rect;
-
+
if (glyph_rect (f1, win_x, win_y, &rect))
last_mouse_glyph = rect;
else
height = FRAME_SMALLEST_FONT_HEIGHT (f1);
gx = win_x;
gy = win_y;
-
- /* Arrange for the division in PIXEL_TO_CHAR_COL etc. to
+
+ /* Arrange for the division in FRAME_PIXEL_X_TO_COL etc. to
round down even for negative values. */
if (gx < 0)
gx -= width - 1;
gy -= height - 1;
gx = (gx + width - 1) / width * width;
gy = (gy + height - 1) / height * height;
-
+
last_mouse_glyph.width = width;
last_mouse_glyph.height = height;
last_mouse_glyph.x = gx;
}
-#ifdef USE_X_TOOLKIT
-
-/* Atimer callback function for TIMER. Called every 0.1s to process
- Xt timeouts, if needed. We must avoid calling XtAppPending as
- much as possible because that function does an implicit XFlush
- that slows us down. */
-
-static void
-x_process_timeouts (timer)
- struct atimer *timer;
-{
- if (toolkit_scroll_bar_interaction || popup_activated_flag)
- {
- BLOCK_INPUT;
- while (XtAppPending (Xt_app_con) & XtIMTimer)
- XtAppProcessEvent (Xt_app_con, XtIMTimer);
- UNBLOCK_INPUT;
- }
-}
-
-#endif /* USE_X_TOOLKIT */
-
\f
+/***********************************************************************
+ Scroll bars
+ ***********************************************************************/
+
/* Scroll bar support. */
/* Given an X window ID, find the struct scroll_bar which manages it.
{
Lisp_Object tail;
+#ifdef USE_GTK
+ window_id = (Window) xg_get_scroll_id_for_window (window_id);
+#endif /* USE_GTK */
+
for (tail = Vframe_list;
XGCTYPE (tail) == Lisp_Cons;
tail = XCDR (tail))
Window window;
{
Lisp_Object tail;
-
+
for (tail = Vframe_list;
XGCTYPE (tail) == Lisp_Cons;
tail = XCDR (tail))
{
Lisp_Object frame = XCAR (tail);
Widget menu_bar = XFRAME (frame)->output_data.x->menubar_widget;
-
+
if (menu_bar && xlwmenu_window_p (menu_bar, window))
return menu_bar;
}
int, int, int));
-/* Id of action hook installed for scroll bars. */
-
-static XtActionHookId action_hook_id;
-
/* Lisp window being scrolled. Set when starting to interact with
a toolkit scroll bar, reset to nil when ending the interaction. */
/* Whether this is an Xaw with arrow-scrollbars. This should imply
that movements of 1/20 of the screen size are mapped to up/down. */
+#ifndef USE_GTK
+/* Id of action hook installed for scroll bars. */
+
+static XtActionHookId action_hook_id;
+
static Boolean xaw3d_arrow_scroll;
/* Whether the drag scrolling maintains the mouse at the top of the
static Boolean xaw3d_pick_top;
+extern void set_vertical_scroll_bar P_ ((struct window *));
/* Action hook installed via XtAppAddActionHook when toolkit scroll
bars are used.. The hook is responsible for detecting when
the user ends an interaction with the scroll bar, and generates
- a `end-scroll' scroll_bar_click' event if so. */
+ a `end-scroll' SCROLL_BAR_CLICK_EVENT' event if so. */
static void
xt_action_hook (widget, client_data, action_name, event, params,
{
int scroll_bar_p;
char *end_action;
-
+
#ifdef USE_MOTIF
scroll_bar_p = XmIsScrollBar (widget);
end_action = "Release";
&& WINDOWP (window_being_scrolled))
{
struct window *w;
-
+
x_send_scroll_bar_event (window_being_scrolled,
scroll_bar_end_scroll, 0, 0);
w = XWINDOW (window_being_scrolled);
- XSCROLL_BAR (w->vertical_scroll_bar)->dragging = Qnil;
+
+ if (!NILP (XSCROLL_BAR (w->vertical_scroll_bar)->dragging))
+ {
+ XSCROLL_BAR (w->vertical_scroll_bar)->dragging = Qnil;
+ /* The thumb size is incorrect while dragging: fix it. */
+ set_vertical_scroll_bar (w);
+ }
window_being_scrolled = Qnil;
last_scroll_bar_part = -1;
toolkit_scroll_bar_interaction = 0;
}
}
+#endif /* not USE_GTK */
/* A vector of windows used for communication between
x_send_scroll_bar_event and x_scroll_bar_to_input_event. */
int i;
BLOCK_INPUT;
-
+
/* Construct a ClientMessage event to send to the frame. */
ev->type = ClientMessage;
ev->message_type = FRAME_X_DISPLAY_INFO (f)->Xatom_Scrollbar;
int new_size = max (10, 2 * scroll_bar_windows_size);
size_t nbytes = new_size * sizeof *scroll_bar_windows;
size_t old_nbytes = scroll_bar_windows_size * sizeof *scroll_bar_windows;
-
+
scroll_bar_windows = (struct window **) xrealloc (scroll_bar_windows,
nbytes);
bzero (&scroll_bar_windows[i], nbytes - old_nbytes);
Lisp_Object window;
struct frame *f;
struct window *w;
-
+
w = scroll_bar_windows[ev->data.l[0]];
scroll_bar_windows[ev->data.l[0]] = NULL;
XSETWINDOW (window, w);
f = XFRAME (w->frame);
-
- ievent->kind = scroll_bar_click;
+
+ ievent->kind = SCROLL_BAR_CLICK_EVENT;
ievent->frame_or_window = window;
ievent->arg = Qnil;
+#ifdef USE_GTK
+ ievent->timestamp = CurrentTime;
+#else
ievent->timestamp = XtLastTimestampProcessed (FRAME_X_DISPLAY (f));
+#endif
ievent->part = ev->data.l[1];
ievent->code = ev->data.l[2];
ievent->x = make_number ((int) ev->data.l[3]);
/* Minimum and maximum values used for Motif scroll bars. */
-#define XM_SB_MIN 1
#define XM_SB_MAX 10000000
-#define XM_SB_RANGE (XM_SB_MAX - XM_SB_MIN)
/* Scroll bar callback for Motif scroll bars. WIDGET is the scroll
bar widget. CLIENT_DATA is a pointer to the scroll_bar structure.
- CALL_DATA is a pointer a a XmScrollBarCallbackStruct. */
+ CALL_DATA is a pointer to a XmScrollBarCallbackStruct. */
static void
xm_scroll_callback (widget, client_data, call_data)
bar->dragging = Qnil;
part = scroll_bar_to_top;
break;
-
+
case XmCR_TO_BOTTOM:
bar->dragging = Qnil;
part = scroll_bar_to_bottom;
case XmCR_DRAG:
{
int slider_size;
- int dragging_down_p = (INTEGERP (bar->dragging)
- && XINT (bar->dragging) <= cs->value);
/* Get the slider size. */
BLOCK_INPUT;
XtVaGetValues (widget, XmNsliderSize, &slider_size, NULL);
UNBLOCK_INPUT;
- /* At the max position of the scroll bar, do a line-wise
- movement. Without doing anything, we would be called with
- the same cs->value again and again. If we want to make
- sure that we can reach the end of the buffer, we have to do
- something.
-
- Implementation note: setting bar->dragging always to
- cs->value gives a smoother movement at the max position.
- Setting it to nil when doing line-wise movement gives
- a better slider behavior. */
-
- if (cs->value + slider_size == XM_SB_MAX
- || (dragging_down_p
- && last_scroll_bar_part == scroll_bar_down_arrow))
- {
- part = scroll_bar_down_arrow;
- bar->dragging = Qnil;
- }
- else
- {
- whole = XM_SB_RANGE;
- portion = min (cs->value - XM_SB_MIN, XM_SB_MAX - slider_size);
- part = scroll_bar_handle;
- bar->dragging = make_number (cs->value);
- }
+ whole = XM_SB_MAX - slider_size;
+ portion = min (cs->value, whole);
+ part = scroll_bar_handle;
+ bar->dragging = make_number (cs->value);
}
break;
-
+
case XmCR_VALUE_CHANGED:
break;
};
}
-#else /* !USE_MOTIF, i.e. Xaw. */
+#else /* !USE_MOTIF, i.e. Xaw or GTK */
+#ifdef USE_GTK
+/* Scroll bar callback for GTK scroll bars. WIDGET is the scroll
+ bar widget. DATA is a pointer to the scroll_bar structure. */
+
+static void
+xg_scroll_callback (widget, data)
+ GtkRange *widget;
+ gpointer data;
+{
+ struct scroll_bar *bar = (struct scroll_bar *) data;
+ gdouble previous;
+ gdouble position;
+ gdouble *p;
+ int diff;
+
+ int part = -1, whole = 0, portion = 0;
+ GtkAdjustment *adj = GTK_ADJUSTMENT (gtk_range_get_adjustment (widget));
+
+ if (xg_ignore_gtk_scrollbar) return;
+
+ position = gtk_adjustment_get_value (adj);
+
+ p = g_object_get_data (G_OBJECT (widget), XG_LAST_SB_DATA);
+ if (! p)
+ {
+ p = (gdouble*) xmalloc (sizeof (gdouble));
+ *p = XG_SB_MIN;
+ g_object_set_data (G_OBJECT (widget), XG_LAST_SB_DATA, p);
+ }
+
+ previous = *p;
+ *p = position;
+
+ diff = (int) (position - previous);
+
+ if (diff == (int) adj->step_increment)
+ {
+ part = scroll_bar_down_arrow;
+ bar->dragging = Qnil;
+ }
+ else if (-diff == (int) adj->step_increment)
+ {
+ part = scroll_bar_up_arrow;
+ bar->dragging = Qnil;
+ }
+ else if (diff == (int) adj->page_increment)
+ {
+ part = scroll_bar_below_handle;
+ bar->dragging = Qnil;
+ }
+ else if (-diff == (int) adj->page_increment)
+ {
+ part = scroll_bar_above_handle;
+ bar->dragging = Qnil;
+ }
+ else
+ {
+ part = scroll_bar_handle;
+ whole = adj->upper - adj->page_size;
+ portion = min ((int)position, whole);
+ bar->dragging = make_number ((int)portion);
+ }
+
+ if (part >= 0)
+ {
+ window_being_scrolled = bar->window;
+ last_scroll_bar_part = part;
+ x_send_scroll_bar_event (bar->window, part, portion, whole);
+ }
+}
+#else /* not USE_GTK */
/* Xaw scroll bar callback. Invoked when the thumb is dragged.
WIDGET is the scroll bar widget. CLIENT_DATA is a pointer to the
x_send_scroll_bar_event (bar->window, part, position, height);
}
-
+#endif /* not USE_GTK */
#endif /* not USE_MOTIF */
+#define SCROLL_BAR_NAME "verticalScrollBar"
/* Create the widget for scroll bar BAR on frame F. Record the widget
and X window of the scroll bar in BAR. */
+#ifdef USE_GTK
+static void
+x_create_toolkit_scroll_bar (f, bar)
+ struct frame *f;
+ struct scroll_bar *bar;
+{
+ char *scroll_bar_name = SCROLL_BAR_NAME;
+
+ BLOCK_INPUT;
+ xg_create_scroll_bar (f, bar, G_CALLBACK (xg_scroll_callback),
+ scroll_bar_name);
+ UNBLOCK_INPUT;
+}
+
+#else /* not USE_GTK */
+
static void
x_create_toolkit_scroll_bar (f, bar)
struct frame *f;
Widget widget;
Arg av[20];
int ac = 0;
- char *scroll_bar_name = "verticalScrollBar";
+ char *scroll_bar_name = SCROLL_BAR_NAME;
unsigned long pixel;
BLOCK_INPUT;
#ifdef USE_MOTIF
/* Set resources. Create the widget. */
XtSetArg (av[ac], XtNmappedWhenManaged, False); ++ac;
- XtSetArg (av[ac], XmNminimum, XM_SB_MIN); ++ac;
+ XtSetArg (av[ac], XmNminimum, 0); ++ac;
XtSetArg (av[ac], XmNmaximum, XM_SB_MAX); ++ac;
XtSetArg (av[ac], XmNorientation, XmVERTICAL); ++ac;
XtSetArg (av[ac], XmNprocessingDirection, XmMAX_ON_BOTTOM), ++ac;
XtSetArg (av[ac], XmNforeground, pixel);
++ac;
}
-
+
pixel = f->output_data.x->scroll_bar_background_pixel;
if (pixel != -1)
{
XtSetArg (av[ac], XmNbackground, pixel);
++ac;
}
-
+
widget = XmCreateScrollBar (f->output_data.x->edit_widget,
scroll_bar_name, av, ac);
(XtPointer) bar);
XtAddCallback (widget, XmNtoTopCallback, xm_scroll_callback,
(XtPointer) bar);
-
+
/* Realize the widget. Only after that is the X window created. */
XtRealizeWidget (widget);
And I'm wondering why it hasn't an arrow cursor by default. */
XDefineCursor (XtDisplay (widget), XtWindow (widget),
f->output_data.x->nontext_cursor);
-
+
#else /* !USE_MOTIF i.e. use Xaw */
-
+
/* Set resources. Create the widget. The background of the
Xaw3d scroll bar widget is a little bit light for my taste.
We don't alter it here to let users change it according
XtSetArg (av[ac], XtNorientation, XtorientVertical); ++ac;
/* For smoother scrolling with Xaw3d -sm */
/* XtSetArg (av[ac], XtNpickTop, True); ++ac; */
-
+
pixel = f->output_data.x->scroll_bar_foreground_pixel;
if (pixel != -1)
{
XtSetArg (av[ac], XtNforeground, pixel);
++ac;
}
-
+
pixel = f->output_data.x->scroll_bar_background_pixel;
if (pixel != -1)
{
XtVaSetValues (widget, XtNcursorName, "top_left_arrow", NULL);
}
}
-
+
/* Define callbacks. */
XtAddCallback (widget, XtNjumpProc, xaw_jump_callback, (XtPointer) bar);
XtAddCallback (widget, XtNscrollProc, xaw_scroll_callback,
(XtPointer) bar);
-
+
/* Realize the widget. Only after that is the X window created. */
XtRealizeWidget (widget);
-
+
#endif /* !USE_MOTIF */
- /* Install an action hook that let's us detect when the user
+ /* Install an action hook that lets us detect when the user
finishes interacting with a scroll bar. */
if (action_hook_id == 0)
action_hook_id = XtAppAddActionHook (Xt_app_con, xt_action_hook, 0);
-
+
/* Remember X window and widget in the scroll bar vector. */
SET_SCROLL_BAR_X_WIDGET (bar, widget);
xwindow = XtWindow (widget);
UNBLOCK_INPUT;
}
+#endif /* not USE_GTK */
/* Set the thumb size and position of scroll bar BAR. We are currently
displaying PORTION out of a whole WHOLE, and our position POSITION. */
+#ifdef USE_GTK
+static void
+x_set_toolkit_scroll_bar_thumb (bar, portion, position, whole)
+ struct scroll_bar *bar;
+ int portion, position, whole;
+{
+ xg_set_toolkit_scroll_bar_thumb (bar, portion, position, whole);
+}
+
+#else /* not USE_GTK */
static void
x_set_toolkit_scroll_bar_thumb (bar, portion, position, whole)
struct scroll_bar *bar;
Widget widget = SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar);
float top, shown;
- if (whole == 0)
+ BLOCK_INPUT;
+
+#ifdef USE_MOTIF
+
+ /* We use an estimate of 30 chars per line rather than the real
+ `portion' value. This has the disadvantage that the thumb size
+ is not very representative, but it makes our life a lot easier.
+ Otherwise, we have to constantly adjust the thumb size, which
+ we can't always do quickly enough: while dragging, the size of
+ the thumb might prevent the user from dragging the thumb all the
+ way to the end. but Motif and some versions of Xaw3d don't allow
+ updating the thumb size while dragging. Also, even if we can update
+ its size, the update will often happen too late.
+ If you don't believe it, check out revision 1.650 of xterm.c to see
+ what hoops we were going through and the still poor behavior we got. */
+ portion = WINDOW_TOTAL_LINES (XWINDOW (bar->window)) * 30;
+ /* When the thumb is at the bottom, position == whole.
+ So we need to increase `whole' to make space for the thumb. */
+ whole += portion;
+
+ if (whole <= 0)
top = 0, shown = 1;
else
{
shown = (float) portion / whole;
}
- BLOCK_INPUT;
-
-#ifdef USE_MOTIF
- {
- int size, value;
+ if (NILP (bar->dragging))
+ {
+ int size, value;
- /* Slider size. Must be in the range [1 .. MAX - MIN] where MAX
- is the scroll bar's maximum and MIN is the scroll bar's minimum
- value. */
- size = shown * XM_SB_RANGE;
- size = min (size, XM_SB_RANGE);
- size = max (size, 1);
+ /* Slider size. Must be in the range [1 .. MAX - MIN] where MAX
+ is the scroll bar's maximum and MIN is the scroll bar's minimum
+ value. */
+ size = shown * XM_SB_MAX;
+ size = min (size, XM_SB_MAX);
+ size = max (size, 1);
- /* Position. Must be in the range [MIN .. MAX - SLIDER_SIZE]. */
- value = top * XM_SB_RANGE;
- value = min (value, XM_SB_MAX - size);
- value = max (value, XM_SB_MIN);
+ /* Position. Must be in the range [MIN .. MAX - SLIDER_SIZE]. */
+ value = top * XM_SB_MAX;
+ value = min (value, XM_SB_MAX - size);
- if (NILP (bar->dragging))
XmScrollBarSetValues (widget, value, size, 0, 0, False);
- else if (last_scroll_bar_part == scroll_bar_down_arrow)
- /* This has the negative side effect that the slider value is
- not what it would be if we scrolled here using line-wise or
- page-wise movement. */
- XmScrollBarSetValues (widget, value, XM_SB_RANGE - value, 0, 0, False);
- else
- {
- /* If currently dragging, only update the slider size.
- This reduces flicker effects. */
- int old_value, old_size, increment, page_increment;
-
- XmScrollBarGetValues (widget, &old_value, &old_size,
- &increment, &page_increment);
- XmScrollBarSetValues (widget, old_value,
- min (size, XM_SB_RANGE - old_value),
- 0, 0, False);
- }
- }
+ }
#else /* !USE_MOTIF i.e. use Xaw */
+
+ if (whole == 0)
+ top = 0, shown = 1;
+ else
+ {
+ top = (float) position / whole;
+ shown = (float) portion / whole;
+ }
+
{
float old_top, old_shown;
Dimension height;
#ifdef HAVE_XAW3D
ScrollbarWidget sb = (ScrollbarWidget) widget;
int scroll_mode = 0;
-
+
/* `scroll_mode' only exists with Xaw3d + ARROW_SCROLLBAR. */
if (xaw3d_arrow_scroll)
{
/* Try to make the scrolling a tad smoother. */
if (!xaw3d_pick_top)
shown = min (shown, old_shown);
-
+
XawScrollbarSetThumb (widget, top, shown);
-
+
#ifdef HAVE_XAW3D
if (xaw3d_arrow_scroll && scroll_mode == 2)
sb->scrollbar.scroll_mode = scroll_mode;
UNBLOCK_INPUT;
}
+#endif /* not USE_GTK */
#endif /* USE_TOOLKIT_SCROLL_BARS */
/************************************************************************
Scroll bars, general
************************************************************************/
-
+
/* Create a scroll bar and return the scroll bar vector for it. W is
the Emacs window on which to create the scroll bar. TOP, LEFT,
- WIDTH and HEIGHT are.the pixel coordinates and dimensions of the
+ WIDTH and HEIGHT are the pixel coordinates and dimensions of the
scroll bar. */
static struct scroll_bar *
a.background_pixel = f->output_data.x->scroll_bar_background_pixel;
if (a.background_pixel == -1)
a.background_pixel = f->output_data.x->background_pixel;
-
+
a.event_mask = (ButtonPressMask | ButtonReleaseMask
| ButtonMotionMask | PointerMotionHintMask
| ExposureMask);
/* Map the window/widget. */
#ifdef USE_TOOLKIT_SCROLL_BARS
{
+#ifdef USE_GTK
+ xg_update_scrollbar_pos (f,
+ SCROLL_BAR_X_WINDOW (bar),
+ top,
+ left + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
+ width - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
+ max (height, 1),
+ left,
+ width);
+ xg_show_scroll_bar (SCROLL_BAR_X_WINDOW (bar));
+#else /* not USE_GTK */
Widget scroll_bar = SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar);
XtConfigureWidget (scroll_bar,
left + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
width - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
max (height, 1), 0);
XtMapWidget (scroll_bar);
+#endif /* not USE_GTK */
}
#else /* not USE_TOOLKIT_SCROLL_BARS */
XMapRaised (FRAME_X_DISPLAY (f), SCROLL_BAR_X_WINDOW (bar));
/* Draw BAR's handle in the proper position.
-
+
If the handle is already drawn from START to END, don't bother
redrawing it, unless REBUILD is non-zero; in that case, always
redraw it. (REBUILD is handy for drawing the handle after expose
BLOCK_INPUT;
#ifdef USE_TOOLKIT_SCROLL_BARS
+#ifdef USE_GTK
+ xg_remove_scroll_bar (f, SCROLL_BAR_X_WINDOW (bar));
+#else /* not USE_GTK */
XtDestroyWidget (SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar));
+#endif /* not USE_GTK */
#else
XDestroyWindow (FRAME_X_DISPLAY (f), SCROLL_BAR_X_WINDOW (bar));
#endif
-
+
/* Disassociate this scroll bar from its window. */
XWINDOW (bar->window)->vertical_scroll_bar = Qnil;
struct frame *f = XFRAME (w->frame);
struct scroll_bar *bar;
int top, height, left, sb_left, width, sb_width;
- int window_x, window_y, window_width, window_height;
+ int window_y, window_height;
/* Get window dimensions. */
- window_box (w, -1, &window_x, &window_y, &window_width, &window_height);
+ window_box (w, -1, 0, &window_y, 0, &window_height);
top = window_y;
- width = FRAME_SCROLL_BAR_COLS (f) * CANON_X_UNIT (f);
+ width = WINDOW_CONFIG_SCROLL_BAR_COLS (w) * FRAME_COLUMN_WIDTH (f);
height = window_height;
/* Compute the left edge of the scroll bar area. */
- if (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
- left = XINT (w->left) + XINT (w->width) - FRAME_SCROLL_BAR_COLS (f);
- else
- left = XFASTINT (w->left);
- left *= CANON_X_UNIT (f);
- left += FRAME_INTERNAL_BORDER_WIDTH (f);
+ left = WINDOW_SCROLL_BAR_AREA_X (w);
/* Compute the width of the scroll bar which might be less than
the width of the area reserved for the scroll bar. */
- if (FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0)
- sb_width = FRAME_SCROLL_BAR_PIXEL_WIDTH (f);
+ if (WINDOW_CONFIG_SCROLL_BAR_WIDTH (w) > 0)
+ sb_width = WINDOW_CONFIG_SCROLL_BAR_WIDTH (w);
else
sb_width = width;
/* Compute the left edge of the scroll bar. */
#ifdef USE_TOOLKIT_SCROLL_BARS
- if (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
- sb_left = left + width - sb_width - (width - sb_width) / 2;
+ if (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w))
+ sb_left = left + width - sb_width - (width - sb_width) / 2;
else
sb_left = left + (width - sb_width) / 2;
#else
- if (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
- sb_left = left + width - sb_width;
+ if (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w))
+ sb_left = left + width - sb_width;
else
sb_left = left;
#endif
-
+
/* Does the scroll bar exist yet? */
if (NILP (w->vertical_scroll_bar))
{
left, top, width, height, False);
UNBLOCK_INPUT;
}
-
+
bar = x_scroll_bar_create (w, top, sb_left, sb_width, height);
}
else
{
/* It may just need to be moved and resized. */
unsigned int mask = 0;
-
+
bar = XSCROLL_BAR (w->vertical_scroll_bar);
BLOCK_INPUT;
mask |= CWY;
if (sb_width != XINT (bar->width))
mask |= CWWidth;
- if (height != XINT (bar->height))
+ if (height != XINT (bar->height))
mask |= CWHeight;
-
+
#ifdef USE_TOOLKIT_SCROLL_BARS
+#ifdef USE_GTK
+ if (mask)
+ xg_update_scrollbar_pos (f,
+ SCROLL_BAR_X_WINDOW (bar),
+ top,
+ sb_left + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
+ sb_width - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
+ max (height, 1),
+ left,
+ width);
+#else /* not USE_GTK */
+
/* Since toolkit scroll bars are smaller than the space reserved
- for them on the frame, we have to clear "under" them. */
+ for them on the frame, we have to clear "under" them. */
if (width > 0 && height > 0)
- x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- left, top, width, height, False);
-
+ x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ left, top, width, height, False);
/* Move/size the scroll bar widget. */
if (mask)
- XtConfigureWidget (SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar),
- sb_left + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
- top,
- sb_width - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
- max (height, 1), 0);
+ XtConfigureWidget (SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar),
+ sb_left + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
+ top,
+ sb_width - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
+ max (height, 1), 0);
+#endif /* not USE_GTK */
#else /* not USE_TOOLKIT_SCROLL_BARS */
-
+
/* Clear areas not covered by the scroll bar because of
VERTICAL_SCROLL_BAR_WIDTH_TRIM. */
if (VERTICAL_SCROLL_BAR_WIDTH_TRIM)
}
/* Clear areas not covered by the scroll bar because it's not as
- wide as the area reserved for it . This makes sure a
+ wide as the area reserved for it. This makes sure a
previous mode line display is cleared after C-x 2 C-x 1, for
example. */
{
- int area_width = FRAME_SCROLL_BAR_COLS (f) * CANON_X_UNIT (f);
+ int area_width = WINDOW_CONFIG_SCROLL_BAR_COLS (w) * FRAME_COLUMN_WIDTH (f);
int rest = area_width - sb_width;
if (rest > 0 && height > 0)
{
- if (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
+ if (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w))
x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
left + area_width - rest, top,
rest, height, False);
left, top, rest, height, False);
}
}
-
+
/* Move/size the scroll bar window. */
if (mask)
{
XWindowChanges wc;
-
+
wc.x = sb_left + VERTICAL_SCROLL_BAR_WIDTH_TRIM;
wc.y = top;
wc.width = sb_width - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2;
XConfigureWindow (FRAME_X_DISPLAY (f), SCROLL_BAR_X_WINDOW (bar),
mask, &wc);
}
-
+
#endif /* not USE_TOOLKIT_SCROLL_BARS */
/* Remember new settings. */
XSETINT (bar->top, top);
XSETINT (bar->width, sb_width);
XSETINT (bar->height, height);
-
+
UNBLOCK_INPUT;
}
}
+#ifndef USE_TOOLKIT_SCROLL_BARS
/* Handle an Expose or GraphicsExpose event on a scroll bar. This
is a no-op when using toolkit scroll bars.
struct scroll_bar *bar;
XEvent *event;
{
-#ifndef USE_TOOLKIT_SCROLL_BARS
-
Window w = SCROLL_BAR_X_WINDOW (bar);
FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window)));
GC gc = f->output_data.x->normal_gc;
0, 0,
XINT (bar->width) - 1 - width_trim - width_trim,
XINT (bar->height) - 1);
-
+
UNBLOCK_INPUT;
-#endif /* not USE_TOOLKIT_SCROLL_BARS */
}
+#endif /* not USE_TOOLKIT_SCROLL_BARS */
/* Handle a mouse click on the scroll bar BAR. If *EMACS_EVENT's kind
- is set to something other than no_event, it is enqueued.
+ is set to something other than NO_EVENT, it is enqueued.
This may be called from a signal handler, so we have to ignore GC
mark bits. */
-#ifndef USE_TOOLKIT_SCROLL_BARS
static void
x_scroll_bar_handle_click (bar, event, emacs_event)
if (! GC_WINDOWP (bar->window))
abort ();
- emacs_event->kind = scroll_bar_click;
+ emacs_event->kind = SCROLL_BAR_CLICK_EVENT;
emacs_event->code = event->xbutton.button - Button1;
emacs_event->modifiers
- = (x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO
+ = (x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO
(XFRAME (WINDOW_FRAME (XWINDOW (bar->window)))),
event->xbutton.state)
| (event->type == ButtonRelease
XSETINT (bar->dragging, y - XINT (bar->start));
#endif
+#ifndef USE_TOOLKIT_SCROLL_BARS
/* If the user has released the handle, set it to its final position. */
if (event->type == ButtonRelease
&& ! NILP (bar->dragging))
x_scroll_bar_set_handle (bar, new_start, new_end, 0);
bar->dragging = Qnil;
}
+#endif
/* Same deal here as the other #if 0. */
#if 0
}
}
+#ifndef USE_TOOLKIT_SCROLL_BARS
+
/* Handle some mouse motion while someone is dragging the scroll bar.
This may be called from a signal handler, so we have to ignore GC
#endif /* not USE_TOOLKIT_SCROLL_BARS */
}
-/* This processes Expose events from the menu-bar specific X event
- loop in xmenu.c. This allows to redisplay the frame if necessary
- when handling menu-bar or pop-up items. */
-
-int
-process_expose_from_menu (event)
- XEvent event;
-{
- FRAME_PTR f;
- struct x_display_info *dpyinfo;
- int frame_exposed_p = 0;
-
- BLOCK_INPUT;
-
- dpyinfo = x_display_info_for_display (event.xexpose.display);
- f = x_window_to_frame (dpyinfo, event.xexpose.window);
- if (f)
- {
- if (f->async_visible == 0)
- {
- f->async_visible = 1;
- f->async_iconified = 0;
- f->output_data.x->has_been_visible = 1;
- SET_FRAME_GARBAGED (f);
- }
- else
- {
- expose_frame (x_window_to_frame (dpyinfo, event.xexpose.window),
- event.xexpose.x, event.xexpose.y,
- event.xexpose.width, event.xexpose.height);
- frame_exposed_p = 1;
- }
- }
- else
- {
- struct scroll_bar *bar
- = x_window_to_scroll_bar (event.xexpose.window);
-
- if (bar)
- x_scroll_bar_expose (bar, &event);
- }
-
- UNBLOCK_INPUT;
- return frame_exposed_p;
-}
\f
/* Define a queue to save up SelectionRequest events for later handling. */
bcopy (&event, f->output_data.x->saved_menu_event, size); \
if (numchars >= 1) \
{ \
- bufp->kind = menu_bar_activate_event; \
+ bufp->kind = MENU_BAR_ACTIVATE_EVENT; \
XSETFRAME (bufp->frame_or_window, f); \
bufp->arg = Qnil; \
bufp++; \
#define SET_SAVED_BUTTON_EVENT SET_SAVED_MENU_EVENT (sizeof (XButtonEvent))
#define SET_SAVED_KEY_EVENT SET_SAVED_MENU_EVENT (sizeof (XKeyEvent))
-/* Read events coming from the X server.
- This routine is called by the SIGIO handler.
- We return as soon as there are no more events to be read.
- Events representing keys are stored in buffer BUFP,
- which can hold up to NUMCHARS characters.
- We return the number of characters stored into the buffer,
- thus pretending to be `read'.
+enum
+{
+ X_EVENT_NORMAL,
+ X_EVENT_GOTO_OUT,
+ X_EVENT_DROP
+};
- EXPECTED is nonzero if the caller knows input is available. */
+/* Filter events for the current X input method.
+ DPYINFO is the display this event is for.
+ EVENT is the X event to filter.
-int
-XTread_socket (sd, bufp, numchars, expected)
- register int sd;
- /* register */ struct input_event *bufp;
- /* register */ int numchars;
- int expected;
-{
- int count = 0;
- int nbytes = 0;
- XEvent event;
- struct frame *f;
- int event_found = 0;
- struct x_display_info *dpyinfo;
- struct coding_system coding;
+ Returns non-zero if the event was filtered, caller shall not process
+ this event further.
+ Returns zero if event is wasn't filtered. */
- if (interrupt_input_blocked)
- {
- interrupt_input_pending = 1;
- return -1;
- }
+#ifdef HAVE_X_I18N
+static int
+x_filter_event (dpyinfo, event)
+ struct x_display_info *dpyinfo;
+ XEvent *event;
+{
+ /* XFilterEvent returns non-zero if the input method has
+ consumed the event. We pass the frame's X window to
+ XFilterEvent because that's the one for which the IC
+ was created. */
- interrupt_input_pending = 0;
- BLOCK_INPUT;
+ struct frame *f1 = x_any_window_to_frame (dpyinfo,
+ event->xclient.window);
- /* So people can tell when we have read the available input. */
- input_signal_count++;
+ return XFilterEvent (event, f1 ? FRAME_X_WINDOW (f1) : None);
+}
+#endif
- if (numchars <= 0)
- abort (); /* Don't think this happens. */
+#ifdef USE_GTK
+static struct x_display_info *current_dpyinfo;
+static struct input_event **current_bufp;
+static int *current_numcharsp;
+static int current_count;
+static int current_finish;
- ++handling_signal;
-
- /* The input should be decoded if it is from XIM. Currently the
- locale of XIM is the same as that of the system. So, we can use
- Vlocale_coding_system which is initialized properly at Emacs
- startup time. */
- setup_coding_system (Vlocale_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;
+/* This is the filter function invoked by the GTK event loop.
+ It is invoked before the XEvent is translated to a GdkEvent,
+ so we have a chanse to act on the event before GTK. */
+static GdkFilterReturn
+event_handler_gdk (gxev, ev, data)
+ GdkXEvent *gxev;
+ GdkEvent *ev;
+ gpointer data;
+{
+ XEvent *xev = (XEvent*)gxev;
- /* Find the display we are supposed to read input for.
- It's the one communicating on descriptor SD. */
- for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
+ if (current_numcharsp)
{
-#if 0 /* This ought to be unnecessary; let's verify it. */
-#ifdef FIOSNBIO
- /* If available, Xlib uses FIOSNBIO to make the socket
- non-blocking, and then looks for EWOULDBLOCK. If O_NDELAY is set,
- FIOSNBIO is ignored, and instead of signaling EWOULDBLOCK,
- a read returns 0, which Xlib interprets as equivalent to EPIPE. */
- fcntl (dpyinfo->connection, F_SETFL, 0);
-#endif /* ! defined (FIOSNBIO) */
+#ifdef HAVE_X_I18N
+ /* Filter events for the current X input method.
+ GTK calls XFilterEvent but not for key press and release,
+ so we do it here. */
+ if (xev->type == KeyPress || xev->type == KeyRelease)
+ if (x_filter_event (current_dpyinfo, xev))
+ return GDK_FILTER_REMOVE;
#endif
+ current_count += handle_one_xevent (current_dpyinfo,
+ xev,
+ current_bufp,
+ current_numcharsp,
+ ¤t_finish);
+ }
+ else
+ current_finish = x_dispatch_event (xev, GDK_DISPLAY ());
-#if 0 /* This code can't be made to work, with multiple displays,
- and appears not to be used on any system any more.
- Also keyboard.c doesn't turn O_NDELAY on and off
- for X connections. */
-#ifndef SIGIO
-#ifndef HAVE_SELECT
- if (! (fcntl (dpyinfo->connection, F_GETFL, 0) & O_NDELAY))
- {
- extern int read_alarm_should_throw;
- read_alarm_should_throw = 1;
- XPeekEvent (dpyinfo->display, &event);
- read_alarm_should_throw = 0;
- }
-#endif /* HAVE_SELECT */
-#endif /* SIGIO */
-#endif
+ if (current_finish == X_EVENT_GOTO_OUT || current_finish == X_EVENT_DROP)
+ return GDK_FILTER_REMOVE;
- /* For debugging, this gives a way to fake an I/O error. */
- if (dpyinfo == XTread_socket_fake_io_error)
- {
- XTread_socket_fake_io_error = 0;
- x_io_error_quitter (dpyinfo->display);
- }
+ return GDK_FILTER_CONTINUE;
+}
+#endif /* USE_GTK */
- while (XPending (dpyinfo->display))
- {
- XNextEvent (dpyinfo->display, &event);
-#ifdef HAVE_X_I18N
- {
- /* Filter events for the current X input method.
- XFilterEvent returns non-zero if the input method has
- consumed the event. We pass the frame's X window to
- XFilterEvent because that's the one for which the IC
- was created. */
- struct frame *f1 = x_any_window_to_frame (dpyinfo,
- event.xclient.window);
- if (XFilterEvent (&event, f1 ? FRAME_X_WINDOW (f1) : None))
- break;
- }
-#endif
- event_found = 1;
+/* Handles the XEvent EVENT on display DPYINFO.
- switch (event.type)
- {
- case ClientMessage:
- {
- if (event.xclient.message_type
- == dpyinfo->Xatom_wm_protocols
- && event.xclient.format == 32)
- {
- if (event.xclient.data.l[0]
- == dpyinfo->Xatom_wm_take_focus)
- {
- /* Use x_any_window_to_frame because this
- could be the shell widget window
- if the frame has no title bar. */
- f = x_any_window_to_frame (dpyinfo, event.xclient.window);
+ *FINISH is X_EVENT_GOTO_OUT if caller should stop reading events.
+ *FINISH is zero if caller should continue reading events.
+ *FINISH is X_EVENT_DROP if event should not be passed to the toolkit.
+
+ Events representing keys are stored in buffer *BUFP_R,
+ which can hold up to *NUMCHARSP characters.
+ We return the number of characters stored into the buffer. */
+
+static int
+handle_one_xevent (dpyinfo, eventp, bufp_r, numcharsp, finish)
+ struct x_display_info *dpyinfo;
+ XEvent *eventp;
+ /* register */ struct input_event **bufp_r;
+ /* register */ int *numcharsp;
+ int *finish;
+{
+ int count = 0;
+ int nbytes = 0;
+ struct frame *f;
+ struct coding_system coding;
+ struct input_event *bufp = *bufp_r;
+ int numchars = *numcharsp;
+ XEvent event = *eventp;
+
+ *finish = X_EVENT_NORMAL;
+
+ switch (event.type)
+ {
+ case ClientMessage:
+ {
+ if (event.xclient.message_type
+ == dpyinfo->Xatom_wm_protocols
+ && event.xclient.format == 32)
+ {
+ if (event.xclient.data.l[0]
+ == dpyinfo->Xatom_wm_take_focus)
+ {
+ /* Use x_any_window_to_frame because this
+ could be the shell widget window
+ if the frame has no title bar. */
+ f = x_any_window_to_frame (dpyinfo, event.xclient.window);
#ifdef HAVE_X_I18N
- /* Not quite sure this is needed -pd */
- if (f && FRAME_XIC (f))
- XSetICFocus (FRAME_XIC (f));
+ /* Not quite sure this is needed -pd */
+ if (f && FRAME_XIC (f))
+ XSetICFocus (FRAME_XIC (f));
#endif
#if 0 /* Emacs sets WM hints whose `input' field is `true'. This
instructs the WM to set the input focus automatically for
below are temporally close (on a fast machine), the call
below can generate additional FocusIn events which confuse
Emacs. */
-
- /* Since we set WM_TAKE_FOCUS, we must call
- XSetInputFocus explicitly. But not if f is null,
- since that might be an event for a deleted frame. */
- if (f)
- {
- Display *d = event.xclient.display;
- /* Catch and ignore errors, in case window has been
- iconified by a window manager such as GWM. */
- int count = x_catch_errors (d);
- XSetInputFocus (d, event.xclient.window,
- /* The ICCCM says this is
- the only valid choice. */
- RevertToParent,
- event.xclient.data.l[1]);
- /* This is needed to detect the error
- if there is an error. */
- XSync (d, False);
- x_uncatch_errors (d, count);
- }
- /* Not certain about handling scroll bars here */
-#endif /* 0 */
- }
- else if (event.xclient.data.l[0]
- == dpyinfo->Xatom_wm_save_yourself)
- {
- /* Save state modify the WM_COMMAND property to
- something which can reinstate us. This notifies
- the session manager, who's looking for such a
- PropertyNotify. Can restart processing when
- a keyboard or mouse event arrives. */
- if (numchars > 0)
- {
- f = x_top_window_to_frame (dpyinfo,
- event.xclient.window);
-
- /* This is just so we only give real data once
- for a single Emacs process. */
- if (f == SELECTED_FRAME ())
- XSetCommand (FRAME_X_DISPLAY (f),
- event.xclient.window,
- initial_argv, initial_argc);
- else if (f)
- XSetCommand (FRAME_X_DISPLAY (f),
- event.xclient.window,
- 0, 0);
- }
- }
- else if (event.xclient.data.l[0]
- == dpyinfo->Xatom_wm_delete_window)
- {
- struct frame *f
- = x_any_window_to_frame (dpyinfo,
- event.xclient.window);
-
- if (f)
- {
- if (numchars == 0)
- abort ();
-
- bufp->kind = delete_window_event;
- XSETFRAME (bufp->frame_or_window, f);
- bufp->arg = Qnil;
- bufp++;
-
- count += 1;
- numchars -= 1;
- }
- }
- }
- else if (event.xclient.message_type
- == dpyinfo->Xatom_wm_configure_denied)
- {
- }
- else if (event.xclient.message_type
- == dpyinfo->Xatom_wm_window_moved)
- {
- int new_x, new_y;
- struct frame *f
- = x_window_to_frame (dpyinfo, event.xclient.window);
- new_x = event.xclient.data.s[0];
- new_y = event.xclient.data.s[1];
-
- if (f)
- {
- f->output_data.x->left_pos = new_x;
- f->output_data.x->top_pos = new_y;
- }
- }
+ /* Since we set WM_TAKE_FOCUS, we must call
+ XSetInputFocus explicitly. But not if f is null,
+ since that might be an event for a deleted frame. */
+ if (f)
+ {
+ Display *d = event.xclient.display;
+ /* Catch and ignore errors, in case window has been
+ iconified by a window manager such as GWM. */
+ int count = x_catch_errors (d);
+ XSetInputFocus (d, event.xclient.window,
+ /* The ICCCM says this is
+ the only valid choice. */
+ RevertToParent,
+ event.xclient.data.l[1]);
+ /* This is needed to detect the error
+ if there is an error. */
+ XSync (d, False);
+ x_uncatch_errors (d, count);
+ }
+ /* Not certain about handling scroll bars here */
+#endif /* 0 */
+ }
+ else if (event.xclient.data.l[0]
+ == dpyinfo->Xatom_wm_save_yourself)
+ {
+ /* Save state modify the WM_COMMAND property to
+ something which can reinstate us. This notifies
+ the session manager, who's looking for such a
+ PropertyNotify. Can restart processing when
+ a keyboard or mouse event arrives. */
+ /* If we have a session manager, don't set this.
+ KDE will then start two Emacsen, one for the
+ session manager and one for this. */
+ if (numchars > 0
+#ifdef HAVE_X_SM
+ && ! x_session_have_connection ()
+#endif
+ )
+ {
+ f = x_top_window_to_frame (dpyinfo,
+ event.xclient.window);
+ /* This is just so we only give real data once
+ for a single Emacs process. */
+ if (f == SELECTED_FRAME ())
+ XSetCommand (FRAME_X_DISPLAY (f),
+ event.xclient.window,
+ initial_argv, initial_argc);
+ else if (f)
+ XSetCommand (FRAME_X_DISPLAY (f),
+ event.xclient.window,
+ 0, 0);
+ }
+ }
+ else if (event.xclient.data.l[0]
+ == dpyinfo->Xatom_wm_delete_window)
+ {
+ struct frame *f
+ = x_any_window_to_frame (dpyinfo,
+ event.xclient.window);
+
+ if (f)
+ {
+ if (numchars == 0)
+ abort ();
+
+ bufp->kind = DELETE_WINDOW_EVENT;
+ XSETFRAME (bufp->frame_or_window, f);
+ bufp->arg = Qnil;
+ bufp++;
+
+ count += 1;
+ numchars -= 1;
+ }
+ else
+ goto OTHER; /* May be a dialog that is to be removed */
+ }
+ }
+ else if (event.xclient.message_type
+ == dpyinfo->Xatom_wm_configure_denied)
+ {
+ }
+ else if (event.xclient.message_type
+ == dpyinfo->Xatom_wm_window_moved)
+ {
+ int new_x, new_y;
+ struct frame *f
+ = x_window_to_frame (dpyinfo, event.xclient.window);
+
+ new_x = event.xclient.data.s[0];
+ new_y = event.xclient.data.s[1];
+
+ if (f)
+ {
+ f->left_pos = new_x;
+ f->top_pos = new_y;
+ }
+ }
#ifdef HACK_EDITRES
- else if (event.xclient.message_type
- == dpyinfo->Xatom_editres)
- {
- struct frame *f
- = x_any_window_to_frame (dpyinfo, event.xclient.window);
- _XEditResCheckMessages (f->output_data.x->widget, NULL,
- &event, NULL);
- }
+ else if (event.xclient.message_type
+ == dpyinfo->Xatom_editres)
+ {
+ struct frame *f
+ = x_any_window_to_frame (dpyinfo, event.xclient.window);
+ _XEditResCheckMessages (f->output_data.x->widget, NULL,
+ &event, NULL);
+ }
#endif /* HACK_EDITRES */
- else if ((event.xclient.message_type
- == dpyinfo->Xatom_DONE)
- || (event.xclient.message_type
- == dpyinfo->Xatom_PAGE))
- {
- /* Ghostview job completed. Kill it. We could
- reply with "Next" if we received "Page", but we
- currently never do because we are interested in
- images, only, which should have 1 page. */
- Pixmap pixmap = (Pixmap) event.xclient.data.l[1];
- struct frame *f
- = x_window_to_frame (dpyinfo, event.xclient.window);
- x_kill_gs_process (pixmap, f);
- expose_frame (f, 0, 0, 0, 0);
- }
+ else if ((event.xclient.message_type
+ == dpyinfo->Xatom_DONE)
+ || (event.xclient.message_type
+ == dpyinfo->Xatom_PAGE))
+ {
+ /* Ghostview job completed. Kill it. We could
+ reply with "Next" if we received "Page", but we
+ currently never do because we are interested in
+ images, only, which should have 1 page. */
+ Pixmap pixmap = (Pixmap) event.xclient.data.l[1];
+ struct frame *f
+ = x_window_to_frame (dpyinfo, event.xclient.window);
+ x_kill_gs_process (pixmap, f);
+ expose_frame (f, 0, 0, 0, 0);
+ }
#ifdef USE_TOOLKIT_SCROLL_BARS
- /* Scroll bar callbacks send a ClientMessage from which
- we construct an input_event. */
- else if (event.xclient.message_type
- == dpyinfo->Xatom_Scrollbar)
- {
- x_scroll_bar_to_input_event (&event, bufp);
- ++bufp, ++count, --numchars;
- goto out;
- }
+ /* Scroll bar callbacks send a ClientMessage from which
+ we construct an input_event. */
+ else if (event.xclient.message_type
+ == dpyinfo->Xatom_Scrollbar)
+ {
+ x_scroll_bar_to_input_event (&event, bufp);
+ ++bufp, ++count, --numchars;
+ goto out;
+ }
#endif /* USE_TOOLKIT_SCROLL_BARS */
- else
- goto OTHER;
- }
- break;
+ else
+ goto OTHER;
+ }
+ break;
- case SelectionNotify:
+ case SelectionNotify:
#ifdef USE_X_TOOLKIT
- if (! x_window_to_frame (dpyinfo, event.xselection.requestor))
- goto OTHER;
+ if (! x_window_to_frame (dpyinfo, event.xselection.requestor))
+ goto OTHER;
#endif /* not USE_X_TOOLKIT */
- x_handle_selection_notify (&event.xselection);
- break;
+ x_handle_selection_notify (&event.xselection);
+ break;
- case SelectionClear: /* Someone has grabbed ownership. */
+ case SelectionClear: /* Someone has grabbed ownership. */
#ifdef USE_X_TOOLKIT
- if (! x_window_to_frame (dpyinfo, event.xselectionclear.window))
- goto OTHER;
+ if (! x_window_to_frame (dpyinfo, event.xselectionclear.window))
+ goto OTHER;
#endif /* USE_X_TOOLKIT */
- {
- XSelectionClearEvent *eventp = (XSelectionClearEvent *) &event;
+ {
+ XSelectionClearEvent *eventp = (XSelectionClearEvent *) &event;
- if (numchars == 0)
- abort ();
+ if (numchars == 0)
+ abort ();
- bufp->kind = selection_clear_event;
- SELECTION_EVENT_DISPLAY (bufp) = eventp->display;
- SELECTION_EVENT_SELECTION (bufp) = eventp->selection;
- SELECTION_EVENT_TIME (bufp) = eventp->time;
- bufp->frame_or_window = Qnil;
- bufp->arg = Qnil;
- bufp++;
+ bufp->kind = SELECTION_CLEAR_EVENT;
+ SELECTION_EVENT_DISPLAY (bufp) = eventp->display;
+ SELECTION_EVENT_SELECTION (bufp) = eventp->selection;
+ SELECTION_EVENT_TIME (bufp) = eventp->time;
+ bufp->frame_or_window = Qnil;
+ bufp->arg = Qnil;
+ bufp++;
- count += 1;
- numchars -= 1;
- }
- break;
+ count += 1;
+ numchars -= 1;
+ }
+ break;
- case SelectionRequest: /* Someone wants our selection. */
+ case SelectionRequest: /* Someone wants our selection. */
#ifdef USE_X_TOOLKIT
- if (!x_window_to_frame (dpyinfo, event.xselectionrequest.owner))
- goto OTHER;
+ if (!x_window_to_frame (dpyinfo, event.xselectionrequest.owner))
+ goto OTHER;
#endif /* USE_X_TOOLKIT */
- if (x_queue_selection_requests)
- x_queue_event (x_window_to_frame (dpyinfo, event.xselectionrequest.owner),
- &event);
- else
- {
- XSelectionRequestEvent *eventp
- = (XSelectionRequestEvent *) &event;
-
- if (numchars == 0)
- abort ();
-
- bufp->kind = selection_request_event;
- SELECTION_EVENT_DISPLAY (bufp) = eventp->display;
- SELECTION_EVENT_REQUESTOR (bufp) = eventp->requestor;
- SELECTION_EVENT_SELECTION (bufp) = eventp->selection;
- SELECTION_EVENT_TARGET (bufp) = eventp->target;
- SELECTION_EVENT_PROPERTY (bufp) = eventp->property;
- SELECTION_EVENT_TIME (bufp) = eventp->time;
- bufp->frame_or_window = Qnil;
- bufp->arg = Qnil;
- bufp++;
-
- count += 1;
- numchars -= 1;
- }
- break;
+ if (x_queue_selection_requests)
+ x_queue_event (x_window_to_frame (dpyinfo, event.xselectionrequest.owner),
+ &event);
+ else
+ {
+ XSelectionRequestEvent *eventp
+ = (XSelectionRequestEvent *) &event;
+
+ if (numchars == 0)
+ abort ();
+
+ bufp->kind = SELECTION_REQUEST_EVENT;
+ SELECTION_EVENT_DISPLAY (bufp) = eventp->display;
+ SELECTION_EVENT_REQUESTOR (bufp) = eventp->requestor;
+ SELECTION_EVENT_SELECTION (bufp) = eventp->selection;
+ SELECTION_EVENT_TARGET (bufp) = eventp->target;
+ SELECTION_EVENT_PROPERTY (bufp) = eventp->property;
+ SELECTION_EVENT_TIME (bufp) = eventp->time;
+ bufp->frame_or_window = Qnil;
+ bufp->arg = Qnil;
+ bufp++;
+
+ count += 1;
+ numchars -= 1;
+ }
+ break;
- case PropertyNotify:
+ case PropertyNotify:
#if 0 /* This is plain wrong. In the case that we are waiting for a
PropertyNotify used as an ACK in incremental selection
transfer, the property will be on the receiver's window. */
#if defined USE_X_TOOLKIT
- if (!x_any_window_to_frame (dpyinfo, event.xproperty.window))
- goto OTHER;
+ if (!x_any_window_to_frame (dpyinfo, event.xproperty.window))
+ goto OTHER;
#endif
#endif
- x_handle_property_notify (&event.xproperty);
- goto OTHER;
-
- case ReparentNotify:
- f = x_top_window_to_frame (dpyinfo, event.xreparent.window);
- if (f)
- {
- int x, y;
- f->output_data.x->parent_desc = event.xreparent.parent;
- x_real_positions (f, &x, &y);
- f->output_data.x->left_pos = x;
- f->output_data.x->top_pos = y;
- }
- break;
+ x_handle_property_notify (&event.xproperty);
+ goto OTHER;
- case Expose:
- f = x_window_to_frame (dpyinfo, event.xexpose.window);
- if (f)
- {
- x_check_fullscreen (f);
+ case ReparentNotify:
+ f = x_top_window_to_frame (dpyinfo, event.xreparent.window);
+ if (f)
+ {
+ int x, y;
+ f->output_data.x->parent_desc = event.xreparent.parent;
+ x_real_positions (f, &x, &y);
+ f->left_pos = x;
+ f->top_pos = y;
+ }
+ goto OTHER;
+ break;
- if (f->async_visible == 0)
- {
- f->async_visible = 1;
- f->async_iconified = 0;
- f->output_data.x->has_been_visible = 1;
- SET_FRAME_GARBAGED (f);
- }
- else
- expose_frame (x_window_to_frame (dpyinfo,
- event.xexpose.window),
- event.xexpose.x, event.xexpose.y,
- event.xexpose.width, event.xexpose.height);
- }
- else
- {
+ case Expose:
+ f = x_window_to_frame (dpyinfo, event.xexpose.window);
+ if (f)
+ {
+ x_check_fullscreen (f);
+
+ if (f->async_visible == 0)
+ {
+ f->async_visible = 1;
+ f->async_iconified = 0;
+ f->output_data.x->has_been_visible = 1;
+ SET_FRAME_GARBAGED (f);
+ }
+ else
+ expose_frame (f,
+ event.xexpose.x, event.xexpose.y,
+ event.xexpose.width, event.xexpose.height);
+ }
+ else
+ {
#ifndef USE_TOOLKIT_SCROLL_BARS
- struct scroll_bar *bar;
+ struct scroll_bar *bar;
#endif
#if defined USE_LUCID
- /* Submenus of the Lucid menu bar aren't widgets
- themselves, so there's no way to dispatch events
- to them. Recognize this case separately. */
- {
- Widget widget
- = x_window_to_menu_bar (event.xexpose.window);
- if (widget)
- xlwmenu_redisplay (widget);
- }
+ /* Submenus of the Lucid menu bar aren't widgets
+ themselves, so there's no way to dispatch events
+ to them. Recognize this case separately. */
+ {
+ Widget widget
+ = x_window_to_menu_bar (event.xexpose.window);
+ if (widget)
+ xlwmenu_redisplay (widget);
+ }
#endif /* USE_LUCID */
#ifdef USE_TOOLKIT_SCROLL_BARS
- /* Dispatch event to the widget. */
- goto OTHER;
+ /* Dispatch event to the widget. */
+ goto OTHER;
#else /* not USE_TOOLKIT_SCROLL_BARS */
- bar = x_window_to_scroll_bar (event.xexpose.window);
+ bar = x_window_to_scroll_bar (event.xexpose.window);
- if (bar)
- x_scroll_bar_expose (bar, &event);
+ if (bar)
+ x_scroll_bar_expose (bar, &event);
#ifdef USE_X_TOOLKIT
- else
- goto OTHER;
+ else
+ goto OTHER;
#endif /* USE_X_TOOLKIT */
#endif /* not USE_TOOLKIT_SCROLL_BARS */
- }
- break;
+ }
+ break;
- case GraphicsExpose: /* This occurs when an XCopyArea's
- source area was obscured or not
- available. */
- f = x_window_to_frame (dpyinfo, event.xgraphicsexpose.drawable);
- if (f)
- {
- expose_frame (f,
- event.xgraphicsexpose.x, event.xgraphicsexpose.y,
- event.xgraphicsexpose.width,
- event.xgraphicsexpose.height);
- }
+ case GraphicsExpose: /* This occurs when an XCopyArea's
+ source area was obscured or not
+ available. */
+ f = x_window_to_frame (dpyinfo, event.xgraphicsexpose.drawable);
+ if (f)
+ {
+ expose_frame (f,
+ event.xgraphicsexpose.x, event.xgraphicsexpose.y,
+ event.xgraphicsexpose.width,
+ event.xgraphicsexpose.height);
+ }
#ifdef USE_X_TOOLKIT
- else
- goto OTHER;
+ else
+ goto OTHER;
#endif /* USE_X_TOOLKIT */
- break;
+ break;
- case NoExpose: /* This occurs when an XCopyArea's
- source area was completely
- available. */
- break;
+ case NoExpose: /* This occurs when an XCopyArea's
+ source area was completely
+ available. */
+ break;
- case UnmapNotify:
- /* Redo the mouse-highlight after the tooltip has gone. */
- if (event.xmap.window == tip_window)
- {
- tip_window = 0;
- redo_mouse_highlight ();
- }
-
- f = x_top_window_to_frame (dpyinfo, event.xunmap.window);
- if (f) /* F may no longer exist if
- the frame was deleted. */
- {
- /* While a frame is unmapped, display generation is
- disabled; you don't want to spend time updating a
- display that won't ever be seen. */
- f->async_visible = 0;
- /* We can't distinguish, from the event, whether the window
- has become iconified or invisible. So assume, if it
- was previously visible, than now it is iconified.
- But x_make_frame_invisible clears both
- the visible flag and the iconified flag;
- and that way, we know the window is not iconified now. */
- if (FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f))
- {
- f->async_iconified = 1;
-
- bufp->kind = iconify_event;
- XSETFRAME (bufp->frame_or_window, f);
- bufp->arg = Qnil;
- bufp++;
- count++;
- numchars--;
- }
- }
- goto OTHER;
-
- case MapNotify:
- if (event.xmap.window == tip_window)
- /* The tooltip has been drawn already. Avoid
- the SET_FRAME_GARBAGED below. */
- goto OTHER;
-
- /* We use x_top_window_to_frame because map events can
- come for sub-windows and they don't mean that the
- frame is visible. */
- f = x_top_window_to_frame (dpyinfo, event.xmap.window);
- if (f)
- {
- f->async_visible = 1;
- f->async_iconified = 0;
- f->output_data.x->has_been_visible = 1;
+ case UnmapNotify:
+ /* Redo the mouse-highlight after the tooltip has gone. */
+ if (event.xmap.window == tip_window)
+ {
+ tip_window = 0;
+ redo_mouse_highlight ();
+ }
- /* wait_reading_process_input will notice this and update
- the frame's display structures. */
- SET_FRAME_GARBAGED (f);
+ f = x_top_window_to_frame (dpyinfo, event.xunmap.window);
+ if (f) /* F may no longer exist if
+ the frame was deleted. */
+ {
+ /* While a frame is unmapped, display generation is
+ disabled; you don't want to spend time updating a
+ display that won't ever be seen. */
+ f->async_visible = 0;
+ /* We can't distinguish, from the event, whether the window
+ has become iconified or invisible. So assume, if it
+ was previously visible, than now it is iconified.
+ But x_make_frame_invisible clears both
+ the visible flag and the iconified flag;
+ and that way, we know the window is not iconified now. */
+ if (FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f))
+ {
+ f->async_iconified = 1;
+
+ bufp->kind = ICONIFY_EVENT;
+ XSETFRAME (bufp->frame_or_window, f);
+ bufp->arg = Qnil;
+ bufp++;
+ count++;
+ numchars--;
+ }
+ }
+ goto OTHER;
+
+ case MapNotify:
+ if (event.xmap.window == tip_window)
+ /* The tooltip has been drawn already. Avoid
+ the SET_FRAME_GARBAGED below. */
+ goto OTHER;
+
+ /* We use x_top_window_to_frame because map events can
+ come for sub-windows and they don't mean that the
+ frame is visible. */
+ f = x_top_window_to_frame (dpyinfo, event.xmap.window);
+ if (f)
+ {
+ /* wait_reading_process_input will notice this and update
+ the frame's display structures.
+ If we where iconified, we should not set garbaged,
+ because that stops redrawing on Expose events. This looks
+ bad if we are called from a recursive event loop
+ (x_dispatch_event), for example when a dialog is up. */
+ if (! f->async_iconified)
+ SET_FRAME_GARBAGED (f);
+
+ f->async_visible = 1;
+ f->async_iconified = 0;
+ f->output_data.x->has_been_visible = 1;
+
+ if (f->iconified)
+ {
+ bufp->kind = DEICONIFY_EVENT;
+ XSETFRAME (bufp->frame_or_window, f);
+ bufp->arg = Qnil;
+ bufp++;
+ count++;
+ numchars--;
+ }
+ else if (! NILP (Vframe_list)
+ && ! NILP (XCDR (Vframe_list)))
+ /* Force a redisplay sooner or later
+ to update the frame titles
+ in case this is the second frame. */
+ record_asynch_buffer_change ();
+ }
+ goto OTHER;
- if (f->iconified)
- {
- bufp->kind = deiconify_event;
- XSETFRAME (bufp->frame_or_window, f);
- bufp->arg = Qnil;
- bufp++;
- count++;
- numchars--;
- }
- else if (! NILP (Vframe_list)
- && ! NILP (XCDR (Vframe_list)))
- /* Force a redisplay sooner or later
- to update the frame titles
- in case this is the second frame. */
- record_asynch_buffer_change ();
- }
- goto OTHER;
+ case KeyPress:
+
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
+ /* Dispatch KeyPress events when in menu. */
+ if (popup_activated ())
+ goto OTHER;
+#endif
- case KeyPress:
- f = x_any_window_to_frame (dpyinfo, event.xkey.window);
+ f = x_any_window_to_frame (dpyinfo, event.xkey.window);
- if (!dpyinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight))
- {
- dpyinfo->mouse_face_hidden = 1;
- clear_mouse_face (dpyinfo);
- }
+ if (!dpyinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight))
+ {
+ dpyinfo->mouse_face_hidden = 1;
+ clear_mouse_face (dpyinfo);
+ }
#if defined USE_MOTIF && defined USE_TOOLKIT_SCROLL_BARS
- if (f == 0)
- {
- /* Scroll bars consume key events, but we want
- the keys to go to the scroll bar's frame. */
- Widget widget = XtWindowToWidget (dpyinfo->display,
- event.xkey.window);
- if (widget && XmIsScrollBar (widget))
- {
- widget = XtParent (widget);
- f = x_any_window_to_frame (dpyinfo, XtWindow (widget));
- }
- }
+ if (f == 0)
+ {
+ /* Scroll bars consume key events, but we want
+ the keys to go to the scroll bar's frame. */
+ Widget widget = XtWindowToWidget (dpyinfo->display,
+ event.xkey.window);
+ if (widget && XmIsScrollBar (widget))
+ {
+ widget = XtParent (widget);
+ f = x_any_window_to_frame (dpyinfo, XtWindow (widget));
+ }
+ }
#endif /* USE_MOTIF and USE_TOOLKIT_SCROLL_BARS */
- if (f != 0)
- {
- KeySym keysym, orig_keysym;
- /* al%imercury@uunet.uu.net says that making this 81
- instead of 80 fixed a bug whereby meta chars made
- his Emacs hang.
-
- It seems that some version of XmbLookupString has
- a bug of not returning XBufferOverflow in
- status_return even if the input is too long to
- fit in 81 bytes. So, we must prepare sufficient
- bytes for copy_buffer. 513 bytes (256 chars for
- two-byte character set) seems to be a fairly good
- approximation. -- 2000.8.10 handa@etl.go.jp */
- unsigned char copy_buffer[513];
- unsigned char *copy_bufptr = copy_buffer;
- int copy_bufsiz = sizeof (copy_buffer);
- int modifiers;
-
- event.xkey.state
- |= x_emacs_to_x_modifiers (FRAME_X_DISPLAY_INFO (f),
- extra_keyboard_modifiers);
- modifiers = event.xkey.state;
-
- /* This will have to go some day... */
-
- /* make_lispy_event turns chars into control chars.
- Don't do it here because XLookupString is too eager. */
- event.xkey.state &= ~ControlMask;
- event.xkey.state &= ~(dpyinfo->meta_mod_mask
- | dpyinfo->super_mod_mask
- | dpyinfo->hyper_mod_mask
- | dpyinfo->alt_mod_mask);
-
- /* In case Meta is ComposeCharacter,
- clear its status. According to Markus Ehrnsperger
- Markus.Ehrnsperger@lehrstuhl-bross.physik.uni-muenchen.de
- this enables ComposeCharacter to work whether or
- not it is combined with Meta. */
- if (modifiers & dpyinfo->meta_mod_mask)
- bzero (&compose_status, sizeof (compose_status));
+ if (f != 0)
+ {
+ KeySym keysym, orig_keysym;
+ /* al%imercury@uunet.uu.net says that making this 81
+ instead of 80 fixed a bug whereby meta chars made
+ his Emacs hang.
+
+ It seems that some version of XmbLookupString has
+ a bug of not returning XBufferOverflow in
+ status_return even if the input is too long to
+ fit in 81 bytes. So, we must prepare sufficient
+ bytes for copy_buffer. 513 bytes (256 chars for
+ two-byte character set) seems to be a fairly good
+ approximation. -- 2000.8.10 handa@etl.go.jp */
+ unsigned char copy_buffer[513];
+ unsigned char *copy_bufptr = copy_buffer;
+ int copy_bufsiz = sizeof (copy_buffer);
+ int modifiers;
+ Lisp_Object coding_system = Qlatin_1;
+
+ event.xkey.state
+ |= x_emacs_to_x_modifiers (FRAME_X_DISPLAY_INFO (f),
+ extra_keyboard_modifiers);
+ modifiers = event.xkey.state;
+
+ /* This will have to go some day... */
+
+ /* make_lispy_event turns chars into control chars.
+ Don't do it here because XLookupString is too eager. */
+ event.xkey.state &= ~ControlMask;
+ event.xkey.state &= ~(dpyinfo->meta_mod_mask
+ | dpyinfo->super_mod_mask
+ | dpyinfo->hyper_mod_mask
+ | dpyinfo->alt_mod_mask);
+
+ /* In case Meta is ComposeCharacter,
+ clear its status. According to Markus Ehrnsperger
+ Markus.Ehrnsperger@lehrstuhl-bross.physik.uni-muenchen.de
+ this enables ComposeCharacter to work whether or
+ not it is combined with Meta. */
+ if (modifiers & dpyinfo->meta_mod_mask)
+ bzero (&compose_status, sizeof (compose_status));
#ifdef HAVE_X_I18N
- if (FRAME_XIC (f))
- {
- Status status_return;
-
- nbytes = XmbLookupString (FRAME_XIC (f),
- &event.xkey, copy_bufptr,
- copy_bufsiz, &keysym,
- &status_return);
- if (status_return == XBufferOverflow)
- {
- copy_bufsiz = nbytes + 1;
- copy_bufptr = (char *) alloca (copy_bufsiz);
- nbytes = XmbLookupString (FRAME_XIC (f),
- &event.xkey, copy_bufptr,
- copy_bufsiz, &keysym,
- &status_return);
- }
+ if (FRAME_XIC (f))
+ {
+ Status status_return;
+
+ coding_system = Vlocale_coding_system;
+ nbytes = XmbLookupString (FRAME_XIC (f),
+ &event.xkey, copy_bufptr,
+ copy_bufsiz, &keysym,
+ &status_return);
+ if (status_return == XBufferOverflow)
+ {
+ copy_bufsiz = nbytes + 1;
+ copy_bufptr = (char *) alloca (copy_bufsiz);
+ nbytes = XmbLookupString (FRAME_XIC (f),
+ &event.xkey, copy_bufptr,
+ copy_bufsiz, &keysym,
+ &status_return);
+ }
+ /* Xutf8LookupString is a new but already deprecated interface. -stef */
+#if 0 && defined X_HAVE_UTF8_STRING
+ else if (status_return == XLookupKeySym)
+ { /* Try again but with utf-8. */
+ coding_system = Qutf_8;
+ nbytes = Xutf8LookupString (FRAME_XIC (f),
+ &event.xkey, copy_bufptr,
+ copy_bufsiz, &keysym,
+ &status_return);
+ if (status_return == XBufferOverflow)
+ {
+ copy_bufsiz = nbytes + 1;
+ copy_bufptr = (char *) alloca (copy_bufsiz);
+ nbytes = Xutf8LookupString (FRAME_XIC (f),
+ &event.xkey,
+ copy_bufptr,
+ copy_bufsiz, &keysym,
+ &status_return);
+ }
+ }
+#endif
- if (status_return == XLookupNone)
- break;
- else if (status_return == XLookupChars)
- {
- keysym = NoSymbol;
- modifiers = 0;
- }
- else if (status_return != XLookupKeySym
- && status_return != XLookupBoth)
- abort ();
- }
- else
- nbytes = XLookupString (&event.xkey, copy_bufptr,
- copy_bufsiz, &keysym,
- &compose_status);
+ if (status_return == XLookupNone)
+ break;
+ else if (status_return == XLookupChars)
+ {
+ keysym = NoSymbol;
+ modifiers = 0;
+ }
+ else if (status_return != XLookupKeySym
+ && status_return != XLookupBoth)
+ abort ();
+ }
+ else
+ nbytes = XLookupString (&event.xkey, copy_bufptr,
+ copy_bufsiz, &keysym,
+ &compose_status);
#else
- nbytes = XLookupString (&event.xkey, copy_bufptr,
- copy_bufsiz, &keysym,
- &compose_status);
+ nbytes = XLookupString (&event.xkey, copy_bufptr,
+ copy_bufsiz, &keysym,
+ &compose_status);
#endif
- orig_keysym = keysym;
-
- if (numchars > 1)
- {
- Lisp_Object c;
-
- /* First deal with keysyms which have defined
- translations to characters. */
- if (keysym >= 32 && keysym < 128)
- /* Avoid explicitly decoding each ASCII character. */
- {
- bufp->kind = ascii_keystroke;
- bufp->code = keysym;
- XSETFRAME (bufp->frame_or_window, f);
- bufp->arg = Qnil;
- bufp->modifiers
- = x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f),
- modifiers);
- bufp->timestamp = event.xkey.time;
- bufp++;
- count++;
- numchars--;
- }
- /* Now non-ASCII. */
- else if (HASH_TABLE_P (Vx_keysym_table)
- && (CHARACTERP (c = Fgethash (make_number (keysym),
- Vx_keysym_table,
- Qnil))))
- {
- bufp->kind = (ASCII_CHAR_P (XFASTINT (c))
- ? ascii_keystroke
- : multibyte_char_keystroke);
- bufp->code = XFASTINT (c);
- XSETFRAME (bufp->frame_or_window, f);
- bufp->arg = Qnil;
- bufp->modifiers
- = x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f),
- modifiers);
- bufp->timestamp = event.xkey.time;
- bufp++;
- count++;
- numchars--;
- }
- else if (((keysym >= XK_BackSpace && keysym <= XK_Escape)
- || keysym == XK_Delete
+ orig_keysym = keysym;
+
+ if (numchars > 1)
+ {
+ Lisp_Object c;
+
+ /* First deal with keysyms which have defined
+ translations to characters. */
+ if (keysym >= 32 && keysym < 128)
+ /* Avoid explicitly decoding each ASCII character. */
+ {
+ bufp->kind = ASCII_KEYSTROKE_EVENT;
+ bufp->code = keysym;
+ XSETFRAME (bufp->frame_or_window, f);
+ bufp->arg = Qnil;
+ bufp->modifiers
+ = x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f),
+ modifiers);
+ bufp->timestamp = event.xkey.time;
+ bufp++;
+ count++;
+ numchars--;
+ }
+ /* Now non-ASCII. */
+ else if (HASH_TABLE_P (Vx_keysym_table)
+ && (NATNUMP (c = Fgethash (make_number (keysym),
+ Vx_keysym_table,
+ Qnil))))
+ {
+ bufp->kind = (SINGLE_BYTE_CHAR_P (XFASTINT (c))
+ ? ASCII_KEYSTROKE_EVENT
+ : MULTIBYTE_CHAR_KEYSTROKE_EVENT);
+ bufp->code = XFASTINT (c);
+ XSETFRAME (bufp->frame_or_window, f);
+ bufp->arg = Qnil;
+ bufp->modifiers
+ = x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f),
+ modifiers);
+ bufp->timestamp = event.xkey.time;
+ bufp++;
+ count++;
+ numchars--;
+ }
+ /* Random non-modifier sorts of keysyms. */
+ else if (((keysym >= XK_BackSpace && keysym <= XK_Escape)
+ || keysym == XK_Delete
#ifdef XK_ISO_Left_Tab
- || (keysym >= XK_ISO_Left_Tab && keysym <= XK_ISO_Enter)
+ || (keysym >= XK_ISO_Left_Tab
+ && keysym <= XK_ISO_Enter)
#endif
- || (keysym >= XK_Kanji && keysym <= XK_Eisu_toggle)
- || IsCursorKey (keysym) /* 0xff50 <= x < 0xff60 */
- || IsMiscFunctionKey (keysym) /* 0xff60 <= x < VARIES */
+ || IsCursorKey (keysym) /* 0xff50 <= x < 0xff60 */
+ || IsMiscFunctionKey (keysym) /* 0xff60 <= x < VARIES */
#ifdef HPUX
- /* This recognizes the "extended function
- keys". It seems there's no cleaner way.
- Test IsModifierKey to avoid handling
- mode_switch incorrectly. */
- || ((unsigned) (keysym) >= XK_Select
- && (unsigned)(keysym) < XK_KP_Space)
+ /* This recognizes the "extended function
+ keys". It seems there's no cleaner way.
+ Test IsModifierKey to avoid handling
+ mode_switch incorrectly. */
+ || ((unsigned) (keysym) >= XK_Select
+ && (unsigned)(keysym) < XK_KP_Space)
#endif
#ifdef XK_dead_circumflex
- || orig_keysym == XK_dead_circumflex
+ || orig_keysym == XK_dead_circumflex
#endif
#ifdef XK_dead_grave
- || orig_keysym == XK_dead_grave
+ || orig_keysym == XK_dead_grave
#endif
#ifdef XK_dead_tilde
- || orig_keysym == XK_dead_tilde
+ || orig_keysym == XK_dead_tilde
#endif
#ifdef XK_dead_diaeresis
- || orig_keysym == XK_dead_diaeresis
+ || orig_keysym == XK_dead_diaeresis
#endif
#ifdef XK_dead_macron
- || orig_keysym == XK_dead_macron
+ || orig_keysym == XK_dead_macron
#endif
#ifdef XK_dead_degree
- || orig_keysym == XK_dead_degree
+ || orig_keysym == XK_dead_degree
#endif
#ifdef XK_dead_acute
- || orig_keysym == XK_dead_acute
+ || orig_keysym == XK_dead_acute
#endif
#ifdef XK_dead_cedilla
- || orig_keysym == XK_dead_cedilla
+ || orig_keysym == XK_dead_cedilla
#endif
#ifdef XK_dead_breve
- || orig_keysym == XK_dead_breve
+ || orig_keysym == XK_dead_breve
#endif
#ifdef XK_dead_ogonek
- || orig_keysym == XK_dead_ogonek
+ || orig_keysym == XK_dead_ogonek
#endif
#ifdef XK_dead_caron
- || orig_keysym == XK_dead_caron
+ || orig_keysym == XK_dead_caron
#endif
#ifdef XK_dead_doubleacute
- || orig_keysym == XK_dead_doubleacute
+ || orig_keysym == XK_dead_doubleacute
#endif
#ifdef XK_dead_abovedot
- || orig_keysym == XK_dead_abovedot
-#endif
-#ifdef XK_dead_abovering
- || orig_keysym == XK_dead_abovering
-#endif
-#ifdef XK_dead_iota
- || orig_keysym == XK_dead_iota
-#endif
-#ifdef XK_dead_belowdot
- || orig_keysym == XK_dead_belowdot
-#endif
-#ifdef XK_dead_voiced_sound
- || orig_keysym == XK_dead_voiced_sound
+ || orig_keysym == XK_dead_abovedot
#endif
-#ifdef XK_dead_semivoiced_sound
- || orig_keysym == XK_dead_semivoiced_sound
-#endif
-#ifdef XK_dead_hook
- || orig_keysym == XK_dead_hook
-#endif
-#ifdef XK_dead_horn
- || orig_keysym == XK_dead_horn
-#endif
- || IsKeypadKey (keysym) /* 0xff80 <= x < 0xffbe */
- || IsFunctionKey (keysym) /* 0xffbe <= x < 0xffe1 */
- /* Any "vendor-specific" key is ok. */
- || (orig_keysym & (1 << 28))
- || (keysym != NoSymbol && nbytes == 0))
- && ! (IsModifierKey (orig_keysym)
+ || IsKeypadKey (keysym) /* 0xff80 <= x < 0xffbe */
+ || IsFunctionKey (keysym) /* 0xffbe <= x < 0xffe1 */
+ /* Any "vendor-specific" key is ok. */
+ || (orig_keysym & (1 << 28))
+ || (keysym != NoSymbol && nbytes == 0))
+ && ! (IsModifierKey (orig_keysym)
#ifndef HAVE_X11R5
#ifdef XK_Mode_switch
- || ((unsigned)(orig_keysym) == XK_Mode_switch)
+ || ((unsigned)(orig_keysym) == XK_Mode_switch)
#endif
#ifdef XK_Num_Lock
- || ((unsigned)(orig_keysym) == XK_Num_Lock)
+ || ((unsigned)(orig_keysym) == XK_Num_Lock)
#endif
#endif /* not HAVE_X11R5 */
- /* The symbols from XK_ISO_Lock to
- XK_ISO_Last_Group_Lock doesn't have
- real modifiers but should be treated
- similarly to Mode_switch by Emacs. */
+ /* The symbols from XK_ISO_Lock
+ to XK_ISO_Last_Group_Lock
+ don't have real modifiers but
+ should be treated similarly to
+ Mode_switch by Emacs. */
#if defined XK_ISO_Lock && defined XK_ISO_Last_Group_Lock
- || ((unsigned)(orig_keysym) >= XK_ISO_Lock
- && (unsigned)(orig_keysym) <= XK_ISO_Last_Group_Lock)
+ || ((unsigned)(orig_keysym)
+ >= XK_ISO_Lock
+ && (unsigned)(orig_keysym)
+ <= XK_ISO_Last_Group_Lock)
#endif
- ))
- {
- if (temp_index == sizeof temp_buffer / sizeof (short))
- temp_index = 0;
- temp_buffer[temp_index++] = keysym;
- /* make_lispy_event will convert this to a symbolic
- key. */
- bufp->kind = non_ascii_keystroke;
- bufp->code = keysym;
- XSETFRAME (bufp->frame_or_window, f);
- bufp->arg = Qnil;
- bufp->modifiers
- = x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f),
- modifiers);
- bufp->timestamp = event.xkey.time;
- bufp++;
- count++;
- numchars--;
- }
- else if (numchars > nbytes)
- { /* Raw characters, not keysym. */
- register int i;
- register int c;
- int nchars, len;
-
- for (i = 0; i < nbytes; i++)
- {
- if (temp_index == (sizeof temp_buffer
- / sizeof (short)))
- temp_index = 0;
- temp_buffer[temp_index++] = copy_bufptr[i];
- }
-
- {
- /* Decode the input data. */
- coding.destination
- = (unsigned char *) malloc (nbytes);
- if (! coding.destination)
- break;
- coding.dst_bytes = nbytes;
- coding.mode |= CODING_MODE_LAST_BLOCK;
- decode_coding_c_string (&coding, copy_bufptr,
- nbytes, Qnil);
- nbytes = coding.produced;
- nchars = coding.produced_char;
- if (copy_bufsiz < nbytes)
- {
- copy_bufsiz = nbytes;
- copy_bufptr = (char *) alloca (nbytes);
- }
- bcopy (coding.destination, copy_bufptr, nbytes);
- free (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);
-
- bufp->kind = (ASCII_CHAR_P (c)
- ? ascii_keystroke
- : multibyte_char_keystroke);
- bufp->code = c;
- XSETFRAME (bufp->frame_or_window, f);
- bufp->arg = Qnil;
- bufp->modifiers
- = x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f),
- modifiers);
- bufp->timestamp = event.xkey.time;
- bufp++;
- }
-
- count += nchars;
- numchars -= nchars;
-
- if (keysym == NoSymbol)
- break;
- }
- else
- abort ();
- }
- else
- abort ();
- }
+ ))
+ {
+ if (temp_index == sizeof temp_buffer / sizeof (short))
+ temp_index = 0;
+ temp_buffer[temp_index++] = keysym;
+ /* make_lispy_event will convert this to a symbolic
+ key. */
+ bufp->kind = NON_ASCII_KEYSTROKE_EVENT;
+ bufp->code = keysym;
+ XSETFRAME (bufp->frame_or_window, f);
+ bufp->arg = Qnil;
+ bufp->modifiers
+ = x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f),
+ modifiers);
+ bufp->timestamp = event.xkey.time;
+ bufp++;
+ count++;
+ numchars--;
+ }
+ else if (numchars > nbytes)
+ { /* Raw bytes, not keysym. */
+ register int i;
+ 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;
++ coding.common_flags &= ~CODING_ANNOTATION_MASK;
+
+ for (i = 0; i < nbytes; i++)
+ {
+ if (temp_index == (sizeof temp_buffer
+ / sizeof (short)))
+ temp_index = 0;
+ temp_buffer[temp_index++] = copy_bufptr[i];
+ }
+
+ {
+ /* Decode the input data. */
- int require;
- unsigned char *p;
-
- require = decoding_buffer_size (&coding, nbytes);
- p = (unsigned char *) alloca (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);
- nbytes = coding.produced;
- nchars = coding.produced_char;
- copy_bufptr = p;
++ coding.destination = (unsigned char *) malloc (nbytes);
++ if (! coding.destination)
++ break;
++ coding.dst_bytes = nbytes;
++ coding.mode |= CODING_MODE_LAST_BLOCK;
++ decode_coding_c_string (&coding, copy_bufptr,
++ nbytes, Qnil);
++ nbytes = coding.produced;
++ nchars = coding.produced_char;
++ if (copy_bufsiz < nbytes)
++ {
++ copy_bufsiz = nbytes;
++ copy_bufptr = (char *) alloca (nbytes);
++ }
++ bcopy (coding.destination, copy_bufptr, nbytes);
++ free (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);
+
- bufp->kind = (SINGLE_BYTE_CHAR_P (c)
++ bufp->kind = (ASCII_CHAR_P (c)
+ ? ASCII_KEYSTROKE_EVENT
+ : MULTIBYTE_CHAR_KEYSTROKE_EVENT);
+ bufp->code = c;
+ XSETFRAME (bufp->frame_or_window, f);
+ bufp->arg = Qnil;
+ bufp->modifiers
+ = x_x_to_emacs_modifiers (FRAME_X_DISPLAY_INFO (f),
+ modifiers);
+ bufp->timestamp = event.xkey.time;
+ bufp++;
+ }
+
+ count += nchars;
+ numchars -= nchars;
+
+ if (keysym == NoSymbol)
+ break;
+ }
+ else
+ abort ();
+ }
+ else
+ abort ();
+ }
#ifdef HAVE_X_I18N
- /* Don't dispatch this event since XtDispatchEvent calls
- XFilterEvent, and two calls in a row may freeze the
- client. */
- break;
+ /* Don't dispatch this event since XtDispatchEvent calls
+ XFilterEvent, and two calls in a row may freeze the
+ client. */
+ break;
#else
- goto OTHER;
+ goto OTHER;
#endif
- case KeyRelease:
+ case KeyRelease:
#ifdef HAVE_X_I18N
- /* Don't dispatch this event since XtDispatchEvent calls
- XFilterEvent, and two calls in a row may freeze the
- client. */
- break;
+ /* Don't dispatch this event since XtDispatchEvent calls
+ XFilterEvent, and two calls in a row may freeze the
+ client. */
+ break;
#else
- goto OTHER;
+ goto OTHER;
#endif
- /* Here's a possible interpretation of the whole
- FocusIn-EnterNotify FocusOut-LeaveNotify mess. If
- you get a FocusIn event, you have to get a FocusOut
- event before you relinquish the focus. If you
- haven't received a FocusIn event, then a mere
- LeaveNotify is enough to free you. */
+ case EnterNotify:
+ {
+ int n;
- case EnterNotify:
- {
- f = x_any_window_to_frame (dpyinfo, event.xcrossing.window);
+ n = x_detect_focus_change (dpyinfo, &event, bufp, numchars);
+ if (n > 0)
+ {
+ bufp += n, count += n, numchars -= n;
+ }
+
+ f = x_any_window_to_frame (dpyinfo, event.xcrossing.window);
#if 0
- if (event.xcrossing.focus)
- {
- /* Avoid nasty pop/raise loops. */
- if (f && (!(f->auto_raise)
- || !(f->auto_lower)
- || (event.xcrossing.time - enter_timestamp) > 500))
- {
- x_new_focus_frame (dpyinfo, f);
- enter_timestamp = event.xcrossing.time;
- }
- }
- else if (f == dpyinfo->x_focus_frame)
- x_new_focus_frame (dpyinfo, 0);
+ if (event.xcrossing.focus)
+ {
+ /* Avoid nasty pop/raise loops. */
+ if (f && (!(f->auto_raise)
+ || !(f->auto_lower)
+ || (event.xcrossing.time - enter_timestamp) > 500))
+ {
+ x_new_focus_frame (dpyinfo, f);
+ enter_timestamp = event.xcrossing.time;
+ }
+ }
+ else if (f == dpyinfo->x_focus_frame)
+ x_new_focus_frame (dpyinfo, 0);
#endif
- /* EnterNotify counts as mouse movement,
- so update things that depend on mouse position. */
- if (f && !f->output_data.x->hourglass_p)
- note_mouse_movement (f, &event.xmotion);
- goto OTHER;
- }
+ /* EnterNotify counts as mouse movement,
+ so update things that depend on mouse position. */
+ if (f && !f->output_data.x->hourglass_p)
+ note_mouse_movement (f, &event.xmotion);
+ goto OTHER;
+ }
- case FocusIn:
- f = x_any_window_to_frame (dpyinfo, event.xfocus.window);
- if (event.xfocus.detail != NotifyPointer)
- dpyinfo->x_focus_event_frame = f;
- if (f)
- {
- x_new_focus_frame (dpyinfo, f);
+ case FocusIn:
+ {
+ int n;
- /* 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)))
- {
- bufp->kind = FOCUS_IN_EVENT;
- XSETFRAME (bufp->frame_or_window, f);
- bufp->arg = Qnil;
- ++bufp, ++count, --numchars;
- }
- }
+ n = x_detect_focus_change (dpyinfo, &event, bufp, numchars);
+ if (n > 0)
+ {
+ bufp += n, count += n, numchars -= n;
+ }
+ }
-#ifdef HAVE_X_I18N
- if (f && FRAME_XIC (f))
- XSetICFocus (FRAME_XIC (f));
-#endif
+ goto OTHER;
- goto OTHER;
+ case LeaveNotify:
+ {
+ int n;
- case LeaveNotify:
- f = x_top_window_to_frame (dpyinfo, event.xcrossing.window);
- if (f)
- {
- if (f == dpyinfo->mouse_face_mouse_frame)
- {
- /* If we move outside the frame, then we're
- certainly no longer on any text in the frame. */
- clear_mouse_face (dpyinfo);
- dpyinfo->mouse_face_mouse_frame = 0;
- }
+ n = x_detect_focus_change (dpyinfo, &event, bufp, numchars);
+ if (n > 0)
+ {
+ bufp += n, count += n, numchars -= n;
+ }
+ }
- /* Generate a nil HELP_EVENT to cancel a help-echo.
- Do it only if there's something to cancel.
- Otherwise, the startup message is cleared when
- the mouse leaves the frame. */
- if (any_help_event_p)
- {
- Lisp_Object frame;
- int n;
-
- XSETFRAME (frame, f);
- help_echo = Qnil;
- n = gen_help_event (bufp, numchars,
- Qnil, frame, Qnil, Qnil, 0);
- bufp += n, count += n, numchars -= n;
- }
+ f = x_top_window_to_frame (dpyinfo, event.xcrossing.window);
+ if (f)
+ {
+ if (f == dpyinfo->mouse_face_mouse_frame)
+ {
+ /* If we move outside the frame, then we're
+ certainly no longer on any text in the frame. */
+ clear_mouse_face (dpyinfo);
+ dpyinfo->mouse_face_mouse_frame = 0;
+ }
+
+ /* Generate a nil HELP_EVENT to cancel a help-echo.
+ Do it only if there's something to cancel.
+ Otherwise, the startup message is cleared when
+ the mouse leaves the frame. */
+ if (any_help_event_p)
+ {
+ Lisp_Object frame;
+ int n;
+
+ XSETFRAME (frame, f);
+ help_echo_string = Qnil;
+ n = gen_help_event (bufp, numchars,
+ Qnil, frame, Qnil, Qnil, 0);
+ bufp += n, count += n, numchars -= n;
+ }
-#if 0
- if (event.xcrossing.focus)
- x_mouse_leave (dpyinfo);
- else
- {
- if (f == dpyinfo->x_focus_event_frame)
- dpyinfo->x_focus_event_frame = 0;
- if (f == dpyinfo->x_focus_frame)
- x_new_focus_frame (dpyinfo, 0);
- }
+ }
+ goto OTHER;
+
+ case FocusOut:
+ {
+ int n;
+
+ n = x_detect_focus_change (dpyinfo, &event, bufp, numchars);
+ if (n > 0)
+ {
+ bufp += n, count += n, numchars -= n;
+ }
+ }
+
+ goto OTHER;
+
+ case MotionNotify:
+ {
+ previous_help_echo_string = help_echo_string;
+ help_echo_string = help_echo_object = help_echo_window = Qnil;
+ help_echo_pos = -1;
+
+ if (dpyinfo->grabbed && last_mouse_frame
+ && FRAME_LIVE_P (last_mouse_frame))
+ f = last_mouse_frame;
+ else
+ f = x_window_to_frame (dpyinfo, event.xmotion.window);
+
+ if (dpyinfo->mouse_face_hidden)
+ {
+ dpyinfo->mouse_face_hidden = 0;
+ clear_mouse_face (dpyinfo);
+ }
+
+ if (f)
+ {
+
+ /* Generate SELECT_WINDOW_EVENTs when needed. */
+ if (mouse_autoselect_window)
+ {
+ Lisp_Object window;
+
+ window = window_from_coordinates (f,
+ event.xmotion.x, event.xmotion.y,
+ 0, 0, 0, 0);
+
+ /* Window will be selected only when it is not selected now and
+ last mouse movement event was not in it. Minibuffer window
+ will be selected iff it is active. */
+ if (WINDOWP(window)
+ && !EQ (window, last_window)
+ && !EQ (window, selected_window)
+ && numchars > 0)
+ {
+ bufp->kind = SELECT_WINDOW_EVENT;
+ bufp->frame_or_window = window;
+ bufp->arg = Qnil;
+ ++bufp, ++count, --numchars;
+ }
+
+ last_window=window;
+ }
+ note_mouse_movement (f, &event.xmotion);
+ }
+ else
+ {
+#ifndef USE_TOOLKIT_SCROLL_BARS
+ struct scroll_bar *bar
+ = x_window_to_scroll_bar (event.xmotion.window);
+
+ if (bar)
+ x_scroll_bar_note_movement (bar, &event);
+#endif /* USE_TOOLKIT_SCROLL_BARS */
+
+ /* If we move outside the frame, then we're
+ certainly no longer on any text in the frame. */
+ clear_mouse_face (dpyinfo);
+ }
+
+ /* If the contents of the global variable help_echo_string
+ has changed, generate a HELP_EVENT. */
+ if (!NILP (help_echo_string)
+ || !NILP (previous_help_echo_string))
+ {
+ Lisp_Object frame;
+ int n;
+
+ if (f)
+ XSETFRAME (frame, f);
+ else
+ frame = Qnil;
+
+ any_help_event_p = 1;
+ n = gen_help_event (bufp, numchars, help_echo_string, frame,
+ help_echo_window, help_echo_object,
+ help_echo_pos);
+ bufp += n, count += n, numchars -= n;
+ }
+
+ goto OTHER;
+ }
+
+ case ConfigureNotify:
+ f = x_top_window_to_frame (dpyinfo, event.xconfigure.window);
+ if (f)
+ {
+#ifndef USE_X_TOOLKIT
+#ifdef USE_GTK
+ xg_resize_widgets (f, event.xconfigure.width,
+ event.xconfigure.height);
+#else /* not USE_GTK */
+ /* If there is a pending resize for fullscreen, don't
+ do this one, the right one will come later.
+ The toolkit version doesn't seem to need this, but we
+ need to reset it below. */
+ int dont_resize
+ = ((f->want_fullscreen & FULLSCREEN_WAIT)
+ && f->new_text_cols != 0);
+ int rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, event.xconfigure.height);
+ int columns = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, event.xconfigure.width);
+
+ if (dont_resize)
+ goto OTHER;
+
+ /* In the toolkit version, change_frame_size
+ is called by the code that handles resizing
+ of the EmacsFrame widget. */
+
+ /* Even if the number of character rows and columns has
+ not changed, the font size may have changed, so we need
+ to check the pixel dimensions as well. */
+ if (columns != FRAME_COLS (f)
+ || rows != FRAME_LINES (f)
+ || event.xconfigure.width != FRAME_PIXEL_WIDTH (f)
+ || event.xconfigure.height != FRAME_PIXEL_HEIGHT (f))
+ {
+ change_frame_size (f, rows, columns, 0, 1, 0);
+ SET_FRAME_GARBAGED (f);
+ cancel_mouse_face (f);
+ }
+#endif /* not USE_GTK */
#endif
- }
- goto OTHER;
- case FocusOut:
- f = x_any_window_to_frame (dpyinfo, event.xfocus.window);
- if (event.xfocus.detail != NotifyPointer
- && f == dpyinfo->x_focus_event_frame)
- dpyinfo->x_focus_event_frame = 0;
- if (f && f == dpyinfo->x_focus_frame)
- x_new_focus_frame (dpyinfo, 0);
+ FRAME_PIXEL_WIDTH (f) = event.xconfigure.width;
+ FRAME_PIXEL_HEIGHT (f) = event.xconfigure.height;
+
+#ifdef USE_GTK
+ /* GTK creates windows but doesn't map them.
+ Only get real positions and check fullscreen when mapped. */
+ if (FRAME_GTK_OUTER_WIDGET (f)
+ && GTK_WIDGET_MAPPED (FRAME_GTK_OUTER_WIDGET (f)))
+#endif
+ {
+ /* What we have now is the position of Emacs's own window.
+ Convert that to the position of the window manager window. */
+ x_real_positions (f, &f->left_pos, &f->top_pos);
+
+ x_check_fullscreen_move (f);
+ if (f->want_fullscreen & FULLSCREEN_WAIT)
+ f->want_fullscreen &= ~(FULLSCREEN_WAIT|FULLSCREEN_BOTH);
+ }
#ifdef HAVE_X_I18N
- if (f && FRAME_XIC (f))
- XUnsetICFocus (FRAME_XIC (f));
+ if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMStatusArea))
+ xic_set_statusarea (f);
#endif
- goto OTHER;
+ if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
+ {
+ /* Since the WM decorations come below top_pos now,
+ we must put them below top_pos in the future. */
+ f->win_gravity = NorthWestGravity;
+ x_wm_set_size_hint (f, (long) 0, 0);
+ }
+ }
+ goto OTHER;
+
+ case ButtonRelease:
+ case ButtonPress:
+ {
+ /* If we decide we want to generate an event to be seen
+ by the rest of Emacs, we put it here. */
+ struct input_event emacs_event;
+ int tool_bar_p = 0;
+
+ emacs_event.kind = NO_EVENT;
+ bzero (&compose_status, sizeof (compose_status));
+
+ if (dpyinfo->grabbed
+ && last_mouse_frame
+ && FRAME_LIVE_P (last_mouse_frame))
+ f = last_mouse_frame;
+ else
+ f = x_window_to_frame (dpyinfo, event.xbutton.window);
+
+ if (f)
+ {
+ /* Is this in the tool-bar? */
+ if (WINDOWP (f->tool_bar_window)
+ && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window)))
+ {
+ Lisp_Object window;
+ int x = event.xbutton.x;
+ int y = event.xbutton.y;
+
+ window = window_from_coordinates (f, x, y, 0, 0, 0, 1);
+ if (EQ (window, f->tool_bar_window))
+ {
+ if (event.xbutton.type == ButtonPress)
+ handle_tool_bar_click (f, x, y, 1, 0);
+ else
+ handle_tool_bar_click (f, x, y, 0,
+ x_x_to_emacs_modifiers (dpyinfo,
+ event.xbutton.state));
+ tool_bar_p = 1;
+ }
+ }
+
+ if (!tool_bar_p)
+ if (!dpyinfo->x_focus_frame
+ || f == dpyinfo->x_focus_frame)
+ {
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
+ if (! popup_activated ())
+#endif
+ construct_mouse_click (&emacs_event, &event, f);
+ }
+ }
+ else
+ {
+ struct scroll_bar *bar
+ = x_window_to_scroll_bar (event.xbutton.window);
+
+#ifdef USE_TOOLKIT_SCROLL_BARS
+ /* Make the "Ctrl-Mouse-2 splits window" work for toolkit
+ scroll bars. */
+ if (bar && event.xbutton.state & ControlMask)
+ {
+ x_scroll_bar_handle_click (bar, &event, &emacs_event);
+ *finish = X_EVENT_DROP;
+ }
+#else /* not USE_TOOLKIT_SCROLL_BARS */
+ if (bar)
+ x_scroll_bar_handle_click (bar, &event, &emacs_event);
+#endif /* not USE_TOOLKIT_SCROLL_BARS */
+ }
+
+ if (event.type == ButtonPress)
+ {
+ dpyinfo->grabbed |= (1 << event.xbutton.button);
+ last_mouse_frame = f;
+ /* Ignore any mouse motion that happened
+ before this event; any subsequent mouse-movement
+ Emacs events should reflect only motion after
+ the ButtonPress. */
+ if (f != 0)
+ f->mouse_moved = 0;
+
+ if (!tool_bar_p)
+ last_tool_bar_item = -1;
+ }
+ else
+ dpyinfo->grabbed &= ~(1 << event.xbutton.button);
+
+ if (numchars >= 1 && emacs_event.kind != NO_EVENT)
+ {
+ bcopy (&emacs_event, bufp, sizeof (struct input_event));
+ bufp++;
+ count++;
+ numchars--;
+ }
+
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
+ f = x_menubar_window_to_frame (dpyinfo, event.xbutton.window);
+ /* For a down-event in the menu bar,
+ don't pass it to Xt right now.
+ Instead, save it away
+ and we will pass it to Xt from kbd_buffer_get_event.
+ That way, we can run some Lisp code first. */
+ if (
+#ifdef USE_GTK
+ ! popup_activated ()
+ &&
+#endif
+ f && event.type == ButtonPress
+ /* Verify the event is really within the menu bar
+ and not just sent to it due to grabbing. */
+ && event.xbutton.x >= 0
+ && event.xbutton.x < FRAME_PIXEL_WIDTH (f)
+ && event.xbutton.y >= 0
+ && event.xbutton.y < f->output_data.x->menubar_height
+ && event.xbutton.same_screen)
+ {
+ SET_SAVED_BUTTON_EVENT;
+ XSETFRAME (last_mouse_press_frame, f);
+#ifdef USE_GTK
+ *finish = X_EVENT_DROP;
+#endif
+ }
+ else if (event.type == ButtonPress)
+ {
+ last_mouse_press_frame = Qnil;
+ goto OTHER;
+ }
+
+#ifdef USE_MOTIF /* This should do not harm for Lucid,
+ but I am trying to be cautious. */
+ else if (event.type == ButtonRelease)
+ {
+ if (!NILP (last_mouse_press_frame))
+ {
+ f = XFRAME (last_mouse_press_frame);
+ if (f->output_data.x)
+ SET_SAVED_BUTTON_EVENT;
+ }
+ else
+ goto OTHER;
+ }
+#endif /* USE_MOTIF */
+ else
+ goto OTHER;
+#endif /* USE_X_TOOLKIT || USE_GTK */
+ }
+ break;
+
+ case CirculateNotify:
+ goto OTHER;
+
+ case CirculateRequest:
+ goto OTHER;
+
+ case VisibilityNotify:
+ goto OTHER;
+
+ case MappingNotify:
+ /* Someone has changed the keyboard mapping - update the
+ local cache. */
+ switch (event.xmapping.request)
+ {
+ case MappingModifier:
+ x_find_modifier_meanings (dpyinfo);
+ /* This is meant to fall through. */
+ case MappingKeyboard:
+ XRefreshKeyboardMapping (&event.xmapping);
+ }
+ goto OTHER;
+
+ default:
+ OTHER:
+#ifdef USE_X_TOOLKIT
+ BLOCK_INPUT;
+ if (*finish != X_EVENT_DROP)
+ XtDispatchEvent (&event);
+ UNBLOCK_INPUT;
+#endif /* USE_X_TOOLKIT */
+ break;
+ }
+
+ goto ret;
+
+ out:
+ *finish = X_EVENT_GOTO_OUT;
+
+ ret:
+ *bufp_r = bufp;
+ *numcharsp = numchars;
+ *eventp = event;
+
+ return count;
+}
+
+
+/* Handles the XEvent EVENT on display DISPLAY.
+ This is used for event loops outside the normal event handling,
+ i.e. looping while a popup menu or a dialog is posted.
+
+ Returns the value handle_one_xevent sets in the finish argument. */
+int
+x_dispatch_event (event, display)
+ XEvent *event;
+ Display *display;
+{
+ struct x_display_info *dpyinfo;
+ struct input_event bufp[10];
+ struct input_event *bufpp;
+ int numchars = 10;
+ int finish = X_EVENT_NORMAL;
+
+ for (bufpp = bufp; bufpp != bufp + 10; bufpp++)
+ EVENT_INIT (*bufpp);
+ bufpp = bufp;
+
+ for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
+ if (dpyinfo->display == display)
+ break;
+
+ if (dpyinfo)
+ {
+ int i, events;
+ events = handle_one_xevent (dpyinfo,
+ event,
+ &bufpp,
+ &numchars,
+ &finish);
+ for (i = 0; i < events; ++i)
+ kbd_buffer_store_event (&bufp[i]);
+ }
+
+ return finish;
+}
+
+
+/* Read events coming from the X server.
+ This routine is called by the SIGIO handler.
+ We return as soon as there are no more events to be read.
+
+ Events representing keys are stored in buffer BUFP,
+ which can hold up to NUMCHARS characters.
+ We return the number of characters stored into the buffer,
+ thus pretending to be `read'.
- case MotionNotify:
- {
- previous_help_echo = help_echo;
- help_echo = help_echo_object = help_echo_window = Qnil;
- help_echo_pos = -1;
-
- if (dpyinfo->grabbed && last_mouse_frame
- && FRAME_LIVE_P (last_mouse_frame))
- f = last_mouse_frame;
- else
- f = x_window_to_frame (dpyinfo, event.xmotion.window);
-
- if (dpyinfo->mouse_face_hidden)
- {
- dpyinfo->mouse_face_hidden = 0;
- clear_mouse_face (dpyinfo);
- }
+ EXPECTED is nonzero if the caller knows input is available. */
- if (f)
- note_mouse_movement (f, &event.xmotion);
- else
- {
-#ifndef USE_TOOLKIT_SCROLL_BARS
- struct scroll_bar *bar
- = x_window_to_scroll_bar (event.xmotion.window);
+static int
+XTread_socket (sd, bufp, numchars, expected)
+ register int sd;
+ /* register */ struct input_event *bufp;
+ /* register */ int numchars;
+ int expected;
+{
+ int count = 0;
+ XEvent event;
+ int event_found = 0;
+ struct x_display_info *dpyinfo;
- if (bar)
- x_scroll_bar_note_movement (bar, &event);
-#endif /* USE_TOOLKIT_SCROLL_BARS */
+ if (interrupt_input_blocked)
+ {
+ interrupt_input_pending = 1;
+ return -1;
+ }
- /* If we move outside the frame, then we're
- certainly no longer on any text in the frame. */
- clear_mouse_face (dpyinfo);
- }
+ interrupt_input_pending = 0;
+ BLOCK_INPUT;
- /* If the contents of the global variable help_echo
- has changed, generate a HELP_EVENT. */
- if (!NILP (help_echo)
- || !NILP (previous_help_echo))
- {
- Lisp_Object frame;
- int n;
+ /* So people can tell when we have read the available input. */
+ input_signal_count++;
- if (f)
- XSETFRAME (frame, f);
- else
- frame = Qnil;
+ if (numchars <= 0)
+ abort (); /* Don't think this happens. */
- any_help_event_p = 1;
- n = gen_help_event (bufp, numchars, help_echo, frame,
- help_echo_window, help_echo_object,
- help_echo_pos);
- bufp += n, count += n, numchars -= n;
- }
-
- goto OTHER;
- }
+ ++handling_signal;
- case ConfigureNotify:
- f = x_top_window_to_frame (dpyinfo, event.xconfigure.window);
- if (f)
- {
-#ifndef USE_X_TOOLKIT
- /* If there is a pending resize for fullscreen, don't
- do this one, the right one will come later.
- The toolkit version doesn't seem to need this, but we
- need to reset it below. */
- int dont_resize =
- ((f->output_data.x->want_fullscreen & FULLSCREEN_WAIT)
- && FRAME_NEW_WIDTH (f) != 0);
- int rows = PIXEL_TO_CHAR_HEIGHT (f, event.xconfigure.height);
- int columns = PIXEL_TO_CHAR_WIDTH (f, event.xconfigure.width);
- if (dont_resize)
- goto OTHER;
-
- /* In the toolkit version, change_frame_size
- is called by the code that handles resizing
- of the EmacsFrame widget. */
-
- /* Even if the number of character rows and columns has
- not changed, the font size may have changed, so we need
- to check the pixel dimensions as well. */
- if (columns != f->width
- || rows != f->height
- || event.xconfigure.width != f->output_data.x->pixel_width
- || event.xconfigure.height != f->output_data.x->pixel_height)
- {
- change_frame_size (f, rows, columns, 0, 1, 0);
- SET_FRAME_GARBAGED (f);
- cancel_mouse_face (f);
- }
+ /* Find the display we are supposed to read input for.
+ It's the one communicating on descriptor SD. */
+ for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
+ {
+#if 0 /* This ought to be unnecessary; let's verify it. */
+#ifdef FIOSNBIO
+ /* If available, Xlib uses FIOSNBIO to make the socket
+ non-blocking, and then looks for EWOULDBLOCK. If O_NDELAY is set,
+ FIOSNBIO is ignored, and instead of signaling EWOULDBLOCK,
+ a read returns 0, which Xlib interprets as equivalent to EPIPE. */
+ fcntl (dpyinfo->connection, F_SETFL, 0);
+#endif /* ! defined (FIOSNBIO) */
#endif
- f->output_data.x->pixel_width = event.xconfigure.width;
- f->output_data.x->pixel_height = event.xconfigure.height;
-
- /* What we have now is the position of Emacs's own window.
- Convert that to the position of the window manager window. */
- x_real_positions (f, &f->output_data.x->left_pos,
- &f->output_data.x->top_pos);
-
- x_check_fullscreen_move(f);
- if (f->output_data.x->want_fullscreen & FULLSCREEN_WAIT)
- f->output_data.x->want_fullscreen &=
- ~(FULLSCREEN_WAIT|FULLSCREEN_BOTH);
-#ifdef HAVE_X_I18N
- if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMStatusArea))
- xic_set_statusarea (f);
+#if 0 /* This code can't be made to work, with multiple displays,
+ and appears not to be used on any system any more.
+ Also keyboard.c doesn't turn O_NDELAY on and off
+ for X connections. */
+#ifndef SIGIO
+#ifndef HAVE_SELECT
+ if (! (fcntl (dpyinfo->connection, F_GETFL, 0) & O_NDELAY))
+ {
+ extern int read_alarm_should_throw;
+ read_alarm_should_throw = 1;
+ XPeekEvent (dpyinfo->display, &event);
+ read_alarm_should_throw = 0;
+ }
+#endif /* HAVE_SELECT */
+#endif /* SIGIO */
#endif
- if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
- {
- /* Since the WM decorations come below top_pos now,
- we must put them below top_pos in the future. */
- f->output_data.x->win_gravity = NorthWestGravity;
- x_wm_set_size_hint (f, (long) 0, 0);
- }
-#ifdef USE_MOTIF
- /* Some window managers pass (0,0) as the location of
- the window, and the Motif event handler stores it
- in the emacs widget, which messes up Motif menus. */
- if (event.xconfigure.x == 0 && event.xconfigure.y == 0)
- {
- event.xconfigure.x = f->output_data.x->widget->core.x;
- event.xconfigure.y = f->output_data.x->widget->core.y;
- }
-#endif /* USE_MOTIF */
- }
- goto OTHER;
+ /* For debugging, this gives a way to fake an I/O error. */
+ if (dpyinfo == XTread_socket_fake_io_error)
+ {
+ XTread_socket_fake_io_error = 0;
+ x_io_error_quitter (dpyinfo->display);
+ }
- case ButtonPress:
- case ButtonRelease:
- {
- /* If we decide we want to generate an event to be seen
- by the rest of Emacs, we put it here. */
- struct input_event emacs_event;
- int tool_bar_p = 0;
-
- emacs_event.kind = no_event;
- bzero (&compose_status, sizeof (compose_status));
-
- if (dpyinfo->grabbed
- && last_mouse_frame
- && FRAME_LIVE_P (last_mouse_frame))
- f = last_mouse_frame;
- else
- f = x_window_to_frame (dpyinfo, event.xbutton.window);
-
- if (f)
- {
- /* Is this in the tool-bar? */
- if (WINDOWP (f->tool_bar_window)
- && XFASTINT (XWINDOW (f->tool_bar_window)->height))
- {
- Lisp_Object window;
- int p, x, y;
-
- x = event.xbutton.x;
- y = event.xbutton.y;
-
- /* Set x and y. */
- window = window_from_coordinates (f, x, y, &p, 1);
- if (EQ (window, f->tool_bar_window))
- {
- x_handle_tool_bar_click (f, &event.xbutton);
- tool_bar_p = 1;
- }
- }
+#ifdef HAVE_X_SM
+ BLOCK_INPUT;
+ count += x_session_check_input (bufp, &numchars);
+ UNBLOCK_INPUT;
+#endif
- if (!tool_bar_p)
- if (!dpyinfo->x_focus_frame
- || f == dpyinfo->x_focus_frame)
- construct_mouse_click (&emacs_event, &event, f);
- }
- else
- {
-#ifndef USE_TOOLKIT_SCROLL_BARS
- struct scroll_bar *bar
- = x_window_to_scroll_bar (event.xbutton.window);
+#ifdef USE_GTK
+ /* For GTK we must use the GTK event loop. But XEvents gets passed
+ to our filter function above, and then to the big event switch.
+ We use a bunch of globals to communicate with our filter function,
+ that is kind of ugly, but it works. */
+ current_dpyinfo = dpyinfo;
- if (bar)
- x_scroll_bar_handle_click (bar, &event, &emacs_event);
-#endif /* not USE_TOOLKIT_SCROLL_BARS */
- }
+ while (gtk_events_pending ())
+ {
+ current_count = count;
+ current_numcharsp = &numchars;
+ current_bufp = &bufp;
- if (event.type == ButtonPress)
- {
- dpyinfo->grabbed |= (1 << event.xbutton.button);
- last_mouse_frame = f;
- /* Ignore any mouse motion that happened
- before this event; any subsequent mouse-movement
- Emacs events should reflect only motion after
- the ButtonPress. */
- if (f != 0)
- f->mouse_moved = 0;
-
- if (!tool_bar_p)
- last_tool_bar_item = -1;
- }
- else
- {
- dpyinfo->grabbed &= ~(1 << event.xbutton.button);
- }
+ gtk_main_iteration ();
- if (numchars >= 1 && emacs_event.kind != no_event)
- {
- bcopy (&emacs_event, bufp, sizeof (struct input_event));
- bufp++;
- count++;
- numchars--;
- }
+ count = current_count;
+ current_bufp = 0;
+ current_numcharsp = 0;
-#ifdef USE_X_TOOLKIT
- f = x_menubar_window_to_frame (dpyinfo, event.xbutton.window);
- /* For a down-event in the menu bar,
- don't pass it to Xt right now.
- Instead, save it away
- and we will pass it to Xt from kbd_buffer_get_event.
- That way, we can run some Lisp code first. */
- if (f && event.type == ButtonPress
- /* Verify the event is really within the menu bar
- and not just sent to it due to grabbing. */
- && event.xbutton.x >= 0
- && event.xbutton.x < f->output_data.x->pixel_width
- && event.xbutton.y >= 0
- && event.xbutton.y < f->output_data.x->menubar_height
- && event.xbutton.same_screen)
- {
- SET_SAVED_BUTTON_EVENT;
- XSETFRAME (last_mouse_press_frame, f);
- }
- else if (event.type == ButtonPress)
- {
- last_mouse_press_frame = Qnil;
- goto OTHER;
- }
+ if (current_finish == X_EVENT_GOTO_OUT)
+ goto out;
+ }
-#ifdef USE_MOTIF /* This should do not harm for Lucid,
- but I am trying to be cautious. */
- else if (event.type == ButtonRelease)
- {
- if (!NILP (last_mouse_press_frame))
- {
- f = XFRAME (last_mouse_press_frame);
- if (f->output_data.x)
- SET_SAVED_BUTTON_EVENT;
- }
- else
- goto OTHER;
- }
-#endif /* USE_MOTIF */
- else
- goto OTHER;
-#endif /* USE_X_TOOLKIT */
- }
- break;
+#else /* not USE_GTK */
+ while (XPending (dpyinfo->display))
+ {
+ int finish;
- case CirculateNotify:
- goto OTHER;
-
- case CirculateRequest:
- goto OTHER;
+ XNextEvent (dpyinfo->display, &event);
- case VisibilityNotify:
- goto OTHER;
+#ifdef HAVE_X_I18N
+ /* Filter events for the current X input method. */
+ if (x_filter_event (dpyinfo, &event))
+ break;
+#endif
+ event_found = 1;
- case MappingNotify:
- /* Someone has changed the keyboard mapping - update the
- local cache. */
- switch (event.xmapping.request)
- {
- case MappingModifier:
- x_find_modifier_meanings (dpyinfo);
- /* This is meant to fall through. */
- case MappingKeyboard:
- XRefreshKeyboardMapping (&event.xmapping);
- }
- goto OTHER;
+ count += handle_one_xevent (dpyinfo,
+ &event,
+ &bufp,
+ &numchars,
+ &finish);
- default:
- OTHER:
-#ifdef USE_X_TOOLKIT
- BLOCK_INPUT;
- XtDispatchEvent (&event);
- UNBLOCK_INPUT;
-#endif /* USE_X_TOOLKIT */
- break;
- }
- }
+ if (finish == X_EVENT_GOTO_OUT)
+ goto out;
+ }
+#endif /* USE_GTK */
}
out:;
Text Cursor
***********************************************************************/
-/* Notice when the text cursor of window W has been completely
- overwritten by a drawing operation that outputs glyphs in AREA
- starting at X0 and ending at X1 in the line starting at Y0 and
- ending at Y1. X coordinates are area-relative. X1 < 0 means all
- the rest of the line after X0 has been written. Y coordinates
- are window-relative. */
-
-static void
-notice_overwritten_cursor (w, area, x0, x1, y0, y1)
- struct window *w;
- enum glyph_row_area area;
- int x0, y0, x1, y1;
-{
- if (area == TEXT_AREA
- && w->phys_cursor_on_p
- && y0 <= w->phys_cursor.y
- && y1 >= w->phys_cursor.y + w->phys_cursor_height
- && x0 <= w->phys_cursor.x
- && (x1 < 0 || x1 > w->phys_cursor.x))
- w->phys_cursor_on_p = 0;
-}
-
-
/* Set clipping for output in glyph row ROW. W is the window in which
we operate. GC is the graphics context to set clipping in.
- WHOLE_LINE_P non-zero means include the areas used for truncation
- mark display and alike in the clipping rectangle.
ROW may be a text row or, e.g., a mode line. Text rows must be
clipped to the interior of the window dedicated to text display,
mode lines must be clipped to the whole window. */
static void
-x_clip_to_row (w, row, gc, whole_line_p)
+x_clip_to_row (w, row, gc)
struct window *w;
struct glyph_row *row;
GC gc;
- int whole_line_p;
{
struct frame *f = XFRAME (WINDOW_FRAME (w));
XRectangle clip_rect;
- int window_x, window_y, window_width, window_height;
+ int window_y, window_width;
- window_box (w, -1, &window_x, &window_y, &window_width, &window_height);
+ window_box (w, -1, 0, &window_y, &window_width, 0);
clip_rect.x = WINDOW_TO_FRAME_PIXEL_X (w, 0);
clip_rect.y = WINDOW_TO_FRAME_PIXEL_Y (w, row->y);
clip_rect.width = window_width;
clip_rect.height = row->visible_height;
- /* If clipping to the whole line, including trunc marks, extend
- the rectangle to the left and increase its width. */
- if (whole_line_p)
- {
- clip_rect.x -= FRAME_X_LEFT_FRINGE_WIDTH (f);
- clip_rect.width += FRAME_X_FRINGE_WIDTH (f);
- }
-
XSetClipRectangles (FRAME_X_DISPLAY (f), gc, 0, 0, &clip_rect, 1, Unsorted);
}
wd = cursor_glyph->pixel_width - 1;
if (cursor_glyph->type == STRETCH_GLYPH
&& !x_stretch_cursor_p)
- wd = min (CANON_X_UNIT (f), wd);
-
+ wd = min (FRAME_COLUMN_WIDTH (f), wd);
+ w->phys_cursor_width = wd;
+
/* The foreground of cursor_gc is typically the same as the normal
background color, which can cause the cursor box to be invisible. */
xgcv.foreground = f->output_data.x->cursor_pixel;
gc = dpyinfo->scratch_cursor_gc;
/* Set clipping, draw the rectangle, and reset clipping again. */
- x_clip_to_row (w, row, gc, 0);
+ x_clip_to_row (w, row, gc);
XDrawRectangle (dpy, FRAME_X_WINDOW (f), gc, x, y, wd, h);
XSetClipMask (dpy, gc, None);
}
--gerd. */
static void
-x_draw_bar_cursor (w, row, width)
+x_draw_bar_cursor (w, row, width, kind)
struct window *w;
struct glyph_row *row;
int width;
+ enum text_cursor_kinds kind;
{
struct frame *f = XFRAME (w->frame);
struct glyph *cursor_glyph;
-
+
/* If cursor is out of bounds, don't draw garbage. This can happen
in mini-buffer windows when switching between echo area glyphs
and mini-buffer. */
{
struct glyph_row *row;
row = MATRIX_ROW (w->current_matrix, w->phys_cursor.vpos);
- x_draw_phys_cursor_glyph (w, row, DRAW_CURSOR);
+ draw_phys_cursor_glyph (w, row, DRAW_CURSOR);
}
else
{
else
xgcv.background = xgcv.foreground = f->output_data.x->cursor_pixel;
xgcv.graphics_exposures = 0;
-
+
if (gc)
XChangeGC (dpy, gc, mask, &xgcv);
else
gc = XCreateGC (dpy, window, mask, &xgcv);
FRAME_X_DISPLAY_INFO (f)->scratch_cursor_gc = gc;
}
-
+
if (width < 0)
- width = f->output_data.x->cursor_width;
+ width = FRAME_CURSOR_WIDTH (f);
width = min (cursor_glyph->pixel_width, width);
-
- x_clip_to_row (w, row, gc, 0);
- XFillRectangle (dpy, window, gc,
- WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x),
- WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y),
- width, row->height);
- XSetClipMask (dpy, gc, None);
- }
-}
-
-/* Clear the cursor of window W to background color, and mark the
- cursor as not shown. This is used when the text where the cursor
- is is about to be rewritten. */
+ w->phys_cursor_width = width;
+ x_clip_to_row (w, row, gc);
-static void
-x_clear_cursor (w)
- struct window *w;
-{
- if (FRAME_VISIBLE_P (XFRAME (w->frame)) && w->phys_cursor_on_p)
- x_update_window_cursor (w, 0);
-}
-
-
-/* Draw the cursor glyph of window W in glyph row ROW. See the
- comment of x_draw_glyphs for the meaning of HL. */
-
-static void
-x_draw_phys_cursor_glyph (w, row, hl)
- struct window *w;
- struct glyph_row *row;
- enum draw_glyphs_face hl;
-{
- /* If cursor hpos is out of bounds, don't draw garbage. This can
- happen in mini-buffer windows when switching between echo area
- glyphs and mini-buffer. */
- if (w->phys_cursor.hpos < row->used[TEXT_AREA])
- {
- int on_p = w->phys_cursor_on_p;
-
- x_draw_glyphs (w, w->phys_cursor.x, row, TEXT_AREA,
- w->phys_cursor.hpos, w->phys_cursor.hpos + 1,
- hl, 0);
- w->phys_cursor_on_p = on_p;
-
- /* When we erase the cursor, and ROW is overlapped by other
- rows, make sure that these overlapping parts of other rows
- are redrawn. */
- if (hl == DRAW_NORMAL_TEXT && row->overlapped_p)
- {
- if (row > w->current_matrix->rows
- && MATRIX_ROW_OVERLAPS_SUCC_P (row - 1))
- x_fix_overlapping_area (w, row - 1, TEXT_AREA);
+ if (kind == BAR_CURSOR)
+ XFillRectangle (dpy, window, gc,
+ WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x),
+ WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y),
+ width, row->height);
+ else
+ XFillRectangle (dpy, window, gc,
+ WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x),
+ WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y +
+ row->height - width),
+ cursor_glyph->pixel_width,
+ width);
- if (MATRIX_ROW_BOTTOM_Y (row) < window_text_bottom_y (w)
- && MATRIX_ROW_OVERLAPS_PRED_P (row + 1))
- x_fix_overlapping_area (w, row + 1, TEXT_AREA);
- }
+ XSetClipMask (dpy, gc, None);
}
}
-/* Erase the image of a cursor of window W from the screen. */
+/* RIF: Define cursor CURSOR on frame F. */
static void
-x_erase_phys_cursor (w)
- struct window *w;
+x_define_frame_cursor (f, cursor)
+ struct frame *f;
+ Cursor cursor;
{
- struct frame *f = XFRAME (w->frame);
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
- int hpos = w->phys_cursor.hpos;
- int vpos = w->phys_cursor.vpos;
- int mouse_face_here_p = 0;
- struct glyph_matrix *active_glyphs = w->current_matrix;
- struct glyph_row *cursor_row;
- struct glyph *cursor_glyph;
- enum draw_glyphs_face hl;
-
- /* No cursor displayed or row invalidated => nothing to do on the
- screen. */
- if (w->phys_cursor_type == NO_CURSOR)
- goto mark_cursor_off;
-
- /* VPOS >= active_glyphs->nrows means that window has been resized.
- Don't bother to erase the cursor. */
- if (vpos >= active_glyphs->nrows)
- goto mark_cursor_off;
-
- /* If row containing cursor is marked invalid, there is nothing we
- can do. */
- cursor_row = MATRIX_ROW (active_glyphs, vpos);
- if (!cursor_row->enabled_p)
- goto mark_cursor_off;
-
- /* If row is completely invisible, don't attempt to delete a cursor which
- isn't there. This can happen if cursor is at top of a window, and
- we switch to a buffer with a header line in that window. */
- if (cursor_row->visible_height <= 0)
- goto mark_cursor_off;
-
- /* This can happen when the new row is shorter than the old one.
- In this case, either x_draw_glyphs or clear_end_of_line
- should have cleared the cursor. Note that we wouldn't be
- able to erase the cursor in this case because we don't have a
- cursor glyph at hand. */
- if (w->phys_cursor.hpos >= cursor_row->used[TEXT_AREA])
- goto mark_cursor_off;
-
- /* If the cursor is in the mouse face area, redisplay that when
- we clear the cursor. */
- if (! NILP (dpyinfo->mouse_face_window)
- && w == XWINDOW (dpyinfo->mouse_face_window)
- && (vpos > dpyinfo->mouse_face_beg_row
- || (vpos == dpyinfo->mouse_face_beg_row
- && hpos >= dpyinfo->mouse_face_beg_col))
- && (vpos < dpyinfo->mouse_face_end_row
- || (vpos == dpyinfo->mouse_face_end_row
- && hpos < dpyinfo->mouse_face_end_col))
- /* Don't redraw the cursor's spot in mouse face if it is at the
- end of a line (on a newline). The cursor appears there, but
- mouse highlighting does not. */
- && cursor_row->used[TEXT_AREA] > hpos)
- mouse_face_here_p = 1;
-
- /* Maybe clear the display under the cursor. */
- if (w->phys_cursor_type == HOLLOW_BOX_CURSOR)
- {
- int x;
- int header_line_height = WINDOW_DISPLAY_HEADER_LINE_HEIGHT (w);
-
- cursor_glyph = get_phys_cursor_glyph (w);
- if (cursor_glyph == NULL)
- goto mark_cursor_off;
-
- x = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x);
-
- x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- x,
- WINDOW_TO_FRAME_PIXEL_Y (w, max (header_line_height,
- cursor_row->y)),
- cursor_glyph->pixel_width,
- cursor_row->visible_height,
- False);
- }
-
- /* Erase the cursor by redrawing the character underneath it. */
- if (mouse_face_here_p)
- hl = DRAW_MOUSE_FACE;
- else
- hl = DRAW_NORMAL_TEXT;
- x_draw_phys_cursor_glyph (w, cursor_row, hl);
-
- mark_cursor_off:
- w->phys_cursor_on_p = 0;
- w->phys_cursor_type = NO_CURSOR;
+ XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
}
-/* Non-zero if physical cursor of window W is within mouse face. */
+/* RIF: Clear area on frame F. */
-static int
-cursor_in_mouse_face_p (w)
- struct window *w;
+static void
+x_clear_frame_area (f, x, y, width, height)
+ struct frame *f;
+ int x, y, width, height;
{
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (XFRAME (w->frame));
- int in_mouse_face = 0;
-
- if (WINDOWP (dpyinfo->mouse_face_window)
- && XWINDOW (dpyinfo->mouse_face_window) == w)
- {
- int hpos = w->phys_cursor.hpos;
- int vpos = w->phys_cursor.vpos;
-
- if (vpos >= dpyinfo->mouse_face_beg_row
- && vpos <= dpyinfo->mouse_face_end_row
- && (vpos > dpyinfo->mouse_face_beg_row
- || hpos >= dpyinfo->mouse_face_beg_col)
- && (vpos < dpyinfo->mouse_face_end_row
- || hpos < dpyinfo->mouse_face_end_col
- || dpyinfo->mouse_face_past_end))
- in_mouse_face = 1;
- }
-
- return in_mouse_face;
+ x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ x, y, width, height, False);
}
-/* Display or clear cursor of window W. If ON is zero, clear the
- cursor. If it is non-zero, display the cursor. If ON is nonzero,
- where to put the cursor is specified by HPOS, VPOS, X and Y. */
+/* RIF: Draw cursor on window W. */
-void
-x_display_and_set_cursor (w, on, hpos, vpos, x, y)
+static void
+x_draw_window_cursor (w, glyph_row, x, y, cursor_type, cursor_width, on_p, active_p)
struct window *w;
- int on, hpos, vpos, x, y;
+ struct glyph_row *glyph_row;
+ int x, y;
+ int cursor_type, cursor_width;
+ int on_p, active_p;
{
- struct frame *f = XFRAME (w->frame);
- int new_cursor_type;
- int new_cursor_width;
- struct glyph_matrix *current_glyphs;
- struct glyph_row *glyph_row;
- struct glyph *glyph;
- int cursor_non_selected;
-
- /* This is pointless on invisible frames, and dangerous on garbaged
- windows and frames; in the latter case, the frame or window may
- be in the midst of changing its size, and x and y may be off the
- window. */
- if (! FRAME_VISIBLE_P (f)
- || FRAME_GARBAGED_P (f)
- || vpos >= w->current_matrix->nrows
- || hpos >= w->current_matrix->matrix_w)
- return;
-
- /* If cursor is off and we want it off, return quickly. */
- if (!on && !w->phys_cursor_on_p)
- return;
-
- current_glyphs = w->current_matrix;
- glyph_row = MATRIX_ROW (current_glyphs, vpos);
- glyph = glyph_row->glyphs[TEXT_AREA] + hpos;
-
- /* If cursor row is not enabled, we don't really know where to
- display the cursor. */
- if (!glyph_row->enabled_p)
- {
- w->phys_cursor_on_p = 0;
- return;
- }
+ struct frame *f = XFRAME (WINDOW_FRAME (w));
- xassert (interrupt_input_blocked);
-
- /* Set new_cursor_type to the cursor we want to be displayed. In a
- mini-buffer window, we want the cursor only to appear if we are
- reading input from this window. For the selected window, we want
- the cursor type given by the frame parameter. If explicitly
- marked off, draw no cursor. In all other cases, we want a hollow
- box cursor. */
- cursor_non_selected
- = !NILP (Fbuffer_local_value (Qcursor_in_non_selected_windows,
- w->buffer));
- new_cursor_width = -1;
- if (cursor_in_echo_area
- && FRAME_HAS_MINIBUF_P (f)
- && EQ (FRAME_MINIBUF_WINDOW (f), echo_area_window))
- {
- if (w == XWINDOW (echo_area_window))
- new_cursor_type = FRAME_DESIRED_CURSOR (f);
- else if (cursor_non_selected)
- new_cursor_type = HOLLOW_BOX_CURSOR;
- else
- new_cursor_type = NO_CURSOR;
- }
- else
+ if (on_p)
{
- if (f != FRAME_X_DISPLAY_INFO (f)->x_highlight_frame
- || w != XWINDOW (f->selected_window))
- {
- if ((MINI_WINDOW_P (w) && minibuf_level == 0)
- || !cursor_non_selected
- || NILP (XBUFFER (w->buffer)->cursor_type))
- new_cursor_type = NO_CURSOR;
- else
- new_cursor_type = HOLLOW_BOX_CURSOR;
- }
- else if (w->cursor_off_p)
- new_cursor_type = NO_CURSOR;
- else
- {
- struct buffer *b = XBUFFER (w->buffer);
-
- if (EQ (b->cursor_type, Qt))
- new_cursor_type = FRAME_DESIRED_CURSOR (f);
- else
- new_cursor_type = x_specified_cursor_type (b->cursor_type,
- &new_cursor_width);
- }
- }
-
- /* If cursor is currently being shown and we don't want it to be or
- it is in the wrong place, or the cursor type is not what we want,
- erase it. */
- if (w->phys_cursor_on_p
- && (!on
- || w->phys_cursor.x != x
- || w->phys_cursor.y != y
- || new_cursor_type != w->phys_cursor_type))
- x_erase_phys_cursor (w);
-
- /* If the cursor is now invisible and we want it to be visible,
- display it. */
- if (on && !w->phys_cursor_on_p)
- {
- w->phys_cursor_ascent = glyph_row->ascent;
- w->phys_cursor_height = glyph_row->height;
-
- /* Set phys_cursor_.* before x_draw_.* is called because some
- of them may need the information. */
- w->phys_cursor.x = x;
- w->phys_cursor.y = glyph_row->y;
- w->phys_cursor.hpos = hpos;
- w->phys_cursor.vpos = vpos;
- w->phys_cursor_type = new_cursor_type;
+ w->phys_cursor_type = cursor_type;
w->phys_cursor_on_p = 1;
- switch (new_cursor_type)
+ switch (cursor_type)
{
case HOLLOW_BOX_CURSOR:
x_draw_hollow_cursor (w, glyph_row);
break;
case FILLED_BOX_CURSOR:
- x_draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR);
- break;
-
- case BAR_CURSOR:
- x_draw_bar_cursor (w, glyph_row, new_cursor_width);
- break;
-
- case NO_CURSOR:
+ draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR);
break;
- default:
- abort ();
- }
-
-#ifdef HAVE_X_I18N
- if (w == XWINDOW (f->selected_window))
- if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMPreeditPosition))
- xic_set_preeditarea (w, x, y);
-#endif
- }
-
-#ifndef XFlush
- if (updating_frame != f)
- XFlush (FRAME_X_DISPLAY (f));
-#endif
-}
-
-
-/* Display the cursor on window W, or clear it. X and Y are window
- relative pixel coordinates. HPOS and VPOS are glyph matrix
- positions. If W is not the selected window, display a hollow
- cursor. ON non-zero means display the cursor at X, Y which
- correspond to HPOS, VPOS, otherwise it is cleared. */
-
-void
-x_display_cursor (w, on, hpos, vpos, x, y)
- struct window *w;
- int on, hpos, vpos, x, y;
-{
- BLOCK_INPUT;
- x_display_and_set_cursor (w, on, hpos, vpos, x, y);
- UNBLOCK_INPUT;
-}
-
-
-/* Display the cursor on window W, or clear it, according to ON_P.
- Don't change the cursor's position. */
-
-void
-x_update_cursor (f, on_p)
- struct frame *f;
-{
- x_update_cursor_in_window_tree (XWINDOW (f->root_window), on_p);
-}
-
-
-/* Call x_update_window_cursor with parameter ON_P on all leaf windows
- in the window tree rooted at W. */
-
-static void
-x_update_cursor_in_window_tree (w, on_p)
- struct window *w;
- int on_p;
-{
- while (w)
- {
- if (!NILP (w->hchild))
- x_update_cursor_in_window_tree (XWINDOW (w->hchild), on_p);
- else if (!NILP (w->vchild))
- x_update_cursor_in_window_tree (XWINDOW (w->vchild), on_p);
- else
- x_update_window_cursor (w, on_p);
+ case BAR_CURSOR:
+ x_draw_bar_cursor (w, glyph_row, cursor_width, BAR_CURSOR);
+ break;
- w = NILP (w->next) ? 0 : XWINDOW (w->next);
- }
-}
+ case HBAR_CURSOR:
+ x_draw_bar_cursor (w, glyph_row, cursor_width, HBAR_CURSOR);
+ break;
+ case NO_CURSOR:
+ w->phys_cursor_width = 0;
+ break;
-/* Switch the display of W's cursor on or off, according to the value
- of ON. */
+ default:
+ abort ();
+ }
-static void
-x_update_window_cursor (w, on)
- struct window *w;
- int on;
-{
- /* Don't update cursor in windows whose frame is in the process
- of being deleted. */
- if (w->current_matrix)
- {
- BLOCK_INPUT;
- x_display_and_set_cursor (w, on, w->phys_cursor.hpos, w->phys_cursor.vpos,
- w->phys_cursor.x, w->phys_cursor.y);
- UNBLOCK_INPUT;
+#ifdef HAVE_X_I18N
+ if (w == XWINDOW (f->selected_window))
+ if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMPreeditPosition))
+ xic_set_preeditarea (w, x, y);
+#endif
}
-}
-
+#ifndef XFlush
+ if (updating_frame != f)
+ XFlush (FRAME_X_DISPLAY (f));
+#endif
+}
\f
/* Icons. */
if (FRAME_X_WINDOW (f) == 0)
return 1;
- /* Free up our existing icon bitmap if any. */
+ /* Free up our existing icon bitmap and mask if any. */
if (f->output_data.x->icon_bitmap > 0)
x_destroy_bitmap (f, f->output_data.x->icon_bitmap);
f->output_data.x->icon_bitmap = 0;
if (STRINGP (file))
- bitmap_id = x_create_bitmap_from_file (f, file);
+ {
+#ifdef USE_GTK
+ /* Use gtk_window_set_icon_from_file() if available,
+ It's not restricted to bitmaps */
+ if (xg_set_icon(f, file))
+ return 0;
+#endif /* USE_GTK */
+ bitmap_id = x_create_bitmap_from_file (f, file);
+ x_create_bitmap_mask(f, bitmap_id);
+ }
else
{
- /* Create the GNU bitmap if necessary. */
+ /* Create the GNU bitmap and mask if necessary. */
if (FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id < 0)
- FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id
- = x_create_bitmap_from_data (f, gnu_bits,
- gnu_width, gnu_height);
+ {
+ FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id
+ = x_create_bitmap_from_data (f, gnu_bits,
+ gnu_width, gnu_height);
+ x_create_bitmap_mask(f, FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id);
+ }
- /* The first time we create the GNU bitmap,
+ /* The first time we create the GNU bitmap and mask,
this increments the ref-count one extra time.
- As a result, the GNU bitmap is never freed.
+ As a result, the GNU bitmap and mask are never freed.
That way, we don't have to worry about allocating it again. */
x_reference_bitmap (f, FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id);
text.encoding = XA_STRING;
text.format = 8;
text.nitems = strlen (icon_name);
-#ifdef USE_X_TOOLKIT
- XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
- &text);
-#else /* not USE_X_TOOLKIT */
- XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
-#endif /* not USE_X_TOOLKIT */
+ XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &text);
}
#else /* not HAVE_X11R4 */
- XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), icon_name);
+ XSetIconName (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), icon_name);
#endif /* not HAVE_X11R4 */
if (f->output_data.x->icon_bitmap > 0)
XErrorEvent *error;
{
XGetErrorText (display, error->error_code,
- XSTRING (x_error_message_string)->data,
+ SDATA (x_error_message_string),
X_ERROR_MESSAGE_SIZE);
}
x_catch_errors (dpy)
Display *dpy;
{
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
/* Make sure any errors from previous requests have been dealt with. */
XSync (dpy, False);
- record_unwind_protect (x_catch_errors_unwind, x_error_message_string);
+ record_unwind_protect (x_catch_errors_unwind,
+ Fcons (make_save_value (dpy, 0),
+ x_error_message_string));
x_error_message_string = make_uninit_string (X_ERROR_MESSAGE_SIZE);
- XSTRING (x_error_message_string)->data[0] = 0;
+ SSET (x_error_message_string, 0, 0);
return count;
}
x_catch_errors_unwind (old_val)
Lisp_Object old_val;
{
- x_error_message_string = old_val;
+ Lisp_Object first;
+
+ first = XCAR (old_val);
+
+ XSync (XSAVE_VALUE (first)->pointer, False);
+
+ x_error_message_string = XCDR (old_val);
return Qnil;
}
/* Make sure to catch any errors incurred so far. */
XSync (dpy, False);
- if (XSTRING (x_error_message_string)->data[0])
- error (format, XSTRING (x_error_message_string)->data);
+ if (SREF (x_error_message_string, 0))
+ error (format, SDATA (x_error_message_string));
}
/* Nonzero if we had any X protocol errors
/* Make sure to catch any errors incurred so far. */
XSync (dpy, False);
- return XSTRING (x_error_message_string)->data[0] != 0;
+ return SREF (x_error_message_string, 0) != 0;
}
/* Forget about any errors we have had, since we did x_catch_errors on DPY. */
x_clear_errors (dpy)
Display *dpy;
{
- XSTRING (x_error_message_string)->data[0] = 0;
+ SSET (x_error_message_string, 0, 0);
}
/* Stop catching X protocol errors and let them make Emacs die.
\f
/* Handle SIGPIPE, which can happen when the connection to a server
simply goes away. SIGPIPE is handled by x_connection_signal.
- Don't need to do anything, because the write which caused the
+ Don't need to do anything, because the write which caused the
SIGPIPE will fail, causing Xlib to invoke the X IO error handler,
which will do the appropriate cleanup for us. */
-
+
static SIGTYPE
x_connection_signal (signalnum) /* If we don't have an argument, */
int signalnum; /* some compilers complain in signal calls. */
struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
Lisp_Object frame, tail;
int count;
-
+
error_msg = (char *) alloca (strlen (error_message) + 1);
strcpy (error_msg, error_message);
handling_signal = 0;
-
+
/* Prevent being called recursively because of an error condition
below. Otherwise, we might end up with printing ``can't find per
display information'' in the recursive call instead of printing
the original message here. */
count = x_catch_errors (dpy);
-
+
/* We have to close the display to inform Xt that it doesn't
exist anymore. If we don't, Xt will continue to wait for
events from the display. As a consequence, a sequence of
Closing the display is reported to lead to a bus error on
OpenWindows in certain situations. I suspect that is a bug
in OpenWindows. I don't know how to cicumvent it here. */
-
+
#ifdef USE_X_TOOLKIT
/* If DPYINFO is null, this means we didn't open the display
in the first place, so don't try to close it. */
x_delete_display (dpyinfo);
x_uncatch_errors (dpy, count);
-
+
if (x_display_list == 0)
{
fprintf (stderr, "%s\n", error_msg);
register char *fontname;
{
struct font_info *fontp
- = FS_LOAD_FONT (f, 0, fontname, -1);
+ = FS_LOAD_FONT (f, fontname);
if (!fontp)
return Qnil;
- if (f->output_data.x->font == (XFontStruct *) (fontp->font))
++ 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);
+
- f->output_data.x->font = (XFontStruct *) (fontp->font);
- f->output_data.x->baseline_offset = fontp->baseline_offset;
- f->output_data.x->fontset = -1;
+ FRAME_FONT (f) = (XFontStruct *) (fontp->font);
+ FRAME_BASELINE_OFFSET (f) = fontp->baseline_offset;
+ FRAME_FONTSET (f) = -1;
- x_compute_fringe_widths (f, 1);
+ FRAME_COLUMN_WIDTH (f) = FONT_WIDTH (FRAME_FONT (f));
+ FRAME_LINE_HEIGHT (f) = FONT_HEIGHT (FRAME_FONT (f));
+
+ compute_fringe_widths (f, 1);
/* Compute the scroll bar width in character columns. */
- if (f->scroll_bar_pixel_width > 0)
+ if (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0)
{
- int wid = FONT_WIDTH (f->output_data.x->font);
- f->scroll_bar_cols = (f->scroll_bar_pixel_width + wid-1) / wid;
+ int wid = FRAME_COLUMN_WIDTH (f);
+ FRAME_CONFIG_SCROLL_BAR_COLS (f)
+ = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + wid-1) / wid;
}
else
{
- int wid = FONT_WIDTH (f->output_data.x->font);
- f->scroll_bar_cols = (14 + wid - 1) / wid;
+ 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)
{
XSetFont (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
- f->output_data.x->font->fid);
+ FRAME_FONT (f)->fid);
XSetFont (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
- f->output_data.x->font->fid);
+ FRAME_FONT (f)->fid);
XSetFont (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
- f->output_data.x->font->fid);
-
- frame_update_line_height (f);
+ FRAME_FONT (f)->fid);
/* 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, f->width, f->height);
+ x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
}
- else
- /* If we are setting a new frame's font for the first time,
- there are no faces yet, so this font's height is the line height. */
- f->output_data.x->line_height = FONT_HEIGHT (f->output_data.x->font);
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.
++ 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, (XSTRING (fontset_ascii (fontset))->data));
++ if (fontset > 0)
++ result = x_new_font (f, (SDATA (fontset_ascii (fontset))));
+ else
- result = x_new_font (f, XSTRING (fontsetname)->data);
++ 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. */
- f->output_data.x->fontset = fontset;
+ FRAME_FONTSET (f) = fontset;
#ifdef HAVE_X_I18N
if (FRAME_XIC (f)
&& (FRAME_XIC_STYLE (f) & (XIMPreeditPosition | XIMStatusArea)))
- xic_set_xfontset (f, XSTRING (fontset_ascii (fontset))->data);
+ xic_set_xfontset (f, SDATA (fontset_ascii (fontset)));
#endif
-
+
- return build_string (fontsetname);
+ return fontset_name (fontset);
}
-/* Compute actual fringe widths */
-
-void
-x_compute_fringe_widths (f, redraw)
- struct frame *f;
- int redraw;
-{
- int o_left = f->output_data.x->left_fringe_width;
- int o_right = f->output_data.x->right_fringe_width;
- int o_cols = f->output_data.x->fringe_cols;
-
- Lisp_Object left_fringe = Fassq (Qleft_fringe, f->param_alist);
- Lisp_Object right_fringe = Fassq (Qright_fringe, f->param_alist);
- int left_fringe_width, right_fringe_width;
-
- if (!NILP (left_fringe))
- left_fringe = Fcdr (left_fringe);
- if (!NILP (right_fringe))
- right_fringe = Fcdr (right_fringe);
-
- left_fringe_width = ((NILP (left_fringe) || !INTEGERP (left_fringe)) ? 8 :
- XINT (left_fringe));
- right_fringe_width = ((NILP (right_fringe) || !INTEGERP (right_fringe)) ? 8 :
- XINT (right_fringe));
-
- if (left_fringe_width || right_fringe_width)
- {
- int left_wid = left_fringe_width >= 0 ? left_fringe_width : -left_fringe_width;
- int right_wid = right_fringe_width >= 0 ? right_fringe_width : -right_fringe_width;
- int conf_wid = left_wid + right_wid;
- int font_wid = FONT_WIDTH (f->output_data.x->font);
- int cols = (left_wid + right_wid + font_wid-1) / font_wid;
- int real_wid = cols * font_wid;
- if (left_wid && right_wid)
- {
- if (left_fringe_width < 0)
- {
- /* Left fringe width is fixed, adjust right fringe if necessary */
- f->output_data.x->left_fringe_width = left_wid;
- f->output_data.x->right_fringe_width = real_wid - left_wid;
- }
- else if (right_fringe_width < 0)
- {
- /* Right fringe width is fixed, adjust left fringe if necessary */
- f->output_data.x->left_fringe_width = real_wid - right_wid;
- f->output_data.x->right_fringe_width = right_wid;
- }
- else
- {
- /* Adjust both fringes with an equal amount.
- Note that we are doing integer arithmetic here, so don't
- lose a pixel if the total width is an odd number. */
- int fill = real_wid - conf_wid;
- f->output_data.x->left_fringe_width = left_wid + fill/2;
- f->output_data.x->right_fringe_width = right_wid + fill - fill/2;
- }
- }
- else if (left_fringe_width)
- {
- f->output_data.x->left_fringe_width = real_wid;
- f->output_data.x->right_fringe_width = 0;
- }
- else
- {
- f->output_data.x->left_fringe_width = 0;
- f->output_data.x->right_fringe_width = real_wid;
- }
- f->output_data.x->fringe_cols = cols;
- f->output_data.x->fringes_extra = real_wid;
- }
- else
- {
- f->output_data.x->left_fringe_width = 0;
- f->output_data.x->right_fringe_width = 0;
- f->output_data.x->fringe_cols = 0;
- f->output_data.x->fringes_extra = 0;
- }
-
- if (redraw && FRAME_VISIBLE_P (f))
- if (o_left != f->output_data.x->left_fringe_width ||
- o_right != f->output_data.x->right_fringe_width ||
- o_cols != f->output_data.x->fringe_cols)
- redraw_frame (f);
-}
\f
/***********************************************************************
X Input Methods
{
struct x_display_info *dpyinfo = (struct x_display_info *) client_data;
Lisp_Object frame, tail;
-
+
BLOCK_INPUT;
-
+
/* No need to call XDestroyIC.. */
FOR_EACH_FRAME (tail, frame)
{
}
}
}
-
+
/* No need to call XCloseIM. */
dpyinfo->xim = NULL;
XFree (dpyinfo->xim_styles);
#endif /* HAVE_X11R6 */
+#ifdef HAVE_X11R6
+/* This isn't prototyped in OSF 5.0 or 5.1a. */
+extern char *XSetIMValues P_ ((XIM, ...));
+#endif
+
/* Open the connection to the XIM server on display DPYINFO.
RESOURCE_NAME is the resource name Emacs uses. */
{
XIM xim;
+#ifdef HAVE_XIM
if (use_xim)
{
xim = XOpenIM (dpyinfo->display, dpyinfo->xrdb, resource_name,
#ifdef HAVE_X11R6
XIMCallback destroy;
#endif
-
+
/* Get supported styles and XIM values. */
XGetIMValues (xim, XNQueryInputStyle, &dpyinfo->xim_styles, NULL);
-
+
#ifdef HAVE_X11R6
destroy.callback = xim_destroy_callback;
destroy.client_data = (XPointer)dpyinfo;
#endif
}
}
+
else
+#endif /* HAVE_XIM */
dpyinfo->xim = NULL;
}
};
/* XIM instantiate callback function, which is called whenever an XIM
- server is available. DISPLAY is teh display of the XIM.
+ server is available. DISPLAY is the display of the XIM.
CLIENT_DATA contains a pointer to an xim_inst_t structure created
when the callback was registered. */
/* We don't support multiple XIM connections. */
if (dpyinfo->xim)
return;
-
+
xim_open_dpy (dpyinfo, xim_inst->resource_name);
/* Create XIC for the existing frames on the same display, as long
FOR_EACH_FRAME (tail, frame)
{
struct frame *f = XFRAME (frame);
-
+
if (FRAME_X_DISPLAY_INFO (f) == xim_inst->dpyinfo)
if (FRAME_XIC (f) == NULL)
{
}
}
}
-
+
UNBLOCK_INPUT;
}
}
struct x_display_info *dpyinfo;
char *resource_name;
{
+#ifdef HAVE_XIM
if (use_xim)
{
#ifdef HAVE_X11R6_XIM
struct xim_inst_t *xim_inst;
int len;
-
+
dpyinfo->xim = NULL;
xim_inst = (struct xim_inst_t *) xmalloc (sizeof (struct xim_inst_t));
xim_inst->dpyinfo = dpyinfo;
XRegisterIMInstantiateCallback (dpyinfo->display, dpyinfo->xrdb,
resource_name, EMACS_CLASS,
xim_instantiate_callback,
- /* Fixme: This is XPointer in
- XFree86 but (XPointer *) on
- Tru64, at least. */
- (XPointer) xim_inst);
+ /* This is XPointer in XFree86
+ but (XPointer *) on Tru64, at
+ least, hence the configure test. */
+ (XRegisterIMInstantiateCallback_arg6) xim_inst);
#else /* not HAVE_X11R6_XIM */
dpyinfo->xim = NULL;
xim_open_dpy (dpyinfo, resource_name);
#endif /* not HAVE_X11R6_XIM */
+
}
else
+#endif /* HAVE_XIM */
dpyinfo->xim = NULL;
}
xim_close_dpy (dpyinfo)
struct x_display_info *dpyinfo;
{
+#ifdef HAVE_XIM
if (use_xim)
{
#ifdef HAVE_X11R6_XIM
dpyinfo->xim = NULL;
XFree (dpyinfo->xim_styles);
}
+#endif /* HAVE_XIM */
}
#endif /* not HAVE_X11R6_XIM */
{
Window child;
int win_x = 0, win_y = 0;
- int flags = f->output_data.x->size_hint_flags;
+ int flags = f->size_hint_flags;
int this_window;
/* We have nothing to do if the current position
if (! ((flags & XNegative) || (flags & YNegative)))
return;
-#ifdef USE_X_TOOLKIT
- this_window = XtWindow (f->output_data.x->widget);
-#else
- this_window = FRAME_X_WINDOW (f);
-#endif
+ this_window = FRAME_OUTER_WINDOW (f);
/* Find the position of the outside upper-left corner of
the inner window, with respect to the outer window.
/* Treat negative positions as relative to the leftmost bottommost
position that fits on the screen. */
if (flags & XNegative)
- f->output_data.x->left_pos = (FRAME_X_DISPLAY_INFO (f)->width
- - 2 * f->output_data.x->border_width - win_x
- - PIXEL_WIDTH (f)
- + f->output_data.x->left_pos);
+ f->left_pos = (FRAME_X_DISPLAY_INFO (f)->width
+ - 2 * f->border_width - win_x
+ - FRAME_PIXEL_WIDTH (f)
+ + f->left_pos);
{
- int height = PIXEL_HEIGHT (f);
+ int height = FRAME_PIXEL_HEIGHT (f);
#if defined USE_X_TOOLKIT && defined USE_MOTIF
/* Something is fishy here. When using Motif, starting Emacs with
It's not obvious where the initial small difference comes from.
2000-12-01, gerd. */
-
+
XtVaGetValues (f->output_data.x->column_widget, XtNheight, &height, NULL);
#endif
if (flags & YNegative)
- f->output_data.x->top_pos = (FRAME_X_DISPLAY_INFO (f)->height
- - 2 * f->output_data.x->border_width
- - win_y
- - height
- + f->output_data.x->top_pos);
+ f->top_pos = (FRAME_X_DISPLAY_INFO (f)->height
+ - 2 * f->border_width
+ - win_y
+ - height
+ + f->top_pos);
}
-
+
/* The left_pos and top_pos
are now relative to the top and left screen edges,
so the flags should correspond. */
- f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative);
+ f->size_hint_flags &= ~ (XNegative | YNegative);
}
/* CHANGE_GRAVITY is 1 when calling from Fset_frame_position,
if (change_gravity > 0)
{
- f->output_data.x->top_pos = yoff;
- f->output_data.x->left_pos = xoff;
- f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative);
+ f->top_pos = yoff;
+ f->left_pos = xoff;
+ f->size_hint_flags &= ~ (XNegative | YNegative);
if (xoff < 0)
- f->output_data.x->size_hint_flags |= XNegative;
+ f->size_hint_flags |= XNegative;
if (yoff < 0)
- f->output_data.x->size_hint_flags |= YNegative;
- f->output_data.x->win_gravity = NorthWestGravity;
+ f->size_hint_flags |= YNegative;
+ f->win_gravity = NorthWestGravity;
}
x_calc_absolute_position (f);
BLOCK_INPUT;
x_wm_set_size_hint (f, (long) 0, 0);
- modified_left = f->output_data.x->left_pos;
- modified_top = f->output_data.x->top_pos;
+ modified_left = f->left_pos;
+ modified_top = f->top_pos;
#if 0 /* Running on psilocin (Debian), and displaying on the NCD X-terminal,
this seems to be unnecessary and incorrect. rms, 4/17/97. */
/* It is a mystery why we need to add the border_width here
when the frame is already visible, but experiment says we do. */
if (change_gravity != 0)
{
- modified_left += f->output_data.x->border_width;
- modified_top += f->output_data.x->border_width;
+ modified_left += f->border_width;
+ modified_top += f->border_width;
}
#endif
-#ifdef USE_X_TOOLKIT
- XMoveWindow (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
- modified_left, modified_top);
-#else /* not USE_X_TOOLKIT */
- XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- modified_left, modified_top);
-#endif /* not USE_X_TOOLKIT */
+ XMoveWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ modified_left, modified_top);
UNBLOCK_INPUT;
}
x_check_fullscreen (f)
struct frame *f;
{
- if (f->output_data.x->want_fullscreen & FULLSCREEN_BOTH)
+ if (f->want_fullscreen & FULLSCREEN_BOTH)
{
int width, height, ign;
-
- x_real_positions (f, &f->output_data.x->left_pos,
- &f->output_data.x->top_pos);
+
+ x_real_positions (f, &f->left_pos, &f->top_pos);
x_fullscreen_adjust (f, &width, &height, &ign, &ign);
-
+
/* We do not need to move the window, it shall be taken care of
when setting WM manager hints.
If the frame is visible already, the position is checked by
x_check_fullscreen_move. */
- if (f->width != width || f->height != height)
+ if (FRAME_COLS (f) != width || FRAME_LINES (f) != height)
{
change_frame_size (f, height, width, 0, 1, 0);
SET_FRAME_GARBAGED (f);
cancel_mouse_face (f);
/* Wait for the change of frame size to occur */
- f->output_data.x->want_fullscreen |= FULLSCREEN_WAIT;
-
+ f->want_fullscreen |= FULLSCREEN_WAIT;
}
}
}
x_check_fullscreen_move (f)
struct frame *f;
{
- if (f->output_data.x->want_fullscreen & FULLSCREEN_MOVE_WAIT)
+ if (f->want_fullscreen & FULLSCREEN_MOVE_WAIT)
{
- int expect_top = f->output_data.x->top_pos;
- int expect_left = f->output_data.x->left_pos;
+ int expect_top = f->top_pos;
+ int expect_left = f->left_pos;
- if (f->output_data.x->want_fullscreen & FULLSCREEN_HEIGHT)
+ if (f->want_fullscreen & FULLSCREEN_HEIGHT)
expect_top = 0;
- if (f->output_data.x->want_fullscreen & FULLSCREEN_WIDTH)
+ if (f->want_fullscreen & FULLSCREEN_WIDTH)
expect_left = 0;
-
- if (expect_top != f->output_data.x->top_pos
- || expect_left != f->output_data.x->left_pos)
+
+ if (expect_top != f->top_pos || expect_left != f->left_pos)
x_set_offset (f, expect_left, expect_top, 1);
/* Just do this once */
- f->output_data.x->want_fullscreen &= ~FULLSCREEN_MOVE_WAIT;
+ f->want_fullscreen &= ~FULLSCREEN_MOVE_WAIT;
}
}
-/* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
- wanted positions of the WM window (not emacs window).
- Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
- window (FRAME_X_WINDOW).
- */
-void
-x_fullscreen_adjust (f, width, height, top_pos, left_pos)
- struct frame *f;
- int *width;
- int *height;
- int *top_pos;
- int *left_pos;
-{
- int newwidth = f->width, newheight = f->height;
-
- *top_pos = f->output_data.x->top_pos;
- *left_pos = f->output_data.x->left_pos;
-
- if (f->output_data.x->want_fullscreen & FULLSCREEN_HEIGHT)
- {
- int ph;
-
- ph = FRAME_X_DISPLAY_INFO (f)->height;
- newheight = PIXEL_TO_CHAR_HEIGHT (f, ph);
- ph = CHAR_TO_PIXEL_HEIGHT (f, newheight)
- - f->output_data.x->y_pixels_diff;
- newheight = PIXEL_TO_CHAR_HEIGHT (f, ph);
- *top_pos = 0;
- }
-
- if (f->output_data.x->want_fullscreen & FULLSCREEN_WIDTH)
- {
- int pw;
-
- pw = FRAME_X_DISPLAY_INFO (f)->width;
- newwidth = PIXEL_TO_CHAR_WIDTH (f, pw);
- pw = CHAR_TO_PIXEL_WIDTH (f, newwidth)
- - f->output_data.x->x_pixels_diff;
- newwidth = PIXEL_TO_CHAR_WIDTH (f, pw);
- *left_pos = 0;
- }
-
- *width = newwidth;
- *height = newheight;
-}
-
-
/* Change the size of frame F's X window to COLS/ROWS in the case F
doesn't have a widget. If CHANGE_GRAVITY is 1, we change to
top-left-corner window gravity for this size change and subsequent
int pixelwidth, pixelheight;
check_frame_size (f, &rows, &cols);
- f->output_data.x->vertical_scroll_bar_extra
+ f->scroll_bar_actual_width
= (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
? 0
- : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
- ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
- : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
+ : FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
+ ? FRAME_CONFIG_SCROLL_BAR_WIDTH (f)
+ : (FRAME_CONFIG_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f)));
- x_compute_fringe_widths (f, 0);
+ compute_fringe_widths (f, 0);
- pixelwidth = CHAR_TO_PIXEL_WIDTH (f, cols);
- pixelheight = CHAR_TO_PIXEL_HEIGHT (f, rows);
+ pixelwidth = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, cols);
+ pixelheight = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, rows);
- f->output_data.x->win_gravity = NorthWestGravity;
+ f->win_gravity = NorthWestGravity;
x_wm_set_size_hint (f, (long) 0, 0);
XSync (FRAME_X_DISPLAY (f), False);
We pass 1 for DELAY since we can't run Lisp code inside of
a BLOCK_INPUT. */
change_frame_size (f, rows, cols, 0, 1, 0);
- PIXEL_WIDTH (f) = pixelwidth;
- PIXEL_HEIGHT (f) = pixelheight;
+ FRAME_PIXEL_WIDTH (f) = pixelwidth;
+ FRAME_PIXEL_HEIGHT (f) = pixelheight;
/* We've set {FRAME,PIXEL}_{WIDTH,HEIGHT} to the values we hope to
receive in the ConfigureNotify event; if we get what we asked
{
BLOCK_INPUT;
-#ifdef USE_X_TOOLKIT
-
+#ifdef USE_GTK
+ if (FRAME_GTK_WIDGET (f))
+ xg_frame_set_char_size (f, cols, rows);
+ else
+ x_set_window_size_1 (f, change_gravity, cols, rows);
+#elif USE_X_TOOLKIT
+
if (f->output_data.x->widget != NULL)
{
/* The x and y position of the widget is clobbered by the
}
else
x_set_window_size_1 (f, change_gravity, cols, rows);
-
+
#else /* not USE_X_TOOLKIT */
-
+
x_set_window_size_1 (f, change_gravity, cols, rows);
-
+
#endif /* not USE_X_TOOLKIT */
/* If cursor was outside the new size, mark it as off. */
mark_window_cursors_off (XWINDOW (f->root_window));
/* Clear out any recollection of where the mouse highlighting was,
- since it might be in a place that's outside the new frame size.
+ since it might be in a place that's outside the new frame size.
Actually checking whether it is outside is a pain in the neck,
so don't try--just let the highlighting be done afresh with new size. */
cancel_mouse_face (f);
{
int pix_x, pix_y;
- pix_x = CHAR_TO_PIXEL_COL (f, x) + FONT_WIDTH (f->output_data.x->font) / 2;
- pix_y = CHAR_TO_PIXEL_ROW (f, y) + f->output_data.x->line_height / 2;
+ pix_x = FRAME_COL_TO_PIXEL_X (f, x) + FRAME_COLUMN_WIDTH (f) / 2;
+ pix_y = FRAME_LINE_TO_PIXEL_Y (f, y) + FRAME_LINE_HEIGHT (f) / 2;
if (pix_x < 0) pix_x = 0;
- if (pix_x > PIXEL_WIDTH (f)) pix_x = PIXEL_WIDTH (f);
+ if (pix_x > FRAME_PIXEL_WIDTH (f)) pix_x = FRAME_PIXEL_WIDTH (f);
if (pix_y < 0) pix_y = 0;
- if (pix_y > PIXEL_HEIGHT (f)) pix_y = PIXEL_HEIGHT (f);
+ if (pix_y > FRAME_PIXEL_HEIGHT (f)) pix_y = FRAME_PIXEL_HEIGHT (f);
BLOCK_INPUT;
if (f->async_visible)
{
BLOCK_INPUT;
-#ifdef USE_X_TOOLKIT
- XRaiseWindow (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget));
-#else /* not USE_X_TOOLKIT */
- XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
-#endif /* not USE_X_TOOLKIT */
+ XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f));
XFlush (FRAME_X_DISPLAY (f));
UNBLOCK_INPUT;
}
if (f->async_visible)
{
BLOCK_INPUT;
-#ifdef USE_X_TOOLKIT
- XLowerWindow (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget));
-#else /* not USE_X_TOOLKIT */
- XLowerWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
-#endif /* not USE_X_TOOLKIT */
+ XLowerWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f));
XFlush (FRAME_X_DISPLAY (f));
UNBLOCK_INPUT;
}
before the window gets really visible. */
if (! FRAME_ICONIFIED_P (f)
&& ! f->output_data.x->asked_for_visible)
- x_set_offset (f, f->output_data.x->left_pos, f->output_data.x->top_pos, 0);
+ x_set_offset (f, f->left_pos, f->top_pos, 0);
f->output_data.x->asked_for_visible = 1;
/* This was XtPopup, but that did nothing for an iconified frame. */
XtMapWidget (f->output_data.x->widget);
#else /* not USE_X_TOOLKIT */
+#ifdef USE_GTK
+ gtk_widget_show_all (FRAME_GTK_OUTER_WIDGET (f));
+ gtk_window_deiconify (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)));
+#else
XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
+#endif /* not USE_GTK */
#endif /* not USE_X_TOOLKIT */
#if 0 /* This seems to bring back scroll bars in the wrong places
if the window configuration has changed. They seem
will set it when they are handled. */
int previously_visible = f->output_data.x->has_been_visible;
- original_left = f->output_data.x->left_pos;
- original_top = f->output_data.x->top_pos;
+ original_left = f->left_pos;
+ original_top = f->top_pos;
/* This must come after we set COUNT. */
UNBLOCK_INPUT;
and we don't want to override it. */
if (! FRAME_VISIBLE_P (f) && ! FRAME_ICONIFIED_P (f)
- && f->output_data.x->win_gravity == NorthWestGravity
+ && f->win_gravity == NorthWestGravity
&& previously_visible)
{
Drawable rootw;
int x, y;
unsigned int width, height, border, depth;
-
+
BLOCK_INPUT;
/* On some window managers (such as FVWM) moving an existing
(raise-frame f))
the frame is not raised with various window managers on
- FreeBSD, Linux and Solaris. It turns out that, for some
+ FreeBSD, GNU/Linux and Solaris. It turns out that, for some
unknown reason, the call to XtMapWidget is completely ignored.
Mapping the widget a second time works. */
-
+
if (!FRAME_VISIBLE_P (f) && --retry_count > 0)
goto retry;
}
{
Window window;
-#ifdef USE_X_TOOLKIT
/* Use the frame's outermost window, not the one we normally draw on. */
- window = XtWindow (f->output_data.x->widget);
-#else /* not USE_X_TOOLKIT */
- window = FRAME_X_WINDOW (f);
-#endif /* not USE_X_TOOLKIT */
+ window = FRAME_OUTER_WINDOW (f);
/* Don't keep the highlight on an invisible frame. */
if (FRAME_X_DISPLAY_INFO (f)->x_highlight_frame == f)
by hand again (they have already done that once for this window.) */
x_wm_set_size_hint (f, (long) 0, 1);
+#ifdef USE_GTK
+ if (FRAME_GTK_OUTER_WIDGET (f))
+ gtk_widget_hide (FRAME_GTK_OUTER_WIDGET (f));
+ else
+#endif
+ {
#ifdef HAVE_X11R4
if (! XWithdrawWindow (FRAME_X_DISPLAY (f), window,
/* Unmap the window ourselves. Cheeky! */
XUnmapWindow (FRAME_X_DISPLAY (f), window);
#endif /* ! defined (HAVE_X11R4) */
+ }
/* We can't distinguish this from iconification
just by the event that we get from the server.
if (!NILP (type))
x_bitmap_icon (f, type);
+#ifdef USE_GTK
+ if (FRAME_GTK_OUTER_WIDGET (f))
+ {
+ if (! FRAME_VISIBLE_P (f))
+ gtk_widget_show_all (FRAME_GTK_OUTER_WIDGET (f));
+
+ gtk_window_iconify (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)));
+ f->iconified = 1;
+ f->visible = 1;
+ f->async_iconified = 1;
+ f->async_visible = 0;
+ UNBLOCK_INPUT;
+ return;
+ }
+#endif
+
#ifdef USE_X_TOOLKIT
if (! FRAME_VISIBLE_P (f))
/* Make sure the X server knows where the window should be positioned,
in case the user deiconifies with the window manager. */
if (! FRAME_VISIBLE_P (f) && !FRAME_ICONIFIED_P (f))
- x_set_offset (f, f->output_data.x->left_pos, f->output_data.x->top_pos, 0);
+ x_set_offset (f, f->left_pos, f->top_pos, 0);
/* Since we don't know which revision of X we're running, we'll use both
the X11R3 and X11R4 techniques. I don't know if this is a good idea. */
free_frame_menubar (f);
#else /* !USE_X_TOOLKIT */
+
+#ifdef USE_GTK
+ /* In the GTK version, tooltips are normal X
+ frames. We must check and free both types. */
+ if (FRAME_GTK_OUTER_WIDGET (f))
+ {
+ gtk_widget_destroy (FRAME_GTK_OUTER_WIDGET (f));
+ FRAME_X_WINDOW (f) = 0; /* Set to avoid XDestroyWindow below */
+ FRAME_GTK_OUTER_WIDGET (f) = 0;
+ }
+#endif /* USE_GTK */
+
if (FRAME_X_WINDOW (f))
XDestroyWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
#endif /* !USE_X_TOOLKIT */
if (FRAME_FACE_CACHE (f))
free_frame_faces (f);
-
+
x_free_gcs (f);
XFlush (FRAME_X_DISPLAY (f));
}
xfree (f->output_data.x);
f->output_data.x = NULL;
-
+
if (f == dpyinfo->x_focus_frame)
dpyinfo->x_focus_frame = 0;
if (f == dpyinfo->x_focus_event_frame)
FLAGS is the flags word to use--or 0 meaning preserve the flags
that the window now has.
If USER_POSITION is nonzero, we set the USPosition
- flag (this is useful when FLAGS is 0). */
+ flag (this is useful when FLAGS is 0).
+ The GTK version is in gtkutils.c */
+#ifndef USE_GTK
void
x_wm_set_size_hint (f, flags, user_position)
struct frame *f;
Arg al[2];
int ac = 0;
Dimension widget_width, widget_height;
- Window window = XtWindow (f->output_data.x->widget);
-#else /* not USE_X_TOOLKIT */
- Window window = FRAME_X_WINDOW (f);
-#endif /* not USE_X_TOOLKIT */
+#endif
+
+ Window window = FRAME_OUTER_WINDOW (f);
/* Setting PMaxSize caused various problems. */
size_hints.flags = PResizeInc | PMinSize /* | PMaxSize */;
- size_hints.x = f->output_data.x->left_pos;
- size_hints.y = f->output_data.x->top_pos;
+ size_hints.x = f->left_pos;
+ size_hints.y = f->top_pos;
#ifdef USE_X_TOOLKIT
XtSetArg (al[ac], XtNwidth, &widget_width); ac++;
size_hints.height = widget_height;
size_hints.width = widget_width;
#else /* not USE_X_TOOLKIT */
- size_hints.height = PIXEL_HEIGHT (f);
- size_hints.width = PIXEL_WIDTH (f);
+ size_hints.height = FRAME_PIXEL_HEIGHT (f);
+ size_hints.width = FRAME_PIXEL_WIDTH (f);
#endif /* not USE_X_TOOLKIT */
- size_hints.width_inc = FONT_WIDTH (f->output_data.x->font);
- size_hints.height_inc = f->output_data.x->line_height;
+ size_hints.width_inc = FRAME_COLUMN_WIDTH (f);
+ size_hints.height_inc = FRAME_LINE_HEIGHT (f);
size_hints.max_width
- = FRAME_X_DISPLAY_INFO (f)->width - CHAR_TO_PIXEL_WIDTH (f, 0);
+ = FRAME_X_DISPLAY_INFO (f)->width - FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, 0);
size_hints.max_height
- = FRAME_X_DISPLAY_INFO (f)->height - CHAR_TO_PIXEL_HEIGHT (f, 0);
+ = FRAME_X_DISPLAY_INFO (f)->height - FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 0);
/* Calculate the base and minimum sizes.
int base_width, base_height;
int min_rows = 0, min_cols = 0;
- base_width = CHAR_TO_PIXEL_WIDTH (f, 0);
- base_height = CHAR_TO_PIXEL_HEIGHT (f, 0);
+ base_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, 0);
+ base_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 0);
check_frame_size (f, &min_rows, &min_cols);
#endif
#ifdef PWinGravity
- size_hints.win_gravity = f->output_data.x->win_gravity;
+ size_hints.win_gravity = f->win_gravity;
size_hints.flags |= PWinGravity;
if (user_position)
XSetNormalHints (FRAME_X_DISPLAY (f), window, &size_hints);
#endif
}
+#endif /* not USE_GTK */
/* Used for IconicState or NormalState */
struct frame *f;
int pixmap_id;
{
- Pixmap icon_pixmap;
+ Pixmap icon_pixmap, icon_mask;
#ifndef USE_X_TOOLKIT
- Window window = FRAME_X_WINDOW (f);
+ Window window = FRAME_OUTER_WINDOW (f);
#endif
if (pixmap_id > 0)
{
icon_pixmap = x_bitmap_pixmap (f, pixmap_id);
f->output_data.x->wm_hints.icon_pixmap = icon_pixmap;
+ icon_mask = x_bitmap_mask (f, pixmap_id);
+ f->output_data.x->wm_hints.icon_mask = icon_mask;
}
else
{
best to explicitly give up. */
#if 0
f->output_data.x->wm_hints.icon_pixmap = None;
+ f->output_data.x->wm_hints.icon_mask = None;
#else
return;
#endif
Arg al[1];
XtSetArg (al[0], XtNiconPixmap, icon_pixmap);
XtSetValues (f->output_data.x->widget, al, 1);
+ XtSetArg (al[0], XtNiconMask, icon_mask);
+ XtSetValues (f->output_data.x->widget, al, 1);
}
#else /* not USE_X_TOOLKIT */
-
- f->output_data.x->wm_hints.flags |= IconPixmapHint;
+
+ f->output_data.x->wm_hints.flags |= (IconPixmapHint | IconMaskHint);
XSetWMHints (FRAME_X_DISPLAY (f), window, &f->output_data.x->wm_hints);
#endif /* not USE_X_TOOLKIT */
struct frame *f;
int icon_x, icon_y;
{
-#ifdef USE_X_TOOLKIT
- Window window = XtWindow (f->output_data.x->widget);
-#else
- Window window = FRAME_X_WINDOW (f);
-#endif
+ Window window = FRAME_OUTER_WINDOW (f);
f->output_data.x->wm_hints.flags |= IconPositionHint;
f->output_data.x->wm_hints.icon_x = icon_x;
XFontStruct *font;
unsigned long value;
- font = XLoadQueryFont (dpy, XSTRING (pattern)->data);
+ font = XLoadQueryFont (dpy, SDATA (pattern));
if (x_had_errors_p (dpy))
{
/* This error is perhaps due to insufficient memory on X
{
/* We try at least 10 fonts because XListFonts will return
auto-scaled fonts at the head. */
- names = XListFonts (dpy, XSTRING (pattern)->data, max (maxnames, 10),
- &num_fonts);
+ if (maxnames < 0)
+ {
+ int limit;
+
+ for (limit = 500;;)
+ {
+ names = XListFonts (dpy, SDATA (pattern), limit, &num_fonts);
+ if (num_fonts == limit)
+ {
+ BLOCK_INPUT;
+ XFreeFontNames (names);
+ UNBLOCK_INPUT;
+ limit *= 2;
+ }
+ else
+ break;
+ }
+ }
+ else
+ names = XListFonts (dpy, SDATA (pattern), max (maxnames, 10),
+ &num_fonts);
+
if (x_had_errors_p (dpy))
{
/* This error is perhaps due to insufficient memory on X
int width = 0;
char *p = names[i];
int average_width = -1, dashes = 0;
-
+
/* Count the number of dashes in NAMES[I]. If there are
14 dashes, and the field value following 12th dash
(AVERAGE_WIDTH) is 0, this is a auto-scaled font which
else if (dashes == 12) /* AVERAGE_WIDTH field */
average_width = atoi (p);
}
-
+
if (allow_scalable_fonts_p
|| dashes < 14 || average_width != 0)
{
}
}
}
-
+
if (!try_XLoadQueryFont)
{
BLOCK_INPUT;
BLOCK_INPUT;
count = x_catch_errors (dpy);
thisinfo = XLoadQueryFont (dpy,
- XSTRING (XCAR (tem))->data);
+ SDATA (XCAR (tem)));
if (x_had_errors_p (dpy))
{
/* This error is perhaps due to insufficient memory on X
}
return newlist;
-}
+}
#if GLYPH_DEBUG
xassert (font != NULL);
for (i = 0; i < dpyinfo->n_fonts; i++)
- if (dpyinfo->font_table[i].name
+ if (dpyinfo->font_table[i].name
&& font == dpyinfo->font_table[i].font)
break;
XFontStruct *font;
int old_width = dpyinfo->smallest_char_width;
int old_height = dpyinfo->smallest_font_height;
-
+
dpyinfo->smallest_font_height = 100000;
dpyinfo->smallest_char_width = 100000;
-
+
for (i = 0; i < dpyinfo->n_fonts; ++i)
if (dpyinfo->font_table[i].name)
{
struct font_info *fontp = dpyinfo->font_table + i;
int w, h;
-
+
font = (XFontStruct *) fontp->font;
xassert (font != (XFontStruct *) ~0);
x_font_min_bounds (font, &w, &h);
-
+
dpyinfo->smallest_font_height = min (dpyinfo->smallest_font_height, h);
dpyinfo->smallest_char_width = min (dpyinfo->smallest_char_width, w);
}
for (tail = font_names; CONSP (tail); tail = XCDR (tail))
if (dpyinfo->font_table[i].name
&& (!strcmp (dpyinfo->font_table[i].name,
- XSTRING (XCAR (tail))->data)
+ SDATA (XCAR (tail)))
|| !strcmp (dpyinfo->font_table[i].full_name,
- XSTRING (XCAR (tail))->data)))
+ SDATA (XCAR (tail)))))
return (dpyinfo->font_table + i);
}
a bug of not finding a font even if the font surely exists and
is loadable by XLoadQueryFont. */
if (size > 0 && !NILP (font_names))
- fontname = (char *) XSTRING (XCAR (font_names))->data;
+ fontname = (char *) SDATA (XCAR (font_names));
BLOCK_INPUT;
count = x_catch_errors (FRAME_X_DISPLAY (f));
BLOCK_INPUT;
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);
XFree (name);
}
-
+
if (full_name != 0)
fontp->full_name = full_name;
else
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
>= 0)))
break;
}
-
+
if (! NILP (list))
{
struct ccl_program *ccl
}
-
-
+ /* 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;
+
+ 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)
+ char_table_set_range (table, min_byte2, max_byte2, 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)
+ {
+ char_table_set_range (table, from, i - 1, Qt);
+ from = -1;
+ }
+ }
+ else if (from < 0)
+ from = i;
+ }
+ if (from >= 0)
+ char_table_set_range (table, from, i - 1, Qt);
+ }
+ }
+ else
+ {
+ if (! font->per_char || font->all_chars_exist == True)
+ {
+ int i;
+
+ for (i = min_byte1; i <= max_byte1; i++)
+ char_table_set_range (table,
+ (i << 8) | min_byte2, (i << 8) | max_byte2,
+ 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)
+ {
+ char_table_set_range (table, (i << 8) | from,
+ (i << 8) | (j - 1), Qt);
+ from = -1;
+ }
+ }
+ else if (from < 0)
+ from = j;
+ }
+ if (from >= 0)
+ char_table_set_range (table, (i << 8) | from,
+ (i << 8) | (j - 1), Qt);
+ }
+ }
+ }
+
+ return table;
+ }
\f
/***********************************************************************
Initialization
the screen number from the server number. */
static int
same_x_server (name1, name2)
- char *name1, *name2;
+ const char *name1, *name2;
{
int seen_colon = 0;
- unsigned char *system_name = XSTRING (Vsystem_name)->data;
+ const unsigned char *system_name = SDATA (Vsystem_name);
int system_name_length = strlen (system_name);
int length_until_period = 0;
x_initialized = 1;
}
+#ifdef USE_GTK
+ {
+#define NUM_ARGV 10
+ int argc;
+ char *argv[NUM_ARGV];
+ char **argv2 = argv;
+ GdkAtom atom;
+
+ /* GTK 2.0 can only handle one display, GTK 2.2 can handle more
+ than one, but this remains to be implemented. */
+ if (x_initialized > 1)
+ return 0;
+
+ x_initialized++;
+
+ for (argc = 0; argc < NUM_ARGV; ++argc)
+ argv[argc] = 0;
+
+ argc = 0;
+ argv[argc++] = initial_argv[0];
+
+ if (! NILP (display_name))
+ {
+ argv[argc++] = "--display";
+ argv[argc++] = SDATA (display_name);
+ }
+
+ argv[argc++] = "--name";
+ argv[argc++] = resource_name;
+
+#ifdef HAVE_X11R5
+ XSetLocaleModifiers ("");
+#endif
+
+ gtk_init (&argc, &argv2);
+
+ /* gtk_init does set_locale. We must fix locale after calling it. */
+ fixup_locale ();
+ xg_initialize ();
+
+ dpy = GDK_DISPLAY ();
+
+ /* NULL window -> events for all windows go to our function */
+ gdk_window_add_filter (NULL, event_handler_gdk, NULL);
+
+ /* Load our own gtkrc if it exists. */
+ {
+ struct gcpro gcpro1, gcpro2;
+ char *file = "~/.emacs.d/gtkrc";
+ Lisp_Object s, abs_file;
+
+ GCPRO2 (s, abs_file);
+ s = make_string (file, strlen (file));
+ abs_file = Fexpand_file_name(s, Qnil);
+
+ if (! NILP (abs_file) && Ffile_readable_p (abs_file))
+ gtk_rc_parse (SDATA (abs_file));
+
+ UNGCPRO;
+ }
+
+ XSetErrorHandler (x_error_handler);
+ XSetIOErrorHandler (x_io_error_quitter);
+ }
+#else /* not USE_GTK */
#ifdef USE_X_TOOLKIT
/* weiner@footloose.sps.mot.com reports that this causes
errors with X11R5:
argv[argc++] = "-xrm";
argv[argc++] = xrm_option;
}
- dpy = XtOpenDisplay (Xt_app_con, XSTRING (display_name)->data,
+ turn_on_atimers (0);
+ dpy = XtOpenDisplay (Xt_app_con, SDATA (display_name),
resource_name, EMACS_CLASS,
emacs_options, XtNumber (emacs_options),
&argc, argv);
+ turn_on_atimers (1);
#ifdef HAVE_X11XTR6
/* I think this is to compensate for XtSetLanguageProc. */
#ifdef HAVE_X11R5
XSetLocaleModifiers ("");
#endif
- dpy = XOpenDisplay (XSTRING (display_name)->data);
+ dpy = XOpenDisplay (SDATA (display_name));
#endif /* not USE_X_TOOLKIT */
+#endif /* not USE_GTK*/
/* Detect failure. */
if (dpy == 0)
for (share = x_display_list, tail = x_display_name_list; share;
share = share->next, tail = XCDR (tail))
- if (same_x_server (XSTRING (XCAR (XCAR (tail)))->data,
- XSTRING (display_name)->data))
+ if (same_x_server (SDATA (XCAR (XCAR (tail))),
+ SDATA (display_name)))
break;
if (share)
dpyinfo->kboard = share->kboard;
dpyinfo->next = x_display_list;
x_display_list = dpyinfo;
- /* Put it on x_display_name_list as well, to keep them parallel. */
+ /* Put it on x_display_name_list as well, to keep them parallel. */
x_display_name_list = Fcons (Fcons (display_name, Qnil),
x_display_name_list);
dpyinfo->name_list_element = XCAR (x_display_name_list);
#endif /* ! 0 */
dpyinfo->x_id_name
- = (char *) xmalloc (STRING_BYTES (XSTRING (Vinvocation_name))
- + STRING_BYTES (XSTRING (Vsystem_name))
+ = (char *) xmalloc (SBYTES (Vinvocation_name)
+ + SBYTES (Vsystem_name)
+ 2);
sprintf (dpyinfo->x_id_name, "%s@%s",
- XSTRING (Vinvocation_name)->data, XSTRING (Vsystem_name)->data);
+ SDATA (Vinvocation_name), SDATA (Vsystem_name));
/* Figure out which modifier bits mean what. */
x_find_modifier_meanings (dpyinfo);
build_string ("PrivateColormap"),
Qnil, Qnil);
if (STRINGP (value)
- && (!strcmp (XSTRING (value)->data, "true")
- || !strcmp (XSTRING (value)->data, "on")))
+ && (!strcmp (SDATA (value), "true")
+ || !strcmp (SDATA (value), "on")))
dpyinfo->cmap = XCopyColormapAndFree (dpyinfo->display, dpyinfo->cmap);
}
}
else
dpyinfo->cmap = XCreateColormap (dpyinfo->display, dpyinfo->root_window,
dpyinfo->visual, AllocNone);
-
+
{
int screen_number = XScreenNumberOfScreen (dpyinfo->screen);
double pixels = DisplayHeight (dpyinfo->display, screen_number);
mm = DisplayWidthMM (dpyinfo->display, screen_number);
dpyinfo->resx = pixels * 25.4 / mm;
}
-
+
dpyinfo->Xatom_wm_protocols
= XInternAtom (dpyinfo->display, "WM_PROTOCOLS", False);
dpyinfo->Xatom_wm_take_focus
= XInternAtom (dpyinfo->display, "TEXT", False);
dpyinfo->Xatom_COMPOUND_TEXT
= XInternAtom (dpyinfo->display, "COMPOUND_TEXT", False);
+ dpyinfo->Xatom_UTF8_STRING
+ = XInternAtom (dpyinfo->display, "UTF8_STRING", False);
dpyinfo->Xatom_DELETE
= XInternAtom (dpyinfo->display, "DELETE", False);
dpyinfo->Xatom_MULTIPLE
/* Ghostscript support. */
dpyinfo->Xatom_PAGE = XInternAtom (dpyinfo->display, "PAGE", False);
dpyinfo->Xatom_DONE = XInternAtom (dpyinfo->display, "DONE", False);
-
+
dpyinfo->Xatom_Scrollbar = XInternAtom (dpyinfo->display, "SCROLLBAR",
False);
null_bits[0] = 0x00;
dpyinfo->null_pixel
- = XCreatePixmapFromBitmapData (dpyinfo->display, dpyinfo->root_window,
+ = XCreatePixmapFromBitmapData (dpyinfo->display, dpyinfo->root_window,
null_bits, 1, 1, (long) 0, (long) 0,
1);
}
#ifdef HAVE_X_I18N
xim_initialize (dpyinfo, resource_name);
#endif
-
+
#ifdef subprocesses
/* This is only needed for distinguishing keyboard and process input. */
if (connection != 0)
XrmValue d, fr, to;
Font font;
int count;
-
+
d.addr = (XPointer)&dpy;
d.size = sizeof (Display *);
fr.addr = XtDefaultFont;
build_string ("Synchronous"),
Qnil, Qnil);
if (STRINGP (value)
- && (!strcmp (XSTRING (value)->data, "true")
- || !strcmp (XSTRING (value)->data, "on")))
+ && (!strcmp (SDATA (value), "true")
+ || !strcmp (SDATA (value), "on")))
XSynchronize (dpyinfo->display, True);
}
-
+
{
Lisp_Object value;
value = display_x_get_resource (dpyinfo,
build_string ("useXIM"),
build_string ("UseXIM"),
Qnil, Qnil);
+#ifdef USE_XIM
if (STRINGP (value)
&& (!strcmp (XSTRING (value)->data, "false")
|| !strcmp (XSTRING (value)->data, "off")))
use_xim = 0;
+#else
+ if (STRINGP (value)
+ && (!strcmp (XSTRING (value)->data, "true")
+ || !strcmp (XSTRING (value)->data, "on")))
+ use_xim = 1;
+#endif
}
-
+
UNBLOCK_INPUT;
return dpyinfo;
if (dpyinfo->xim)
xim_close_dpy (dpyinfo);
#endif
-
+
xfree (dpyinfo->font_table);
xfree (dpyinfo->x_id_name);
xfree (dpyinfo->color_cells);
xfree (dpyinfo);
}
+#ifdef USE_X_TOOLKIT
+
+/* Atimer callback function for TIMER. Called every 0.1s to process
+ Xt timeouts, if needed. We must avoid calling XtAppPending as
+ much as possible because that function does an implicit XFlush
+ that slows us down. */
+
+static void
+x_process_timeouts (timer)
+ struct atimer *timer;
+{
+ if (toolkit_scroll_bar_interaction || popup_activated ())
+ {
+ BLOCK_INPUT;
+ while (XtAppPending (Xt_app_con) & XtIMTimer)
+ XtAppProcessEvent (Xt_app_con, XtIMTimer);
+ UNBLOCK_INPUT;
+ }
+}
+
+#endif /* USE_X_TOOLKIT */
+
\f
/* Set up use of X before we make the first connection. */
+extern frame_parm_handler x_frame_parm_handlers[];
+
static struct redisplay_interface x_redisplay_interface =
{
+ x_frame_parm_handlers,
x_produce_glyphs,
x_write_glyphs,
x_insert_glyphs,
x_after_update_window_line,
x_update_window_begin,
x_update_window_end,
- XTcursor_to,
+ x_cursor_to,
+ x_flush,
+#ifndef XFlush
x_flush,
- x_clear_mouse_face,
+#else
+ 0, /* flush_display_optional */
+#endif
+ x_clear_window_mouse_face,
x_get_glyph_overhangs,
- x_fix_overlapping_area
+ x_fix_overlapping_area,
+ x_draw_fringe_bitmap,
+ x_per_char_metric,
+ x_encode_char,
+ x_compute_glyph_string_overhangs,
+ x_draw_glyph_string,
+ x_define_frame_cursor,
+ x_clear_frame_area,
+ x_draw_window_cursor,
+ x_draw_vertical_window_border,
+ x_shift_glyphs_for_insert
};
void
condemn_scroll_bars_hook = XTcondemn_scroll_bars;
redeem_scroll_bar_hook = XTredeem_scroll_bar;
judge_scroll_bars_hook = XTjudge_scroll_bars;
- estimate_mode_line_height_hook = x_estimate_mode_line_height;
scroll_region_ok = 1; /* we'll scroll partial frames */
char_ins_del_ok = 1;
x_noop_count = 0;
last_tool_bar_item = -1;
any_help_event_p = 0;
-
+
/* Try to use interrupt input; if we can't, then start polling. */
Fset_input_mode (Qt, Qnil, Qt, Qnil);
XtToolkitInitialize ();
Xt_app_con = XtCreateApplicationContext ();
-
+
/* Register a converter from strings to pixels, which uses
Emacs' color allocation infrastructure. */
XtAppSetTypeConverter (Xt_app_con,
start_atimer (ATIMER_CONTINUOUS, interval, x_process_timeouts, 0);
}
#endif
-
+
#ifdef USE_TOOLKIT_SCROLL_BARS
+#ifndef USE_GTK
xaw3d_arrow_scroll = False;
xaw3d_pick_top = True;
+#endif
#endif
/* Note that there is no real way portable across R3/R4 to get the
/* Disable Window Change signals; they are handled by X events. */
#ifdef SIGWINCH
signal (SIGWINCH, SIG_DFL);
-#endif /* ! defined (SIGWINCH) */
+#endif /* SIGWINCH */
signal (SIGPIPE, x_connection_signal);
+
+#ifdef HAVE_X_SM
+ x_session_initialize ();
+#endif
}
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");
+
staticpro (&last_mouse_press_frame);
last_mouse_press_frame = Qnil;
- help_echo = Qnil;
- staticpro (&help_echo);
- help_echo_object = Qnil;
- staticpro (&help_echo_object);
- help_echo_window = Qnil;
- staticpro (&help_echo_window);
- previous_help_echo = Qnil;
- staticpro (&previous_help_echo);
- help_echo_pos = -1;
-
- DEFVAR_BOOL ("x-autoselect-window", &x_autoselect_window_p,
- doc: /* *Non-nil means autoselect window with mouse pointer. */);
- x_autoselect_window_p = 0;
-
- DEFVAR_BOOL ("x-stretch-cursor", &x_stretch_cursor_p,
- doc: /* *Non-nil means draw block cursor as wide as the glyph under it.
-For example, if a block cursor is over a tab, it will be drawn as
-wide as that tab on the display. */);
- x_stretch_cursor_p = 0;
-
DEFVAR_BOOL ("x-use-underline-position-properties",
&x_use_underline_position_properties,
doc: /* *Non-nil means make use of UNDERLINE_POSITION font properties.
Vx_toolkit_scroll_bars = intern ("motif");
#elif defined HAVE_XAW3D
Vx_toolkit_scroll_bars = intern ("xaw3d");
+#elif USE_GTK
+ Vx_toolkit_scroll_bars = intern ("gtk");
#else
Vx_toolkit_scroll_bars = intern ("xaw");
#endif
staticpro (&last_mouse_motion_frame);
last_mouse_motion_frame = Qnil;
-
+
Qmodifier_value = intern ("modifier-value");
Qalt = intern ("alt");
Fput (Qalt, Qmodifier_value, make_number (alt_modifier));
Fput (Qmeta, Qmodifier_value, make_number (meta_modifier));
Qsuper = intern ("super");
Fput (Qsuper, Qmodifier_value, make_number (super_modifier));
-
+
DEFVAR_LISP ("x-alt-keysym", &Vx_alt_keysym,
doc: /* Which keys Emacs uses for the alt modifier.
This should be one of the symbols `alt', `hyper', `meta', `super'.
For example, `alt' means use the Alt_L and Alt_R keysyms. The default
is nil, which is the same as `alt'. */);
Vx_alt_keysym = Qnil;
-
+
DEFVAR_LISP ("x-hyper-keysym", &Vx_hyper_keysym,
doc: /* Which keys Emacs uses for the hyper modifier.
This should be one of the symbols `alt', `hyper', `meta', `super'.
For example, `hyper' means use the Hyper_L and Hyper_R keysyms. The
default is nil, which is the same as `hyper'. */);
Vx_hyper_keysym = Qnil;
-
+
DEFVAR_LISP ("x-meta-keysym", &Vx_meta_keysym,
doc: /* Which keys Emacs uses for the meta modifier.
This should be one of the symbols `alt', `hyper', `meta', `super'.
For example, `meta' means use the Meta_L and Meta_R keysyms. The
default is nil, which is the same as `meta'. */);
Vx_meta_keysym = Qnil;
-
+
DEFVAR_LISP ("x-super-keysym", &Vx_super_keysym,
doc: /* Which keys Emacs uses for the super modifier.
This should be one of the symbols `alt', `hyper', `meta', `super'.
#include <X11/StringDefs.h>
#include <X11/IntrinsicP.h> /* CoreP.h needs this */
#include <X11/CoreP.h> /* foul, but we need this to use our own
- window inside a widget instead of one
+ window inside a widget instead of one
that Xt creates... */
#include <X11/StringDefs.h>
+
+typedef Widget xt_or_gtk_widget;
#endif
-/* The class of this X application. */
-#define EMACS_CLASS "Emacs"
+#ifdef USE_GTK
+#include <gtk/gtk.h>
+#include <gdk/gdkx.h>
+
+/* Some definitions to reduce conditionals. */
+typedef GtkWidget *xt_or_gtk_widget;
+#define XtParent(x) (gtk_widget_get_parent (x))
+#undef XSync
+#define XSync(d, b) gdk_window_process_all_updates ()
+
+#endif /* USE_GTK */
+
\f
/* Bookkeeping to distinguish X versions. */
#ifdef PBaseSize
/* AIX 3.1's X is somewhere between X11R3 and X11R4. It has
PBaseSize, but not XWithdrawWindow, XSetWMName, XSetWMNormalHints,
- XSetWMIconName.
+ XSetWMIconName.
AIX 3.2 is at least X11R4. */
#if (!defined AIX) || (defined AIX3_2)
#define HAVE_X11R4
#define FONT_WIDTH(f) ((f)->max_bounds.width)
#define FONT_HEIGHT(f) ((f)->ascent + (f)->descent)
#define FONT_BASE(f) ((f)->ascent)
+#define FONT_DESCENT(f) ((f)->descent)
/* The mask of events that text windows always want to receive. This
includes mouse movement events, since handling the mouse-font text property
| EnterWindowMask \
| VisibilityChangeMask)
-enum text_cursor_kinds
-{
- NO_CURSOR = -1,
- FILLED_BOX_CURSOR,
- HOLLOW_BOX_CURSOR,
- BAR_CURSOR
-};
-
/* Structure recording X pixmap and reference count.
If REFCOUNT is 0 then this record is free to be reused. */
struct x_bitmap_record
{
Pixmap pixmap;
+ int have_mask;
+ Pixmap mask;
char *file;
int refcount;
/* Record some info about this pixmap. */
{
/* Chain of all x_display_info structures. */
struct x_display_info *next;
-
+
/* Connection number (normally a file descriptor number). */
int connection;
-
+
/* This says how to access this display in Xlib. */
Display *display;
-
+
/* This is a cons cell of the form (NAME . FONT-LIST-CACHE).
The same cons cell also appears in x_display_name_list. */
Lisp_Object name_list_element;
-
+
/* Number of frames that are on this display. */
int reference_count;
-
+
/* The Screen this connection is connected to. */
Screen *screen;
/* Dots per inch of the screen. */
double resx, resy;
-
+
/* The Visual being used for this display. */
Visual *visual;
/* The colormap being used. */
Colormap cmap;
-
+
/* Number of panes on this screen. */
int n_planes;
-
+
/* Dimensions of this screen. */
int height, width;
-
+
/* Mask of things that cause the mouse to be grabbed. */
int grabbed;
-
+
/* Emacs bitmap-id of the default icon bitmap for this frame.
Or -1 if none has been allocated yet. */
int icon_bitmap_id;
-
+
/* The root window of this screen. */
Window root_window;
-
+
/* The cursor to use for vertical scroll bars. */
Cursor vertical_scroll_bar_cursor;
-
+
/* X Resource data base */
XrmDatabase xrdb;
/* Communication with window managers. */
Atom Xatom_wm_protocols;
-
+
/* Kinds of protocol things we may receive. */
Atom Xatom_wm_take_focus;
Atom Xatom_wm_save_yourself;
Atom Xatom_wm_delete_window;
-
+
/* Atom for indicating window state to the window manager. */
Atom Xatom_wm_change_state;
-
+
/* Other WM communication */
Atom Xatom_wm_configure_denied; /* When our config request is denied */
Atom Xatom_wm_window_moved; /* When the WM moves us. */
-
+
/* EditRes protocol */
Atom Xatom_editres;
/* More atoms, which are selection types. */
Atom Xatom_CLIPBOARD, Xatom_TIMESTAMP, Xatom_TEXT, Xatom_DELETE,
- Xatom_COMPOUND_TEXT,
+ Xatom_COMPOUND_TEXT, Xatom_UTF8_STRING,
Xatom_MULTIPLE, Xatom_INCR, Xatom_EMACS_TMP, Xatom_TARGETS, Xatom_NULL,
Xatom_ATOM_PAIR;
extern struct frame *x_window_to_frame P_ ((struct x_display_info *, int));
-#ifdef USE_X_TOOLKIT
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
extern struct frame *x_any_window_to_frame P_ ((struct x_display_info *, int));
extern struct frame *x_non_menubar_window_to_frame P_ ((struct x_display_info *, int));
extern struct frame *x_top_window_to_frame P_ ((struct x_display_info *, int));
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
struct x_output
{
- /* Position of the X window (x and y offsets in root window). */
- int left_pos;
- int top_pos;
-
- /* Border width of the X window as known by the X window system. */
- int border_width;
-
- /* Size of the X window in pixels. */
- int pixel_height, pixel_width;
-
/* Height of menu bar widget, in pixels.
Zero if not using the X toolkit.
When using the toolkit, this value is not meaningful
if the menubar is turned off. */
int menubar_height;
- /* Height of a line, in pixels. */
- int line_height;
+ /* Height of tool bar widget, in pixels.
+ Zero if not using an external tool bar. */
+ int toolbar_height;
/* The tiled border used when the mouse is out of the frame. */
Pixmap border_tile;
GC reverse_gc; /* Reverse video */
GC cursor_gc; /* cursor drawing */
- /* Width of the internal border. This is a line of background color
- just inside the window's border. When the frame is selected,
- a highlighting is displayed inside the internal border. */
- int internal_border_width;
-
/* The X window used for this frame.
May be zero while the frame object is being created
and the X window has not yet been created. */
Widget menubar_widget;
#endif
+#ifdef USE_GTK
+ /* The widget of this screen. This is the window of a top widget. */
+ GtkWidget *widget;
+ /* The widget of the edit portion of this screen; the window in
+ "window_desc" is inside of this. */
+ GtkWidget *edit_widget;
+ /* The widget used for laying out widgets vertically. */
+ GtkWidget *vbox_widget;
+ /* The menubar in this frame. */
+ GtkWidget *menubar_widget;
+ /* The tool bar in this frame */
+ GtkWidget *toolbar_widget;
+ /* The handle box that makes the tool bar detachable. */
+ GtkWidget *handlebox_widget;
+
+ /* The last size hints set. */
+ GdkGeometry size_hints;
+ long hint_flags;
+#endif
+
/* If >=0, a bitmap index. The indicated bitmap is used for the
icon. */
int icon_bitmap;
/* Foreground color for scroll bars. A value of -1 means use the
default (black for non-toolkit scroll bars). */
unsigned long scroll_bar_foreground_pixel;
-
+
/* Background color for scroll bars. A value of -1 means use the
default (background color of the frame for non-toolkit scroll
bars). */
Cursor text_cursor;
Cursor nontext_cursor;
Cursor modeline_cursor;
- Cursor cross_cursor;
+ Cursor hand_cursor;
Cursor hourglass_cursor;
Cursor horizontal_drag_cursor;
/* Window whose cursor is hourglass_cursor. This window is temporarily
mapped to display an hourglass cursor. */
Window hourglass_window;
-
+
/* Non-zero means hourglass cursor is currently displayed. */
unsigned hourglass_p : 1;
/* Flag to set when the X window needs to be completely repainted. */
int needs_exposure;
- /* What kind of text cursor is drawn in this window right now?
- (If there is no cursor (phys_cursor_x < 0), then this means nothing.) */
- enum text_cursor_kinds current_cursor;
-
- /* What kind of text cursor should we draw in the future?
- This should always be filled_box_cursor or bar_cursor. */
- enum text_cursor_kinds desired_cursor;
-
- /* Width of bar cursor (if we are using that). */
- int cursor_width;
-
/* These are the current window manager hints. It seems that
XSetWMHints, when presented with an unset bit in the `flags'
member of the hints structure, does not leave the corresponding
to the mask as we go. */
XWMHints wm_hints;
- /* The size of the extra width currently allotted for vertical
- scroll bars, in pixels. */
- int vertical_scroll_bar_extra;
-
- /* The extra width currently allotted for the areas in which
- truncation marks, continuation marks, and overlay arrows are
- displayed. */
- int left_fringe_width, right_fringe_width;
- int fringe_cols, fringes_extra;
-
- /* This is the gravity value for the specified window position. */
- int win_gravity;
-
- /* The geometry flags for this window. */
- int size_hint_flags;
-
/* This is the Emacs structure for the X display this frame is on. */
struct x_display_info *display_info;
zero, tell Xt not to wait. */
int wait_for_wm;
- /* See enum below */
- int want_fullscreen;
-
- /* This many pixels are the difference between the outer window (i.e. the
- left of the window manager decoration) and FRAME_X_WINDOW. */
- int x_pixels_diff;
-
- /* This many pixels are the difference between the outer window (i.e. the
- top of the window manager titlebar) and FRAME_X_WINDOW. */
- int y_pixels_diff;
-
/* As x_pixels_diff, but to FRAME_OUTER_WINDOW. For some reason the
two might differ by a pixel, depending on WM */
int x_pixels_outer_diff;
-
+
/* As y_pixels_diff, but to FRAME_OUTER_WINDOW. In the toolkit version,
these may differ because this does not take into account possible
menubar. y_pixels_diff is with menubar height included */
int y_pixels_outer_diff;
+
+ /* Keep track of focus. May be EXPLICIT if we received a FocusIn for this
+ frame, or IMPLICIT if we received an EnterNotify.
+ FocusOut and LeaveNotify clears EXPLICIT/IMPLICIT. */
+ int focus_state;
};
+#define No_Cursor (None)
+
enum
{
- /* Values used as a bit mask, BOTH == WIDTH | HEIGHT. */
- FULLSCREEN_NONE = 0,
- FULLSCREEN_WIDTH = 1,
- FULLSCREEN_HEIGHT = 2,
- FULLSCREEN_BOTH = 3,
- FULLSCREEN_WAIT = 4,
- FULLSCREEN_MOVE_WAIT = 8,
+ /* Values for focus_state, used as bit mask.
+ EXPLICIT means we received a FocusIn for the frame and know it has
+ the focus. IMPLICIT means we recevied an EnterNotify and the frame
+ may have the focus if no window manager is running.
+ FocusOut and LeaveNotify clears EXPLICIT/IMPLICIT. */
+ FOCUS_NONE = 0,
+ FOCUS_IMPLICIT = 1,
+ FOCUS_EXPLICIT = 2
};
+
+/* Return the X output data for frame F. */
+#define FRAME_X_OUTPUT(f) ((f)->output_data.x)
+
/* Return the X window used for displaying data in frame F. */
#define FRAME_X_WINDOW(f) ((f)->output_data.x->window_desc)
XtWindow ((f)->output_data.x->widget) : \
FRAME_X_WINDOW (f))
#else
+#ifdef USE_GTK
+#define GTK_WIDGET_TO_X_WIN(w) \
+ ((w) && (w)->window ? GDK_WINDOW_XWINDOW ((w)->window) : 0)
+
+#define FRAME_GTK_OUTER_WIDGET(f) ((f)->output_data.x->widget)
+#define FRAME_GTK_WIDGET(f) ((f)->output_data.x->edit_widget)
+#define FRAME_OUTER_WINDOW(f) \
+ (FRAME_GTK_OUTER_WIDGET (f) ? \
+ GTK_WIDGET_TO_X_WIN (FRAME_GTK_OUTER_WIDGET (f)) : \
+ FRAME_X_WINDOW (f))
+
+#else /* !USE_GTK */
#define FRAME_OUTER_WINDOW(f) (FRAME_X_WINDOW (f))
+#endif /* !USE_GTK */
#endif
+
#define FRAME_FONT(f) ((f)->output_data.x->font)
#define FRAME_FONTSET(f) ((f)->output_data.x->fontset)
-#define FRAME_INTERNAL_BORDER_WIDTH(f) ((f)->output_data.x->internal_border_width)
#define FRAME_MENUBAR_HEIGHT(f) ((f)->output_data.x->menubar_height)
-#define FRAME_LINE_HEIGHT(f) ((f)->output_data.x->line_height)
-
-/* Width of the default font of frame F. Must be defined by each
- terminal specific header. */
-#define FRAME_DEFAULT_FONT_WIDTH(F) FONT_WIDTH (FRAME_FONT (F))
+#define FRAME_TOOLBAR_HEIGHT(f) ((f)->output_data.x->toolbar_height)
+#define FRAME_BASELINE_OFFSET(f) ((f)->output_data.x->baseline_offset)
/* 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)
/* This is the 'font_info *' which frame F has. */
#define FRAME_X_FONT_TABLE(f) (FRAME_X_DISPLAY_INFO (f)->font_table)
-/* These two really ought to be called FRAME_PIXEL_{WIDTH,HEIGHT}. */
-#define PIXEL_WIDTH(f) ((f)->output_data.x->pixel_width)
-#define PIXEL_HEIGHT(f) ((f)->output_data.x->pixel_height)
+/* The difference in pixels between the top left corner of the
+ Emacs window (including possible window manager decorations)
+ and FRAME_X_WINDOW (f). */
+#define FRAME_OUTER_TO_INNER_DIFF_X(f) \
+ ((f)->output_data.x->x_pixels_outer_diff)
+#define FRAME_OUTER_TO_INNER_DIFF_Y(f) \
+ ((f)->output_data.x->y_pixels_outer_diff \
+ + FRAME_MENUBAR_HEIGHT (f) + FRAME_TOOLBAR_HEIGHT (f))
-#define FRAME_DESIRED_CURSOR(f) ((f)->output_data.x->desired_cursor)
#define FRAME_XIC(f) ((f)->output_data.x->xic)
#define FRAME_X_XIM(f) (FRAME_X_DISPLAY_INFO (f)->xim)
#define FRAME_X_IMAGE_CACHE(F) FRAME_X_DISPLAY_INFO ((F))->image_cache
-\f
-/* 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
- sizes aren't pixel values. If it weren't the case, we wouldn't be
- able to split windows horizontally nicely. */
-
-#define FRAME_X_FRINGE_COLS(F) ((F)->output_data.x->fringe_cols)
-
-/* Total width of fringes in pixels. */
-
-#define FRAME_X_FRINGE_WIDTH(F) ((F)->output_data.x->fringes_extra)
-
-/* Pixel-width of the left and right fringe. */
-
-#define FRAME_X_LEFT_FRINGE_WIDTH(F) ((F)->output_data.x->left_fringe_width)
-#define FRAME_X_RIGHT_FRINGE_WIDTH(F) ((F)->output_data.x->right_fringe_width)
-
-
\f
/* X-specific scroll bar stuff. */
/* Return the length of the rectangle within which the top of the
handle must stay. This isn't equivalent to the inside height,
- because the scroll bar handle has a minimum height.
+ because the scroll bar handle has a minimum height.
This is the real range of motion for the scroll bar, so when we're
scaling buffer positions to scroll bar positions, we use this, not
#define VERTICAL_SCROLL_BAR_WIDTH_TRIM (0)
\f
-/* Manipulating pixel sizes and character sizes.
- Knowledge of which factors affect the overall size of the window should
- be hidden in these macros, if that's possible.
-
- Return the upper/left pixel position of the character cell on frame F
- at ROW/COL. */
-#define CHAR_TO_PIXEL_ROW(f, row) \
- ((f)->output_data.x->internal_border_width \
- + (row) * (f)->output_data.x->line_height)
-#define CHAR_TO_PIXEL_COL(f, col) \
- ((f)->output_data.x->internal_border_width \
- + (col) * FONT_WIDTH ((f)->output_data.x->font))
-
-/* Return the pixel width/height of frame F if it has
- WIDTH columns/HEIGHT rows. */
-#define CHAR_TO_PIXEL_WIDTH(f, width) \
- (CHAR_TO_PIXEL_COL (f, width) \
- + (f)->output_data.x->vertical_scroll_bar_extra \
- + (f)->output_data.x->fringes_extra \
- + (f)->output_data.x->internal_border_width)
-#define CHAR_TO_PIXEL_HEIGHT(f, height) \
- (CHAR_TO_PIXEL_ROW (f, height) \
- + (f)->output_data.x->internal_border_width)
-
-
-/* Return the row/column (zero-based) of the character cell containing
- the pixel on FRAME at ROW/COL. */
-#define PIXEL_TO_CHAR_ROW(f, row) \
- (((row) - (f)->output_data.x->internal_border_width) \
- / (f)->output_data.x->line_height)
-#define PIXEL_TO_CHAR_COL(f, col) \
- (((col) - (f)->output_data.x->internal_border_width) \
- / FONT_WIDTH ((f)->output_data.x->font))
-
-/* How many columns/rows of text can we fit in WIDTH/HEIGHT pixels on
- frame F? */
-#define PIXEL_TO_CHAR_WIDTH(f, width) \
- (PIXEL_TO_CHAR_COL (f, ((width) \
- - (f)->output_data.x->internal_border_width \
- - (f)->output_data.x->fringes_extra \
- - (f)->output_data.x->vertical_scroll_bar_extra)))
-#define PIXEL_TO_CHAR_HEIGHT(f, height) \
- (PIXEL_TO_CHAR_ROW (f, ((height) \
- - (f)->output_data.x->internal_border_width)))
-
-\f
-/* If a struct input_event has a kind which is selection_request_event
- or selection_clear_event, then its contents are really described
+/* If a struct input_event has a kind which is SELECTION_REQUEST_EVENT
+ or SELECTION_CLEAR_EVENT, then its contents are really described
by this structure. */
-/* For an event of kind selection_request_event,
+/* For an event of kind SELECTION_REQUEST_EVENT,
this structure really describes the contents.
**Don't make this struct longer!**
If it overlaps the frame_or_window field of struct input_event,
/* From xrdb.c. */
-char *x_get_string_resource P_ ((XrmDatabase, char *, char *));
char *x_get_customization_string P_ ((XrmDatabase, char *, char *));
XrmDatabase x_load_resources P_ ((Display *, char *, char *, char *));
int x_get_resource P_ ((XrmDatabase, char *, char *,
void x_make_frame_visible P_ ((struct frame *));
void x_iconify_frame P_ ((struct frame *));
void x_wm_set_size_hint P_ ((struct frame *, long, int));
-void x_set_offset P_ ((struct frame *, int, int, int));
-void x_wm_set_icon_position P_ ((struct frame *, int, int));
int x_catch_errors P_ ((Display *));
int x_had_errors_p P_ ((Display *));
void x_uncatch_errors P_ ((Display *, int));
void x_wm_set_window_state P_ ((struct frame *, int));
int x_alloc_nearest_color P_ ((struct frame *, Colormap, XColor *));
-extern void pixel_to_glyph_coords P_ ((struct frame *, int, int,
- int *, int *, XRectangle *, int));
-
/* Defined in xterm.c */
extern void cancel_mouse_face P_ ((struct frame *));
extern void x_scroll_bar_clear P_ ((struct frame *));
extern void x_start_queuing_selection_requests P_ ((Display *));
extern void x_stop_queuing_selection_requests P_ ((Display *));
-extern void x_update_cursor P_ ((struct frame *, int));
extern int x_text_icon P_ ((struct frame *, char *));
extern int x_bitmap_icon P_ ((struct frame *, Lisp_Object));
extern int x_catch_errors P_ ((Display *));
extern void x_check_errors P_ ((Display *, char *));
extern int x_had_errors_p P_ ((Display *));
extern void x_uncatch_errors P_ ((Display *, int));
-extern Lisp_Object x_new_font P_ ((struct frame *, char *));
-extern Lisp_Object x_new_fontset P_ ((struct frame *, Lisp_Object));
-extern void x_compute_fringe_widths P_ ((struct frame *, int));
-extern void x_set_offset P_ ((struct frame *, int, int, int));
extern void x_set_window_size P_ ((struct frame *, int, int, int));
extern void x_set_mouse_position P_ ((struct frame *, int, int));
extern void x_set_mouse_pixel_position P_ ((struct frame *, int, int));
extern void x_wm_set_size_hint P_ ((struct frame *, long, int));
extern void x_wm_set_window_state P_ ((struct frame *, int));
extern void x_wm_set_icon_pixmap P_ ((struct frame *, int));
-extern void x_wm_set_icon_position P_ ((struct frame *, int, int));
extern void x_delete_display P_ ((struct x_display_info *));
extern void x_initialize P_ ((void));
-extern void x_display_cursor P_ ((struct window *, int, int, int, int, int));
extern unsigned long x_copy_color P_ ((struct frame *, unsigned long));
#ifdef USE_X_TOOLKIT
extern XtAppContext Xt_app_con;
extern void x_query_color P_ ((struct frame *f, XColor *));
extern void x_clear_area P_ ((Display *, Window, int, int, int, int, int));
-extern void x_fullscreen_adjust P_ ((struct frame *f, int *, int *,
- int *, int *));
-
+extern int x_dispatch_event P_ ((XEvent *, Display *));
/* Defined in xselect.c */
unsigned int, unsigned int));
extern int x_create_bitmap_from_file P_ ((struct frame *, Lisp_Object));
extern void x_destroy_bitmap P_ ((struct frame *, int));
-extern void x_set_frame_parameters P_ ((struct frame *, Lisp_Object));
+extern int x_create_bitmap_mask P_ ((struct frame * , int));
+
+#ifdef USE_GTK
+extern int xg_set_icon P_ ((struct frame *, Lisp_Object));
+#endif /* USE_GTK */
+
extern void x_real_positions P_ ((struct frame *, int *, int *));
-extern void x_report_frame_params P_ ((struct frame *, Lisp_Object *));
extern int defined_color P_ ((struct frame *, char *, XColor *, int));
extern void x_set_border_pixel P_ ((struct frame *, int));
extern void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
extern int x_char_height P_ ((struct frame *));
extern int x_screen_planes P_ ((struct frame *));
extern void x_sync P_ ((struct frame *));
-extern enum text_cursor_kinds x_specified_cursor_type P_ ((Lisp_Object, int *));
extern int x_defined_color P_ ((struct frame *, char *, XColor *, int));
#ifdef HAVE_X_I18N
extern void free_frame_xic P_ ((struct frame *));
/* Defined in xfaces.c */
-extern int frame_update_line_height P_ ((struct frame *));
extern int compute_glyph_face P_ ((struct frame *, int, int));
extern int compute_glyph_face_1 P_ ((struct frame *, Lisp_Object, int));
extern void x_free_dpy_colors P_ ((Display *, Screen *, Colormap,
#ifdef USE_X_TOOLKIT
extern void widget_store_internal_border P_ ((Widget));
#endif
+
+/* Defined in xsmfns.c */
+#ifdef HAVE_X_SM
+extern void x_session_initialize P_ ((void));
+extern int x_session_check_input P_ ((struct input_event *bufp,
+ int *numchars));
+extern int x_session_have_connection P_ ((void));
+#endif
+
+#define FONT_TYPE_FOR_UNIBYTE(font, ch) 0
+#define FONT_TYPE_FOR_MULTIBYTE(font, ch) 0
+
+#define STORE_XCHAR2B(chp, b1, b2) \
+ ((chp)->byte1 = (b1), (chp)->byte2 = (b2))
+
+#define XCHAR2B_BYTE1(chp) \
+ ((chp)->byte1)
+
+#define XCHAR2B_BYTE2(chp) \
+ ((chp)->byte2)
+
+
+#define STORE_NATIVE_RECT(nr,rx,ry,rwidth,rheight) \
+ ((nr).x = (rx), \
+ (nr).y = (ry), \
+ (nr).width = (rwidth), \
+ (nr).height = (rheight))