Mercurial > hg > xemacs-beta
changeset 165:5a88923fcbfe r20-3b9
Import from CVS: tag r20-3b9
line wrap: on
line diff
--- a/CHANGES-beta Mon Aug 13 09:43:39 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 09:44:42 2007 +0200 @@ -1,32 +1,45 @@ -*- indented-text -*- +to 20.3 beta9 "Sofia". +-- cc-mode-5.11 +-- custom-1.9937 +-- Mule Updates/Quail/Synch with Emacs/Mule zeta courtesy of MORIOKA Tomohiko +-- lazy-lock.el reverted to 1.14 as per Ben Wing's instructions. +-- ph.el-2.1 +-- W3-3.0.92 courtesy of William Perry +-- reftex.el-2.14 +-- Lots of Miscellaneous Hrvoje Niksic patches +-- view-process 2.4 -- Courtesy of Heiko Muenkel +-- time.el-1.17 +-- Miscellaneous bug fixes + to 20.3 beta8 "Copenhagen". -- Custom changes now saved in ~/.xemacs-custom and loaded automatically at - startup. + startup -- oobr support binaries moved from lisp hierarchy to new top level - directory `pkg-src'. + directory `pkg-src' -- Viper-2.94 Courtesy of Michael Kifer -- Customizations from Hrvoje Niksic -- FAQ update from Andreas Kaempf -- New graphic cbx.gif added to etc, courtesy of Jens Lautenbacher, `Created by XEmacs' suitable for adorning a web page. -- save-some-buffers now has an option to preview dirty buffers as - they are being offered for save. Courtesy of David Bakhash. --- XEmacs compiles in 64 bit SGI environment courtesy of Olivier Galibert. --- Hardcoded -I/usr/local/include, -L/usr/local/include removed. + they are being offered for save. Courtesy of David Bakhash +-- XEmacs compiles in 64 bit SGI environment courtesy of Olivier Galibert +-- Hardcoded -I/usr/local/include, -L/usr/local/include removed -- edmacro.el-3.16 -- mapvector is now a subr courtesy of Hrvoje Niksic -- new function archive-quit in arc-mode.el courtesy of Karl Hegbloom -- debug-on-error (round 2) courtesy of Hrvoje Niksic -- Gnus-5.4.59 -- Build no longer depends on a list of .elc files listed in src/Makefile.in.in - (only important to developers). + (only important to developers) -- If a .xemacs file exists, use it in preference to .emacs. If no .xemacs - use .emacs as usual. The file loaded is left in `user-init-file'. --- Overhaul of XEmacs startup code, Part II. + use .emacs as usual. The file loaded is left in `user-init-file' +-- Overhaul of XEmacs startup code, Part II -- custom-1.9931 -- Miscellaneous Ebola fixes --- New internal autoload generating function `batch-update-directory'. --- New file hippie-exp.el from Emacs/Mule zeta. +-- New internal autoload generating function `batch-update-directory' +-- New file hippie-exp.el from Emacs/Mule zeta -- Miscellaneous bug fixes to 20.3 beta7 "Oslo".
--- a/ChangeLog Mon Aug 13 09:43:39 2007 +0200 +++ b/ChangeLog Mon Aug 13 09:44:42 2007 +0200 @@ -1,5 +1,102 @@ +1997-06-25 Steven L Baur <steve@altair.xemacs.org> + + * XEmacs 20.3-beta9 is released. + + * Makefile.in (dist): Make `make dist' work for me. + +1997-06-25 Martin Buchholz <mrb@eng.sun.com> + + * configure.in: + - Change "t" to tabs in sed commands + - Add /g to sed substitition commands when appropriate + - Change XtVa[SG]etValue to Xt[SG]etValue + - Make version variables into Lisp_Objects. + +1997-06-19 Martin Buchholz <mrb@eng.sun.com> + + * src/config.h.in: + * configure.in: + - Autodetect X defines using xmkmf. + - Compute rpath on *bsd* systems as well. + - rewrite PRINT_VAR m4 macro. + - detect sizes of void* and long long for future use by unex*.c + * regex.c: _GNU_SOURCE may be defined by config.h; don't redefine. + +1997-06-24 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * lisp/language/arabic.el: moved from lisp/mule/arabic-hooks.el. + + * lisp/mh-e/mh-e.el (mh-get-new-mail): Decode output as + `mh-folder-coding-system'. + +1997-06-24 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * lisp/language/ethio-util.el: imported from + Emacs/mule-19.34.94-zeta. + + * lisp/language/arabic-util.el: moved from lisp/mule/arabic.el; + repair Arabic characters. + +1997-06-24 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * lib-src/update-autoloads.sh: Search lisp/mule/. + + * etc/HELLO: final byte for ethiopic was changed to sync with + Emacs/mule-19.34.94-zeta. + + * lisp/x11/x-menubar.el: Fix "Describe language support" and "Set + language environment" of Mule menu. + + * lisp/language/visual-mode.el: moved from mule/. + + * lisp/language/ethiopic.el: Modify for XEmacs. + + * lisp/language/cyrillic.el: Modify DOC-string of koi8-r; Fixed + problem of setting for `language-info-alist' about koi8-r. + + * lisp/mule/auto-autoloads.el: Enable auto-autoloads.el for mule/. + + * lisp/mule/mule-util.el: New file (imported from + Emacs/mule-19.34.94-zeta). + + * lisp/mule/mule-misc.el: Function `truncate-string-to-width' was + moved to mule-util.el. + + * lisp/prim/dumped-lisp.el, lisp/mule/mule-load.el: + lisp/mule/arabic-hooks.el was moved to lisp/language/arabic.el; + lisp/mule/arabic.el was moved to lisp/language/arabic-util.el; Use + lisp/language/ethiopic.el instead of lisp/mule/ethiopic-hooks.el; + Use lisp/language/ethio-util.el instead of lisp/mule/ethiopic.el. + + * lisp/mule/mule-coding.el (coding-system-docstring): New alias to + emulate Emacs/mule-19.34.94-zeta function. + + * lisp/mule/mule-cmds.el: modified to sync with + Emacs/mule-19.34.94-zeta (mule-prefix was changed to "C-x C-m") + + (set-language-info): Add to "Describe Language Support" and "Set + Language Environment" menu. + + * lisp/mule/mule-charset.el: Function `compose-region' and + `decompose-region' were moved to mule-util.el. + + * lisp/leim/quail.el: modify to sync with latest quail.el of + Emacs/mule in ETL. + + (quail-toggle-mode-temporarily): check `quail-conv-overlay'. + + (quail-map-p): Use `characterp' instead of `integerp'. + +1997-06-23 Steven L Baur <steve@altair.xemacs.org> + + * etc/NEWS (Commands): Various updates by Hrvoje Niksic. + 1997-06-21 Steven L Baur <steve@altair.xemacs.org> + * Makefile.in: Missing FRC.info. + (install-arch-dep): Add missing backslash. + From Glynn Clements <glynn@sensei.co.uk> + * XEmacs 20.3-beta8 is released. 1997-06-20 Olivier Galibert <Olivier.Galibert@mines.u-nancy.fr>
--- a/Makefile.in Mon Aug 13 09:43:39 2007 +0200 +++ b/Makefile.in Mon Aug 13 09:44:42 2007 +0200 @@ -228,6 +228,11 @@ ## Convenience target for XEmacs beta testers beta: clean all-elc +## Convenience target for XEmacs maintainers +## This would run `make-xemacsdist' if I were really confident that everything +## was turnkey. +dist: all-elc info + ## Build XEmacs and recompile out-of-date and missing .elc files along ## the way. all-elc all-elcs: lib-src lwlib dump-elcs src @@ -361,7 +366,7 @@ then \ ${INSTALL_DATA} lib-src/DOC ${archlibdir}/DOC ; \ for subdir in `find ${archlibdir} -type d ! -name RCS ! -name SCCS ! -name CVS -print` ; do \ - (cd $${subdir} && $(RM) -r RCS CVS SCCS \#* *~) ; + (cd $${subdir} && $(RM) -r RCS CVS SCCS \#* *~) ; \ done ; \ else true; fi ${INSTALL_PROGRAM} src/xemacs ${bindir}/xemacs-${version} @@ -455,7 +460,7 @@ ## Some makes seem to remember that they've built something called FRC, ## so you can only use a given FRC once per makefile. -FRC FRC.src.paths.h FRC.mkdir FRC.dump-elcs: +FRC FRC.src.paths.h FRC.mkdir FRC.dump-elcs FRC.info: FRC.mostlyclean FRC.clean FRC.distclean FRC.realclean FRC.tags: ## ==================== Cleaning up and miscellanea ==================== @@ -575,8 +580,9 @@ check: @echo "We don't have any automated tests for XEmacs yet." -dist: - cd ${srcdir} && make-dist +## Is this something Chuck used and doesn't work with CVS? -slb +## dist: +## cd ${srcdir} && make-dist info: FRC.info cd ${srcdir}/man && $(MAKE) $(MFLAGS) $@
--- a/configure Mon Aug 13 09:43:39 2007 +0200 +++ b/configure Mon Aug 13 09:44:42 2007 +0200 @@ -2124,8 +2124,7 @@ ' > $tempcname CPP=`eval "echo $CPP"` eval `$CPP -Isrc $tempcname \ - | sed -n -e "s/[ \t]*=[ \t\"]*/='/" -e "s/[ \t\"]*\$/'/" -e "s/^configure___//p"` - + | sed -n -e "s/[ ]*=[ \"]*/='/" -e "s/[ \"]*\$/'/" -e "s/^configure___//p"` rm $tempcname @@ -2188,7 +2187,7 @@ fi echo $ac_n "checking for dynodump""... $ac_c" 1>&6 -echo "configure:2192: checking for dynodump" >&5 +echo "configure:2191: checking for dynodump" >&5 if test "$unexec" != "unexsol2.o"; then echo "$ac_t""no" 1>&6 else @@ -2244,7 +2243,7 @@ done if test -n "$site_runtime_libraries" ; then - LD_RUN_PATH="`echo $site_runtime_libraries | sed 's/ */:/'`" + LD_RUN_PATH="`echo $site_runtime_libraries | sed -e 's/ */:/g'`" export LD_RUN_PATH fi @@ -2259,19 +2258,19 @@ if test "$add_runtime_path" = "yes"; then echo $ac_n "checking "for runtime libraries flag"""... $ac_c" 1>&6 -echo "configure:2263: checking "for runtime libraries flag"" >&5 +echo "configure:2262: checking "for runtime libraries flag"" >&5 dash_r="" for try_dash_r in "-R" "-R " "-rpath "; do xe_check_libs="${try_dash_r}/no/such/file-or-directory" cat > conftest.$ac_ext <<EOF -#line 2268 "configure" +#line 2267 "configure" #include "confdefs.h" int main() { ; return 0; } EOF -if { (eval echo configure:2275: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2274: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* dash_r="$try_dash_r" else @@ -2302,8 +2301,8 @@ if test "$add_runtime_path" = "yes" -a -n "$dash_r"; then - ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//"` - ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//"` + ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"` + ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"` runpath="" runpath_dirs="" if test -n "$LD_RUN_PATH"; then @@ -2365,7 +2364,7 @@ # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2369: checking for $ac_word" >&5 +echo "configure:2368: checking for $ac_word" >&5 if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. @@ -2418,7 +2417,7 @@ # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # ./install, which can be erroneously created by make from ./install.sh. echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 -echo "configure:2422: checking for a BSD compatible install" >&5 +echo "configure:2421: checking for a BSD compatible install" >&5 if test -z "$INSTALL"; then IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS="${IFS}:" @@ -2469,7 +2468,7 @@ # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2473: checking for $ac_word" >&5 +echo "configure:2472: checking for $ac_word" >&5 if test -n "$YACC"; then ac_cv_prog_YACC="$YACC" # Let the user override the test. @@ -2500,15 +2499,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2504: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2507 "configure" +echo "configure:2503: checking for $ac_hdr" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2506 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2512: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2511: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2541,15 +2540,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2545: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2548 "configure" +echo "configure:2544: checking for $ac_hdr" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2547 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2553: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2552: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2582,15 +2581,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2586: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2589 "configure" +echo "configure:2585: checking for $ac_hdr" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2588 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2594: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2593: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2620,10 +2619,10 @@ done echo $ac_n "checking for sys/wait.h that is POSIX.1 compatible""... $ac_c" 1>&6 -echo "configure:2624: checking for sys/wait.h that is POSIX.1 compatible" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2627 "configure" +echo "configure:2623: checking for sys/wait.h that is POSIX.1 compatible" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2626 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/wait.h> @@ -2639,7 +2638,7 @@ s = WIFEXITED (s) ? WEXITSTATUS (s) : 1; ; return 0; } EOF -if { (eval echo configure:2643: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2642: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_sys_wait_h=yes else @@ -2663,10 +2662,10 @@ fi echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 -echo "configure:2667: checking for ANSI C header files" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2670 "configure" +echo "configure:2666: checking for ANSI C header files" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2669 "configure" #include "confdefs.h" #include <stdlib.h> #include <stdarg.h> @@ -2674,7 +2673,7 @@ #include <float.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2678: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2677: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2691,7 +2690,7 @@ if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext <<EOF -#line 2695 "configure" +#line 2694 "configure" #include "confdefs.h" #include <string.h> EOF @@ -2709,7 +2708,7 @@ if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext <<EOF -#line 2713 "configure" +#line 2712 "configure" #include "confdefs.h" #include <stdlib.h> EOF @@ -2727,7 +2726,7 @@ if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. cat > conftest.$ac_ext <<EOF -#line 2731 "configure" +#line 2730 "configure" #include "confdefs.h" #include <ctype.h> #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') @@ -2738,7 +2737,7 @@ exit (0); } EOF -if { (eval echo configure:2742: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:2741: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then : else @@ -2763,10 +2762,10 @@ fi echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6 -echo "configure:2767: checking whether time.h and sys/time.h may both be included" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2770 "configure" +echo "configure:2766: checking whether time.h and sys/time.h may both be included" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2769 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/time.h> @@ -2775,7 +2774,7 @@ struct tm *tp; ; return 0; } EOF -if { (eval echo configure:2779: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2778: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_time=yes else @@ -2799,10 +2798,10 @@ fi echo $ac_n "checking for sys_siglist declaration in signal.h or unistd.h""... $ac_c" 1>&6 -echo "configure:2803: checking for sys_siglist declaration in signal.h or unistd.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2806 "configure" +echo "configure:2802: checking for sys_siglist declaration in signal.h or unistd.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2805 "configure" #include "confdefs.h" #include <sys/types.h> #include <signal.h> @@ -2814,7 +2813,7 @@ char *msg = *(sys_siglist + 1); ; return 0; } EOF -if { (eval echo configure:2818: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2817: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_decl_sys_siglist=yes else @@ -2839,9 +2838,9 @@ echo $ac_n "checking for struct utimbuf""... $ac_c" 1>&6 -echo "configure:2843: checking for struct utimbuf" >&5 -cat > conftest.$ac_ext <<EOF -#line 2845 "configure" +echo "configure:2842: checking for struct utimbuf" >&5 +cat > conftest.$ac_ext <<EOF +#line 2844 "configure" #include "confdefs.h" #ifdef TIME_WITH_SYS_TIME #include <sys/time.h> @@ -2860,7 +2859,7 @@ static struct utimbuf x; x.actime = x.modtime; ; return 0; } EOF -if { (eval echo configure:2864: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2863: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 { test "$extra_verbose" = "yes" && cat << \EOF @@ -2880,10 +2879,10 @@ rm -f conftest* echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 -echo "configure:2884: checking return type of signal handlers" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2887 "configure" +echo "configure:2883: checking return type of signal handlers" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2886 "configure" #include "confdefs.h" #include <sys/types.h> #include <signal.h> @@ -2900,7 +2899,7 @@ int i; ; return 0; } EOF -if { (eval echo configure:2904: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2903: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_type_signal=void else @@ -2922,10 +2921,10 @@ echo $ac_n "checking for size_t""... $ac_c" 1>&6 -echo "configure:2926: checking for size_t" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2929 "configure" +echo "configure:2925: checking for size_t" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2928 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -2956,10 +2955,10 @@ fi echo $ac_n "checking for pid_t""... $ac_c" 1>&6 -echo "configure:2960: checking for pid_t" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2963 "configure" +echo "configure:2959: checking for pid_t" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2962 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -2990,10 +2989,10 @@ fi echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6 -echo "configure:2994: checking for uid_t in sys/types.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 2997 "configure" +echo "configure:2993: checking for uid_t in sys/types.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 2996 "configure" #include "confdefs.h" #include <sys/types.h> EOF @@ -3029,10 +3028,10 @@ fi echo $ac_n "checking for mode_t""... $ac_c" 1>&6 -echo "configure:3033: checking for mode_t" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3036 "configure" +echo "configure:3032: checking for mode_t" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3035 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -3063,10 +3062,10 @@ fi echo $ac_n "checking for off_t""... $ac_c" 1>&6 -echo "configure:3067: checking for off_t" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3070 "configure" +echo "configure:3066: checking for off_t" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3069 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -3098,9 +3097,9 @@ echo $ac_n "checking for struct timeval""... $ac_c" 1>&6 -echo "configure:3102: checking for struct timeval" >&5 -cat > conftest.$ac_ext <<EOF -#line 3104 "configure" +echo "configure:3101: checking for struct timeval" >&5 +cat > conftest.$ac_ext <<EOF +#line 3103 "configure" #include "confdefs.h" #ifdef TIME_WITH_SYS_TIME #include <sys/time.h> @@ -3116,7 +3115,7 @@ static struct timeval x; x.tv_sec = x.tv_usec; ; return 0; } EOF -if { (eval echo configure:3120: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3119: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 HAVE_TIMEVAL=yes @@ -3138,10 +3137,10 @@ rm -f conftest* echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6 -echo "configure:3142: checking whether struct tm is in sys/time.h or time.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3145 "configure" +echo "configure:3141: checking whether struct tm is in sys/time.h or time.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3144 "configure" #include "confdefs.h" #include <sys/types.h> #include <time.h> @@ -3149,7 +3148,7 @@ struct tm *tp; tp->tm_sec; ; return 0; } EOF -if { (eval echo configure:3153: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3152: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm=time.h else @@ -3173,10 +3172,10 @@ fi echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6 -echo "configure:3177: checking for tm_zone in struct tm" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3180 "configure" +echo "configure:3176: checking for tm_zone in struct tm" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3179 "configure" #include "confdefs.h" #include <sys/types.h> #include <$ac_cv_struct_tm> @@ -3184,7 +3183,7 @@ struct tm tm; tm.tm_zone; ; return 0; } EOF -if { (eval echo configure:3188: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3187: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm_zone=yes else @@ -3207,10 +3206,10 @@ else echo $ac_n "checking for tzname""... $ac_c" 1>&6 -echo "configure:3211: checking for tzname" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3214 "configure" +echo "configure:3210: checking for tzname" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3213 "configure" #include "confdefs.h" #include <time.h> #ifndef tzname /* For SGI. */ @@ -3220,7 +3219,7 @@ atoi(*tzname); ; return 0; } EOF -if { (eval echo configure:3224: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3223: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_cv_var_tzname=yes else @@ -3246,10 +3245,10 @@ echo $ac_n "checking for working const""... $ac_c" 1>&6 -echo "configure:3250: checking for working const" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3253 "configure" +echo "configure:3249: checking for working const" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3252 "configure" #include "confdefs.h" int main() { @@ -3298,7 +3297,7 @@ ; return 0; } EOF -if { (eval echo configure:3302: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3301: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes else @@ -3323,7 +3322,7 @@ echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 -echo "configure:3327: checking whether ${MAKE-make} sets \${MAKE}" >&5 +echo "configure:3326: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` cat > conftestmake <<\EOF @@ -3348,12 +3347,12 @@ echo $ac_n "checking whether byte ordering is bigendian""... $ac_c" 1>&6 -echo "configure:3352: checking whether byte ordering is bigendian" >&5 +echo "configure:3351: checking whether byte ordering is bigendian" >&5 ac_cv_c_bigendian=unknown # See if sys/param.h defines the BYTE_ORDER macro. cat > conftest.$ac_ext <<EOF -#line 3357 "configure" +#line 3356 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/param.h> @@ -3364,11 +3363,11 @@ #endif ; return 0; } EOF -if { (eval echo configure:3368: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3367: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* # It does; now see whether it defined to BIG_ENDIAN or not. cat > conftest.$ac_ext <<EOF -#line 3372 "configure" +#line 3371 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/param.h> @@ -3379,7 +3378,7 @@ #endif ; return 0; } EOF -if { (eval echo configure:3383: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3382: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_bigendian=yes else @@ -3396,7 +3395,7 @@ rm -f conftest* if test $ac_cv_c_bigendian = unknown; then cat > conftest.$ac_ext <<EOF -#line 3400 "configure" +#line 3399 "configure" #include "confdefs.h" main () { /* Are we little or big endian? From Harbison&Steele. */ @@ -3409,7 +3408,7 @@ exit (u.c[sizeof (long) - 1] == 1); } EOF -if { (eval echo configure:3413: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3412: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_c_bigendian=no else @@ -3435,10 +3434,10 @@ echo $ac_n "checking size of short""... $ac_c" 1>&6 -echo "configure:3439: checking size of short" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3442 "configure" +echo "configure:3438: checking size of short" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3441 "configure" #include "confdefs.h" #include <stdio.h> main() @@ -3449,7 +3448,7 @@ exit(0); } EOF -if { (eval echo configure:3453: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3452: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_short=`cat conftestval` else @@ -3476,10 +3475,10 @@ exit 1 fi echo $ac_n "checking size of int""... $ac_c" 1>&6 -echo "configure:3480: checking size of int" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3483 "configure" +echo "configure:3479: checking size of int" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3482 "configure" #include "confdefs.h" #include <stdio.h> main() @@ -3490,7 +3489,7 @@ exit(0); } EOF -if { (eval echo configure:3494: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3493: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_int=`cat conftestval` else @@ -3511,10 +3510,10 @@ echo $ac_n "checking size of long""... $ac_c" 1>&6 -echo "configure:3515: checking size of long" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3518 "configure" +echo "configure:3514: checking size of long" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3517 "configure" #include "confdefs.h" #include <stdio.h> main() @@ -3525,7 +3524,7 @@ exit(0); } EOF -if { (eval echo configure:3529: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3528: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_long=`cat conftestval` else @@ -3546,10 +3545,10 @@ echo $ac_n "checking size of long long""... $ac_c" 1>&6 -echo "configure:3550: checking size of long long" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3553 "configure" +echo "configure:3549: checking size of long long" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3552 "configure" #include "confdefs.h" #include <stdio.h> main() @@ -3560,7 +3559,7 @@ exit(0); } EOF -if { (eval echo configure:3564: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3563: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_long_long=`cat conftestval` else @@ -3581,10 +3580,10 @@ echo $ac_n "checking size of void *""... $ac_c" 1>&6 -echo "configure:3585: checking size of void *" >&5 - -cat > conftest.$ac_ext <<EOF -#line 3588 "configure" +echo "configure:3584: checking size of void *" >&5 + +cat > conftest.$ac_ext <<EOF +#line 3587 "configure" #include "confdefs.h" #include <stdio.h> main() @@ -3595,7 +3594,7 @@ exit(0); } EOF -if { (eval echo configure:3599: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3598: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_void_p=`cat conftestval` else @@ -3617,7 +3616,7 @@ echo $ac_n "checking for long file names""... $ac_c" 1>&6 -echo "configure:3621: checking for long file names" >&5 +echo "configure:3620: checking for long file names" >&5 ac_cv_sys_long_file_names=yes # Test for long file names in all the places we know might matter: @@ -3664,12 +3663,12 @@ echo $ac_n "checking for sqrt in -lm""... $ac_c" 1>&6 -echo "configure:3668: checking for sqrt in -lm" >&5 +echo "configure:3667: checking for sqrt in -lm" >&5 ac_lib_var=`echo m'_'sqrt | sed 'y%./+-%__p_%'` xe_check_libs=" -lm " cat > conftest.$ac_ext <<EOF -#line 3673 "configure" +#line 3672 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -3680,7 +3679,7 @@ sqrt() ; return 0; } EOF -if { (eval echo configure:3684: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3683: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3723,7 +3722,7 @@ echo "checking type of mail spool file locking" 1>&6 -echo "configure:3727: checking type of mail spool file locking" >&5 +echo "configure:3726: checking type of mail spool file locking" >&5 test -z "$mail_locking" -a "$mail_use_flock" = "yes" && mail_locking=flock test -z "$mail_locking" -a "$mail_use_lockf" = "yes" && mail_locking=lockf if test "$mail_locking" = "lockf"; then { test "$extra_verbose" = "yes" && cat << \EOF @@ -3747,12 +3746,12 @@ echo $ac_n "checking for kstat_open in -lkstat""... $ac_c" 1>&6 -echo "configure:3751: checking for kstat_open in -lkstat" >&5 +echo "configure:3750: checking for kstat_open in -lkstat" >&5 ac_lib_var=`echo kstat'_'kstat_open | sed 'y%./+-%__p_%'` xe_check_libs=" -lkstat " cat > conftest.$ac_ext <<EOF -#line 3756 "configure" +#line 3755 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -3763,7 +3762,7 @@ kstat_open() ; return 0; } EOF -if { (eval echo configure:3767: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3766: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3797,12 +3796,12 @@ echo $ac_n "checking for kvm_read in -lkvm""... $ac_c" 1>&6 -echo "configure:3801: checking for kvm_read in -lkvm" >&5 +echo "configure:3800: checking for kvm_read in -lkvm" >&5 ac_lib_var=`echo kvm'_'kvm_read | sed 'y%./+-%__p_%'` xe_check_libs=" -lkvm " cat > conftest.$ac_ext <<EOF -#line 3806 "configure" +#line 3805 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -3813,7 +3812,7 @@ kvm_read() ; return 0; } EOF -if { (eval echo configure:3817: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3816: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3847,12 +3846,12 @@ echo $ac_n "checking for cma_open in -lpthreads""... $ac_c" 1>&6 -echo "configure:3851: checking for cma_open in -lpthreads" >&5 +echo "configure:3850: checking for cma_open in -lpthreads" >&5 ac_lib_var=`echo pthreads'_'cma_open | sed 'y%./+-%__p_%'` xe_check_libs=" -lpthreads " cat > conftest.$ac_ext <<EOF -#line 3856 "configure" +#line 3855 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -3863,7 +3862,7 @@ cma_open() ; return 0; } EOF -if { (eval echo configure:3867: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3866: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3899,7 +3898,7 @@ fi echo $ac_n "checking whether the -xildoff compiler flag is required""... $ac_c" 1>&6 -echo "configure:3903: checking whether the -xildoff compiler flag is required" >&5 +echo "configure:3902: checking whether the -xildoff compiler flag is required" >&5 if ${CC-cc} '-###' -xildon no_such_file.c 2>&1 | grep '^[^ ]*/ild ' > /dev/null ; then if ${CC-cc} '-###' -xildoff no_such_file.c 2>&1 | grep '^[^ ]*/ild ' > /dev/null ; then echo "$ac_t""no" 1>&6; @@ -3908,9 +3907,9 @@ else echo "$ac_t""no" 1>&6 fi -if test "$opsys" = "sol2" -a "${OS_RELEASE:-0}" -ge 56; then +if test "$opsys" = "sol2" && test "$OS_RELEASE" -ge 56; then echo $ac_n "checking for \"-z ignore\" linker flag""... $ac_c" 1>&6 -echo "configure:3914: checking for \"-z ignore\" linker flag" >&5 +echo "configure:3913: checking for \"-z ignore\" linker flag" >&5 case "`ld -h 2>&1`" in *-z\ ignore\|record* ) echo "$ac_t""yes" 1>&6 ld_switch_site="-z ignore $ld_switch_site" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-z ignore\" to \$ld_switch_site"; fi ;; @@ -3920,7 +3919,7 @@ echo "checking "for specified window system"" 1>&6 -echo "configure:3924: checking "for specified window system"" >&5 +echo "configure:3923: checking "for specified window system"" >&5 if test "$x_includes $x_libraries" = "NONE NONE"; then if test -n "$OPENWINHOME" \ @@ -3941,7 +3940,7 @@ # Uses ac_ vars as temps to allow command line to override cache and checks. # --without-x overrides everything else, but does not touch the cache. echo $ac_n "checking for X""... $ac_c" 1>&6 -echo "configure:3945: checking for X" >&5 +echo "configure:3944: checking for X" >&5 # Check whether --with-x or --without-x was given. if test "${with_x+set}" = set; then @@ -4001,12 +4000,12 @@ # First, try using that file with no special directory specified. cat > conftest.$ac_ext <<EOF -#line 4005 "configure" +#line 4004 "configure" #include "confdefs.h" #include <$x_direct_test_include> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4010: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:4009: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -4075,14 +4074,14 @@ ac_save_LIBS="$LIBS" LIBS="-l$x_direct_test_library $LIBS" cat > conftest.$ac_ext <<EOF -#line 4079 "configure" +#line 4078 "configure" #include "confdefs.h" int main() { ${x_direct_test_function}() ; return 0; } EOF -if { (eval echo configure:4086: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4085: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* LIBS="$ac_save_LIBS" # We can link X programs with no special library path. @@ -4191,17 +4190,17 @@ case "`(uname -sr) 2>/dev/null`" in "SunOS 5"*) echo $ac_n "checking whether -R must be followed by a space""... $ac_c" 1>&6 -echo "configure:4195: checking whether -R must be followed by a space" >&5 +echo "configure:4194: checking whether -R must be followed by a space" >&5 ac_xsave_LIBS="$LIBS"; LIBS="$LIBS -R$x_libraries" cat > conftest.$ac_ext <<EOF -#line 4198 "configure" +#line 4197 "configure" #include "confdefs.h" int main() { ; return 0; } EOF -if { (eval echo configure:4205: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4204: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_R_nospace=yes else @@ -4217,14 +4216,14 @@ else LIBS="$ac_xsave_LIBS -R $x_libraries" cat > conftest.$ac_ext <<EOF -#line 4221 "configure" +#line 4220 "configure" #include "confdefs.h" int main() { ; return 0; } EOF -if { (eval echo configure:4228: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4227: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_R_space=yes else @@ -4260,12 +4259,12 @@ else echo $ac_n "checking for dnet_ntoa in -ldnet""... $ac_c" 1>&6 -echo "configure:4264: checking for dnet_ntoa in -ldnet" >&5 +echo "configure:4263: checking for dnet_ntoa in -ldnet" >&5 ac_lib_var=`echo dnet'_'dnet_ntoa | sed 'y%./+-%__p_%'` xe_check_libs=" -ldnet " cat > conftest.$ac_ext <<EOF -#line 4269 "configure" +#line 4268 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4276,7 +4275,7 @@ dnet_ntoa() ; return 0; } EOF -if { (eval echo configure:4280: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4279: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4300,12 +4299,12 @@ if test $ac_cv_lib_dnet_dnet_ntoa = no; then echo $ac_n "checking for dnet_ntoa in -ldnet_stub""... $ac_c" 1>&6 -echo "configure:4304: checking for dnet_ntoa in -ldnet_stub" >&5 +echo "configure:4303: checking for dnet_ntoa in -ldnet_stub" >&5 ac_lib_var=`echo dnet_stub'_'dnet_ntoa | sed 'y%./+-%__p_%'` xe_check_libs=" -ldnet_stub " cat > conftest.$ac_ext <<EOF -#line 4309 "configure" +#line 4308 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4316,7 +4315,7 @@ dnet_ntoa() ; return 0; } EOF -if { (eval echo configure:4320: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4319: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4345,10 +4344,10 @@ # The nsl library prevents programs from opening the X display # on Irix 5.2, according to dickey@clark.net. echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6 -echo "configure:4349: checking for gethostbyname" >&5 - -cat > conftest.$ac_ext <<EOF -#line 4352 "configure" +echo "configure:4348: checking for gethostbyname" >&5 + +cat > conftest.$ac_ext <<EOF +#line 4351 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char gethostbyname(); below. */ @@ -4371,7 +4370,7 @@ ; return 0; } EOF -if { (eval echo configure:4375: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4374: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_gethostbyname=yes" else @@ -4392,12 +4391,12 @@ if test $ac_cv_func_gethostbyname = no; then echo $ac_n "checking for gethostbyname in -lnsl""... $ac_c" 1>&6 -echo "configure:4396: checking for gethostbyname in -lnsl" >&5 +echo "configure:4395: checking for gethostbyname in -lnsl" >&5 ac_lib_var=`echo nsl'_'gethostbyname | sed 'y%./+-%__p_%'` xe_check_libs=" -lnsl " cat > conftest.$ac_ext <<EOF -#line 4401 "configure" +#line 4400 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4408,7 +4407,7 @@ gethostbyname() ; return 0; } EOF -if { (eval echo configure:4412: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4411: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4438,10 +4437,10 @@ # -lsocket must be given before -lnsl if both are needed. # We assume that if connect needs -lnsl, so does gethostbyname. echo $ac_n "checking for connect""... $ac_c" 1>&6 -echo "configure:4442: checking for connect" >&5 - -cat > conftest.$ac_ext <<EOF -#line 4445 "configure" +echo "configure:4441: checking for connect" >&5 + +cat > conftest.$ac_ext <<EOF +#line 4444 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char connect(); below. */ @@ -4464,7 +4463,7 @@ ; return 0; } EOF -if { (eval echo configure:4468: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4467: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_connect=yes" else @@ -4487,12 +4486,12 @@ xe_msg_checking="for connect in -lsocket" test -n "$X_EXTRA_LIBS" && xe_msg_checking="$xe_msg_checking using extra libs $X_EXTRA_LIBS" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:4491: checking "$xe_msg_checking"" >&5 +echo "configure:4490: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo socket'_'connect | sed 'y%./+-%__p_%'` xe_check_libs=" -lsocket $X_EXTRA_LIBS" cat > conftest.$ac_ext <<EOF -#line 4496 "configure" +#line 4495 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4503,7 +4502,7 @@ connect() ; return 0; } EOF -if { (eval echo configure:4507: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4506: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4527,10 +4526,10 @@ # gomez@mi.uni-erlangen.de says -lposix is necessary on A/UX. echo $ac_n "checking for remove""... $ac_c" 1>&6 -echo "configure:4531: checking for remove" >&5 - -cat > conftest.$ac_ext <<EOF -#line 4534 "configure" +echo "configure:4530: checking for remove" >&5 + +cat > conftest.$ac_ext <<EOF +#line 4533 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char remove(); below. */ @@ -4553,7 +4552,7 @@ ; return 0; } EOF -if { (eval echo configure:4557: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4556: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_remove=yes" else @@ -4574,12 +4573,12 @@ if test $ac_cv_func_remove = no; then echo $ac_n "checking for remove in -lposix""... $ac_c" 1>&6 -echo "configure:4578: checking for remove in -lposix" >&5 +echo "configure:4577: checking for remove in -lposix" >&5 ac_lib_var=`echo posix'_'remove | sed 'y%./+-%__p_%'` xe_check_libs=" -lposix " cat > conftest.$ac_ext <<EOF -#line 4583 "configure" +#line 4582 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4590,7 +4589,7 @@ remove() ; return 0; } EOF -if { (eval echo configure:4594: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4593: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4614,10 +4613,10 @@ # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay. echo $ac_n "checking for shmat""... $ac_c" 1>&6 -echo "configure:4618: checking for shmat" >&5 - -cat > conftest.$ac_ext <<EOF -#line 4621 "configure" +echo "configure:4617: checking for shmat" >&5 + +cat > conftest.$ac_ext <<EOF +#line 4620 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char shmat(); below. */ @@ -4640,7 +4639,7 @@ ; return 0; } EOF -if { (eval echo configure:4644: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4643: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_shmat=yes" else @@ -4661,12 +4660,12 @@ if test $ac_cv_func_shmat = no; then echo $ac_n "checking for shmat in -lipc""... $ac_c" 1>&6 -echo "configure:4665: checking for shmat in -lipc" >&5 +echo "configure:4664: checking for shmat in -lipc" >&5 ac_lib_var=`echo ipc'_'shmat | sed 'y%./+-%__p_%'` xe_check_libs=" -lipc " cat > conftest.$ac_ext <<EOF -#line 4670 "configure" +#line 4669 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4677,7 +4676,7 @@ shmat() ; return 0; } EOF -if { (eval echo configure:4681: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4680: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4711,12 +4710,12 @@ # --interran@uluru.Stanford.EDU, kb@cs.umb.edu. echo $ac_n "checking for IceConnectionNumber in -lICE""... $ac_c" 1>&6 -echo "configure:4715: checking for IceConnectionNumber in -lICE" >&5 +echo "configure:4714: checking for IceConnectionNumber in -lICE" >&5 ac_lib_var=`echo ICE'_'IceConnectionNumber | sed 'y%./+-%__p_%'` xe_check_libs=" -lICE " cat > conftest.$ac_ext <<EOF -#line 4720 "configure" +#line 4719 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4727,7 +4726,7 @@ IceConnectionNumber() ; return 0; } EOF -if { (eval echo configure:4731: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4730: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4805,8 +4804,8 @@ if test "$add_runtime_path" = "yes" -a -n "$dash_r"; then - ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//"` - ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//"` + ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"` + ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"` runpath="" runpath_dirs="" if test -n "$LD_RUN_PATH"; then @@ -4859,7 +4858,7 @@ fi echo "checking for X defines extracted by xmkmf" 1>&6 -echo "configure:4863: checking for X defines extracted by xmkmf" >&5 +echo "configure:4862: checking for X defines extracted by xmkmf" >&5 rm -fr conftestdir if mkdir conftestdir; then cd conftestdir @@ -4891,15 +4890,15 @@ ac_safe=`echo "X11/Intrinsic.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for X11/Intrinsic.h""... $ac_c" 1>&6 -echo "configure:4895: checking for X11/Intrinsic.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 4898 "configure" +echo "configure:4894: checking for X11/Intrinsic.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 4897 "configure" #include "confdefs.h" #include <X11/Intrinsic.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4903: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:4902: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -4923,12 +4922,12 @@ echo $ac_n "checking for XOpenDisplay in -lX11""... $ac_c" 1>&6 -echo "configure:4927: checking for XOpenDisplay in -lX11" >&5 +echo "configure:4926: checking for XOpenDisplay in -lX11" >&5 ac_lib_var=`echo X11'_'XOpenDisplay | sed 'y%./+-%__p_%'` xe_check_libs=" -lX11 " cat > conftest.$ac_ext <<EOF -#line 4932 "configure" +#line 4931 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4939,7 +4938,7 @@ XOpenDisplay() ; return 0; } EOF -if { (eval echo configure:4943: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4942: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4964,12 +4963,12 @@ xe_msg_checking="for XGetFontProperty in -lX11" test -n "-b i486-linuxaout" && xe_msg_checking="$xe_msg_checking using extra libs -b i486-linuxaout" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:4968: checking "$xe_msg_checking"" >&5 +echo "configure:4967: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo X11'_'XGetFontProperty | sed 'y%./+-%__p_%'` xe_check_libs=" -lX11 -b i486-linuxaout" cat > conftest.$ac_ext <<EOF -#line 4973 "configure" +#line 4972 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4980,7 +4979,7 @@ XGetFontProperty() ; return 0; } EOF -if { (eval echo configure:4984: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4983: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5007,12 +5006,12 @@ echo $ac_n "checking for XShapeSelectInput in -lXext""... $ac_c" 1>&6 -echo "configure:5011: checking for XShapeSelectInput in -lXext" >&5 +echo "configure:5010: checking for XShapeSelectInput in -lXext" >&5 ac_lib_var=`echo Xext'_'XShapeSelectInput | sed 'y%./+-%__p_%'` xe_check_libs=" -lXext " cat > conftest.$ac_ext <<EOF -#line 5016 "configure" +#line 5015 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5023,7 +5022,7 @@ XShapeSelectInput() ; return 0; } EOF -if { (eval echo configure:5027: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5026: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5047,12 +5046,12 @@ case "$opsys" in sunos4* ) libs_x="-u _XtToolkitInitialize -lXt $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-u _XtToolkitInitialize -lXt\" to \$libs_x"; fi ;; * ) echo $ac_n "checking for XtOpenDisplay in -lXt""... $ac_c" 1>&6 -echo "configure:5051: checking for XtOpenDisplay in -lXt" >&5 +echo "configure:5050: checking for XtOpenDisplay in -lXt" >&5 ac_lib_var=`echo Xt'_'XtOpenDisplay | sed 'y%./+-%__p_%'` xe_check_libs=" -lXt " cat > conftest.$ac_ext <<EOF -#line 5056 "configure" +#line 5055 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5063,7 +5062,7 @@ XtOpenDisplay() ; return 0; } EOF -if { (eval echo configure:5067: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5066: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5087,14 +5086,14 @@ esac echo $ac_n "checking the version of X11 being used""... $ac_c" 1>&6 -echo "configure:5091: checking the version of X11 being used" >&5 +echo "configure:5090: checking the version of X11 being used" >&5 cat > conftest.$ac_ext <<EOF -#line 5093 "configure" +#line 5092 "configure" #include "confdefs.h" #include <X11/Intrinsic.h> main(int c, char* v[]) { return c>1 ? XlibSpecificationRelease : 0; } EOF -if { (eval echo configure:5098: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:5097: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ./conftest foobar; x11_release=$? else @@ -5118,15 +5117,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:5122: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <<EOF -#line 5125 "configure" +echo "configure:5121: checking for $ac_hdr" >&5 + +cat > conftest.$ac_ext <<EOF +#line 5124 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5130: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5129: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5157,7 +5156,7 @@ echo $ac_n "checking for XFree86""... $ac_c" 1>&6 -echo "configure:5161: checking for XFree86" >&5 +echo "configure:5160: checking for XFree86" >&5 if test -d "/usr/X386/include" -o \ -f "/etc/XF86Config" -o \ -f "/etc/X11/XF86Config" -o \ @@ -5179,12 +5178,12 @@ * ) if test -z "$with_xmu"; then echo $ac_n "checking for XmuConvertStandardSelection in -lXmu""... $ac_c" 1>&6 -echo "configure:5183: checking for XmuConvertStandardSelection in -lXmu" >&5 +echo "configure:5182: checking for XmuConvertStandardSelection in -lXmu" >&5 ac_lib_var=`echo Xmu'_'XmuConvertStandardSelection | sed 'y%./+-%__p_%'` xe_check_libs=" -lXmu " cat > conftest.$ac_ext <<EOF -#line 5188 "configure" +#line 5187 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5195,7 +5194,7 @@ XmuConvertStandardSelection() ; return 0; } EOF -if { (eval echo configure:5199: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5198: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5228,19 +5227,19 @@ echo $ac_n "checking for main in -lXbsd""... $ac_c" 1>&6 -echo "configure:5232: checking for main in -lXbsd" >&5 +echo "configure:5231: checking for main in -lXbsd" >&5 ac_lib_var=`echo Xbsd'_'main | sed 'y%./+-%__p_%'` xe_check_libs=" -lXbsd " cat > conftest.$ac_ext <<EOF -#line 5237 "configure" +#line 5236 "configure" #include "confdefs.h" int main() { main() ; return 0; } EOF -if { (eval echo configure:5244: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5243: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5263,12 +5262,12 @@ echo $ac_n "checking for XawScrollbarSetThumb in -lXaw""... $ac_c" 1>&6 -echo "configure:5267: checking for XawScrollbarSetThumb in -lXaw" >&5 +echo "configure:5266: checking for XawScrollbarSetThumb in -lXaw" >&5 ac_lib_var=`echo Xaw'_'XawScrollbarSetThumb | sed 'y%./+-%__p_%'` xe_check_libs=" -lXaw " cat > conftest.$ac_ext <<EOF -#line 5272 "configure" +#line 5271 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5279,7 +5278,7 @@ XawScrollbarSetThumb() ; return 0; } EOF -if { (eval echo configure:5283: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5282: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5336,15 +5335,15 @@ test -z "$with_xauth" && test "$window_system" = "none" && with_xauth=no test -z "$with_xauth" && { ac_safe=`echo "X11/Xauth.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for X11/Xauth.h""... $ac_c" 1>&6 -echo "configure:5340: checking for X11/Xauth.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 5343 "configure" +echo "configure:5339: checking for X11/Xauth.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 5342 "configure" #include "confdefs.h" #include <X11/Xauth.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5348: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5347: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5367,12 +5366,12 @@ } test -z "$with_xauth" && { echo $ac_n "checking for XauGetAuthByAddr in -lXau""... $ac_c" 1>&6 -echo "configure:5371: checking for XauGetAuthByAddr in -lXau" >&5 +echo "configure:5370: checking for XauGetAuthByAddr in -lXau" >&5 ac_lib_var=`echo Xau'_'XauGetAuthByAddr | sed 'y%./+-%__p_%'` xe_check_libs=" -lXau " cat > conftest.$ac_ext <<EOF -#line 5376 "configure" +#line 5375 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5383,7 +5382,7 @@ XauGetAuthByAddr() ; return 0; } EOF -if { (eval echo configure:5387: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5386: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5424,15 +5423,15 @@ test -z "$with_offix" && { ac_safe=`echo "OffiX/DragAndDrop.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for OffiX/DragAndDrop.h""... $ac_c" 1>&6 -echo "configure:5428: checking for OffiX/DragAndDrop.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 5431 "configure" +echo "configure:5427: checking for OffiX/DragAndDrop.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 5430 "configure" #include "confdefs.h" #include <OffiX/DragAndDrop.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5436: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5435: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5455,12 +5454,12 @@ } test -z "$with_offix" && { echo $ac_n "checking for DndInitialize in -lDnd""... $ac_c" 1>&6 -echo "configure:5459: checking for DndInitialize in -lDnd" >&5 +echo "configure:5458: checking for DndInitialize in -lDnd" >&5 ac_lib_var=`echo Dnd'_'DndInitialize | sed 'y%./+-%__p_%'` xe_check_libs=" -lDnd " cat > conftest.$ac_ext <<EOF -#line 5464 "configure" +#line 5463 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5471,7 +5470,7 @@ DndInitialize() ; return 0; } EOF -if { (eval echo configure:5475: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5474: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5510,15 +5509,15 @@ for dir in "" "Tt/" "desktop/" ; do ac_safe=`echo "${dir}tt_c.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ${dir}tt_c.h""... $ac_c" 1>&6 -echo "configure:5514: checking for ${dir}tt_c.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 5517 "configure" +echo "configure:5513: checking for ${dir}tt_c.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 5516 "configure" #include "confdefs.h" #include <${dir}tt_c.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5522: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5521: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5547,12 +5546,12 @@ xe_msg_checking="for tt_message_create in -ltt" test -n "$extra_libs" && xe_msg_checking="$xe_msg_checking using extra libs $extra_libs" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:5551: checking "$xe_msg_checking"" >&5 +echo "configure:5550: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo tt'_'tt_message_create | sed 'y%./+-%__p_%'` xe_check_libs=" -ltt $extra_libs" cat > conftest.$ac_ext <<EOF -#line 5556 "configure" +#line 5555 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5563,7 +5562,7 @@ tt_message_create() ; return 0; } EOF -if { (eval echo configure:5567: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5566: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5612,15 +5611,15 @@ test -z "$with_cde" && { ac_safe=`echo "Dt/Dt.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for Dt/Dt.h""... $ac_c" 1>&6 -echo "configure:5616: checking for Dt/Dt.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 5619 "configure" +echo "configure:5615: checking for Dt/Dt.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 5618 "configure" #include "confdefs.h" #include <Dt/Dt.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5624: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5623: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5643,12 +5642,12 @@ } test -z "$with_cde" && { echo $ac_n "checking for DtDndDragStart in -lDtSvc""... $ac_c" 1>&6 -echo "configure:5647: checking for DtDndDragStart in -lDtSvc" >&5 +echo "configure:5646: checking for DtDndDragStart in -lDtSvc" >&5 ac_lib_var=`echo DtSvc'_'DtDndDragStart | sed 'y%./+-%__p_%'` xe_check_libs=" -lDtSvc " cat > conftest.$ac_ext <<EOF -#line 5652 "configure" +#line 5651 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5659,7 +5658,7 @@ DtDndDragStart() ; return 0; } EOF -if { (eval echo configure:5663: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5662: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5706,19 +5705,19 @@ echo $ac_n "checking for main in -lenergize""... $ac_c" 1>&6 -echo "configure:5710: checking for main in -lenergize" >&5 +echo "configure:5709: checking for main in -lenergize" >&5 ac_lib_var=`echo energize'_'main | sed 'y%./+-%__p_%'` xe_check_libs=" -lenergize " cat > conftest.$ac_ext <<EOF -#line 5715 "configure" +#line 5714 "configure" #include "confdefs.h" int main() { main() ; return 0; } EOF -if { (eval echo configure:5722: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5721: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5750,19 +5749,19 @@ if test -z "$energize_version"; then echo $ac_n "checking for main in -lconn""... $ac_c" 1>&6 -echo "configure:5754: checking for main in -lconn" >&5 +echo "configure:5753: checking for main in -lconn" >&5 ac_lib_var=`echo conn'_'main | sed 'y%./+-%__p_%'` xe_check_libs=" -lconn " cat > conftest.$ac_ext <<EOF -#line 5759 "configure" +#line 5758 "configure" #include "confdefs.h" int main() { main() ; return 0; } EOF -if { (eval echo configure:5766: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5765: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5795,15 +5794,15 @@ fi ac_safe=`echo "editorconn.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for editorconn.h""... $ac_c" 1>&6 -echo "configure:5799: checking for editorconn.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 5802 "configure" +echo "configure:5798: checking for editorconn.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 5801 "configure" #include "confdefs.h" #include <editorconn.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5807: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5806: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5845,7 +5844,7 @@ echo "checking for graphics libraries" 1>&6 -echo "configure:5849: checking for graphics libraries" >&5 +echo "configure:5848: checking for graphics libraries" >&5 test -z "$with_gif" && with_gif=yes; if test "$with_gif" = "yes"; then { test "$extra_verbose" = "yes" && cat << \EOF @@ -5862,10 +5861,10 @@ fi echo $ac_n "checking for Xpm - no older than 3.4f""... $ac_c" 1>&6 -echo "configure:5866: checking for Xpm - no older than 3.4f" >&5 +echo "configure:5865: checking for Xpm - no older than 3.4f" >&5 xe_check_libs=-lXpm test -z "$with_xpm" && { cat > conftest.$ac_ext <<EOF -#line 5869 "configure" +#line 5868 "configure" #include "confdefs.h" #include <X11/xpm.h> int main(int c, char **v) { @@ -5875,7 +5874,7 @@ 0 ; } EOF -if { (eval echo configure:5879: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:5878: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ./conftest foobar; xpm_status=$?; if test "$xpm_status" = "0"; then with_xpm=yes; else with_xpm=no; fi; @@ -5913,15 +5912,15 @@ test -z "$with_xface" && { ac_safe=`echo "compface.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for compface.h""... $ac_c" 1>&6 -echo "configure:5917: checking for compface.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 5920 "configure" +echo "configure:5916: checking for compface.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 5919 "configure" #include "confdefs.h" #include <compface.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5925: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5924: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5944,12 +5943,12 @@ } test -z "$with_xface" && { echo $ac_n "checking for UnGenFace in -lcompface""... $ac_c" 1>&6 -echo "configure:5948: checking for UnGenFace in -lcompface" >&5 +echo "configure:5947: checking for UnGenFace in -lcompface" >&5 ac_lib_var=`echo compface'_'UnGenFace | sed 'y%./+-%__p_%'` xe_check_libs=" -lcompface " cat > conftest.$ac_ext <<EOF -#line 5953 "configure" +#line 5952 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5960,7 +5959,7 @@ UnGenFace() ; return 0; } EOF -if { (eval echo configure:5964: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5963: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5996,15 +5995,15 @@ test -z "$with_jpeg" && { ac_safe=`echo "jpeglib.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for jpeglib.h""... $ac_c" 1>&6 -echo "configure:6000: checking for jpeglib.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 6003 "configure" +echo "configure:5999: checking for jpeglib.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 6002 "configure" #include "confdefs.h" #include <jpeglib.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6008: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6007: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6027,12 +6026,12 @@ } test -z "$with_jpeg" && { echo $ac_n "checking for jpeg_destroy_decompress in -ljpeg""... $ac_c" 1>&6 -echo "configure:6031: checking for jpeg_destroy_decompress in -ljpeg" >&5 +echo "configure:6030: checking for jpeg_destroy_decompress in -ljpeg" >&5 ac_lib_var=`echo jpeg'_'jpeg_destroy_decompress | sed 'y%./+-%__p_%'` xe_check_libs=" -ljpeg " cat > conftest.$ac_ext <<EOF -#line 6036 "configure" +#line 6035 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6043,7 +6042,7 @@ jpeg_destroy_decompress() ; return 0; } EOF -if { (eval echo configure:6047: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6046: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6079,15 +6078,15 @@ test -z "$with_png" && { ac_safe=`echo "png.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for png.h""... $ac_c" 1>&6 -echo "configure:6083: checking for png.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 6086 "configure" +echo "configure:6082: checking for png.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 6085 "configure" #include "confdefs.h" #include <png.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6091: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6090: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6109,10 +6108,10 @@ fi } test -z "$with_png" && { echo $ac_n "checking for pow""... $ac_c" 1>&6 -echo "configure:6113: checking for pow" >&5 - -cat > conftest.$ac_ext <<EOF -#line 6116 "configure" +echo "configure:6112: checking for pow" >&5 + +cat > conftest.$ac_ext <<EOF +#line 6115 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char pow(); below. */ @@ -6135,7 +6134,7 @@ ; return 0; } EOF -if { (eval echo configure:6139: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6138: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_pow=yes" else @@ -6160,12 +6159,12 @@ xe_msg_checking="for png_read_image in -lpng" test -n "$extra_libs" && xe_msg_checking="$xe_msg_checking using extra libs $extra_libs" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:6164: checking "$xe_msg_checking"" >&5 +echo "configure:6163: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo png'_'png_read_image | sed 'y%./+-%__p_%'` xe_check_libs=" -lpng $extra_libs" cat > conftest.$ac_ext <<EOF -#line 6169 "configure" +#line 6168 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6176,7 +6175,7 @@ png_read_image() ; return 0; } EOF -if { (eval echo configure:6180: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6179: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6226,15 +6225,15 @@ ac_safe=`echo "Xm/Xm.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for Xm/Xm.h""... $ac_c" 1>&6 -echo "configure:6230: checking for Xm/Xm.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 6233 "configure" +echo "configure:6229: checking for Xm/Xm.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 6232 "configure" #include "confdefs.h" #include <Xm/Xm.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6238: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6237: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6251,12 +6250,12 @@ echo "$ac_t""yes" 1>&6 echo $ac_n "checking for XmStringFree in -lXm""... $ac_c" 1>&6 -echo "configure:6255: checking for XmStringFree in -lXm" >&5 +echo "configure:6254: checking for XmStringFree in -lXm" >&5 ac_lib_var=`echo Xm'_'XmStringFree | sed 'y%./+-%__p_%'` xe_check_libs=" -lXm " cat > conftest.$ac_ext <<EOF -#line 6260 "configure" +#line 6259 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6267,7 +6266,7 @@ XmStringFree() ; return 0; } EOF -if { (eval echo configure:6271: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6270: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6515,7 +6514,7 @@ if test "$with_mule" = "yes" ; then echo "checking for Mule-related features" 1>&6 -echo "configure:6519: checking for Mule-related features" >&5 +echo "configure:6518: checking for Mule-related features" >&5 { test "$extra_verbose" = "yes" && cat << \EOF Defining MULE EOF @@ -6532,15 +6531,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:6536: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <<EOF -#line 6539 "configure" +echo "configure:6535: checking for $ac_hdr" >&5 + +cat > conftest.$ac_ext <<EOF +#line 6538 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6544: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6543: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6571,12 +6570,12 @@ echo $ac_n "checking for strerror in -lintl""... $ac_c" 1>&6 -echo "configure:6575: checking for strerror in -lintl" >&5 +echo "configure:6574: checking for strerror in -lintl" >&5 ac_lib_var=`echo intl'_'strerror | sed 'y%./+-%__p_%'` xe_check_libs=" -lintl " cat > conftest.$ac_ext <<EOF -#line 6580 "configure" +#line 6579 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6587,7 +6586,7 @@ strerror() ; return 0; } EOF -if { (eval echo configure:6591: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6590: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6620,19 +6619,19 @@ echo "checking for Mule input methods" 1>&6 -echo "configure:6624: checking for Mule input methods" >&5 +echo "configure:6623: checking for Mule input methods" >&5 test -z "$with_xim" -a "$opsys" != "sol2" && with_xim=no case "$with_xim" in "" | "yes" ) echo "checking for XIM" 1>&6 -echo "configure:6628: checking for XIM" >&5 +echo "configure:6627: checking for XIM" >&5 echo $ac_n "checking for XmImMbLookupString in -lXm""... $ac_c" 1>&6 -echo "configure:6631: checking for XmImMbLookupString in -lXm" >&5 +echo "configure:6630: checking for XmImMbLookupString in -lXm" >&5 ac_lib_var=`echo Xm'_'XmImMbLookupString | sed 'y%./+-%__p_%'` xe_check_libs=" -lXm " cat > conftest.$ac_ext <<EOF -#line 6636 "configure" +#line 6635 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6643,7 +6642,7 @@ XmImMbLookupString() ; return 0; } EOF -if { (eval echo configure:6647: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6646: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6705,15 +6704,15 @@ test "$with_wnn6" = "yes" && with_wnn=yes # wnn6 implies wnn support test -z "$with_wnn" && { ac_safe=`echo "wnn/jllib.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for wnn/jllib.h""... $ac_c" 1>&6 -echo "configure:6709: checking for wnn/jllib.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 6712 "configure" +echo "configure:6708: checking for wnn/jllib.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 6711 "configure" #include "confdefs.h" #include <wnn/jllib.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6717: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6716: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6736,12 +6735,12 @@ } test -z "$with_wnn" && { echo $ac_n "checking for jl_dic_list_e in -lwnn""... $ac_c" 1>&6 -echo "configure:6740: checking for jl_dic_list_e in -lwnn" >&5 +echo "configure:6739: checking for jl_dic_list_e in -lwnn" >&5 ac_lib_var=`echo wnn'_'jl_dic_list_e | sed 'y%./+-%__p_%'` xe_check_libs=" -lwnn " cat > conftest.$ac_ext <<EOF -#line 6745 "configure" +#line 6744 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6752,7 +6751,7 @@ jl_dic_list_e() ; return 0; } EOF -if { (eval echo configure:6756: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6755: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6789,12 +6788,12 @@ fi echo $ac_n "checking for jl_fi_dic_list in -lwnn""... $ac_c" 1>&6 -echo "configure:6793: checking for jl_fi_dic_list in -lwnn" >&5 +echo "configure:6792: checking for jl_fi_dic_list in -lwnn" >&5 ac_lib_var=`echo wnn'_'jl_fi_dic_list | sed 'y%./+-%__p_%'` xe_check_libs=" -lwnn " cat > conftest.$ac_ext <<EOF -#line 6798 "configure" +#line 6797 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6805,7 +6804,7 @@ jl_fi_dic_list() ; return 0; } EOF -if { (eval echo configure:6809: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6808: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6837,15 +6836,15 @@ test -z "$with_canna" && { ac_safe=`echo "canna/RK.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for canna/RK.h""... $ac_c" 1>&6 -echo "configure:6841: checking for canna/RK.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 6844 "configure" +echo "configure:6840: checking for canna/RK.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 6843 "configure" #include "confdefs.h" #include <canna/RK.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6849: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6848: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6868,12 +6867,12 @@ } test -z "$with_canna" && { echo $ac_n "checking for RkBgnBun in -lRKC""... $ac_c" 1>&6 -echo "configure:6872: checking for RkBgnBun in -lRKC" >&5 +echo "configure:6871: checking for RkBgnBun in -lRKC" >&5 ac_lib_var=`echo RKC'_'RkBgnBun | sed 'y%./+-%__p_%'` xe_check_libs=" -lRKC " cat > conftest.$ac_ext <<EOF -#line 6877 "configure" +#line 6876 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6884,7 +6883,7 @@ RkBgnBun() ; return 0; } EOF -if { (eval echo configure:6888: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6887: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6907,12 +6906,12 @@ } test -z "$with_canna" && { echo $ac_n "checking for jrKanjiControl in -lcanna""... $ac_c" 1>&6 -echo "configure:6911: checking for jrKanjiControl in -lcanna" >&5 +echo "configure:6910: checking for jrKanjiControl in -lcanna" >&5 ac_lib_var=`echo canna'_'jrKanjiControl | sed 'y%./+-%__p_%'` xe_check_libs=" -lcanna " cat > conftest.$ac_ext <<EOF -#line 6916 "configure" +#line 6915 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -6923,7 +6922,7 @@ jrKanjiControl() ; return 0; } EOF -if { (eval echo configure:6927: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6926: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6972,8 +6971,8 @@ libs_x="-lXm $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXm\" to \$libs_x"; fi if test "$add_runtime_path" = "yes" -a -n "$dash_r"; then - ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//"` - ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//"` + ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"` + ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"` runpath="" runpath_dirs="" if test -n "$LD_RUN_PATH"; then @@ -7023,10 +7022,10 @@ for ac_func in acosh asinh atanh cbrt closedir dup2 eaccess fmod fpathconf frexp ftime gethostname getpagesize gettimeofday getcwd getwd logb lrand48 matherr mkdir mktime perror poll random rename res_init rint rmdir select setitimer setpgid setlocale setsid sigblock sighold sigprocmask strcasecmp strerror tzset utimes waitpid do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:7027: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7030 "configure" +echo "configure:7026: checking for $ac_func" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7029 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -7049,7 +7048,7 @@ ; return 0; } EOF -if { (eval echo configure:7053: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7052: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -7086,10 +7085,10 @@ for ac_func in realpath do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:7090: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7093 "configure" +echo "configure:7089: checking for $ac_func" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7092 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -7112,7 +7111,7 @@ ; return 0; } EOF -if { (eval echo configure:7116: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7115: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -7145,16 +7144,16 @@ esac echo $ac_n "checking whether netdb declares h_errno""... $ac_c" 1>&6 -echo "configure:7149: checking whether netdb declares h_errno" >&5 -cat > conftest.$ac_ext <<EOF -#line 7151 "configure" +echo "configure:7148: checking whether netdb declares h_errno" >&5 +cat > conftest.$ac_ext <<EOF +#line 7150 "configure" #include "confdefs.h" #include <netdb.h> int main() { return h_errno; ; return 0; } EOF -if { (eval echo configure:7158: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7157: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* echo "$ac_t""yes" 1>&6 { test "$extra_verbose" = "yes" && cat << \EOF @@ -7174,16 +7173,16 @@ rm -f conftest* echo $ac_n "checking for sigsetjmp""... $ac_c" 1>&6 -echo "configure:7178: checking for sigsetjmp" >&5 -cat > conftest.$ac_ext <<EOF -#line 7180 "configure" +echo "configure:7177: checking for sigsetjmp" >&5 +cat > conftest.$ac_ext <<EOF +#line 7179 "configure" #include "confdefs.h" #include <setjmp.h> int main() { sigjmp_buf bar; sigsetjmp (bar, 0); ; return 0; } EOF -if { (eval echo configure:7187: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:7186: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 { test "$extra_verbose" = "yes" && cat << \EOF @@ -7203,11 +7202,11 @@ rm -f conftest* echo $ac_n "checking whether localtime caches TZ""... $ac_c" 1>&6 -echo "configure:7207: checking whether localtime caches TZ" >&5 +echo "configure:7206: checking whether localtime caches TZ" >&5 if test "$ac_cv_func_tzset" = "yes"; then cat > conftest.$ac_ext <<EOF -#line 7211 "configure" +#line 7210 "configure" #include "confdefs.h" #include <time.h> #if STDC_HEADERS @@ -7242,7 +7241,7 @@ exit (0); } EOF -if { (eval echo configure:7246: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:7245: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then emacs_cv_localtime_cache=no else @@ -7271,9 +7270,9 @@ if test "$HAVE_TIMEVAL" = "yes"; then echo $ac_n "checking whether gettimeofday cannot accept two arguments""... $ac_c" 1>&6 -echo "configure:7275: checking whether gettimeofday cannot accept two arguments" >&5 -cat > conftest.$ac_ext <<EOF -#line 7277 "configure" +echo "configure:7274: checking whether gettimeofday cannot accept two arguments" >&5 +cat > conftest.$ac_ext <<EOF +#line 7276 "configure" #include "confdefs.h" #ifdef TIME_WITH_SYS_TIME @@ -7295,7 +7294,7 @@ ; return 0; } EOF -if { (eval echo configure:7299: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7298: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* echo "$ac_t""no" 1>&6 else @@ -7317,19 +7316,19 @@ echo $ac_n "checking for inline""... $ac_c" 1>&6 -echo "configure:7321: checking for inline" >&5 +echo "configure:7320: checking for inline" >&5 ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do cat > conftest.$ac_ext <<EOF -#line 7326 "configure" +#line 7325 "configure" #include "confdefs.h" int main() { } $ac_kw foo() { ; return 0; } EOF -if { (eval echo configure:7333: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:7332: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_inline=$ac_kw; break else @@ -7379,17 +7378,17 @@ # The Ultrix 4.2 mips builtin alloca declared by alloca.h only works # for constant arguments. Useless! echo $ac_n "checking for working alloca.h""... $ac_c" 1>&6 -echo "configure:7383: checking for working alloca.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7386 "configure" +echo "configure:7382: checking for working alloca.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7385 "configure" #include "confdefs.h" #include <alloca.h> int main() { char *p = alloca(2 * sizeof(int)); ; return 0; } EOF -if { (eval echo configure:7393: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7392: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_cv_header_alloca_h=yes else @@ -7413,10 +7412,10 @@ fi echo $ac_n "checking for alloca""... $ac_c" 1>&6 -echo "configure:7417: checking for alloca" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7420 "configure" +echo "configure:7416: checking for alloca" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7419 "configure" #include "confdefs.h" #ifdef __GNUC__ @@ -7439,7 +7438,7 @@ char *p = (char *) alloca(1); ; return 0; } EOF -if { (eval echo configure:7443: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7442: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_cv_func_alloca_works=yes else @@ -7478,10 +7477,10 @@ echo $ac_n "checking whether alloca needs Cray hooks""... $ac_c" 1>&6 -echo "configure:7482: checking whether alloca needs Cray hooks" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7485 "configure" +echo "configure:7481: checking whether alloca needs Cray hooks" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7484 "configure" #include "confdefs.h" #if defined(CRAY) && ! defined(CRAY2) webecray @@ -7505,10 +7504,10 @@ if test $ac_cv_os_cray = yes; then for ac_func in _getb67 GETB67 getb67; do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:7509: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7512 "configure" +echo "configure:7508: checking for $ac_func" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7511 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -7531,7 +7530,7 @@ ; return 0; } EOF -if { (eval echo configure:7535: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7534: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -7561,10 +7560,10 @@ fi echo $ac_n "checking stack direction for C alloca""... $ac_c" 1>&6 -echo "configure:7565: checking stack direction for C alloca" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7568 "configure" +echo "configure:7564: checking stack direction for C alloca" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7567 "configure" #include "confdefs.h" find_stack_direction () { @@ -7583,7 +7582,7 @@ exit (find_stack_direction() < 0); } EOF -if { (eval echo configure:7587: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:7586: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_c_stack_direction=1 else @@ -7611,15 +7610,15 @@ ac_safe=`echo "vfork.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for vfork.h""... $ac_c" 1>&6 -echo "configure:7615: checking for vfork.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7618 "configure" +echo "configure:7614: checking for vfork.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7617 "configure" #include "confdefs.h" #include <vfork.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7623: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:7622: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -7647,10 +7646,10 @@ fi echo $ac_n "checking for working vfork""... $ac_c" 1>&6 -echo "configure:7651: checking for working vfork" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7654 "configure" +echo "configure:7650: checking for working vfork" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7653 "configure" #include "confdefs.h" /* Thanks to Paul Eggert for this test. */ #include <stdio.h> @@ -7745,7 +7744,7 @@ } } EOF -if { (eval echo configure:7749: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:7748: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_func_vfork_works=yes else @@ -7770,10 +7769,10 @@ echo $ac_n "checking for working strcoll""... $ac_c" 1>&6 -echo "configure:7774: checking for working strcoll" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7777 "configure" +echo "configure:7773: checking for working strcoll" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7776 "configure" #include "confdefs.h" #include <string.h> main () @@ -7783,7 +7782,7 @@ strcoll ("123", "456") >= 0); } EOF -if { (eval echo configure:7787: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:7786: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_func_strcoll_works=yes else @@ -7810,10 +7809,10 @@ for ac_func in getpgrp do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:7814: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7817 "configure" +echo "configure:7813: checking for $ac_func" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7816 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -7836,7 +7835,7 @@ ; return 0; } EOF -if { (eval echo configure:7840: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7839: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -7864,10 +7863,10 @@ done echo $ac_n "checking whether getpgrp takes no argument""... $ac_c" 1>&6 -echo "configure:7868: checking whether getpgrp takes no argument" >&5 - -cat > conftest.$ac_ext <<EOF -#line 7871 "configure" +echo "configure:7867: checking whether getpgrp takes no argument" >&5 + +cat > conftest.$ac_ext <<EOF +#line 7870 "configure" #include "confdefs.h" /* @@ -7922,7 +7921,7 @@ } EOF -if { (eval echo configure:7926: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:7925: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_func_getpgrp_void=yes else @@ -7948,10 +7947,10 @@ echo $ac_n "checking for working mmap""... $ac_c" 1>&6 -echo "configure:7952: checking for working mmap" >&5 +echo "configure:7951: checking for working mmap" >&5 case "$opsys" in ultrix* ) have_mmap=no ;; *) cat > conftest.$ac_ext <<EOF -#line 7955 "configure" +#line 7954 "configure" #include "confdefs.h" #include <stdio.h> #include <unistd.h> @@ -7984,7 +7983,7 @@ return 1; } EOF -if { (eval echo configure:7988: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:7987: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then have_mmap=yes else @@ -8017,10 +8016,10 @@ echo $ac_n "checking for socket""... $ac_c" 1>&6 -echo "configure:8021: checking for socket" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8024 "configure" +echo "configure:8020: checking for socket" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8023 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char socket(); below. */ @@ -8043,7 +8042,7 @@ ; return 0; } EOF -if { (eval echo configure:8047: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8046: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_socket=yes" else @@ -8058,15 +8057,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "netinet/in.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for netinet/in.h""... $ac_c" 1>&6 -echo "configure:8062: checking for netinet/in.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8065 "configure" +echo "configure:8061: checking for netinet/in.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8064 "configure" #include "confdefs.h" #include <netinet/in.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8070: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8069: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8083,15 +8082,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "arpa/inet.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for arpa/inet.h""... $ac_c" 1>&6 -echo "configure:8087: checking for arpa/inet.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8090 "configure" +echo "configure:8086: checking for arpa/inet.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8089 "configure" #include "confdefs.h" #include <arpa/inet.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8095: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8094: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8116,9 +8115,9 @@ } echo $ac_n "checking "for sun_len member in struct sockaddr_un"""... $ac_c" 1>&6 -echo "configure:8120: checking "for sun_len member in struct sockaddr_un"" >&5 +echo "configure:8119: checking "for sun_len member in struct sockaddr_un"" >&5 cat > conftest.$ac_ext <<EOF -#line 8122 "configure" +#line 8121 "configure" #include "confdefs.h" #include <sys/types.h> @@ -8129,7 +8128,7 @@ static struct sockaddr_un x; x.sun_len = 1; ; return 0; } EOF -if { (eval echo configure:8133: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8132: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* echo "$ac_t""yes" 1>&6; { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_SOCKADDR_SUN_LEN @@ -8160,10 +8159,10 @@ echo $ac_n "checking for msgget""... $ac_c" 1>&6 -echo "configure:8164: checking for msgget" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8167 "configure" +echo "configure:8163: checking for msgget" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8166 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char msgget(); below. */ @@ -8186,7 +8185,7 @@ ; return 0; } EOF -if { (eval echo configure:8190: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8189: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_msgget=yes" else @@ -8201,15 +8200,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "sys/ipc.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/ipc.h""... $ac_c" 1>&6 -echo "configure:8205: checking for sys/ipc.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8208 "configure" +echo "configure:8204: checking for sys/ipc.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8207 "configure" #include "confdefs.h" #include <sys/ipc.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8213: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8212: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8226,15 +8225,15 @@ echo "$ac_t""yes" 1>&6 ac_safe=`echo "sys/msg.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/msg.h""... $ac_c" 1>&6 -echo "configure:8230: checking for sys/msg.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8233 "configure" +echo "configure:8229: checking for sys/msg.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8232 "configure" #include "confdefs.h" #include <sys/msg.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8238: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8237: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8272,15 +8271,15 @@ ac_safe=`echo "dirent.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for dirent.h""... $ac_c" 1>&6 -echo "configure:8276: checking for dirent.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8279 "configure" +echo "configure:8275: checking for dirent.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8278 "configure" #include "confdefs.h" #include <dirent.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8284: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8283: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8307,15 +8306,15 @@ echo "$ac_t""no" 1>&6 ac_safe=`echo "sys/dir.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/dir.h""... $ac_c" 1>&6 -echo "configure:8311: checking for sys/dir.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8314 "configure" +echo "configure:8310: checking for sys/dir.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8313 "configure" #include "confdefs.h" #include <sys/dir.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8319: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8318: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8348,15 +8347,15 @@ ac_safe=`echo "nlist.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for nlist.h""... $ac_c" 1>&6 -echo "configure:8352: checking for nlist.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8355 "configure" +echo "configure:8351: checking for nlist.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8354 "configure" #include "confdefs.h" #include <nlist.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8360: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8359: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8460,7 +8459,7 @@ echo "checking "for sound support"" 1>&6 -echo "configure:8464: checking "for sound support"" >&5 +echo "configure:8463: checking "for sound support"" >&5 case "$with_sound" in native | both ) with_native_sound=yes;; nas | no ) with_native_sound=no;; @@ -8471,15 +8470,15 @@ if test -n "$native_sound_lib"; then ac_safe=`echo "multimedia/audio_device.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for multimedia/audio_device.h""... $ac_c" 1>&6 -echo "configure:8475: checking for multimedia/audio_device.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8478 "configure" +echo "configure:8474: checking for multimedia/audio_device.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8477 "configure" #include "confdefs.h" #include <multimedia/audio_device.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8483: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8482: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8527,12 +8526,12 @@ if test -z "$native_sound_lib"; then echo $ac_n "checking for ALopenport in -laudio""... $ac_c" 1>&6 -echo "configure:8531: checking for ALopenport in -laudio" >&5 +echo "configure:8530: checking for ALopenport in -laudio" >&5 ac_lib_var=`echo audio'_'ALopenport | sed 'y%./+-%__p_%'` xe_check_libs=" -laudio " cat > conftest.$ac_ext <<EOF -#line 8536 "configure" +#line 8535 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -8543,7 +8542,7 @@ ALopenport() ; return 0; } EOF -if { (eval echo configure:8547: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8546: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8574,12 +8573,12 @@ if test -z "$native_sound_lib"; then echo $ac_n "checking for AOpenAudio in -lAlib""... $ac_c" 1>&6 -echo "configure:8578: checking for AOpenAudio in -lAlib" >&5 +echo "configure:8577: checking for AOpenAudio in -lAlib" >&5 ac_lib_var=`echo Alib'_'AOpenAudio | sed 'y%./+-%__p_%'` xe_check_libs=" -lAlib " cat > conftest.$ac_ext <<EOF -#line 8583 "configure" +#line 8582 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -8590,7 +8589,7 @@ AOpenAudio() ; return 0; } EOF -if { (eval echo configure:8594: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8593: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8628,15 +8627,15 @@ for dir in "machine" "sys" "linux"; do ac_safe=`echo "${dir}/soundcard.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ${dir}/soundcard.h""... $ac_c" 1>&6 -echo "configure:8632: checking for ${dir}/soundcard.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8635 "configure" +echo "configure:8631: checking for ${dir}/soundcard.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8634 "configure" #include "confdefs.h" #include <${dir}/soundcard.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8640: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8639: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8706,7 +8705,7 @@ fi LIBS="-laudio $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-laudio\" to \$LIBS"; fi cat > conftest.$ac_ext <<EOF -#line 8710 "configure" +#line 8709 "configure" #include "confdefs.h" #include <audio/Xtutil.h> EOF @@ -8733,7 +8732,7 @@ if test "$with_tty" = "yes" ; then echo "checking for TTY-related features" 1>&6 -echo "configure:8737: checking for TTY-related features" >&5 +echo "configure:8736: checking for TTY-related features" >&5 { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_TTY EOF @@ -8748,15 +8747,15 @@ ac_safe=`echo "termios.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for termios.h""... $ac_c" 1>&6 -echo "configure:8752: checking for termios.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8755 "configure" +echo "configure:8751: checking for termios.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8754 "configure" #include "confdefs.h" #include <termios.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8760: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8759: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8783,15 +8782,15 @@ echo "$ac_t""no" 1>&6 ac_safe=`echo "termio.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for termio.h""... $ac_c" 1>&6 -echo "configure:8787: checking for termio.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8790 "configure" +echo "configure:8786: checking for termio.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8789 "configure" #include "confdefs.h" #include <termio.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8795: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8794: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8824,12 +8823,12 @@ if test -z "$with_ncurses"; then echo $ac_n "checking for tgetent in -lncurses""... $ac_c" 1>&6 -echo "configure:8828: checking for tgetent in -lncurses" >&5 +echo "configure:8827: checking for tgetent in -lncurses" >&5 ac_lib_var=`echo ncurses'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -lncurses " cat > conftest.$ac_ext <<EOF -#line 8833 "configure" +#line 8832 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -8840,7 +8839,7 @@ tgetent() ; return 0; } EOF -if { (eval echo configure:8844: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8843: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -8873,15 +8872,15 @@ ac_safe=`echo "ncurses/curses.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ncurses/curses.h""... $ac_c" 1>&6 -echo "configure:8877: checking for ncurses/curses.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8880 "configure" +echo "configure:8876: checking for ncurses/curses.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8879 "configure" #include "confdefs.h" #include <ncurses/curses.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8885: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8884: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8903,15 +8902,15 @@ ac_safe=`echo "ncurses/term.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ncurses/term.h""... $ac_c" 1>&6 -echo "configure:8907: checking for ncurses/term.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8910 "configure" +echo "configure:8906: checking for ncurses/term.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8909 "configure" #include "confdefs.h" #include <ncurses/term.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8915: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8914: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8941,15 +8940,15 @@ c_switch_site="$c_switch_site -I/usr/include/ncurses" ac_safe=`echo "ncurses/curses.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ncurses/curses.h""... $ac_c" 1>&6 -echo "configure:8945: checking for ncurses/curses.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 8948 "configure" +echo "configure:8944: checking for ncurses/curses.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 8947 "configure" #include "confdefs.h" #include <ncurses/curses.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8953: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8952: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8984,12 +8983,12 @@ for lib in curses termlib termcap; do echo $ac_n "checking for tgetent in -l$lib""... $ac_c" 1>&6 -echo "configure:8988: checking for tgetent in -l$lib" >&5 +echo "configure:8987: checking for tgetent in -l$lib" >&5 ac_lib_var=`echo $lib'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -l$lib " cat > conftest.$ac_ext <<EOF -#line 8993 "configure" +#line 8992 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9000,7 +8999,7 @@ tgetent() ; return 0; } EOF -if { (eval echo configure:9004: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9003: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9031,12 +9030,12 @@ else echo $ac_n "checking for tgetent in -lcurses""... $ac_c" 1>&6 -echo "configure:9035: checking for tgetent in -lcurses" >&5 +echo "configure:9034: checking for tgetent in -lcurses" >&5 ac_lib_var=`echo curses'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -lcurses " cat > conftest.$ac_ext <<EOF -#line 9040 "configure" +#line 9039 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9047,7 +9046,7 @@ tgetent() ; return 0; } EOF -if { (eval echo configure:9051: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9050: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9065,12 +9064,12 @@ else echo "$ac_t""no" 1>&6 echo $ac_n "checking for tgetent in -ltermcap""... $ac_c" 1>&6 -echo "configure:9069: checking for tgetent in -ltermcap" >&5 +echo "configure:9068: checking for tgetent in -ltermcap" >&5 ac_lib_var=`echo termcap'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -ltermcap " cat > conftest.$ac_ext <<EOF -#line 9074 "configure" +#line 9073 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9081,7 +9080,7 @@ tgetent() ; return 0; } EOF -if { (eval echo configure:9085: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9084: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9129,15 +9128,15 @@ test -z "$with_gpm" && { ac_safe=`echo "gpm.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for gpm.h""... $ac_c" 1>&6 -echo "configure:9133: checking for gpm.h" >&5 - -cat > conftest.$ac_ext <<EOF -#line 9136 "configure" +echo "configure:9132: checking for gpm.h" >&5 + +cat > conftest.$ac_ext <<EOF +#line 9135 "configure" #include "confdefs.h" #include <gpm.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9141: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9140: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9160,12 +9159,12 @@ } test -z "$with_gpm" && { echo $ac_n "checking for Gpm_Open in -lgpm""... $ac_c" 1>&6 -echo "configure:9164: checking for Gpm_Open in -lgpm" >&5 +echo "configure:9163: checking for Gpm_Open in -lgpm" >&5 ac_lib_var=`echo gpm'_'Gpm_Open | sed 'y%./+-%__p_%'` xe_check_libs=" -lgpm " cat > conftest.$ac_ext <<EOF -#line 9169 "configure" +#line 9168 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9176,7 +9175,7 @@ Gpm_Open() ; return 0; } EOF -if { (eval echo configure:9180: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9179: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9225,17 +9224,17 @@ echo "checking for database support" 1>&6 -echo "configure:9229: checking for database support" >&5 +echo "configure:9228: checking for database support" >&5 if test "$with_database_gnudbm" != "no"; then echo $ac_n "checking for dbm_open in -lgdbm""... $ac_c" 1>&6 -echo "configure:9234: checking for dbm_open in -lgdbm" >&5 +echo "configure:9233: checking for dbm_open in -lgdbm" >&5 ac_lib_var=`echo gdbm'_'dbm_open | sed 'y%./+-%__p_%'` xe_check_libs=" -lgdbm " cat > conftest.$ac_ext <<EOF -#line 9239 "configure" +#line 9238 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9246,7 +9245,7 @@ dbm_open() ; return 0; } EOF -if { (eval echo configure:9250: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9249: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9268,10 +9267,10 @@ if test "$with_database_gnudbm" != "yes"; then echo $ac_n "checking for dbm_open""... $ac_c" 1>&6 -echo "configure:9272: checking for dbm_open" >&5 - -cat > conftest.$ac_ext <<EOF -#line 9275 "configure" +echo "configure:9271: checking for dbm_open" >&5 + +cat > conftest.$ac_ext <<EOF +#line 9274 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char dbm_open(); below. */ @@ -9294,7 +9293,7 @@ ; return 0; } EOF -if { (eval echo configure:9298: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9297: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_dbm_open=yes" else @@ -9330,10 +9329,10 @@ if test "$with_database_dbm" != "no"; then echo $ac_n "checking for dbm_open""... $ac_c" 1>&6 -echo "configure:9334: checking for dbm_open" >&5 - -cat > conftest.$ac_ext <<EOF -#line 9337 "configure" +echo "configure:9333: checking for dbm_open" >&5 + +cat > conftest.$ac_ext <<EOF +#line 9336 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char dbm_open(); below. */ @@ -9356,7 +9355,7 @@ ; return 0; } EOF -if { (eval echo configure:9360: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9359: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_dbm_open=yes" else @@ -9377,12 +9376,12 @@ if test "$need_libdbm" != "no"; then echo $ac_n "checking for dbm_open in -ldbm""... $ac_c" 1>&6 -echo "configure:9381: checking for dbm_open in -ldbm" >&5 +echo "configure:9380: checking for dbm_open in -ldbm" >&5 ac_lib_var=`echo dbm'_'dbm_open | sed 'y%./+-%__p_%'` xe_check_libs=" -ldbm " cat > conftest.$ac_ext <<EOF -#line 9386 "configure" +#line 9385 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9393,7 +9392,7 @@ dbm_open() ; return 0; } EOF -if { (eval echo configure:9397: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9396: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9430,10 +9429,10 @@ if test "$with_database_berkdb" != "no"; then echo $ac_n "checking for dbopen""... $ac_c" 1>&6 -echo "configure:9434: checking for dbopen" >&5 - -cat > conftest.$ac_ext <<EOF -#line 9437 "configure" +echo "configure:9433: checking for dbopen" >&5 + +cat > conftest.$ac_ext <<EOF +#line 9436 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char dbopen(); below. */ @@ -9456,7 +9455,7 @@ ; return 0; } EOF -if { (eval echo configure:9460: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9459: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_dbopen=yes" else @@ -9477,12 +9476,12 @@ if test "$need_libdb" != "no"; then echo $ac_n "checking for dbopen in -ldb""... $ac_c" 1>&6 -echo "configure:9481: checking for dbopen in -ldb" >&5 +echo "configure:9480: checking for dbopen in -ldb" >&5 ac_lib_var=`echo db'_'dbopen | sed 'y%./+-%__p_%'` xe_check_libs=" -ldb " cat > conftest.$ac_ext <<EOF -#line 9486 "configure" +#line 9485 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9493,7 +9492,7 @@ dbopen() ; return 0; } EOF -if { (eval echo configure:9497: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9496: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -9517,7 +9516,7 @@ if test "$with_database_berkdb" = "yes"; then for path in "db/db.h" "db.h"; do cat > conftest.$ac_ext <<EOF -#line 9521 "configure" +#line 9520 "configure" #include "confdefs.h" #ifdef HAVE_INTTYPES_H #define __BIT_TYPES_DEFINED__ @@ -9535,7 +9534,7 @@ ; return 0; } EOF -if { (eval echo configure:9539: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:9538: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* db_h_path="$path"; break else @@ -9587,12 +9586,12 @@ if test "$with_socks" = "yes"; then echo $ac_n "checking for SOCKSinit in -lsocks""... $ac_c" 1>&6 -echo "configure:9591: checking for SOCKSinit in -lsocks" >&5 +echo "configure:9590: checking for SOCKSinit in -lsocks" >&5 ac_lib_var=`echo socks'_'SOCKSinit | sed 'y%./+-%__p_%'` xe_check_libs=" -lsocks " cat > conftest.$ac_ext <<EOF -#line 9596 "configure" +#line 9595 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -9603,7 +9602,7 @@ SOCKSinit() ; return 0; } EOF -if { (eval echo configure:9607: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9606: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -10579,9 +10578,9 @@ cd $dir rm -f junk.c < Makefile.in \ - sed -e 's/^# Generated.*//' \ + sed -e '/^# Generated/d' \ -e 's%/\*\*/#.*%%' \ - -e 's/^[ \f\t]*#[ \f\t]*/#/' \ + -e 's/^ *# */#/' \ -e '/^##/d' \ -e '/^#/ { p @@ -10594,8 +10593,8 @@ $CPP -I. -I${top_srcdir}/src $CPPFLAGS junk.c > junk.cpp; < junk.cpp \ sed -e 's/^#.*//' \ - -e 's/^[ \f\t][ \f\t]*$//' \ - -e 's/^ / /' \ + -e 's/^[ ][ ]*$//' \ + -e 's/^ / /' \ | sed -n -e '/^..*$/p' \ | sed '/^"/ { s/\\\([\"]\)/\1/g @@ -10605,7 +10604,7 @@ chmod 444 Makefile.new mv -f Makefile.new Makefile rm -f junk.c junk.cpp - ) +) done exit 0
--- a/configure.in Mon Aug 13 09:43:39 2007 +0200 +++ b/configure.in Mon Aug 13 09:44:42 2007 +0200 @@ -1749,9 +1749,11 @@ dnl The value of CPP is a quoted variable reference, so we need to do this dnl to get its actual value... CPP=`eval "echo $CPP"` +define(TAB, [ ])dnl +changequote(, )dnl eval `$CPP -Isrc $tempcname \ - | [sed -n -e "s/[ \t]*=[ \t\"]*/='/" -e "s/[ \t\"]*\$/'/" -e "s/^configure___//p"`] - + | sed -n -e "s/[ TAB]*=[ TAB\"]*/='/" -e "s/[ TAB\"]*\$/'/" -e "s/^configure___//p"` +changequote([, ])dnl dnl if test -z "$SPECIFIED_CFLAGS"; then dnl eval `$CPP -Isrc -DTHIS_IS_CONFIGURE $tempcname \ dnl | sed -n -e "s/ *=[[ \"]]*/='/" -e "s/[[ \"]]*\$/'/" -e "s/^configure___//p"` @@ -1878,7 +1880,7 @@ dnl --site-runtime-libraries (multiple dirs) if test -n "$site_runtime_libraries" ; then - LD_RUN_PATH="`echo $site_runtime_libraries | sed 's/ */:/'`" + LD_RUN_PATH="`echo $site_runtime_libraries | sed -e 's/ */:/g'`" export LD_RUN_PATH fi @@ -1937,8 +1939,8 @@ define([XE_COMPUTE_RUNPATH],[ if test "$add_runtime_path" = "yes" -a -n "$dash_r"; then dnl Remove runtime paths from current ld switches - ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[[^ ]]*//"` - ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[[^ ]]*//"` + ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[[^ ]]*//g"` + ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[[^ ]]*//g"` dnl PRINT_VAR(ld_switch_site ld_switch_x_site) dnl Fix up Runtime path @@ -2128,7 +2130,7 @@ fi dnl Link with "-z ignore" on Solaris if supported -if test "$opsys" = "sol2" -a "${OS_RELEASE:-0}" -ge 56; then +if test "$opsys" = "sol2" && test "$OS_RELEASE" -ge 56; then AC_MSG_CHECKING(for \"-z ignore\" linker flag) case "`ld -h 2>&1`" in *-z\ ignore\|record* ) AC_MSG_RESULT(yes) @@ -3478,13 +3480,14 @@ AC_OUTPUT($internal_makefile_list,[ for dir in $MAKE_SUBDIR; do echo creating $dir/Makefile - ([ + ( +changequote(<<, >>)dnl cd $dir rm -f junk.c < Makefile.in \ - sed -e 's/^# Generated.*//' \ + sed -e '/^# Generated/d' \ -e 's%/\*\*/#.*%%' \ - -e 's/^[ \f\t]*#[ \f\t]*/#/' \ + -e 's/^ *# */#/' \ -e '/^##/d' \ -e '/^#/ { p @@ -3497,8 +3500,8 @@ $CPP -I. -I${top_srcdir}/src $CPPFLAGS junk.c > junk.cpp; < junk.cpp \ sed -e 's/^#.*//' \ - -e 's/^[ \f\t][ \f\t]*$//' \ - -e 's/^ / /' \ + -e 's/^[ TAB][ TAB]*$//' \ + -e 's/^ /TAB/' \ | sed -n -e '/^..*$/p' \ | sed '/^"/ { s/\\\([\"]\)/\1/g @@ -3508,7 +3511,8 @@ chmod 444 Makefile.new mv -f Makefile.new Makefile rm -f junk.c junk.cpp - ]) +changequote([, ])dnl +) done ], [CPP="$CPP"
--- a/etc/HELLO Mon Aug 13 09:43:39 2007 +0200 +++ b/etc/HELLO Mon Aug 13 09:44:42 2007 +0200 @@ -2,7 +2,7 @@ Please correct this incomplete list and add more! --------------------------------------------------------- -Amharic ($(2"S!,!6!l(B) $(2#Q!$!.(B +Amharic ($(3"c!<!N"^(B) $(3!A!,!>(B Arabic [2](38R(47d(3T!JSa(4W(3W[0](B Croatian Zdravo Danish (Dansk) Hej, Goddag @@ -25,7 +25,7 @@ Spanish (Espa,Aq(Bol) ,A!(BHola! Swedish (Svenska) Hej, Goddag Thai (,T@RIRd7B(B) ,TJ0GQ1J04U1$0CQ1:(B, ,TJ0GQ1J04U10$h1P(B -Tigrigna ($(2!V#>!6!l(B) $(2"C!$!,!V(B +Tigrigna ($(3"8#r!N"^(B) $(3!Q!,!<"8(B Turkish (T,A|(Brk,Ag(Be) Merhaba Vietnamese (Ti,1*(Bng Vi,1.(Bt) Ch,1`(Bo b,1U(Bn
--- a/etc/NEWS Mon Aug 13 09:43:39 2007 +0200 +++ b/etc/NEWS Mon Aug 13 09:44:42 2007 +0200 @@ -109,28 +109,28 @@ * Changes in XEmacs 20.3 ======================== -** .xemacs is loaded at startup if it exists. +** Startup file additions. By default XEmacs now loads the user file ~/.xemacs if it exists. If -there is no such file, it reads ~/.emacs as usual. If both .xemacs and -.emacs exist, XEmacs will only load .xemacs. +there is no such file, it reads ~/.emacs as usual. If both .xemacs +and .emacs exist, XEmacs will only load .xemacs. + +Customizable options are now saved to ~/.xemacs-custom file, which is +normally loaded after .emacs. ** Quail input method is now available. -#### Need something to say about quail. - -** arc-mode has a new function called `archive-quit' bound to q. - -This function quits archive mode in the same fashion dired-quit works. +Quail is a simple key-translation system which allows users to input +any multilingual text from normal ASCII keyboard. This means that +XEmacs with Mule now supports a number of European languages. ** XEmacs runs on Windows NT. Thanks to David Hobley <davidh@wr.com.au> and Marc Paquette <marcpa@cam.org>, XEmacs now runs on Windows NT. -For now, you need an X server to be able to run it, but Marc is -working on a port that implements a native NT device. We need *your* -help. +There are plans to hire contractors to do a native, professional +port. This might be over for the 20.3 final release. ** Multiple TTY frames are now available. @@ -146,6 +146,13 @@ current buffer and deletes the selected window. It asks for confirmation first. +** arc-mode has a new function called `archive-quit' bound to q, which +quits archive mode in the same fashion dired-quit works. + +** The feature to teach the key bindings of extended commands after +the command finishes. The message suggesting key bindings appears +temporarily in the echo area. The previous echo area contents come + ** XEmacs can now save the minibuffer histories from various minibuffers. To use this feature, add the line: @@ -246,6 +253,11 @@ write the output to a specified file. Like `progn', it returns the value of the last form. +** The variable `debug-ignored-errors' now works in XEmacs. It allows +one to ignore the debugger for some common errors, even when +`debug-on-error' is t. It has no effect when `debug-on-signal' is +non-nil. + * Changes in XEmacs 20.2
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/custom/face.xpm Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,28 @@ +/* XPM */ +static char *face[] = { +/* width height num_colors chars_per_pixel */ +" 17 17 4 1", +/* colors */ +". c #000000", +"a c #a8b038", +"b c #f8f800", +"c s None c None", +/* pixels */ +"ccccccccccccccccc", +"ccccccccccccccccc", +"cccccbbbbbbcccccc", +"ccccbbbbbbbbccccc", +"cccbbbbbbbbbbcccc", +"ccbbbbbbbbbbbbccc", +"cbbaaabbbbaaabbcc", +"cbbbbbbbbbbbbbbcc", +"cbbbbbbaabbbbbbcc", +"cbbbbbbaabbbbbbcc", +"cbbbbbbaabbbbbbcc", +"cbbbbbaaaabbbbbcc", +"ccbbabbbbbbabbccc", +"cccbbabbbbabbcccc", +"ccccbbaaaabbccccc", +"cccccbbbbbbcccccc", +"ccccccccccccccccc" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/custom/folder.xpm Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,28 @@ +/* XPM */ +static char *folder[] = { +/* width height num_colors chars_per_pixel */ +" 17 17 4 1", +/* colors */ +". c #000000", +"a c #a8b038", +"b c #f8f800", +"c s None c None", +/* pixels */ +"ccccccccccccccccc", +"ccccccccccccccccc", +"ccccccccccccccccc", +"ccccccccccccccccc", +"cccccccccaaaaaacc", +"ccccccccaaaaaaacc", +"cc......a.a.a.aac", +"c.bbbbbbbbbbbbb.c", +".bbbbbbbbbbbbbb.c", +".bbbbbbbbbbbbbb.c", +".bbbbbbbbbbbbbb.c", +".bbbbbbbbbbbbbb.c", +".bbbbbbbbbbbbbb.c", +".bbbbbbbbbbbbbb.c", +".bbbbbbbbbbbbbb.c", +".bbbbbbbbbbbbbb.c", +"a..............ac" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/custom/option.xpm Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,28 @@ +/* XPM */ +static char *option[] = { +/* width height num_colors chars_per_pixel */ +" 17 17 4 1", +/* colors */ +". c #000000", +"a c #a8b038", +"b c #f8f800", +"c s None c None", +/* pixels */ +"ccccccccccccccccc", +"ccccccccccccccccc", +"cccccbbbbbbcccccc", +"ccccbbbbbbbbccccc", +"cccbbbaaaabbbcccc", +"ccbbbaaaaaabbbccc", +"cbbbaabbbaabbbbcc", +"cbbbaababaabbbbcc", +"cbbbbbbbaabbbbbcc", +"cbbbbbbaabbbbbbcc", +"cbbbbbbaabbbbbbcc", +"cbbbbbbbbbbbbbbcc", +"ccbbbbbaabbbbbccc", +"cccbbbbaabbbbcccc", +"ccccbbbbbbbbccccc", +"cccccbbbbbbcccccc", +"ccccccccccccccccc" +};
--- a/etc/w3/stylesheet Mon Aug 13 09:43:39 2007 +0200 +++ b/etc/w3/stylesheet Mon Aug 13 09:44:42 2007 +0200 @@ -129,8 +129,8 @@ dt { font-weight: bold; display: list-item } dd { display: list-item; margin-left: 5em; } li { display: list-item; margin-left: 5em; } + ol li { list-style: decimal; } ul li { list-style: circle; } - ol li { list-style: decimal; } /* These are to make nested list items look better */ ul ul,ol ul,ol ol,ul ol { display: line; }
--- a/lib-src/ChangeLog Mon Aug 13 09:43:39 2007 +0200 +++ b/lib-src/ChangeLog Mon Aug 13 09:44:42 2007 +0200 @@ -1,3 +1,15 @@ +1997-06-24 Steven L Baur <steve@altair.xemacs.org> + + * gnuattach: Needed executable bit set. + Suggested by Kyle Jones <kyle_jones@wonderworks.com> + + * update-elc.sh (ignore_pattern): lisp/language/ethiopic byte + compiles now. + +1997-06-24 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * update-autoloads.sh: Search lisp/mule/. + 1997-06-20 Steven L Baur <steve@altair.xemacs.org> * gnuattach: Readd as warning script.
--- a/lib-src/update-autoloads.sh Mon Aug 13 09:43:39 2007 +0200 +++ b/lib-src/update-autoloads.sh Mon Aug 13 09:44:42 2007 +0200 @@ -30,7 +30,6 @@ -a $dir != lisp/SCCS \ -a $dir != lisp/egg \ -a $dir != lisp/its \ - -a $dir != lisp/mule \ -a $dir != lisp/language \ -a $dir != lisp/leim; then dirs="$dirs $dir"
--- a/lib-src/update-elc.sh Mon Aug 13 09:43:39 2007 +0200 +++ b/lib-src/update-elc.sh Mon Aug 13 09:44:42 2007 +0200 @@ -108,14 +108,15 @@ #make_special vm #make_special ediff elc #make_special viper elc +make_special auctex some +make_special cc-mode all make_special efs x20 +make_special eos -k # not strictly necessary... make_special gnus some -make_special w3 xemacs-w3 make_special hyperbole elc +make_special ilisp elc make_special oobr HYPB_ELC='' elc -make_special eos -k # not strictly necessary... -make_special ilisp elc -make_special auctex some +make_special w3 xemacs-w3 ignore_pattern='' for dir in $ignore_dirs ; do @@ -144,7 +145,6 @@ \!/sunpro/sunpro-load.el$!d \!/tooltalk/tooltalk-load.el$!d \!/language/devanagari.el$!d -\!/language/ethiopic.el$!d \!/language/indian.el$!d \!/language/lao-util.el$!d \!/language/lao.el$!d
--- a/lisp/ChangeLog Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 09:44:42 2007 +0200 @@ -1,3 +1,172 @@ +1997-06-25 Steven L Baur <steve@altair.xemacs.org> + + * x11/x-menubar.el(default-menubar): Comment out changes to the + Mule menu because they bombed after recompilation. + + * packages/hyper-apropos.el + (hyper-apropos-toggle-programming-flag): Use `with-current-buffer' + instead of `eval-in-buffer'. + + * term/sun-mouse.el: Remove bogus redefinition of + `eval-in-buffer'. + (sun-mouse-handler): Use with-current-buffer instead of + `eval-in-buffer'. + + * prim/make-docfile.el: Use princ not print. + Suggested by Hrvoje Niksic. + + * packages/info.el (Info-select-node): Desensitive case search for + Note:. + (Info-next-reference): Ditto. + * prim/simple.el (kill-region): Adjust endpoints of extent to + test and deal with case of the end being less than the beginning. + * prim/cmdloop.el (teach-extended-commands-timeout): Bump value to 4. + From Hrvoje Niksic <hniksic@srce.hr> + + * prim/subr.el (eval-in-buffer): Make obsolete. + Suggested by Hrvoje Niksic. + + * packages/hyper-apropos.el (hyper-apropos-faces): Change group to + 'faces. + Suggested by Per Abrahamsen. + +1997-06-23 Hrvoje Niksic <hniksic@srce.hr> + + * prim/cmdloop.el (execute-extended-command): Print message after + the command finishes, and restore old echo-area contents. + + - Get keybinding before command is executed. + Suggested by Kyle Jones and Steve Baur. + +1997-06-24 Steven L Baur <steve@altair.xemacs.org> + + * packages/gnuserv.el: Make old symbols Obsolete. + From Hrvoje Niksic <hniksic@srce.hr> + + * prim/cmdloop.el (keyboard-quit): Don't kill zmacs-region in + minibuffer. + * prim/minibuf.el (minibuffer-keyboard-quit): Ditto. + From Hrvoje Niksic <hniksic@srce.hr> + + * prim/help.el (help-mode-quit): Bury buffer when quitting. + From Hrvoje Niksic <hniksic@srce.hr> + +1997-06-24 Hrvoje Niksic <hniksic@srce.hr> + + * prim/cmdloop.el: Customize `teach-extended-commands-p' and + `teach-extended-commands-timeout'. + +1997-06-23 Steven L Baur <steve@altair.xemacs.org> + + * version.el (emacs-version): Synch with InfoDock 4.0. + (emacs-version): Ditto. + +Mon Jun 23 12:33:52 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * about.el (about-show-linked-info): Use empty strings for + `widget-link-prefix' and `widget-link-suffix'. + +1997-06-22 Gary D. Foster <Gary.Foster@corp.Sun.COM> + + * x11/x-menubar.el: Added `bookmark-menu-filter', changed + bookmark submenu from a popup to a cascading submenu. + * packages/bookmark.el: Added an autoload cookie for + `bookmark-all-names' (by Steve Baur) + +1997-06-23 Hrvoje Niksic <hniksic@srce.hr> + + * packages/info.el (Info-next-reference): Fix up for M-TAB to work + correctly. + + * utils/live-icon.el (live-icon-one-frame): Don't set glyphs to + balloon-help frames. + + * packages/balloon-help.el (balloon-help-make-help-frame): Set the + `balloon-help' property to the newly created frame. + + * prim/profile.el (profile): New macro. + + * prim/files.el (auto-mode-alist): Add winmgr-mode. + + * modes/winmgr-mode.el: Customize. + +1997-06-23 Steven L Baur <steve@altair.xemacs.org> + + * utils/autoload.el (generate-file-autoloads-1): Remove warning + about 900 character lines. + + * x11/x-toolbar.el (toolbar-mail-commands-alist): Correction for + calling Netscape mail. + From Hrvoje Niksic <hniksic@srce.hr> + +1997-06-22 Steven L Baur <steve@altair.xemacs.org> + + * x11/x-menubar.el (default-menubar): Make `Jump to bookmark' menu + dynamic. + From Gary D. Foster <Gary.Foster@Corp.Sun.COM> + + * prim/dumped-lisp.el (dumped-lisp-packages): Sparcworks dumps + comint and ring. + +1997-06-24 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * language/arabic.el: moved from mule/arabic-hooks.el. + + * mh-e/mh-e.el (mh-get-new-mail): Decode output as + `mh-folder-coding-system'. + +1997-06-24 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * language/ethio-util.el: imported from Emacs/mule-19.34.94-zeta. + + * language/arabic-util.el: moved from mule/arabic.el; repair + Arabic characters. + +1997-06-24 MORIOKA Tomohiko <morioka@jaist.ac.jp> + + * x11/x-menubar.el: Fix "Describe language support" and "Set + language environment" of Mule menu. + + * language/visual-mode.el: moved from mule/. + + * language/ethiopic.el: Modify for XEmacs. + + * language/cyrillic.el: Modify DOC-string of koi8-r; Fixed problem + of setting for `language-info-alist' about koi8-r. + + * mule/auto-autoloads.el: Enable auto-autoloads.el for mule/. + + * mule/mule-util.el: New file (imported from + Emacs/mule-19.34.94-zeta). + + * mule/mule-misc.el: Function `truncate-string-to-width' was moved + to mule-util.el. + + * prim/dumped-lisp.el, mule/mule-load.el: mule/arabic-hooks.el was + moved to language/arabic.el; mule/arabic.el was moved to + language/arabic-util.el; Use language/ethiopic.el instead of + mule/ethiopic-hooks.el; Use language/ethio-util.el instead of + mule/ethiopic.el. + + * mule/mule-coding.el (coding-system-docstring): New alias (to + emulate Emacs/mule-19.34.94-zeta function). + + * mule/mule-cmds.el: modified to sync with + Emacs/mule-19.34.94-zeta (mule-prefix was changed to "C-x C-m") + + (set-language-info): Add to "Describe Language Support" and "Set + Language Environment" menu. + + * mule/mule-charset.el: Function `compose-region' and + `decompose-region' were moved to mule-util.el. + + * leim/quail.el: modify to sync with latest quail.el of Emacs/mule + in ETL. + + (quail-toggle-mode-temporarily): check `quail-conv-overlay'. + + (quail-map-p): Use `characterp' instead of `integerp'. + 1997-06-21 Steven L Baur <steve@altair.xemacs.org> * prim/tabify.el (untabify): Return nil. @@ -8,6 +177,8 @@ 1997-06-21 Hrvoje Niksic <hniksic@srce.hr> + * packages/bookmark.el (bookmark-menu-popup-paned-menu): Change + title to name. * prim/overlay.el (overlay-put): Support `local-map'. (overlay-get): Support `category'.
--- a/lisp/apel/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/apel/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/auctex/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/auctex/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -66,7 +66,6 @@ (put 'browse-url 'custom-loads '()) (put 'LaTeX-indentation 'custom-loads '("latex")) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'LaTeX 'custom-loads '("latex" "tex")) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '())
--- a/lisp/bytecomp/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/bytecomp/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/calendar/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/calendar/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '("calendar")) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/ANNOUNCEMENT Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,54 @@ +Release Announcement +CC Mode Version 5.11 +Barry A. Warsaw <cc-mode-help@python.org> + +This message announces the available of a new version of CC Mode, a +GNU Emacs mode for editing C (ANSI and K&R), C++, Objective-C, and +Java code. A list of user visible changes is available from +<http://www.python.org/ftp/emacs/cc-details.html>. + +Since the distribution is fairly large and since it is readily +available via the Web, anonymous ftp, and email, the source code is +not being posted here. Downloading instructions are provided further +down in this message. + +If you want to become a beta tester send subscribe requests to +cc-mode-victims-request@python.org. If you just want announcements of +new versions, send subscribe requests to +cc-mode-announce-request@python.org. You do not need to subscribe to +both of these lists! These mailing lists are maintained by the +Majordomo automated mailing list software. + +Getting CC Mode +=============== + +The canonical ftp site for the full CC Mode tar distribution is: + + <ftp://ftp.python.org/pub/emacs/cc-mode.tar.gz> + +This is a gzip'd tar file containing the .el source code and +documentation, along with sundry other useful files. See the MANIFEST +a complete list of the contained files. You can get individual files +from the directory: + + <ftp://ftp.python.org/pub/emacs/cc-mode/> + +Find out more about CC Mode on the Web: + + <http://www.python.org/ftp/emacs/> + +For those of you without anon-ftp access, you can use the DEC +ftpmail'er at the address ftpmail@decwrl.dec.com. Send the following +message in the body of your mail to that address to get CC Mode: + +reply <a valid net address back to you> +connect ftp.python.org +binary +uuencode +chdir pub/emacs +get cc-mode.tar.gz + +or just send the message "help" for more information on ftpmail. +Response times will vary with the number of requests in the queue. +Note that I am in no way connected with the DEC ftpmail'er so you are +own your own with this route.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/MANIFEST Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,28 @@ +Manifest for CC Mode 5.11 +Barry A. Warsaw <cc-mode-help@python.org> + +You should have received the following files in this distribution: + + MANIFEST: This file. + + README: Quick intro into how to get CC Mode up and running. + + Makefile: for byte-compiling the source code + + cc-align.el, cc-auto.el, cc-cmds.el, cc-engine.el, cc-langs.el, + cc-menus.el, cc-mode.el, cc-styles.el, cc-vars.el: The source code + + cc-compat.el: Helps ease the transition from c-mode.el to cc-mode + style indentation control. This is provided for your convenience + only, and is completely unguaranteed and unsupported. + + cc-guess.el: Experiments in style guessing. This is provided for + your convenience only, and is completely unguaranteed and + unsupported. + + cc-lobotomy.el: Performance vs. accuracy trade-offs. + + cc-mode.texi: The latest CC-Mode Texinfo manual. + + ANNOUNCEMENT: Release announcement as it appeared on various + forums.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/Makefile Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,27 @@ +# Modified by slb for integration with XEmacs. + +EMACS = xemacs + +OPTS = -batch -q -no-site-file + +CMD = -f batch-byte-compile + +PRELOADS = -l ./cc-vars.el -l ./cc-mode.el -l ./cc-menus.el -l ./cc-langs.el + +SPECIAL_ELCS = custom-load.elc + +.el.elc: + $(EMACS) $(OPTS) $(PRELOADS) $(CMD) $< + +ALL_ELCS = \ + cc-align.elc cc-auto.elc cc-cmds.elc cc-compat.elc \ + cc-engine.elc cc-langs.elc cc-menus.elc cc-mode.elc \ + cc-styles.elc cc-vars.elc + +all: $(ALL_ELCS) $(SPECIAL_ELCS) + +custom-load.elc: custom-load.el + $(EMACS) $(OPTS) $(CMD) $< + +clean: + -rm $(ALL_ELCS)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/README Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,28 @@ +README for CC Mode 5.11 +Barry A. Warsaw <cc-mode-help@python.org> + +Please read the cc-mode.texi manual for details on using CC Mode. + +As of this writing (23-May-1997), CC Mode version 5 currently works +out of the box only with XEmacs 19.15 and XEmacs 20.0. Emacs 19.34 is +missing some stuff that CC Mode requires, and while Emacs 19.35 has +not yet been release, it is expected to work with CC Mode. Check the +CC Mode web pages <http://www.python.org/~bwarsaw/betas/index.html> +for details. + +Preformatted versions of the manual in DVI, PostScript, and Info, are +all available at <http://www.python.org/~bwarsaw/betas/index.html>. + +To build the manual yourself, you will need the latest Texinfo release +(currently Texinfo 3.9). Specifically, you must make sure that your +are using at least version 2.185 of the texinfo.tex file. To build +the Info manual, simply type: + + % makeinfo cc-mode.texi + +To make the DVI version, simply type: + + % texi2dvi cc-mode.texi + +The MANIFEST file contains a description of all the files you should +have gotten with this distribution.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/auto-autoloads.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,103 @@ +;;; DO NOT MODIFY THIS FILE +(if (not (featurep 'cc-mode-autoloads)) + (progn + +;;;### (autoloads (java-mode objc-mode c++-mode c-mode) "cc-mode" "cc-mode/cc-mode.el") + +(autoload '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. + +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. + +Key bindings: +\\{c-mode-map}" t nil) + +(autoload 'c++-mode "cc-mode" "\ +Major mode for editing 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. + +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. + +Key bindings: +\\{c++-mode-map}" t nil) + +(autoload 'objc-mode "cc-mode" "\ +Major mode for editing Objective C code. +To submit a problem report, enter `\\[c-submit-bug-report]' from an +objc-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 `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. + +Key bindings: +\\{objc-mode-map}" t nil) + +(autoload 'java-mode "cc-mode" "\ +Major mode for editing Java code. +To submit a problem report, enter `\\[c-submit-bug-report]' from an +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 +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'. + +Key bindings: +\\{java-mode-map}" t nil) + +;;;*** + +;;;### (autoloads (c-add-style c-set-style) "cc-styles" "cc-mode/cc-styles.el") + +(autoload 'c-set-style "cc-styles" "\ +Set CC Mode variables to use one of several different indentation styles. +STYLENAME is a string representing the desired style from the list of +styles described in the variable `c-style-alist'. See that variable +for details of setting up styles. + +The variable `c-indentation-style' always contains the buffer's current +style name." t nil) + +(autoload '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: + + ([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) + +;;;*** + +(provide 'cc-mode-autoloads) +))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/cc-align.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,400 @@ +;;; cc-align.el --- custom indentation functions for CC Mode + +;; Copyright (C) 1985,87,92,93,94,95,96,97 Free Software Foundation, Inc. + +;; Authors: 1992-1997 Barry A. Warsaw +;; 1987 Dave Detlefs and Stewart Clamen +;; 1985 Richard M. Stallman +;; Maintainer: cc-mode-help@python.org +;; Created: 22-Apr-1997 (split from cc-mode.el) +;; Version: 5.11 +;; Keywords: c languages oop + +;; 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. + + +(eval-when-compile + (load-file "./cc-engine.el")) + +(defsubst c-langelem-col (langelem &optional preserve-point) + ;; convenience routine to return the column of langelem's relpos. + ;; Leaves point at the relpos unless preserve-point is non-nil. + (let ((here (point))) + (goto-char (cdr langelem)) + (prog1 (current-column) + (if preserve-point + (goto-char here)) + ))) + + +;; Standard indentation line-ups +(defun c-lineup-arglist (langelem) + ;; lineup the current arglist line with the arglist appearing just + ;; after the containing paren which starts the arglist. + (save-excursion + (let* ((containing-sexp + (save-excursion + ;; arglist-cont-nonempty gives relpos == + ;; to boi of containing-sexp paren. This + ;; is good when offset is +, but bad + ;; when it is c-lineup-arglist, so we + ;; have to special case a kludge here. + (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty)) + (progn + (beginning-of-line) + (backward-up-list 1) + (skip-chars-forward " \t" (c-point 'eol))) + (goto-char (cdr langelem))) + (point))) + (langelem-col (c-langelem-col langelem t))) + (if (save-excursion + (beginning-of-line) + (looking-at "[ \t]*)")) + (progn (goto-char (match-end 0)) + (forward-sexp -1) + (forward-char 1) + (c-forward-syntactic-ws) + (- (current-column) langelem-col)) + (goto-char containing-sexp) + (or (eolp) + (not (memq (following-char) '(?{ ?\( ))) + (let ((eol (c-point 'eol)) + (here (progn + (forward-char 1) + (skip-chars-forward " \t") + (point)))) + (c-forward-syntactic-ws) + (if (< (point) eol) + (goto-char here)))) + (- (current-column) langelem-col) + )))) + +(defun c-lineup-arglist-intro-after-paren (langelem) + ;; lineup an arglist-intro line to just after the open paren + (save-excursion + (let ((langelem-col (c-langelem-col langelem t)) + (ce-curcol (save-excursion + (beginning-of-line) + (backward-up-list 1) + (skip-chars-forward " \t" (c-point 'eol)) + (current-column)))) + (- ce-curcol langelem-col -1)))) + +(defun c-lineup-arglist-close-under-paren (langelem) + ;; lineup an arglist-intro line to just after the open paren + (save-excursion + (let ((langelem-col (c-langelem-col langelem t)) + (ce-curcol (save-excursion + (beginning-of-line) + (backward-up-list 1) + (current-column)))) + (- ce-curcol langelem-col)))) + +(defun c-lineup-streamop (langelem) + ;; lineup stream operators + (save-excursion + (let ((langelem-col (c-langelem-col langelem))) + (re-search-forward "<<\\|>>" (c-point 'eol) 'move) + (goto-char (match-beginning 0)) + (- (current-column) langelem-col)))) + +(defun c-lineup-multi-inher (langelem) + ;; line up multiple inheritance lines + (save-excursion + (let ((eol (c-point 'eol)) + (here (point)) + (langelem-col (c-langelem-col langelem))) + (skip-chars-forward "^:" eol) + (skip-chars-forward " \t:" eol) + (if (or (eolp) + (looking-at c-comment-start-regexp)) + (c-forward-syntactic-ws here)) + (- (current-column) langelem-col) + ))) + +(defun c-lineup-java-inher (langelem) + ;; line up Java implements and extends continuations + (save-excursion + (let ((langelem-col (c-langelem-col langelem))) + (forward-word 1) + (if (looking-at "[ \t]*$") + langelem-col + (c-forward-syntactic-ws) + (- (current-column) langelem-col))))) + +(defun c-lineup-java-throws (langelem) + ;; lineup func-decl-cont's in Java which are continuations of throws + ;; declarations. If `throws' starts the previous line, line up to + ;; just after that keyword. If not, lineup under the previous line. + (save-excursion + (let ((iopl (c-point 'iopl)) + (langelem-col (c-langelem-col langelem t)) + (extra 0)) + (back-to-indentation) + (cond + ((looking-at "throws[ \t\n]") + (goto-char (cdr langelem)) + (setq extra c-basic-offset)) + ((and (goto-char iopl) + (looking-at "throws[ \t\n]")) + (forward-word 1) + (skip-chars-forward " \t") + (when (eolp) + (back-to-indentation) + (setq extra c-basic-offset))) + (t (goto-char iopl))) + (+ (- (current-column) langelem-col) extra)))) + +(defun c-lineup-C-comments (langelem) + ;; line up C block comment continuation lines + (save-excursion + (let ((here (point)) + (stars (progn (back-to-indentation) + (skip-chars-forward "*"))) + (langelem-col (c-langelem-col langelem))) + (back-to-indentation) + (if (not (re-search-forward "/\\([*]+\\)" (c-point 'eol) t)) + (progn + (if (not (looking-at "[*]+")) + (progn + ;; we now have to figure out where this comment begins. + (goto-char here) + (back-to-indentation) + (if (looking-at "[*]+/") + (progn (goto-char (match-end 0)) + (forward-comment -1)) + (goto-char (cdr langelem)) + (back-to-indentation)))) + (- (current-column) langelem-col)) + (if (zerop stars) + (progn + (skip-chars-forward " \t") + (- (current-column) langelem-col)) + ;; how many stars on comment opening line? if greater than + ;; on current line, align left. if less than or equal, + ;; align right. this should also pick up Javadoc style + ;; comments. + (if (> (length (match-string 1)) stars) + (progn + (back-to-indentation) + (- (current-column) -1 langelem-col)) + (- (current-column) stars langelem-col)) + ))))) + +(defun c-lineup-comment (langelem) + ;; support old behavior for comment indentation. we look at + ;; c-comment-only-line-offset to decide how to indent comment + ;; only-lines + (save-excursion + (back-to-indentation) + ;; this highly kludgiforous flag prevents the mapcar over + ;; c-syntactic-context from entering an infinite loop + (let ((recurse-prevention-flag (boundp 'recurse-prevention-flag))) + (cond + ;; CASE 1: preserve comment-column + (recurse-prevention-flag 0) + ((= (current-column) comment-column) + ;; we have to subtract out all other indentation + (- comment-column (apply '+ (mapcar 'c-get-offset + c-syntactic-context)))) + ;; indent as specified by c-comment-only-line-offset + ((not (bolp)) + (or (car-safe c-comment-only-line-offset) + c-comment-only-line-offset)) + (t + (or (cdr-safe c-comment-only-line-offset) + (car-safe c-comment-only-line-offset) + -1000)) ;jam it against the left side + )))) + +(defun c-lineup-runin-statements (langelem) + ;; line up statements in coding standards which place the first + ;; statement on the same line as the block opening brace. + (if (= (char-after (cdr langelem)) ?{) + (save-excursion + (let ((langelem-col (c-langelem-col langelem))) + (forward-char 1) + (skip-chars-forward " \t") + (- (current-column) langelem-col))) + 0)) + +(defun c-lineup-math (langelem) + ;; line up math statement-cont after the equals + (save-excursion + (let ((equalp (save-excursion + (goto-char (c-point 'boi)) + (skip-chars-forward "^=" (c-point 'eol)) + (and (= (following-char) ?=) + (- (point) (c-point 'boi))))) + (langelem-col (c-langelem-col langelem)) + donep) + (while (and (not donep) + (< (point) (c-point 'eol))) + (skip-chars-forward "^=" (c-point 'eol)) + (if (c-in-literal (cdr langelem)) + (forward-char 1) + (setq donep t))) + (if (/= (following-char) ?=) + ;; there's no equal sign on the line + c-basic-offset + ;; calculate indentation column after equals and ws, unless + ;; our line contains an equals sign + (if (not equalp) + (progn + (forward-char 1) + (skip-chars-forward " \t") + (setq equalp 0))) + (- (current-column) equalp langelem-col)) + ))) + +(defun c-lineup-ObjC-method-call (langelem) + ;; Line up methods args as elisp-mode does with function args: go to + ;; the position right after the message receiver, and if you are at + ;; (eolp) indent the current line by a constant offset from the + ;; opening bracket; otherwise we are looking at the first character + ;; of the first method call argument, so lineup the current line + ;; with it. + (save-excursion + (let* ((extra (save-excursion + (back-to-indentation) + (c-backward-syntactic-ws (cdr langelem)) + (if (= (preceding-char) ?:) + (- c-basic-offset) + 0))) + (open-bracket-pos (cdr langelem)) + (open-bracket-col (progn + (goto-char open-bracket-pos) + (current-column))) + (target-col (progn + (forward-char) + (forward-sexp) + (skip-chars-forward " \t") + (if (eolp) + (+ open-bracket-col c-basic-offset) + (current-column)))) + ) + (- target-col open-bracket-col extra)))) + +(defun c-lineup-ObjC-method-args (langelem) + ;; Line up the colons that separate args. This is done trying to + ;; align colons vertically. + (save-excursion + (let* ((here (c-point 'boi)) + (curcol (progn (goto-char here) (current-column))) + (eol (c-point 'eol)) + (relpos (cdr langelem)) + (first-col-column (progn + (goto-char relpos) + (skip-chars-forward "^:" eol) + (and (= (following-char) ?:) + (current-column))))) + (if (not first-col-column) + c-basic-offset + (goto-char here) + (skip-chars-forward "^:" eol) + (if (= (following-char) ?:) + (+ curcol (- first-col-column (current-column))) + c-basic-offset))))) + +(defun c-lineup-ObjC-method-args-2 (langelem) + ;; Line up the colons that separate args. This is done trying to + ;; align the colon on the current line with the previous one. + (save-excursion + (let* ((here (c-point 'boi)) + (curcol (progn (goto-char here) (current-column))) + (eol (c-point 'eol)) + (relpos (cdr langelem)) + (prev-col-column (progn + (skip-chars-backward "^:" relpos) + (and (= (preceding-char) ?:) + (- (current-column) 1))))) + (if (not prev-col-column) + c-basic-offset + (goto-char here) + (skip-chars-forward "^:" eol) + (if (= (following-char) ?:) + (+ curcol (- prev-col-column (current-column))) + c-basic-offset))))) + +(defun c-snug-do-while (syntax pos) + "Dynamically calculate brace hanginess for do-while statements. +Using this function, `while' clauses that end a `do-while' block will +remain on the same line as the brace that closes that block. + +See `c-hanging-braces-alist' for how to utilize this function as an +ACTION associated with `block-close' syntax." + (save-excursion + (let (langelem) + (if (and (eq syntax 'block-close) + (setq langelem (assq 'block-close c-syntactic-context)) + (progn (goto-char (cdr langelem)) + (if (= (following-char) ?{) + (c-safe (forward-sexp -1))) + (looking-at "\\<do\\>[^_]"))) + '(before) + '(before after))))) + +(defun c-gnu-impose-minimum () + "Imposes a minimum indentation for lines inside a top-level construct. +The variable `c-label-minimum-indentation' specifies the minimum +indentation amount." + (let ((non-top-levels '(defun-block-intro statement statement-cont + statement-block-intro statement-case-intro + statement-case-open substatement substatement-open + case-label label do-while-closure else-clause + )) + (syntax c-syntactic-context) + langelem) + (while syntax + (setq langelem (car (car syntax)) + syntax (cdr syntax)) + ;; don't adjust comment-only lines + (cond ((eq langelem 'comment-intro) + (setq syntax nil)) + ((memq langelem non-top-levels) + (save-excursion + (setq syntax nil) + (back-to-indentation) + (if (zerop (current-column)) + (insert (make-string c-label-minimum-indentation 32))) + )) + )))) + + +;; Useful for c-hanging-semi&comma-criteria +(defun c-semi&comma-inside-parenlist () + "Determine if a newline should be added after a semicolon. +If a comma was inserted, no determination is made. If a semicolon was +inserted inside a parenthesis list, no newline is added otherwise a +newline is added. In either case, checking is stopped. This supports +exactly the old newline insertion behavior." + ;; newline only after semicolon, but only if that semicolon is not + ;; inside a parenthesis list (e.g. a for loop statement) + (if (/= last-command-char ?\;) + nil ; continue checking + (if (condition-case nil + (save-excursion + (up-list -1) + (/= (following-char) ?\()) + (error t)) + t + 'stop))) + + +(provide 'cc-align) +;;; cc-align.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/cc-auto.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,60 @@ +;;; cc-auto.el --- autoloads for CC Mode + +;; Copyright (C) 1985,87,92,93,94,95,96,97 Free Software Foundation, Inc. + +;; Authors: 1992-1997 Barry A. Warsaw +;; 1987 Dave Detlefs and Stewart Clamen +;; 1985 Richard M. Stallman +;; Maintainer: cc-mode-help@python.org +;; Created: 22-Apr-1997 (split from cc-mode.el) +;; Version: 5.11 +;; Keywords: c languages oop + +;; 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. + +(autoload 'c-mode "cc-mode" + "Major mode for editing K&R and ANSI C code." t) + +(autoload 'c++-mode "cc-mode" + "Major mode for editing C++ code." t) + +(autoload 'objc-mode "cc-mode" + "Major mode for editing Objective C code." t) + +(autoload 'java-mode "cc-mode" + "Major mode for editing Java code." t) + +(autoload 'c-add-style "cc-styles" + "Adds a style to `c-style-alist', or updates an existing one." t) + + +;; This comment was here before me: +;; +;; cmacexp is lame because it uses no preprocessor symbols. It +;; isn't very extensible either -- hardcodes /lib/cpp. +;; +;; I add it here only because c-mode had it -- BAW +;; +(autoload 'c-macro-expand "cmacexp" + "Display the result of expanding all C macros occurring in the region. +The expansion is entirely correct because it uses the C preprocessor." + t) + + +(provide 'cc-auto) +;;; cc-auto.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/cc-cmds.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,1382 @@ +;;; cc-cmds.el --- user level commands for CC Mode + +;; Copyright (C) 1985,87,92,93,94,95,96,97 Free Software Foundation, Inc. + +;; Authors: 1992-1997 Barry A. Warsaw +;; 1987 Dave Detlefs and Stewart Clamen +;; 1985 Richard M. Stallman +;; Maintainer: cc-mode-help@python.org +;; Created: 22-Apr-1997 (split from cc-mode.el) +;; Version: 5.11 +;; Keywords: c languages oop + +;; 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. + +(eval-when-compile + (load-file "./cc-engine.el")) + + +;; Utilities +(defsubst c-update-modeline () + ;; set the c-auto-hungry-string for the correct designation on the modeline + (setq c-auto-hungry-string + (if c-auto-newline + (if c-hungry-delete-key "/ah" "/a") + (if c-hungry-delete-key "/h" nil))) + (force-mode-line-update)) + +(defun c-calculate-state (arg prevstate) + ;; Calculate the new state of PREVSTATE, t or nil, based on arg. If + ;; arg is nil or zero, toggle the state. If arg is negative, turn + ;; the state off, and if arg is positive, turn the state on + (if (or (not arg) + (zerop (setq arg (prefix-numeric-value arg)))) + (not prevstate) + (> arg 0))) + + +;; Auto-newline and hungry-delete +(defun c-toggle-auto-state (arg) + "Toggle auto-newline feature. +Optional numeric ARG, if supplied turns on auto-newline when positive, +turns it off when negative, and just toggles it when zero. + +When the auto-newline feature is enabled (as evidenced by the `/a' or +`/ah' on the modeline after the mode name) newlines are automatically +inserted after special characters such as brace, comma, semi-colon, +and colon." + (interactive "P") + (setq c-auto-newline (c-calculate-state arg c-auto-newline)) + (c-update-modeline) + (c-keep-region-active)) + +(defun c-toggle-hungry-state (arg) + "Toggle hungry-delete-key feature. +Optional numeric ARG, if supplied turns on hungry-delete when positive, +turns it off when negative, and just toggles it when zero. + +When the hungry-delete-key feature is enabled (as evidenced by the +`/h' or `/ah' on the modeline after the mode name) the delete key +gobbles all preceding whitespace in one fell swoop." + (interactive "P") + (setq c-hungry-delete-key (c-calculate-state arg c-hungry-delete-key)) + (c-update-modeline) + (c-keep-region-active)) + +(defun c-toggle-auto-hungry-state (arg) + "Toggle auto-newline and hungry-delete-key features. +Optional numeric ARG, if supplied turns on auto-newline and +hungry-delete when positive, turns them off when negative, and just +toggles them when zero. + +See `c-toggle-auto-state' and `c-toggle-hungry-state' for details." + (interactive "P") + (setq c-auto-newline (c-calculate-state arg c-auto-newline)) + (setq c-hungry-delete-key (c-calculate-state arg c-hungry-delete-key)) + (c-update-modeline) + (c-keep-region-active)) + + +;; Electric keys + +;; Note: In XEmacs 20.3 the Delete and BackSpace keysyms have been +;; separated and "\177" is no longer an alias for both keys. Also, +;; the variable delete-key-deletes-forward controls in which direction +;; the Delete keysym deletes characters. The functions +;; c-electric-delete and c-electric-backspace attempt to deal with +;; this new functionality. For Emacs 19 and XEmacs 19 backwards +;; compatibility, the old behavior has moved to c-electric-backspace +;; and c-backspace-function. + +(defun c-electric-backspace (arg) + "Deletes preceding character or whitespace. +If `c-hungry-delete-key' is non-nil, as evidenced by the \"/h\" or +\"/ah\" string on the mode line, then all preceding whitespace is +consumed. If however an ARG is supplied, or `c-hungry-delete-key' is +nil, or point is inside a literal then the function in the variable +`c-backspace-function' is called. + +See also \\[c-electric-delete]." + (interactive "P") + (if (or (not c-hungry-delete-key) + arg + (c-in-literal)) + (funcall c-backspace-function (prefix-numeric-value arg)) + (let ((here (point))) + (skip-chars-backward " \t\n") + (if (/= (point) here) + (delete-region (point) here) + (funcall c-backspace-function 1) + )))) + +(defun c-electric-delete (arg) + "Deletes preceding or following character or whitespace. + +The behavior of this function depends on the variable +`delete-key-deletes-forward'. If this variable is nil (or does not +exist, as in older Emacsen), then this function behaves identical to +\\[c-electric-backspace]. + +If `delete-key-deletes-forward' is non-nil, then deletion occurs in +the forward direction. So if `c-hungry-delete-key' is non-nil, as +evidenced by the \"/h\" or \"/ah\" string on the mode line, then all +following whitespace is consumed. If however an ARG is supplied, or +`c-hungry-delete-key' is nil, or point is inside a literal then the +function in the variable `c-delete-function' is called." + (interactive "P") + (if (and (boundp 'delete-key-deletes-forward) + delete-key-deletes-forward) + (if (or (not c-hungry-delete-key) + arg + (c-in-literal)) + (funcall c-delete-function (prefix-numeric-value arg)) + (let ((here (point))) + (skip-chars-forward " \t\n") + (if (/= (point) here) + (delete-region (point) here) + (funcall c-delete-function 1)))) + ;; act just like c-electric-backspace + (c-electric-backspace arg))) + +(defun c-electric-pound (arg) + "Electric pound (`#') insertion. +Inserts a `#' character specially depending on the variable +`c-electric-pound-behavior'. If a numeric ARG is supplied, or if +point is inside a literal, nothing special happens." + (interactive "P") + (if (or (c-in-literal) + arg + (not (memq 'alignleft c-electric-pound-behavior))) + ;; do nothing special + (self-insert-command (prefix-numeric-value arg)) + ;; place the pound character at the left edge + (let ((pos (- (point-max) (point))) + (bolp (bolp))) + (beginning-of-line) + (delete-horizontal-space) + (insert-char last-command-char 1) + (and (not bolp) + (goto-char (- (point-max) pos))) + ))) + +(defun c-electric-brace (arg) + "Insert a brace. + +If the auto-newline feature is turned on, as evidenced by the \"/a\" +or \"/ah\" string on the mode line, newlines are inserted before and +after braces based on the value of `c-hanging-braces-alist'. + +Also, the line is re-indented unless a numeric ARG is supplied, there +are non-whitespace characters present on the line after the brace, or +the brace is inserted inside a literal." + (interactive "P") + (let* ((c-state-cache (c-parse-state)) + (safepos (c-safe-position (point) c-state-cache)) + (literal (c-in-literal safepos))) + ;; if we're in a literal, or we're not at the end of the line, or + ;; a numeric arg is provided, or auto-newlining is turned off, + ;; then just insert the character. + (if (or literal arg +; (not c-auto-newline) + (not (looking-at "[ \t]*$"))) + (self-insert-command (prefix-numeric-value arg)) + (let* ((syms '(class-open class-close defun-open defun-close + inline-open inline-close brace-list-open brace-list-close + brace-list-intro brace-list-entry block-open block-close + substatement-open statement-case-open + extern-lang-open extern-lang-close)) + ;; we want to inhibit blinking the paren since this will + ;; be most disruptive. we'll blink it ourselves later on + (old-blink-paren blink-paren-function) + blink-paren-function + (insertion-point (point)) + delete-temp-newline + (preserve-p (= 32 (char-syntax (preceding-char)))) + ;; shut this up too + (c-echo-syntactic-information-p nil) + (syntax (progn + ;; only insert a newline if there is + ;; non-whitespace behind us + (if (save-excursion + (skip-chars-backward " \t") + (not (bolp))) + (progn (newline) + (setq delete-temp-newline t))) + (self-insert-command (prefix-numeric-value arg)) + ;; state cache doesn't change + (c-guess-basic-syntax))) + (newlines (and + c-auto-newline + (or (c-lookup-lists syms syntax c-hanging-braces-alist) + '(ignore before after))))) + ;; If syntax is a function symbol, then call it using the + ;; defined semantics. + (if (and (not (consp (cdr newlines))) + (functionp (cdr newlines))) + (let ((c-syntactic-context syntax)) + (setq newlines + (funcall (cdr newlines) (car newlines) insertion-point)))) + ;; does a newline go before the open brace? + (if (memq 'before newlines) + ;; we leave the newline we've put in there before, + ;; but we need to re-indent the line above + (let ((pos (- (point-max) (point))) + (here (point)) + (c-state-cache c-state-cache)) + (forward-line -1) + ;; we may need to update the cache. this should still be + ;; faster than recalculating the state in many cases + (save-excursion + (save-restriction + (narrow-to-region here (point)) + (if (and (c-safe (progn (backward-up-list -1) t)) + (memq (preceding-char) '(?\) ?})) + (progn (widen) + (c-safe (progn (forward-sexp -1) t)))) + (setq c-state-cache + (c-hack-state (point) 'open c-state-cache)) + (if (and (car c-state-cache) + (not (consp (car c-state-cache))) + (<= (point) (car c-state-cache))) + (setq c-state-cache (cdr c-state-cache)) + )))) + (let ((here (point)) + (shift (c-indent-line))) + (setq c-state-cache (c-adjust-state (c-point 'bol) here + (- shift) c-state-cache))) + (goto-char (- (point-max) pos)) + ;; if the buffer has changed due to the indentation, we + ;; need to recalculate syntax for the current line, but + ;; we won't need to update the state cache. + (if (/= (point) here) + (setq syntax (c-guess-basic-syntax)))) + ;; must remove the newline we just stuck in (if we really did it) + (and delete-temp-newline + (save-excursion + ;; if there is whitespace before point, then preserve + ;; at least one space. + (delete-indentation) + (just-one-space) + (if (not preserve-p) + (delete-char -1)))) + ;; since we're hanging the brace, we need to recalculate + ;; syntax. Update the state to accurately reflect the + ;; beginning of the line. We punt if we cross any open or + ;; closed parens because its just too hard to modify the + ;; known state. This limitation will be fixed in v5. + (save-excursion + (let ((bol (c-point 'bol))) + (if (zerop (car (parse-partial-sexp bol (1- (point))))) + (setq c-state-cache (c-whack-state bol c-state-cache) + syntax (c-guess-basic-syntax)) + ;; gotta punt. this requires some horrible kludgery + (beginning-of-line) + (makunbound 'c-state-cache) + (setq c-state-cache (c-parse-state) + syntax nil)))) + ) + ;; now adjust the line's indentation. don't update the state + ;; cache since c-guess-basic-syntax isn't called when the + ;; syntax is passed to c-indent-line + (let ((here (point)) + (shift (c-indent-line syntax))) + (setq c-state-cache (c-adjust-state (c-point 'bol) here + (- shift) c-state-cache))) + ;; Do all appropriate clean ups + (let ((here (point)) + (pos (- (point-max) (point))) + mbeg mend) + ;; clean up empty defun braces + (if (and c-auto-newline + (memq 'empty-defun-braces c-cleanup-list) + (= last-command-char ?\}) + (c-intersect-lists '(defun-close class-close inline-close) + syntax) + (progn + (forward-char -1) + (skip-chars-backward " \t\n") + (= (preceding-char) ?\{)) + ;; make sure matching open brace isn't in a comment + (not (c-in-literal))) + (delete-region (point) (1- here))) + ;; clean up brace-else-brace + (if (and c-auto-newline + (memq 'brace-else-brace c-cleanup-list) + (= last-command-char ?\{) + (re-search-backward "}[ \t\n]*else[ \t\n]*{" nil t) + (progn + (setq mbeg (match-beginning 0) + mend (match-end 0)) + (= mend here)) + (not (c-in-literal))) + (progn + (delete-region mbeg mend) + (insert "} else {"))) + ;; clean up brace-elseif-brace + (if (and c-auto-newline + (memq 'brace-elseif-brace c-cleanup-list) + (= last-command-char ?\{) + (re-search-backward "}[ \t\n]*else[ \t\n]+if[ \t\n]*" nil t) + (save-excursion + (goto-char (match-end 0)) + (c-safe (forward-sexp 1)) + (skip-chars-forward " \t\n") + (setq mbeg (match-beginning 0) + mend (match-end 0)) + (= here (1+ (point)))) + (not (c-in-literal))) + (progn + (delete-region mbeg mend) + (insert "} else if "))) + (goto-char (- (point-max) pos)) + ) + ;; does a newline go after the brace? + (if (memq 'after newlines) + (progn + (newline) + ;; update on c-state-cache + (let* ((bufpos (- (point) 2)) + (which (if (= (char-after bufpos) ?{) 'open 'close)) + (c-state-cache (c-hack-state bufpos which c-state-cache))) + (c-indent-line)))) + ;; blink the paren + (and (= last-command-char ?\}) + old-blink-paren + (save-excursion + (c-backward-syntactic-ws safepos) + (funcall old-blink-paren))) + )))) + +(defun c-electric-slash (arg) + "Insert a slash character. +If slash is second of a double-slash C++ style comment introducing +construct, and we are on a comment-only-line, indent line as comment. +If numeric ARG is supplied or point is inside a literal, indentation +is inhibited." + (interactive "P") + (let ((indentp (and (not arg) + (= (preceding-char) ?/) + (= last-command-char ?/) + (not (c-in-literal)))) + ;; shut this up + (c-echo-syntactic-information-p nil)) + (self-insert-command (prefix-numeric-value arg)) + (if indentp + (c-indent-line)))) + +(defun c-electric-star (arg) + "Insert a star character. +If the star is the second character of a C style comment introducing +construct, and we are on a comment-only-line, indent line as comment. +If numeric ARG is supplied or point is inside a literal, indentation +is inhibited." + (interactive "P") + (self-insert-command (prefix-numeric-value arg)) + ;; if we are in a literal, or if arg is given do not re-indent the + ;; current line, unless this star introduces a comment-only line. + (if (and (not arg) + (memq (c-in-literal) '(c)) + (= (preceding-char) ?*) + (save-excursion + (forward-char -1) + (skip-chars-backward "*") + (if (= (preceding-char) ?/) + (forward-char -1)) + (skip-chars-backward " \t") + (bolp))) + ;; shut this up + (let (c-echo-syntactic-information-p) + (c-indent-line)) + )) + +(defun c-electric-semi&comma (arg) + "Insert a comma or semicolon. +When the auto-newline feature is turned on, as evidenced by the \"/a\" +or \"/ah\" string on the mode line, a newline might be inserted. See +the variable `c-hanging-semi&comma-criteria' for how newline insertion +is determined. + +When semicolon is inserted, the line is re-indented unless a numeric +arg is supplied, point is inside a literal, or there are +non-whitespace characters on the line following the semicolon." + (interactive "P") + (let* ((lim (c-most-enclosing-brace (c-parse-state))) + (literal (c-in-literal lim)) + (here (point)) + ;; shut this up + (c-echo-syntactic-information-p nil)) + (if (or literal + arg + (not (looking-at "[ \t]*$"))) + (self-insert-command (prefix-numeric-value arg)) + ;; do some special stuff with the character + (self-insert-command (prefix-numeric-value arg)) + ;; do all cleanups, reindentations, and newline insertions, but + ;; only if c-auto-newline is turned on + (if (not c-auto-newline) nil + ;; clean ups + (let ((pos (- (point-max) (point)))) + (if (and (or (and + (= last-command-char ?,) + (memq 'list-close-comma c-cleanup-list)) + (and + (= last-command-char ?\;) + (memq 'defun-close-semi c-cleanup-list))) + (progn + (forward-char -1) + (skip-chars-backward " \t\n") + (= (preceding-char) ?})) + ;; make sure matching open brace isn't in a comment + (not (c-in-literal lim))) + (delete-region (point) here)) + (goto-char (- (point-max) pos))) + ;; re-indent line + (c-indent-line) + ;; check to see if a newline should be added + (let ((criteria c-hanging-semi&comma-criteria) + answer add-newline-p) + (while criteria + (setq answer (funcall (car criteria))) + ;; only nil value means continue checking + (if (not answer) + (setq criteria (cdr criteria)) + (setq criteria nil) + ;; only 'stop specifically says do not add a newline + (setq add-newline-p (not (eq answer 'stop))) + )) + (if add-newline-p + (progn (newline) + (c-indent-line))) + ))))) + +(defun c-electric-colon (arg) + "Insert a colon. + +If the auto-newline feature is turned on, as evidenced by the \"/a\" +or \"/ah\" string on the mode line, newlines are inserted before and +after colons based on the value of `c-hanging-colons-alist'. + +Also, the line is re-indented unless a numeric ARG is supplied, there +are non-whitespace characters present on the line after the colon, or +the colon is inserted inside a literal. + +This function cleans up double colon scope operators based on the +value of `c-cleanup-list'." + (interactive "P") + (let* ((bod (c-point 'bod)) + (literal (c-in-literal bod)) + syntax newlines + ;; shut this up + (c-echo-syntactic-information-p nil)) + (if (or literal + arg + (not (looking-at "[ \t]*$"))) + (self-insert-command (prefix-numeric-value arg)) + ;; insert the colon, then do any specified cleanups + (self-insert-command (prefix-numeric-value arg)) + (let ((pos (- (point-max) (point))) + (here (point))) + (if (and c-auto-newline + (memq 'scope-operator c-cleanup-list) + (= (preceding-char) ?:) + (progn + (forward-char -1) + (skip-chars-backward " \t\n") + (= (preceding-char) ?:)) + (not (c-in-literal)) + (not (= (char-after (- (point) 2)) ?:))) + (delete-region (point) (1- here))) + (goto-char (- (point-max) pos))) + ;; lets do some special stuff with the colon character + (setq syntax (c-guess-basic-syntax) + ;; some language elements can only be determined by + ;; checking the following line. Lets first look for ones + ;; that can be found when looking on the line with the + ;; colon + newlines + (and c-auto-newline + (or (c-lookup-lists '(case-label label access-label) + syntax c-hanging-colons-alist) + (c-lookup-lists '(member-init-intro inher-intro) + (prog2 + (insert "\n") + (c-guess-basic-syntax) + (delete-char -1)) + c-hanging-colons-alist)))) + ;; indent the current line + (c-indent-line syntax) + ;; does a newline go before the colon? Watch out for already + ;; non-hung colons. However, we don't unhang them because that + ;; would be a cleanup (and anti-social). + (if (and (memq 'before newlines) + (save-excursion + (skip-chars-backward ": \t") + (not (bolp)))) + (let ((pos (- (point-max) (point)))) + (forward-char -1) + (newline) + (c-indent-line) + (goto-char (- (point-max) pos)))) + ;; does a newline go after the colon? + (if (memq 'after (cdr-safe newlines)) + (progn + (newline) + (c-indent-line))) + ))) + +(defun c-electric-lt-gt (arg) + "Insert a less-than, or greater-than character. +When the auto-newline feature is turned on, as evidenced by the \"/a\" +or \"/ah\" string on the mode line, the line will be re-indented if +the character inserted is the second of a C++ style stream operator +and the buffer is in C++ mode. + +The line will also not be re-indented if a numeric argument is +supplied, or point is inside a literal." + (interactive "P") + (let ((indentp (and (not arg) + (= (preceding-char) last-command-char) + (not (c-in-literal)))) + ;; shut this up + (c-echo-syntactic-information-p nil)) + (self-insert-command (prefix-numeric-value arg)) + (if indentp + (c-indent-line)))) + + + +;; better movement routines for ThisStyleOfVariablesCommonInCPlusPlus +;; originally contributed by Terry_Glanfield.Southern@rxuk.xerox.com +(defun c-forward-into-nomenclature (&optional arg) + "Move forward to end of a nomenclature section or word. +With arg, to it arg times." + (interactive "p") + (let ((case-fold-search nil)) + (if (> arg 0) + (re-search-forward "\\W*\\([A-Z]*[a-z0-9]*\\)" (point-max) t arg) + (while (and (< arg 0) + (re-search-backward + "\\(\\(\\W\\|[a-z0-9]\\)[A-Z]+\\|\\W\\w+\\)" + (point-min) 0)) + (forward-char 1) + (setq arg (1+ arg))))) + (c-keep-region-active)) + +(defun c-backward-into-nomenclature (&optional arg) + "Move backward to beginning of a nomenclature section or word. +With optional ARG, move that many times. If ARG is negative, move +forward." + (interactive "p") + (c-forward-into-nomenclature (- arg)) + (c-keep-region-active)) + +(defun c-scope-operator () + "Insert a double colon scope operator at point. +No indentation or other \"electric\" behavior is performed." + (interactive) + (insert "::")) + + +(defun c-beginning-of-statement (&optional count lim sentence-flag) + "Go to the beginning of the innermost C statement. +With prefix arg, go back N - 1 statements. If already at the +beginning of a statement then go to the beginning of the preceding +one. If within a string or comment, or next to a comment (only +whitespace between), move by sentences instead of statements. + +When called from a program, this function takes 3 optional args: the +repetition count, a buffer position limit which is the farthest back +to search, and a flag saying whether to do sentence motion when in a +comment." + (interactive (list (prefix-numeric-value current-prefix-arg) + nil t)) + (let ((here (point)) + (count (or count 1)) + (lim (or lim (c-point 'bod))) + state) + (save-excursion + (goto-char lim) + (setq state (parse-partial-sexp (point) here nil nil))) + (if (and sentence-flag + (or (nth 3 state) + (nth 4 state) +; (looking-at (concat "[ \t]*" comment-start-skip)) + (save-excursion + (skip-chars-backward " \t") + (goto-char (- (point) 2)) + (looking-at "\\*/")))) + (forward-sentence (- count)) + (while (> count 0) + (c-beginning-of-statement-1 lim) + (setq count (1- count))) + (while (< count 0) + (c-end-of-statement-1) + (setq count (1+ count)))) + ;; its possible we've been left up-buf of lim + (goto-char (max (point) lim)) + ) + (c-keep-region-active)) + +(defun c-end-of-statement (&optional count lim sentence-flag) + "Go to the end of the innermost C statement. + +With prefix arg, go forward N - 1 statements. Move forward to end of +the next statement if already at end. If within a string or comment, +move by sentences instead of statements. + +When called from a program, this function takes 3 optional args: the +repetition count, a buffer position limit which is the farthest back +to search, and a flag saying whether to do sentence motion when in a +comment." + (interactive (list (prefix-numeric-value current-prefix-arg) + nil t)) + (c-beginning-of-statement (- (or count 1)) lim sentence-flag) + (c-keep-region-active)) + + +;; set up electric character functions to work with pending-del, +;; (a.k.a. delsel) mode. All symbols get the t value except +;; c-electric-delete which gets 'supersede. +(mapcar + (function + (lambda (sym) + (put sym 'delete-selection t) ; for delsel (Emacs) + (put sym 'pending-delete t))) ; for pending-del (XEmacs) + '(c-electric-pound + c-electric-brace + c-electric-slash + c-electric-star + c-electric-semi&comma + c-electric-lt-gt + c-electric-colon)) +(put 'c-electric-delete 'delete-selection 'supersede) ; delsel +(put 'c-electric-delete 'pending-delete 'supersede) ; pending-del + + +;; This is used by indent-for-comment to decide how much to indent a +;; comment in C code based on its context. +(defun c-comment-indent () + (if (looking-at (concat "^\\(" c-comment-start-regexp "\\)")) + 0 ;Existing comment at bol stays there. + (let ((opoint (point)) + placeholder) + (save-excursion + (beginning-of-line) + (cond + ;; CASE 1: A comment following a solitary close-brace should + ;; have only one space. + ((looking-at (concat "[ \t]*}[ \t]*\\($\\|" + c-comment-start-regexp + "\\)")) + (search-forward "}") + (1+ (current-column))) + ;; CASE 2: 2 spaces after #endif + ((or (looking-at "^#[ \t]*endif[ \t]*") + (looking-at "^#[ \t]*else[ \t]*")) + 7) + ;; CASE 3: when comment-column is nil, calculate the offset + ;; according to c-offsets-alist. E.g. identical to hitting + ;; TAB. + ((and c-indent-comments-syntactically-p + (save-excursion + (skip-chars-forward " \t") + (or (looking-at comment-start) + (eolp)))) + (let ((syntax (c-guess-basic-syntax))) + ;; BOGOSITY ALERT: if we're looking at the eol, its + ;; because indent-for-comment hasn't put the comment-start + ;; in the buffer yet. this will screw up the syntactic + ;; analysis so we kludge in the necessary info. Another + ;; kludge is that if we're at the bol, then we really want + ;; to ignore any anchoring as specified by + ;; c-comment-only-line-offset since it doesn't apply here. + (if (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (eolp)) + (c-add-syntax 'comment-intro)) + (let ((c-comment-only-line-offset + (if (consp c-comment-only-line-offset) + c-comment-only-line-offset + (cons c-comment-only-line-offset + c-comment-only-line-offset)))) + (apply '+ (mapcar 'c-get-offset syntax))))) + ;; CASE 4: use comment-column if previous line is a + ;; comment-only line indented to the left of comment-column + ((save-excursion + (beginning-of-line) + (and (not (bobp)) + (forward-line -1)) + (skip-chars-forward " \t") + (prog1 + (looking-at c-comment-start-regexp) + (setq placeholder (point)))) + (goto-char placeholder) + (if (< (current-column) comment-column) + comment-column + (current-column))) + ;; CASE 5: If comment-column is 0, and nothing but space + ;; before the comment, align it at 0 rather than 1. + ((progn + (goto-char opoint) + (skip-chars-backward " \t") + (and (= comment-column 0) (bolp))) + 0) + ;; CASE 6: indent at comment column except leave at least one + ;; space. + (t (max (1+ (current-column)) + comment-column)) + ))))) + +;; used by outline-minor-mode +(defun c-outline-level () + (save-excursion + (skip-chars-forward "\t ") + (current-column))) + + +(defun c-up-conditional (count) + "Move back to the containing preprocessor conditional, leaving mark behind. +A prefix argument acts as a repeat count. With a negative argument, +move forward to the end of the containing preprocessor conditional. +When going backwards, `#elif' is treated like `#else' followed by +`#if'. When going forwards, `#elif' is ignored." + (interactive "p") + (c-forward-conditional (- count) t) + (c-keep-region-active)) + +(defun c-backward-conditional (count &optional up-flag) + "Move back across a preprocessor conditional, leaving mark behind. +A prefix argument acts as a repeat count. With a negative argument, +move forward across a preprocessor conditional." + (interactive "p") + (c-forward-conditional (- count) up-flag) + (c-keep-region-active)) + +(defun c-forward-conditional (count &optional up-flag) + "Move forward across a preprocessor conditional, leaving mark behind. +A prefix argument acts as a repeat count. With a negative argument, +move backward across a preprocessor conditional." + (interactive "p") + (let* ((forward (> count 0)) + (increment (if forward -1 1)) + (search-function (if forward 're-search-forward 're-search-backward)) + (new)) + (save-excursion + (while (/= count 0) + (let ((depth (if up-flag 0 -1)) found) + (save-excursion + ;; Find the "next" significant line in the proper direction. + (while (and (not found) + ;; Rather than searching for a # sign that + ;; comes at the beginning of a line aside from + ;; whitespace, search first for a string + ;; starting with # sign. Then verify what + ;; precedes it. This is faster on account of + ;; the fastmap feature of the regexp matcher. + (funcall search-function + "#[ \t]*\\(if\\|elif\\|endif\\)" + nil t)) + (beginning-of-line) + ;; Now verify it is really a preproc line. + (if (looking-at "^[ \t]*#[ \t]*\\(if\\|elif\\|endif\\)") + (let ((prev depth)) + ;; Update depth according to what we found. + (beginning-of-line) + (cond ((looking-at "[ \t]*#[ \t]*endif") + (setq depth (+ depth increment))) + ((looking-at "[ \t]*#[ \t]*elif") + (if (and forward (= depth 0)) + (setq found (point)))) + (t (setq depth (- depth increment)))) + ;; If we are trying to move across, and we find an + ;; end before we find a beginning, get an error. + (if (and (< prev 0) (< depth prev)) + (error (if forward + "No following conditional at this level" + "No previous conditional at this level"))) + ;; When searching forward, start from next line so + ;; that we don't find the same line again. + (if forward (forward-line 1)) + ;; If this line exits a level of conditional, exit + ;; inner loop. + (if (< depth 0) + (setq found (point)))) + ;; else + (if forward (forward-line 1)) + ))) + (or found + (error "No containing preprocessor conditional")) + (goto-char (setq new found))) + (setq count (+ count increment)))) + (push-mark) + (goto-char new)) + (c-keep-region-active)) + + +;; commands to indent lines, regions, defuns, and expressions +(defun c-indent-command (&optional whole-exp) + "Indent current line as C code, and/or insert some whitespace. + +If `c-tab-always-indent' is t, always just indent the current line. +If nil, indent the current line only if point is at the left margin or +in the line's indentation; otherwise insert some whitespace[*]. If +other than nil or t, then some whitespace[*] is inserted only within +literals (comments and strings) and inside preprocessor directives, +but the line is always reindented. + +A numeric argument, regardless of its value, means indent rigidly all +the lines of the expression starting after point so that this line +becomes properly indented. The relative indentation among the lines +of the expression are preserved. + + [*] The amount and kind of whitespace inserted is controlled by the + variable `c-insert-tab-function', which is called to do the actual + insertion of whitespace. Normally the function in this variable + just inserts a tab character, or the equivalent number of spaces, + depending on the variable `indent-tabs-mode'." + + (interactive "P") + (let ((bod (c-point 'bod))) + (if whole-exp + ;; If arg, always indent this line as C + ;; and shift remaining lines of expression the same amount. + (let ((shift-amt (c-indent-line)) + beg end) + (save-excursion + (if (eq c-tab-always-indent t) + (beginning-of-line)) + (setq beg (point)) + (forward-sexp 1) + (setq end (point)) + (goto-char beg) + (forward-line 1) + (setq beg (point))) + (if (> end beg) + (indent-code-rigidly beg end (- shift-amt) "#"))) + ;; No arg supplied, use c-tab-always-indent to determine + ;; behavior + (cond + ;; CASE 1: indent when at column zero or in lines indentation, + ;; otherwise insert a tab + ((not c-tab-always-indent) + (if (save-excursion + (skip-chars-backward " \t") + (not (bolp))) + (funcall c-insert-tab-function) + (c-indent-line))) + ;; CASE 2: just indent the line + ((eq c-tab-always-indent t) + (c-indent-line)) + ;; CASE 3: if in a literal, insert a tab, but always indent the + ;; line + (t + (if (c-in-literal bod) + (funcall c-insert-tab-function)) + (c-indent-line) + ))))) + +(defun c-indent-exp (&optional shutup-p) + "Indent each line in balanced expression following point. +Optional SHUTUP-P if non-nil, inhibits message printing and error checking." + (interactive "P") + (let ((here (point)) + end progress-p) + (unwind-protect + (let ((c-echo-syntactic-information-p nil) ;keep quiet for speed + (start (progn + ;; try to be smarter about finding the range of + ;; lines to indent. skip all following + ;; whitespace. failing that, try to find any + ;; opening brace on the current line + (skip-chars-forward " \t\n") + (if (memq (following-char) '(?\( ?\[ ?\{)) + (point) + (let ((state (parse-partial-sexp (point) + (c-point 'eol)))) + (and (nth 1 state) + (goto-char (nth 1 state)) + (memq (following-char) '(?\( ?\[ ?\{)) + (point))))))) + ;; find balanced expression end + (setq end (and (c-safe (progn (forward-sexp 1) t)) + (point-marker))) + ;; sanity check + (and (not start) + (not shutup-p) + (error "Cannot find start of balanced expression to indent.")) + (and (not end) + (not shutup-p) + (error "Cannot find end of balanced expression to indent.")) + (c-progress-init start end 'c-indent-exp) + (setq progress-p t) + (goto-char start) + (beginning-of-line) + (while (< (point) end) + (if (not (looking-at "[ \t]*$")) + (c-indent-line)) + (c-progress-update) + (forward-line 1))) + ;; make sure marker is deleted + (and end + (set-marker end nil)) + (and progress-p + (c-progress-fini 'c-indent-exp)) + (goto-char here)))) + +(defun c-indent-defun () + "Re-indents the current top-level function def, struct or class declaration." + (interactive) + (let ((here (point-marker)) + (c-echo-syntactic-information-p nil) + (brace (c-least-enclosing-brace (c-parse-state)))) + (if brace + (goto-char brace) + (beginning-of-defun)) + ;; if we're sitting at b-o-b, it might be because there was no + ;; least enclosing brace and we were sitting on the defun's open + ;; brace. + (if (and (bobp) (not (= (following-char) ?\{))) + (goto-char here)) + ;; if defun-prompt-regexp is non-nil, b-o-d might not leave us at + ;; the open brace. I consider this an Emacs bug. + (and (boundp 'defun-prompt-regexp) + defun-prompt-regexp + (looking-at defun-prompt-regexp) + (goto-char (match-end 0))) + ;; catch all errors in c-indent-exp so we can 1. give more + ;; meaningful error message, and 2. restore point + (unwind-protect + (c-indent-exp) + (goto-char here) + (set-marker here nil)))) + +(defun c-indent-region (start end) + ;; Indent every line whose first char is between START and END inclusive. + (save-excursion + (goto-char start) + ;; Advance to first nonblank line. + (skip-chars-forward " \t\n") + (beginning-of-line) + (let (endmark) + (unwind-protect + (let ((c-tab-always-indent t) + ;; shut up any echo msgs on indiv lines + (c-echo-syntactic-information-p nil) + fence) + (c-progress-init start end 'c-indent-region) + (setq endmark (copy-marker end)) + (while (and (bolp) + (not (eobp)) + (< (point) endmark)) + ;; update progress + (c-progress-update) + ;; Indent one line as with TAB. + (let (nextline sexpend sexpbeg) + ;; skip blank lines + (skip-chars-forward " \t\n") + (beginning-of-line) + ;; indent the current line + (c-indent-line) + (setq fence (point)) + (if (save-excursion + (beginning-of-line) + (looking-at "[ \t]*#")) + (forward-line 1) + (save-excursion + ;; Find beginning of following line. + (setq nextline (c-point 'bonl)) + ;; Find first beginning-of-sexp for sexp extending past + ;; this line. + (beginning-of-line) + (while (< (point) nextline) + (condition-case nil + (progn + (forward-sexp 1) + (setq sexpend (point))) + (error (setq sexpend nil) + (goto-char nextline))) + (c-forward-syntactic-ws)) + (if sexpend + (progn + ;; make sure the sexp we found really starts on the + ;; current line and extends past it + (goto-char sexpend) + (setq sexpend (point-marker)) + (c-safe (backward-sexp 1)) + (setq sexpbeg (point)))) + (if (and sexpbeg (< sexpbeg fence)) + (setq sexpbeg fence))) + ;; check to see if the next line starts a + ;; comment-only line + (save-excursion + (forward-line 1) + (skip-chars-forward " \t") + (if (looking-at c-comment-start-regexp) + (setq sexpbeg (c-point 'bol)))) + ;; If that sexp ends within the region, indent it all at + ;; once, fast. + (condition-case nil + (if (and sexpend + (> sexpend nextline) + (<= sexpend endmark)) + (progn + (goto-char sexpbeg) + (c-indent-exp 'shutup) + (c-progress-update) + (goto-char sexpend))) + (error + (goto-char sexpbeg) + (c-indent-line))) + ;; Move to following line and try again. + (and sexpend + (markerp sexpend) + (set-marker sexpend nil)) + (forward-line 1) + (setq fence (point)))))) + (set-marker endmark nil) + (c-progress-fini 'c-indent-region) + )))) + +(defun c-mark-function () + "Put mark at end of a C, C++, or Objective-C defun, point at beginning." + (interactive) + (let ((here (point)) + ;; there should be a c-point position for 'eod + (eod (save-excursion (end-of-defun) (point))) + (state (c-parse-state)) + brace) + (while state + (setq brace (car state)) + (if (consp brace) + (goto-char (cdr brace)) + (goto-char brace)) + (setq state (cdr state))) + (if (= (following-char) ?{) + (progn + (forward-line -1) + (while (not (or (bobp) + (looking-at "[ \t]*$"))) + (forward-line -1))) + (forward-line 1) + (skip-chars-forward " \t\n")) + (push-mark here) + (push-mark eod nil t))) + + +;; for progress reporting +(defvar c-progress-info nil) + +(defun c-progress-init (start end context) + ;; start the progress update messages. if this emacs doesn't have a + ;; built-in timer, just be dumb about it + (if (not (fboundp 'current-time)) + (message "indenting region... (this may take a while)") + ;; if progress has already been initialized, do nothing. otherwise + ;; initialize the counter with a vector of: + ;; [start end lastsec context] + (if c-progress-info + () + (setq c-progress-info (vector start + (save-excursion + (goto-char end) + (point-marker)) + (nth 1 (current-time)) + context)) + (message "indenting region...")))) + +(defun c-progress-update () + ;; update progress + (if (not (and c-progress-info c-progress-interval)) + nil + (let ((now (nth 1 (current-time))) + (start (aref c-progress-info 0)) + (end (aref c-progress-info 1)) + (lastsecs (aref c-progress-info 2))) + ;; should we update? currently, update happens every 2 seconds, + ;; what's the right value? + (if (< c-progress-interval (- now lastsecs)) + (progn + (message "indenting region... (%d%% complete)" + (/ (* 100 (- (point) start)) (- end start))) + (aset c-progress-info 2 now))) + ))) + +(defun c-progress-fini (context) + ;; finished + (if (or (eq context (aref c-progress-info 3)) + (eq context t)) + (progn + (set-marker (aref c-progress-info 1) nil) + (setq c-progress-info nil) + (message "indenting region...done")))) + + + +;;; This page handles insertion and removal of backslashes for C macros. + +(defun c-backslash-region (from to delete-flag) + "Insert, align, or delete end-of-line backslashes on the lines in the region. +With no argument, inserts backslashes and aligns existing backslashes. +With an argument, deletes the backslashes. + +This function does not modify blank lines at the start of the region. +If the region ends at the start of a line, it always deletes the +backslash (if any) at the end of the previous line. + +You can put the region around an entire macro definition and use this +command to conveniently insert and align the necessary backslashes." + (interactive "r\nP") + (save-excursion + (goto-char from) + (let ((column c-backslash-column) + (endmark (make-marker))) + (move-marker endmark to) + ;; Compute the smallest column number past the ends of all the lines. + (if (not delete-flag) + (while (< (point) to) + (end-of-line) + (if (= (preceding-char) ?\\) + (progn (forward-char -1) + (skip-chars-backward " \t"))) + (setq column (max column (1+ (current-column)))) + (forward-line 1))) + ;; Adjust upward to a tab column, if that doesn't push past the margin. + (if (> (% column tab-width) 0) + (let ((adjusted (* (/ (+ column tab-width -1) tab-width) tab-width))) + (if (< adjusted (window-width)) + (setq column adjusted)))) + ;; Don't modify blank lines at start of region. + (goto-char from) + (while (and (< (point) endmark) (eolp)) + (forward-line 1)) + ;; Add or remove backslashes on all the lines. + (while (< (point) endmark) + (if (and (not delete-flag) + ;; Un-backslashify the last line + ;; if the region ends right at the start of the next line. + (save-excursion + (forward-line 1) + (< (point) endmark))) + (c-append-backslash column) + (c-delete-backslash)) + (forward-line 1)) + (move-marker endmark nil))) + (c-keep-region-active)) + +(defun c-append-backslash (column) + (end-of-line) + ;; Note that "\\\\" is needed to get one backslash. + (if (= (preceding-char) ?\\) + (progn (forward-char -1) + (delete-horizontal-space) + (indent-to column)) + (indent-to column) + (insert "\\"))) + +(defun c-delete-backslash () + (end-of-line) + (or (bolp) + (progn + (forward-char -1) + (if (looking-at "\\\\") + (delete-region (1+ (point)) + (progn (skip-chars-backward " \t") (point))))))) + + +(defun c-fill-paragraph (&optional arg) + "Like \\[fill-paragraph] but handles C and C++ style comments. +If any of the current line is a comment or within a comment, +fill the comment or the paragraph of it that point is in, +preserving the comment indentation or line-starting decorations. + +Optional prefix ARG means justify paragraph as well." + (interactive "P") + (let* (comment-start-place + (first-line + ;; Check for obvious entry to comment. + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t\n") + (and (looking-at comment-start-skip) + (setq comment-start-place (point))))) + (re1 "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$")) + (if (and c-double-slash-is-comments-p + (save-excursion + (beginning-of-line) + (looking-at ".*//"))) + (let ((fill-prefix fill-prefix) + ;; Lines containing just a comment start or just an end + ;; should not be filled into paragraphs they are next + ;; to. + (paragraph-start (concat paragraph-start re1)) + (paragraph-separate (concat paragraph-separate re1))) + (save-excursion + (beginning-of-line) + ;; Move up to first line of this comment. + (while (and (not (bobp)) + (looking-at "[ \t]*//[ \t]*[^ \t\n]")) + (forward-line -1)) + (if (not (looking-at ".*//[ \t]*[^ \t\n]")) + (forward-line 1)) + ;; Find the comment start in this line. + (re-search-forward "[ \t]*//[ \t]*") + ;; Set the fill-prefix to be what all lines except the first + ;; should start with. But do not alter a user set fill-prefix. + (if (null fill-prefix) + (setq fill-prefix (buffer-substring (match-beginning 0) + (match-end 0)))) + (save-restriction + ;; Narrow down to just the lines of this comment. + (narrow-to-region (c-point 'bol) + (save-excursion + (forward-line 1) + (while (looking-at fill-prefix) + (forward-line 1)) + (point))) + (fill-paragraph arg) + t))) + ;; else C style comments + (if (or first-line + ;; t if we enter a comment between start of function and + ;; this line. + (eq (c-in-literal) 'c) + ;; t if this line contains a comment starter. + (setq first-line + (save-excursion + (beginning-of-line) + (prog1 + (re-search-forward comment-start-skip + (save-excursion (end-of-line) + (point)) + t) + (setq comment-start-place (point)))))) + ;; Inside a comment: fill one comment paragraph. + (let ((fill-prefix + ;; The prefix for each line of this paragraph + ;; is the appropriate part of the start of this line, + ;; up to the column at which text should be indented. + (save-excursion + (beginning-of-line) + (if (looking-at "[ \t]*/\\*.*\\*/") + (progn (re-search-forward comment-start-skip) + (make-string (current-column) ?\ )) + (if first-line (forward-line 1)) + + (let ((line-width (progn (end-of-line) (current-column)))) + (beginning-of-line) + (prog1 + (buffer-substring + (point) + + ;; How shall we decide where the end of the + ;; fill-prefix is? + (progn + (beginning-of-line) + (skip-chars-forward " \t*" (c-point 'eol)) + ;; kludge alert, watch out for */, in + ;; which case fill-prefix should *not* + ;; be "*"! + (if (and (= (following-char) ?/) + (= (preceding-char) ?*)) + (forward-char -1)) + (point))) + + ;; If the comment is only one line followed + ;; by a blank line, calling move-to-column + ;; above may have added some spaces and tabs + ;; to the end of the line; the fill-paragraph + ;; function will then delete it and the + ;; newline following it, so we'll lose a + ;; blank line when we shouldn't. So delete + ;; anything move-to-column added to the end + ;; of the line. We record the line width + ;; instead of the position of the old line + ;; end because move-to-column might break a + ;; tab into spaces, and the new characters + ;; introduced there shouldn't be deleted. + + ;; If you can see a better way to do this, + ;; please make the change. This seems very + ;; messy to me. + (delete-region (progn (move-to-column line-width) + (point)) + (progn (end-of-line) (point)))))))) + + ;; Lines containing just a comment start or just an end + ;; should not be filled into paragraphs they are next + ;; to. + (paragraph-start (concat paragraph-start re1)) + (paragraph-separate (concat paragraph-separate re1)) + (chars-to-delete 0) + ) + (save-restriction + ;; Don't fill the comment together with the code + ;; following it. So temporarily exclude everything + ;; before the comment start, and everything after the + ;; line where the comment ends. If comment-start-place + ;; is non-nil, the comment starter is there. Otherwise, + ;; point is inside the comment. + (narrow-to-region (save-excursion + (if comment-start-place + (goto-char comment-start-place) + (search-backward "/*")) + (if (and (not c-hanging-comment-starter-p) + (looking-at + (concat c-comment-start-regexp + "[ \t]*$"))) + (forward-line 1)) + ;; Protect text before the comment + ;; start by excluding it. Add + ;; spaces to bring back proper + ;; indentation of that point. + (let ((column (current-column))) + (prog1 (point) + (setq chars-to-delete column) + (insert-char ?\ column)))) + (save-excursion + (if comment-start-place + (goto-char (+ comment-start-place 2))) + (search-forward "*/" nil 'move) + (forward-line 1) + (point))) + (fill-paragraph arg) + (save-excursion + ;; Delete the chars we inserted to avoid clobbering + ;; the stuff before the comment start. + (goto-char (point-min)) + (if (> chars-to-delete 0) + (delete-region (point) (+ (point) chars-to-delete))) + ;; Find the comment ender (should be on last line of + ;; buffer, given the narrowing) and don't leave it on + ;; its own line, unless that's the style that's desired. + (goto-char (point-max)) + (forward-line -1) + (search-forward "*/" nil 'move) + (beginning-of-line) + (if (and c-hanging-comment-ender-p + (looking-at "[ \t]*\\*/")) + ;(delete-indentation))))) + (let ((fill-column (+ fill-column 9999))) + (forward-line -1) + (fill-region-as-paragraph (point) (point-max)))))) + t))))) + + +(provide 'cc-cmds) +;;; cc-cmds.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/cc-compat.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,149 @@ +;;; cc-compat.el --- cc-mode compatibility with c-mode.el confusion + +;; Copyright (C) 1985,87,92,93,94,95,96,97 Free Software Foundation, Inc. + +;; Author: 1994-1997 Barry A. Warsaw +;; Maintainer: cc-mode-help@python.org +;; Created: August 1994, split from cc-mode.el +;; Version: 5.11 +;; Keywords: c languages oop + +;; 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: +;; +;; Boring old c-mode.el (BOCM) is confusion and brain melt. cc-mode.el +;; is clarity of thought and purity of chi. If you are still unwilling +;; to accept enlightenment, this might help, or it may prolong your +;; agony. +;; +;; To use, add the following to your c-mode-hook: +;; +;; (require 'cc-compat) +;; (c-set-style "BOCM") + +;;; Code: + +(eval-when-compile + (load-file "./cc-styles.el") + (load-file "./cc-engine.el")) + + +;; In case c-mode.el isn't loaded +(defvar c-indent-level 2 + "*Indentation of C statements with respect to containing block.") +(defvar c-brace-imaginary-offset 0 + "*Imagined indentation of a C open brace that actually follows a statement.") +(defvar c-brace-offset 0 + "*Extra indentation for braces, compared with other text in same context.") +(defvar c-argdecl-indent 5 + "*Indentation level of declarations of C function arguments.") +(defvar c-label-offset -2 + "*Offset of C label lines and case statements relative to usual indentation.") +(defvar c-continued-statement-offset 2 + "*Extra indent for lines not starting new statements.") +(defvar c-continued-brace-offset 0 + "*Extra indent for substatements that start with open-braces. +This is in addition to c-continued-statement-offset.") + + + +;; these offsets are taken by brute force testing c-mode.el, since +;; there's no logic to what it does. +(let* ((offsets '(c-offsets-alist . + ((defun-block-intro . cc-block-intro-offset) + (statement-block-intro . cc-block-intro-offset) + (defun-open . 0) + (class-open . 0) + (inline-open . c-brace-offset) + (block-open . c-brace-offset) + (block-close . cc-block-close-offset) + (brace-list-open . c-brace-offset) + (substatement-open . cc-substatement-open-offset) + (substatement . c-continued-statement-offset) + (knr-argdecl-intro . c-argdecl-indent) + (case-label . c-label-offset) + (access-label . c-label-offset) + (label . c-label-offset) + )))) + (c-add-style "BOCM" offsets)) + + +(defun cc-block-intro-offset (langelem) + ;; taken directly from calculate-c-indent confusion + (save-excursion + (c-backward-syntactic-ws) + (if (= (preceding-char) ?{) + (forward-char -1) + (goto-char (cdr langelem))) + (let* ((curcol (save-excursion + (goto-char (cdr langelem)) + (current-column))) + (bocm-lossage + ;; If no previous statement, indent it relative to line + ;; brace is on. For open brace in column zero, don't let + ;; statement start there too. If c-indent-level is zero, + ;; use c-brace-offset + c-continued-statement-offset + ;; instead. For open-braces not the first thing in a line, + ;; add in c-brace-imaginary-offset. + (+ (if (and (bolp) (zerop c-indent-level)) + (+ c-brace-offset c-continued-statement-offset) + c-indent-level) + ;; Move back over whitespace before the openbrace. If + ;; openbrace is not first nonwhite thing on the line, + ;; add the c-brace-imaginary-offset. + (progn (skip-chars-backward " \t") + (if (bolp) 0 c-brace-imaginary-offset)) + ;; If the openbrace is preceded by a parenthesized exp, + ;; move to the beginning of that; possibly a different + ;; line + (progn + (if (eq (preceding-char) ?\)) + (forward-sexp -1)) + ;; Get initial indentation of the line we are on. + (current-indentation))))) + (- bocm-lossage curcol)))) + + +(defun cc-block-close-offset (langelem) + (save-excursion + (let* ((here (point)) + bracep + (curcol (progn + (goto-char (cdr langelem)) + (current-column))) + (bocm-lossage (progn + (goto-char (cdr langelem)) + (if (= (following-char) ?{) + (setq bracep t) + (goto-char here) + (beginning-of-line) + (backward-up-list 1) + (forward-char 1) + (c-forward-syntactic-ws)) + (current-column)))) + (- bocm-lossage curcol + (if bracep 0 c-indent-level))))) + + +(defun cc-substatement-open-offset (langelem) + (+ c-continued-statement-offset c-continued-brace-offset)) + + +(provide 'cc-compat) +;;; cc-compat.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/cc-engine.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,1722 @@ +;;; cc-engine.el --- core syntax guessing engine for CC mode + +;; Copyright (C) 1985,87,92,93,94,95,96,97 Free Software Foundation, Inc. + +;; Authors: 1992-1997 Barry A. Warsaw +;; 1987 Dave Detlefs and Stewart Clamen +;; 1985 Richard M. Stallman +;; Maintainer: cc-mode-help@python.org +;; Created: 22-Apr-1997 (split from cc-mode.el) +;; Version: 5.11 +;; Keywords: c languages oop + +;; 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. + + +;; utilities +(defmacro c-add-syntax (symbol &optional relpos) + ;; a simple macro to append the syntax in symbol to the syntax list. + ;; try to increase performance by using this macro + (` (setq syntax (cons (cons (, symbol) (, relpos)) syntax)))) + +(defsubst c-auto-newline () + ;; if auto-newline feature is turned on, insert a newline character + ;; and return t, otherwise return nil. + (and c-auto-newline + (not (c-in-literal)) + (not (newline)))) + +(defsubst c-intersect-lists (list alist) + ;; return the element of ALIST that matches the first element found + ;; in LIST. Uses assq. + (let (match) + (while (and list + (not (setq match (assq (car list) alist)))) + (setq list (cdr list))) + match)) + +(defsubst c-lookup-lists (list alist1 alist2) + ;; first, find the first entry from LIST that is present in ALIST1, + ;; then find the entry in ALIST2 for that entry. + (assq (car (c-intersect-lists list alist1)) alist2)) + + +;; WARNING: Be *exceptionally* careful about modifications to this +;; function! Much of CC Mode depends on this Doing The Right Thing. +;; If you break it you will be sorry. + +(defun c-beginning-of-statement-1 (&optional lim) + ;; move to the start of the current statement, or the previous + ;; statement if already at the beginning of one. + (let ((firstp t) + (substmt-p t) + donep c-in-literal-cache + ;; KLUDGE ALERT: maybe-labelp is used to pass information + ;; between c-crosses-statement-barrier-p and + ;; c-beginning-of-statement-1. A better way should be + ;; implemented. + maybe-labelp saved + (last-begin (point))) + ;; first check for bare semicolon + (if (and (progn (c-backward-syntactic-ws lim) + (= (preceding-char) ?\;)) + (c-safe (progn (forward-char -1) + (setq saved (point)) + t)) + (progn (c-backward-syntactic-ws lim) + (memq (preceding-char) '(?\; ?{ ?} ?:))) + ) + (setq last-begin saved) + (goto-char last-begin) + (while (not donep) + ;; stop at beginning of buffer + (if (bobp) (setq donep t) + ;; go backwards one balanced expression, but be careful of + ;; unbalanced paren being reached + (if (not (c-safe (progn (backward-sexp 1) t))) + (progn + (if firstp + (backward-up-list 1) + (goto-char last-begin)) + ;; skip over any unary operators, or other special + ;; characters appearing at front of identifier + (save-excursion + (c-backward-syntactic-ws lim) + (skip-chars-backward "-+!*&:.~ \t\n") + (if (= (preceding-char) ?\() + (setq last-begin (point)))) + (goto-char last-begin) + (setq last-begin (point) + donep t))) + + (setq maybe-labelp nil) + ;; see if we're in a literal. if not, then this bufpos may be + ;; a candidate for stopping + (cond + ;; CASE 0: did we hit the error condition above? + (donep) + ;; CASE 1: are we in a literal? + ((eq (c-in-literal lim) 'pound) + (beginning-of-line)) + ;; CASE 2: some other kind of literal? + ((c-in-literal lim)) + ;; CASE 3: are we looking at a conditional keyword? + ((or (looking-at c-conditional-key) + (and (= (following-char) ?\() + (save-excursion + (forward-sexp 1) + (c-forward-syntactic-ws) + (/= (following-char) ?\;)) + (let ((here (point)) + (foundp (progn + (c-backward-syntactic-ws lim) + (forward-word -1) + (and lim + (<= lim (point)) + (not (c-in-literal lim)) + (looking-at c-conditional-key) + )))) + ;; did we find a conditional? + (if (not foundp) + (goto-char here)) + foundp))) + ;; are we in the middle of an else-if clause? + (if (save-excursion + (and (not substmt-p) + (c-safe (progn (forward-sexp -1) t)) + (looking-at "\\<else\\>[ \t\n]+\\<if\\>") + (not (c-in-literal lim)))) + (progn + (forward-sexp -1) + (c-backward-to-start-of-if lim))) + ;; are we sitting at an else clause, that we are not a + ;; substatement of? + (if (and (not substmt-p) + (looking-at "\\<else\\>[^_]")) + (c-backward-to-start-of-if lim)) + ;; are we sitting at the while of a do-while? + (if (and (looking-at "\\<while\\>[^_]") + (c-backward-to-start-of-do lim)) + (setq substmt-p nil)) + (setq last-begin (point) + donep substmt-p)) + ;; CASE 4: are we looking at a label? + ((looking-at c-label-key)) + ;; CASE 5: is this the first time we're checking? + (firstp (setq firstp nil + substmt-p (not (c-crosses-statement-barrier-p + (point) last-begin)) + last-begin (point))) + ;; CASE 6: have we crossed a statement barrier? + ((c-crosses-statement-barrier-p (point) last-begin) + (setq donep t)) + ;; CASE 7: ignore labels + ((and maybe-labelp + (or (and c-access-key (looking-at c-access-key)) + ;; with switch labels, we have to go back further + ;; to try to pick up the case or default + ;; keyword. Potential bogosity alert: we assume + ;; `case' or `default' is first thing on line + (let ((here (point))) + (beginning-of-line) + (c-forward-syntactic-ws) + (if (looking-at c-switch-label-key) + t + (goto-char here) + nil)) + (looking-at c-label-key)))) + ;; CASE 8: ObjC or Java method def + ((and c-method-key + (setq last-begin (c-in-method-def-p))) + (setq donep t)) + ;; CASE 9: nothing special + (t (setq last-begin (point))) + )))) + (goto-char last-begin) + ;; we always do want to skip over non-whitespace modifier + ;; characters that didn't get skipped above + (skip-chars-backward "-+!*&:.~" (c-point 'boi)))) + +(defun c-end-of-statement-1 () + (condition-case () + (progn + (while (and (not (eobp)) + (let ((beg (point))) + (forward-sexp 1) + (let ((end (point))) + (save-excursion + (goto-char beg) + (not (re-search-forward "[;{}]" end t))))))) + (re-search-backward "[;}]") + (forward-char 1)) + (error + (let ((beg (point))) + (backward-up-list -1) + (let ((end (point))) + (goto-char beg) + (search-forward ";" end 'move)))))) + + + +(defun c-crosses-statement-barrier-p (from to) + ;; Does buffer positions FROM to TO cross a C statement boundary? + (let ((here (point)) + (lim from) + crossedp) + (condition-case () + (progn + (goto-char from) + (while (and (not crossedp) + (< (point) to)) + (skip-chars-forward "^;{}:" to) + (if (not (c-in-literal lim)) + (progn + (if (memq (following-char) '(?\; ?{ ?})) + (setq crossedp t) + (if (= (following-char) ?:) + (setq maybe-labelp t)) + (forward-char 1)) + (setq lim (point))) + (forward-char 1)))) + (error (setq crossedp nil))) + (goto-char here) + crossedp)) + + +;; Skipping of "syntactic whitespace", defined as lexical whitespace, +;; C and C++ style comments, and preprocessor directives. Search no +;; farther back or forward than optional LIM. If LIM is omitted, +;; `beginning-of-defun' is used for backward skipping, point-max is +;; used for forward skipping. + +(defun c-forward-syntactic-ws (&optional lim) + ;; Forward skip of syntactic whitespace for Emacs 19. + (save-restriction + (let* ((lim (or lim (point-max))) + (here lim) + (hugenum (point-max))) + (narrow-to-region lim (point)) + (while (/= here (point)) + (setq here (point)) + (forward-comment hugenum) + ;; skip preprocessor directives + (if (and (= (following-char) ?#) + (= (c-point 'boi) (point))) + (end-of-line) + ))))) + +(defun c-backward-syntactic-ws (&optional lim) + ;; Backward skip over syntactic whitespace for Emacs 19. + (save-restriction + (let* ((lim (or lim (c-point 'bod))) + (here lim) + (hugenum (- (point-max)))) + (if (< lim (point)) + (progn + (narrow-to-region lim (point)) + (while (/= here (point)) + (setq here (point)) + (forward-comment hugenum) + (if (eq (c-in-literal lim) 'pound) + (beginning-of-line)) + ))) + ))) + + +;; Return `c' if in a C-style comment, `c++' if in a C++ style +;; comment, `string' if in a string literal, `pound' if on a +;; preprocessor line, or nil if not in a comment at all. Optional LIM +;; is used as the backward limit of the search. If omitted, or nil, +;; `beginning-of-defun' is used." + +(defun c-in-literal (&optional lim) + ;; Determine if point is in a C++ literal. we cache the last point + ;; calculated if the cache is enabled + (if (and (boundp 'c-in-literal-cache) + c-in-literal-cache + (= (point) (aref c-in-literal-cache 0))) + (aref c-in-literal-cache 1) + (let ((rtn (save-excursion + (let* ((lim (or lim (c-point 'bod))) + (here (point)) + (state (parse-partial-sexp lim (point)))) + (cond + ((nth 3 state) 'string) + ((nth 4 state) (if (nth 7 state) 'c++ 'c)) + ((progn + (goto-char here) + (beginning-of-line) + (looking-at "[ \t]*#")) + 'pound) + (t nil)))))) + ;; cache this result if the cache is enabled + (and (boundp 'c-in-literal-cache) + (setq c-in-literal-cache (vector (point) rtn))) + rtn))) + + +;; utilities for moving and querying around syntactic elements + +(defun c-parse-state () + ;; Finds and records all open parens between some important point + ;; earlier in the file and point. + ;; + ;; if there's a state cache, return it + (if (boundp 'c-state-cache) c-state-cache + (let* (at-bob + (pos (save-excursion + ;; go back 2 bods, but ignore any bogus positions + ;; returned by beginning-of-defun (i.e. open paren + ;; in column zero) + (let ((cnt 2)) + (while (not (or at-bob (zerop cnt))) + (beginning-of-defun) + (if (= (following-char) ?\{) + (setq cnt (1- cnt))) + (if (bobp) + (setq at-bob t)))) + (point))) + (here (save-excursion + ;;(skip-chars-forward " \t}") + (point))) + (last-bod pos) (last-pos pos) + placeholder state sexp-end) + ;; cache last bod position + (while (catch 'backup-bod + (setq state nil) + (while (and pos (< pos here)) + (setq last-pos pos) + (if (and (setq pos (c-safe (scan-lists pos 1 -1))) + (<= pos here)) + (progn + (setq sexp-end (c-safe (scan-sexps (1- pos) 1))) + (if (and sexp-end + (<= sexp-end here)) + ;; we want to record both the start and end + ;; of this sexp, but we only want to record + ;; the last-most of any of them before here + (progn + (if (= (char-after (1- pos)) ?\{) + (setq state (cons (cons (1- pos) sexp-end) + (if (consp (car state)) + (cdr state) + state)))) + (setq pos sexp-end)) + ;; we're contained in this sexp so put pos on + ;; front of list + (setq state (cons (1- pos) state)))) + ;; something bad happened. check to see if we + ;; crossed an unbalanced close brace. if so, we + ;; didn't really find the right `important bufpos' + ;; so lets back up and try again + (if (and (not pos) (not at-bob) + (setq placeholder + (c-safe (scan-lists last-pos 1 1))) + ;;(char-after (1- placeholder)) + (<= placeholder here) + (= (char-after (1- placeholder)) ?\})) + (while t + (setq last-bod (c-safe (scan-lists last-bod -1 1))) + (if (not last-bod) + (error "unbalanced close brace at position %d" + (1- placeholder)) + (setq at-bob (= last-bod (point-min)) + pos last-bod) + (if (= (char-after last-bod) ?\{) + (throw 'backup-bod t))) + )) ;end-if + )) ;end-while + nil)) + state))) + +(defun c-whack-state (bufpos state) + ;; whack off any state information that appears on STATE which lies + ;; after the bounds of BUFPOS. + (let (newstate car) + (while state + (setq car (car state) + state (cdr state)) + (if (consp car) + ;; just check the car, because in a balanced brace + ;; expression, it must be impossible for the corresponding + ;; close brace to be before point, but the open brace to be + ;; after. + (if (<= bufpos (car car)) + nil ; whack it off + ;; its possible that the open brace is before bufpos, but + ;; the close brace is after. In that case, convert this + ;; to a non-cons element. + (if (<= bufpos (cdr car)) + (setq newstate (append newstate (list (car car)))) + ;; we know that both the open and close braces are + ;; before bufpos, so we also know that everything else + ;; on state is before bufpos, so we can glom up the + ;; whole thing and exit. + (setq newstate (append newstate (list car) state) + state nil))) + (if (<= bufpos car) + nil ; whack it off + ;; it's before bufpos, so everything else should too + (setq newstate (append newstate (list car) state) + state nil)))) + newstate)) + +(defun c-hack-state (bufpos which state) + ;; Using BUFPOS buffer position, and WHICH (must be 'open or + ;; 'close), hack the c-parse-state STATE and return the results. + (if (eq which 'open) + (let ((car (car state))) + (if (or (null car) + (consp car) + (/= bufpos car)) + (cons bufpos state) + state)) + (if (not (eq which 'close)) + (error "c-hack-state, bad argument: %s" which)) + ;; 'close brace + (let ((car (car state)) + (cdr (cdr state))) + (if (consp car) + (setq car (car cdr) + cdr (cdr cdr))) + ;; TBD: is this test relevant??? + (if (consp car) + state ;on error, don't change + ;; watch out for balanced expr already on cdr of list + (cons (cons car bufpos) + (if (consp (car cdr)) + (cdr cdr) cdr)) + )))) + +(defun c-adjust-state (from to shift state) + ;; Adjust all points in state that lie in the region FROM..TO by + ;; SHIFT amount (as would be returned by c-indent-line). + (mapcar + (function + (lambda (e) + (if (consp e) + (let ((car (car e)) + (cdr (cdr e))) + (if (and (<= from car) (< car to)) + (setcar e (+ shift car))) + (if (and (<= from cdr) (< cdr to)) + (setcdr e (+ shift cdr)))) + (if (and (<= from e) (< e to)) + (setq e (+ shift e)))) + e)) + state)) + + +(defun c-beginning-of-inheritance-list (&optional lim) + ;; Go to the first non-whitespace after the colon that starts a + ;; multiple inheritance introduction. Optional LIM is the farthest + ;; back we should search. + (let ((lim (or lim (c-point 'bod))) + (placeholder (progn + (back-to-indentation) + (point)))) + (c-backward-syntactic-ws lim) + (while (and (> (point) lim) + (memq (preceding-char) '(?, ?:)) + (progn + (beginning-of-line) + (setq placeholder (point)) + (skip-chars-forward " \t") + (not (looking-at c-class-key)) + )) + (c-backward-syntactic-ws lim)) + (goto-char placeholder) + (skip-chars-forward "^:" (c-point 'eol)))) + +(defun c-beginning-of-macro (&optional lim) + ;; Go to the beginning of the macro. Right now we don't support + ;; multi-line macros too well + (back-to-indentation)) + +(defun c-in-method-def-p () + ;; Return nil if we aren't in a method definition, otherwise the + ;; position of the initial [+-]. + (save-excursion + (beginning-of-line) + (and c-method-key + (looking-at c-method-key) + (point)) + )) + +(defun c-just-after-func-arglist-p (&optional containing) + ;; Return t if we are between a function's argument list closing + ;; paren and its opening brace. Note that the list close brace + ;; could be followed by a "const" specifier or a member init hanging + ;; colon. Optional CONTAINING is position of containing s-exp open + ;; brace. If not supplied, point is used as search start. + (save-excursion + (c-backward-syntactic-ws) + (let ((checkpoint (or containing (point)))) + (goto-char checkpoint) + ;; could be looking at const specifier + (if (and (= (preceding-char) ?t) + (forward-word -1) + (looking-at "\\<const\\>")) + (c-backward-syntactic-ws) + ;; otherwise, we could be looking at a hanging member init + ;; colon + (goto-char checkpoint) + (if (and (= (preceding-char) ?:) + (progn + (forward-char -1) + (c-backward-syntactic-ws) + (looking-at "[ \t\n]*:\\([^:]+\\|$\\)"))) + nil + (goto-char checkpoint)) + ) + (and (= (preceding-char) ?\)) + ;; check if we are looking at a method def + (or (not c-method-key) + (progn + (forward-sexp -1) + (forward-char -1) + (c-backward-syntactic-ws) + (not (or (= (preceding-char) ?-) + (= (preceding-char) ?+) + ;; or a class category + (progn + (forward-sexp -2) + (looking-at c-class-key)) + ))))) + ))) + +;; defuns to look backwards for things +(defun c-backward-to-start-of-do (&optional lim) + ;; Move to the start of the last "unbalanced" do expression. + ;; Optional LIM is the farthest back to search. If none is found, + ;; nil is returned and point is left unchanged, otherwise t is returned. + (let ((do-level 1) + (case-fold-search nil) + (lim (or lim (c-point 'bod))) + (here (point)) + foundp) + (while (not (zerop do-level)) + ;; we protect this call because trying to execute this when the + ;; while is not associated with a do will throw an error + (condition-case nil + (progn + (backward-sexp 1) + (cond + ((memq (c-in-literal lim) '(c c++))) + ((looking-at "while\\b[^_]") + (setq do-level (1+ do-level))) + ((looking-at "do\\b[^_]") + (if (zerop (setq do-level (1- do-level))) + (setq foundp t))) + ((<= (point) lim) + (setq do-level 0) + (goto-char lim)))) + (error + (goto-char lim) + (setq do-level 0)))) + (if (not foundp) + (goto-char here)) + foundp)) + +(defun c-backward-to-start-of-if (&optional lim) + ;; Move to the start of the last "unbalanced" if and return t. If + ;; none is found, and we are looking at an if clause, nil is + ;; returned. If none is found and we are looking at an else clause, + ;; an error is thrown. + (let ((if-level 1) + (here (c-point 'bol)) + (case-fold-search nil) + (lim (or lim (c-point 'bod))) + (at-if (looking-at "if\\b[^_]"))) + (catch 'orphan-if + (while (and (not (bobp)) + (not (zerop if-level))) + (c-backward-syntactic-ws) + (condition-case nil + (backward-sexp 1) + (error + (if at-if + (throw 'orphan-if nil) + (error "No matching `if' found for `else' on line %d." + (1+ (count-lines 1 here)))))) + (cond + ((looking-at "else\\b[^_]") + (setq if-level (1+ if-level))) + ((looking-at "if\\b[^_]") + ;; check for else if... skip over + (let ((here (point))) + (c-safe (forward-sexp -1)) + (if (looking-at "\\<else\\>[ \t]+\\<if\\>") + nil + (setq if-level (1- if-level)) + (goto-char here)))) + ((< (point) lim) + (setq if-level 0) + (goto-char lim)) + )) + t))) + +(defun c-skip-conditional () + ;; skip forward over conditional at point, including any predicate + ;; statements in parentheses. No error checking is performed. + (forward-sexp (cond + ;; else if() + ((looking-at "\\<else\\>[ \t]+\\<if\\>") 3) + ;; do, else, try, finally + ((looking-at "\\<\\(do\\|else\\|try\\|finally\\)\\>") 1) + ;; for, if, while, switch, catch, synchronized + (t 2)))) + +(defun c-skip-case-statement-forward (state &optional lim) + ;; skip forward over case/default bodies, with optional maximal + ;; limit. if no next case body is found, nil is returned and point + ;; is not moved + (let ((lim (or lim (point-max))) + (here (point)) + donep foundp bufpos + (safepos (point)) + (balanced (car state))) + ;; search until we've passed the limit, or we've found our match + (while (and (< (point) lim) + (not donep)) + (setq safepos (point)) + ;; see if we can find a case statement, not in a literal + (if (and (re-search-forward c-switch-label-key lim 'move) + (setq bufpos (match-beginning 0)) + (not (c-in-literal safepos)) + (/= bufpos here)) + ;; if we crossed into a balanced sexp, we know the case is + ;; not part of our switch statement, so just bound over the + ;; sexp and keep looking. + (if (and (consp balanced) + (> bufpos (car balanced)) + (< bufpos (cdr balanced))) + (goto-char (cdr balanced)) + (goto-char bufpos) + (setq donep t + foundp t)))) + (if (not foundp) + (goto-char here)) + foundp)) + +(defun c-search-uplist-for-classkey (brace-state) + ;; search for the containing class, returning a 2 element vector if + ;; found. aref 0 contains the bufpos of the class key, and aref 1 + ;; contains the bufpos of the open brace. + (if (null brace-state) + ;; no brace-state means we cannot be inside a class + nil + (let ((carcache (car brace-state)) + search-start search-end) + (if (consp carcache) + ;; a cons cell in the first element means that there is some + ;; balanced sexp before the current bufpos. this we can + ;; ignore. the nth 1 and nth 2 elements define for us the + ;; search boundaries + (setq search-start (nth 2 brace-state) + search-end (nth 1 brace-state)) + ;; if the car was not a cons cell then nth 0 and nth 1 define + ;; for us the search boundaries + (setq search-start (nth 1 brace-state) + search-end (nth 0 brace-state))) + ;; search-end cannot be a cons cell + (and (consp search-end) + (error "consp search-end: %s" search-end)) + ;; if search-end is nil, or if the search-end character isn't an + ;; open brace, we are definitely not in a class + (if (or (not search-end) + (< search-end (point-min)) + (/= (char-after search-end) ?{)) + nil + ;; now, we need to look more closely at search-start. if + ;; search-start is nil, then our start boundary is really + ;; point-min. + (if (not search-start) + (setq search-start (point-min)) + ;; if search-start is a cons cell, then we can start + ;; searching from the end of the balanced sexp just ahead of + ;; us + (if (consp search-start) + (setq search-start (cdr search-start)))) + ;; now we can do a quick regexp search from search-start to + ;; search-end and see if we can find a class key. watch for + ;; class like strings in literals + (save-excursion + (save-restriction + (goto-char search-start) + (let ((search-key (concat c-class-key "\\|extern[^_]")) + foundp class match-end) + (while (and (not foundp) + (progn + (c-forward-syntactic-ws) + (> search-end (point))) + (re-search-forward search-key search-end t)) + (setq class (match-beginning 0) + match-end (match-end 0)) + (if (c-in-literal search-start) + nil ; its in a comment or string, ignore + (goto-char class) + (skip-chars-forward " \t\n") + (setq foundp (vector (c-point 'boi) search-end)) + (cond + ;; check for embedded keywords + ((let ((char (char-after (1- class)))) + (and char + (memq (char-syntax char) '(?w ?_)))) + (goto-char match-end) + (setq foundp nil)) + ;; make sure we're really looking at the start of a + ;; class definition, and not a forward decl, return + ;; arg, template arg list, or an ObjC or Java method. + ((and c-method-key + (re-search-forward c-method-key search-end t)) + (setq foundp nil)) + ;; Its impossible to define a regexp for this, and + ;; nearly so to do it programmatically. + ;; + ;; ; picks up forward decls + ;; = picks up init lists + ;; ) picks up return types + ;; > picks up templates, but remember that we can + ;; inherit from templates! + ((let ((skipchars "^;=)")) + ;; try to see if we found the `class' keyword + ;; inside a template arg list + (save-excursion + (skip-chars-backward "^<>" search-start) + (if (= (preceding-char) ?<) + (setq skipchars (concat skipchars ">")))) + (skip-chars-forward skipchars search-end) + (/= (point) search-end)) + (setq foundp nil)) + ))) + foundp)) + ))))) + +(defun c-inside-bracelist-p (containing-sexp brace-state) + ;; return the buffer position of the beginning of the brace list + ;; statement if we're inside a brace list, otherwise return nil. + ;; CONTAINING-SEXP is the buffer pos of the innermost containing + ;; paren. BRACE-STATE is the remainder of the state of enclosing braces + ;; + ;; N.B.: This algorithm can potentially get confused by cpp macros + ;; places in inconvenient locations. Its a trade-off we make for + ;; speed. + (or + ;; this will pick up enum lists + (condition-case () + (save-excursion + (goto-char containing-sexp) + (forward-sexp -1) + (if (or (looking-at "enum[\t\n ]+") + (progn (forward-sexp -1) + (looking-at "enum[\t\n ]+"))) + (point))) + (error nil)) + ;; this will pick up array/aggregate init lists, even if they are nested. + (save-excursion + (let (bufpos failedp) + (while (and (not bufpos) + containing-sexp) + (if (consp containing-sexp) + (setq containing-sexp (car brace-state) + brace-state (cdr brace-state)) + ;; see if significant character just before brace is an equal + (goto-char containing-sexp) + (setq failedp nil) + (condition-case () + (progn + (forward-sexp -1) + (forward-sexp 1) + (c-forward-syntactic-ws containing-sexp)) + (error (setq failedp t))) + (if (or failedp (/= (following-char) ?=)) + ;; lets see if we're nested. find the most nested + ;; containing brace + (setq containing-sexp (car brace-state) + brace-state (cdr brace-state)) + ;; we've hit the beginning of the aggregate list + (c-beginning-of-statement-1 (c-most-enclosing-brace brace-state)) + (setq bufpos (point))) + )) + bufpos)) + )) + + +(defun c-most-enclosing-brace (state) + ;; return the bufpos of the most enclosing brace that hasn't been + ;; narrowed out by any enclosing class, or nil if none was found + (let (enclosingp) + (while (and state (not enclosingp)) + (setq enclosingp (car state) + state (cdr state)) + (if (consp enclosingp) + (setq enclosingp nil) + (if (> (point-min) enclosingp) + (setq enclosingp nil)) + (setq state nil))) + enclosingp)) + +(defun c-least-enclosing-brace (state) + ;; return the bufpos of the least (highest) enclosing brace that + ;; hasn't been narrowed out by any enclosing class, or nil if none + ;; was found. + (c-most-enclosing-brace (nreverse state))) + +(defun c-safe-position (bufpos state) + ;; return the closest known safe position higher up than point + (let ((safepos nil)) + (while state + (setq safepos + (if (consp (car state)) + (cdr (car state)) + (car state))) + (if (< safepos bufpos) + (setq state nil) + (setq state (cdr state)))) + safepos)) + +(defun c-narrow-out-enclosing-class (state lim) + ;; narrow the buffer so that the enclosing class is hidden + (let (inclass-p) + (and state + (setq inclass-p (c-search-uplist-for-classkey state)) + (narrow-to-region + (progn + (goto-char (1+ (aref inclass-p 1))) + (skip-chars-forward " \t\n" lim) + ;; if point is now left of the class opening brace, we're + ;; hosed, so try a different tact + (if (<= (point) (aref inclass-p 1)) + (progn + (goto-char (1+ (aref inclass-p 1))) + (c-forward-syntactic-ws lim))) + (point)) + ;; end point is the end of the current line + (progn + (goto-char lim) + (c-point 'eol)))) + ;; return the class vector + inclass-p)) + + +;; This function implements the main decision tree for determining the +;; syntactic analysis of the current line of code. Yes, it's huge and +;; bloated! + +(defun c-guess-basic-syntax () + (save-excursion + (save-restriction + (beginning-of-line) + (let* ((indent-point (point)) + (case-fold-search nil) + (fullstate (c-parse-state)) + (state fullstate) + (in-method-intro-p (and (eq major-mode 'objc-mode) + c-method-key + (looking-at c-method-key))) + literal containing-sexp char-before-ip char-after-ip lim + syntax placeholder c-in-literal-cache inswitch-p + injava-inher + ;; narrow out any enclosing class or extern "C" block + (inclass-p (c-narrow-out-enclosing-class state indent-point)) + (inextern-p (and inclass-p + (save-excursion + (save-restriction + (widen) + (goto-char (aref inclass-p 0)) + (looking-at "extern[^_]"))))) + ) + + ;; get the buffer position of the most nested opening brace, + ;; if there is one, and it hasn't been narrowed out + (save-excursion + (goto-char indent-point) + (skip-chars-forward " \t}") + (skip-chars-backward " \t") + (while (and state + (not in-method-intro-p) + (not containing-sexp)) + (setq containing-sexp (car state) + state (cdr state)) + (if (consp containing-sexp) + ;; if cdr == point, then containing sexp is the brace + ;; that opens the sexp we close + (if (= (cdr containing-sexp) (point)) + (setq containing-sexp (car containing-sexp)) + ;; otherwise, ignore this element + (setq containing-sexp nil)) + ;; ignore the bufpos if its been narrowed out by the + ;; containing class + (if (<= containing-sexp (point-min)) + (setq containing-sexp nil))))) + + ;; set the limit on the farthest back we need to search + (setq lim (or containing-sexp + (if (consp (car fullstate)) + (cdr (car fullstate)) + nil) + (point-min))) + + ;; cache char before and after indent point, and move point to + ;; the most likely position to perform the majority of tests + (goto-char indent-point) + (skip-chars-forward " \t") + (setq char-after-ip (following-char)) + (c-backward-syntactic-ws lim) + (setq char-before-ip (preceding-char)) + (goto-char indent-point) + (skip-chars-forward " \t") + + ;; are we in a literal? + (setq literal (c-in-literal lim)) + + ;; now figure out syntactic qualities of the current line + (cond + ;; CASE 1: in a string. + ((memq literal '(string)) + (c-add-syntax 'string (c-point 'bopl))) + ;; CASE 2: in a C or C++ style comment. + ((memq literal '(c c++)) + ;; we need to catch multi-paragraph C comments + (while (and (zerop (forward-line -1)) + (looking-at "^[ \t]*$"))) + (c-add-syntax literal (c-point 'boi))) + ;; CASE 3: in a cpp preprocessor + ((eq literal 'pound) + (c-beginning-of-macro lim) + (c-add-syntax 'cpp-macro (c-point 'boi))) + ;; CASE 4: in an objective-c method intro + (in-method-intro-p + (c-add-syntax 'objc-method-intro (c-point 'boi))) + ;; CASE 5: Line is at top level. + ((null containing-sexp) + (cond + ;; CASE 5A: we are looking at a defun, class, or + ;; inline-inclass method opening brace + ((= char-after-ip ?{) + (cond + ;; CASE 5A.1: extern declaration + ((save-excursion + (goto-char indent-point) + (skip-chars-forward " \t") + (and (c-safe (progn (backward-sexp 2) t)) + (looking-at "extern[^_]") + (progn + (setq placeholder (point)) + (forward-sexp 1) + (c-forward-syntactic-ws) + (= (following-char) ?\")))) + (goto-char placeholder) + (c-add-syntax 'extern-lang-open (c-point 'boi))) + ;; CASE 5A.2: we are looking at a class opening brace + ((save-excursion + (goto-char indent-point) + (skip-chars-forward " \t{") + ;; TBD: watch out! there could be a bogus + ;; c-state-cache in place when we get here. we have + ;; to go through much chicanery to ignore the cache. + ;; But of course, there may not be! BLECH! BOGUS! + (let ((decl + (if (boundp 'c-state-cache) + (let ((old-cache c-state-cache)) + (prog2 + (makunbound 'c-state-cache) + (c-search-uplist-for-classkey (c-parse-state)) + (setq c-state-cache old-cache))) + (c-search-uplist-for-classkey (c-parse-state)) + ))) + (and decl + (setq placeholder (aref decl 0))) + )) + (c-add-syntax 'class-open placeholder)) + ;; CASE 5A.3: brace list open + ((save-excursion + (c-beginning-of-statement-1 lim) + ;; c-b-o-s could have left us at point-min + (and (bobp) + (c-forward-syntactic-ws indent-point)) + (if (looking-at "typedef[^_]") + (progn (forward-sexp 1) + (c-forward-syntactic-ws indent-point))) + (setq placeholder (c-point 'boi)) + (and (or (looking-at "enum[ \t\n]+") + (= char-before-ip ?=)) + (save-excursion + (skip-chars-forward "^;(" indent-point) + (not (memq (following-char) '(?\; ?\())) + ))) + (c-add-syntax 'brace-list-open placeholder)) + ;; CASE 5A.4: inline defun open + ((and inclass-p (not inextern-p)) + (c-add-syntax 'inline-open) + (c-add-syntax 'inclass (aref inclass-p 0))) + ;; CASE 5A.5: ordinary defun open + (t + (goto-char placeholder) + (c-add-syntax 'defun-open (c-point 'bol)) + ))) + ;; CASE 5B: first K&R arg decl or member init + ((c-just-after-func-arglist-p) + (cond + ;; CASE 5B.1: a member init + ((or (= char-before-ip ?:) + (= char-after-ip ?:)) + ;; this line should be indented relative to the beginning + ;; of indentation for the topmost-intro line that contains + ;; the prototype's open paren + ;; TBD: is the following redundant? + (if (= char-before-ip ?:) + (forward-char -1)) + (c-backward-syntactic-ws lim) + ;; TBD: is the preceding redundant? + (if (= (preceding-char) ?:) + (progn (forward-char -1) + (c-backward-syntactic-ws lim))) + (if (= (preceding-char) ?\)) + (backward-sexp 1)) + (setq placeholder (point)) + (save-excursion + (and (c-safe (backward-sexp 1) t) + (looking-at "throw[^_]") + (c-safe (backward-sexp 1) t) + (setq placeholder (point)))) + (goto-char placeholder) + (c-add-syntax 'member-init-intro (c-point 'boi)) + ;; we don't need to add any class offset since this + ;; should be relative to the ctor's indentation + ) + ;; CASE 5B.2: K&R arg decl intro + (c-recognize-knr-p + (c-add-syntax 'knr-argdecl-intro (c-point 'boi)) + (and inclass-p (c-add-syntax 'inclass (aref inclass-p 0)))) + ;; CASE 5B.3: Nether region after a C++ or Java func + ;; decl, which could include a `throws' declaration. + (t + (c-beginning-of-statement-1 lim) + (c-add-syntax 'func-decl-cont (c-point 'boi)) + ))) + ;; CASE 5C: inheritance line. could be first inheritance + ;; line, or continuation of a multiple inheritance + ((or (and c-baseclass-key (looking-at c-baseclass-key)) + (and (or (= char-before-ip ?:) + ;; watch out for scope operator + (save-excursion + (and (= char-after-ip ?:) + (c-safe (progn (forward-char 1) t)) + (/= (following-char) ?:) + ))) + (save-excursion + (c-backward-syntactic-ws lim) + (if (= char-before-ip ?:) + (progn + (forward-char -1) + (c-backward-syntactic-ws lim))) + (back-to-indentation) + (looking-at c-class-key))) + ;; for Java + (and (eq major-mode 'java-mode) + (let ((fence (save-excursion + (c-beginning-of-statement-1 lim) + (point))) + cont done) + (save-excursion + (while (not done) + (cond ((looking-at c-Java-special-key) + (setq injava-inher (cons cont (point)) + done t)) + ((or (not (c-safe (forward-sexp -1) t)) + (<= (point) fence)) + (setq done t)) + ) + (setq cont t))) + injava-inher) + (not (c-crosses-statement-barrier-p (cdr injava-inher) + (point))) + )) + (cond + ;; CASE 5C.1: non-hanging colon on an inher intro + ((= char-after-ip ?:) + (c-backward-syntactic-ws lim) + (c-add-syntax 'inher-intro (c-point 'boi)) + ;; don't add inclass symbol since relative point already + ;; contains any class offset + ) + ;; CASE 5C.2: hanging colon on an inher intro + ((= char-before-ip ?:) + (c-add-syntax 'inher-intro (c-point 'boi)) + (and inclass-p (c-add-syntax 'inclass (aref inclass-p 0)))) + ;; CASE 5C.3: in a Java implements/extends + (injava-inher + (let ((where (cdr injava-inher)) + (cont (car injava-inher))) + (goto-char where) + (cond ((looking-at "throws[ \t\n]") + (c-add-syntax 'func-decl-cont + (progn (c-beginning-of-statement-1 lim) + (c-point 'boi)))) + (cont (c-add-syntax 'inher-cont where)) + (t (c-add-syntax 'inher-intro + (progn (goto-char (cdr injava-inher)) + (c-beginning-of-statement-1 lim) + (point)))) + ))) + ;; CASE 5C.4: a continued inheritance line + (t + (c-beginning-of-inheritance-list lim) + (c-add-syntax 'inher-cont (point)) + ;; don't add inclass symbol since relative point already + ;; contains any class offset + ))) + ;; CASE 5D: this could be a top-level compound statement or a + ;; member init list continuation + ((= char-before-ip ?,) + (goto-char indent-point) + (c-backward-syntactic-ws lim) + (while (and (< lim (point)) + (= (preceding-char) ?,)) + ;; this will catch member inits with multiple + ;; line arglists + (forward-char -1) + (c-backward-syntactic-ws (c-point 'bol)) + (if (= (preceding-char) ?\)) + (backward-sexp 1)) + ;; now continue checking + (beginning-of-line) + (c-backward-syntactic-ws lim)) + (cond + ;; CASE 5D.1: hanging member init colon, but watch out + ;; for bogus matches on access specifiers inside classes. + ((and (= (preceding-char) ?:) + (save-excursion + (forward-word -1) + (not (looking-at c-access-key)))) + (goto-char indent-point) + (c-backward-syntactic-ws lim) + (c-safe (backward-sexp 1)) + (c-add-syntax 'member-init-cont (c-point 'boi)) + ;; we do not need to add class offset since relative + ;; point is the member init above us + ) + ;; CASE 5D.2: non-hanging member init colon + ((progn + (c-forward-syntactic-ws indent-point) + (= (following-char) ?:)) + (skip-chars-forward " \t:") + (c-add-syntax 'member-init-cont (point))) + ;; CASE 5D.3: perhaps a multiple inheritance line? + ((looking-at c-inher-key) + (c-add-syntax 'inher-cont (c-point 'boi))) + ;; CASE 5D.4: perhaps a template list continuation? + ((save-excursion + (skip-chars-backward "^<" lim) + ;; not sure if this is the right test, but it should + ;; be fast and mostly accurate. + (and (= (preceding-char) ?<) + (not (c-in-literal lim)))) + ;; we can probably indent it just like and arglist-cont + (c-add-syntax 'arglist-cont (point))) + ;; CASE 5D.5: perhaps a top-level statement-cont + (t + (c-beginning-of-statement-1 lim) + ;; skip over any access-specifiers + (and inclass-p c-access-key + (while (looking-at c-access-key) + (forward-line 1))) + ;; skip over comments, whitespace + (c-forward-syntactic-ws indent-point) + (c-add-syntax 'statement-cont (c-point 'boi))) + )) + ;; CASE 5E: we are looking at a access specifier + ((and inclass-p + c-access-key + (looking-at c-access-key)) + (c-add-syntax 'access-label (c-point 'bonl)) + (c-add-syntax 'inclass (aref inclass-p 0))) + ;; CASE 5F: extern-lang-close? + ((and inextern-p + (= char-after-ip ?})) + (c-add-syntax 'extern-lang-close (aref inclass-p 1))) + ;; CASE 5G: we are looking at the brace which closes the + ;; enclosing nested class decl + ((and inclass-p + (= char-after-ip ?}) + (save-excursion + (save-restriction + (widen) + (forward-char 1) + (and + (condition-case nil + (progn (backward-sexp 1) t) + (error nil)) + (= (point) (aref inclass-p 1)) + )))) + (save-restriction + (widen) + (goto-char (aref inclass-p 0)) + (c-add-syntax 'class-close (c-point 'boi)))) + ;; CASE 5H: we could be looking at subsequent knr-argdecls + ((and c-recognize-knr-p + ;; here we essentially use the hack that is used in + ;; Emacs' c-mode.el to limit how far back we should + ;; look. The assumption is made that argdecls are + ;; indented at least one space and that function + ;; headers are not indented. + (let ((limit (save-excursion + (re-search-backward "^[^ \^L\t\n#]" nil 'move) + (point)))) + (save-excursion + (c-backward-syntactic-ws limit) + (setq placeholder (point)) + (while (and (memq (preceding-char) '(?\; ?,)) + (> (point) limit)) + (beginning-of-line) + (setq placeholder (point)) + (c-backward-syntactic-ws limit)) + (and (= (preceding-char) ?\)) + (or (not c-method-key) + (progn + (forward-sexp -1) + (forward-char -1) + (c-backward-syntactic-ws) + (not (or (= (preceding-char) ?-) + (= (preceding-char) ?+) + ;; or a class category + (progn + (forward-sexp -2) + (looking-at c-class-key)) + ))))) + )) + (save-excursion + (c-beginning-of-statement-1) + (not (looking-at "typedef[ \t\n]+")))) + (goto-char placeholder) + (c-add-syntax 'knr-argdecl (c-point 'boi))) + ;; CASE 5I: we are at the topmost level, make sure we skip + ;; back past any access specifiers + ((progn + (c-backward-syntactic-ws lim) + (while (and inclass-p + c-access-key + (not (bobp)) + (save-excursion + (c-safe (progn (backward-sexp 1) t)) + (looking-at c-access-key))) + (backward-sexp 1) + (c-backward-syntactic-ws lim)) + (or (bobp) + (memq (preceding-char) '(?\; ?\})))) + ;; real beginning-of-line could be narrowed out due to + ;; enclosure in a class block + (save-restriction + (widen) + (c-add-syntax 'topmost-intro (c-point 'bol)) + (if inclass-p + (progn + (goto-char (aref inclass-p 1)) + (if inextern-p + (c-add-syntax 'inextern-lang) + (c-add-syntax 'inclass (c-point 'boi))))) + )) + ;; CASE 5J: we are at an ObjC or Java method definition + ;; continuation line. + ((and c-method-key + (progn + (c-beginning-of-statement-1 lim) + (beginning-of-line) + (looking-at c-method-key))) + (c-add-syntax 'objc-method-args-cont (point))) + ;; CASE 5K: we are at a topmost continuation line + (t + (c-beginning-of-statement-1 lim) + (c-forward-syntactic-ws) + (c-add-syntax 'topmost-intro-cont (c-point 'boi))) + )) ; end CASE 5 + ;; CASE 6: line is an expression, not a statement. Most + ;; likely we are either in a function prototype or a function + ;; call argument list + ((/= (char-after containing-sexp) ?{) + (c-backward-syntactic-ws containing-sexp) + (cond + ;; CASE 6A: we are looking at the arglist closing paren + ((and (/= char-before-ip ?,) + (memq char-after-ip '(?\) ?\]))) + (goto-char containing-sexp) + (c-add-syntax 'arglist-close (c-point 'boi))) + ;; CASE 6B: we are looking at the first argument in an empty + ;; argument list. Use arglist-close if we're actually + ;; looking at a close paren or bracket. + ((memq char-before-ip '(?\( ?\[)) + (goto-char containing-sexp) + (c-add-syntax 'arglist-intro (c-point 'boi))) + ;; CASE 6C: we are inside a conditional test clause. treat + ;; these things as statements + ((save-excursion + (goto-char containing-sexp) + (and (c-safe (progn (forward-sexp -1) t)) + (looking-at "\\<for\\>[^_]"))) + (goto-char (1+ containing-sexp)) + (c-forward-syntactic-ws indent-point) + (c-beginning-of-statement-1 containing-sexp) + (if (= char-before-ip ?\;) + (c-add-syntax 'statement (point)) + (c-add-syntax 'statement-cont (point)) + )) + ;; CASE 6D: maybe a continued method call. This is the case + ;; when we are inside a [] bracketed exp, and what precede + ;; the opening bracket is not an identifier. + ((and c-method-key + (= (char-after containing-sexp) ?\[) + (save-excursion + (goto-char (1- containing-sexp)) + (c-backward-syntactic-ws (c-point 'bod)) + (if (not (looking-at c-symbol-key)) + (c-add-syntax 'objc-method-call-cont containing-sexp)) + ))) + ;; CASE 6E: we are looking at an arglist continuation line, + ;; but the preceding argument is on the same line as the + ;; opening paren. This case includes multi-line + ;; mathematical paren groupings, but we could be on a + ;; for-list continuation line + ((and (save-excursion + (goto-char (1+ containing-sexp)) + (skip-chars-forward " \t") + (not (eolp))) + (save-excursion + (c-beginning-of-statement-1 lim) + (skip-chars-backward " \t([") + (<= (point) containing-sexp))) + (goto-char containing-sexp) + (c-add-syntax 'arglist-cont-nonempty (c-point 'boi))) + ;; CASE 6F: we are looking at just a normal arglist + ;; continuation line + (t (c-beginning-of-statement-1 containing-sexp) + (forward-char 1) + (c-forward-syntactic-ws indent-point) + (c-add-syntax 'arglist-cont (c-point 'boi))) + )) + ;; CASE 7: func-local multi-inheritance line + ((and c-baseclass-key + (save-excursion + (goto-char indent-point) + (skip-chars-forward " \t") + (looking-at c-baseclass-key))) + (goto-char indent-point) + (skip-chars-forward " \t") + (cond + ;; CASE 7A: non-hanging colon on an inher intro + ((= char-after-ip ?:) + (c-backward-syntactic-ws lim) + (c-add-syntax 'inher-intro (c-point 'boi))) + ;; CASE 7B: hanging colon on an inher intro + ((= char-before-ip ?:) + (c-add-syntax 'inher-intro (c-point 'boi))) + ;; CASE 7C: a continued inheritance line + (t + (c-beginning-of-inheritance-list lim) + (c-add-syntax 'inher-cont (point)) + ))) + ;; CASE 8: we are inside a brace-list + ((setq placeholder (c-inside-bracelist-p containing-sexp state)) + (cond + ;; CASE 8A: brace-list-close brace + ((and (= char-after-ip ?}) + (c-safe (progn (forward-char 1) + (backward-sexp 1) + t)) + (= (point) containing-sexp)) + (c-add-syntax 'brace-list-close (c-point 'boi))) + ;; CASE 8B: we're looking at the first line in a brace-list + ((save-excursion + (goto-char indent-point) + (c-backward-syntactic-ws containing-sexp) + (= (point) (1+ containing-sexp))) + (goto-char containing-sexp) + ;;(if (= char-after-ip ?{) + ;;(c-add-syntax 'brace-list-open (c-point 'boi)) + (c-add-syntax 'brace-list-intro (c-point 'boi)) + ) + ;;)) ; end CASE 8B + ;; CASE 8C: this is just a later brace-list-entry + (t (goto-char (1+ containing-sexp)) + (c-forward-syntactic-ws indent-point) + (if (= char-after-ip ?{) + (c-add-syntax 'brace-list-open (point)) + (c-add-syntax 'brace-list-entry (point)) + )) ; end CASE 8C + )) ; end CASE 8 + ;; CASE 9: A continued statement + ((and (not (memq char-before-ip '(?\; ?} ?:))) + (> (point) + (save-excursion + (c-beginning-of-statement-1 containing-sexp) + (setq placeholder (point)))) + (/= placeholder containing-sexp)) + (goto-char indent-point) + (skip-chars-forward " \t") + (let ((after-cond-placeholder + (save-excursion + (goto-char placeholder) + (if (looking-at c-conditional-key) + (progn + (c-safe (c-skip-conditional)) + (c-forward-syntactic-ws) + (if (memq (following-char) '(?\;)) + (progn + (forward-char 1) + (c-forward-syntactic-ws))) + (point)) + nil)))) + (cond + ;; CASE 9A: substatement + ((and after-cond-placeholder + (>= after-cond-placeholder indent-point)) + (goto-char placeholder) + (if (= char-after-ip ?{) + (c-add-syntax 'substatement-open (c-point 'boi)) + (c-add-syntax 'substatement (c-point 'boi)))) + ;; CASE 9B: open braces for class or brace-lists + ((= char-after-ip ?{) + (cond + ;; CASE 9B.1: class-open + ((save-excursion + (goto-char indent-point) + (skip-chars-forward " \t{") + (let ((decl (c-search-uplist-for-classkey (c-parse-state)))) + (and decl + (setq placeholder (aref decl 0))) + )) + (c-add-syntax 'class-open placeholder)) + ;; CASE 9B.2: brace-list-open + ((or (save-excursion + (goto-char placeholder) + (looking-at "\\<enum\\>")) + (= char-before-ip ?=)) + (c-add-syntax 'brace-list-open placeholder)) + ;; CASE 9B.3: catch-all for unknown construct. + (t + ;; Can and should I add an extensibility hook here? + ;; Something like c-recognize-hook so support for + ;; unknown constructs could be added. It's probably a + ;; losing proposition, so I dunno. + (goto-char placeholder) + (c-add-syntax 'statement-cont (c-point 'boi)) + (c-add-syntax 'block-open)) + )) + ;; CASE 9C: iostream insertion or extraction operator + ((looking-at "<<\\|>>") + (goto-char placeholder) + (and after-cond-placeholder + (goto-char after-cond-placeholder)) + (while (and (re-search-forward "<<\\|>>" indent-point 'move) + (c-in-literal placeholder))) + ;; if we ended up at indent-point, then the first + ;; streamop is on a separate line. Indent the line like + ;; a statement-cont instead + (if (/= (point) indent-point) + (c-add-syntax 'stream-op (c-point 'boi)) + (c-backward-syntactic-ws lim) + (c-add-syntax 'statement-cont (c-point 'boi)))) + ;; CASE 9D: continued statement. find the accurate + ;; beginning of statement or substatement + (t + (c-beginning-of-statement-1 after-cond-placeholder) + ;; KLUDGE ALERT! c-beginning-of-statement-1 can leave + ;; us before the lim we're passing in. It should be + ;; fixed, but I'm worried about side-effects at this + ;; late date. Fix for v5. + (goto-char (or (and after-cond-placeholder + (max after-cond-placeholder (point))) + (point))) + (c-add-syntax 'statement-cont (point))) + ))) + ;; CASE 10: an else clause? + ((looking-at "\\<else\\>[^_]") + (c-backward-to-start-of-if containing-sexp) + (c-add-syntax 'else-clause (c-point 'boi))) + ;; CASE 11: Statement. But what kind? Lets see if its a + ;; while closure of a do/while construct + ((progn + (goto-char indent-point) + (skip-chars-forward " \t") + (and (looking-at "while\\b[^_]") + (save-excursion + (c-backward-to-start-of-do containing-sexp) + (setq placeholder (point)) + (looking-at "do\\b[^_]")) + )) + (c-add-syntax 'do-while-closure placeholder)) + ;; CASE 12: A case or default label + ((looking-at c-switch-label-key) + (goto-char containing-sexp) + ;; check for hanging braces + (if (/= (point) (c-point 'boi)) + (forward-sexp -1)) + (c-add-syntax 'case-label (c-point 'boi))) + ;; CASE 13: any other label + ((looking-at c-label-key) + (goto-char containing-sexp) + (c-add-syntax 'label (c-point 'boi))) + ;; CASE 14: block close brace, possibly closing the defun or + ;; the class + ((= char-after-ip ?}) + (let* ((lim (c-safe-position containing-sexp fullstate)) + (relpos (save-excursion + (goto-char containing-sexp) + (if (/= (point) (c-point 'boi)) + (c-beginning-of-statement-1 lim)) + (c-point 'boi)))) + (cond + ;; CASE 14A: does this close an inline? + ((let ((inclass-p (progn + (goto-char containing-sexp) + (c-search-uplist-for-classkey state)))) + ;; inextern-p in higher level let* + (setq inextern-p (and inclass-p + (progn + (goto-char (aref inclass-p 0)) + (looking-at "extern[^_]")))) + (and inclass-p (not inextern-p))) + (c-add-syntax 'inline-close relpos)) + ;; CASE 14B: if there an enclosing brace that hasn't + ;; been narrowed out by a class, then this is a + ;; block-close + ((and (not inextern-p) + (c-most-enclosing-brace state)) + (c-add-syntax 'block-close relpos)) + ;; CASE 14C: find out whether we're closing a top-level + ;; class or a defun + (t + (save-restriction + (narrow-to-region (point-min) indent-point) + (let ((decl (c-search-uplist-for-classkey (c-parse-state)))) + (if decl + (c-add-syntax 'class-close (aref decl 0)) + (c-add-syntax 'defun-close relpos))))) + ))) + ;; CASE 15: statement catchall + (t + ;; we know its a statement, but we need to find out if it is + ;; the first statement in a block + (goto-char containing-sexp) + (forward-char 1) + (c-forward-syntactic-ws indent-point) + ;; now skip forward past any case/default clauses we might find. + (while (or (c-skip-case-statement-forward fullstate indent-point) + (and (looking-at c-switch-label-key) + (not inswitch-p))) + (setq inswitch-p t)) + ;; we want to ignore non-case labels when skipping forward + (while (and (looking-at c-label-key) + (goto-char (match-end 0))) + (c-forward-syntactic-ws indent-point)) + (cond + ;; CASE 15A: we are inside a case/default clause inside a + ;; switch statement. find out if we are at the statement + ;; just after the case/default label. + ((and inswitch-p + (progn + (goto-char indent-point) + (c-backward-syntactic-ws containing-sexp) + (back-to-indentation) + (setq placeholder (point)) + (looking-at c-switch-label-key))) + (goto-char indent-point) + (skip-chars-forward " \t") + (if (= (following-char) ?{) + (c-add-syntax 'statement-case-open placeholder) + (c-add-syntax 'statement-case-intro placeholder))) + ;; CASE 15B: continued statement + ((= char-before-ip ?,) + (c-add-syntax 'statement-cont (c-point 'boi))) + ;; CASE 15C: a question/colon construct? But make sure + ;; what came before was not a label, and what comes after + ;; is not a globally scoped function call! + ((or (and (memq char-before-ip '(?: ??)) + (save-excursion + (goto-char indent-point) + (c-backward-syntactic-ws lim) + (back-to-indentation) + (not (looking-at c-label-key)))) + (and (memq char-after-ip '(?: ??)) + (save-excursion + (goto-char indent-point) + (skip-chars-forward " \t") + ;; watch out for scope operator + (not (looking-at "::"))))) + (c-add-syntax 'statement-cont (c-point 'boi))) + ;; CASE 15D: any old statement + ((< (point) indent-point) + (let ((safepos (c-most-enclosing-brace fullstate)) + relpos done) + (goto-char indent-point) + (c-beginning-of-statement-1 safepos) + ;; It is possible we're on the brace that opens a nested + ;; function. + (if (and (= (following-char) ?{) + (save-excursion + (c-backward-syntactic-ws safepos) + (/= (preceding-char) ?\;))) + (c-beginning-of-statement-1 safepos)) + (if (and inswitch-p + (looking-at c-switch-label-key)) + (progn + (goto-char placeholder) + (end-of-line) + (forward-sexp -1))) + (setq relpos (c-point 'boi)) + (while (and (not done) + (<= safepos (point)) + (/= relpos (point))) + (c-beginning-of-statement-1 safepos) + (if (= relpos (c-point 'boi)) + (setq done t)) + (setq relpos (c-point 'boi))) + (c-add-syntax 'statement relpos) + (if (= char-after-ip ?{) + (c-add-syntax 'block-open)))) + ;; CASE 15E: first statement in an inline, or first + ;; statement in a top-level defun. we can tell this is it + ;; if there are no enclosing braces that haven't been + ;; narrowed out by a class (i.e. don't use bod here!) + ((save-excursion + (save-restriction + (widen) + (goto-char containing-sexp) + (c-narrow-out-enclosing-class state containing-sexp) + (not (c-most-enclosing-brace state)))) + (goto-char containing-sexp) + ;; if not at boi, then defun-opening braces are hung on + ;; right side, so we need a different relpos + (if (/= (point) (c-point 'boi)) + (progn + (c-backward-syntactic-ws) + (c-safe (forward-sexp (if (= (preceding-char) ?\)) + -1 -2))) + ;; looking at a Java throws clause following a + ;; method's parameter list + (c-beginning-of-statement-1) + )) + (c-add-syntax 'defun-block-intro (c-point 'boi))) + ;; CASE 15F: first statement in a block + (t (goto-char containing-sexp) + (if (/= (point) (c-point 'boi)) + (c-beginning-of-statement-1 + (if (= (point) lim) + (c-safe-position (point) state) lim))) + (c-add-syntax 'statement-block-intro (c-point 'boi)) + (if (= char-after-ip ?{) + (c-add-syntax 'block-open))) + )) + ) + + ;; now we need to look at any modifiers + (goto-char indent-point) + (skip-chars-forward " \t") + ;; are we looking at a comment only line? + (if (looking-at c-comment-start-regexp) + (c-add-syntax 'comment-intro)) + ;; we might want to give additional offset to friends (in C++). + (if (and (eq major-mode 'c++-mode) + (looking-at c-C++-friend-key)) + (c-add-syntax 'friend)) + ;; return the syntax + syntax)))) + + +;; indent via syntactic language elements +(defun c-indent-line (&optional syntax) + ;; indent the current line as C/C++/ObjC code. Optional SYNTAX is the + ;; syntactic information for the current line. Returns the amount of + ;; indentation change + (let* ((c-syntactic-context (or syntax (c-guess-basic-syntax))) + (pos (- (point-max) (point))) + (indent (apply '+ (mapcar 'c-get-offset c-syntactic-context))) + (shift-amt (- (current-indentation) indent))) + (and c-echo-syntactic-information-p + (message "syntax: %s, indent= %d" c-syntactic-context indent)) + (if (zerop shift-amt) + nil + (delete-region (c-point 'bol) (c-point 'boi)) + (beginning-of-line) + (indent-to indent)) + (if (< (point) (c-point 'boi)) + (back-to-indentation) + ;; If initial point was within line's indentation, position after + ;; the indentation. Else stay at same point in text. + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos))) + ) + (run-hooks 'c-special-indent-hook) + shift-amt)) + +(defun c-show-syntactic-information (arg) + "Show syntactic information for current line. +With universal argument, inserts the analysis as a comment on that line." + (interactive "P") + (let ((syntax (c-guess-basic-syntax))) + (if (not (consp arg)) + (message "syntactic analysis: %s" syntax) + (indent-for-comment) + (insert (format "%s" syntax)) + )) + (c-keep-region-active)) + + +(provide 'cc-engine) +;;; cc-engine.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/cc-guess.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,100 @@ +;;; cc-guess.el --- guess indentation values by scanning existing code + +;; Copyright (C) 1985,87,92,93,94,95,96,97 Free Software Foundation, Inc. + +;; Author: 1994-1995 Barry A. Warsaw +;; Maintainer: Unmaintained +;; Created: August 1994, split from cc-mode.el +;; Version: 5.11 +;; Keywords: c languages oop + +;; This file is not part of GNU Emacs. + +;; 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 +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with 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 contains routines that help guess the cc-mode style in a +;; particular region of C, C++, or Objective-C code. It is provided +;; for example and experimentation only. It is not supported in +;; anyway. Some folks have asked for a style guesser and the best way +;; to show my thoughts on the subject is with this sample code. Feel +;; free to improve upon it in anyway you'd like. Please send me the +;; results. Note that style guessing is lossy! +;; +;; The way this is intended to be run is for you to mark a region of +;; code to guess the style of, then run the command, cc-guess-region. + +;;; Code: + +(defvar cc-guessed-style nil + "Currently guessed style.") + +(defvar cc-guess-conversions + '((c . c-lineup-C-comments) + (inher-cont . c-lineup-multi-inher) + (string . -1000) + (comment-intro . c-lineup-comment) + (arglist-cont-nonempty . c-lineup-arglist) + (cpp-macro . -1000))) + + +(defun cc-guess-region (start end &optional reset) + "Sets `c-offset-alist' indentation values based on region of code. +Every line of code in the region is examined and the indentation +values of the various syntactic symbols in `c-offset-alist' is +guessed. The first such positively identified indentation is used, so +if an inconsistent style exists in the C code, the guessed indentation +may be incorrect. + +Note that the larger the region to guess in, the slower the +guessing. Previous guesses can be concatenated together, unless the +optional RESET is provided. + +See `cc-guess-write-style' to find out how to save the guessed style, +and `cc-guess-view-style' for viewing the guessed style." + (interactive "r\nP") + (if (consp reset) + (setq cc-guessed-style nil)) + (save-excursion + (goto-char start) + (while (< (point) end) + (let* ((syntax (c-guess-basic-syntax)) + (relpos (cdr (car syntax))) + (symbol (car (car syntax))) + point-indent relpos-indent) + ;; TBD: for now I can't guess indentation when more than 1 + ;; symbol is on the list, nor for symbols without relpos's + (if (or (/= 1 (length syntax)) + (not (numberp relpos)) + ;; also, don't try to reguess an already guessed + ;; symbol + (assq symbol cc-guessed-style)) + nil + (back-to-indentation) + (setq point-indent (current-column) + relpos-indent (save-excursion + (goto-char relpos) + (current-column))) + ;; guessed indentation is the difference between point's and + ;; relpos's current-column indentation + (setq cc-guessed-style + (cons (cons symbol (- point-indent relpos-indent)) + cc-guessed-style)) + )) + (forward-line 1)))) + +;;; cc-guess.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/cc-langs.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,500 @@ +;;; cc-langs.el --- specific language support for CC Mode + +;; Copyright (C) 1985,87,92,93,94,95,96,97 Free Software Foundation, Inc. + +;; Authors: 1992-1997 Barry A. Warsaw +;; 1987 Dave Detlefs and Stewart Clamen +;; 1985 Richard M. Stallman +;; Maintainer: cc-mode-help@python.org +;; Created: 22-Apr-1997 (split from cc-mode.el) +;; Version: 5.11 +;; Keywords: c languages oop + +;; 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. + +(eval-when-compile + (load-file "./cc-styles.el")) + + +;; Regular expressions and other values which must be parameterized on +;; a per-language basis. + +;; Keywords defining protection levels +(defconst c-protection-key "\\<\\(public\\|protected\\|private\\)\\>") + +;; Regex describing a `symbol' in all languages We cannot use just +;; `word' syntax class since `_' cannot be in word class. Putting +;; underscore in word class breaks forward word movement behavior that +;; users are familiar with. +(defconst c-symbol-key "\\(\\w\\|\\s_\\)+") + + +;; keywords introducing class definitions. language specific +(defconst c-C-class-key "\\(struct\\|union\\)") +(defconst c-C++-class-key "\\(class\\|struct\\|union\\)") + +(defconst c-ObjC-class-key + (concat + "@\\(interface\\|implementation\\)\\s +" + c-symbol-key ;name of the class + "\\(\\s *:\\s *" c-symbol-key "\\)?" ;maybe followed by the superclass + "\\(\\s *<[^>]+>\\)?" ;and maybe the adopted protocols list + )) + +(defconst c-Java-class-key + (concat + "\\(" c-protection-key "\\s +\\)?" + "\\(interface\\|class\\)\\s +" + c-symbol-key ;name of the class + "\\(\\s *extends\\s *" c-symbol-key "\\)?" ;maybe followed by superclass + ;;"\\(\\s *implements *[^{]+{\\)?" ;maybe the adopted protocols list + )) + +(defvar c-class-key c-C-class-key) +(make-variable-buffer-local 'c-class-key) + + +;; regexp describing access protection clauses. language specific +(defvar c-access-key nil) +(make-variable-buffer-local 'c-access-key) +(defconst c-C++-access-key (concat c-protection-key "[ \t]*:")) +(defconst c-ObjC-access-key (concat "@" c-protection-key)) +(defconst c-Java-access-key nil) + + +;; keywords introducing conditional blocks +(defconst c-C-conditional-key nil) +(defconst c-C++-conditional-key nil) +(defconst c-Java-conditional-key nil) + +(let ((all-kws "for\\|if\\|do\\|else\\|while\\|switch") + (exc-kws "\\|try\\|catch") + (thr-kws "\\|finally\\|synchronized") + (front "\\b\\(") + (back "\\)\\b[^_]")) + (setq c-C-conditional-key (concat front all-kws back) + c-C++-conditional-key (concat front all-kws exc-kws back) + c-Java-conditional-key (concat front all-kws exc-kws thr-kws back))) + +(defvar c-conditional-key c-C-conditional-key) +(make-variable-buffer-local 'c-conditional-key) + + +;; keywords describing method definition introductions +(defvar c-method-key nil) +(make-variable-buffer-local 'c-method-key) + +(defconst c-ObjC-method-key + (concat + "^\\s *[+-]\\s *" + "\\(([^)]*)\\)?" ; return type + ;; \\s- in objc syntax table does not include \n + ;; since it is considered the end of //-comments. + "[ \t\n]*" c-symbol-key)) + +(defconst c-Java-method-key + (concat + "^\\s *[+-]\\s *" + "\\(([^)]*)\\)?" ; return type + ;; \\s- in java syntax table does not include \n + ;; since it is considered the end of //-comments. + "[ \t\n]*" c-symbol-key)) + + +;; comment starter definitions for various languages. language specific +(defconst c-C-comment-start-regexp "/[*]") +(defconst c-C++-comment-start-regexp "/[/*]") +;; We need to match all 3 Java style comments +;; 1) Traditional C block; 2) javadoc /** ...; 3) C++ style +(defconst c-Java-comment-start-regexp "/\\(/\\|[*][*]?\\)") +(defvar c-comment-start-regexp c-C-comment-start-regexp) +(make-variable-buffer-local 'c-comment-start-regexp) + + + +;; Regexp describing a switch's case or default label for all languages +(defconst c-switch-label-key "\\(\\(case[( \t]+\\S .*\\)\\|default[ \t]*\\):") +;; Regexp describing any label. +(defconst c-label-key (concat c-symbol-key ":\\([^:]\\|$\\)")) + +;; Regexp describing class inheritance declarations. TBD: this should +;; be language specific, and only makes sense for C++ +(defconst c-inher-key + (concat "\\(\\<static\\>\\s +\\)?" + c-C++-class-key "[ \t]+" c-symbol-key + "\\([ \t]*:[ \t]*\\)\\s *[^;]")) + +;; Regexp describing C++ base classes in a derived class definition. +;; TBD: this should be language specific, and only makes sense for C++ +(defvar c-baseclass-key + (concat + ":?[ \t]*\\(virtual[ \t]+\\)?\\(" + c-protection-key "[ \t]+\\)" c-symbol-key)) +(make-variable-buffer-local 'c-baseclass-key) + +;; Regexp describing friend declarations in C++ classes. +(defconst c-C++-friend-key + "friend[ \t]+\\|template[ \t]*<.+>[ \t]*friend[ \t]+") + +;; Regexp describing Java inheritance and throws clauses. +(defconst c-Java-special-key "\\(implements\\|extends\\|throws\\)[^_]") + +;; Regexp describing the beginning of a Java top-level definition. +(defconst c-Java-defun-prompt-regexp + "^[ \t]*\\(\\(\\(public\\|protected\\|private\\|const\\|abstract\\|synchronized\\|final\\|static\\|threadsafe\\|transient\\|native\\|volatile\\)\\s-+\\)*\\(\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*[][_$.a-zA-Z0-9]+\\|[[a-zA-Z]\\)\\s-*\\)\\s-+\\)\\)?\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*\\s-+\\)\\s-*\\)?\\([_a-zA-Z][^][ \t:;.,{}()=]*\\|\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)\\)\\s-*\\(([^);{}]*)\\)?\\([] \t]*\\)\\(\\s-*\\<throws\\>\\s-*\\(\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)[, \t\n\r\f]*\\)+\\)?\\s-*") + + + +;; internal state variables + +;; Internal state of hungry delete key feature +(defvar c-hungry-delete-key nil) +(make-variable-buffer-local 'c-hungry-delete-key) + +;; Internal state of auto newline feature. +(defvar c-auto-newline nil) +(make-variable-buffer-local 'c-auto-newline) + +;; Internal auto-newline/hungry-delete designation string for mode line. +(defvar c-auto-hungry-string nil) +(make-variable-buffer-local 'c-auto-hungry-string) + +;; Buffer local language-specific comment style flag. +(defvar c-double-slash-is-comments-p nil) +(make-variable-buffer-local 'c-double-slash-is-comments-p) + +;; Non-nil means K&R style argument declarations are valid. +(defvar c-recognize-knr-p t) +(make-variable-buffer-local 'c-recognize-knr-p) + + + +(defun c-use-java-style () + "Institutes `java' indentation style. +For use with the variable `java-mode-hook'." + (c-set-style "java")) + +(defun c-common-init () + ;; Common initializations for c++-mode and c-mode. + ;; + ;; these variables should always be buffer local; they do not affect + ;; indentation style. + (make-local-variable 'paragraph-start) + (make-local-variable 'paragraph-separate) + (make-local-variable 'paragraph-ignore-fill-prefix) + (make-local-variable 'require-final-newline) + (make-local-variable 'parse-sexp-ignore-comments) + (make-local-variable 'indent-line-function) + (make-local-variable 'indent-region-function) + (make-local-variable 'comment-start) + (make-local-variable 'comment-end) + (make-local-variable 'comment-column) + (make-local-variable 'comment-start-skip) + (make-local-variable 'comment-multi-line) + (make-local-variable 'outline-regexp) + (make-local-variable 'outline-level) + (make-local-variable 'adaptive-fill-regexp) + (make-local-variable 'imenu-generic-expression) ;set in the mode functions + ;; Emacs 19.30 and beyond only, AFAIK + (if (boundp 'fill-paragraph-function) + (progn + (make-local-variable 'fill-paragraph-function) + (setq fill-paragraph-function 'c-fill-paragraph))) + ;; now set their values + (setq paragraph-start (concat page-delimiter "\\|$") + paragraph-separate paragraph-start + paragraph-ignore-fill-prefix t + require-final-newline t + parse-sexp-ignore-comments t + indent-line-function 'c-indent-line + indent-region-function 'c-indent-region + outline-regexp "[^#\n\^M]" + outline-level 'c-outline-level + comment-column 32 + comment-start-skip "/\\*+ *\\|// *" + adaptive-fill-regexp nil) + ;; we have to do something special for c-offsets-alist so that the + ;; buffer local value has its own alist structure. + (setq c-offsets-alist (copy-alist c-offsets-alist)) + ;; setup the comment indent variable in a Emacs version portable way + ;; ignore any byte compiler warnings you might get here + (make-local-variable 'comment-indent-function) + (setq comment-indent-function 'c-comment-indent) + ;; add menus to menubar + (easy-menu-add (c-mode-menu mode-name)) + ;; put auto-hungry designators onto minor-mode-alist, but only once + (or (assq 'c-auto-hungry-string minor-mode-alist) + (setq minor-mode-alist + (cons '(c-auto-hungry-string c-auto-hungry-string) + minor-mode-alist)))) + +(defun c-postprocess-file-styles () + "Function that post processes relevant file local variables. +Currently, this function simply applies any style and offset settings +found in the file's Local Variable list. It first applies any style +setting found in `c-file-style', then it applies any offset settings +it finds in `c-file-offsets'." + ;; apply file styles and offsets + (and c-file-style + (c-set-style c-file-style)) + (and c-file-offsets + (mapcar + (function + (lambda (langentry) + (let ((langelem (car langentry)) + (offset (cdr langentry))) + (c-set-offset langelem offset) + ))) + c-file-offsets))) + +(add-hook 'hack-local-variables-hook 'c-postprocess-file-styles) + + +;; Common routines +(defsubst c-make-inherited-keymap () + (let ((map (make-sparse-keymap))) + (cond + ;; XEmacs 19 & 20 + ((fboundp 'set-keymap-parents) + (set-keymap-parents map c-mode-base-map)) + ;; Emacs 19 + ((fboundp 'set-keymap-parent) + (set-keymap-parent map c-mode-base-map)) + ;; incompatible + (t (error "CC Mode is incompatible with this version of Emacs"))) + map)) + +(defun c-populate-syntax-table (table) + ;; Populate the syntax TABLE + ;; DO NOT TRY TO SET _ (UNDERSCORE) TO WORD CLASS! + (modify-syntax-entry ?_ "_" table) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?% "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?& "." table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?\' "\"" table)) + +(defun c-setup-dual-comments (table) + ;; Set up TABLE to handle block and line style comments + (cond + ;; XEmacs 19 & 20 + ((memq '8-bit c-emacs-features) + (modify-syntax-entry ?/ ". 1456" table) + (modify-syntax-entry ?* ". 23" table) + (modify-syntax-entry ?\n "> b" table) + ;; Give CR the same syntax as newline, for selective-display + (modify-syntax-entry ?\^m "> b" table)) + ;; Emacs 19 + ((memq '1-bit c-emacs-features) + (modify-syntax-entry ?/ ". 124b" table) + (modify-syntax-entry ?* ". 23" table) + (modify-syntax-entry ?\n "> b" table) + ;; Give CR the same syntax as newline, for selective-display + (modify-syntax-entry ?\^m "> b" table)) + ;; incompatible + (t (error "CC Mode is incompatible with this version of Emacs")) + )) + +(defvar c-mode-base-map () + "Keymap shared by all CC Mode related modes.") + +(if c-mode-base-map + nil + ;; TBD: should we even worry about naming this keymap. My vote: no, + ;; because Emacs and XEmacs do it differently. + (setq c-mode-base-map (make-sparse-keymap)) + ;; put standard keybindings into MAP + ;; the following mappings correspond more or less directly to BOCM + (define-key c-mode-base-map "{" 'c-electric-brace) + (define-key c-mode-base-map "}" 'c-electric-brace) + (define-key c-mode-base-map ";" 'c-electric-semi&comma) + (define-key c-mode-base-map "#" 'c-electric-pound) + (define-key c-mode-base-map ":" 'c-electric-colon) + ;; Lucid Emacs 19.9 defined these two, the second of which was + ;; commented out... + ;; (define-key c-mode-base-map "\e{" 'c-insert-braces) + ;; Commented out electric square brackets because nobody likes them. + ;; (define-key c-mode-base-map "[" 'c-insert-brackets) + (define-key c-mode-base-map "\C-c\C-m" 'c-mark-function) + (define-key c-mode-base-map "\e\C-q" 'c-indent-exp) + (define-key c-mode-base-map "\ea" 'c-beginning-of-statement) + (define-key c-mode-base-map "\ee" 'c-end-of-statement) + (define-key c-mode-base-map "\C-c\C-n" 'c-forward-conditional) + (define-key c-mode-base-map "\C-c\C-p" 'c-backward-conditional) + (define-key c-mode-base-map "\C-c\C-u" 'c-up-conditional) + (define-key c-mode-base-map "\t" 'c-indent-command) + ;; In XEmacs 19 and Emacs 19, this binds both the BackSpace and + ;; Delete keysyms to c-electric-backspace. In XEmacs 20 it binds + ;; only BackSpace, so we now bind them individually + (define-key c-mode-base-map [delete] 'c-electric-delete) + (define-key c-mode-base-map [backspace] 'c-electric-backspace) + ;; these are new keybindings, with no counterpart to BOCM + (define-key c-mode-base-map "," 'c-electric-semi&comma) + (define-key c-mode-base-map "*" 'c-electric-star) + (define-key c-mode-base-map "\C-c\C-q" 'c-indent-defun) + (define-key c-mode-base-map "\C-c\C-\\" 'c-backslash-region) + ;; TBD: where if anywhere, to put c-backward|forward-into-nomenclature + (define-key c-mode-base-map "\C-c\C-a" 'c-toggle-auto-state) + (define-key c-mode-base-map "\C-c\C-b" 'c-submit-bug-report) + (define-key c-mode-base-map "\C-c\C-c" 'comment-region) + (define-key c-mode-base-map "\C-c\C-d" 'c-toggle-hungry-state) + (define-key c-mode-base-map "\C-c\C-e" 'c-macro-expand) + (define-key c-mode-base-map "\C-c\C-o" 'c-set-offset) + (define-key c-mode-base-map "\C-c\C-s" 'c-show-syntactic-information) + (define-key c-mode-base-map "\C-c\C-t" 'c-toggle-auto-hungry-state) + (define-key c-mode-base-map "\C-c." 'c-set-style) + ;; conflicts with OOBR + ;;(define-key c-mode-base-map "\C-c\C-v" 'c-version) + ) + + + +;; Support for C + +(defvar c-mode-abbrev-table nil + "Abbrev table in use in c-mode buffers.") +(define-abbrev-table 'c-mode-abbrev-table ()) + +(defvar c-mode-map () + "Keymap used in c-mode buffers.") +(if c-mode-map + nil + (setq c-mode-map (c-make-inherited-keymap)) + ;; add bindings which are only useful for C + ) + +(defvar c-mode-syntax-table nil + "Syntax table used in c-mode buffers.") +(if c-mode-syntax-table + () + (setq c-mode-syntax-table (make-syntax-table)) + (c-populate-syntax-table c-mode-syntax-table) + ;; add extra comment syntax + (modify-syntax-entry ?/ ". 14" c-mode-syntax-table) + (modify-syntax-entry ?* ". 23" c-mode-syntax-table)) + +(defun c-enable-//-in-c-mode () + "Enables // as a comment delimiter in `c-mode'. +ANSI C currently does *not* allow this, although many C compilers +support optional C++ style comments. To use, call this function from +your `.emacs' file before you visit any C files. The changes are +global and affect all future `c-mode' buffers." + (c-setup-dual-comments c-mode-syntax-table) + (setq-default c-C-comment-start-regexp c-C++-comment-start-regexp)) + + + +;; Support for C++ + +(defvar c++-mode-abbrev-table nil + "Abbrev table in use in c++-mode buffers.") +(define-abbrev-table 'c++-mode-abbrev-table ()) + +(defvar c++-mode-map () + "Keymap used in c++-mode buffers.") +(if c++-mode-map + nil + (setq c++-mode-map (c-make-inherited-keymap)) + ;; add bindings which are only useful for C++ + (define-key c++-mode-map "\C-c:" 'c-scope-operator) + (define-key c++-mode-map "/" 'c-electric-slash) + (define-key c++-mode-map "<" 'c-electric-lt-gt) + (define-key c++-mode-map ">" 'c-electric-lt-gt)) + +(defvar c++-mode-syntax-table nil + "Syntax table used in c++-mode buffers.") +(if c++-mode-syntax-table + () + (setq c++-mode-syntax-table (make-syntax-table)) + (c-populate-syntax-table c++-mode-syntax-table) + ;; add extra comment syntax + (c-setup-dual-comments c++-mode-syntax-table) + ;; TBD: does it make sense for colon to be symbol class in C++? + ;; I'm not so sure, since c-label-key is busted on lines like: + ;; Foo::bar( i ); + ;; maybe c-label-key should be fixed instead of commenting this out, + ;; but it also bothers me that this only seems appropriate for C++ + ;; and not C. + ;;(modify-syntax-entry ?: "_" c++-mode-syntax-table) + ) + + + +;; Support for Objective-C + +(defvar objc-mode-abbrev-table nil + "Abbrev table in use in objc-mode buffers.") +(define-abbrev-table 'objc-mode-abbrev-table ()) + +(defvar objc-mode-map () + "Keymap used in objc-mode buffers.") +(if objc-mode-map + nil + (setq objc-mode-map (c-make-inherited-keymap)) + ;; add bindings which are only useful for Objective-C + (define-key objc-mode-map "/" 'c-electric-slash)) + +(defvar objc-mode-syntax-table nil + "Syntax table used in objc-mode buffers.") +(if objc-mode-syntax-table + () + (setq objc-mode-syntax-table (make-syntax-table)) + (c-populate-syntax-table objc-mode-syntax-table) + ;; add extra comment syntax + (c-setup-dual-comments objc-mode-syntax-table) + ;; everyone gets these + (modify-syntax-entry ?@ "_" objc-mode-syntax-table) + ) + + + +;; Support for Java + +(defvar java-mode-abbrev-table nil + "Abbrev table in use in java-mode buffers.") +(define-abbrev-table 'java-mode-abbrev-table ()) + +(defvar java-mode-map () + "Keymap used in java-mode buffers.") +(if java-mode-map + nil + (setq java-mode-map (c-make-inherited-keymap)) + ;; add bindings which are only useful for Java + (define-key java-mode-map "/" 'c-electric-slash)) + +(defvar java-mode-syntax-table nil + "Syntax table used in java-mode buffers.") +(if java-mode-syntax-table + () + (setq java-mode-syntax-table (make-syntax-table)) + (c-populate-syntax-table java-mode-syntax-table) + ;; add extra comment syntax + (c-setup-dual-comments java-mode-syntax-table) + ;; everyone gets these + (modify-syntax-entry ?@ "_" java-mode-syntax-table) + ) + + + +(provide 'cc-langs) +;;; cc-langs.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/cc-lobotomy.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,200 @@ +;;; cc-lobotomy.el --- excise portions of cc-mode's brain... for speed + +;; Copyright (C) 1985,87,92,93,94,95,96,97 Free Software Foundation, Inc. + +;; Author: 1995 Barry A. Warsaw +;; Maintainer: Unmaintained +;; Created: March 1995, split from cc-mode.el +;; Version: 5.11 +;; Keywords: c languages oop + +;; This file is not part of GNU Emacs. + +;; 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 +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with 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: +;; +;; Every effort has been made to improve the performance of +;; cc-mode. However, due to the nature of the C, C++, and Objective-C +;; language definitions, a trade-off is often required between +;; accuracy of construct recognition and speed. I believe it is always +;; best to be correct, and that the mode is currently fast enough for +;; most normal usage. Others disagree. I have no intention of +;; including these hacks in the main distribution. When cc-mode +;; version 5 comes out, it will include a rewritten indentation engine +;; so that performance will be greatly improved automatically. This +;; was not included in this release of version 4 so that Emacs 18 +;; could still be supported. Note that this implies that cc-mode +;; version 5 will *not* work on Emacs 18! +;; +;; To use, see the variable cc-lobotomy-pith-list and the function +;; cc-lobotomize. The variable contains a good explanation of the +;; speed/accuracy trade-offs for each option. Set it to what you'd +;; like, and call cc-lobotomy in your c-mode-hook. +;; +;; This will redefine certain cc-mode functions and affect all cc-mode +;; buffers globally. +;; +;; This file is completely unsupported! I have no idea whether this +;; will work with such things as cc-mode-18.el. + + +;;; Code: +(require 'cc-mode) + +(defvar cc-lobotomy-pith-list () + "*List of things to dumb-ify to speed up cc-mode. Note that each +incurs a penalty in correct identification of certain code constructs. +Possible values to put on this list: + + 'literal -- `c-in-literal' is lobotomized. This will significantly + speed up parsing over large lists of cpp macros, as seen + for instance in header files. The penalty is that you + cannot put the `#' character as the first non-whitespace + character on a line inside other multi-line literals + (i.e. comments or strings) + + 'class -- `c-narrow-out-enclosing-class' and `c-search-uplist for + classkey' are lobotomized. This speeds up some + indenting inside and around class and struct + definitions. The penalty is that elements inside of + classes and structs may not indent correctly. + + 'lists -- `c-inside-bracelist-p' is lobotomized. This speeds up + indenting inside and around brace lists (e.g. aggregate + initializers, enum lists, etc.). The penalty is that + elements inside these lists may not indent correctly.") + +(defun cc-lobotomize () + "Perform lobotomies on cc-mode as described in `cc-lobotomy-pith-list'." + (let (pithedp) + (if (memq 'literal cc-lobotomy-pith-list) + (progn + (fset 'c-in-literal 'cc-in-literal-lobotomized) + (setq pithedp t))) + (if (memq 'class cc-lobotomy-pith-list) + (progn + (fset 'c-narrow-out-enclosing-class + 'cc-narrow-out-enclosing-class-lobotomized) + (fset 'c-search-uplist-for-classkey + 'cc-search-uplist-for-classkey-lobotomized) + (setq pithedp t))) + (if (memq 'lists cc-lobotomy-pith-list) + (progn + (fset 'c-inside-bracelist-p 'cc-inside-bracelist-p-lobotomized) + (setq pithedp t))) + (if pithedp + (fset 'c-submit-bug-report 'cc-submit-bug-report-lobotomized)) + )) + + +;; This is a faster version of c-in-literal. It trades speed for one +;; approximation, namely that within other literals, the `#' character +;; cannot be the first non-whitespace on a line. +(defun cc-in-literal-lobotomized (&optional lim) + ;; first check the cache + (if (and (boundp 'c-in-literal-cache) + c-in-literal-cache + (= (point) (aref c-in-literal-cache 0))) + (aref c-in-literal-cache 1) + ;; quickly check for cpp macro. this breaks if the `#' character + ;; appears as the first non-whitespace on a line inside another + ;; literal. + (let* (state + (char-at-boi (char-after (c-point 'boi))) + (rtn (cond + ((and char-at-boi (= char-at-boi ?#)) + 'pound) + ((nth 3 (setq state (save-excursion + (parse-partial-sexp + (or lim (c-point 'bod)) + (point))))) + 'string) + ((nth 4 state) (if (nth 7 state) 'c++ 'c)) + (t nil)))) + ;; cache this result if the cache is enabled + (and (boundp 'c-in-literal-cache) + (setq c-in-literal-cache (vector (point) rtn))) + rtn))) + +(defun cc-narrow-out-enclosing-class-lobotomized (dummy1 dummy2) nil) + +(defun cc-search-uplist-for-classkey-lobotomized (dummy) nil) + +(defun cc-inside-bracelist-p-lobotomized (dummy1 dummy2) nil) + +(defun cc-submit-bug-report-lobotomized () + "Submit via mail a bug report on cc-mode." + (interactive) + ;; load in reporter + (let ((reporter-prompt-for-summary-p t) + (reporter-dont-compact-list '(c-offsets-alist))) + (and + (y-or-n-p "Do you want to submit a report on cc-mode? ") + (require 'reporter) + (reporter-submit-bug-report + c-mode-help-address + (concat "cc-mode " c-version " (" + (cond ((eq major-mode 'c++-mode) "C++") + ((eq major-mode 'c-mode) "C") + ((eq major-mode 'objc-mode) "ObjC")) + ")") + (let ((vars (list + ;; report only the vars that affect indentation + 'c-basic-offset + 'c-offsets-alist + 'c-block-comments-indent-p + 'c-cleanup-list + 'c-comment-only-line-offset + 'c-backslash-column + 'c-delete-function + 'c-electric-pound-behavior + 'c-hanging-braces-alist + 'c-hanging-colons-alist + 'c-hanging-comment-ender-p + 'c-tab-always-indent + 'c-recognize-knr-p + 'defun-prompt-regexp + 'tab-width + ))) + (if (not (boundp 'defun-prompt-regexp)) + (delq 'defun-prompt-regexp vars) + vars)) + (function + (lambda () + (insert + (if c-special-indent-hook + (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" + "c-special-indent-hook is set to '" + (format "%s" c-special-indent-hook) + ".\nPerhaps this is your problem?\n" + "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n") + "\n") + (format "c-emacs-features: %s\n" c-emacs-features) + ))) + (function + (lambda () + (insert + "You are using cc-lobotomy.el. You realize that by doing\n" + "so you have already made the decision to trade off accuracy\n" + "for speed? Don't set your hopes too high that your problem\n" + "will be fixed.\n\n" + ))) + "Dear Barry," + )))) + +(provide 'cc-lobotomy) +;;; cc-lobotomy.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/cc-menus.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,142 @@ +;;; cc-menus.el --- menu and imenu support for CC Mode + +;; Copyright (C) 1985,87,92,93,94,95,96,97 Free Software Foundation, Inc. + +;; Authors: 1992-1997 Barry A. Warsaw +;; 1987 Dave Detlefs and Stewart Clamen +;; 1985 Richard M. Stallman +;; Maintainer: cc-mode-help@python.org +;; Created: 22-Apr-1997 (split from cc-mode.el) +;; Version: 5.11 +;; Keywords: c languages oop + +;; 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. + + +;; imenu integration +(defvar cc-imenu-c++-generic-expression + (` + ((nil + (, + (concat + "^" ; beginning of line is required + "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" + "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; type specs; there can be no + "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; more than 3 tokens, right? + + "\\(" ; last type spec including */& + "[a-zA-Z0-9_:]+" + "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either ptr/ref sign or ws + "\\)?" ; if there is a last type spec + "\\(" ; name, take into the imenu entry + "[a-zA-Z0-9_:~]+" ; member func, ctor or dtor... + ; (may not contain * because then + ; "a::operator char*" would + ; become "char*"!) + "\\|" + "\\([a-zA-Z0-9_:~]*::\\)?operator" + "[^a-zA-Z1-9_][^(]*" ; ...or operator + " \\)" + "[ \t]*([^)]*)[ \t\n]*[^ ;]" ; require something other than + ; a `;' after the (...) to + ; avoid prototypes. Can't + ; catch cases with () inside + ; the parentheses surrounding + ; the parameters. e.g.: + ; "int foo(int a=bar()) {...}" + + )) 6) + ("Class" + (, (concat + "^" ; beginning of line is required + "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" + "class[ \t]+" + "\\([a-zA-Z0-9_]+\\)" ; the string we want to get + "[ \t]*[:{]" + )) 2))) + "Imenu generic expression for C++ mode. See `imenu-generic-expression'.") + +(defvar cc-imenu-c-generic-expression + cc-imenu-c++-generic-expression + "Imenu generic expression for C mode. See `imenu-generic-expression'.") + +;(defvar cc-imenu-objc-generic-expression +; ()) +; Please contribute one! + +(defvar cc-imenu-java-generic-expression + (` + ((nil + (, + (concat + "^\\([ \t]\\)*" + "\\([A-Za-z0-9_-]+[ \t]+\\)?" ; type specs; there can be + "\\([A-Za-z0-9_-]+[ \t]+\\)?" ; more than 3 tokens, right? + "\\([A-Za-z0-9_-]+[ \t]*[[]?[]]?\\)" + "\\([ \t]\\)" + "\\([A-Za-z0-9_-]+\\)" ; the string we want to get + "\\([ \t]*\\)+(" + "\\([a-zA-Z,_1-9\n \t]*[[]?[]]?\\)*" ; arguments + ")[ \t]*" + "[^;(]" + "[,a-zA-Z_1-9\n \t]*{" + )) 6))) + "Imenu generic expression for Java mode. See `imenu-generic-expression'.") + + +;; menu support for both XEmacs and Emacs. If you don't have easymenu +;; with your version of Emacs, you are incompatible! +(require 'easymenu) + +(defvar c-c-menu nil) +(defvar c-c++-menu nil) +(defvar c-objc-menu nil) +(defvar c-java-menu nil) + +(defun c-mode-menu (modestr) + (let ((m + '(["Comment Out Region" comment-region (mark)] + ["Macro Expand Region" c-macro-expand (mark)] + ["Backslashify" c-backslash-region (mark)] + ["Indent Expression" c-indent-exp + (memq (following-char) '(?\( ?\[ ?\{))] + ["Indent Line" c-indent-command t] + ["Fill Comment Paragraph" c-fill-paragraph t] + ["Up Conditional" c-up-conditional t] + ["Backward Conditional" c-backward-conditional t] + ["Forward Conditional" c-forward-conditional t] + ["Backward Statement" c-beginning-of-statement t] + ["Forward Statement" c-end-of-statement t] + ))) + (cons modestr m))) + +(eval-when-compile + (load-file "./cc-langs.el")) + +(easy-menu-define c-c-menu c-mode-map "C Mode Commands" + (c-mode-menu "C")) +(easy-menu-define c-c++-menu c++-mode-map "C++ Mode Commands" + (c-mode-menu "C++")) +(easy-menu-define c-objc-menu objc-mode-map "ObjC Mode Commands" + (c-mode-menu "ObjC")) +(easy-menu-define c-java-menu java-mode-map "Java Mode Commands" + (c-mode-menu "Java")) + + +(provide 'cc-menus) +;;; cc-menus.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/cc-mode.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,453 @@ +;;; cc-mode.el --- major mode for editing C, C++, Objective-C, and Java code + +;; Copyright (C) 1985,87,92,93,94,95,96,97 Free Software Foundation, Inc. + +;; Authors: 1992-1997 Barry A. Warsaw +;; 1987 Dave Detlefs and Stewart Clamen +;; 1985 Richard M. Stallman +;; Maintainer: cc-mode-help@python.org +;; Created: a long, long, time ago. adapted from the original c-mode.el +;; Version: 5.11 +;; Keywords: c languages oop + +;; NOTE: Read the commentary below for the right way to submit bug reports! +;; NOTE: See the accompanying texinfo manual for details on using this mode! + +;; 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 package provides GNU Emacs major modes for editing C, C++, +;; Objective-C, and Java code. As of the latest Emacs and XEmacs +;; releases, it is the default package for editing these languages. +;; This package is called "CC Mode", and should be spelled exactly +;; this way. It supports K&R and ANSI C, ANSI C++, Objective-C, and +;; Java, with a consistent indentation model across all modes. This +;; indentation model is intuitive and very flexible, so that almost +;; any desired style of indentation can be supported. Installation, +;; usage, and programming details are contained in an accompanying +;; texinfo manual. + +;; CC Mode's immediate ancestors were, c++-mode.el, cplus-md.el, and +;; cplus-md1.el.. + +;; NOTE: This mode does not perform font-locking (a.k.a syntactic +;; coloring, keyword highlighting, etc.) for any of the supported +;; modes. Typically this is done by a package called font-lock.el +;; which I do *not* maintain. You should contact the Emacs +;; maintainers for questions about coloring or highlighting in any +;; language mode. + +;; To submit bug reports, type "C-c C-b". These will be sent to +;; bug-gnu-emacs@prep.ai.mit.edu as well as cc-mode-help@python.org, +;; and I'll read about them there (the former is mirrored as the +;; Usenet newsgroup gnu.emacs.bug). Questions can sent to +;; help-gnu-emacs@prep.ai.mit.edu (mirrored as gnu.emacs.help) and/or +;; cc-mode-help@python.org. Please do not send bugs or questions to +;; my personal account. + +;; YOU CAN IGNORE ALL BYTE-COMPILER WARNINGS. They are the result of +;; the cross-Emacsen support. GNU Emacs 19 (from the FSF), GNU XEmacs +;; 19 (formerly Lucid Emacs), and GNU Emacs 18 all do things +;; differently and there's no way to shut the byte-compiler up at the +;; necessary granularity. Let me say this again: YOU CAN IGNORE ALL +;; BYTE-COMPILER WARNINGS (you'd be surprised at how many people don't +;; follow this advice :-). + +;; Many, many thanks go out to all the folks on the beta test list. +;; Without their patience, testing, insight, code contributions, and +;; encouragement CC Mode would be a far inferior package. + +;; You can get the latest version of CC Mode, including PostScript +;; documentation and separate individual files from: +;; +;; http://www.python.org/ftp/emacs/ + +;; Or if you don't have access to the World Wide Web, through +;; anonymous ftp from: +;; +;; ftp://ftp.python.org/pub/emacs + +;;; Code: + + + +;; Figure out what features this Emacs has +(defconst c-emacs-features + (let ((infodock-p (boundp 'infodock-version)) + (comments + ;; XEmacs 19 and beyond use 8-bit modify-syntax-entry flags. + ;; Emacs 19 uses a 1-bit flag. We will have to set up our + ;; syntax tables differently to handle this. + (let ((table (copy-syntax-table)) + entry) + (modify-syntax-entry ?a ". 12345678" table) + (cond + ;; XEmacs 19, and beyond Emacs 19.34 + ((arrayp table) + (setq entry (aref table ?a)) + ;; In Emacs, table entries are cons cells + (if (consp entry) (setq entry (car entry)))) + ;; XEmacs 20 + ((fboundp 'get-char-table) (setq entry (get-char-table ?a table))) + ;; before and including Emacs 19.34 + ((and (fboundp 'char-table-p) + (char-table-p table)) + (setq entry (car (char-table-range table [?a])))) + ;; incompatible + (t (error "CC Mode is incompatible with this version of Emacs"))) + (if (= (logand (lsh entry -16) 255) 255) + '8-bit + '1-bit)))) + (if infodock-p + (list comments '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: + + XEmacs 19: (8-bit) + XEmacs 20: (8-bit) + Emacs 19: (1-bit) + +Infodock (based on XEmacs) has an additional symbol on this list: +'infodock.") + + + +;; important macros and subroutines +(defsubst c-point (position) + ;; Returns the value of point at certain commonly referenced POSITIONs. + ;; POSITION can be one of the following symbols: + ;; + ;; bol -- beginning of line + ;; eol -- end of line + ;; bod -- beginning of defun + ;; boi -- back to indentation + ;; ionl -- indentation of next line + ;; iopl -- indentation of previous line + ;; bonl -- beginning of next line + ;; bopl -- beginning of previous line + ;; + ;; This function does not modify point or mark. + (let ((here (point))) + (cond + ((eq position 'bol) (beginning-of-line)) + ((eq position 'eol) (end-of-line)) + ((eq position 'bod) + (beginning-of-defun) + ;; if defun-prompt-regexp is non-nil, b-o-d won't leave us at + ;; the open brace. + (and defun-prompt-regexp + (looking-at defun-prompt-regexp) + (goto-char (match-end 0))) + ) + ((eq position 'boi) (back-to-indentation)) + ((eq position 'bonl) (forward-line 1)) + ((eq position 'bopl) (forward-line -1)) + ((eq position 'iopl) + (forward-line -1) + (back-to-indentation)) + ((eq position 'ionl) + (forward-line 1) + (back-to-indentation)) + (t (error "unknown buffer position requested: %s" position)) + ) + (prog1 + (point) + (goto-char here)))) + +(defmacro c-safe (&rest body) + ;; safely execute BODY, return nil if an error occurred + (` (condition-case nil + (progn (,@ body)) + (error nil)))) + +(defsubst c-keep-region-active () + ;; Do whatever is necessary to keep the region active in XEmacs. + ;; Ignore byte-compiler warnings you might see. This is not needed + ;; for Emacs. + (and (boundp 'zmacs-region-stays) + (setq zmacs-region-stays t))) + + + +(defsubst c-load-all () + ;; make sure all necessary components of CC Mode are loaded in. + (require 'cc-vars) + (require 'cc-engine) + (require 'cc-langs) + (require 'cc-menus) + (require 'cc-align) + (require 'cc-styles) + (require 'cc-cmds)) + + +;;;###autoload +(defun c-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. + +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. + +Key bindings: +\\{c-mode-map}" + (interactive) + (c-load-all) + (kill-all-local-variables) + (set-syntax-table c-mode-syntax-table) + (setq major-mode 'c-mode + mode-name "C" + local-abbrev-table c-mode-abbrev-table) + (use-local-map c-mode-map) + (c-common-init) + (setq comment-start "/* " + comment-end " */" + comment-multi-line t + c-conditional-key c-C-conditional-key + c-class-key c-C-class-key + c-baseclass-key nil + c-comment-start-regexp c-C-comment-start-regexp + imenu-generic-expression cc-imenu-c-generic-expression) + (run-hooks 'c-mode-common-hook) + (run-hooks 'c-mode-hook) + (c-update-modeline)) + + +;;;###autoload +(defun c++-mode () + "Major mode for editing 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. + +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. + +Key bindings: +\\{c++-mode-map}" + (interactive) + (c-load-all) + (kill-all-local-variables) + (set-syntax-table c++-mode-syntax-table) + (setq major-mode 'c++-mode + mode-name "C++" + local-abbrev-table c++-mode-abbrev-table) + (use-local-map c++-mode-map) + (c-common-init) + (setq comment-start "// " + comment-end "" + comment-multi-line nil + c-conditional-key c-C++-conditional-key + c-comment-start-regexp c-C++-comment-start-regexp + c-class-key c-C++-class-key + c-access-key c-C++-access-key + c-double-slash-is-comments-p t + c-recognize-knr-p nil + imenu-generic-expression cc-imenu-c++-generic-expression) + (run-hooks 'c-mode-common-hook) + (run-hooks 'c++-mode-hook) + (c-update-modeline)) + + +;;;###autoload +(defun objc-mode () + "Major mode for editing Objective C code. +To submit a problem report, enter `\\[c-submit-bug-report]' from an +objc-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 `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. + +Key bindings: +\\{objc-mode-map}" + (interactive) + (c-load-all) + (kill-all-local-variables) + (set-syntax-table objc-mode-syntax-table) + (setq major-mode 'objc-mode + mode-name "ObjC" + local-abbrev-table objc-mode-abbrev-table) + (use-local-map objc-mode-map) + (c-common-init) + (setq comment-start "// " + comment-end "" + comment-multi-line nil + c-conditional-key c-C-conditional-key + c-comment-start-regexp c-C++-comment-start-regexp + c-class-key c-ObjC-class-key + c-baseclass-key nil + c-access-key c-ObjC-access-key + c-double-slash-is-comments-p t + c-method-key c-ObjC-method-key) + (run-hooks 'c-mode-common-hook) + (run-hooks 'objc-mode-hook) + (c-update-modeline)) + + +;;;###autoload +(defun java-mode () + "Major mode for editing Java code. +To submit a problem report, enter `\\[c-submit-bug-report]' from an +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 +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'. + +Key bindings: +\\{java-mode-map}" + (interactive) + (c-load-all) + (kill-all-local-variables) + (set-syntax-table java-mode-syntax-table) + (setq major-mode 'java-mode + mode-name "Java" + local-abbrev-table java-mode-abbrev-table) + (use-local-map java-mode-map) + (c-common-init) + (setq comment-start "// " + comment-end "" + comment-multi-line nil + c-conditional-key c-Java-conditional-key + c-comment-start-regexp c-Java-comment-start-regexp + c-class-key c-Java-class-key + c-method-key c-Java-method-key + c-double-slash-is-comments-p t + c-baseclass-key nil + c-recognize-knr-p nil + c-access-key c-Java-access-key + ;defun-prompt-regexp c-Java-defun-prompt-regexp + imenu-generic-expression cc-imenu-java-generic-expression + ) + (c-set-style "java") + (run-hooks 'c-mode-common-hook) + (run-hooks 'java-mode-hook) + (c-update-modeline)) + + +;; defuns for submitting bug reports +(defconst c-version "5.11" + "CC Mode version number.") + +(defconst c-mode-help-address + "bug-gnu-emacs@prep.ai.mit.edu, cc-mode-help@python.org" + "Address for CC Mode bug reports.") + +(defun c-version () + "Echo the current version of CC Mode in the minibuffer." + (interactive) + (message "Using CC Mode version %s" c-version) + (c-keep-region-active)) + +;; Get reporter-submit-bug-report when byte-compiling +(eval-when-compile + (require 'reporter)) + +(defun c-submit-bug-report () + "Submit via mail a bug report on CC Mode." + (interactive) + (require 'cc-vars) + ;; load in reporter + (let ((reporter-prompt-for-summary-p t) + (reporter-dont-compact-list '(c-offsets-alist)) + (style c-indentation-style) + (hook c-special-indent-hook) + (c-features c-emacs-features)) + (and + (if (y-or-n-p "Do you want to submit a report on CC Mode? ") + t (message "") nil) + (require 'reporter) + (reporter-submit-bug-report + c-mode-help-address + (concat "CC Mode " c-version " (" + (cond ((eq major-mode 'c++-mode) "C++") + ((eq major-mode 'c-mode) "C") + ((eq major-mode 'objc-mode) "ObjC") + ((eq major-mode 'java-mode) "Java") + ) + ")") + (let ((vars (list + ;; report only the vars that affect indentation + 'c-basic-offset + 'c-offsets-alist + 'c-cleanup-list + 'c-comment-only-line-offset + 'c-backslash-column + 'c-delete-function + 'c-electric-pound-behavior + 'c-hanging-braces-alist + 'c-hanging-colons-alist + 'c-hanging-comment-starter-p + 'c-hanging-comment-ender-p + 'c-indent-comments-syntactically-p + 'c-tab-always-indent + 'c-recognize-knr-p + 'c-label-minimum-indentation + 'defun-prompt-regexp + 'tab-width + ))) + (if (not (boundp 'defun-prompt-regexp)) + (delq 'defun-prompt-regexp vars) + vars)) + (function + (lambda () + (insert + "Buffer Style: " style "\n\n" + (if hook + (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" + "c-special-indent-hook is set to '" + (format "%s" hook) + ".\nPerhaps this is your problem?\n" + "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n") + "\n") + (format "c-emacs-features: %s\n" c-features) + ))) + nil + "Dear Barry," + )))) + + +(provide 'cc-mode) +;;; cc-mode.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/cc-styles.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,621 @@ +;;; cc-styles.el --- support for styles in CC Mode + +;; Copyright (C) 1985,87,92,93,94,95,96,97 Free Software Foundation, Inc. + +;; Authors: 1992-1997 Barry A. Warsaw +;; 1987 Dave Detlefs and Stewart Clamen +;; 1985 Richard M. Stallman +;; Maintainer: cc-mode-help@python.org +;; Created: 22-Apr-1997 (split from cc-mode.el) +;; Version: 5.11 +;; Keywords: c languages oop + +;; 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. + +(eval-when-compile + (load-file "./cc-align.el")) + + +(defconst c-style-alist + '(("gnu" + (c-basic-offset . 2) + (c-comment-only-line-offset . (0 . 0)) + (c-offsets-alist . ((statement-block-intro . +) + (knr-argdecl-intro . 5) + (substatement-open . +) + (label . 0) + (statement-case-open . +) + (statement-cont . +) + (arglist-intro . c-lineup-arglist-intro-after-paren) + (arglist-close . c-lineup-arglist) + )) + (c-special-indent-hook . c-gnu-impose-minimum) + ) + ("k&r" + (c-basic-offset . 5) + (c-comment-only-line-offset . 0) + (c-offsets-alist . ((statement-block-intro . +) + (knr-argdecl-intro . 0) + (substatement-open . 0) + (label . 0) + (statement-cont . +) + )) + ) + ("bsd" + (c-basic-offset . 4) + (c-comment-only-line-offset . 0) + (c-offsets-alist . ((statement-block-intro . +) + (knr-argdecl-intro . +) + (substatement-open . 0) + (label . 0) + (statement-cont . +) + )) + ) + ("stroustrup" + (c-basic-offset . 4) + (c-comment-only-line-offset . 0) + (c-offsets-alist . ((statement-block-intro . +) + (substatement-open . 0) + (label . 0) + (statement-cont . +) + )) + ) + ("whitesmith" + (c-basic-offset . 4) + (c-comment-only-line-offset . 0) + (c-offsets-alist . ((statement-block-intro . +) + (knr-argdecl-intro . +) + (substatement-open . 0) + (label . 0) + (statement-cont . +) + )) + + ) + ("ellemtel" + (c-basic-offset . 3) + (c-comment-only-line-offset . 0) + (c-hanging-braces-alist . ((substatement-open before after))) + (c-offsets-alist . ((topmost-intro . 0) + (topmost-intro-cont . 0) + (substatement . +) + (substatement-open . 0) + (case-label . +) + (access-label . -) + (inclass . ++) + (inline-open . 0) + )) + ) + ("linux" + (c-basic-offset . 8) + (c-comment-only-line-offset . 0) + (c-hanging-braces-alist . ((brace-list-open) + (substatement-open after) + (block-close . c-snug-do-while))) + (c-cleanup-list . (brace-else-brace)) + (c-offsets-alist . ((statement-block-intro . +) + (knr-argdecl-intro . 0) + (substatement-open . 0) + (label . 0) + (statement-cont . +) + )) + ) + ("python" + (indent-tabs-mode . t) + (fill-column . 72) + (c-basic-offset . 8) + (c-offsets-alist . ((substatement-open . 0) + )) + (c-hanging-braces-alist . ((brace-list-open) + (brace-list-intro) + (brace-list-close) + (substatement-open after) + (block-close . c-snug-do-while) + )) + ) + ("java" + (c-basic-offset . 2) + (c-comment-only-line-offset . (0 . 0)) + (c-offsets-alist . ((topmost-intro-cont . +) + (statement-block-intro . +) + (knr-argdecl-intro . 5) + (substatement-open . +) + (label . 0) + (statement-case-open . +) + (statement-cont . +) + (arglist-intro . c-lineup-arglist-intro-after-paren) + (arglist-close . c-lineup-arglist) + (access-label . 0) + (inher-cont . c-lineup-java-inher) + (func-decl-cont . c-lineup-java-throws) + )) + + ) + ) + "Styles of indentation. +Elements of this alist are of the form: + + (STYLE-STRING [BASE-STYLE] (VARIABLE . VALUE) [(VARIABLE . VALUE) ...]) + +where STYLE-STRING is a short descriptive string used to select a +style, VARIABLE is any Emacs variable, and VALUE is the intended value +for that variable when using the selected style. + +Optional BASE-STYLE if present, is a string and must follow +STYLE-STRING. BASE-STYLE names a style that this style inherits from. +By default, all styles inherit from the \"cc-mode\" style, which is +computed at run time. Style loops generate errors. + +Two variables are treated specially. When VARIABLE is +`c-offsets-alist', the VALUE is a list containing elements of the +form: + + (SYNTACTIC-SYMBOL . OFFSET) + +as described in `c-offsets-alist'. These are passed directly to +`c-set-offset' so there is no need to set every syntactic symbol in +your style, only those that are different from the default. + +When VARIABLE is `c-special-indent-hook', its VALUE is added to +`c-special-indent-hook' using `add-hook'. If VALUE is a list, each +element of the list is added with `add-hook'. + +Do not change this variable directly. Use the function `c-add-style' +to add new styles or modify existing styles (it is not a good idea to +modify existing styles -- you should create a new style that inherits +the existing style.") + + +;; Functions that manipulate styles +(defun c-set-style-1 (conscell) + ;; Set the style for one variable + (let ((attr (car conscell)) + (val (cdr conscell))) + (cond + ;; first special variable + ((eq attr 'c-offsets-alist) + (mapcar + (function + (lambda (langentry) + (let ((langelem (car langentry)) + (offset (cdr langentry))) + (c-set-offset langelem offset) + ))) + val)) + ;; second special variable + ((eq attr 'c-special-indent-hook) + (if (listp val) + (while val + (add-hook 'c-special-indent-hook (car val)) + (setq val (cdr val))) + (add-hook 'c-special-indent-hook val))) + ;; all other variables + (t (set attr val))) + )) + +(defun c-set-style-2 (style basestyles) + ;; Recursively set the base style. If no base style is given, the + ;; default base style is "cc-mode" and the recursion stops. Be sure + ;; to detect loops. + (if (not (string-equal style "cc-mode")) + (let ((base (if (stringp (car basestyles)) + (downcase (car basestyles)) + "cc-mode"))) + (if (memq base basestyles) + (error "Style loop detected: %s in %s" base basestyles)) + (c-set-style-2 base (cons base basestyles)))) + (let ((vars (cdr (or (assoc (downcase style) c-style-alist) + (assoc (upcase style) c-style-alist) + (assoc style c-style-alist) + (error "Undefined style: %s" style))))) + (mapcar 'c-set-style-1 vars))) + +(defvar c-set-style-history nil) + +;;;###autoload +(defun c-set-style (stylename) + "Set CC Mode variables to use one of several different indentation styles. +STYLENAME is a string representing the desired style from the list of +styles described in the variable `c-style-alist'. See that variable +for details of setting up styles. + +The variable `c-indentation-style' always contains the buffer's current +style name." + (interactive (list (let ((completion-ignore-case t) + (prompt (format "Which %s indentation style? " + mode-name))) + (completing-read prompt c-style-alist nil t + (cons c-indentation-style 0) + 'c-set-style-history)))) + (c-set-style-2 stylename nil) + (setq c-indentation-style stylename) + (c-keep-region-active)) + +;;;###autoload +(defun c-add-style (style descrip &optional set-p) + "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: + + ([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." + (interactive + (let ((stylename (completing-read "Style to add: " c-style-alist + nil nil nil 'c-set-style-history)) + (description (eval-minibuffer "Style description: "))) + (list stylename description + (y-or-n-p "Set the style too? ")))) + (setq style (downcase style)) + (let ((s (assoc style c-style-alist))) + (if s + (setcdr s (copy-alist descrip)) ; replace + (setq c-style-alist (cons (cons style descrip) c-style-alist)))) + (and set-p (c-set-style style))) + + + +(defconst c-offsets-alist + '((string . -1000) + (c . c-lineup-C-comments) + (defun-open . 0) + (defun-close . 0) + (defun-block-intro . +) + (class-open . 0) + (class-close . 0) + (inline-open . +) + (inline-close . 0) + (func-decl-cont . +) + (knr-argdecl-intro . +) + (knr-argdecl . 0) + (topmost-intro . 0) + (topmost-intro-cont . 0) + (member-init-intro . +) + (member-init-cont . 0) + (inher-intro . +) + (inher-cont . c-lineup-multi-inher) + (block-open . 0) + (block-close . 0) + (brace-list-open . 0) + (brace-list-close . 0) + (brace-list-intro . +) + (brace-list-entry . 0) + (statement . 0) + ;; some people might prefer + ;;(statement . c-lineup-runin-statements) + (statement-cont . +) + ;; some people might prefer + ;;(statement-cont . c-lineup-math) + (statement-block-intro . +) + (statement-case-intro . +) + (statement-case-open . 0) + (substatement . +) + (substatement-open . +) + (case-label . 0) + (access-label . -) + (label . 2) + (do-while-closure . 0) + (else-clause . 0) + (comment-intro . c-lineup-comment) + (arglist-intro . +) + (arglist-cont . 0) + (arglist-cont-nonempty . c-lineup-arglist) + (arglist-close . +) + (stream-op . c-lineup-streamop) + (inclass . +) + (cpp-macro . -1000) + (friend . 0) + (objc-method-intro . -1000) + (objc-method-args-cont . c-lineup-ObjC-method-args) + (objc-method-call-cont . c-lineup-ObjC-method-call) + (extern-lang-open . 0) + (extern-lang-close . 0) + (inextern-lang . +) + ) + "Association list of syntactic element symbols and indentation offsets. +As described below, each cons cell in this list has the form: + + (SYNTACTIC-SYMBOL . OFFSET) + +When a line is indented, CC Mode first determines the syntactic +context of the line by generating a list of symbols called syntactic +elements. This list can contain more than one syntactic element and +the global variable `c-syntactic-context' contains the context list +for the line being indented. Each element in this list is actually a +cons cell of the syntactic symbol and a buffer position. This buffer +position is called the relative indent point for the line. Some +syntactic symbols may not have a relative indent point associated with +them. + +After the syntactic context list for a line is generated, CC Mode +calculates the absolute indentation for the line by looking at each +syntactic element in the list. First, it compares the syntactic +element against the SYNTACTIC-SYMBOL's in `c-offsets-alist'. When it +finds a match, it adds the OFFSET to the column of the relative indent +point. The sum of this calculation for each element in the syntactic +list is the absolute offset for line being indented. + +If the syntactic element does not match any in the `c-offsets-alist', +an error is generated if `c-strict-syntax-p' is non-nil, otherwise the +element is ignored. + +Actually, OFFSET can be an integer, a function, a variable, or one of +the following symbols: `+', `-', `++', `--', `*', or `/'. These +latter designate positive or negative multiples of `c-basic-offset', +respectively: 1, -1, 2, -2, 0.5, and -0.5. If OFFSET is a function, it +is called with a single argument containing the cons of the syntactic +element symbol and the relative indent point. The function should +return an integer offset. + +Here is the current list of valid syntactic element symbols: + + string -- inside multi-line string + c -- inside a multi-line C style block comment + defun-open -- brace that opens a function definition + defun-close -- brace that closes a function definition + defun-block-intro -- the first line in a top-level defun + class-open -- brace that opens a class definition + class-close -- brace that closes a class definition + inline-open -- brace that opens an in-class inline method + inline-close -- brace that closes an in-class inline method + func-decl-cont -- the region between a function definition's + argument list and the function opening brace + (excluding K&R argument declarations). In C, you + cannot put anything but whitespace and comments + between them; in C++ and Java, throws declarations + and other things can appear in this context. + knr-argdecl-intro -- first line of a K&R C argument declaration + knr-argdecl -- subsequent lines in a K&R C argument declaration + topmost-intro -- the first line in a topmost construct definition + topmost-intro-cont -- topmost definition continuation lines + member-init-intro -- first line in a member initialization list + member-init-cont -- subsequent member initialization list lines + inher-intro -- first line of a multiple inheritance list + inher-cont -- subsequent multiple inheritance lines + block-open -- statement block open brace + block-close -- statement block close brace + brace-list-open -- open brace of an enum or static array list + brace-list-close -- close brace of an enum or static array list + brace-list-intro -- first line in an enum or static array list + brace-list-entry -- subsequent lines in an enum or static array list + statement -- a C (or like) statement + statement-cont -- a continuation of a C (or like) statement + statement-block-intro -- the first line in a new statement block + statement-case-intro -- the first line in a case \"block\" + statement-case-open -- the first line in a case block starting with brace + substatement -- the first line after an if/while/for/do/else + substatement-open -- the brace that opens a substatement block + case-label -- a `case' or `default' label + access-label -- C++ private/protected/public access label + label -- any ordinary label + do-while-closure -- the `while' that ends a do/while construct + else-clause -- the `else' of an if/else construct + comment-intro -- a line containing only a comment introduction + arglist-intro -- the first line in an argument list + arglist-cont -- subsequent argument list lines when no + arguments follow on the same line as the + arglist opening paren + arglist-cont-nonempty -- subsequent argument list lines when at + least one argument follows on the same + line as the arglist opening paren + arglist-close -- the solo close paren of an argument list + stream-op -- lines continuing a stream operator construct + inclass -- the construct is nested inside a class definition + cpp-macro -- the start of a cpp macro + friend -- a C++ friend declaration + objc-method-intro -- the first line of an Objective-C method definition + objc-method-args-cont -- lines continuing an Objective-C method definition + objc-method-call-cont -- lines continuing an Objective-C method call + extern-lang-open -- brace that opens an external language block + extern-lang-close -- brace that closes an external language block + inextern-lang -- analogous to `inclass' syntactic symbol +") + +(defun c-get-offset (langelem) + ;; Get offset from LANGELEM which is a cons cell of the form: + ;; (SYMBOL . RELPOS). The symbol is matched against + ;; c-offsets-alist and the offset found there is either returned, + ;; or added to the indentation at RELPOS. If RELPOS is nil, then + ;; the offset is simply returned. + (let* ((symbol (car langelem)) + (relpos (cdr langelem)) + (match (assq symbol c-offsets-alist)) + (offset (cdr-safe match))) + ;; offset can be a number, a function, a variable, or one of the + ;; symbols + or - + (cond + ((not match) + (if c-strict-syntax-p + (error "don't know how to indent a %s" symbol) + (setq offset 0 + relpos 0))) + ((eq offset '+) (setq offset c-basic-offset)) + ((eq offset '-) (setq offset (- c-basic-offset))) + ((eq offset '++) (setq offset (* 2 c-basic-offset))) + ((eq offset '--) (setq offset (* 2 (- c-basic-offset)))) + ((eq offset '*) (setq offset (/ c-basic-offset 2))) + ((eq offset '/) (setq offset (/ (- c-basic-offset) 2))) + ((functionp offset) (setq offset (funcall offset langelem))) + ((not (numberp offset)) (setq offset (symbol-value offset))) + ) + (+ (if (and relpos + (< relpos (c-point 'bol))) + (save-excursion + (goto-char relpos) + (current-column)) + 0) + offset))) + + +(defvar c-read-offset-history nil) + +(defun c-read-offset (langelem) + ;; read new offset value for LANGELEM from minibuffer. return a + ;; legal value only + (let* ((oldoff (cdr-safe (assq langelem c-offsets-alist))) + (defstr (format "(default %s): " oldoff)) + (errmsg (concat "Offset must be int, func, var, " + "or in [+,-,++,--,*,/] " + defstr)) + (prompt (concat "Offset " defstr)) + offset input interned raw) + (while (not offset) + (setq input (completing-read prompt obarray 'fboundp nil nil + 'c-read-offset-history) + offset (cond ((string-equal "" input) oldoff) ; default + ((string-equal "+" input) '+) + ((string-equal "-" input) '-) + ((string-equal "++" input) '++) + ((string-equal "--" input) '--) + ((string-equal "*" input) '*) + ((string-equal "/" input) '/) + ((string-match "^-?[0-9]+$" input) + (string-to-int input)) + ;; a symbol with a function binding + ((fboundp (setq interned (intern input))) + interned) + ;; a lambda function + ((c-safe (functionp (setq raw (read input)))) + raw) + ;; a symbol with variable binding + ((boundp interned) interned) + ;; error, but don't signal one, keep trying + ;; to read an input value + (t (ding) + (setq prompt errmsg) + nil)))) + offset)) + +(defun c-set-offset (symbol offset &optional add-p) + "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. Optional ADD says to add SYMBOL to +`c-offsets-alist' if it doesn't already appear there." + (interactive + (let* ((langelem + (intern (completing-read + (concat "Syntactic symbol to change" + (if current-prefix-arg " or add" "") + ": ") + (mapcar + #'(lambda (langelem) + (cons (format "%s" (car langelem)) nil)) + c-offsets-alist) + nil (not current-prefix-arg) + ;; initial contents tries to be the last element + ;; on the syntactic analysis list for the current + ;; line + (let* ((syntax (c-guess-basic-syntax)) + (len (length syntax)) + (ic (format "%s" (car (nth (1- len) syntax))))) + (cons ic 0)) + ))) + (offset (c-read-offset langelem))) + (list langelem offset current-prefix-arg))) + ;; sanity check offset + (or (eq offset '+) + (eq offset '-) + (eq offset '++) + (eq offset '--) + (eq offset '*) + (eq offset '/) + (integerp offset) + (functionp offset) + (boundp offset) + (error "Offset must be int, func, var, or in [+,-,++,--,*,/]: %s" + offset)) + (let ((entry (assq symbol c-offsets-alist))) + (if entry + (setcdr entry offset) + (if add-p + (setq c-offsets-alist (cons (cons symbol offset) c-offsets-alist)) + (error "%s is not a valid syntactic symbol." symbol)))) + (c-keep-region-active)) + + + +;; Dynamically append the default value of most variables. This is +;; crucial because future c-set-style calls will always reset the +;; variables first to the `cc-mode' style before instituting the new +;; style. Only do this once! +(or (assoc "cc-mode" c-style-alist) + (progn + (c-add-style "cc-mode" + (mapcar + (function + (lambda (var) + (let ((val (symbol-value var))) + (cons var (if (atom val) val + (copy-tree val) + )) + ))) + '(c-backslash-column + c-basic-offset + c-cleanup-list + c-comment-only-line-offset + c-electric-pound-behavior + c-hanging-braces-alist + c-hanging-colons-alist + c-hanging-comment-starter-p + c-hanging-comment-ender-p + c-offsets-alist + ))) + ;; the default style is now GNU. This can be overridden in + ;; c-mode-common-hook or {c,c++,objc,java}-mode-hook. + (c-set-style c-site-default-style))) + +(defun c-make-styles-buffer-local () + "Make all CC Mode style variables buffer local. +If you edit primarily one style of C (or C++, Objective-C, Java) code, +you probably want style variables to be global. This is the default. + +If you edit many different styles of C (or C++, Objective-C, Java) at +the same time, you probably want the CC Mode style variables to be +buffer local. If you do, then you will need to set any CC Mode style +variables in a hook function (e.g. off of c-mode-common-hook), instead +of at the top level of your ~/.emacs file. + +This function makes all the CC Mode style variables buffer local. +Call it after CC Mode is loaded into your Emacs environment. +Conversely, set the variable `c-style-variables-are-local-p' to t in +your .emacs file, before CC Mode is loaded, and this function will be +automatically called when CC Mode is loaded." + ;; style variables + (make-variable-buffer-local 'c-offsets-alist) + (make-variable-buffer-local 'c-basic-offset) + (make-variable-buffer-local 'c-file-style) + (make-variable-buffer-local 'c-file-offsets) + (make-variable-buffer-local 'c-comment-only-line-offset) + (make-variable-buffer-local 'c-cleanup-list) + (make-variable-buffer-local 'c-hanging-braces-alist) + (make-variable-buffer-local 'c-hanging-colons-alist) + (make-variable-buffer-local 'c-hanging-comment-starter-p) + (make-variable-buffer-local 'c-hanging-comment-ender-p) + (make-variable-buffer-local 'c-backslash-column) + (make-variable-buffer-local 'c-label-minimum-indentation) + (make-variable-buffer-local 'c-special-indent-hook) + (make-variable-buffer-local 'c-indentation-style)) + +(if c-style-variables-are-local-p + (c-make-styles-buffer-local)) + + + +(provide 'cc-styles) +;;; cc-styles.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/cc-vars.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,390 @@ +;;; cc-vars.el --- user customization variables for CC Mode + +;; Copyright (C) 1985,87,92,93,94,95,96,97 Free Software Foundation, Inc. + +;; Authors: 1992-1997 Barry A. Warsaw +;; 1987 Dave Detlefs and Stewart Clamen +;; 1985 Richard M. Stallman +;; Maintainer: cc-mode-help@python.org +;; Created: 22-Apr-1997 (split from cc-mode.el) +;; Version: 5.11 +;; Keywords: c languages oop + +;; 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. + +(require 'custom) + + +(defcustom c-strict-syntax-p nil + "*If non-nil, all syntactic symbols must be found in `c-offsets-alist'. +If the syntactic symbol for a particular line does not match a symbol +in the offsets alist, an error is generated, otherwise no error is +reported and the syntactic symbol is ignored." + :type 'boolean + :group 'c) + +(defcustom c-echo-syntactic-information-p nil + "*If non-nil, syntactic info is echoed when the line is indented." + :type 'boolean + :group 'c) + +(defcustom c-basic-offset 4 + "*Amount of basic offset used by + and - symbols in `c-offsets-alist'." + :type 'integer + :group 'c) + +(defcustom c-tab-always-indent t + "*Controls the operation of the TAB key. +If t, hitting TAB always just indents the current line. If nil, +hitting TAB indents the current line if point is at the left margin or +in the line's indentation, otherwise it insert a `real' tab character +\(see note\). If other than nil or t, then tab is inserted only +within literals -- defined as comments and strings -- and inside +preprocessor directives, but line is always reindented. + +Note: The value of `indent-tabs-mode' will determine whether a real +tab character will be inserted, or the equivalent number of space. +When inserting a tab, actually the function stored in the variable +`c-insert-tab-function' is called. + +Note: indentation of lines containing only comments is also controlled +by the `c-comment-only-line-offset' variable." + :type '(radio + :extra-offset 8 + :format "%{Tab Always Indent%}:\n The TAB key\n%v" + (const :tag "always indents, never inserts TAB" t) + (const :tag "indents in left margin, otherwise inserts TAB" nil) + (const :tag "inserts TAB in literals, otherwise indent" other)) + :group 'c) + +(defcustom c-insert-tab-function 'insert-tab + "*Function used when inserting a tab for \\[TAB]. +Only used when `c-tab-always-indent' indicates a `real' tab character +should be inserted. Value must be a function taking no arguments." + :type 'function + :group 'c) + +(defcustom c-comment-only-line-offset 0 + "*Extra offset for line which contains only the start of a comment. +Can contain an integer or a cons cell of the form: + + (NON-ANCHORED-OFFSET . ANCHORED-OFFSET) + +Where NON-ANCHORED-OFFSET is the amount of offset given to +non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is +the amount of offset to give column-zero anchored comment-only lines. +Just an integer as value is equivalent to (<val> . -1000)." + :type '(choice (integer :tag "Non-anchored offset") + (cons :tag "Non-anchored & anchored offset" + :value (0 . 0) + :extra-offset 8 + (integer :tag "Non-anchored offset") + (integer :tag "Anchored offset"))) + :group 'c) + +(defcustom c-indent-comments-syntactically-p nil + "*Specifies how comment-only lines should be indented. +When this variable is non-nil, comment-only lines are indented +according to syntactic analysis via `c-offsets-alist', even when +\\[indent-for-comment] is used." + :type 'boolean + :group 'c) + +(defcustom c-cleanup-list '(scope-operator) + "*List of various C/C++/ObjC constructs to \"clean up\". +These clean ups only take place when the auto-newline feature is +turned on, as evidenced by the `/a' or `/ah' appearing next to the +mode name. Valid symbols are: + + brace-else-brace -- cleans up `} else {' constructs by placing entire + construct on a single line. This clean up + only takes place when there is nothing but + white space between the braces and the `else'. + Clean up occurs when the open-brace after the + `else' is typed. + brace-elseif-brace -- similar to brace-else-brace, but cleans up + `} else if {' constructs. + empty-defun-braces -- cleans up empty defun braces by placing the + braces on the same line. Clean up occurs when + the defun closing brace is typed. + defun-close-semi -- cleans up the terminating semi-colon on defuns + by placing the semi-colon on the same line as + the closing brace. Clean up occurs when the + semi-colon is typed. + list-close-comma -- cleans up commas following braces in array + and aggregate initializers. Clean up occurs + when the comma is typed. + scope-operator -- cleans up double colons which may designate + a C++ scope operator split across multiple + lines. Note that certain C++ constructs can + generate ambiguous situations. This clean up + only takes place when there is nothing but + whitespace between colons. Clean up occurs + when the second colon is typed." + :type '(set + :extra-offset 8 + (const :tag "Put `} else {' on one line" brace-else-brace) + (const :tag "Put `} else if {' on one line" brace-elseif-brace) + (const :tag "Put empty defun braces on one line" empty-defun-braces) + (const :tag "Put `},' in aggregates on one line" list-close-comma) + (const :tag "Put C++ style `::' on one line" scope-operator)) + :group 'c) + +(defcustom c-hanging-braces-alist '((brace-list-open) + (substatement-open after) + (block-close . c-snug-do-while) + (extern-lang-open after) + ) + "*Controls the insertion of newlines before and after braces. +This variable contains an association list with elements of the +following form: (SYNTACTIC-SYMBOL . ACTION). + +When a brace (either opening or closing) is inserted, the syntactic +context it defines is looked up in this list, and if found, the +associated ACTION is used to determine where newlines are inserted. +If the context is not found, the default is to insert a newline both +before and after the brace. + +SYNTACTIC-SYMBOL can be any of: defun-open, defun-close, class-open, +class-close, inline-open, inline-close, block-open, block-close, +substatement-open, statement-case-open, extern-lang-open, +extern-lang-close, brace-list-open, brace-list-close, +brace-list-intro, or brace-list-entry. See `c-offsets-alist' for +details. + +ACTION can be either a function symbol or a list containing any +combination of the symbols `before' or `after'. If the list is empty, +no newlines are inserted either before or after the brace. + +When ACTION is a function symbol, the function is called with a two +arguments: the syntactic symbol for the brace and the buffer position +at which the brace was inserted. The function must return a list as +described in the preceding paragraph. Note that during the call to +the function, the variable `c-syntactic-context' is set to the entire +syntactic context for the brace line." + :type '(repeat + (cons :format "%v" + (choice :tag "Syntax" + (const defun-open) (const defun-close) + (const class-open) (const class-close) + (const inline-open) (const inline-close) + (const block-open) (const block-close) + (const substatement-open) (const statement-case-open) + (const extern-lang-open) (const extern-lang-close) + (const brace-list-open) (const brace-list-close) + (const brace-list-intro) (const brace-list-entry)) + (choice :tag "Action" + (set :format "%v" + :extra-offset 8 + (const before) (const after)) + (function :format "%v" :value c-) + ))) + :group 'c) + +(defcustom c-hanging-colons-alist nil + "*Controls the insertion of newlines before and after certain colons. +This variable contains an association list with elements of the +following form: (SYNTACTIC-SYMBOL . ACTION). + +SYNTACTIC-SYMBOL can be any of: case-label, label, access-label, +member-init-intro, or inher-intro. + +See the variable `c-hanging-braces-alist' for the semantics of this +variable. Note however that making ACTION a function symbol is +currently not supported for this variable." + :type '(repeat + (cons :format "%v" + (choice :tag "Syntax" + (const case-label) (const label) (const access-label) + (const member-init-intro) (const inher-intro)) + (set :tag "Action" + :format "%t: %v" + :extra-offset 8 + (const before) (const after)))) + :group 'c) + +(defcustom c-hanging-semi&comma-criteria '(c-semi&comma-inside-parenlist) + "*List of functions that decide whether to insert a newline or not. +The functions in this list are called, in order, whenever the +auto-newline minor mode is activated (as evidenced by a `/a' or `/ah' +string in the mode line), and a semicolon or comma is typed (see +`c-electric-semi&comma'). Each function in this list is called with +no arguments, and should return one of the following values: + + nil -- no determination made, continue checking + 'stop -- do not insert a newline, and stop checking + (anything else) -- insert a newline, and stop checking + +If every function in the list is called with no determination made, +then no newline is inserted." + :type '(repeat function) + :group 'c) + +(defcustom c-hanging-comment-ender-p t + "*Controls what \\[fill-paragraph] does to C block comment enders. +When set to nil, C block comment enders are left on their own line. +When set to t, block comment enders will be placed at the end of the +previous line (i.e. they `hang' on that line)." + :type 'boolean + :group 'c) + +(defcustom c-hanging-comment-starter-p t + "*Controls what \\[fill-paragraph] does to C block comment starters. +When set to nil, C block comment starters are left on their own line. +When set to t, text that follows a block comment starter will be +placed on the same line as the block comment starter (i.e. the text +`hangs' on that line)." + :type 'boolean + :group 'c) + +(defcustom c-backslash-column 48 + "*Column to insert backslashes when macroizing a region." + :type 'integer + :group 'c) + +(defcustom c-special-indent-hook nil + "*Hook for user defined special indentation adjustments. +This hook gets called after a line is indented by the mode." + :type 'hook + :group 'c) + +(defcustom c-backspace-function 'backward-delete-char-untabify + "*Function called by `c-electric-backspace' when deleting backwards." + :type 'function + :group 'c) + +(defcustom c-delete-function 'delete-char + "*Function called by `c-electric-delete' when deleting forwards." + :type 'function + :group 'c) + +(defcustom c-electric-pound-behavior nil + "*List of behaviors for electric pound insertion. +Only currently supported behavior is `alignleft'." + :type '(set :extra-offset 8 (const alignleft)) + :group 'c) + +(defcustom c-label-minimum-indentation 1 + "*Minimum indentation for lines inside of top-level constructs. +This variable typically only affects code using the `gnu' style, which +mandates a minimum of one space in front of every line inside +top-level constructs. Specifically, the function +`c-gnu-impose-minimum' on your `c-special-indent-hook' is what +enforces this." + :type 'integer + :group 'c) + +(defcustom c-progress-interval 5 + "*Interval used to update progress status during long re-indentation. +If a number, percentage complete gets updated after each interval of +that many seconds. Set to nil to inhibit updating. This is only +useful for Emacs 19." + :type 'integer + :group 'c) + +(defcustom c-site-default-style "gnu" + "Default style for your site. +To change the default style at your site, you can set this variable to +any style defined in `c-style-alist'. However, if CC Mode is usually +loaded into your Emacs at compile time, you will need to set this +variable in the `site-init.el' file before CC Mode is loaded, then +re-dump Emacs." + :type 'string + :group 'c) + +(defcustom c-style-variables-are-local-p nil + "*Whether style variables should be buffer local by default. +If non-nil, then all indentation style related variables will be made +buffer local by default. If nil, they will remain global. Variables +are made buffer local when this file is loaded, and once buffer +localized, they cannot be made global again. + +The list of variables to buffer localize are: + c-offsets-alist + c-basic-offset + c-file-style + c-file-offsets + c-comment-only-line-offset + c-cleanup-list + c-hanging-braces-alist + c-hanging-colons-alist + c-hanging-comment-starter-p + c-hanging-comment-ender-p + c-backslash-column + c-label-minimum-indentation + c-special-indent-hook + c-indentation-style" + :type 'boolean + :group 'c) + +(defcustom c-mode-hook nil + "*Hook called by `c-mode'." + :type '(hook :format "%{C Mode Hook%}:\n%v") + :group 'c) + +(defcustom c++-mode-hook nil + "*Hook called by `c++-mode'." + :type 'hook + :group 'c) + +(defcustom objc-mode-hook nil + "*Hook called by `objc-mode'." + :type 'hook + :group 'c) + +(defcustom java-mode-hook nil + "*Hook called by `java-mode'." + :type 'hook + :group 'c) + +(defcustom c-mode-common-hook nil + "*Hook called by all CC Mode modes for common initializations." + :type '(hook :format "%{CC Mode Common Hook%}:\n%v") + :group 'c) + + + +;; Non-customizable variables, still part of the interface to CC Mode +(defvar c-file-style nil + "Variable interface for setting style via File Local Variables. +In a file's Local Variable section, you can set this variable to a +string suitable for `c-set-style'. When the file is visited, CC Mode +will set the style of the file to this value automatically. + +Note that file style settings are applied before file offset settings +as designated in the variable `c-file-offsets'.") + +(defvar c-file-offsets nil + "Variable interface for setting offsets via File Local Variables. +In a file's Local Variable section, you can set this variable to an +association list similar to the values allowed in `c-offsets-alist'. +When the file is visited, CC Mode will institute these offset settings +automatically. + +Note that file offset settings are applied after file style settings +as designated in the variable `c-file-style'.") + +(defvar c-syntactic-context nil + "Variable containing syntactic analysis list during indentation.") + +(defvar c-indentation-style c-site-default-style + "Name of style installed in the current buffer.") + + +(provide 'cc-vars) +;;; cc-vars.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,65 @@ +(put 'copyright 'custom-loads '()) +(put 'eldoc 'custom-loads '()) +(put 'execute 'custom-loads '()) +(put 'mouse 'custom-loads '()) +(put 'mail-abbrevs 'custom-loads '()) +(put 'etags 'custom-loads '()) +(put 'limits 'custom-loads '()) +(put 'minibuffer 'custom-loads '()) +(put 'environment 'custom-loads '()) +(put 'sound 'custom-loads '()) +(put 'holidays 'custom-loads '()) +(put 'auto-save 'custom-loads '()) +(put 'ispell 'custom-loads '()) +(put 'fortran-indent 'custom-loads '()) +(put 'lpr 'custom-loads '()) +(put 'message-headers 'custom-loads '()) +(put 'editing-basics 'custom-loads '()) +(put 'internal 'custom-loads '()) +(put 'calendar 'custom-loads '()) +(put 'help-appearance 'custom-loads '()) +(put 'display-time 'custom-loads '()) +(put 'lisp 'custom-loads '()) +(put 'diff 'custom-loads '()) +(put 'paren-matching 'custom-loads '()) +(put 'help 'custom-loads '()) +(put 'local 'custom-loads '()) +(put 'keyboard 'custom-loads '()) +(put 'minubuffer 'custom-loads '()) +(put 'message-sending 'custom-loads '()) +(put 'data 'custom-loads '()) +(put 'ps-print 'custom-loads '()) +(put 'backup 'custom-loads '()) +(put 'frames 'custom-loads '()) +(put 'customize 'custom-loads '()) +(put 'abbrev 'custom-loads '()) +(put 'toolbar 'custom-loads '()) +(put 'compilation 'custom-loads '()) +(put 'dired 'custom-loads '()) +(put 'killing 'custom-loads '()) +(put 'paren-blinking 'custom-loads '()) +(put 'find-file 'custom-loads '()) +(put 'gnuserv 'custom-loads '()) +(put 'maint 'custom-loads '()) +(put 'fill-comments 'custom-loads '()) +(put 'message-mail 'custom-loads '()) +(put 'windows 'custom-loads '()) +(put 'message-various 'custom-loads '()) +(put 'resize-minibuffer 'custom-loads '()) +(put 'fill 'custom-loads '()) +(put 'debug 'custom-loads '()) +(put 'display 'custom-loads '()) +(put 'diary 'custom-loads '()) +(put 'browse-url 'custom-loads '()) +(put 'message-insertion 'custom-loads '()) +(put 'vc 'custom-loads '()) +(put 'alloc 'custom-loads '()) +(put 'isearch 'custom-loads '()) +(put 'modeline 'custom-loads '()) +(put 'processes-basics 'custom-loads '()) +(put 'editing 'custom-loads '()) +(put 'matching 'custom-loads '()) +(put 'ps-print-color 'custom-loads '()) +(put 'undo 'custom-loads '()) +(put 'x 'custom-loads '()) +(put 'c 'custom-loads '("cc-vars"))
--- a/lisp/cl/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/cl/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/comint/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/comint/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -62,7 +62,6 @@ (put 'browse-url 'custom-loads '()) (put 'processes 'custom-loads '("background" "comint" "rlogin" "shell" "ssh")) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'background 'custom-loads '("background")) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '())
--- a/lisp/custom/ChangeLog Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/custom/ChangeLog Mon Aug 13 09:44:42 2007 +0200 @@ -1,3 +1,83 @@ +Wed Jun 25 17:46:18 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.9937 released. + +Wed Jun 25 17:29:08 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * widget.el (:match-alternatives): New keyword. + + * custom.el: Updated autoloads. + + * all: Synched with FSF. + +Tue Jun 24 16:27:41 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.9936 released. + +Tue Jun 24 14:35:17 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * cus-edit.el (customize-browse): Take a group argument. + (custom-help-menu): Browse `emacs' group. + + * Version 1.9935 released. + +Tue Jun 24 14:31:53 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.9934 released. + +Tue Jun 24 14:30:26 MET DST 1997 Simon Marshall <simon@gnu.ai.mit.edu> + + * cus-edit.el (custom-add-parent-links): Simplify mapatoms lambda. + (custom-browse): New group. + (custom-buffer-groups-last): + (custom-menu-groups-first): Options deleted. + (custom-browse-sort-alphabetically): + (custom-browse-order-groups): + (custom-buffer-order-groups): + (custom-menu-order-groups): New options. + (custom-browse-sort-predicate): + (custom-buffer-sort-predicate): + (custom-menu-sort-predicate): Functions deleted. + (custom-sort-items): New replacement function; simplification and + extension of previous predicate functions. + (customize-face): + (customize-customized): + (customize-saved): + (customize-apropos): + (custom-menu-create): + (custom-group-value-create): Use it. + +Tue Jun 24 11:46:40 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * cus-edit.el (custom-tree-alist): Use "-\ " instead of "-+ ". + (custom-group-value-create): Ditto. + + * Version 1.9933 released. + +Tue Jun 24 11:32:55 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * wid-edit.el (widget-button-click): Steal up event if key is not + bounbd in `widget-global-map'. + +Mon Jun 23 17:23:27 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.9932 released. + +Mon Jun 23 11:56:40 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * cus-edit.el (custom-tree-insert-prefix): Renamed from + `custom-tree-insert'. + (custom-group-value-create): Use it. + + * wid-edit.el (widget-field-use-before-change): New option. + (widget-setup): Obey it. + + * cus-edit.el (custom-help-menu): Add entry for + `customize-browse'. + + * widget.texi: Change `@br' to `@*'. + Patch by Ralph Schleicher <rs@purple.UL.BaWue.DE>. + Sat Jun 21 21:10:57 1997 Per Abrahamsen <abraham@dina.kvl.dk> * Version 1.9931 released.
--- a/lisp/custom/auto-autoloads.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/custom/auto-autoloads.el Mon Aug 13 09:44:42 2007 +0200 @@ -2,9 +2,9 @@ (if (not (featurep 'custom-autoloads)) (progn -;;;### (autoloads (customize-menu-create custom-menu-create custom-save-all custom-save-customized 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-option customize-group-other-window customize-group customize custom-set-variable custom-set-value) "cus-edit" "custom/cus-edit.el") +;;;### (autoloads (customize-menu-create custom-menu-create custom-save-all customize-save-customized 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-option customize-group-other-window customize-group customize customize-set-variable customize-set-value) "cus-edit" "custom/cus-edit.el") -(autoload 'custom-set-value "cus-edit" "\ +(autoload 'customize-set-value "cus-edit" "\ Set VARIABLE to VALUE. VALUE is a Lisp object. If VARIABLE has a `variable-interactive' property, that is used as if @@ -13,7 +13,7 @@ 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." t nil) -(autoload 'custom-set-variable "cus-edit" "\ +(autoload 'customize-set-variable "cus-edit" "\ Set the default for VARIABLE to VALUE. VALUE is a Lisp object. If VARIABLE has a `custom-set' property, that is used for setting @@ -101,7 +101,7 @@ (defcustom custom-file (if (featurep 'xemacs) "~/.xemacs-custom" "~/.emacs") "File used for storing customization information.\nIf you change this from the default \"~/.emacs\" you need to\nexplicitly load that file for the settings to take effect." :type 'file :group 'customize) -(autoload 'custom-save-customized "cus-edit" "\ +(autoload 'customize-save-customized "cus-edit" "\ Save all user options which have been set in this session." t nil) (autoload 'custom-save-all "cus-edit" "\
--- a/lisp/custom/cus-edit.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/custom/cus-edit.el Mon Aug 13 09:44:42 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.9931 +;; Version: 1.9937 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs. @@ -30,6 +30,10 @@ ;; ;; See `custom.el'. +;; No commands should have names starting with `custom-' because +;; that interferes with completion. Use `customize-' for commands +;; that the user will run with M-x, and `Custom-' for interactive commands. + ;;; Code: (require 'cus-face) @@ -251,13 +255,18 @@ :group 'customize :group 'faces) +(defgroup custom-browse nil + "Control customize browser." + :prefix "custom-" + :group 'customize) + (defgroup custom-buffer nil - "Control the customize buffers." + "Control customize buffers." :prefix "custom-" :group 'customize) (defgroup custom-menu nil - "Control how the customize menus." + "Control customize menus." :prefix "custom-" :group 'customize) @@ -545,62 +554,81 @@ ;;; Sorting. +(defcustom custom-browse-sort-alphabetically nil + "If non-nil, sort members of each customization group alphabetically." + :type 'boolean + :group 'custom-browse) + +(defcustom custom-browse-order-groups nil + "If non-nil, order group members within each customization group. +If `first', order groups before non-groups. +If `last', order groups after non-groups." + :type '(choice (const first) + (const last) + (const :tag "none" nil)) + :group 'custom-browse) + (defcustom custom-buffer-sort-alphabetically nil - "If non-nil, sort the members of each customization group alphabetically." + "If non-nil, sort members of each customization group alphabetically." :type 'boolean :group 'custom-buffer) -(defcustom custom-buffer-groups-last nil - "If non-nil, put subgroups after all ordinary options within a group." - :type 'boolean +(defcustom custom-buffer-order-groups 'last + "If non-nil, order group members within each customization group. +If `first', order groups before non-groups. +If `last', order groups after non-groups." + :type '(choice (const first) + (const last) + (const :tag "none" nil)) :group 'custom-buffer) (defcustom custom-menu-sort-alphabetically nil - "If non-nil, sort the members of each customization group alphabetically." - :type 'boolean - :group 'custom-menu) - -(defcustom custom-menu-groups-first t - "If non-nil, put subgroups before all ordinary options within a group." + "If non-nil, sort members of each customization group alphabetically." :type 'boolean :group 'custom-menu) -(defun custom-buffer-sort-predicate (a b) - "Return t iff A should come before B in a customization buffer. -A and B should be members of a `custom-group' property." - (cond ((and (not custom-buffer-groups-last) - (not custom-buffer-sort-alphabetically)) - nil) - ((or (eq (eq (nth 1 a) 'custom-group) (eq (nth 1 b) 'custom-group)) - (not custom-buffer-groups-last)) - (if custom-buffer-sort-alphabetically - (string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b))) - nil)) - (t - (not (eq (nth 1 a) 'custom-group) )))) +(defcustom custom-menu-order-groups 'first + "If non-nil, order group members within each customization group. +If `first', order groups before non-groups. +If `last', order groups after non-groups." + :type '(choice (const first) + (const last) + (const :tag "none" nil)) + :group 'custom-menu) -(defalias 'custom-browse-sort-predicate 'ignore) - -(defun custom-menu-sort-predicate (a b) - "Return t iff A should come before B in a customization menu. -A and B should be members of a `custom-group' property." - (cond ((and (not custom-menu-groups-first) - (not custom-menu-sort-alphabetically)) - nil) - ((or (eq (eq (nth 1 a) 'custom-group) (eq (nth 1 b) 'custom-group)) - (not custom-menu-groups-first)) - (if custom-menu-sort-alphabetically - (string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b))) - nil)) - (t - (eq (nth 1 a) 'custom-group) ))) +(defun custom-sort-items (items sort-alphabetically order-groups) + "Return a sorted copy of ITEMS. +ITEMS should be a `custom-group' property. +If SORT-ALPHABETICALLY non-nil, sort alphabetically. +If ORDER-GROUPS is `first' order groups before non-groups, if `last' order +groups after non-groups, if nil do not order groups at all." + (sort (copy-sequence items) + (lambda (a b) + (let ((typea (nth 1 a)) (typeb (nth 1 b)) + (namea (symbol-name (nth 0 a))) (nameb (symbol-name (nth 0 b)))) + (cond ((not order-groups) + ;; Since we don't care about A and B order, maybe sort. + (when sort-alphabetically + (string-lessp namea nameb))) + ((eq typea 'custom-group) + ;; If B is also a group, maybe sort. Otherwise, order A and B. + (if (eq typeb 'custom-group) + (when sort-alphabetically + (string-lessp namea nameb)) + (eq order-groups 'first))) + ((eq typeb 'custom-group) + ;; Since A cannot be a group, order A and B. + (eq order-groups 'last)) + (sort-alphabetically + ;; Since A and B cannot be groups, sort. + (string-lessp namea nameb))))))) ;;; Custom Mode Commands. (defvar custom-options nil "Customization widgets in the current buffer.") -(defun custom-set () +(defun Custom-set () "Set changes in all modified options." (interactive) (let ((children custom-options)) @@ -609,7 +637,7 @@ (widget-apply child :custom-set))) children))) -(defun custom-save () +(defun Custom-save () "Set all modified group members and save them." (interactive) (let ((children custom-options)) @@ -620,9 +648,9 @@ (custom-save-all)) (defvar custom-reset-menu - '(("Current" . custom-reset-current) - ("Saved" . custom-reset-saved) - ("Standard Settings" . custom-reset-standard)) + '(("Current" . Custom-reset-current) + ("Saved" . Custom-reset-saved) + ("Standard Settings" . Custom-reset-standard)) "Alist of actions for the `Reset' button. The key is a string containing the name of the action, the value is a lisp function taking the widget as an element which will be called @@ -637,7 +665,7 @@ (if answer (funcall answer)))) -(defun custom-reset-current (&rest ignore) +(defun Custom-reset-current (&rest ignore) "Reset all modified group members to their current value." (interactive) (let ((children custom-options)) @@ -646,7 +674,7 @@ (widget-apply child :custom-reset-current))) children))) -(defun custom-reset-saved (&rest ignore) +(defun Custom-reset-saved (&rest ignore) "Reset all modified or set group members to their saved value." (interactive) (let ((children custom-options)) @@ -655,7 +683,7 @@ (widget-apply child :custom-reset-saved))) children))) -(defun custom-reset-standard (&rest ignore) +(defun Custom-reset-standard (&rest ignore) "Reset all modified, set, or saved group members to their standard settings." (interactive) (let ((children custom-options)) @@ -701,7 +729,7 @@ (eval-minibuffer prompt))))))) ;;;###autoload -(defun custom-set-value (var val) +(defun customize-set-value (var val) "Set VARIABLE to VALUE. VALUE is a Lisp object. If VARIABLE has a `variable-interactive' property, that is used as if @@ -715,7 +743,7 @@ (set var val)) ;;;###autoload -(defun custom-set-variable (var val) +(defun customize-set-variable (var val) "Set the default for VARIABLE to VALUE. VALUE is a Lisp object. If VARIABLE has a `custom-set' property, that is used for setting @@ -811,17 +839,14 @@ (interactive (list (completing-read "Customize face: (default all) " obarray 'custom-facep))) (if (or (null symbol) (and (stringp symbol) (zerop (length symbol)))) - (let ((found nil)) - (message "Looking for faces...") - (mapcar (lambda (symbol) - (push (list symbol 'custom-face) found)) - (nreverse (mapcar 'intern - (sort (mapcar 'symbol-name (face-list)) - 'string-lessp)))) - - (custom-buffer-create found "*Customize Faces*")) - (if (stringp symbol) - (setq symbol (intern symbol))) + (custom-buffer-create (custom-sort-items + (mapcar (lambda (symbol) + (list symbol 'custom-face)) + (face-list)) + t nil) + "*Customize Faces*") + (when (stringp symbol) + (setq symbol (intern symbol))) (unless (symbolp symbol) (error "Should be a symbol %S" symbol)) (custom-buffer-create (list (list symbol 'custom-face)) @@ -855,9 +880,10 @@ (and (get symbol 'customized-value) (boundp symbol) (push (list symbol 'custom-variable) found)))) - (if found - (custom-buffer-create found "*Customize Customized*") - (error "No customized user options")))) + (if (not found) + (error "No customized user options") + (custom-buffer-create (custom-sort-items found t nil) + "*Customize Customized*")))) ;;;###autoload (defun customize-saved () @@ -871,9 +897,10 @@ (and (get symbol 'saved-value) (boundp symbol) (push (list symbol 'custom-variable) found)))) - (if found - (custom-buffer-create found "*Customize Saved*") - (error "No saved user options")))) + (if (not found ) + (error "No saved user options") + (custom-buffer-create (custom-sort-items found t nil) + "*Customize Saved*")))) ;;;###autoload (defun customize-apropos (regexp &optional all) @@ -903,9 +930,9 @@ (push (list symbol 'custom-variable) found))))) (if (not found) (error "No matches") - (let ((custom-buffer-sort-alphabetically t)) - (custom-buffer-create (sort found 'custom-buffer-sort-predicate) - "*Customize Apropos*"))))) + (custom-buffer-create (custom-sort-items found t + custom-buffer-order-groups) + "*Customize Apropos*")))) ;;;###autoload (defun customize-apropos-options (regexp &optional arg) @@ -979,25 +1006,28 @@ (message "Creating customization buffer...") (custom-mode) (widget-insert "This is a customization buffer. -Push RET or click mouse-2 on the word ") +Square brackets show active fields; type RET or click mouse-2 +on an active field to invoke its action. Invoke ") (widget-create 'info-link - :tag "help" + :tag "Help" :help-echo "Read the online help." "(emacs)Easy Customization") (widget-insert " for more information.\n\n") (message "Creating customization buttons...") + (widget-insert "Operate on everything in this buffer:\n ") (widget-create 'push-button :tag "Set" - :help-echo "Set all modifications for this session." + :help-echo "\ +Make your editing in this buffer take effect for this session." :action (lambda (widget &optional event) - (custom-set))) + (Custom-set))) (widget-insert " ") (widget-create 'push-button :tag "Save" :help-echo "\ -Make the modifications default for future sessions." +Make your editing in this buffer take effect for future Emacs sessions." :action (lambda (widget &optional event) - (custom-save))) + (Custom-save))) (widget-insert " ") (if custom-reset-button-menu (widget-create 'push-button @@ -1009,23 +1039,23 @@ (widget-create 'push-button :tag "Reset" :help-echo "\ -Reset all visible items in this buffer to their current settings." - :action 'custom-reset-current) +Reset all edited text in this buffer to reflect current values." + :action 'Custom-reset-current) (widget-insert " ") (widget-create 'push-button :tag "Reset to Saved" :help-echo "\ -Reset all visible items in this buffer to their saved settings." - :action 'custom-reset-saved) +Reset all values in this buffer to their saved settings." + :action 'Custom-reset-saved) (widget-insert " ") (widget-create 'push-button :tag "Reset to Standard" :help-echo "\ -Reset all visible items in this buffer to their standard settings." - :action 'custom-reset-standard)) - (widget-insert " ") +Reset all values in this buffer to their standard settings." + :action 'Custom-reset-standard)) + (widget-insert " ") (widget-create 'push-button - :tag "Done" + :tag "Bury Buffer" :help-echo "Bury the buffer." :action (lambda (widget &optional event) (bury-buffer))) @@ -1068,23 +1098,33 @@ ;;; The Tree Browser. ;;;###autoload -(defun customize-browse () +(defun customize-browse (group) "Create a tree browser for the customize hierarchy." - (interactive) + (interactive (list (let ((completion-ignore-case t)) + (completing-read "Customize group: (default emacs) " + obarray + (lambda (symbol) + (get symbol 'custom-group)) + t)))) + + (when (stringp group) + (if (string-equal "" group) + (setq group 'emacs) + (setq group (intern group)))) (let ((name "*Customize Browser*")) (kill-buffer (get-buffer-create name)) (switch-to-buffer (get-buffer-create name))) (custom-mode) (widget-insert "\ Invoke [+] below to expand items, and [-] to collapse items. -Invoke the [group], [face], and [option] buttons below to edit that +Invoke the [Group], [Face], and [Option] buttons below to edit that item in another window.\n\n") (let ((custom-buffer-style 'tree)) (widget-create 'custom-group :custom-last t :custom-state 'unknown - :tag (custom-unlispify-tag-name 'emacs) - :value 'emacs)) + :tag (custom-unlispify-tag-name group) + :value group)) (goto-char (point-min))) (define-widget 'custom-tree-visibility 'item @@ -1098,7 +1138,7 @@ (define-widget 'custom-tree-group-tag 'push-button "Show parent in other window when activated." - :tag "group" + :tag "Group" :tag-glyph "folder" :action 'custom-tree-group-tag-action) @@ -1108,7 +1148,7 @@ (define-widget 'custom-tree-variable-tag 'push-button "Show parent in other window when activated." - :tag "option" + :tag "Option" :tag-glyph "option" :action 'custom-tree-variable-tag-action) @@ -1118,7 +1158,7 @@ (define-widget 'custom-tree-face-tag 'push-button "Show parent in other window when activated." - :tag "face" + :tag "Face" :tag-glyph "face" :action 'custom-tree-face-tag-action) @@ -1128,18 +1168,23 @@ (defconst custom-tree-alist '((" " "space") (" | " "vertical") + ("-\\ " "top") (" |-" "middle") (" `-" "bottom"))) -(defun custom-tree-insert (prefix) +(defun custom-tree-insert-prefix (prefix) "Insert PREFIX. On XEmacs convert it to line graphics." - (if nil ;(string-match "XEmacs" emacs-version) - (while (not (string-equal prefix "")) - (let ((entry (substring prefix 0 3))) - (setq prefix (substring prefix 3)) - (widget-specify-insert - (widget-glyph-insert nil entry - (nth 1 (assoc entry custom-tree-alist)))))) + (if nil ; (string-match "XEmacs" emacs-version) + (progn + (insert "*") + (while (not (string-equal prefix "")) + (let ((entry (substring prefix 0 3))) + (setq prefix (substring prefix 3)) + (let ((overlay (make-overlay (1- (point)) (point) nil t nil)) + (name (nth 1 (assoc entry custom-tree-alist)))) + (overlay-put overlay 'end-glyph (widget-glyph-find name entry)) + (overlay-put overlay 'start-open t) + (overlay-put overlay 'end-open t))))) (insert prefix))) ;;; Modification of Basic Widgets. @@ -1283,22 +1328,22 @@ (defcustom custom-magic-show 'long "If non-nil, show textual description of the state. -If non-nil and not the symbol `long', only show first word." +If `long', show a full-line description, not just one word." :type '(choice (const :tag "no" nil) (const short) (const long)) :group 'custom-buffer) (defcustom custom-magic-show-hidden '(option face) - "Control whether the state button is shown for hidden items. -The value should be a list with the custom categories where the state + "Control whether the State button is shown for hidden items. +The value should be a list with the custom categories where the State button should be visible. Possible categories are `group', `option', and `face'." :type '(set (const group) (const option) (const face)) :group 'custom-buffer) (defcustom custom-magic-show-button nil - "Show a magic button indicating the state of each customization option." + "Show a \"magic\" button indicating the state of each customization option." :type 'boolean :group 'custom-buffer) @@ -1339,7 +1384,9 @@ (or (not hidden) (memq category custom-magic-show-hidden))) (insert " ") - (when (eq category 'group) + (when (and (eq category 'group) + (not (and (eq custom-buffer-style 'links) + (> (widget-get parent :custom-level) 1)))) (insert-char ?\ (* custom-buffer-indent (widget-get parent :custom-level)))) (push (widget-create-child-and-convert @@ -1352,13 +1399,17 @@ :tag "State") children) (insert ": ") - (if (eq custom-magic-show 'long) - (insert text) - (insert (symbol-name state))) - (when lisp - (insert " (lisp)")) + (let ((start (point))) + (if (eq custom-magic-show 'long) + (insert text) + (insert (symbol-name state))) + (when lisp + (insert " (lisp)")) + (put-text-property start (point) 'face 'custom-state-face)) (insert "\n")) - (when (eq category 'group) + (when (and (eq category 'group) + (not (and (eq custom-buffer-style 'links) + (> (widget-get parent :custom-level) 1)))) (insert-char ?\ (* custom-buffer-indent (widget-get parent :custom-level)))) (when custom-magic-show-button @@ -1388,6 +1439,24 @@ ;;; The `custom' Widget. +(defface custom-button-face nil + "Face used for buttons in customization buffers." + :group 'custom-faces) + +(defface custom-documentation-face nil + "Face used for documentation strings in customization buffers." + :group 'custom-faces) + +(defface custom-state-face '((((class color) + (background dark)) + (:foreground "lime green")) + (((class color) + (background light)) + (:foreground "dark green")) + (t nil)) + "Face used for State descriptions in the customize buffer." + :group 'custom-faces) + (define-widget 'custom 'default "Customize a user option." :format "%v" @@ -1401,6 +1470,7 @@ :value-delete 'widget-children-value-delete :value-get 'widget-value-value-get :validate 'widget-children-validate + :button-face 'custom-button-face :match (lambda (widget value) (symbolp value))) (defun custom-convert-widget (widget) @@ -1509,7 +1579,7 @@ (widget-setup))) (defun custom-toggle-parent (widget &rest ignore) - "Toggle visibility of parent to WIDGET." + "Toggle visibility of parent of WIDGET." (custom-toggle-hide (widget-get widget :parent))) (defun custom-add-see-also (widget &optional prefix) @@ -1540,32 +1610,41 @@ (insert ", ")))) (widget-put widget :buttons buttons)))) -(defun custom-add-parent-links (widget) - "Add `Parent groups: ...' to WIDGET." +(defun custom-add-parent-links (widget &optional initial-string) + "Add \"Parent groups: ...\" to WIDGET if the group has parents. +The value if non-nil if any parents were found. +If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (let ((name (widget-value widget)) (type (widget-type widget)) (buttons (widget-get widget :buttons)) + (start (point)) found) - (insert "Parent groups:") + (insert (or initial-string "Parent groups:")) (mapatoms (lambda (symbol) - (let ((group (get symbol 'custom-group))) - (when (assq name group) - (when (eq type (nth 1 (assq name group))) - (insert " ") - (push (widget-create-child-and-convert - widget 'custom-group-link - :tag (custom-unlispify-tag-name symbol) - symbol) - buttons) - (setq found t)))))) + (let ((entry (assq name (get symbol 'custom-group)))) + (when (eq (nth 1 entry) type) + (insert " ") + (push (widget-create-child-and-convert + widget 'custom-group-link + :tag (custom-unlispify-tag-name symbol) + symbol) + buttons) + (setq found t))))) (widget-put widget :buttons buttons) - (unless found - (insert " (none)")) - (insert "\n"))) + (if found + (insert "\n") + (delete-region start (point))) + found)) ;;; The `custom-variable' Widget. -(defface custom-variable-sample-face '((t (:underline t))) +(defface custom-variable-tag-face '((((class color) + (background dark)) + (:foreground "light blue" :underline t)) + (((class color) + (background light)) + (:foreground "blue" :underline t)) + (t (:underline t))) "Face used for unpushable variable tags." :group 'custom-faces) @@ -1647,7 +1726,7 @@ (push (widget-create-child-and-convert widget 'item :format "%{%t%}: " - :sample-face 'custom-variable-sample-face + :sample-face 'custom-variable-tag-face :tag tag :parent widget) buttons) @@ -1698,7 +1777,7 @@ :help-echo "Change value of this option." :mouse-down-action 'custom-tag-mouse-down-action :button-face 'custom-variable-button-face - :sample-face 'custom-variable-sample-face + :sample-face 'custom-variable-tag-face tag) buttons) (insert " ") @@ -2348,7 +2427,7 @@ (define-widget 'custom-group-link 'link "Show parent in other window when activated." - :help-echo "Create customize buffer for this group group." + :help-echo "Create customization buffer for this group." :action 'custom-group-link-action) (defun custom-group-link-action (widget &rest ignore) @@ -2356,7 +2435,7 @@ ;;; The `custom-group' Widget. -(defcustom custom-group-tag-faces '(custom-group-tag-face-1) +(defcustom custom-group-tag-faces nil ;; In XEmacs, this ought to play games with font size. "Face used for group tags. The first member is used for level 1 groups, the second for level 2, @@ -2405,6 +2484,16 @@ (or (nth (1- (widget-get widget :custom-level)) custom-group-tag-faces) 'custom-group-tag-face)) +(define-widget 'custom-group-visibility 'visibility + "An indicator and manipulator for hidden group contents." + :create 'custom-group-visibility-create) + +(defun custom-group-visibility-create (widget) + (let ((visible (widget-value widget))) + (if visible + (insert "--------"))) + (widget-default-create widget)) + (defun custom-group-value-create (widget) "Insert a customize group for WIDGET in the current buffer." (let ((state (widget-get widget :custom-state)) @@ -2416,7 +2505,7 @@ (symbol (widget-value widget))) (cond ((and (eq custom-buffer-style 'tree) (eq state 'hidden)) - (custom-tree-insert prefix) + (custom-tree-insert-prefix prefix) (push (widget-create-child-and-convert widget 'custom-tree-visibility ;; :tag-glyph "plus" @@ -2431,7 +2520,7 @@ (widget-put widget :buttons buttons)) ((and (eq custom-buffer-style 'tree) (zerop (length (get symbol 'custom-group)))) - (custom-tree-insert prefix) + (custom-tree-insert-prefix prefix) (insert "[ ]-- ") ;; (widget-glyph-insert nil "[ ]" "empty") ;; (widget-glyph-insert nil "-- " "horizontal") @@ -2441,11 +2530,11 @@ (insert " " tag "\n") (widget-put widget :buttons buttons)) ((eq custom-buffer-style 'tree) - (custom-tree-insert prefix) + (custom-tree-insert-prefix prefix) (custom-load-widget widget) (if (zerop (length (get symbol 'custom-group))) (progn - (custom-tree-insert prefix) + (custom-tree-insert-prefix prefix) (insert "[ ]-- ") ;; (widget-glyph-insert nil "[ ]" "empty") ;; (widget-glyph-insert nil "-- " "horizontal") @@ -2459,16 +2548,17 @@ ;; :tag-glyph "minus" :tag "-") buttons) - (insert "-+ ") - ;; (widget-glyph-insert nil "-+ " "top") + (insert "-\\ ") + ;; (widget-glyph-insert nil "-\\ " "top") (push (widget-create-child-and-convert widget 'custom-tree-group-tag) buttons) (insert " " tag "\n") (widget-put widget :buttons buttons) (message "Creating group...") - (let* ((members (sort (copy-sequence (get symbol 'custom-group)) - 'custom-browse-sort-predicate)) + (let* ((members (custom-sort-items (get symbol 'custom-group) + custom-browse-sort-alphabetically + custom-browse-order-groups)) (prefixes (widget-get widget :custom-prefixes)) (custom-prefix-list (custom-prefix-add symbol prefixes)) (length (length members)) @@ -2496,8 +2586,9 @@ ;; Nested style. ((eq state 'hidden) ;; Create level indicator. - (insert-char ?\ (* custom-buffer-indent (1- level))) - (insert "-- ") + (unless (eq custom-buffer-style 'links) + (insert-char ?\ (* custom-buffer-indent (1- level))) + (insert "-- ")) ;; Create tag. (let ((begin (point))) (insert tag) @@ -2507,11 +2598,11 @@ (if (eq custom-buffer-style 'links) (push (widget-create-child-and-convert widget 'custom-group-link - :tag "Show" + :tag "Go to Group" symbol) buttons) (push (widget-create-child-and-convert - widget 'visibility + widget 'group-visibility :help-echo "Show members of this group." :action 'custom-toggle-parent (not (eq state 'hidden))) @@ -2525,9 +2616,18 @@ ;; Update buttons. (widget-put widget :buttons buttons) ;; Insert documentation. + (if (and (eq custom-buffer-style 'links) (> level 1)) + (widget-put widget :documentation-indent 0)) (widget-default-format-handler widget ?h)) ;; Nested style. (t ;Visible. + ;; Add parent groups references above the group. + (if t ;;; This should test that the buffer + ;;; was made to display a group. + (when (eq level 1) + (if (custom-add-parent-links widget + "Go to parent group:") + (insert "\n")))) ;; Create level indicator. (insert-char ?\ (* custom-buffer-indent (1- level))) (insert "/- ") @@ -2563,18 +2663,21 @@ (widget-put widget :buttons buttons) ;; Insert documentation. (widget-default-format-handler widget ?h) - ;; Parents and See also. - (when (eq level 1) - (insert-char ?\ custom-buffer-indent) - (custom-add-parent-links widget)) + ;; Parent groups. + (if nil ;;; This should test that the buffer + ;;; was not made to display a group. + (when (eq level 1) + (insert-char ?\ custom-buffer-indent) + (custom-add-parent-links widget))) (custom-add-see-also widget (make-string (* custom-buffer-indent level) ?\ )) ;; Members. (message "Creating group...") (custom-load-widget widget) - (let* ((members (sort (copy-sequence (get symbol 'custom-group)) - 'custom-buffer-sort-predicate)) + (let* ((members (custom-sort-items (get symbol 'custom-group) + custom-buffer-sort-alphabetically + custom-buffer-order-groups)) (prefixes (widget-get widget :custom-prefixes)) (custom-prefix-list (custom-prefix-add symbol prefixes)) (length (length members)) @@ -2807,7 +2910,7 @@ (princ "\n"))))) ;;;###autoload -(defun custom-save-customized () +(defun customize-save-customized () "Save all user options which have been set in this session." (interactive) (mapatoms (lambda (symbol) @@ -2838,7 +2941,8 @@ (unless (string-match "XEmacs" emacs-version) (defconst custom-help-menu '("Customize" - ["Update menu..." custom-menu-update t] + ["Update menu..." Custom-menu-update t] + ["Browse..." (customize-browse 'emacs) t] ["Group..." customize-group t] ["Variable..." customize-variable t] ["Face..." customize-face t] @@ -2860,7 +2964,7 @@ (easy-menu-create-keymaps (car custom-help-menu) (cdr custom-help-menu))))) - (defun custom-menu-update (event) + (defun Custom-menu-update (event) "Update customize menu." (interactive "e") (add-hook 'custom-define-hook 'custom-menu-reset) @@ -2928,8 +3032,9 @@ (< (length (get symbol 'custom-group)) widget-menu-max-size)) (let ((custom-prefix-list (custom-prefix-add symbol custom-prefix-list)) - (members (sort (copy-sequence (get symbol 'custom-group)) - 'custom-menu-sort-predicate))) + (members (custom-sort-items (get symbol 'custom-group) + custom-menu-sort-alphabetically + custom-menu-order-groups))) (custom-load-symbol symbol) `(,(custom-unlispify-menu-entry symbol t) ,item @@ -2962,30 +3067,48 @@ (defvar custom-mode-map nil "Keymap for `custom-mode'.") - + (unless custom-mode-map (setq custom-mode-map (make-sparse-keymap)) (set-keymap-parent custom-mode-map widget-keymap) (suppress-keymap custom-mode-map) - (define-key custom-mode-map "q" 'bury-buffer)) + (define-key custom-mode-map " " 'scroll-up) + (define-key custom-mode-map "\177" 'scroll-down) + (define-key custom-mode-map "q" 'bury-buffer) + (define-key custom-mode-map "u" 'Custom-goto-parent)) -(easy-menu-define custom-mode-menu +(easy-menu-define Custom-mode-menu custom-mode-map "Menu used in customization buffers." `("Custom" ,(customize-menu-create 'customize) - ["Set" custom-set t] - ["Save" custom-save t] - ["Reset to Current" custom-reset-current t] - ["Reset to Saved" custom-reset-saved t] - ["Reset to Standard Settings" custom-reset-standard t] + ["Set" Custom-set t] + ["Save" Custom-save t] + ["Reset to Current" Custom-reset-current t] + ["Reset to Saved" Custom-reset-saved t] + ["Reset to Standard Settings" Custom-reset-standard t] ["Info" (Info-goto-node "(custom)The Customization Buffer") t])) +(defun Custom-goto-parent () + "Go to the parent group listed at the top of this buffer. +If several parents are listed, go to the first of them." + (interactive) + (save-excursion + (goto-char (point-min)) + (if (search-forward "\nGo to parent group: " nil t) + (let* ((button (get-char-property (point) 'button)) + (parent (downcase (widget-get button :tag)))) + (customize-group parent))))) + (defcustom custom-mode-hook nil "Hook called when entering custom-mode." :type 'hook :group 'custom-buffer ) +(defun custom-state-buffer-message (widget) + (if (eq (widget-get (widget-get widget :parent) :custom-state) 'modified) + (message "To install your edits, invoke [State] and choose the Set operation"))) + (defun custom-mode () "Major mode for editing customization buffers. @@ -2995,11 +3118,11 @@ Move to previous button or editable field. \\[widget-backward] Invoke button under the mouse pointer. \\[widget-button-click] Invoke button under point. \\[widget-button-press] -Set all modifications. \\[custom-set] -Make all modifications default. \\[custom-save] -Reset all modified options. \\[custom-reset-current] -Reset all modified or set options. \\[custom-reset-saved] -Reset all options. \\[custom-reset-standard] +Set all modifications. \\[Custom-set] +Make all modifications default. \\[Custom-save] +Reset all modified options. \\[Custom-reset-current] +Reset all modified or set options. \\[Custom-reset-saved] +Reset all options. \\[Custom-reset-standard] Entry to this mode calls the value of `custom-mode-hook' if that value is non-nil." @@ -3007,8 +3130,12 @@ (setq major-mode 'custom-mode mode-name "Custom") (use-local-map custom-mode-map) - (easy-menu-add custom-mode-menu) + (easy-menu-add Custom-mode-menu) (make-local-variable 'custom-options) + (make-local-variable 'widget-documentation-face) + (setq widget-documentation-face 'custom-documentation-face) + (make-local-hook 'widget-edit-functions) + (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t) (run-hooks 'custom-mode-hook)) ;;; The End.
--- a/lisp/custom/cus-face.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/custom/cus-face.el Mon Aug 13 09:44:42 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.9931 +;; Version: 1.9937 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary:
--- a/lisp/custom/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/custom/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -41,6 +41,7 @@ (put 'backup 'custom-loads '()) (put 'frames 'custom-loads '()) (put 'customize 'custom-loads '("cus-edit" "wid-edit" "cus-face")) +(put 'custom-browse 'custom-loads '("cus-edit")) (put 'abbrev 'custom-loads '("cus-edit")) (put 'programming 'custom-loads '("cus-edit")) (put 'toolbar 'custom-loads '()) @@ -72,7 +73,6 @@ (put 'emacs 'custom-loads '("cus-edit")) (put 'processes 'custom-loads '("cus-edit")) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'wp 'custom-loads '("cus-edit")) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '())
--- a/lisp/custom/custom.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/custom/custom.el Mon Aug 13 09:44:42 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.9931 +;; Version: 1.9937 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs. @@ -44,8 +44,8 @@ ;; These autoloads should be deleted eventually. (unless (fboundp 'load-gc) ;; From cus-edit.el - (autoload 'custom-set-value "cus-edit" nil t) - (autoload 'custom-set-variable "cus-edit" nil t) + (autoload 'customize-set-value "cus-edit" nil t) + (autoload 'customize-set-variable "cus-edit" nil t) (autoload 'customize "cus-edit" nil t) (autoload 'customize-browse "cus-edit" nil t) (autoload 'customize-group "cus-edit" nil t)
--- a/lisp/custom/wid-browse.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/custom/wid-browse.el Mon Aug 13 09:44:42 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.9931 +;; Version: 1.9937 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs.
--- a/lisp/custom/wid-edit.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/custom/wid-edit.el Mon Aug 13 09:44:42 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.9931 +;; Version: 1.9937 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs. @@ -134,6 +134,10 @@ :group 'widgets :group 'faces) +(defvar widget-documentation-face 'widget-documentation-face + "Face used for documentation strings in widges. +This exists as a variable so it can be set locally in certain buffers.") + (defface widget-documentation-face '((((class color) (background dark)) (:foreground "lime green")) @@ -202,6 +206,13 @@ :group 'widgets :type 'integer) +(defcustom widget-menu-minibuffer-flag nil + "*Control how to ask for a choice from the keyboard. +Non-nil means use the minibuffer; +nil means read a single character." + :group 'widgets + :type 'boolean) + (defun widget-choose (title items &optional event) "Choose an item from a list. @@ -238,7 +249,8 @@ (stringp (car-safe (event-object val))) (car (event-object val)))) (cdr (assoc val items)))) - (t + (widget-menu-minibuffer-flag + ;; Read the choice of name from the minibuffer. (setq items (widget-remove-if 'stringp items)) (let ((val (completing-read (concat title ": ") items nil t))) (if (stringp val) @@ -246,7 +258,45 @@ (when (stringp try) (setq val try)) (cdr (assoc val items))) - nil))))) + nil))) + (t + ;; Construct a menu of the choices + ;; and then use it for prompting for a single character. + (let* ((overriding-terminal-local-map + (make-sparse-keymap)) + map choice (next-digit ?0) + value) + ;; Define SPC as a prefix char to get to this menu. + (define-key overriding-terminal-local-map " " + (setq map (make-sparse-keymap title))) + (while items + (setq choice (car items) items (cdr items)) + (if (consp choice) + (let* ((name (car choice)) + (function (cdr choice)) + (character (aref name 0))) + ;; Pick a character for this choice; + ;; avoid duplication. + (when (lookup-key map (vector character)) + (setq character (downcase character)) + (when (lookup-key map (vector character)) + (setq character next-digit + next-digit (1+ next-digit)))) + (define-key map (vector character) + (cons (format "%c = %s" character name) function))))) + (define-key map [?\C-g] '("Quit" . keyboard-quit)) + (define-key map [t] 'keyboard-quit) + (setcdr map (nreverse (cdr map))) + ;; Unread a SPC to lead to our new menu. + (setq unread-command-events (cons ?\ unread-command-events)) + ;; Read a char with the menu, and return the result + ;; that corresponds to it. + (setq value + (lookup-key overriding-terminal-local-map + (read-key-sequence title) t)) + (when (eq value 'keyboard-quit) + (error "Canceled")) + value)))) (defun widget-remove-if (predictate list) (let (result (tail list)) @@ -285,6 +335,17 @@ :type 'boolean :group 'widgets) +(defcustom widget-field-use-before-change + (or (> emacs-minor-version 34) + (> emacs-major-version 20) + (string-match "XEmacs" emacs-version)) + "Non-nil means use `before-change-functions' to track editable fields. +This enables the use of undo, but doesn'f work on Emacs 19.34 and earlier. +Using before hooks also means that the :notify function can't know the +new value." + :type 'boolean + :group 'widgets) + (defun widget-specify-field (widget from to) "Specify editable button for WIDGET between FROM and TO." (put-text-property from to 'read-only nil) @@ -354,7 +415,7 @@ (defun widget-specify-doc (widget from to) ;; Specify documentation for WIDGET between FROM and TO. (add-text-properties from to (list 'widget-doc widget - 'face 'widget-documentation-face))) + 'face widget-documentation-face))) (defmacro widget-specify-insert (&rest form) ;; Execute FORM without inheriting any text properties. @@ -931,24 +992,25 @@ (widget-apply-action button event))) (overlay-put overlay 'face face) (overlay-put overlay 'mouse-face mouse-face))) - (let (command up) + (let ((up t) + command) ;; Find the global command to run, and check whether it ;; is bound to an up event. (cond ((setq command ;down event - (lookup-key widget-global-map [ button2 ]))) + (lookup-key widget-global-map [ button2 ])) + (setq up nil)) ((setq command ;down event - (lookup-key widget-global-map [ down-mouse-2 ]))) - ((setq command ;up event - (lookup-key widget-global-map [ button2up ])) - (setq up t)) + (lookup-key widget-global-map [ down-mouse-2 ])) + (setq up nil)) ((setq command ;up event - (lookup-key widget-global-map [ mouse-2])) - (setq up t))) - (when command + (lookup-key widget-global-map [ button2up ]))) + ((setq command ;up event + (lookup-key widget-global-map [ mouse-2])))) + (when up ;; Don't execute up events twice. - (when up - (while (not (button-release-event-p event)) - (setq event (widget-read-event)))) + (while (not (button-release-event-p event)) + (setq event (widget-read-event)))) + (when command (call-interactively command)))))) (t (message "You clicked somewhere weird.")))) @@ -1140,11 +1202,12 @@ (widget-clear-undo) ;; We need to maintain text properties and size of the editing fields. (make-local-variable 'after-change-functions) - (make-local-variable 'before-change-functions) (setq after-change-functions (if widget-field-list '(widget-after-change) nil)) - (setq before-change-functions - (if widget-field-list '(widget-before-change) nil))) + (when widget-field-use-before-change + (make-local-variable 'before-change-functions) + (setq before-change-functions + (if widget-field-list '(widget-before-change) nil)))) (defvar widget-field-last nil) ;; Last field containing point. @@ -1437,9 +1500,17 @@ (error "Unknown escape `%c'" escape))) (widget-put widget :buttons buttons))) +(defvar widget-button-face nil + "Face to use for buttons. +This is a variable so that it can be buffer-local.") + (defun widget-default-button-face-get (widget) ;; Use :button-face or widget-button-face - (or (widget-get widget :button-face) 'widget-button-face)) + (or (widget-get widget :button-face) + (let ((parent (widget-get widget :parent))) + (if parent + (widget-apply parent :button-face-get) + 'widget-button-face)))) (defun widget-default-sample-face-get (widget) ;; Use :sample-face. @@ -1468,11 +1539,25 @@ (defun widget-default-value-set (widget value) ;; Recreate widget with new value. - (save-excursion - (goto-char (widget-get widget :from)) - (widget-apply widget :delete) - (widget-put widget :value value) - (widget-apply widget :create))) + (let* ((old-pos (point)) + (from (copy-marker (widget-get widget :from))) + (to (copy-marker (widget-get widget :to))) + (offset (if (and (<= from old-pos) (<= old-pos to)) + (if (>= old-pos (1- to)) + (- old-pos to 1) + (- old-pos from))))) + ;;??? Bug: this ought to insert the new value before deleting the old one, + ;; so that markers on either side of the value automatically + ;; stay on the same side. -- rms. + (save-excursion + (goto-char (widget-get widget :from)) + (widget-apply widget :delete) + (widget-put widget :value value) + (widget-apply widget :create)) + (if offset + (if (< offset 0) + (goto-char (+ (widget-get widget :to) offset 1)) + (goto-char (min (+ from offset) (1- (widget-get widget :to)))))))) (defun widget-default-value-inline (widget) ;; Wrap value in a list unless it is inline. @@ -1707,16 +1792,12 @@ :prompt-internal prompt initial history))) (widget-apply widget :value-to-external answer)))) +(defvar widget-edit-functions nil) + (defun widget-field-action (widget &optional event) - ;; Edit the value in the minibuffer. - (let ((invalid (widget-apply widget :validate))) - (let ((prompt (concat (widget-apply widget :menu-tag-get) ": ")) - (value (unless invalid - (widget-value widget)))) - (let ((answer (widget-apply widget :prompt-value prompt value invalid) )) - (widget-value-set widget answer))) - (widget-setup) - (widget-apply widget :notify widget event))) + ;; Move to next field. + (widget-forward 1) + (run-hook-with-args 'widget-edit-functions widget)) (defun widget-field-validate (widget) ;; Valid if the content matches `:valid-regexp'. @@ -1911,7 +1992,8 @@ (widget-apply current :value-to-external (widget-get current :value))) (widget-setup) - (widget-apply widget :notify widget event)))) + (widget-apply widget :notify widget event))) + (run-hooks 'widget-edit-hook)) (defun widget-choice-validate (widget) ;; Valid if we have made a valid choice. @@ -1966,7 +2048,8 @@ (defun widget-toggle-action (widget &optional event) ;; Toggle value. (widget-value-set widget (not (widget-value widget))) - (widget-apply widget :notify widget event)) + (widget-apply widget :notify widget event) + (run-hooks 'widget-edit-hook)) ;;; The `checkbox' Widget. @@ -2641,8 +2724,15 @@ (concat "Describe the `" (widget-get widget :value) "' symbol.")) (defun widget-documentation-link-action (widget &optional event) - "Run apropos on WIDGET's value. Ignore optional argument EVENT." - (apropos (concat "\\`" (regexp-quote (widget-get widget :value)) "\\'"))) + "Display documentation for WIDGET's value. Ignore optional argument EVENT." + (let* ((string (widget-get widget :value)) + (symbol (intern string))) + (if (and (fboundp symbol) (boundp symbol)) + ;; If there are two doc strings, give the user a way to pick one. + (apropos (concat "\\`" (regexp-quote string) "\\'")) + (if (fboundp symbol) + (describe-function symbol) + (describe-variable symbol))))) (defcustom widget-documentation-links t "Add hyperlinks to documentation strings when non-nil." @@ -2802,10 +2892,36 @@ (define-widget 'file 'string "A file widget. It will read a file name from the minibuffer when invoked." + :complete-function 'widget-file-complete :prompt-value 'widget-file-prompt-value :format "%{%t%}: %v" - :tag "File" - :action 'widget-file-action) + :tag "File") + +(defun widget-file-complete () + "Perform completion on file name preceding point." + (interactive) + (let* ((end (point)) + (beg (save-excursion + (skip-chars-backward "^ ") + (point))) + (pattern (buffer-substring beg end)) + (name-part (file-name-nondirectory pattern)) + (directory (file-name-directory pattern)) + (completion (file-name-completion name-part directory))) + (cond ((eq completion t)) + ((null completion) + (message "Can't find completion for \"%s\"" pattern) + (ding)) + ((not (string= name-part completion)) + (delete-region beg end) + (insert (expand-file-name completion directory))) + (t + (message "Making completion list...") + (let ((list (file-name-all-completions name-part directory))) + (setq list (sort list 'string<)) + (with-output-to-temp-buffer "*Completions*" + (display-completion-list list))) + (message "Making completion list...%s" "done"))))) (defun widget-file-prompt-value (widget prompt value unbound) ;; Read file from minibuffer. @@ -2818,18 +2934,18 @@ (must-match (widget-get widget :must-match))) (read-file-name prompt2 dir nil must-match file))))) -(defun widget-file-action (widget &optional event) - ;; Read a file name from the minibuffer. - (let* ((value (widget-value widget)) - (dir (file-name-directory value)) - (file (file-name-nondirectory value)) - (menu-tag (widget-apply widget :menu-tag-get)) - (must-match (widget-get widget :must-match)) - (answer (read-file-name (concat menu-tag ": (default `" value "') ") - dir nil must-match file))) - (widget-value-set widget (abbreviate-file-name answer)) - (widget-setup) - (widget-apply widget :notify widget event))) +;;;(defun widget-file-action (widget &optional event) +;;; ;; Read a file name from the minibuffer. +;;; (let* ((value (widget-value widget)) +;;; (dir (file-name-directory value)) +;;; (file (file-name-nondirectory value)) +;;; (menu-tag (widget-apply widget :menu-tag-get)) +;;; (must-match (widget-get widget :must-match)) +;;; (answer (read-file-name (concat menu-tag ": (default `" value "') ") +;;; dir nil must-match file))) +;;; (widget-value-set widget (abbreviate-file-name answer)) +;;; (widget-setup) +;;; (widget-apply widget :notify widget event))) (define-widget 'directory 'file "A directory widget. @@ -2845,6 +2961,7 @@ :tag "Symbol" :format "%{%t%}: %v" :match (lambda (widget value) (symbolp value)) + :complete-function 'lisp-complete-symbol :prompt-internal 'widget-symbol-prompt-internal :prompt-match 'symbolp :prompt-history 'widget-symbol-prompt-value-history @@ -2990,19 +3107,45 @@ (buffer-substring (point) (point-max)))) answer))))) -(define-widget 'integer 'sexp +(define-widget 'restricted-sexp 'sexp + "A Lisp expression restricted to values that match. +To use this type, you must define :match or :match-alternatives." + :type-error "The specified value is not valid" + :match 'widget-restricted-sexp-match + :value-to-internal (lambda (widget value) + (if (widget-apply widget :match value) + (prin1-to-string value) + value))) + +(defun widget-restricted-sexp-match (widget value) + (let ((alternatives (widget-get widget :match-alternatives)) + matched) + (while (and alternatives (not matched)) + (if (cond ((functionp (car alternatives)) + (funcall (car alternatives) value)) + ((and (consp (car alternatives)) + (eq (car (car alternatives)) 'quote)) + (eq value (nth 1 (car alternatives))))) + (setq matched t)) + (setq alternatives (cdr alternatives))) + matched)) + +(define-widget 'integer 'restricted-sexp "An integer." :tag "Integer" :value 0 :type-error "This field should contain an integer" - :value-to-internal (lambda (widget value) - (if (integerp value) - (prin1-to-string value) - value)) - :match (lambda (widget value) (integerp value))) + :match-alternatives '(integerp)) + +(define-widget 'number 'restricted-sexp + "A floating point number." + :tag "Number" + :value 0.0 + :type-error "This field should contain a number" + :match-alternatives '(numberp)) (define-widget 'character 'editable-field - "An character." + "A character." :tag "Character" :value 0 :size 1 @@ -3022,17 +3165,6 @@ (characterp value) (integerp value)))) -(define-widget 'number 'sexp - "A floating point number." - :tag "Number" - :value 0.0 - :type-error "This field should contain a number" - :value-to-internal (lambda (widget value) - (if (numberp value) - (prin1-to-string value) - value)) - :match (lambda (widget value) (numberp value))) - (define-widget 'list 'group "A lisp list." :tag "List"
--- a/lisp/custom/widget-example.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/custom/widget-example.el Mon Aug 13 09:44:42 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.9931 +;; Version: 1.9937 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ (require 'widget)
--- a/lisp/custom/widget.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/custom/widget.el Mon Aug 13 09:44:42 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.9931 +;; Version: 1.9937 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs. @@ -44,7 +44,7 @@ (set (car keywords) (car keywords))) (setq keywords (cdr keywords))))))) -(define-widget-keywords :documentation-indent +(define-widget-keywords :match-alternatives :documentation-indent :complete-function :complete :button-overlay :field-overlay :documentation-shown :button-prefix
--- a/lisp/edebug/auto-autoloads.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/edebug/auto-autoloads.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,6 +1,9 @@ ;;; DO NOT MODIFY THIS FILE (if (not (featurep 'edebug-autoloads)) (progn + +(provide 'edebug-autoloads) +)) ;;;### (autoloads (edebug-eval-top-level-form def-edebug-spec) "edebug" "edebug/edebug.el") @@ -18,6 +21,3 @@ or if an error occurs, leave point after it with mark at the original point." t nil) ;;;*** - -(provide 'edebug-autoloads) -))
--- a/lisp/edebug/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/edebug/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -53,7 +53,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/ediff/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/ediff/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -58,7 +58,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/efs/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/efs/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/electric/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/electric/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/emulators/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/emulators/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/eos/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/eos/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/eterm/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/eterm/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -54,7 +54,6 @@ (put 'browse-url 'custom-loads '()) (put 'processes 'custom-loads '("term")) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/games/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/games/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -54,7 +54,6 @@ (put 'xmine 'custom-loads '("xmine")) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/gnats/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/gnats/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/gnus/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/gnus/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -123,7 +123,6 @@ (put 'news 'custom-loads '("gnus" "message")) (put 'gnus-cache 'custom-loads '()) (put 'message-insertion 'custom-loads '("message")) -(put 'hyper-apropos 'custom-loads '()) (put 'message-faces 'custom-loads '("message")) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '())
--- a/lisp/hm--html-menus/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/hm--html-menus/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/hyperbole/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/hyperbole/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/ilisp/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/ilisp/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/iso/auto-autoloads.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/iso/auto-autoloads.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,6 +1,9 @@ ;;; DO NOT MODIFY THIS FILE (if (not (featurep 'iso-autoloads)) (progn + +(provide 'iso-autoloads) +)) ;;;### (autoloads (iso-accents-mode) "iso-acc" "iso/iso-acc.el") @@ -28,6 +31,3 @@ and a negative argument disables it." t nil) ;;;*** - -(provide 'iso-autoloads) -))
--- a/lisp/iso/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/iso/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/language/arabic-util.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,675 @@ +;;; arabic-util.el --- minor mode for editing Arabic. + +;; Copyright (C) 1994 Free Software Foundation, Inc. + +;; Keywords: multilingual, Arabic + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Synched up with: Mule 2.3. + +;;; Code: + +;;; 94.6.13 created for Mule Ver.1.1 by Takahashi N. <ntakahas@etl.go.jp> + +(require 'visual-mode) + +(defvar arabic-mode-indicator " [2](3=a:GJ[0](B" + "String displayed in mode-line. +\" Arabic\" for Arabic keyboard input, \" [2](3=a:GJ[0](B\".") + +(make-variable-buffer-local 'arabic-mode-indicator) + +;;;###autoload +(defvar arabic-mode nil + "Non-nil if in arabic-mode.") + +(make-variable-buffer-local 'arabic-mode) + +(if (not (assq 'arabic-mode minor-mode-alist)) + (setq minor-mode-alist + (cons '(arabic-mode arabic-mode-indicator) minor-mode-alist))) + +(define-key global-map [(meta \\)] 'arabic-mode) + +(defvar arabic-input-arabic-char t + "Non-nil if key input is Arabic. Nil if key input is ASCII.") + +(make-variable-buffer-local 'arabic-input-arabic-char) + +(defvar arabic-input-keymap 'arabic-keymap-0 + "Specify which input table is used for Arabic input. Should be on of: +arabic-keymap-0 (default), +arabic-keymap-1 (Farsi standard), or +arabic-keymap-2 (Microsoft Arabic).") + +(defvar arabic-translate-table + (cond + ((eq arabic-input-keymap 'arabic-keymap-0) + [?[2](3![0](B ?[2](3"[0](B ?[2](3-[0](B nil nil nil nil ?' ?[2](3#[0](B ?[2](3$[0](B nil nil ?[2](3%[0](B nil ?[2](3&[0](B ?[2](49[0](B + ?(2![0](B ?(2"[0](B ?(2#[0](B ?(2$[0](B ?(2%[0](B ?(2&[0](B ?(2'[0](B ?(2([0](B ?(2)[0](B ?(2*[0](B ?[2](3'[0](B ?[2](3([0](B ?[2](3*[0](B nil ?[2](3+[0](B ?[2](3)[0](B + nil ?[2](4][0](B nil ?[2](4g[0](B ?[2](4A[0](B nil nil ?[2](4O[0](B ?[2](4-[0](B nil nil ?[2](41[0](B nil nil nil nil + nil nil nil ?[2](4=[0](B ?[2](4E[0](B nil nil nil ?[2](3h[0](B nil ?[2](4I[0](B nil nil nil nil nil + ?[2](4M[0](B ?[2](38[0](B ?[2](4#[0](B ?[2](4'[0](B ?[2](3B[0](B nil ?[2](4Q[0](B ?[2](4k[0](B ?[2](3Z[0](B nil ?[2](4)[0](B ?[2](4U[0](B ?[2](4Y[0](B ?[2](3T[0](B ?[2](4[[0](B ?[2](3<[0](B + ?[2](4e[0](B ?[2](4S[0](B ?[2](3F[0](B ?[2](45[0](B ?[2](4%[0](B nil nil ?[2](3^[0](B ?[2](3D[0](B ?[2](4_[0](B ?[2](3H[0](B nil ?| nil nil]) + ((eq arabic-input-keymap 'arabic-keymap-1) + [?[2](3![0](B ?[2](3"[0](B nil nil nil nil nil nil ?[2](3#[0](B ?[2](3$[0](B nil nil ?[2](3%[0](B nil ?[2](3&[0](B nil + ?(2![0](B ?(2"[0](B ?(2#[0](B ?(2$[0](B ?(2%[0](B ?(2&[0](B ?(2'[0](B ?(2([0](B ?(2)[0](B ?(2*[0](B ?[2](3'[0](B ?[2](4U[0](B ?[2](3*[0](B nil ?[2](3+[0](B ?[2](3)[0](B + nil nil ?[2](3h[0](B nil nil nil ?[2](4e[0](B ?[2](3.[0](B nil nil nil nil nil nil nil nil + nil nil nil nil nil nil ?[2](30[0](B nil nil nil nil ?[2](4)[0](B nil ?[2](4g[0](B nil nil + nli ?[2](49[0](B ?[2](3H[0](B ?[2](3D[0](B ?[2](4_[0](B ?[2](4S[0](B ?[2](4#[0](B ?[2](38[0](B ?[2](4%[0](B nil ?[2](4Y[0](B ?[2](4[[0](B ?[2](3T[0](B ?[2](3^[0](B ?[2](3F[0](B ?[2](41[0](B + ?[2](4-[0](B ?[2](4A[0](B ?[2](4Q[0](B ?[2](45[0](B ?[2](4O[0](B ?[2](3Z[0](B ?[2](3B[0](B ?[2](4=[0](B ?[2](4E[0](B ?[2](4M[0](B ?[2](4I[0](B nil nli nil nil ]) + (t + [?[2](3![0](B ?[2](3"[0](B ?\" ?# ?$ ?% ?& ?' ?[2](3#[0](B ?[2](3$[0](B ?* ?+ ?[2](3^[0](B ?- ?[2](3H[0](B ?[2](4I[0](B + ?(2![0](B ?(2"[0](B ?(2#[0](B ?(2$[0](B ?(2%[0](B ?(2&[0](B ?(2'[0](B ?(2([0](B ?(2)[0](B ?(2*[0](B ?[2](3'[0](B ?[2](4U[0](B ?, ?= ?. ?[2](3)[0](B + ?@ nil ?[2](3b[0](B ?{ ?[ nil ?] ?[2](3c[0](B ?[2](30[0](B nil nil ?[2](3%[0](B ?/ ?` ?[2](3.[0](B nil + ?[2](3([0](B nil nil nil ?[2](3d[0](B ?' ?} nil nil ?[2](34[0](B ?~ ?[2](4)[0](B ?\\ ?[2](3B[0](B ?^ ?_ + ?[2](3D[0](B ?[2](49[0](B ?[2](3e[0](B ?[2](32[0](B ?[2](4_[0](B ?[2](4'[0](B ?[2](4#[0](B ?[2](4Y[0](B ?[2](38[0](B ?[2](3Z[0](B ?[2](4%[0](B ?[2](4[[0](B ?[2](3T[0](B ?[2](3<[0](B ?[2](4][0](B ?[2](41[0](B + ?[2](4-[0](B ?[2](4A[0](B ?[2](4S[0](B ?[2](45[0](B ?[2](4Q[0](B ?[2](4M[0](B ?[2](3F[0](B ?[2](4=[0](B ?[2](3-[0](B ?[2](4O[0](B ?[2](4)) + +(defvar arabic-mode-map + (let ((map (make-keymap))) + (substitute-key-definition 'self-insert-command + 'arabic-self-insert-command + map global-map) + + (define-key map [(control c) (control c)] 'arabic-mode) + (define-key map [(control d)] 'arabic-delete-char) + (define-key map [(control k)] 'arabic-kill-line) + (define-key map [(control m)] 'arabic-newline) + (define-key map [(control o)] 'arabic-open-line) + (define-key map [(control w)] 'arabic-kill-region) + (define-key map [(control y)] 'arabic-yank) + (define-key map [delete] 'arabic-backward-delete-char) + (define-key map [(meta d)] 'arabic-delete-word) + (define-key map [(meta y)] 'arabic-yank-pop) + (define-key map [(meta z)] 'arabic-help) + (define-key map [(meta \\)] 'arabic-toggle-input-char) + (define-key map [(meta delete)] 'arabic-backward-kill-word) + + (define-key map [(control n)] 'visual-next-line) + (define-key map [(control p)] 'visual-previous-line) + (define-key map [(meta <)] 'visual-beginning-of-buffer) + (define-key map [(meta >)] 'visual-end-of-buffer) + (define-key map [up] 'visual-previous-line) + (define-key map [down] 'visual-next-line) + (define-key map [home] 'visual-beginning-of-buffer) + (define-key map [end] 'visual-end-of-buffer) + (define-key map [left] 'visual-move-to-left-char) + (define-key map [right] 'visual-move-to-right-char) + (define-key map [(meta left)] 'visual-move-to-left-word) + (define-key map [(meta right)] 'visual-move-to-right-word) + + (if visual-use-lr-commands + (progn + (define-key map [(control a)] 'visual-left-end-of-line) + (define-key map [(control b)] 'visual-move-to-left-char) + (define-key map [(control e)] 'visual-right-end-of-line) + (define-key map [(control f)] 'visual-move-to-right-char) + (define-key map [(meta b)] 'visual-move-to-left-word) + (define-key map [(meta f)] 'visual-move-to-right-word)) + (define-key map [(control a)] 'visual-beginning-of-line) + (define-key map [(control b)] 'visual-backward-char) + (define-key map [(control e)] 'visual-end-of-line) + (define-key map [(control f)] 'visual-forward-char) + (define-key map [(meta b)] 'visual-backward-word) + (define-key map [(meta f)] 'visual-forward-word)) + + (cond + ((eq arabic-input-keymap 'arabic-keymap-0) + (define-key map [?~] 'arabic-insert-madda) + (define-key map [?'] 'arabic-insert-hamza) + (define-key map [?a] 'arabic-insert-alif) + (define-key map [?_] 'arabic-make-connection) + (define-key map [?|] 'arabic-cut-connection)) + ((eq arabic-input-keymap 'arabic-keymap-1) + (define-key map [?~] 'arabic-insert-madda) + (define-key map [?'] 'arabic-insert-hamza) + (define-key map [?a] 'arabic-insert-alif) + (define-key map [?_] 'arabic-make-connection) + (define-key map [?|] 'arabic-cut-connection) + (define-key map [(alt \;)] 'arabic-insert-gaaf) + (define-key map [(alt v)] 'arabic-insert-isolated-hamza)) + (t + (define-key map [(alt z)] 'arabic-insert-madda) + (define-key map [(alt x)] 'arabic-insert-hamza) + (define-key map [(alt h)] 'arabic-insert-alif) + (define-key map [(alt _)] 'arabic-make-connection) + (define-key map [(alt |)] 'arabic-cut-connection))) + + map) + "minor-mode-keymap for arabic-mode.") + + (if (not (assq 'arabic-mode minor-mode-map-alist)) + (setq minor-mode-map-alist + (cons (cons 'arabic-mode arabic-mode-map) minor-mode-map-alist))) + + (defvar arabic-help-string + (cond + ((eq arabic-input-keymap 'arabic-keymap-0) + "\ + Keymap in Arabic-mode + + +----------------------------------------------------------------+ + |! [2](3"[0](B |@ |# |$ |% |^ |& |* |( [2](3#[0](B |) [2](3$[0](B |_ |+ |~ | + |1 (2"[0](B |2 (2#[0](B |3 (2$[0](B |4 (2%[0](B |5 (2&[0](B |6 (2'[0](B |7 (2([0](B |8 (2)[0](B |9 (2*[0](B |0 (2![0](B |- |= |` [2](4M[0](B| + +----------------------------------------------------------------+ + |Q |W |E |R |T [2](4E[0](B|Y |U |I |O |P | + |q [2](4S[0](B|w [2](3^[0](B |e |r [2](3F[0](B |t [2](4%[0](B|y [2](4_[0](B|u |i |o [2](3<[0](B |p [2](4e[0](B| + +--------------------------------------------------------+ + |A [2](4][0](B|S [2](4=[0](B|D [2](4A[0](B|F |G [2](4O[0](B|H [2](4-[0](B|J |K [2](41[0](B|L |: [2](3'[0](B |\" [2](3-[0](B | + |a [2](38[0](B |s [2](45[0](B|d [2](3B[0](B |f [2](4Q[0](B|g [2](4k[0](B|h [2](3Z[0](B |j [2](4)[0](B|k [2](4U[0](B|l [2](4Y[0](B|; [2](3([0](B |' | + +------------------------------------------------------+ + |Z [2](4I[0](B|X [2](3h[0](B |C [2](4g[0](B|V |B |N |M |< [2](3*[0](B |> [2](3+[0](B |? [2](3)[0](B | + |z [2](3H[0](B |x [2](3D[0](B |c [2](4'[0](B|v |b [2](4#[0](B|n [2](4[[0](B|m [2](3T[0](B |, [2](3%[0](B |. [2](3&[0](B |/ [2](49[0](B| + +-------------------------------------------------+") + + ((eq arabic-input-keymap 'arabic-keymap-1) + "\ + Keymap in Arabic-mode +--------------+ + | ALT SHIFT| + +-------------------------------------------------+ |ASCII ARABIC| +| [2](3"[0](B | | | | | | | | [2](3#[0](B | [2](3$[0](B | +--------------+ +|1 (2"[0](B |2 (2#[0](B |3 (2$[0](B |4 (2%[0](B |5 (2&[0](B |6 (2'[0](B |7 (2([0](B |8 (2)[0](B |9 (2*[0](B |0 (2[0](B|] [2](4g[0](B| + +-----------------------------------------------------------+ + | | | | [2](4e[0](B| [2](3.[0](B | | | | |[2](4k[0](B [2](3'[0](B| + |a [2](49[0](B|s [2](45[0](B|d [2](4_[0](B|f [2](4#[0](B|g [2](38[0](B |h [2](4%[0](B|j [2](4Y[0](B|k [2](4[[0](B|l [2](3T[0](B |; [2](4U[0](B| + +---------------------------------------------------+ + | | | |[2](3-[0](B [2](30[0](B | [2](3h[0](B | | | [2](3*[0](B | [2](3+[0](B | [2](3)[0](B | + |z [2](4I[0](B|x [2](4E[0](B|c [2](3D[0](B |v [2](3B[0](B |b [2](3H[0](B |n [2](3F[0](B |m [2](3^[0](B |, [2](3%[0](B |. [2](3&[0](B |/ | + +-------------------------------------------------+") + + (t + "\ + +-----------------+ + |S-ASCII S-Arabic| + | ASCII Arabic | +----+ + +-----------------+ || || + |\\ \\| ++-----------------------------------------------------------+ +|! [2](3"[0](B|@ @|# #|$ $|% %|^ ^|& &|* *|( [2](3#[0](B|) [2](3$[0](B|_ _|+ +| +|1 (2"[0](B|2 (2#[0](B|3 (2$[0](B|4 (2%[0](B|5 (2&[0](B|6 (2'[0](B|7 (2([0](B|8 (2)[0](B|9 (2*[0](B|0 (2[0](B|] [2](3B[0](B| + +-------------------------------------------------------------+ + |A |S |D [|F ]|G [2](3c[0](B|H [2](30[0](B|J |K [2](3%[0](B|L /|: [2](3'[0](B|\" \" |~[2](3,[0](B | + | [2](49[0](B| [2](45[0](B| [2](4_[0](B| [2](4#[0](B| [2](4Y[0](B| [2](38[0](B| [2](4%[0](B| [2](4[[0](B| [2](3T[0](B|\; [2](4U[0](B|' [2](4E[0](B|` [2](3D[0](B| + +-----------------------------------------------------------+ + |Z ~|X |C {|V }|B [2](3b[0](B|N [2](3.[0](B|M `|< ,|> [2](3&[0](B|? [2](3)[0](B| + | [2](4![0](B| [2](3-[0](B| [2](32[0](B| [2](3F[0](B| [2](3e[0](B| [2](4][0](B| [2](3<[0](B|, [2](3^[0](B|. [2](3H[0](B|/ [2](4I[0](B| + +-------------------------------------------------+")) + + "Document shown by arabic-help (M-z).") + +;;;###autoload +(defun arabic-mode (&optional arg) + "Toggle arabic-mode. With ARG, turn arabic-mode on iff ARG is positive." + (interactive "P") + (if (null arg) + (if arabic-mode (exit-arabic-mode) (enter-arabic-mode)) + (if (> (prefix-numeric-value arg) 0) + (enter-arabic-mode) + (exit-arabic-mode)))) + +(defun enter-arabic-mode nil + "Enter arabic-mode." + (interactive) + (if (not arabic-mode) + (progn + (setq arabic-mode t + arabic-input-arabic-char t + arabic-mode-indicator " [2](3=a:GJ[0](B") + (redraw-modeline t) + (message "M-z to display arabic keymap.") + (run-hooks 'arabic-mode-hooks)))) + +(defun exit-arabic-mode nil + "Exit arabic-mode." + (interactive) + (if arabic-mode + (progn + (setq arabic-mode nil) + (redraw-modeline t)))) + +(defconst *arabic-adding-connection-to-right* + '((?[2](3.[0](B . ?[2](3/[0](B ) (?[2](3/[0](B . ?[2](3/[0](B ) + (?[2](30[0](B . ?[2](31[0](B ) (?[2](31[0](B . ?[2](31[0](B ) + (?[2](32[0](B . ?[2](33[0](B ) (?[2](33[0](B . ?[2](33[0](B ) + (?[2](34[0](B . ?[2](35[0](B ) (?[2](35[0](B . ?[2](35[0](B ) + (?[2](4![0](B . ?[2](4"[0](B) (?[2](36[0](B . ?[2](37[0](B ) (?[2](37[0](B . ?[2](37[0](B ) (?[2](4"[0](B . ?[2](4"[0](B) + (?[2](36[0](B . ?[2](37[0](B ) (?[2](37[0](B . ?[2](37[0](B ) + (?[2](38[0](B . ?[2](39[0](B ) (?[2](39[0](B . ?[2](39[0](B ) + (?[2](4#[0](B . ?[2](4$[0](B) (?[2](3:[0](B . ?[2](3;[0](B ) (?[2](3;[0](B . ?[2](3;[0](B ) (?[2](4$[0](B . ?[2](4$[0](B) + (?[2](3<[0](B . ?[2](3=[0](B ) (?[2](3=[0](B . ?[2](3=[0](B ) + (?[2](4%[0](B . ?[2](4&[0](B) (?[2](3>[0](B . ?[2](3?[0](B ) (?[2](3?[0](B . ?[2](3?[0](B ) (?[2](4&[0](B . ?[2](4&[0](B) + (?[2](4'[0](B . ?[2](4([0](B) (?[2](3@[0](B . ?[2](3A[0](B ) (?[2](3A[0](B . ?[2](3A[0](B ) (?[2](4([0](B . ?[2](4([0](B) + (?[2](4)[0](B . ?[2](4,[0](B) (?[2](4*[0](B . ?[2](4+[0](B) (?[2](4+[0](B . ?[2](4+[0](B) (?[2](4,[0](B . ?[2](4,[0](B) + (?[2](4-[0](B . ?[2](40[0](B) (?[2](4.[0](B . ?[2](4/[0](B) (?[2](4/[0](B . ?[2](4/[0](B) (?[2](40[0](B . ?[2](40[0](B) + (?[2](41[0](B . ?[2](44[0](B) (?[2](42[0](B . ?[2](43[0](B) (?[2](43[0](B . ?[2](43[0](B) (?[2](44[0](B . ?[2](44[0](B) + (?[2](3B[0](B . ?[2](3C[0](B ) (?[2](3C[0](B . ?[2](3C[0](B ) + (?[2](3D[0](B . ?[2](3E[0](B ) (?[2](3E[0](B . ?[2](3E[0](B ) + (?[2](3F[0](B . ?[2](3G[0](B ) (?[2](3G[0](B . ?[2](3G[0](B ) + (?[2](3H[0](B . ?[2](3I[0](B ) (?[2](3I[0](B . ?[2](3I[0](B ) + (?[2](45[0](B . ?[2](48[0](B) (?[2](46[0](B . ?[2](47[0](B) (?[2](47[0](B . ?[2](47[0](B) (?[2](48[0](B . ?[2](48[0](B) + (?[2](49[0](B . ?[2](4<[0](B) (?[2](4:[0](B . ?[2](4;[0](B) (?[2](4;[0](B . ?[2](4;[0](B) (?[2](4<[0](B . ?[2](4<[0](B) + (?[2](4=[0](B . ?[2](4@[0](B) (?[2](4>[0](B . ?[2](4?[0](B) (?[2](4?[0](B . ?[2](4?[0](B) (?[2](4@[0](B . ?[2](4@[0](B) + (?[2](4A[0](B . ?[2](4D[0](B) (?[2](4B[0](B . ?[2](4C[0](B) (?[2](4C[0](B . ?[2](4C[0](B) (?[2](4D[0](B . ?[2](4D[0](B) + (?[2](4E[0](B . ?[2](4H[0](B) (?[2](4F[0](B . ?[2](4G[0](B) (?[2](4G[0](B . ?[2](4G[0](B) (?[2](4H[0](B . ?[2](4H[0](B) + (?[2](4I[0](B . ?[2](4L[0](B) (?[2](4J[0](B . ?[2](4K[0](B) (?[2](4K[0](B . ?[2](4K[0](B) (?[2](4L[0](B . ?[2](4L[0](B) + (?[2](4M[0](B . ?[2](4N[0](B) (?[2](3J[0](B . ?[2](3K[0](B ) (?[2](3K[0](B . ?[2](3K[0](B ) (?[2](4N[0](B . ?[2](4N[0](B) + (?[2](4O[0](B . ?[2](4P[0](B) (?[2](3L[0](B . ?[2](3M[0](B ) (?[2](3M[0](B . ?[2](3M[0](B ) (?[2](4P[0](B . ?[2](4P[0](B) + (?[2](4Q[0](B . ?[2](4R[0](B) (?[2](3N[0](B . ?[2](3O[0](B ) (?[2](3O[0](B . ?[2](3O[0](B ) (?[2](4R[0](B . ?[2](4R[0](B) + (?[2](4S[0](B . ?[2](4T[0](B) (?[2](3P[0](B . ?[2](3Q[0](B ) (?[2](3Q[0](B . ?[2](3Q[0](B ) (?[2](4T[0](B . ?[2](4T[0](B) + (?[2](4U[0](B . ?[2](4X[0](B) (?[2](4V[0](B . ?[2](4W[0](B) (?[2](4W[0](B . ?[2](4W[0](B) (?[2](4X[0](B . ?[2](4X[0](B) + (?[2](4Y[0](B . ?[2](4Z[0](B) (?[2](3R[0](B . ?[2](3S[0](B ) (?[2](3S[0](B . ?[2](3S[0](B ) (?[2](4Z[0](B . ?[2](4Z[0](B) + (?[2](3T[0](B . ?[2](3W[0](B ) (?[2](3U[0](B . ?[2](3V[0](B ) (?[2](3V[0](B . ?[2](3V[0](B ) (?[2](3W[0](B . ?[2](3W[0](B ) + (?[2](4[[0](B . ?[2](4\[0](B) (?[2](3X[0](B . ?[2](3Y[0](B ) (?[2](3Y[0](B . ?[2](3Y[0](B ) (?[2](4\[0](B . ?[2](4\[0](B) + (?[2](3Z[0](B . ?[2](3][0](B ) (?[2](3[[0](B . ?[2](3\[0](B ) (?[2](3\[0](B . ?[2](3\[0](B ) (?[2](3][0](B . ?[2](3][0](B ) + (?[2](3^[0](B . ?[2](3_[0](B ) (?[2](3_[0](B . ?[2](3_[0](B ) + (?[2](4][0](B . ?[2](4^[0](B) (?[2](4^[0](B . ?[2](4^[0](B) + (?[2](4_[0](B . ?[2](4`[0](B) (?[2](3`[0](B . ?[2](3a[0](B ) (?[2](3a[0](B . ?[2](3a[0](B ) (?[2](4`[0](B . ?[2](4`[0](B) + (?[2](3b[0](B . ?[2](4a[0](B) (?[2](4a[0](B . ?[2](4a[0](B) + (?[2](3c[0](B . ?[2](4b[0](B) (?[2](4b[0](B . ?[2](4b[0](B) + (?[2](3d[0](B . ?[2](4c[0](B) (?[2](4c[0](B . ?[2](4c[0](B) + (?[2](3e[0](B . ?[2](4d[0](B) (?[2](4d[0](B . ?[2](4d[0](B) + (?[2](4e[0](B . ?[2](4f[0](B) (?[2](3f[0](B . ?[2](3g[0](B ) (?[2](3g[0](B . ?[2](3g[0](B ) (?[2](4f[0](B . ?[2](4f[0](B) + (?[2](4g[0](B . ?[2](4j[0](B) (?[2](4h[0](B . ?[2](4i[0](B) (?[2](4i[0](B . ?[2](4i[0](B) (?[2](4j[0](B . ?[2](4j[0](B) + (?[2](3h[0](B . ?[2](3i[0](B ) (?[2](3i[0](B . ?[2](3i[0](B ) + (?[2](4k[0](B . ?[2](4n[0](B) (?[2](4l[0](B . ?[2](4m[0](B) (?[2](4m[0](B . ?[2](4m[0](B) (?[2](4n[0](B . ?[2](4n[0](B))) + +(defconst *arabic-adding-connection-to-left* + '((?[2](4 (?[2](36[0](B . ?[2](36[0](B ) (?[2](37[0](B . ?[2](37[0](B ) (?[2](4"[0](B . ?[2](37[0](B) + (?[2](4#[0](B . ?[2](3:[0](B ) (?[2](3:[0](B . ?[2](3:[0](B ) (?[2](3;[0](B . ?[2](3;[0](B ) (?[2](4$[0](B . ?[2](3;[0](B ) + (?[2](4%[0](B . ?[2](3>[0](B ) (?[2](3>[0](B . ?[2](3>[0](B ) (?[2](3?[0](B . ?[2](3?[0](B ) (?[2](4&[0](B . ?[2](3?[0](B ) + (?[2](4'[0](B . ?[2](3@[0](B ) (?[2](3@[0](B . ?[2](3@[0](B ) (?[2](3A[0](B . ?[2](3A[0](B ) (?[2](4([0](B . ?[2](3A[0](B ) + (?[2](4)[0](B . ?[2](4*[0](B) (?[2](4*[0](B . ?[2](4*[0](B) (?[2](4+[0](B . ?[2](4+[0](B) (?[2](4,[0](B . ?[2](4+[0](B) + (?[2](4-[0](B . ?[2](4.[0](B) (?[2](4.[0](B . ?[2](4.[0](B) (?[2](4/[0](B . ?[2](4/[0](B) (?[2](40[0](B . ?[2](4/[0](B) + (?[2](41[0](B . ?[2](42[0](B) (?[2](42[0](B . ?[2](42[0](B) (?[2](43[0](B . ?[2](43[0](B) (?[2](44[0](B . ?[2](43[0](B) + (?[2](45[0](B . ?[2](46[0](B) (?[2](46[0](B . ?[2](46[0](B) (?[2](47[0](B . ?[2](47[0](B) (?[2](48[0](B . ?[2](47[0](B) + (?[2](49[0](B . ?[2](4:[0](B) (?[2](4:[0](B . ?[2](4:[0](B) (?[2](4;[0](B . ?[2](4;[0](B) (?[2](4<[0](B . ?[2](4;[0](B) + (?[2](4=[0](B . ?[2](4>[0](B) (?[2](4>[0](B . ?[2](4>[0](B) (?[2](4?[0](B . ?[2](4?[0](B) (?[2](4@[0](B . ?[2](4?[0](B) + (?[2](4A[0](B . ?[2](4B[0](B) (?[2](4B[0](B . ?[2](4B[0](B) (?[2](4C[0](B . ?[2](4C[0](B) (?[2](4D[0](B . ?[2](4C[0](B) + (?[2](4E[0](B . ?[2](4F[0](B) (?[2](4F[0](B . ?[2](4F[0](B) (?[2](4G[0](B . ?[2](4G[0](B) (?[2](4H[0](B . ?[2](4G[0](B) + (?[2](4I[0](B . ?[2](4J[0](B) (?[2](4J[0](B . ?[2](4J[0](B) (?[2](4K[0](B . ?[2](4K[0](B) (?[2](4L[0](B . ?[2](4K[0](B) + (?[2](4M[0](B . ?[2](3J[0](B ) (?[2](3J[0](B . ?[2](3J[0](B ) (?[2](3K[0](B . ?[2](3K[0](B ) (?[2](4N[0](B . ?[2](3K[0](B ) + (?[2](4O[0](B . ?[2](3L[0](B ) (?[2](3L[0](B . ?[2](3L[0](B ) (?[2](3M[0](B . ?[2](3M[0](B ) (?[2](4P[0](B . ?[2](3M[0](B ) + (?[2](4Q[0](B . ?[2](3N[0](B ) (?[2](3N[0](B . ?[2](3N[0](B ) (?[2](3O[0](B . ?[2](3O[0](B ) (?[2](4R[0](B . ?[2](3O[0](B ) + (?[2](4S[0](B . ?[2](3P[0](B ) (?[2](3P[0](B . ?[2](3P[0](B ) (?[2](3Q[0](B . ?[2](3Q[0](B ) (?[2](4T[0](B . ?[2](3Q[0](B ) + (?[2](4U[0](B . ?[2](4V[0](B) (?[2](4V[0](B . ?[2](4V[0](B) (?[2](4W[0](B . ?[2](4W[0](B) (?[2](4X[0](B . ?[2](4W[0](B) + (?[2](4Y[0](B . ?[2](3R[0](B ) (?[2](3R[0](B . ?[2](3R[0](B ) (?[2](3S[0](B . ?[2](3S[0](B ) (?[2](4Z[0](B . ?[2](3S[0](B ) + (?[2](3T[0](B . ?[2](3U[0](B ) (?[2](3U[0](B . ?[2](3U[0](B ) (?[2](3V[0](B . ?[2](3V[0](B ) (?[2](3W[0](B . ?[2](3V[0](B ) + (?[2](4[[0](B . ?[2](3X[0](B ) (?[2](3X[0](B . ?[2](3X[0](B ) (?[2](3Y[0](B . ?[2](3Y[0](B ) (?[2](4\[0](B . ?[2](3Y[0](B ) + (?[2](3Z[0](B . ?[2](3[[0](B ) (?[2](3[[0](B . ?[2](3[[0](B ) (?[2](3\[0](B . ?[2](3\[0](B ) (?[2](3][0](B . ?[2](3\[0](B ) + (?[2](4_[0](B . ?[2](3`[0](B ) (?[2](3`[0](B . ?[2](3`[0](B ) (?[2](3a[0](B . ?[2](3a[0](B ) (?[2](4`[0](B . ?[2](3a[0](B ) + (?[2](4e[0](B . ?[2](3f[0](B ) (?[2](3f[0](B . ?[2](3f[0](B ) (?[2](3g[0](B . ?[2](3g[0](B ) (?[2](4f[0](B . ?[2](3g[0](B) + (?[2](4g[0](B . ?[2](4h[0](B) (?[2](4h[0](B . ?[2](4h[0](B) (?[2](4i[0](B . ?[2](4i[0](B) (?[2](4j[0](B . ?[2](4i[0](B) + (?[2](4k[0](B . ?[2](4l[0](B) (?[2](4l[0](B . ?[2](4l[0](B) (?[2](4m[0](B . ?[2](4m[0](B) (?[2](4n[0](B . ?[2](4m[0](B))) + +(defconst *arabic-removing-connection-from-right* + '((?[2](3/[0](B . ?[2](3.[0](B ) + (?[2](31[0](B . ?[2](30[0](B ) + (?[2](33[0](B . ?[2](32[0](B ) + (?[2](35[0](B . ?[2](34[0](B ) + (?[2](4"[0](B . ?[2](4 (?[2](37[0](B . ?[2](36[0](B ) + (?[2](39[0](B . ?[2](38[0](B ) + (?[2](4$[0](B . ?[2](4#[0](B) (?[2](3;[0](B . ?[2](3:[0](B ) + (?[2](3=[0](B . ?[2](3<[0](B ) + (?[2](4&[0](B . ?[2](4%[0](B) (?[2](3?[0](B . ?[2](3>[0](B ) + (?[2](4([0](B . ?[2](4'[0](B) (?[2](3A[0](B . ?[2](3@[0](B ) + (?[2](4,[0](B . ?[2](4)[0](B) (?[2](4+[0](B . ?[2](4*[0](B) + (?[2](40[0](B . ?[2](4-[0](B) (?[2](4/[0](B . ?[2](4.[0](B) + (?[2](44[0](B . ?[2](41[0](B) (?[2](43[0](B . ?[2](42[0](B) + (?[2](3C[0](B . ?[2](3B[0](B ) + (?[2](3E[0](B . ?[2](3D[0](B ) + (?[2](3G[0](B . ?[2](3F[0](B ) + (?[2](3I[0](B . ?[2](3H[0](B ) + (?[2](48[0](B . ?[2](45[0](B) (?[2](47[0](B . ?[2](46[0](B) + (?[2](4<[0](B . ?[2](49[0](B) (?[2](4;[0](B . ?[2](4:[0](B) + (?[2](4@[0](B . ?[2](4=[0](B) (?[2](4?[0](B . ?[2](4>[0](B) + (?[2](4D[0](B . ?[2](4A[0](B) (?[2](4C[0](B . ?[2](4B[0](B) + (?[2](4H[0](B . ?[2](4E[0](B) (?[2](4G[0](B . ?[2](4F[0](B) + (?[2](4L[0](B . ?[2](4I[0](B) (?[2](4K[0](B . ?[2](4J[0](B) + (?[2](4N[0](B . ?[2](4M[0](B) (?[2](3K[0](B . ?[2](3J[0](B ) + (?[2](4P[0](B . ?[2](4O[0](B) (?[2](3M[0](B . ?[2](3L[0](B ) + (?[2](4R[0](B . ?[2](4Q[0](B) (?[2](3O[0](B . ?[2](3N[0](B ) + (?[2](4T[0](B . ?[2](4S[0](B) (?[2](3Q[0](B . ?[2](3P[0](B ) + (?[2](4X[0](B . ?[2](4U[0](B) (?[2](4W[0](B . ?[2](4V[0](B) + (?[2](4Z[0](B . ?[2](4Y[0](B) (?[2](3S[0](B . ?[2](3R[0](B ) + (?[2](3W[0](B . ?[2](3T[0](B ) (?[2](3V[0](B . ?[2](3U[0](B ) + (?[2](4\[0](B . ?[2](4[[0](B) (?[2](3Y[0](B . ?[2](3X[0](B ) + (?[2](3][0](B . ?[2](3Z[0](B ) (?[2](3\[0](B . ?[2](3[[0](B ) + (?[2](3_[0](B . ?[2](3^[0](B ) + (?[2](4^[0](B . ?[2](4][0](B) + (?[2](4`[0](B . ?[2](4_[0](B) (?[2](3a[0](B . ?[2](3`[0](B ) + (?[2](4a[0](B . ?[2](3b[0](B ) + (?[2](4b[0](B . ?[2](3c[0](B ) + (?[2](4c[0](B . ?[2](3d[0](B ) + (?[2](4d[0](B . ?[2](3e[0](B ) + (?[2](4f[0](B . ?[2](4e[0](B) (?[2](3g[0](B . ?[2](3f[0](B ) + (?[2](4j[0](B . ?[2](4g[0](B) (?[2](4i[0](B . ?[2](4h[0](B) + (?[2](3i[0](B . ?[2](3h[0](B) + (?[2](4n[0](B . ?[2](4k[0](B) (?[2](4m[0](B . ?[2](4l[0](B))) + +(defconst *arabic-removing-connection-from-left* + '((?[2](36[0](B . ?[2](4 (?[2](37[0](B . ?[2](4"[0](B) + (?[2](3:[0](B . ?[2](4#[0](B) (?[2](3;[0](B . ?[2](4$[0](B) + (?[2](3>[0](B . ?[2](4%[0](B) (?[2](3?[0](B . ?[2](4&[0](B) + (?[2](3@[0](B . ?[2](4'[0](B) (?[2](3A[0](B . ?[2](4([0](B) + (?[2](4*[0](B . ?[2](4)[0](B) (?[2](4+[0](B . ?[2](4,[0](B) + (?[2](4.[0](B . ?[2](4-[0](B) (?[2](4/[0](B . ?[2](40[0](B) + (?[2](42[0](B . ?[2](41[0](B) (?[2](43[0](B . ?[2](44[0](B) + (?[2](46[0](B . ?[2](45[0](B) (?[2](47[0](B . ?[2](48[0](B) + (?[2](4:[0](B . ?[2](49[0](B) (?[2](4;[0](B . ?[2](4<[0](B) + (?[2](4>[0](B . ?[2](4=[0](B) (?[2](4?[0](B . ?[2](4@[0](B) + (?[2](4D[0](B . ?[2](4A[0](B) (?[2](4C[0](B . ?[2](4A[0](B) + (?[2](4F[0](B . ?[2](4E[0](B) (?[2](4G[0](B . ?[2](4H[0](B) + (?[2](4J[0](B . ?[2](4I[0](B) (?[2](4K[0](B . ?[2](4L[0](B) + (?[2](3J[0](B . ?[2](4M[0](B) (?[2](3K[0](B . ?[2](4N[0](B) + (?[2](3L[0](B . ?[2](4O[0](B) (?[2](3M[0](B . ?[2](4P[0](B) + (?[2](3N[0](B . ?[2](4Q[0](B) (?[2](3O[0](B . ?[2](4R[0](B) + (?[2](3P[0](B . ?[2](4S[0](B) (?[2](3Q[0](B . ?[2](4T[0](B) + (?[2](4V[0](B . ?[2](4U[0](B) (?[2](4W[0](B . ?[2](4X[0](B) + (?[2](3R[0](B . ?[2](4Y[0](B) (?[2](3S[0](B . ?[2](4Z[0](B) + (?[2](3U[0](B . ?[2](3T[0](B ) (?[2](3V[0](B . ?[2](3W[0](B ) + (?[2](3X[0](B . ?[2](4[[0](B) (?[2](3Y[0](B . ?[2](4\[0](B) + (?[2](3[[0](B . ?[2](3Z[0](B ) (?[2](3\[0](B . ?[2](3][0](B ) + (?[2](3`[0](B . ?[2](4_[0](B) (?[2](3a[0](B . ?[2](4`[0](B) + (?[2](4h[0](B . ?[2](4g[0](B) (?[2](4i[0](B . ?[2](4j[0](B) + (?[2](4l[0](B . ?[2](4k[0](B) (?[2](4m[0](B . ?[2](4n[0](B))) + +(defun arabic-make-connection nil + "If possible, tie the two characters around the cursor." + (interactive) + (let ((lch (assoc (visual-char-left) *arabic-adding-connection-to-right*)) + (rch (assoc (visual-char-right) *arabic-adding-connection-to-left*))) + (if (not (and lch rch)) + (arabic-cut-connection) + (visual-replace-left-1-char (cdr lch)) + (visual-replace-right-1-char (cdr rch))))) + +(defun arabic-cut-connection nil + "Remove the connection between the two characters around the cursor, if any." + (interactive) + (let + ((lch (assoc (visual-char-left) *arabic-removing-connection-from-right*)) + (rch (assoc (visual-char-right) *arabic-removing-connection-from-left*))) + (if lch + (visual-replace-left-1-char (cdr lch))) + (if rch + (visual-replace-right-1-char (cdr rch))))) + +(defun arabic-insert-char (ch arg) + "Insert ARG (2nd arg; > 0) number of CHs (1st arg; character) around +visual point. +If CH is l2r, inserted on the left. Otherwise, on the right." + (while (> arg 0) + (arabic-insert-1-char ch) + (setq arg (1- arg)))) + +(defun arabic-insert-1-char (ch) + "Insert CH (1st arg; character) around visual point. +If CH is l2r, inserted on the left. Otherwise, on the right." + (if (= (visual-char-direction ch) 0) + ; if visual-char-direction = 0, always disjoint. + (progn + (arabic-cut-connection) + (visual-insert-left-1-char ch)) + (visual-insert-left-1-char ch) + (arabic-make-connection) + (visual-move-to-left-1-char) + (arabic-make-connection))) + +(defun arabic-self-insert-command (arg) + "Self-insert-command for arabic-mode." + (interactive "*p") + (let ((ch last-command-char)) + (if arabic-input-arabic-char + (setq ch (aref arabic-translate-table (- ch 32)))) + (if (null ch) + (beep) + (while (> arg 0) + (arabic-keyboard-insert-1-char ch) + (setq arg (1- arg)))))) + +(defun arabic-keyboard-insert-1-char (ch) + "Insert CH (1st arg; Arabic character) at visual cursor position. +if last-command is arabic-cut-connection, CH will not connected to the +right adjacent character (but connected to the left, if possible)." + (let ((rch (visual-char-right))) + (cond + ((= (visual-char-direction ch) 0) + (arabic-cut-connection) + (visual-insert-left-1-char ch)) + ((eq last-command 'arabic-cut-connection) + (visual-insert-right-1-char ch) + (arabic-make-connection)) + (t + (arabic-insert-1-char ch))))) + +(defun arabic-insert-gaaf (arg) + "Insert gaaf as if it were typed from keyboard." + (interactive "*p") + (while (> arg 0) + (arabic-keyboard-insert-1-char ?[2](4k[0](B) + (setq arg (1- arg)))) + +(defun arabic-insert-isolated-hamza (arg) + "Insert an isolated hamza as if it were typed from keyboard." + (interactive "*p") + (while (> arg 0) + (arabic-keyboard-insert-1-char ?[2](3-[0](B) + (setq arg (1- arg)))) + +(defun arabic-insert-madda nil + "Put madda on the previous alif." + (interactive) + (let ((rch (visual-char-right))) + (cond + ((eq rch ?[2](38[0](B ) (visual-replace-right-1-char ?[2](3.[0](B )) + ((eq rch ?[2](39[0](B ) (visual-replace-right-1-char ?[2](3/[0](B )) + ((eq rch ?[2](3e[0](B ) (visual-replace-right-1-char ?[2](3b[0](B )) + ((eq rch ?[2](4d[0](B) (visual-replace-right-1-char ?[2](4a[0](B)) + (t (beep))))) + +(defun arabic-insert-alif (arg) + "Insert ARG number of alif's. +If the previous character is a laam, replace it with an alif+laam ligature." + (interactive "*p") + (let (rch) + (while (> arg 0) + (setq rch (visual-char-right)) + (cond + ((eq last-command 'arabic-cut-connection) + (visual-insert-right-1-char ?[2](38[0](B)) + ((or (eq rch ?[2](4Y[0](B) (eq rch ?[2](3R[0](B )) + (visual-replace-right-1-char ?[2](3e[0](B )) + ((or (eq rch ?[2](3S[0](B ) (eq rch ?[2](4Z[0](B)) + (visual-replace-right-1-char ?[2](4d[0](B)) + (t + (visual-insert-left-1-char ?[2](38[0](B ) + (arabic-make-connection) + (visual-move-to-left-1-char))) + (setq arg (1- arg))) + (arabic-cut-connection))) + +(defun arabic-insert-hamza (arg) + "Insert ARG number of hamza's. +Put it on/under previous characters, if possible." + (interactive "*p") + (let (rch) + (while (> arg 0) + (setq rch (visual-char-right)) + (cond + ((eq last-command 'arabic-cut-connection) + (visual-insert-right-1-char ?[2](3-[0](B)) + ((eq rch ?[2](38[0](B ) (visual-replace-right-1-char ?[2](30[0](B )) + ((eq rch ?[2](39[0](B ) (visual-replace-right-1-char ?[2](31[0](B )) + ((eq rch ?[2](30[0](B ) (visual-replace-right-1-char ?[2](34[0](B )) + ((eq rch ?[2](31[0](B ) (visual-replace-right-1-char ?[2](35[0](B )) + ((eq rch ?[2](3^[0](B ) (visual-replace-right-1-char ?[2](32[0](B )) + ((eq rch ?[2](3_[0](B ) (visual-replace-right-1-char ?[2](33[0](B )) + ((eq rch ?[2](4_[0](B) (visual-replace-right-1-char ?[2](4) + ((eq rch ?[2](3`[0](B ) (visual-replace-right-1-char ?[2](36[0](B )) + ((eq rch ?[2](3a[0](B ) (visual-replace-right-1-char ?[2](37[0](B )) + ((eq rch ?[2](4`[0](B) (visual-replace-right-1-char ?[2](4"[0](B)) + ((eq rch ?[2](4][0](B) (visual-replace-right-1-char ?[2](4) + ((eq rch ?[2](4^[0](B) (visual-replace-right-1-char ?[2](4"[0](B)) + ((eq rch ?[2](3e[0](B ) (visual-replace-right-1-char ?[2](3c[0](B )) + ((eq rch ?[2](4d[0](B) (visual-replace-right-1-char ?[2](4b[0](B)) + ((eq rch ?[2](3c[0](B ) (visual-replace-right-1-char ?[2](3d[0](B )) + ((eq rch ?[2](4b[0](B) (visual-replace-right-1-char ?[2](4c[0](B)) + (t (arabic-cut-connection) + (visual-insert-right-1-char ?[2](3-[0](B))) + (setq arg (1- arg))))) + +(defun arabic-toggle-input-char nil + "Toggle Arabic key input and ASCII key input." + (interactive) + (if arabic-input-arabic-char + (setq arabic-input-arabic-char nil + arabic-mode-indicator " Arabic") + (setq arabic-input-arabic-char t + arabic-mode-indicator " [2](3=a:GJ[0](B")) + (redraw-modeline t)) + +(defun arabic-newline (arg) + "Newline for arabic-mode." + (interactive "*p") + (arabic-insert-char ?\n arg)) + +(defun arabic-open-line (arg) + "Openline for arabic-mode." + (interactive "*p") + (arabic-insert-char ?\n arg) + (visual-backward-char arg)) + +(defun arabic-delete-char (arg) + "Delete ARG (1st arg; integer) chars visually after visual point. +After that, Arabic ligature is performed." + (interactive "*p") + (visual-delete-char arg) + (arabic-make-connection)) + +(defun arabic-backward-delete-char (arg) + "Delete ARG (1st arg; integer) chars visually before visual point. +After that, Arabic ligature is performed." + (interactive "*p") + (visual-backward-delete-char arg) + (arabic-make-connection)) + +(defun arabic-kill-region (beg end) + "Kill-region command for arabic-mode." + (interactive "r") + (if (or (and buffer-read-only (not inhibit-read-only)) + (text-property-not-all beg end 'read-only nil)) + (visual-kill-region beg end) + (visual-kill-region beg end) + (arabic-make-connection))) + +(defun arabic-kill-word (arg) + "Kill-word command for arabic-mode." + (interactive "*p") + (visual-kill-word arg) + (arabic-make-connection)) + +(defun arabic-backward-kill-word (arg) + "Backword-ill-word command for arabic-mode." + (interactive "*p") + (visual-backward-kill-word arg) + (arabic-make-connection)) + +(defun arabic-kill-line (&optional arg) + "Kill-line command for arabic-mode." + (interactive "*P") + (visual-kill-line arg) + (arabic-make-connection)) + +(defun arabic-yank (&optional arg) + "yank command for arabic-mode." + (interactive "*P") + (visual-yank arg) + (let ((p1 (point)) (p2 (mark t))) + (arabic-make-connection) + (goto-char p2) + (arabic-make-connection) + (goto-char p1) + (set-marker (mark-marker) p2 (current-buffer)) + nil)) + +(defun arabic-yank-pop (arg) + "yank-pop command for arabic-mode." + (interactive "*p") + (visual-yank-pop arg) + (let ((p1 (point)) (p2 (mark t))) + (arabic-make-connection) + (goto-char p2) + (arabic-make-connection) + (goto-char p1) + (set-marker (mark-marker) p2 (current-buffer)) + nil)) + +(defun arabic-help nil + "Display keymap in Arabic-mode." + (interactive) + (let ((arabic-help-buffer (get-buffer-create "*Help*"))) + (set-buffer arabic-help-buffer) + (erase-buffer) + (insert arabic-help-string) + (goto-char (point-min)) + (display-buffer (current-buffer)))) + + +;; arabic LR commands + +(defun arabic-delete-left-char (arg) + "Kill N (1st arg; integer) characters on the left of visual point." + (interactive "*p") + (if display-direction + (arabic-delete-char arg) + (arabic-backward-delete-char arg))) + +(defun arabic-delete-right-char (arg) + "Kill N (1st arg; integer) characters on the right of visual point." + (interactive "*p") + (if display-direction + (arabic-backward-delete-char arg) + (arabic-delete-char arg))) + +(defun arabic-kill-left-word (arg) + "Kill N (1st arg; integer) words on the left of visual point." + (interactive "*p") + (if display-direction + (arabic-kill-word arg) + (arabic-backward-kill-word arg))) + +(defun arabic-kill-right-word (arg) + "Kill N (1st arg; integer) words on the right of visual point." + (interactive "*p") + (if display-direction + (arabic-backward-kill-word arg) + (arabic-kill-word arg))) + +;;; +(provide 'arabic) +;;; arabic-util.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/language/arabic.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,67 @@ +;;; arabic.el --- pre-loaded support for Arabic. + +;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. +;; Copyright (C) 1995 Amdahl Corporation. +;; Copyright (C) 1995 Sun Microsystems. + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Synched up with: Mule 2.3. + +;;; Code: + +;; Three character sets for Arabic +(make-charset 'arabic-0 "Arabic digits" + '(registry "MuleArabic-0" + dimension 1 + chars 94 + final ?2 + graphic 0 + direction l2r + )) + +(make-charset 'arabic-1 "one-column Arabic" + '(registry "MuleArabic-1" + dimension 1 + chars 94 + final ?3 + graphic 0 + direction r2l + )) + +(make-charset 'arabic-2 "two-column Arabic" + '(registry "MuleArabic-2" + dimension 1 + chars 94 + final ?4 + graphic 0 + direction r2l + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ARABIC +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-language-environment 'arabic + "Arabic" + (lambda () + (require 'arabic))) + +;;; arabic.el ends here
--- a/lisp/language/cyrillic.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/language/cyrillic.el Mon Aug 13 09:44:42 2007 +0200 @@ -119,7 +119,7 @@ (make-coding-system 'koi8-r 'ccl - "Coding-system used for KOI8." + "Coding-system used for KOI8-R." `(decode ,ccl-decode-koi8 encode ,ccl-encode-koi8 mnemonic "KOI8")) @@ -254,7 +254,7 @@ "Cyrillic" '((setup-function . setup-cyrillic-environment) (describe-function . describe-cyrillic-support) (charset . (cyrillic-iso8859-5)) - (coding-system . (iso-8859-5 koi8 alternativnyj)) + (coding-system . (iso-8859-5 koi8-r alternativnyj)) (sample-text . "Russian (,L@caaZXY(B) ,L7T`PRabRcYbU(B!") (documentation . nil)))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/language/ethio-util.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,1842 @@ +;;; ethio-util.el --- utilities for Ethiopic + +;; Copyright (C) 1995 Free Software Foundation, Inc. +;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Copyright (C) 1997 MORIOKA Tomohiko + +;; Keywords: mule, multilingual, Ethiopic + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp> +;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp> for XEmacs. + +;;; Code: + +(eval-when-compile + (require 'rmail) + (require 'w3) + ) + +;; +;; ETHIOPIC UTILITY FUNCTIONS +;; + +;; If the filename ends in ".sera", editing is done in fidel +;; but file I/O is done in SERA. +;; +;; If the filename ends in ".java", editing is done in fidel +;; but file I/O is done in the \uXXXX style, where XXXX is +;; the Unicode codepoint for the Ethiopic character. +;; +;; If the filename ends in ".tex", editing is done in fidel +;; but file I/O is done in EthioTeX format. +;; +;; To automatically convert Ethiopic text to SERA format when sending mail, +;; (add-hook 'mail-send-hook 'ethio-fidel-to-sera-mail) +;; +;; To automatically convert SERA format to Ethiopic when receiving mail, +;; (add-hook 'rmail-show-message-hook 'ethio-sera-to-fidel-mail) +;; +;; To automatically convert Ethiopic text to SERA format when posting news, +;; (add-hook 'news-inews-hook 'ethio-fidel-to-sera-mail) + +;; +;; users' preference +;; + +(defvar ethio-primary-language 'tigrigna + "*Symbol that defines the primary language in SERA --> FIDEL conversion. +The value should be one of: `tigrigna', `amharic' or `english'.") + +(defvar ethio-secondary-language 'english + "*Symbol that defines the secondary language in SERA --> FIDEL conversion. +The value should be one of: `tigrigna', `amharic' or `english'.") + +(defvar ethio-use-colon-for-colon nil + "*Non-nil means associate ASCII colon with Ethiopic colon. +If nil, associate ASCII colon with Ethiopic word separator, i.e., two +vertically stacked dots. All SERA <--> FIDEL converters refer this +variable.") + +(defvar ethio-use-three-dot-question nil + "*Non-nil means associate ASCII question mark with Ethiopic old style question mark (three vertically stacked dots). +If nil, associate ASCII question mark with Ethiopic stylised question +mark. All SERA <--> FIDEL converters refer this variable.") + +(defvar ethio-quote-vowel-always nil + "*Non-nil means always put an apostrophe before an isolated vowel (except at word initial) in FIDEL --> SERA conversion. +If nil, put an apostrophe only between a sixth-form consonant and an +isolated vowel.") + +(defvar ethio-W-sixth-always nil + "*Non-nil means convert the Wu-form of a 12-form consonant to \"W'\" instead of \"Wu\" in FIDEL --> SERA conversion.") + +(defvar ethio-numeric-reduction 0 + "*Degree of reduction in converting Ethiopic digits into Arabic digits. +Should be 0, 1 or 2. +For example, ({10}{9}{100}{80}{7}) is converted into: + `10`9`100`80`7 if `ethio-numeric-reduction' is 0, + `109100807 if `ethio-numeric-reduction' is 1, + `10900807 if `ethio-numeric-reduction' is 2.") + +(defvar ethio-implicit-period-conversion t + "*Non-nil means replacing the Ethiopic dot at the end of an Ethiopic sentence +with an Ethiopic full stop.") + +(defvar ethio-java-save-lowercase nil + "*Non-nil means save Ethiopic characters in lowercase hex numbers to Java files. +If nil, use uppercases.") + +;; +;; SERA to FIDEL +;; + +(defconst ethio-sera-to-fidel-table + [ + nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil + nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil +;;; SP + (" " + (?: (if ethio-use-colon-for-colon " $(3$l(B" "$(3$h(B") + (32 (if ethio-use-colon-for-colon " $(3$l(B " "$(3$h(B")) + (?- " $(3$m(B") + (?: " $(3$i(B") + (?| (if ethio-use-colon-for-colon " $(3$l(B|" " $(3$h(B|") + (?: " $(3$o(B")))) + +;;; ! " # $ % & ' + nil nil nil nil nil nil ("" (?' "$(3%s(B")) +;;; ( ) * + , - . + nil nil nil nil ("$(3$j(B") ("-" (?: "$(3$l(B")) ("$(3%u(B") +;;; / 0 1 2 3 4 5 6 7 8 9 + nil nil nil nil nil nil nil nil nil nil nil +;;; : + ((if ethio-use-colon-for-colon "$(3$l(B" "$(3$h(B") + (32 (if ethio-use-colon-for-colon "$(3$l(B " "$(3$h(B")) + (?- "$(3$m(B") + (?: "$(3$i(B") + (?| (if ethio-use-colon-for-colon "$(3$l(B|" "$(3$h(B|") + (?: "$(3$o(B"))) +;;; ; < = > + ("$(3$k(B") ("<" (?< "$(3%v(B")) nil (">" (?> "$(3%w(B")) +;;; ? + ((if ethio-use-three-dot-question "$(3$n(B" "$(3%x(B")) +;;; @ + nil +;;; A + ("$(3"f(B" (?2 "$(3#8(B")) +;;; B + ("$(3"((B" (?e "$(3"#(B") (?u "$(3"$(B") (?i "$(3"%(B") (?a "$(3"&(B") (?E "$(3"'(B") (?o "$(3")(B") + (?W "$(3%b(B" (?e "$(3%2(B") (?u "$(3%b(B") (?i "$(3%B(B") (?a "$(3"*(B") (?E "$(3%R(B"))) +;;; C + ("$(3$4(B" (?e "$(3$/(B") (?u "$(3$0(B") (?i "$(3$1(B") (?a "$(3$2(B") (?E "$(3$3(B") (?o "$(3$5(B") + (?W "$(3$6(B" (?a "$(3$6(B") + (?e "$(3$4%n(B") (?u "$(3$4%r(B") (?i "$(3$4%o(B") (?E "$(3$4%q(B"))) +;;; D + ("$(3#b(B" (?e "$(3#](B") (?u "$(3#^(B") (?i "$(3#_(B") (?a "$(3#`(B") (?E "$(3#a(B") (?o "$(3#c(B") + (?W "$(3#d(B" (?a "$(3#d(B") + (?e "$(3#b%n(B") (?u "$(3#b%r(B") (?i "$(3#b%o(B") (?E "$(3#b%q(B"))) +;;; E + ("$(3"g(B" (?2 "$(3#9(B")) +;;; F + ("$(3$T(B" (?e "$(3$O(B") (?u "$(3$P(B") (?i "$(3$Q(B") (?a "$(3$R(B") (?E "$(3$S(B") (?o "$(3$U(B") + (?W "$(3%d(B" (?e "$(3%4(B") (?u "$(3%d(B") (?i "$(3%D(B") (?a "$(3$V(B") (?E "$(3%T(B")) + (?Y "$(3$a(B" (?a "$(3$a(B"))) +;;; G + ("$(3$$(B" (?e "$(3#}(B") (?u "$(3#~(B") (?i "$(3$!(B") (?a "$(3$"(B") (?E "$(3$#(B") (?o "$(3$%(B") + (?W "$(3%c(B" (?e "$(3%3(B") (?u "$(3%c(B") (?i "$(3%C(B") (?a "$(3$&(B") (?E "$(3%S(B"))) +;;; H + ("$(3!6(B" (?e "$(3!1(B") (?u "$(3!2(B") (?i "$(3!3(B") (?a "$(3!4(B") (?E "$(3!5(B") (?o "$(3!7(B") + (?W "$(3!8(B" (?a "$(3!8(B") + (?e "$(3!6%n(B") (?u "$(3!6%r(B") (?i "$(3!6%o(B") (?E "$(3!6%q(B"))) +;;; I + ("$(3"h(B" (?2 "$(3#:(B")) +;;; J + ("$(3#j(B" (?e "$(3#e(B") (?u "$(3#f(B") (?i "$(3#g(B") (?a "$(3#h(B") (?E "$(3#i(B") (?o "$(3#k(B") + (?W "$(3#l(B" (?a "$(3#l(B") + (?e "$(3#j%n(B") (?u "$(3#j%r(B") (?i "$(3#j%o(B") (?E "$(3#j%q(B"))) +;;; K + ("$(3#"(B" (?e "$(3"{(B") (?u "$(3"|(B") (?i "$(3"}(B") (?a "$(3"~(B") (?E "$(3#!(B") (?o "$(3##(B") + (?W "$(3#*(B" (?e "$(3#%(B") (?u "$(3#*(B") (?i "$(3#'(B") (?a "$(3#((B") (?E "$(3#)(B"))) +;;; L + ("$(3!.(B" (?e "$(3!)(B") (?u "$(3!*(B") (?i "$(3!+(B") (?a "$(3!,(B") (?E "$(3!-(B") (?o "$(3!/(B") + (?W "$(3!0(B" (?a "$(3!0(B") + (?e "$(3!.%n(B") (?u "$(3!.%r(B") (?i "$(3!.%o(B") (?E "$(3!.%q(B"))) +;;; M + ("$(3!>(B" (?e "$(3!9(B") (?u "$(3!:(B") (?i "$(3!;(B") (?a "$(3!<(B") (?E "$(3!=(B") (?o "$(3!?(B") + (?W "$(3%a(B" (?e "$(3%1(B") (?u "$(3%a(B") (?i "$(3%A(B") (?a "$(3!@(B") (?E "$(3%Q(B")) + (?Y "$(3$_(B" (?a "$(3$_(B"))) +;;; N + ("$(3"`(B" (?e "$(3"[(B") (?u "$(3"\(B") (?i "$(3"](B") (?a "$(3"^(B") (?E "$(3"_(B") (?o "$(3"a(B") + (?W "$(3"b(B" (?a "$(3"b(B") + (?e "$(3"`%n(B") (?u "$(3"`%r(B") (?i "$(3"`%o(B") (?E "$(3"`%q(B"))) +;;; O + ("$(3"i(B" (?2 "$(3#;(B")) +;;; P + ("$(3$<(B" (?e "$(3$7(B") (?u "$(3$8(B") (?i "$(3$9(B") (?a "$(3$:(B") (?E "$(3$;(B") (?o "$(3$=(B") + (?W "$(3$>(B" (?a "$(3$>(B") + (?e "$(3$<%n(B") (?u "$(3$<%r(B") (?i "$(3$<%o(B") (?E "$(3$<%q(B"))) +;;; Q + ("$(3!v(B" (?e "$(3!q(B") (?u "$(3!r(B") (?i "$(3!s(B") (?a "$(3!t(B") (?E "$(3!u(B") (?o "$(3!w(B") + (?W "$(3!~(B" (?e "$(3!y(B") (?u "$(3!~(B") (?i "$(3!{(B") (?a "$(3!|(B") (?E "$(3!}(B"))) +;;; R + ("$(3!N(B" (?e "$(3!I(B") (?u "$(3!J(B") (?i "$(3!K(B") (?a "$(3!L(B") (?E "$(3!M(B") (?o "$(3!O(B") + (?W "$(3!P(B" (?a "$(3!P(B") + (?e "$(3!N%n(B") (?u "$(3!N%r(B") (?i "$(3!N%o(B") (?E "$(3!N%q(B")) + (?Y "$(3$`(B" (?a "$(3$`(B"))) +;;; S + ("$(3$D(B" (?e "$(3$?(B") (?u "$(3$@(B") (?i "$(3$A(B") (?a "$(3$B(B") (?E "$(3$C(B") (?o "$(3$E(B") + (?W "$(3$F(B" (?a "$(3$F(B") + (?e "$(3$D%n(B") (?u "$(3$D%r(B") (?i "$(3$D%o(B") (?E "$(3$D%q(B")) + (?2 "$(3$L(B" + (?e "$(3$G(B") (?u "$(3$H(B") (?i "$(3$I(B") (?a "$(3$J(B") (?E "$(3$K(B") (?o "$(3$M(B") + (?W "$(3$F(B" (?a "$(3$F(B") + (?e "$(3$L%n(B") (?u "$(3$L%r(B") (?i "$(3$L%o(B") (?E "$(3$L%q(B")))) +;;; T + ("$(3$,(B" (?e "$(3$'(B") (?u "$(3$((B") (?i "$(3$)(B") (?a "$(3$*(B") (?E "$(3$+(B") (?o "$(3$-(B") + (?W "$(3$.(B" (?a "$(3$.(B") + (?e "$(3$,%n(B") (?u "$(3$,%r(B") (?i "$(3$,%o(B") (?E "$(3$,%q(B"))) +;;; U + ("$(3"d(B" (?2 "$(3#6(B")) +;;; V + ("$(3"0(B" (?e "$(3"+(B") (?u "$(3",(B") (?i "$(3"-(B") (?a "$(3".(B") (?E "$(3"/(B") (?o "$(3"1(B") + (?W "$(3"2(B" (?a "$(3"2(B") + (?e "$(3"0%n(B") (?u "$(3"0%r(B") (?i "$(3"0%o(B") (?E "$(3"0%q(B"))) +;;; W + ("$(3%r(B" (?e "$(3%n(B") (?u "$(3%r(B") (?i "$(3%o(B") (?a "$(3%p(B") (?E "$(3%q(B")) +;;; X + ("$(3%N(B" (?e "$(3%I(B") (?u "$(3%J(B") (?i "$(3%K(B") (?a "$(3%L(B") (?E "$(3%M(B") (?o "$(3%O(B")) +;;; Y + ("$(3#R(B" (?e "$(3#M(B") (?u "$(3#N(B") (?i "$(3#O(B") (?a "$(3#P(B") (?E "$(3#Q(B") (?o "$(3#S(B") + (?W "$(3#T(B" (?a "$(3#T(B") + (?e "$(3#R%n(B") (?u "$(3#R%r(B") (?i "$(3#R%o(B") (?E "$(3#R%q(B"))) +;;; Z + ("$(3#J(B" (?e "$(3#E(B") (?u "$(3#F(B") (?i "$(3#G(B") (?a "$(3#H(B") (?E "$(3#I(B") (?o "$(3#K(B") + (?W "$(3#L(B" (?a "$(3#L(B") + (?e "$(3#J%n(B") (?u "$(3#J%r(B") (?i "$(3#J%o(B") (?E "$(3#J%q(B"))) +;;; [ \ ] ^ _ + nil nil nil nil nil +;;; ` + ("" + (?: "$(3$h(B") + (?? (if ethio-use-three-dot-question "$(3%x(B" "$(3$n(B")) + (?! "$(3%t(B") + (?e "$(3#5(B") (?u "$(3#6(B") (?U "$(3#6(B") (?i "$(3#7(B") (?a "$(3#8(B") (?A "$(3#8(B") + (?E "$(3#9(B") (?I "$(3#:(B") (?o "$(3#;(B") (?O "$(3#;(B") + (?g "$(3%^(B" + (?e "$(3%Y(B") (?u "$(3%Z(B") (?i "$(3%[(B") (?a "$(3%\(B") (?E "$(3%](B") (?o "$(3%_(B")) + (?h "$(3"H(B" + (?e "$(3"C(B") (?u "$(3"D(B") (?i "$(3"E(B") (?a "$(3"F(B") (?E "$(3"G(B") (?o "$(3"I(B") + (?W "$(3"P(B" (?e "$(3"K(B") (?u "$(3"P(B") (?i "$(3"M(B") (?a "$(3"N(B") (?E "$(3"O(B"))) + (?k "$(3%>(B" + (?e "$(3%9(B") (?u "$(3%:(B") (?i "$(3%;(B") (?a "$(3%<(B") (?E "$(3%=(B") (?o "$(3%?(B")) + (?s "$(3!F(B" + (?e "$(3!A(B") (?u "$(3!B(B") (?i "$(3!C(B") (?a "$(3!D(B") (?E "$(3!E(B") (?o "$(3!G(B") + (?W "$(3!H(B" (?a "$(3!H(B") + (?e "$(3!F%n(B") (?u "$(3!F%r(B") (?i "$(3!F%o(B") (?E "$(3!F%q(B"))) + (?S "$(3$L(B" + (?e "$(3$G(B") (?u "$(3$H(B") (?i "$(3$I(B") (?a "$(3$J(B") (?E "$(3$K(B") (?o "$(3$M(B") + (?W "$(3$F(B" (?a "$(3$F(B") + (?e "$(3$L%n(B") (?u "$(3$L%r(B") (?i "$(3$L%o(B") (?E "$(3$L%q(B"))) + (?q "$(3%.(B" (?e "$(3%)(B") (?u "$(3%*(B") (?i "$(3%+(B") (?a "$(3%,(B") (?E "$(3%-(B") (?o "$(3%/(B"))) +;;; a + ("$(3"f(B" (?2 "$(3#8(B")) +;;; b + ("$(3"((B" (?e "$(3"#(B") (?u "$(3"$(B") (?i "$(3"%(B") (?a "$(3"&(B") (?E "$(3"'(B") (?o "$(3")(B") + (?W "$(3%b(B" (?e "$(3%2(B") (?u "$(3%b(B") (?i "$(3%B(B") (?a "$(3"*(B") (?E "$(3%R(B"))) +;;; c + ("$(3"@(B" (?e "$(3";(B") (?u "$(3"<(B") (?i "$(3"=(B") (?a "$(3">(B") (?E "$(3"?(B") (?o "$(3"A(B") + (?W "$(3"B(B" (?a "$(3"B(B") + (?e "$(3"@%n(B") (?u "$(3"@%r(B") (?i "$(3"@%o(B") (?E "$(3"@%q(B"))) +;;; d + ("$(3#Z(B" (?e "$(3#U(B") (?u "$(3#V(B") (?i "$(3#W(B") (?a "$(3#X(B") (?E "$(3#Y(B") (?o "$(3#[(B") + (?W "$(3#\(B" (?a "$(3#\(B") + (?e "$(3#Z%o(B") (?u "$(3#Z%r(B") (?i "$(3#Z%p(B") (?E "$(3#Z%q(B"))) +;;; e + ("$(3"c(B" (?2 "$(3#5(B") (?a "$(3"j(B")) +;;; f + ("$(3$T(B" (?e "$(3$O(B") (?u "$(3$P(B") (?i "$(3$Q(B") (?a "$(3$R(B") (?E "$(3$S(B") (?o "$(3$U(B") + (?W "$(3%d(B" (?e "$(3%4(B") (?u "$(3%d(B") (?i "$(3%D(B") (?a "$(3$V(B") (?E "$(3%T(B")) + (?Y "$(3$a(B" (?a "$(3$a(B"))) +;;; g + ("$(3#r(B" (?e "$(3#m(B") (?u "$(3#n(B") (?i "$(3#o(B") (?a "$(3#p(B") (?E "$(3#q(B") (?o "$(3#s(B") + (?W "$(3#z(B" (?e "$(3#u(B") (?u "$(3#z(B") (?i "$(3#w(B") (?a "$(3#x(B") (?E "$(3#y(B")) + (?2 "$(3%^(B" (?e "$(3%Y(B") (?u "$(3%Z(B") (?i "$(3%[(B") (?a "$(3%\(B") (?E "$(3%](B") (?o "$(3%_(B"))) +;;; h + ("$(3!&(B" (?e "$(3!!(B") (?u "$(3!"(B") (?i "$(3!#(B") (?a "$(3!$(B") (?E "$(3!%(B") (?o "$(3!'(B") + (?W "$(3"P(B" (?e "$(3"K(B") (?u "$(3"P(B") (?i "$(3"M(B") (?a "$(3"N(B") (?E "$(3"O(B")) + (?2 "$(3"H(B" (?e "$(3"C(B") (?u "$(3"D(B") (?i "$(3"E(B") (?a "$(3"F(B") (?E "$(3"G(B") (?o "$(3"I(B") + (?W "$(3"P(B" (?e "$(3"K(B") (?u "$(3"P(B") (?i "$(3"M(B") (?a "$(3"N(B") (?E "$(3"O(B")))) +;;; i + ("$(3"e(B" (?2 "$(3#7(B")) +;;; j + ("$(3#j(B" (?e "$(3#e(B") (?u "$(3#f(B") (?i "$(3#g(B") (?a "$(3#h(B") (?E "$(3#i(B") (?o "$(3#k(B") + (?W "$(3#l(B" (?a "$(3#l(B") + (?e "$(3#j%n(B") (?u "$(3#j%r(B") (?i "$(3#j%o(B") (?E "$(3#j%q(B"))) +;;; k + ("$(3"p(B" (?e "$(3"k(B") (?u "$(3"l(B") (?i "$(3"m(B") (?a "$(3"n(B") (?E "$(3"o(B") (?o "$(3"q(B") + (?W "$(3"x(B" (?e "$(3"s(B") (?u "$(3"x(B") (?i "$(3"u(B") (?a "$(3"v(B") (?E "$(3"w(B")) + (?2 "$(3%>(B" (?e "$(3%9(B") (?u "$(3%:(B") (?i "$(3%;(B") (?a "$(3%<(B") (?E "$(3%=(B") (?o "$(3%?(B"))) +;;; l + ("$(3!.(B" (?e "$(3!)(B") (?u "$(3!*(B") (?i "$(3!+(B") (?a "$(3!,(B") (?E "$(3!-(B") (?o "$(3!/(B") + (?W "$(3!0(B" (?a "$(3!0(B") + (?e "$(3!.%n(B") (?u "$(3!.%r(B") (?i "$(3!.%o(B") (?E "$(3!.%q(B"))) +;;; m + ("$(3!>(B" (?e "$(3!9(B") (?u "$(3!:(B") (?i "$(3!;(B") (?a "$(3!<(B") (?E "$(3!=(B") (?o "$(3!?(B") + (?W "$(3%a(B" (?e "$(3%1(B") (?u "$(3%a(B") (?i "$(3%A(B") (?a "$(3!@(B") (?E "$(3%Q(B")) + (?Y "$(3$_(B" (?a "$(3$_(B"))) +;;; n + ("$(3"X(B" (?e "$(3"S(B") (?u "$(3"T(B") (?i "$(3"U(B") (?a "$(3"V(B") (?E "$(3"W(B") (?o "$(3"Y(B") + (?W "$(3"Z(B" (?a "$(3"Z(B") + (?e "$(3"X%n(B") (?u "$(3"X%r(B") (?i "$(3"X%o(B") (?E "$(3"X%q(B"))) +;;; o + ("$(3"i(B" (?2 "$(3#;(B")) +;;; p + ("$(3$\(B" (?e "$(3$W(B") (?u "$(3$X(B") (?i "$(3$Y(B") (?a "$(3$Z(B") (?E "$(3$[(B") (?o "$(3$](B") + (?W "$(3%e(B" (?e "$(3%5(B") (?u "$(3%e(B") (?i "$(3%E(B") (?a "$(3$^(B") (?E "$(3%U(B"))) +;;; q + ("$(3!f(B" (?e "$(3!a(B") (?u "$(3!b(B") (?i "$(3!c(B") (?a "$(3!d(B") (?E "$(3!e(B") (?o "$(3!g(B") + (?W "$(3!n(B" (?e "$(3!i(B") (?u "$(3!n(B") (?i "$(3!k(B") (?a "$(3!l(B") (?E "$(3!m(B")) + (?2 "$(3%.(B" (?e "$(3%)(B") (?u "$(3%*(B") (?i "$(3%+(B") (?a "$(3%,(B") (?E "$(3%-(B") (?o "$(3%/(B"))) +;;; r + ("$(3!N(B" (?e "$(3!I(B") (?u "$(3!J(B") (?i "$(3!K(B") (?a "$(3!L(B") (?E "$(3!M(B") (?o "$(3!O(B") + (?W "$(3!P(B" (?a "$(3!P(B") + (?e "$(3!N%n(B") (?u "$(3!N%r(B") (?i "$(3!N%o(B") (?E "$(3!N%q(B")) + (?Y "$(3$`(B" (?a "$(3$`(B"))) +;;; s + ("$(3!V(B" (?e "$(3!Q(B") (?u "$(3!R(B") (?i "$(3!S(B") (?a "$(3!T(B") (?E "$(3!U(B") (?o "$(3!W(B") + (?W "$(3!X(B" (?a "$(3!X(B") + (?e "$(3!V%n(B") (?u "$(3!V%r(B") (?i "$(3!V%o(B") (?E "$(3!V%q(B")) + (?2 "$(3!F(B" (?e "$(3!A(B") (?u "$(3!B(B") (?i "$(3!C(B") (?a "$(3!D(B") (?E "$(3!E(B") (?o "$(3!G(B") + (?W "$(3!H(B" (?a "$(3!H(B") + (?e "$(3!F%n(B") (?u "$(3!F%r(B") (?i "$(3!F%o(B") (?E "$(3!F%q(B")))) +;;; t + ("$(3"8(B" (?e "$(3"3(B") (?u "$(3"4(B") (?i "$(3"5(B") (?a "$(3"6(B") (?E "$(3"7(B") (?o "$(3"9(B") + (?W "$(3":(B" (?a "$(3":(B") + (?e "$(3"8%n(B") (?u "$(3"8%r(B") (?i "$(3"8%o(B") (?E "$(3"8%q(B"))) +;;; u + ("$(3"d(B" (?2 "$(3#6(B")) +;;; v + ("$(3"0(B" (?e "$(3"+(B") (?u "$(3",(B") (?i "$(3"-(B") (?a "$(3".(B") (?E "$(3"/(B") (?o "$(3"1(B") + (?W "$(3"2(B" (?a "$(3"2(B") + (?e "$(3"0%n(B") (?u "$(3"0%r(B") (?i "$(3"0%o(B") (?E "$(3"0%q(B"))) +;;; w + ("$(3#2(B" (?e "$(3#-(B") (?u "$(3#.(B") (?i "$(3#/(B") (?a "$(3#0(B") (?E "$(3#1(B") (?o "$(3#3(B") + (?W "$(3%p(B" (?e "$(3%n(B") (?u "$(3%r(B") (?i "$(3%o(B") (?a "$(3%p(B") (?E "$(3%q(B"))) +;;; x + ("$(3!^(B" (?e "$(3!Y(B") (?u "$(3!Z(B") (?i "$(3![(B") (?a "$(3!\(B") (?E "$(3!](B") (?o "$(3!_(B") + (?W "$(3!`(B" (?a "$(3!`(B") + (?e "$(3!^%n(B") (?u "$(3!^%r(B") (?i "$(3!^%o(B") (?E "$(3!^%q(B"))) +;;; y + ("$(3#R(B" (?e "$(3#M(B") (?u "$(3#N(B") (?i "$(3#O(B") (?a "$(3#P(B") (?E "$(3#Q(B") (?o "$(3#S(B") + (?W "$(3#T(B" (?a "$(3#T(B") + (?e "$(3#R%n(B") (?u "$(3#R%r(B") (?i "$(3#R%o(B") (?E "$(3#R%q(B"))) +;;; z + ("$(3#B(B" (?e "$(3#=(B") (?u "$(3#>(B") (?i "$(3#?(B") (?a "$(3#@(B") (?E "$(3#A(B") (?o "$(3#C(B") + (?W "$(3#D(B" (?a "$(3#D(B") + (?e "$(3#B%n(B") (?u "$(3#B%r(B") (?i "$(3#B%o(B") (?E "$(3#B%q(B"))) +;;; { | } ~ DEL + nil nil nil nil nil + ]) + +;;;###autoload +(defun ethio-sera-to-fidel-region (beg end &optional secondary force) + "Convert the characters in region from SERA to FIDEL. +The variable `ethio-primary-language' specifies the primary language +and `ethio-secondary-language' specifies the secondary. + +If the 3rd parameter SECONDARY is given and non-nil, assume the region +begins begins with the secondary language; otherwise with the primary +language. + +If the 4th parameter FORCE is given and non-nil, perform conversion +even if the buffer is read-only. + +See also the descriptions of the variables +`ethio-use-colen-for-colon' and +`ethio-use-three-dot-question'." + + (interactive "r\nP") + (save-restriction + (narrow-to-region beg end) + (ethio-sera-to-fidel-buffer secondary force))) + +;;;###autoload +(defun ethio-sera-to-fidel-buffer (&optional secondary force) + "Convert the current buffer from SERA to FIDEL. + +The variable `ethio-primary-language' specifies the primary +language and `ethio-secondary-language' specifies the secondary. + +If the 1st optional parameter SECONDARY is non-nil, assume the buffer +begins with the secondary language; otherwise with the primary +language. + +If the 2nd optional parametr FORCE is non-nil, perform conversion even if the +buffer is read-only. + +See also the descriptions of the variables +`ethio-use-colen-for-colon' and +`ethio-use-three-dot-question'." + + (interactive "P") + + (if (and buffer-read-only + (not force) + (not (y-or-n-p "Buffer is read-only. Force to convert? "))) + (error "")) + + (let ((ethio-primary-language ethio-primary-language) + (ethio-secondary-language ethio-secondary-language) + (ethio-use-colon-for-colon ethio-use-colon-for-colon) + (ethio-use-three-dot-question ethio-use-three-dot-question) + ;; The above four variables may be changed temporary + ;; by tilde escapes during conversion. So we bind them to other + ;; variables but of the same names. + (buffer-read-only nil) + (case-fold-search nil) + current-language + next-language) + + (setq current-language + (if secondary + ethio-secondary-language + ethio-primary-language)) + + (goto-char (point-min)) + + (while (not (eobp)) + (setq next-language + (cond + ((eq current-language 'english) + (ethio-sera-to-fidel-english)) + ((eq current-language 'amharic) + (ethio-sera-to-fidel-ethio 'amharic)) + ((eq current-language 'tigrigna) + (ethio-sera-to-fidel-ethio 'tigrigna)) + (t ; we don't know what to do + (ethio-sera-to-fidel-english)))) + + (setq current-language + (cond + + ;; when language tag is explicitly specified + ((not (eq next-language 'toggle)) + next-language) + + ;; found a toggle in a primary language section + ((eq current-language ethio-primary-language) + ethio-secondary-language) + + ;; found a toggle in a secondary, third, fourth, ... + ;; language section + (t + ethio-primary-language)))) + + ;; If ethio-implicit-period-conversion is non-nil, the + ;; Ethiopic dot "$(3%u(B" at the end of an Ethiopic sentence is + ;; replaced with the Ethiopic full stop "$(3$i(B". + (if ethio-implicit-period-conversion + (progn + (goto-char (point-min)) + (while (re-search-forward "\\([$(3!!(B-$(3$a%)(B-$(3%e%n(B-$(3%r%s(B]\\)$(3%u(B\\([ \t]\\)" + nil t) + (replace-match "\\1$(3$i(B\\2")) + (goto-char (point-min)) + (while (re-search-forward "\\([$(3!!(B-$(3$a%)(B-$(3%e%n(B-$(3%r%s(B]\\)$(3%u(B$" nil t) + (replace-match "\\1$(3$i(B")))) + + ;; gemination + (goto-char (point-min)) + (while (re-search-forward "\\ce$(3%s(B" nil 0) + (compose-region + (save-excursion (backward-char 2) (point)) + (point))) + )) + +(defun ethio-sera-to-fidel-english nil + "Handle English section in SERA to FIDEL conversion. +Conversion stops when a language switch is found. Then delete that +switch and return the name of the new language as a symbol." + (let ((new-language nil)) + + (while (and (not (eobp)) (null new-language)) + (cond + + ;; if no more "\", nothing to do. + ((not (search-forward "\\" nil 0))) + + ;; hereafter point is put after a "\". + ;; first delete that "\", then check the following chars + + ;; "\\" : leave the second "\" + ((progn + (delete-backward-char 1) + (= (following-char) ?\\ )) + (forward-char 1)) + + ;; "\ " : delete the following " " + ((= (following-char) 32) + (delete-char 1) + (setq new-language 'toggle)) + + ;; a language flag + ((setq new-language (ethio-process-language-flag))) + + ;; just a "\" : not special sequence. + (t + (setq new-language 'toggle)))) + + new-language)) + +(defun ethio-sera-to-fidel-ethio (lang) + "Handle Ethiopic section in SERA to FIDEL conversion. +Conversion stops when a language switch is found. Then delete that +switch and return the name of the new language as a symbol. + +The parameter LANG (symbol, either `amharic' or `tigrigna') affects +the conversion of \"a\"." + + (let ((new-language nil) + (verbatim nil) + start table table2 ch) + + (setcar (aref ethio-sera-to-fidel-table ?a) + (if (eq lang 'tigrigna) "$(3"f(B" "$(3"c(B")) + + (while (and (not (eobp)) (null new-language)) + (setq ch (following-char)) + (cond + + ;; skip from "<" to ">" (or from "&" to ";") if in w3-mode + ((and (boundp 'sera-being-called-by-w3) + sera-being-called-by-w3 + (or (= ch ?<) (= ch ?&))) + (search-forward (if (= ch ?<) ">" ";") + nil 0)) + + ;; leave non-ASCII characters as they are + ((>= ch 128) + (forward-char 1)) + + ;; ethiopic digits + ((looking-at "`[1-9][0-9]*") + (delete-char 1) + (ethio-convert-digit)) + + ;; if not seeing a "\", do sera to fidel conversion + ((/= ch ?\\ ) + (setq start (point)) + (forward-char 1) + (setq table (aref ethio-sera-to-fidel-table ch)) + (while (setq table2 (cdr (assoc (following-char) table))) + (setq table table2) + (forward-char 1)) + (if (setq ch (car table)) + (progn + (delete-region start (point)) + (if (stringp ch) + (insert ch) + (insert (eval ch)))))) + + ;; if control reaches here, we must be looking at a "\" + + ;; verbatim mode + (verbatim + (if (looking-at "\\\\~! ?") + + ;; "\~!" or "\~! ". switch to non-verbatim mode + (progn + (replace-match "") + (setq verbatim nil)) + + ;; "\" but not "\~!" nor "\~! ". skip the current "\". + (forward-char 1))) + + ;; hereafter, non-verbatim mode and looking at a "\" + ;; first delete that "\", then check the following chars. + + ;; "\ " : delete the following " " + ((progn + (delete-char 1) + (setq ch (following-char)) + (= ch 32)) + (delete-char 1) + (setq new-language 'toggle)) + + ;; "\~!" or "\~! " : switch to verbatim mode + ((looking-at "~! ?") + (replace-match "") + (setq verbatim t)) + + ;; a language flag + ((setq new-language (ethio-process-language-flag))) + + ;; "\~" but not "\~!" nor a language flag + ((= ch ?~) + (delete-char 1) + (ethio-tilde-escape)) + + ;; ASCII punctuation escape. skip + ((looking-at "\\(,\\|\\.\\|;\\|:\\|'\\|`\\|\?\\|\\\\\\)+") + (goto-char (match-end 0))) + + ;; "\", but not special sequence + (t + (setq new-language 'toggle)))) + + new-language)) + +(defun ethio-process-language-flag nil + "Process a language flag of the form \"~lang\" or \"~lang1~lang2\". + +If looking at \"~lang1~lang2\", set `ethio-primary-language' and +`ethio-une-secondary-language' based on \"lang1\" and \"lang2\". +Then delete the language flag \"~lang1~lang2\" from the buffer. +Return value is the new primary language. + +If looking at \"~lang\", delete that language flag \"~lang\" from the +buffer and return that language. In this case +`ethio-primary-language' and `ethio-uni-secondary-language' +are left unchanged. + +If an unsupported language flag is found, just return nil without +changing anything." + + (let (lang1 lang2) + (cond + + ;; ~lang1~lang2 + ((and (looking-at + "~\\([a-z][a-z][a-z]?\\)~\\([a-z][a-z][a-z]?\\)[ \t\n\\]") + (setq lang1 + (ethio-flag-to-language + (buffer-substring (match-beginning 1) (match-end 1)))) + (setq lang2 + (ethio-flag-to-language + (buffer-substring (match-beginning 2) (match-end 2))))) + (setq ethio-primary-language lang1 + ethio-secondary-language lang2) + (delete-region (point) (match-end 2)) + (if (= (following-char) 32) + (delete-char 1)) + ethio-primary-language) + + ;; ~lang + ((and (looking-at "~\\([a-z][a-z][a-z]?\\)[ \t\n\\]") + (setq lang1 + (ethio-flag-to-language + (buffer-substring (match-beginning 1) (match-end 1))))) + (delete-region (point) (match-end 1)) + (if (= (following-char) 32) + (delete-char 1)) + lang1) + + ;; otherwise + (t + nil)))) + +(defun ethio-tilde-escape nil + "Handle a SERA tilde escape in Ethiopic section and delete it. +Delete the escape even it is not recognised." + + (let ((p (point)) command) + (skip-chars-forward "^ \t\n\\\\") + (setq command (buffer-substring p (point))) + (delete-region p (point)) + (if (= (following-char) 32) + (delete-char 1)) + + (cond + + ;; \~-: + ((string= command "-:") + (setq ethio-use-colon-for-colon t)) + + ;; \~`: + ((string= command "`:") + (setq ethio-use-colon-for-colon nil)) + + ;; \~? + ((string= command "?") + (setq ethio-use-three-dot-question nil)) + + ;; \~`| + ((string= command "`|") + (setq ethio-use-three-dot-question t)) + + ;; \~e + ((string= command "e") + (insert "$(3%j(B")) + + ;; \~E + ((string= command "E") + (insert "$(3%k(B")) + + ;; \~a + ((string= command "a") + (insert "$(3%l(B")) + + ;; \~A + ((string= command "A") + (insert "$(3%m(B")) + + ;; \~X + ((string= command "X") + (insert "$(3%i(B")) + + ;; unsupported tilde escape + (t + nil)))) + +(defun ethio-flag-to-language (flag) + (cond + ((or (string= flag "en") (string= flag "eng")) 'english) + ((or (string= flag "ti") (string= flag "tir")) 'tigrigna) + ((or (string= flag "am") (string= flag "amh")) 'amharic) + (t nil))) + +(defun ethio-convert-digit nil + "Convert Arabic digits to Ethiopic digits." + (let (ch z) + (while (and (>= (setq ch (following-char)) ?1) + (<= ch ?9)) + (delete-char 1) + + ;; count up following zeros + (setq z 0) + (while (= (following-char) ?0) + (delete-char 1) + (setq z (1+ z))) + + (cond + + ;; first digit is 10, 20, ..., or 90 + ((= (mod z 2) 1) + (insert (aref [?$(3$y(B ?$(3$z(B ?$(3${(B ?$(3$|(B ?$(3$}(B ?$(3$~(B ?$(3%!(B ?$(3%"(B ?$(3%#(B] (- ch ?1))) + (setq z (1- z))) + + ;; first digit is 2, 3, ..., or 9 + ((/= ch ?1) + (insert (aref [?$(3$q(B ?$(3$r(B ?$(3$s(B ?$(3$t(B ?$(3$u(B ?$(3$v(B ?$(3$w(B ?$(3$x(B] (- ch ?2)))) + + ;; single 1 + ((= z 0) + (insert "$(3$p(B"))) + + ;; 100 + (if (= (mod z 4) 2) + (insert "$(3%$(B")) + + ;; 10000 + (insert-char ?$(3%%(B (/ z 4))))) + +;;;###autoload +(defun ethio-sera-to-fidel-mail (&optional arg) + "Convert SERA to FIDEL to read/write mail and news. + +If the buffer contains the markers \"<sera>\" and \"</sera>\", +convert the segments between them into FIDEL. + +If invoked interactively and there is no marker, convert the subject field +and the body into FIDEL using `ethio-sera-to-fidel-region'." + + (interactive "p") + (let ((buffer-read-only nil) + border) + (save-excursion + + ;; look for the header-body separator + (goto-char (point-min)) + (if (search-forward + (if (eq major-mode 'rmail-mode) + "\n\n" (concat "\n" mail-header-separator "\n")) + nil t) + (setq border (point)) + (error "header separator not found")) + + ;; note that the point is placed at the border + (if (or (re-search-forward "^<sera>$" nil t) + (progn + (goto-char (point-min)) + (re-search-forward "^Subject: <sera>" border t))) + + ;; there are markers + (progn + ;; we start with the body so that the border will not change + ;; use "^<sera>\n" instead of "^<sera>$" not to leave a blank line + (goto-char border) + (while (re-search-forward "^<sera>\n" nil t) + (replace-match "") + (ethio-sera-to-fidel-region + (point) + (progn + (if (re-search-forward "^</sera>\n" nil 0) + (replace-match "")) + (point)))) + ;; now process the subject + (goto-char (point-min)) + (if (re-search-forward "^Subject: <sera>" border t) + (ethio-sera-to-fidel-region + (progn (delete-backward-char 6) (point)) + (progn + (if (re-search-forward "</sera>$" (line-end-position) 0) + (replace-match "")) + (point))))) + + ;; in case there are no marks but invoked interactively + (if arg + (progn + (ethio-sera-to-fidel-region border (point-max)) + (goto-char (point-min)) + (if (re-search-forward "^Subject: " border t) + (ethio-sera-to-fidel-region (point) (line-end-position)))))) + + ;; adjust the rmail marker + (if (eq major-mode 'rmail-mode) + (set-marker + (aref rmail-message-vector (1+ rmail-current-message)) + (point-max)))))) + +;;;###autoload +(defun ethio-sera-to-fidel-marker (&optional force) + "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." + (interactive "P") + (if (and buffer-read-only + (not force) + (not (y-or-n-p "Buffer is read-only. Force to convert? "))) + (error "")) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "<sera>" nil t) + (ethio-sera-to-fidel-region + (point) + (if (re-search-forward "</sera>" nil t) + (match-beginning 0) + (point-max)) + nil + 'force)))) + +;; +;; FIDEL to SERA +;; + +(defconst ethio-fidel-to-sera-map + [ "he" "hu" "hi" "ha" "hE" "h" "ho" "" ;; 0 - 7 + "le" "lu" "li" "la" "lE" "l" "lo" "lWa" ;; 8 + "He" "Hu" "Hi" "Ha" "HE" "H" "Ho" "HWa" ;; 16 + "me" "mu" "mi" "ma" "mE" "m" "mo" "mWa" ;; 24 + "`se" "`su" "`si" "`sa" "`sE" "`s" "`so" "`sWa" ;; 32 + "re" "ru" "ri" "ra" "rE" "r" "ro" "rWa" ;; 40 + "se" "su" "si" "sa" "sE" "s" "so" "sWa" ;; 48 + "xe" "xu" "xi" "xa" "xE" "x" "xo" "xWa" ;; 56 + "qe" "qu" "qi" "qa" "qE" "q" "qo" "" ;; 64 + "qWe" "" "qWi" "qWa" "qWE" "qW'" "" "" ;; 72 + "Qe" "Qu" "Qi" "Qa" "QE" "Q" "Qo" "" ;; 80 + "QWe" "" "QWi" "QWa" "QWE" "QW'" "" "" ;; 88 + "be" "bu" "bi" "ba" "bE" "b" "bo" "bWa" ;; 96 + "ve" "vu" "vi" "va" "vE" "v" "vo" "vWa" ;; 104 + "te" "tu" "ti" "ta" "tE" "t" "to" "tWa" ;; 112 + "ce" "cu" "ci" "ca" "cE" "c" "co" "cWa" ;; 120 + "`he" "`hu" "`hi" "`ha" "`hE" "`h" "`ho" "" ;; 128 + "hWe" "" "hWi" "hWa" "hWE" "hW'" "" "" ;; 136 + "ne" "nu" "ni" "na" "nE" "n" "no" "nWa" ;; 144 + "Ne" "Nu" "Ni" "Na" "NE" "N" "No" "NWa" ;; 152 + "e" "u" "i" "A" "E" "I" "o" "ea" ;; 160 + "ke" "ku" "ki" "ka" "kE" "k" "ko" "" ;; 168 + "kWe" "" "kWi" "kWa" "kWE" "kW'" "" "" ;; 176 + "Ke" "Ku" "Ki" "Ka" "KE" "K" "Ko" "" ;; 184 + "KWe" "" "KWi" "KWa" "KWE" "KW'" "" "" ;; 192 + "we" "wu" "wi" "wa" "wE" "w" "wo" "" ;; 200 + "`e" "`u" "`i" "`a" "`E" "`I" "`o" "" ;; 208 + "ze" "zu" "zi" "za" "zE" "z" "zo" "zWa" ;; 216 + "Ze" "Zu" "Zi" "Za" "ZE" "Z" "Zo" "ZWa" ;; 224 + "ye" "yu" "yi" "ya" "yE" "y" "yo" "yWa" ;; 232 + "de" "du" "di" "da" "dE" "d" "do" "dWa" ;; 240 + "De" "Du" "Di" "Da" "DE" "D" "Do" "DWa" ;; 248 + "je" "ju" "ji" "ja" "jE" "j" "jo" "jWa" ;; 256 + "ge" "gu" "gi" "ga" "gE" "g" "go" "" ;; 264 + "gWe" "" "gWi" "gWa" "gWE" "gW'" "" "" ;; 272 + "Ge" "Gu" "Gi" "Ga" "GE" "G" "Go" "GWa" ;; 280 + "Te" "Tu" "Ti" "Ta" "TE" "T" "To" "TWa" ;; 288 + "Ce" "Cu" "Ci" "Ca" "CE" "C" "Co" "CWa" ;; 296 + "Pe" "Pu" "Pi" "Pa" "PE" "P" "Po" "PWa" ;; 304 + "Se" "Su" "Si" "Sa" "SE" "S" "So" "SWa" ;; 312 + "`Se" "`Su" "`Si" "`Sa" "`SE" "`S" "`So" "" ;; 320 + "fe" "fu" "fi" "fa" "fE" "f" "fo" "fWa" ;; 328 + "pe" "pu" "pi" "pa" "pE" "p" "po" "pWa" ;; 336 + "mYa" "rYa" "fYa" "" "" "" "" "" ;; 344 + " " " : " "::" "," ";" "-:" ":-" "`?" ;; 352 + ":|:" "1" "2" "3" "4" "5" "6" "7" ;; 360 + "8" "9" "10" "20" "30" "40" "50" "60" ;; 368 + "70" "80" "90" "100" "10000" "" "" "" ;; 376 + "`qe" "`qu" "`qi" "`qa" "`qE" "`q" "`qo" "" ;; 384 + "mWe" "bWe" "GWe" "fWe" "pWe" "" "" "" ;; 392 + "`ke" "`ku" "`ki" "`ka" "`kE" "`k" "`ko" "" ;; 400 + "mWi" "bWi" "GWi" "fWi" "pWi" "" "" "" ;; 408 + "Xe" "Xu" "Xi" "Xa" "XE" "X" "Xo" "" ;; 416 + "mWE" "bWE" "GWE" "fWE" "pWE" "" "" "" ;; 424 + "`ge" "`gu" "`gi" "`ga" "`gE" "`g" "`go" "" ;; 432 + "mW'" "bW'" "GW'" "fW'" "pW'" "" "" "" ;; 440 + "\\~X " "\\~e " "\\~E " "\\~a " "\\~A " "wWe" "wWi" "wWa" ;; 448 + "wWE" "wW'" "''" "`!" "." "<<" ">>" "?" ]) ;; 456 + +(defun ethio-prefer-amharic-p nil + (or (eq ethio-primary-language 'amharic) + (and (not (eq ethio-primary-language 'tigrigna)) + (eq ethio-secondary-language 'amharic)))) + +(defun ethio-language-to-flag (lang) + (cond + ((eq lang 'english) "eng") + ((eq lang 'tigrigna) "tir") + ((eq lang 'amharic) "amh") + (t ""))) + +;;;###autoload +(defun ethio-fidel-to-sera-region (begin end &optional secondary force) + "Replace all the FIDEL characters in the region to the SERA format. +The variable `ethio-primary-language' specifies the primary +language and `ethio-secondary-language' specifies the secondary. + +If the 3dr parameter SECONDARY is given and non-nil, try to convert +the region so that it begins in the secondary language; otherwise with +the primary language. + +If the 4th parameter FORCE is given and non-nil, convert even if the +buffer is read-only. + +See also the descriptions of the variables +`ethio-use-colen-for-colon', `ethio-use-three-dot-question', +`ethio-quote-vowel-always' and `ethio-numeric-reduction'." + + (interactive "r\nP") + (save-restriction + (narrow-to-region begin end) + (ethio-fidel-to-sera-buffer secondary force))) + +;;;###autoload +(defun ethio-fidel-to-sera-buffer (&optional secondary force) + "Replace all the FIDEL characters in the current buffer to the SERA format. +The variable `ethio-primary-language' specifies the primary +language and `ethio-secondary-language' specifies the secondary. + +If the 1st optional parameter SECONDARY is non-nil, try to convert the +region so that it begins in the secondary language; otherwise with the +primary language. + +If the 2nd optional parameter FORCE is non-nil, convert even if the +buffer is read-only. + +See also the descriptions of the variables +`ethio-use-colen-for-colon', `ethio-use-three-dot-question', +`ethio-quote-vowel-always' and `ethio-numeric-reduction'." + + (interactive "P") + (if (and buffer-read-only + (not force) + (not (y-or-n-p "Buffer is read-only. Force to convert? "))) + (error "")) + + (let ((buffer-read-only nil) + (case-fold-search nil) + (lonec nil) ;; t means previous char was a lone consonant + (fidel nil) ;; t means previous char was a FIDEL + (digit nil) ;; t means previous char was an Ethiopic digit + (flag (if (ethio-prefer-amharic-p) "\\~amh " "\\~tir ")) + mode ch) + + ;; user's preference in transcription + (if ethio-use-colon-for-colon + (progn + (aset ethio-fidel-to-sera-map 353 "`:") + (aset ethio-fidel-to-sera-map 357 ":")) + (aset ethio-fidel-to-sera-map 353 " : ") + (aset ethio-fidel-to-sera-map 357 "-:")) + + (if ethio-use-three-dot-question + (progn + (aset ethio-fidel-to-sera-map 359 "?") + (aset ethio-fidel-to-sera-map 463 "`?")) + (aset ethio-fidel-to-sera-map 359 "`?") + (aset ethio-fidel-to-sera-map 463 "?")) + + (mapcar + '(lambda (x) + (aset (aref ethio-fidel-to-sera-map x) + 2 + (if ethio-W-sixth-always ?' ?u))) + '(77 93 141 181 197 277 440 441 442 443 444 457)) + + (if (ethio-prefer-amharic-p) + (aset ethio-fidel-to-sera-map 160 "a") + (aset ethio-fidel-to-sera-map 160 "e")) + ;; end of user's preference + + ;; first, decompose geminated characters + (decompose-region (point-min) (point-max)) + + ;; main conversion routine + (goto-char (point-min)) + (while (not (eobp)) + (setq ch (following-char)) + + (cond ; ethiopic, english, neutral + + ;; ethiopic character. must go to ethiopic mode, if not in it. + ((eq (char-charset ch) 'ethiopic) + (setq ch (ethio-char-to-ethiocode ch)) + (delete-char 1) + (if (not (eq mode 'ethiopic)) + (progn + (insert flag) + (setq mode 'ethiopic))) + + (cond ; fidel, punc, digit + + ;; fidels + ((or (<= ch 346) ; he - fYa + (and (>= ch 384) (<= ch 444)) ; `qe - pw + (and (>= ch 453) (<= ch 457))) ; wWe - wW + (if (and (memq ch '(160 161 162 163 164 166 167)) ; (e - ea) + (or lonec + (and ethio-quote-vowel-always + fidel))) + (insert "'")) + (insert (aref ethio-fidel-to-sera-map ch)) + (setq lonec (ethio-lone-consonant-p ch) + fidel t + digit nil)) + + ;; punctuations or icons + ((or (and (>= ch 353) (<= ch 360)) ; : - :|: + (>= ch 458) ; '' - ? + (and (>= ch 448) (<= ch 452))) ; \~X \~e \~E \~a \~A + (insert (aref ethio-fidel-to-sera-map ch)) + (setq lonec nil + fidel nil + digit nil)) + + ;; now CH must be an ethiopic digit + + ;; reduction = 0 or not preceded by Ethiopic number(s) + ((or (= ethio-numeric-reduction 0) + (not digit)) + (insert "`" (aref ethio-fidel-to-sera-map ch)) + (setq lonec nil + fidel nil + digit t)) + + ;; reduction = 2 and following 10s, 100s, 10000s + ((and (= ethio-numeric-reduction 2) + (memq ch '(370 379 380))) + (insert (substring (aref ethio-fidel-to-sera-map ch) 1)) + (setq lonec nil + fidel nil + digit t)) + + ;; ordinary following digits + (t + (insert (aref ethio-fidel-to-sera-map ch)) + (setq lonec nil + fidel nil + digit t)))) + + ;; english character. must go to english mode, if not in it. + ((or (and (>= ch ?a) (<= ch ?z)) + (and (>= ch ?A) (<= ch ?Z))) + (if (not (eq mode 'english)) + (insert "\\~eng ")) + (forward-char 1) + (setq mode 'english + lonec nil + fidel nil + digit nil)) + + ;; ch can appear both in ethiopic section and in english section. + (t + + ;; we must decide the mode, if not decided yet + (if (null mode) + (progn + (setq mode + (if secondary + ethio-secondary-language + ethio-primary-language)) + (if (eq mode 'english) + (insert "\\~eng ") + (insert flag) + (setq mode 'ethiopic)))) ; tigrigna & amharic --> ethiopic + + (cond ; \ , eng-mode , punc , w3 , other + + ;; backslash is always quoted + ((= ch ?\\ ) + (insert "\\") + (forward-char 1)) + + ;; nothing to do if in english mode + ((eq mode 'english) + (forward-char 1)) + + ;; now we must be in ethiopic mode and seeing a non-"\" + + ;; ascii punctuations in ethiopic mode + ((looking-at "[,.;:'`?]+") + (insert "\\") + (goto-char (1+ (match-end 0)))) ; because we inserted one byte (\) + + ;; skip from "<" to ">" (or from "&" to ";") if called from w3 + ((and (boundp 'sera-being-called-by-w3) + sera-being-called-by-w3 + (or (= ch ?<) (= ch ?&))) + (search-forward (if (= ch ?<) ">" ";") + nil 0)) + + ;; neutral character. no need to quote. just skip it. + (t + (forward-char 1))) + + (setq lonec nil + fidel nil + digit nil))) + ;; end of main conversion routine + ))) + +(defun ethio-lone-consonant-p (ethiocode) + "If ETHIOCODE is an Ethiopic lone consonant, return t." + (or (and (< ethiocode 344) (= (% ethiocode 8) 5)) + + ;; `q `k X `g mW bW GW fW pW wW + (memq ethiocode '(389 405 421 437 440 441 442 443 444 457)))) + +;;;###autoload +(defun ethio-fidel-to-sera-mail nil + "Convert FIDEL to SERA to read/write mail and news. + +If the body contains at least one Ethiopic character, + 1) insert the string \"<sera>\" at the beginning of the body, + 2) insert \"</sera>\" at the end of the body, and + 3) convert the body into SERA. + +The very same procedure applies to the subject field, too." + + (interactive) + (let ((buffer-read-only nil) + border) + (save-excursion + + ;; look for the header-body separator + (goto-char (point-min)) + (if (search-forward + (if (eq major-mode 'rmail-mode) + "\n\n" (concat "\n" mail-header-separator "\n")) + nil t) + (setq border (point)) + (error "header separator not found")) + + ;; process body first not to change the border + ;; note that the point is already at the border + (if (re-search-forward "\\ce" nil t) + (progn + (ethio-fidel-to-sera-region border (point-max)) + (goto-char border) + (insert "<sera>") + (goto-char (point-max)) + (insert "</sera>"))) + + ;; process subject + (goto-char (point-min)) + (if (re-search-forward "^Subject: " border t) + (let ((beg (point)) + (end (line-end-position))) + (if (re-search-forward "\\ce" end t) + (progn + (ethio-fidel-to-sera-region beg end) + (goto-char beg) + (insert "<sera>") + (end-of-line) + (insert "</sera>"))))) + + ;; adjust the rmail marker + (if (eq major-mode 'rmail-mode) + (set-marker + (aref rmail-message-vector (1+ rmail-current-message)) + (point-max)))))) + +;;;###autoload +(defun ethio-fidel-to-sera-marker (&optional force) + "Convert the regions surrounded by \"<sera>\" and \"</sera>\" from FIDEL to SERA. +The markers \"<sera>\" and \"</sera>\" themselves are not deleted." + + (interactive "P") + (if (and buffer-read-only + (not force) + (not (y-or-n-p "Buffer is read-only. Force to convert? "))) + (error "")) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "<sera>" nil t) + (ethio-fidel-to-sera-region + (point) + (if (re-search-forward "</sera>" nil t) + (match-beginning 0) + (point-max)) + nil + 'force)))) + +;; +;; vowel modification +;; + +;;;###autoload +(defun ethio-modify-vowel nil + "Modify the vowel of the FIDEL that is under the cursor." + (interactive) + (let ((ch (following-char)) + (composite nil) ; geminated or not + newch base vowel modulo) + + (cond + ;; in case of gemination + ((eq (char-charset ch) 'composition) + (setq ch (string-to-char (decompose-composite-char ch)) + composite t)) + ;; neither gemination nor fidel + ((not (eq (char-charset ch) 'ethiopic)) + (error "Not a valid character."))) + + ;; set frequently referred character features + (setq ch (ethio-char-to-ethiocode ch) + base (* (/ ch 8) 8) + modulo (% ch 8)) + + (if (or (and (>= ch 344) (<= ch 380)) ;; mYa - `10000 + (and (>= ch 448) (<= ch 452)) ;; \~X - \~A + (>= ch 458)) ;; private punctuations + (error "Not a valid character.")) + + (setq + newch + (cond + + ;; first standalone vowels + ((= base 160) + (if (ethio-prefer-amharic-p) + (message "Modify vowel to: [auiAEIoW\"] ") + (message "Modify vowel to: [euiAEIoW\"] ")) + (setq vowel (read-char)) + (cond + ((= vowel ?e) 160) + ((= vowel ?u) 161) + ((= vowel ?i) 162) + ((= vowel ?A) 163) + ((= vowel ?E) 164) + ((= vowel ?I) 165) + ((= vowel ?o) 166) + ((= vowel ?W) 167) + ((= vowel ?a) (if (ethio-prefer-amharic-p) 160 163)) + ((= vowel ?\") (setq composite t) ch) + (t nil))) + + ;; second standalone vowels + ((= base 208) + (message "Modify vowel to: [euiaEIo\"] ") + (setq vowel (read-char)) + (cond + ((= vowel ?e) 208) + ((= vowel ?u) 209) + ((= vowel ?i) 210) + ((= vowel ?a) 211) + ((= vowel ?E) 212) + ((= vowel ?I) 213) + ((= vowel ?o) 214) + ((= vowel ?\") (setq composite t) ch) + (t nil))) + + ;; 12-form consonants, *W* form + ((memq base '(72 88 136 176 192 272)) ; qW QW hW kW KW gW + (message "Modify vowel to: [euiaE'\"] ") + (setq vowel (read-char)) + (cond + ((= vowel ?e) base) + ((= vowel ?u) (+ base 5)) + ((= vowel ?i) (+ base 2)) + ((= vowel ?a) (+ base 3)) + ((= vowel ?E) (+ base 4)) + ((= vowel ?') (+ base 5)) + ((= vowel ?\") (setq composite t) ch) + (t nil))) + + ;; extended 12-form consonants, mWa bWa GWa fWa pWa + ((= ch 31) ; mWa + (message "Modify vowel to: [euiaE'\"] ") + (setq vowel (read-char)) + (cond + ((= vowel ?e) 392) + ((= vowel ?u) 440) + ((= vowel ?i) 408) + ((= vowel ?a) ch) + ((= vowel ?E) 424) + ((= vowel ?') 440) + ((= vowel ?\") (setq composite t) ch) + (t nil))) + ((= ch 103) ; bWa + (message "Modify vowel to: [euiaE'\"] ") + (setq vowel (read-char)) + (cond + ((= vowel ?e) 393) + ((= vowel ?u) 441) + ((= vowel ?i) 409) + ((= vowel ?a) ch) + ((= vowel ?E) 425) + ((= vowel ?') 441) + ((= vowel ?\") (setq composite t) ch) + (t nil))) + ((= ch 287) ; GWa + (message "Modify vowel to: [euiaE'\"] ") + (setq vowel (read-char)) + (cond + ((= vowel ?e) 394) + ((= vowel ?u) 442) + ((= vowel ?i) 410) + ((= vowel ?a) ch) + ((= vowel ?E) 426) + ((= vowel ?') 442) + ((= vowel ?\") (setq composite t) ch) + (t nil))) + ((= ch 335) ; fWa + (message "Modify vowel to: [euiaE'\"] ") + (setq vowel (read-char)) + (cond + ((= vowel ?e) 395) + ((= vowel ?u) 443) + ((= vowel ?i) 411) + ((= vowel ?a) ch) + ((= vowel ?E) 427) + ((= vowel ?') 443) + ((= vowel ?\") (setq composite t) ch) + (t nil))) + ((= ch 343) ; pWa + (message "Modify vowel to: [euiaE'\"] ") + (setq vowel (read-char)) + (cond + ((= vowel ?e) 396) + ((= vowel ?u) 444) + ((= vowel ?i) 412) + ((= vowel ?a) ch) + ((= vowel ?E) 428) + ((= vowel ?') 444) + ((= vowel ?\") (setq composite t) ch) + (t nil))) + + ;; extended 12-form consonatns, mW* bW* GW* fW* pW* + ((memq base '(392 408 424 440)) ; *We *Wi *WE *W + (message "Modify vowel to: [eiEau'\"] ") + (setq vowel (read-char)) + (cond + ((= vowel ?e) (+ 392 modulo)) + ((= vowel ?i) (+ 408 modulo)) + ((= vowel ?E) (+ 424 modulo)) + ((= vowel ?a) (cond + ((= modulo 0) 31) ; mWa + ((= modulo 1) 103) ; bWa + ((= modulo 2) 287) ; GWa + ((= modulo 3) 335) ; fWa + ((= modulo 4) 343) ; pWa + (t nil))) ; never reach here + ((= vowel ?') (+ 440 modulo)) + ((= vowel ?u) (+ 440 modulo)) + ((= vowel ?\") (setq composite t) ch) + (t nil))) + + ((and (>= ch 453) (<= ch 457)) ; wWe wWi wWa wWE wW + (message "Modify vowel to: [eiaE'u\"] ") + (setq vowel (read-char)) + (cond + ((= vowel ?e) 453) + ((= vowel ?i) 454) + ((= vowel ?a) 455) + ((= vowel ?E) 456) + ((= vowel ?') 457) + ((= vowel ?u) 457) + ((= vowel ?\") (setq composite t) ch) + (t nil))) + + ;; 7-form consonants, or + ;; first 7 of 8-form consonants + ((<= modulo 6) + (message "Modify vowel to: [euiaE'o\"] ") + (setq vowel (read-char)) + (cond + ((= vowel ?e) base) + ((= vowel ?u) (+ base 1)) + ((= vowel ?i) (+ base 2)) + ((= vowel ?a) (+ base 3)) + ((= vowel ?E) (+ base 4)) + ((= vowel ?') (+ base 5)) + ((= vowel ?o) (+ base 6)) + ((= vowel ?\") (setq composite t) ch) + (t nil))) + + ;; otherwise + (t + nil))) + + (cond + + ;; could not get new character + ((null newch) + (error "Invalid vowel")) + + ;; vowel changed on a composite Fidel + (composite + (delete-char 1) + (insert + (compose-string + (concat (char-to-string (ethio-ethiocode-to-char newch)) "$(3%s(B")))) + + ;; simple vowel modification + (t + (delete-char 1) + (insert (ethio-ethiocode-to-char newch)))))) + +(defun ethio-ethiocode-to-char (ethiocode) + (make-char + 'ethiopic + (+ (/ ethiocode 94) 33) + (+ (mod ethiocode 94) 33))) + +(defun ethio-char-to-ethiocode (ch) + (and (eq (char-charset ch) 'ethiopic) + (let ((char-components (split-char ch))) + (+ (* (- (nth 1 char-components) 33) 94) + (- (nth 2 char-components) 33))))) + +;; +;; space replacement +;; + +;;;###autoload +(defun ethio-replace-space (ch begin end) + "Replace ASCII spaces with Ethiopic word separators in the region. + +In the specified region, replace word separators surrounded by two +Ethiopic characters, depending on the first parameter CH, which should +be 1, 2, or 3. + +If CH = 1, word separator will be replaced with an ASCII space. +If CH = 2, with two ASCII spaces. +If CH = 3, with the Ethiopic colon-like word separator. + +The second and third parameters BEGIN and END specify the region." + + (interactive "*cReplace spaces to: 1 (sg col), 2 (dbl col), 3 (Ethiopic)\nr") + (if (not (memq ch '(?1 ?2 ?3))) + (error "")) + (save-excursion + (save-restriction + (narrow-to-region begin end) + + (cond + ((= ch ?1) + ;; an Ethiopic word separator --> an ASCII space + (goto-char (point-min)) + (while (search-forward "$(3$h(B" nil t) + (replace-match " " nil t)) + + ;; two ASCII spaces between Ethiopic characters --> an ASCII space + (goto-char (point-min)) + (while (re-search-forward "\\(\\ce\\) \\(\\ce\\)" nil t) + (replace-match "\\1 \\2") + (goto-char (match-beginning 2)))) + + ((= ch ?2) + ;; An Ethiopic word separator --> two ASCII spaces + (goto-char (point-min)) + (while (search-forward "$(3$h(B" nil t) + (replace-match " ")) + + ;; An ASCII space between Ethiopic characters --> two ASCII spaces + (goto-char (point-min)) + (while (re-search-forward "\\(\\ce\\) \\(\\ce\\)" nil t) + (replace-match "\\1 \\2") + (goto-char (match-beginning 2)))) + + (t + ;; One or two ASCII spaces between Ethiopic characters + ;; --> An Ethiopic word separator + (goto-char (point-min)) + (while (re-search-forward "\\(\\ce\\) ?\\(\\ce\\)" nil t) + (replace-match "\\1$(3$h(B\\2") + (goto-char (match-beginning 2))) + + ;; Three or more ASCII spaces between Ethiopic characters + ;; --> An Ethiopic word separator + (N - 2) ASCII spaces + (goto-char (point-min)) + (while (re-search-forward "\\(\\ce\\) \\( *\\ce\\)" nil t) + (replace-match "\\1$(3$h(B\\2") + (goto-char (match-beginning 2)))))))) + +;; +;; special icons +;; + +;;;###autoload +(defun ethio-input-special-character (arg) + "Allow the user to input special characters." + (interactive "*cInput number: 1.$(3%j(B 2.$(3%k(B 3.$(3%l(B 4.$(3%m(B 5.$(3%i(B") + (cond + ((= arg ?1) + (insert "$(3%j(B")) + ((= arg ?2) + (insert "$(3%k(B")) + ((= arg ?3) + (insert "$(3%l(B")) + ((= arg ?4) + (insert "$(3%m(B")) + ((= arg ?5) + (insert "$(3%i(B")) + (t + (error "")))) + +;; +;; TeX support +;; + +(defconst ethio-fidel-to-tex-map + [ "heG" "huG" "hiG" "haG" "hEG" "hG" "hoG" "" ;; 0 - 7 + "leG" "luG" "liG" "laG" "lEG" "lG" "loG" "lWaG" ;; 8 + "HeG" "HuG" "HiG" "HaG" "HEG" "HG" "HoG" "HWaG" ;; 16 + "meG" "muG" "miG" "maG" "mEG" "mG" "moG" "mWaG" ;; 24 + "sseG" "ssuG" "ssiG" "ssaG" "ssEG" "ssG" "ssoG" "ssWaG" ;; 32 + "reG" "ruG" "riG" "raG" "rEG" "rG" "roG" "rWaG" ;; 40 + "seG" "suG" "siG" "saG" "sEG" "sG" "soG" "sWaG" ;; 48 + "xeG" "xuG" "xiG" "xaG" "xEG" "xG" "xoG" "xWaG" ;; 56 + "qeG" "quG" "qiG" "qaG" "qE" "qG" "qoG" "" ;; 64 + "qWeG" "" "qWi" "qWaG" "qWEG" "qWG" "" "" ;; 72 + "QeG" "QuG" "QiG" "QaG" "QEG" "QG" "QoG" "" ;; 80 + "QWeG" "" "QWiG" "QWaG" "QWEG" "QWG" "" "" ;; 88 + "beG" "buG" "biG" "baG" "bEG" "bG" "boG" "bWaG" ;; 96 + "veG" "vuG" "viG" "vaG" "vEG" "vG" "voG" "vWaG" ;; 104 + "teG" "tuG" "tiG" "taG" "tEG" "tG" "toG" "tWaG" ;; 112 + "ceG" "cuG" "ciG" "caG" "cEG" "cG" "coG" "cWaG" ;; 120 + "hheG" "hhuG" "hhiG" "hhaG" "hhEG" "hhG" "hhoG" "" ;; 128 + "hWeG" "" "hWiG" "hWaG" "hWEG" "hWG" "" "" ;; 136 + "neG" "nuG" "niG" "naG" "nEG" "nG" "noG" "nWaG" ;; 144 + "NeG" "NuG" "NiG" "NaG" "NEG" "NG" "NoG" "NWaG" ;; 152 + "eG" "uG" "iG" "AG" "EG" "IG" "oGG" "eaG" ;; 160 + "keG" "kuG" "kiG" "kaG" "kEG" "kG" "koG" "" ;; 168 + "kWeG" "" "kWiG" "kWa" "kWEG" "kWG" "" "" ;; 176 + "KeG" "KuG" "KiG" "KaG" "KEG" "KG" "KoG" "" ;; 184 + "KWeG" "" "KWiG" "KWa" "KWEG" "KWG" "" "" ;; 192 + "weG" "wuG" "wiG" "waG" "wEG" "wG" "woG" "" ;; 200 + "eeG" "uuG" "iiG" "aaG" "EEG" "IIG" "ooG" "" ;; 208 + "zeG" "zuG" "ziG" "zaG" "zEG" "zG" "zoG" "zWaG" ;; 216 + "ZeG" "ZuG" "ZiG" "ZaG" "ZEG" "ZG" "ZoG" "ZWaG" ;; 224 + "yeG" "yuG" "yiG" "yaG" "yEG" "yG" "yoG" "yWaG" ;; 232 + "deG" "duG" "diG" "daG" "dEG" "dG" "doG" "dWaG" ;; 240 + "DeG" "DuG" "DiG" "DaG" "DEG" "DG" "DoG" "DWaG" ;; 248 + "jeG" "juG" "jiG" "jaG" "jEG" "jG" "joG" "jWaG" ;; 256 + "geG" "guG" "giG" "gaG" "gEG" "gG" "goG" "" ;; 264 + "gWeG" "" "gWiG" "gWaG" "gWEG" "gWG" "" "" ;; 272 + "GeG" "GuG" "GiG" "GaG" "GEG" "GG" "GoG" "GWaG" ;; 280 + "TeG" "TuG" "TiG" "TaG" "TEG" "TG" "ToG" "TWaG" ;; 288 + "CeG" "CuG" "CiG" "CaG" "CEG" "CG" "CoG" "CWaG" ;; 296 + "PeG" "PuG" "PiG" "PaG" "PEG" "PG" "PoG" "PWaG" ;; 304 + "SeG" "SuG" "SiG" "SaG" "SEG" "SG" "SoG" "SWaG" ;; 312 + "SSeG" "SSuG" "SSiG" "SSaG" "SSEG" "SSG" "SSoG" "" ;; 320 + "feG" "fuG" "fiG" "faG" "fEG" "fG" "foG" "fWaG" ;; 328 + "peG" "puG" "piG" "paG" "pEG" "pG" "poG" "pWaG" ;; 336 + "mYaG" "rYaG" "fYaG" "" "" "" "" "" ;; 344 + "" "spaceG" "periodG" "commaG" ;; 352 + "semicolonG" "colonG" "precolonG" "oldqmarkG" ;; 356 + "pbreakG" "andG" "huletG" "sostG" "aratG" "amstG" "sadstG" "sabatG" ;; 360 + "smntG" "zeteNG" "asrG" "heyaG" "selasaG" "arbaG" "hemsaG" "slsaG" ;; 368 + "sebaG" "semanyaG" "zeTanaG" "metoG" "asrxiG" "" "" "" ;; 376 + "qqeG" "qquG" "qqiG" "qqaG" "qqEG" "qqG" "qqoG" "" ;; 384 + "mWeG" "bWeG" "GWeG" "fWeG" "pWeG" "" "" "" ;; 392 + "kkeG" "kkuG" "kkiG" "kkaG" "kkEG" "kkG" "kkoG" "" ;; 400 + "mWiG" "bWiG" "GWiG" "fWiG" "pWiG" "" "" "" ;; 408 + "XeG" "XuG" "GXiG" "XaG" "XEG" "XG" "XoG" "" ;; 416 + "mWEG" "bWEG" "GWEG" "fWEG" "pWEG" "" "" "" ;; 424 + "ggeG" "gguG" "ggiG" "ggaG" "ggEG" "ggG" "ggoG" "" ;; 432 + "mWG" "bWG" "GWG" "fWG" "pWG" "" "" "" ;; 440 + "ornamentG" "flandG" "iflandG" "africaG" ;; 448 + "iafricaG" "wWeG" "wWiG" "wWaG" ;; 452 + "wWEG" "wWG" "" "slaqG" "dotG" "lquoteG" "rquoteG" "qmarkG" ]) ;; 456 + +;; +;; To make tex-to-fidel mapping. +;; The following code makes +;; (get 'ethio-tex-command-he 'ethio-fidel-char) ==> ?$(3!!(B +;; etc. +;; + +(let ((i 0) str) + (while (< i (length ethio-fidel-to-tex-map)) + (setq str (aref ethio-fidel-to-tex-map i)) + (if (not (string= str "")) + (put + (intern (concat "ethio-tex-command-" (aref ethio-fidel-to-tex-map i))) + 'ethio-fidel-char + (ethio-ethiocode-to-char i))) + (setq i (1+ i)))) + +;;;###autoload +(defun ethio-fidel-to-tex-buffer nil + "Convert each fidel characters in the current buffer into a fidel-tex command. +Each command is always surrounded by braces." + (interactive) + (let ((buffer-read-only nil)) + + ;; Isolated gemination marks need special treatement + (goto-char (point-min)) + (while (search-forward "$(3%s(B" nil t) + (replace-match "\\geminateG{}" t t)) + + ;; First, decompose geminations + ;; Here we assume that each composed character consists of + ;; one Ethiopic character and the Ethiopic gemination mark. + (decompose-region (point-min) (point-max)) + + ;; Special treatment for geminated characters + ;; The geminated character (la'') will be "\geminateG{\la}". + (goto-char (point-min)) + (while (search-forward "$(3%s(B" nil t) + (delete-backward-char 1) + (backward-char 1) + (insert "\\geminateG") + (forward-char 1)) + + ;; Ethiopic characters to TeX macros + (goto-char (point-min)) + (while (re-search-forward "\\ce" nil t) + (insert + "{\\" + (aref ethio-fidel-to-tex-map + (prog1 (ethio-char-to-ethiocode (preceding-char)) + (backward-delete-char 1))) + "}")) + (goto-char (point-min)) + (set-buffer-modified-p nil))) + +;;;###autoload +(defun ethio-tex-to-fidel-buffer nil + "Convert fidel-tex commands in the current buffer into fidel chars." + (interactive) + (let ((buffer-read-only nil) + (p) (ch)) + + ;; Special treatment for gemination + ;; "\geminateG{\la}" or "\geminateG{{\la}}" will be "\la$(3%s(B" + ;; "\geminateG{}" remains unchanged. + (goto-char (point-min)) + (while (re-search-forward "\\\\geminateG{\\(\\\\[a-zA-Z]+\\)}" nil t) + (replace-match "\\1$(3%s(B")) + + ;; TeX macros to Ethiopic characters + (goto-char (point-min)) + (while (search-forward "\\" nil t) + (setq p (point)) + (skip-chars-forward "a-zA-Z") + (setq ch + (get (intern (concat "ethio-tex-command-" + (buffer-substring p (point)))) + 'ethio-fidel-char)) + (if ch + (progn + (delete-region (1- p) (point)) ; don't forget the preceding "\" + (if (and (= (preceding-char) ?{) + (= (following-char) ?})) + (progn + (backward-delete-char 1) + (delete-char 1))) + (insert ch)))) + + ;; compose geminated characters + (goto-char (point-min)) + (while (re-search-forward "\\ce$(3%s(B" nil 0) + (compose-region + (save-excursion (backward-char 2) (point)) + (point))) + + ;; Now it's time to convert isolated gemination marks. + (goto-char (point-min)) + (while (search-forward "\\geminateG{}" nil t) + (replace-match "$(3%s(B")) + + (goto-char (point-min)) + (set-buffer-modified-p nil))) + +;; +;; Java support +;; + +;;;###autoload +(defun ethio-fidel-to-java-buffer nil + "Convert Ethiopic characters into the Java escape sequences. + +Each escape sequence is of the form \uXXXX, where XXXX is the +character's codepoint (in hex) in Unicode. + +If `ethio-java-save-lowercase' is non-nil, use [0-9a-f]. +Otherwise, [0-9A-F]." + (let ((ucode)) + + ;; first, decompose geminations + (decompose-region (point-min) (point-max)) + + (goto-char (point-min)) + (while (re-search-forward "\\ce" nil t) + (setq ucode (+ ?\x1200 (ethio-char-to-ethiocode (preceding-char)))) + (if (> ucode ?\x13bc) + (setq ucode (+ ucode 59952))) + (delete-backward-char 1) + (if ethio-java-save-lowercase + (insert (format "\\u%4x" ucode)) + (insert (upcase (format "\\u%4x" ucode))))))) + +;;;###autoload +(defun ethio-java-to-fidel-buffer nil + "Convert the Java escape sequences into corresponding Ethiopic characters." + (let ((ucode)) + (goto-char (point-min)) + (while (re-search-forward "\\\\u\\([0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]\\)" nil t) + (setq ucode + (read + (concat + "?\\x" + (buffer-substring (match-beginning 1) (match-end 1))))) + (cond + ((and (>= ucode ?\x1200) (<= ucode ?\x13bc)) + (replace-match "") + (insert (ethio-ethiocode-to-char (- ucode ?\x1200)))) + ((and (>= ucode ?\xfdf1) (<= ucode ?\xfdff)) + (replace-match "") + (insert (ethio-ethiocode-to-char (- ucode 64560)))) + (t + nil))) + + ;; gemination + (goto-char (point-min)) + (while (re-search-forward "\\ce$(3%s(B" nil 0) + (compose-region + (save-excursion (backward-char 2) (point)) + (point))) + )) + +;; +;; file I/O hooks +;; + +;;;###autoload +(defun ethio-find-file nil + "Transcribe file content into Ethiopic dependig on filename suffix." + (cond + + ((string-match "\\.sera$" (buffer-file-name)) + (save-excursion + (ethio-sera-to-fidel-buffer nil 'force) + (set-buffer-modified-p nil))) + + ((string-match "\\.html$" (buffer-file-name)) + (let ((sera-being-called-by-w3 t)) + (save-excursion + (ethio-sera-to-fidel-marker 'force) + (goto-char (point-min)) + (while (re-search-forward "&[lr]aquote;" nil t) + (if (= (char-after (1+ (match-beginning 0))) ?l) + (replace-match "$(3%v(B") + (replace-match "$(3%w(B"))) + (set-buffer-modified-p nil)))) + + ((string-match "\\.tex$" (buffer-file-name)) + (save-excursion + (ethio-tex-to-fidel-buffer) + (set-buffer-modified-p nil))) + + ((string-match "\\.java$" (buffer-file-name)) + (save-excursion + (ethio-java-to-fidel-buffer) + (set-buffer-modified-p nil))) + + (t + nil))) + +;;;###autoload +(defun ethio-write-file nil + "Transcribe Ethiopic characters in ASCII depending on the file extension." + (cond + + ((string-match "\\.sera$" (buffer-file-name)) + (save-excursion + (ethio-fidel-to-sera-buffer nil 'force) + (goto-char (point-min)) + (ethio-record-user-preference) + (set-buffer-modified-p nil))) + + ((string-match "\\.html$" (buffer-file-name)) + (save-excursion + (let ((sera-being-called-by-w3 t) + (lq (aref ethio-fidel-to-sera-map 461)) + (rq (aref ethio-fidel-to-sera-map 462))) + (aset ethio-fidel-to-sera-map 461 "«te;") + (aset ethio-fidel-to-sera-map 462 "»te;") + (ethio-fidel-to-sera-marker 'force) + (goto-char (point-min)) + (if (search-forward "<sera>" nil t) + (ethio-record-user-preference)) + (aset ethio-fidel-to-sera-map 461 lq) + (aset ethio-fidel-to-sera-map 462 rq) + (set-buffer-modified-p nil)))) + + ((string-match "\\.tex$" (buffer-file-name)) + (save-excursion + (ethio-fidel-to-tex-buffer) + (set-buffer-modified-p nil))) + + ((string-match "\\.java$" (buffer-file-name)) + (save-excursion + (ethio-fidel-to-java-buffer) + (set-buffer-modified-p nil))) + + (t + nil))) + +(defun ethio-record-user-preference nil + (if (looking-at "\\\\~\\(tir?\\|amh?\\) ") + (goto-char (match-end 0)) + (insert (if (ethio-prefer-amharic-p) "\\~amh " "\\~tir "))) + (insert (if ethio-use-colon-for-colon "\\~-: " "\\~`: ") + (if ethio-use-three-dot-question "\\~`| " "\\~`? "))) + +(add-hook 'find-file-hooks 'ethio-find-file) +(add-hook 'write-file-hooks 'ethio-write-file) +(add-hook 'after-save-hook 'ethio-find-file) + +;; +(provide 'language/ethio-util) + +;;; Local Variables: +;;; generated-autoload-file: "../loaddefs.el" +;;; End: +;;; ethio-util.el ends here
--- a/lisp/language/ethiopic.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/language/ethiopic.el Mon Aug 13 09:44:42 2007 +0200 @@ -2,51 +2,76 @@ ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Copyright (C) 1997 MORIOKA Tomohiko ;; Keywords: multilingual, Ethiopic -;; This file is part of GNU Emacs. +;; This file is part of XEmacs. -;; 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 +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. -;; 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. +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with 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. +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. ;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp> +;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp> for XEmacs. ;;; Code: +;; Ethiopic +(make-charset 'ethiopic "Ethiopic" + '(registry "Ethio" + dimension 2 + chars 94 + final ?3 + graphic 0 + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ETHIOPIC +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-category ?E "Ethiopic (Ge'ez) character.") +(modify-category-entry 'ethiopic ?E) + +;; (define-ccl-program ccl-encode-ethio-font +;; '(0 +;; ;; In: R0:ethiopic (not checked) +;; ;; R1:position code 1 +;; ;; R2:position code 2 +;; ;; Out: R1:font code point 1 +;; ;; R2:font code point 2 +;; ((r1 -= 33) +;; (r2 -= 33) +;; (r1 *= 94) +;; (r2 += r1) +;; (if (r2 < 256) +;; (r1 = ?\x12) +;; (if (r2 < 448) +;; ((r1 = ?\x13) (r2 -= 256)) +;; ((r1 = ?\xfd) (r2 -= 208)) +;; )))) +;; "CCL program to encode an Ehitopic code to code point of Ehitopic font.") (define-ccl-program ccl-encode-ethio-font - '(0 - ;; In: R0:ethiopic (not checked) - ;; R1:position code 1 - ;; R2:position code 2 - ;; Out: R1:font code point 1 - ;; R2:font code point 2 - ((r1 -= 33) - (r2 -= 33) - (r1 *= 94) - (r2 += r1) - (if (r2 < 256) - (r1 = ?\x12) - (if (r2 < 448) - ((r1 = ?\x13) (r2 -= 256)) - ((r1 = ?\xfd) (r2 -= 208)) - )))) - "CCL program to encode an Ehitopic code to code point of Ehitopic font.") + '(((r0 -= #x21) + (r1 -= #x21) + (r0 *= 94) + (r1 += r0) + (if (r1 < 256) (r0 = 0) ((r1 -= 256) (r0 = 1)))))) -(setq font-ccl-encoder-alist - (cons (cons "ethiopic" ccl-encode-ethio-font) font-ccl-encoder-alist)) +;; (setq font-ccl-encoder-alist +;; (cons (cons "ethiopic" ccl-encode-ethio-font) font-ccl-encoder-alist)) +(set-charset-ccl-program 'ethiopic ccl-encode-ethio-font) (register-input-method "Ethiopic" '("quail-ethio" quail-use-package "quail/ethiopic")) @@ -97,4 +122,11 @@ (sample-text . "$(3$O#U!.(B") (documentation . nil))) +;; for XEmacs (will be obsoleted) +(define-language-environment 'ethiopic + "Ethiopic" + #'(lambda () + (setq-default quail-current-package + (assoc "ethio" quail-package-alist)))) + ;;; ethiopic.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/language/visual-mode.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,1176 @@ +;; visual.el -- cursor motion, insertion, deletion, etc. in visual order +;; Copyright (C) 1992 Free Software Foundation, Inc. + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; 94.5.15 created for Mule Ver.1.1 by Takahashi N. <ntakahas@etl.go.jp> + +;;;###autoload +(defvar visual-mode nil "non-nil if in visual-mode.") + +(make-variable-buffer-local 'visual-mode) + +(defvar visual-use-lr-commands nil + "If non-nil, use visual-left-* and visual-right-* commands instead of +visual-forward-* and visual-backward-* commands.") + +(defvar visual-mode-map + (let ((map (make-keymap))) + (substitute-key-definition 'self-insert-command + 'visual-self-insert-command + map global-map) + ; visual basic commands + (define-key map [(control d)] 'visual-delete-char) + (define-key map [(control k)] 'visual-kill-line) + (define-key map [(control m)] 'visual-newline) + (define-key map [(control o)] 'visual-open-line) + (define-key map [(control p)] 'visual-previous-line) + (define-key map [(control w)] 'visual-kill-region) + (define-key map [(control y)] 'visual-yank) + (define-key map [delete] 'visual-backward-delete-char) + (define-key map [(meta <)] 'visual-beginning-of-buffer) + (define-key map [(meta >)] 'visual-end-of-buffer) + (define-key map [(meta d)] 'visual-kill-word) + (define-key map [(meta w)] 'visual-kill-ring-save) + (define-key map [(meta y)] 'visual-yank-pop) + (define-key map [(meta delete)] 'visual-backward-kill-word) + (define-key map [up] 'visual-previous-line) + (define-key map [down] 'visual-next-line) + (define-key map [home] 'visual-beginning-of-buffer) + (define-key map [end] 'visual-end-of-buffer) + (define-key map [left] 'visual-move-to-left-char) + (define-key map [right] 'visual-move-to-right-char) + (define-key map [(meta left)] 'visual-move-to-left-word) + (define-key map [(meta right)] 'visual-move-to-right-word) + (define-key map [(control c) (control c)] 'exit-visual-mode) + (define-key map [(control c) <] 'l2r-mode) + (define-key map [(control c) >] 'r2l-mode) + ; LR commands + (if visual-use-lr-commands + (progn + (define-key map [(control a)] 'visual-left-end-of-line) + (define-key map [(control b)] 'visual-move-to-left-char) + (define-key map [(control e)] 'visual-right-end-of-line) + (define-key map [(control f)] 'visual-move-to-right-char) + (define-key map [(meta b)] 'visual-move-to-left-word) + (define-key map [(meta f)] 'visual-move-to-right-word)) + (define-key map [(control a)] 'visual-beginning-of-line) + (define-key map [(control b)] 'visual-backward-char) + (define-key map [(control e)] 'visual-end-of-line) + (define-key map [(control f)] 'visual-forward-char) + (define-key map [(meta b)] 'visual-backward-word) + (define-key map [(meta f)] 'visual-forward-word)) + map) + "minor-mode-keymap for visual-mode.") + +(if (not (assq 'visual-mode minor-mode-map-alist)) + (setq minor-mode-map-alist + (cons (cons 'visual-mode visual-mode-map) + minor-mode-map-alist))) + +(defvar visual-mode-indicator nil + "string displayed in mode line. \" l2r\" or \" r2l\".") +(make-variable-buffer-local 'visual-mode-indicator) + +(if (not (assq 'visual-mode minor-mode-alist)) + (setq minor-mode-alist + (cons '(visual-mode visual-mode-indicator) + minor-mode-alist))) + +(setq auto-mode-alist + (append '(("\\.l2r$" . l2r-mode) ("\\.r2l$" . r2l-mode)) + auto-mode-alist)) + +(defvar visual-mode-hooks nil) + +;;;###autoload +(defun visual-mode (&optional arg) + "Toggle visual-mode. With ARG, turn visual-mode on iff ARG is positive." + (interactive "P") + (if (null arg) + (if visual-mode (exit-visual-mode) (enter-visual-mode)) + (if (> (prefix-numeric-value arg) 0) + (enter-visual-mode) + (exit-visual-mode)))) + +(defun enter-visual-mode nil + "Enter visual-mode. Cursor moves in visual order." + (interactive) + (if (not visual-mode) + (progn + (setq visual-mode t + visual-mode-indicator (if display-direction " r2l" " l2r")) + (redraw-display) + (run-hooks 'visual-mode-hooks)))) + +(defun exit-visual-mode nil + "Exit visual-mode. Cursor moves in logical order." + (interactive) + (if visual-mode + (progn + (setq visual-mode nil) + (redraw-modeline t)))) + +(defun l2r-mode nil + "Set display-direction left to right." + (interactive) + (if (not visual-mode) + (enter-visual-mode)) + (setq display-direction nil) + (setq visual-mode-indicator " l2r") + (redraw-display)) + +(defun r2l-mode nil + "Set display-direction right to left." + (interactive) + (if (not visual-mode) + (enter-visual-mode)) + (setq display-direction t) + (setq visual-mode-indicator " r2l") + (redraw-display)) + + +;; cursor motion + +(defun visual-forward-char (arg) + "Move the cursor visually forward by ARG (integer) characters. +if ARG is negative, move backward." + (interactive "p") + (if (< arg 0) + (while (< arg 0) + (visual-backward-1-char) + (setq arg (1+ arg))) + (while (> arg 0) + (visual-forward-1-char) + (setq arg (1- arg))))) + +(defun visual-forward-1-char nil + "Move the cursor visually forward by 1 character." + (let ((r-dir (if display-direction 0 1)) + (a-dir (visual-char-direction-after-point)) + (aa-dir (visual-char-direction-after-after-point)) + (b-dir (visual-char-direction-before-point))) + + ; symbols used in the following comments + ; ^ : point in here + ; ~ : point will be there + ; d : character whose direction is the same as display-direction + ; r : character whose direction is opposite to display-direction + ; !d : r or nil + ; !r : d or nil + ; r* : 0 or more r's + ; d* : 0 or more d's + + (cond + ((null a-dir) + ; ... nil + ; ^ + (error "end of buffer")) + + ((eq a-dir r-dir) + (if (eq b-dir r-dir) + + ; ... r r ... + ; ~ ^ + (backward-char 1) + + ; ... !r r r* ... + ; ^ ~ + (skip-direction-forward r-dir))) + + ((eq aa-dir r-dir) + ; ... d r* r ... + ; ^ ~ + (forward-char 1) + (skip-direction-forward r-dir) + (backward-char 1)) + + (t + ; ... d !r ... + ; ^ ~ + (forward-char 1))))) + +(defun visual-backward-char (arg) + "Move the cursor visually backward by ARG (integer) characters. +if ARG is negative, move forward." + (interactive "p") + (if (< arg 0) + (while (< arg 0) + (visual-forward-1-char) + (setq arg (1+ arg))) + (while (> arg 0) + (visual-backward-1-char) + (setq arg (1- arg))))) + +(defun visual-backward-1-char nil + "Move the cursor visually backward by 1 character." + (let ((r-dir (if display-direction 0 1)) + (a-dir (visual-char-direction-after-point)) + (aa-dir (visual-char-direction-after-after-point)) + (b-dir (visual-char-direction-before-point))) + + ; symbols used in the following comments + ; ^ : point in here + ; ~ : point will be there + ; d : character whose direction is the same as display-direction + ; r : character whose direction is opposite to display-direction + ; !d : r or nil + ; !r : d or nil + ; r* : 0 or more r's + ; d* : 0 or more d's + + (cond + ((eq a-dir r-dir) + (if (eq aa-dir r-dir) + ; ... r r ... + ; ^ ~ + (forward-char 1) + + ; ... !r r* !r ... + ; ~ ^ + (skip-direction-backward r-dir) + (if (visual-char-direction-before-point) + (backward-char 1) + (skip-direction-forward r-dir) + (backward-char 1) + (error "beginning of buffer")))) + + ((null b-dir) + ; nil !r ... + ; ^ + (error "beginning of buffer")) + + ((eq b-dir r-dir) + ; ... r* r !r + ; ~ ^ + (skip-direction-backward r-dir)) + + (t + ; ... d !r ... + ; ~ ^ + (backward-char 1))))) + +(defun visual-char-direction (ch) + "Return the direction of CH (character). +Newline's direction will be same as display-direction." + (cond + ((null ch) nil) + ((= ch ?\n) (if display-direction 1 0)) + (t (char-direction ch)))) + +(defun visual-char-direction-after-point nil + "Return the direction of after-point-character. +0: left-to-right, 1: right-to-left" + (visual-char-direction (char-after (point)))) + +(defun visual-char-direction-after-after-point nil + "Return the direction of after-after-point-character. +0: left-to-right, 1: right-to-left" + (if (= (point) (point-max)) + nil + (save-excursion + (forward-char 1) + (visual-char-direction (char-after (point)))))) + +(defun visual-char-direction-before-point nil + "Return the direction of before-point-character. +0: left-to-right, 1: right-to-left" + (visual-char-direction (char-before (point)))) + +(defun skip-direction-forward (dir) + "Move point forward as long as DIR-direction characters continue." + (while (eq (visual-char-direction-after-point) dir) + (forward-char 1))) + +(defun skip-direction-backward (dir) + "Move point backward as long as DIR-direction characters continue." + (while (eq (visual-char-direction-before-point) dir) + (backward-char 1))) + +(defvar *visual-punctuations* + '(? ?. ?, ?: ?; ?? ?! ?- ?_ ?' ?\" ?/ ?( ?) ?[ ?] ?{ ?} ?\n ?\t ; ASCII + ? ?. ?, ?: ?; ?? ?! ?- ?_ ?' ?" ?( ?) ?[ ?] ; Hebrew + ?[2](3[0](B ?[2](3"[0](B ?[2](3'[0](B ?[2](3([0](B ?[2](3#[0](B ?[2](3$[0](B ?[2](3*[0](B ?[2](3+[0](B )) ; Arabic + +(defun visual-forward-word (arg) + "Move the cursor visually forward by ARG (integer) words. +If ARG is negative, move the cursor backward." + (interactive "p") + (if (< arg 0) + (while (< arg 0) + (visual-backward-1-word) + (setq arg (1+ arg))) + (while (> arg 0) + (visual-forward-1-word) + (setq arg (1- arg))))) + +(defun visual-backward-word (arg) + "Move the cursor visually backward by ARG (integer) words. +If ARG is negative, move the cursor forward." + (interactive "p") + (if (< arg 0) + (while (< arg 0) + (visual-forward-1-word) + (setq arg (1+ arg))) + (while (> arg 0) + (visual-backward-1-word) + (setq arg (1- arg))))) + +(defun visual-forward-1-word nil + "Move the cursor visually forward by one word." + (while (memq (visual-char-after) *visual-punctuations*) + (visual-forward-1-char)) + (while (not (memq (visual-char-after) *visual-punctuations*)) + (visual-forward-1-char))) + +(defun visual-backward-1-word nil + "Move the cursor visually backward by one word." + (while (memq (visual-char-before) *visual-punctuations*) + (visual-backward-1-char)) + (while (not (memq (visual-char-before) *visual-punctuations*)) + (visual-backward-1-char))) + +(defun visual-char-before nil + "Return the character visually before the cursor. +If such position is out of range, returns nil." + ; almost same as visual-backward-1-char + (save-excursion + (let ((r-dir (if display-direction 0 1)) + (a-dir (visual-char-direction-after-point)) + (aa-dir (visual-char-direction-after-after-point)) + (b-dir (visual-char-direction-before-point))) + (cond + ((eq a-dir r-dir) + (if (eq aa-dir r-dir) + (progn + (forward-char 1) + (char-after (point))) + (skip-direction-backward r-dir) + (if (visual-char-direction-before-point) + (progn + (backward-char 1) + (char-after (point))) + nil))) + ((null b-dir) + nil) + ((eq b-dir r-dir) + (skip-direction-backward r-dir) + (char-after (point))) + (t + (backward-char 1) + (char-after (point))))))) + +(defun visual-char-after nil + "Return the character under the cursor. +If such position is out of range, returns nil." + (char-after (point))) + +(defun visual-beginning-of-line (&optional arg) + "Move the cursor to the visual beginning of line. +With ARG not nil, move forward ARG - 1 lines first. +If scan reaches end of buffer, stop there without error." + (interactive "P") + (beginning-of-line arg) + (let ((a-dir (visual-char-direction-after-point)) + (d-dir (if display-direction 1 0))) + (if (and a-dir (/= a-dir d-dir)) + (progn (skip-direction-forward a-dir) + (backward-char 1))))) + +(fset 'visual-end-of-line 'end-of-line) + +(defun visual-beginning-of-buffer nil + "Move the cursor to the visual beginning of current buffer." + (interactive) + (beginning-of-buffer) + (visual-beginning-of-line)) + +(fset 'visual-end-of-buffer 'end-of-buffer) + +(defvar visual-temporary-goal-column 0 + "temporary-goal-column command for visual-mode.") + +(defun visual-next-line (arg) + "next-line command for visual-mode." + (interactive "p") + (if (and (not (eq last-command 'visual-next-line)) + (not (eq last-command 'visual-previous-line))) + (setq visual-temporary-goal-column (visual-current-column))) + (next-line arg) + (visual-goto-column visual-temporary-goal-column)) + +(defun visual-previous-line (arg) + "previous-line command for visual-mode." + (interactive "p") + (if (and (not (eq last-command 'visual-next-line)) + (not (eq last-command 'visual-previous-line))) + (setq visual-temporary-goal-column (visual-current-column))) + (previous-line arg) + (visual-goto-column visual-temporary-goal-column)) + +(defun visual-current-column nil + "Return the current column counted in visual order." + (let ((c 0) (p (point))) + (visual-beginning-of-line) + (while (/= (point) p) + (setq c (+ c (char-width (visual-char-after)))) + (visual-forward-1-char)) + c)) + +(defun visual-goto-column (col) + "Move the cursor to visual column N (integer) in the current line. +If it is impossible to go to column N, the cursor is put on the nearest column +M (M < N). Returns N - M." + (if (< col 0) + (error "argument must be positive.")) + (let ((c 0)) + (visual-beginning-of-line) + (while (and (< c col) (not (eolp))) + (setq c (+ c (char-width (visual-char-after)))) + (visual-forward-1-char)) + (if (> c col) + (progn + (visual-backward-1-char) + (setq c (- c (char-width (visual-char-after)))))) + (- col c))) + + +;; insertion + +(defun visual-insert-char (ch arg) + "Insert character CH visually before the cursor. +With ARG (integer) insert that many characters." + (if (< arg 0) + (error "arg must be >= 0.")) + (while (> arg 0) + (visual-insert-1-char ch) + (setq arg (1- arg)))) + +(defun visual-insert-1-char (ch) + "Insert character CH visually before the cursor. +The cursor moves visually forward." + (let ((c-dir (visual-char-direction ch)) + (r-dir (if display-direction 0 1)) + (a-dir (visual-char-direction-after-point)) + (tmp)) + + ; symbols used in the following comments + ; d : character whose direction is the same as display-direction + ; r : character whose direction is opposite to display-direction + ; !d : r or nil + ; !r : d or nil + ; ^d : point is here and the character to be inserted is d + ; ^r : point is here and the character to be inserted is d + + (if (eq c-dir r-dir) + (if (eq a-dir r-dir) + + ; ... r ... + ; ^r + (progn + (forward-char 1) + (insert ch) + (backward-char 2)) + + ; ... !r ... + ; ^r + (skip-direction-backward c-dir) + (insert ch) + (skip-direction-forward c-dir)) + + (if (or (eq a-dir nil) + (eq a-dir c-dir)) + + ; ... !r ... + ; ^d + (insert ch) + + ; ... r ... + ; ^d + (forward-char 1) + (setq tmp (delete-direction-backward r-dir)) + (skip-direction-forward r-dir) + (insert ch tmp) + (backward-char 1))))) + +(defun delete-direction-forward (dir) + "From current point, delete DIR-direction characters forward. +Returns the deleted string." + (let ((p (point))) + (skip-direction-forward dir) + (prog1 + (buffer-substring (point) p) + (delete-region (point) p)))) + +(defun delete-direction-backward (dir) + "From current point, delete DIR-direction characters backward. +Return the deleted string." + (let ((p (point))) + (skip-direction-backward dir) + (prog1 + (buffer-substring (point) p) + (delete-region (point) p)))) + +(defun visual-self-insert-command (arg) + "Insert this character (32 <= CH < 127). +With ARG (integer), insert that many characters. +If display-direction is non-nil, the cursor stays at the same position." + (interactive "*p") + (visual-insert-char last-command-char arg) + (if display-direction + (visual-backward-char arg))) + +;; wire us into pending-delete +(put 'visual-self-insert-command 'pending-delete t) + +(defun visual-newline (arg) + "newline command for visual-mode. +With ARG (integer), insert that many newlines." + (interactive "*p") + (visual-insert-char ?\n arg)) + +(defun visual-open-line (arg) + "open-line command for visual-mode. +With arg (integer), insert that many newlines." + (interactive "*p") + (visual-insert-char ?\n arg) + (visual-backward-char arg)) + + +;; deletion + +(defun visual-delete-char (arg) + "Delete ARG (integer) characters visually forward. +If ARG is negative, delete backward." + (interactive "*p") + (if (< arg 0) + (while (< arg 0) + (visual-backward-delete-1-char) + (setq arg (1+ arg))) + (while (> arg 0) + (visual-delete-1-char) + (setq arg (1- arg))))) + +(defun visual-backward-delete-char (arg) + "Delete ARG (integer) characters visually backward. +If arg is negative, delete forward." + (interactive "*p") + (if (< arg 0) + (while (< arg 0) + (visual-delete-1-char) + (setq arg (1+ arg))) + (while (> arg 0) + (visual-backward-delete-1-char) + (setq arg (1- arg))))) + +(fset 'visual-delete-backward-char 'visual-backward-delete-char) + +(defun visual-backward-delete-1-char nil + "Delete a character visually before the cursor. +Ther cursor moves visually backward." + (let ((d-dir (if display-direction 1 0)) + (r-dir (if display-direction 0 1)) + (a-dir (visual-char-direction-after-point)) + (aa-dir (visual-char-direction-after-after-point)) + (b-dir (visual-char-direction-before-point)) + (tmp)) + + ; symbols used in the following comments + ; ^ : point in here + ; d : character whose direction is the same as display-direction + ; r : character whose direction is opposite to display-direction + ; !d : r or nil + ; !r : d or nil + ; r* : 0 or more r's + ; d* : 0 or more d's + + (if (eq a-dir r-dir) + (cond + ((eq aa-dir r-dir) + ; ... r r ... + ; ^ + (forward-char 1) + (delete-char 1) + (backward-char 1)) + + ((save-excursion + (skip-direction-backward r-dir) + (backward-char 1) + (and (eq (visual-char-direction-after-point) d-dir) + (eq (visual-char-direction-before-point) r-dir))) + ; ... r d r* r !r ... + ; ^ + (forward-char 1) + (setq tmp (delete-direction-backward r-dir)) + (delete-backward-char 1) + (skip-direction-backward r-dir) + (insert tmp) + (backward-char 1)) + + (t + ; .....!r d r* r !r ... + ; ^ + (skip-direction-backward r-dir) + (delete-backward-char 1) + (skip-direction-forward r-dir) + (backward-char 1))) + + (cond + ((null b-dir) + ; nil !r ... + ; ^ + (error "beginning of buffer")) + + ((eq b-dir r-dir) + ; ... r !r ... + ; ^ + (skip-direction-backward r-dir) + (delete-char 1) + (skip-direction-forward r-dir)) + + (t + ; ... !r !r ... + ; ^ + (delete-backward-char 1)))))) + +(fset 'visual-delete-backward-1-char 'visual-backward-delete-1-char) + +(defun visual-delete-1-char nil + "Delete a character under the cursor. +Visually, the cursor stays at the same position." + (let ((d-dir (if display-direction 1 0)) + (r-dir (if display-direction 0 1)) + (a-dir (visual-char-direction-after-point)) + (aa-dir (visual-char-direction-after-after-point)) + (b-dir (visual-char-direction-before-point)) + (tmp)) + + ; symbols used in the following comments + ; ^ : point in here + ; d : character whose direction is the same as display-direction + ; r : character whose direction is opposite to display-direction + ; !d : r or nil + ; !r : d or nil + ; r* : 0 or more r's + ; d* : 0 or more d's + + (cond + ((null a-dir) + ; ... nil + ; ^ + (error "end of buffer")) + + ((eq a-dir r-dir) + (if (eq b-dir r-dir) + + ; ... r r ... + ; ^ + (progn (delete-char 1) + (backward-char 1)) + + ; ... !r r ... + ; ^ + (delete-char 1) + (skip-direction-forward r-dir))) + + ((not (eq aa-dir r-dir)) + ; ... d !r ... + ; ^ + (delete-char 1)) + + ((eq b-dir r-dir) + ; ... r d r ... + ; ^ + (delete-char 1) + (setq tmp (delete-direction-forward r-dir)) + (skip-direction-backward r-dir) + (insert tmp) + (backward-char 1)) + + (t + ; ...!r d r ... + ; ^ + (delete-char 1) + (skip-direction-forward r-dir) + (backward-char 1))))) + +(defun visual-delete-region (beg end) + "delete-region command for visual-mode." + (interactive "*r") + (let ((begl) (begc) (endl) (endc) (l)) + + ; swap beg & end if necessary + (goto-char beg) + (setq begl (current-line) + begc (visual-current-column)) + (goto-char end) + (setq endl (current-line) + endc (visual-current-column)) + (if (or (> begl endl) + (and (= begl endl) + (> begc endc))) + (progn + (setq beg (prog1 end (setq end beg)) + begl (prog1 endl (setq endl begl)) + begc (prog1 endc (setq endc begc))) + (goto-char end))) + + ; insert a newline visually at END + (visual-insert-1-char ?\n) + (visual-backward-1-char) + (setq l (current-line)) + + ; insert a newline visually at BEG + (goto-line begl) + (visual-goto-column begc) + (visual-insert-1-char ?\n) + (beginning-of-line) + + (delete-region + (point) + (progn + (goto-line (1+ l)) + (end-of-line) + (point))) + (backward-char 1) + (visual-delete-char 2))) + +(defun current-line nil + "Return the current line number (in the buffer) of point." + (interactive) + (save-excursion + (beginning-of-line) + (1+ (count-lines 1 (point))))) + + +;; kill + +(defun visual-kill-region (beg end) + "kill-region command for visual-mode." + (interactive "r") + (let ((begl) (begc) (endl) (endc) (l)) + + ; swap beg & end if necessary + (goto-char beg) + (setq begl (current-line) + begc (visual-current-column)) + (goto-char end) + (setq endl (current-line) + endc (visual-current-column)) + (if (or (> begl endl) + (and (= begl endl) (> begc endc))) + (progn + (setq beg (prog1 end (setq end beg)) + begl (prog1 endl (setq endl begl)) + begc (prog1 endc (setq endc begc))) + (goto-char end))) + + (if (or (and buffer-read-only (not inhibit-read-only)) + (text-property-not-all beg end 'read-only nil)) + (progn + (visual-copy-region-as-kill beg end) + (if kill-read-only-ok + (message "Read only text copied to kill ring") + (barf-if-buffer-read-only))) + + ; insert a newline visually at END + (visual-insert-1-char ?\n) + (visual-backward-1-char) + (setq l (current-line)) + + ; insert a newline visually at BEG + (goto-line begl) + (visual-goto-column begc) + (visual-insert-1-char ?\n) + (beginning-of-line) + + (kill-region + (point) + (progn + (goto-line (1+ l)) + (end-of-line) + (point))) + (backward-char 1) + (visual-delete-char 2))) + + (setq this-command 'kill-region)) + +(defun visual-kill-word (arg) + "Kill ARG (integer) words visually forward. +If ARG is negative, kill backward." + (interactive "*p") + (visual-kill-region + (point) + (progn + (visual-forward-word arg) + (point)))) + +(defun visual-backward-kill-word (arg) + "Kill ARG (integer) words visually backward. +If ARG is negative, kill forward." + (interactive "*p") + (visual-kill-region + (point) + (progn + (visual-backward-word arg) + (point)))) + +(defun visual-kill-line (&optional arg) + "kill-line command for visual-mode." + (interactive "*P") + (visual-kill-region + (point) + (progn + (if arg + (progn + (forward-line (prefix-numeric-value arg)) + (visual-beginning-of-line)) + (if (eobp) + (signal 'end-of-buffer nil)) + (if (not (eolp)) + (visual-end-of-line) + (forward-line 1) + (visual-beginning-of-line))) + (point)))) + +(defun visual-copy-region-as-kill (beg end) + "copy-region-as-kill command for visual-mode." + (interactive "r") + (let ((buffer-read-only nil) + (auto-save-mode 0) + (p (point))) + (visual-kill-region beg end) + (visual-yank 1) + (if (/= (point) p) + (exchange-point-and-mark))) + nil) + +(defun visual-kill-ring-save (beg end) + "kill-ring-save command for visual-mode." + (interactive "r") + (visual-copy-region-as-kill beg end) + (if (interactive-p) + (let ((other-end (if (= (point) beg) end beg)) + (opoint (point)) + (inhibit-quit t)) + (if (pos-visible-in-window-p other-end (selected-window)) + (progn + (set-marker (mark-marker) (point) (current-buffer)) + (goto-char other-end) + (sit-for 1) + (set-marker (mark-marker) other-end (current-buffer)) + (goto-char opoint) + (and quit-flag mark-active + (deactivate-mark))) + (let* ((killed-text (current-kill 0)) + (message-len (min (length killed-text) 40))) + (if (= (point) beg) + (message "Saved text until \"%s\"" + (substring killed-text (- message-len))) + (message "Saved text from \"%s\"" + (substring killed-text 0 message-len)))))))) + + +;; yank + +(defun visual-yank (&optional arg) + "yank command for visual-mode." + (interactive "*P") + (setq this-command t) + + (let ((l1 (current-line)) (c1 (visual-current-column)) l2 c2) + + ;; Insert a newline both before and after current point. + (visual-insert-char ?\n 2) + (visual-backward-1-char) + + ;; Reinsert killed string between the two newlines. + (insert (current-kill (cond + ((listp arg) 0) + ((eq arg '-) -1) + (t (1- arg))))) + + ;; Delete the latter newline visually. + (visual-delete-1-char) + (setq l2 (current-line) + c2 (visual-current-column)) + + ;; Delete the former newline visually. + (goto-line l1) + (end-of-line) + (visual-delete-1-char) + (push-mark (point)) + + ;; Go back to the end of yanked string. + (if (= (- l2 l1) 1) + (visual-goto-column (+ c1 c2)) + (goto-line (1- l2)) + (visual-goto-column c2)) + + ;; Exchange point and mark if necessary. + (if (consp arg) + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) (current-buffer)))))) + + (setq this-command 'yank) + nil) + +(defun visual-yank-pop (arg) + "yank-pop command for visual-mode." + (interactive "*p") + (if (not (eq last-command 'yank)) + (error "Previous command was not a yank")) + (setq this-command 'yank) + (let (l1 c1 l2 c2 before) + + (save-excursion + (setq l2 (current-line) + c2 (visual-current-column)) + (goto-char (mark t)) + (setq l1 (current-line) + c1 (visual-current-column)) + (if (or (> l1 l2) + (and (= l1 l2) (> c1 c2))) + (setq before t))) + + (visual-delete-region (point) (mark t)) + (setq l1 (current-line) + c1 (visual-current-column)) + + ;; Insert a newline both before and after current point. + (visual-insert-char ?\n 2) + (visual-backward-1-char) + + ;; Reinsert killed string between the two newlines. + (insert (current-kill arg)) + + ;; Delete the latter newline visually. + (visual-delete-1-char) + (setq l2 (current-line) + c2 (visual-current-column)) + + ;; Delete the former newline visually. + (goto-line l1) + (end-of-line) + (visual-delete-1-char) + (set-marker (mark-marker) (point) (current-buffer)) + + ;; Go back to the end of yanked string. + (if (= (- l2 l1) 1) + (visual-goto-column (+ c1 c2)) + (goto-line (1- l2)) + (visual-goto-column c2)) + + ;; Exchange point and mark if necessary. + (if before + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) (current-buffer)))))) + + nil) + + +;; misc + +(defun visual-reverse-direction-word nil + "Reverse the char order of the word before point." + (interactive "*") + (goto-char + (prog1 + (point) + (reverse-region + (point) + (progn (skip-direction-backward (visual-char-direction-before-point)) + (point)))))) + +(defun visual-reverse-region (begin end) + "Reverse the order of chars between BEGIN and END." + (interactive "*r") + (apply 'insert + (nreverse + (string-to-char-list + (prog1 (buffer-substring begin end) (delete-region begin end)))))) + + +;; LR commands + +(defun visual-char-left nil + "Return the character on the left of visual point." + (if display-direction + (visual-char-after) + (visual-char-before))) + +(defun visual-char-right nil + "Return the character on the right of visual point." + (if display-direction + (visual-char-before) + (visual-char-after))) + +(defun visual-move-to-left-char (arg) + "Move the cursor visually left by ARG (integer) characters. +If ARG is negative, move the cursor right." + (interactive "p") + (if display-direction + (visual-forward-char arg) + (visual-backward-char arg))) + +(defun visual-move-to-left-1-char nil + "Move the cursor visually left by 1 character." + (interactive "p") + (if display-direction + (visual-forward-1-char) + (visual-backward-1-char))) + +(defun visual-move-to-right-char (arg) + "Move the cursor visually right by ARG (integer) characters. +If ARG is negative, move the cursor left." + (interactive "p") + (if display-direction + (visual-backward-char arg) + (visual-forward-char arg))) + +(defun visual-move-to-right-1-char nil + "Move the cursor visually right by 1 character." + (interactive "p") + (if display-direction + (visual-backward-1-char) + (visual-forward-1-char))) + +(defun visual-move-to-left-word (arg) + "Move the cursor visually left by ARG (integer) words. +If ARG is negative, move the cursor right." + (interactive "p") + (if display-direction + (visual-forward-word arg) + (visual-backward-word arg))) + +(defun visual-move-to-right-word (arg) + "Move the cursor visually right by ARG (integer) words. +If ARG is negative, move the cursor left." + (interactive "p") + (if display-direction + (visual-backward-word arg) + (visual-forward-word arg))) + +(defun visual-left-end-of-line (arg) + "Move the line cursor to the left-end of line. +With ARG not nil, move forward ARG - 1 lines first. +If scan reaches end of buffer, stop there without error." + (interactive "P") + (if display-direction + (visual-end-of-line arg) + (visual-beginning-of-line arg))) + +(defun visual-right-end-of-line (arg) + "Move the line cursor to the right-end of line. +With ARG not nil, move forward ARG - 1 lines first. +If scan reaches end of buffer, stop there without error." + (interactive "P") + (if display-direction + (visual-beginning-of-line arg) + (visual-end-of-line arg))) + +(defun visual-insert-char-left (ch arg) + "Insert CH (character) on the left of visual point as many as +ARG (integer)." + (if (< arg 0) + (error "ARG must be >= 0.")) + (visual-insert-char ch arg) + (and display-direction + (visual-backward-char arg))) + +(defun visual-insert-left-1-char (ch) + "Insert CH (character) on the left of visual point." + (visual-insert-1-char ch) + (and display-direction + (visual-backward-1-char))) + +(defun visual-insert-char-right (ch arg) + "Insert CH (character) on the right of visual point as many as +ARG (integer)." + (if (< arg 0) + (error "ARG must be >= 0.")) + (visual-insert-char ch arg) + (or display-direction + (visual-backward-char arg))) + +(defun visual-insert-right-1-char (ch) + "Insert CH (character) on the right of visual point." + (visual-insert-1-char ch) + (or display-direction + (visual-backward-1-char))) + +(defun visual-delete-left-char (arg) + "Delete ARG (integer) characters on the left of visual point. +If ARG is negative, on the right." + (interactive "*p") + (if display-direction + (visual-delete-char arg) + (visual-backward-delete-char arg))) + +(defun visual-delete-left-1-char nil + "Delete 1 character on the left of visual point." + (interactive "*p") + (if display-direction + (visual-delete-1-char) + (visual-backward-delete-1-char))) + +(defun visual-delete-right-char (arg) + "Delete ARG (integer) characters on the right of visual point. +If ARG is negative, on the left." + (interactive "*p") + (if display-direction + (visual-backward-delete-char arg) + (visual-delete-char arg))) + +(defun visual-delete-right-1-char nil + "Delete 1 character on the right of visual point." + (interactive "*p") + (if display-direction + (visual-backward-delete-1-char) + (visual-delete-1-char))) + +(defmacro visual-replace-left-1-char (ch) + (list + 'progn + '(visual-delete-left-1-char) + (list 'visual-insert-left-1-char ch))) + +(defmacro visual-replace-right-1-char (ch) + (list + 'progn + '(visual-delete-right-1-char) + (list 'visual-insert-right-1-char ch))) + +(defun visual-kill-left-word (arg) + "Kill ARG (integer) words on the left of visual pointer. +If ARG is negative, kill on the right." + (interactive "*p") + (if display-direction + (visual-kill-word arg) + (visual-backward-kill-word arg))) + +(defun visual-kill-right-word (arg) + "Kill ARG (integer) words on the right of visual point. +If ARG is negative, kill on the left." + (interactive "*p") + (if display-direction + (visual-backward-kill-word arg) + (visual-kill-word arg))) + +;;; +(provide 'visual-mode)
--- a/lisp/leim/quail.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/leim/quail.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,4 +1,4 @@ -;;; quail.el -- provides simple input method for multilingual text +;;; quail.el --- Provides simple input method for multilingual text ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. @@ -93,6 +93,13 @@ (defvar quail-current-translations nil "Cons of indices and vector of possible translations of the current key.") +(defvar quail-current-data nil + "Any Lisp object holding information of current translation status. +When a key sequence is mapped to TRANS and TRANS is a cons +of actual translation and some Lisp object to be refered +for translating the longer key sequence, this variable is set +to that Lisp object.") + ;; A flag to control conversion region. Normally nil, but if set to ;; t, it means we must start the new conversion region if new key to ;; be translated is input. @@ -557,7 +564,10 @@ (setq overriding-local-map quail-saved-overriding-local-map) ;; If whole text in conversion area was deleted, exit from the ;; recursive edit. - (let ((start (overlay-start quail-conv-overlay))) + ;; 1997/6/24 modified by MORIOKA Tomohiko <morioka@jaist.ac.jp> + ;; for XEmacs + (let ((start (and quail-conv-overlay + (overlay-start quail-conv-overlay)))) (if (and start (= start (overlay-end quail-conv-overlay))) (throw 'quail-tag nil))) ))) @@ -684,11 +694,13 @@ format \(INDEX . VECTOR), as described above." (and (consp object) (let ((translation (car object))) - (or (integerp translation) (consp translation) (null translation) + (or (characterp translation) (null translation) (vectorp translation) (stringp translation) - (symbolp translation))) + (symbolp translation) + (and (consp translation) (not (vectorp (cdr translation)))))) (let ((alist (cdr object))) - (or (listp alist) (symbolp alist))))) + (or (and (listp alist) (consp (car alist))) + (symbolp alist))))) (defmacro quail-define-rules (&rest rules) "Define translation rules of the current Quail package. @@ -723,11 +735,14 @@ (defun quail-defrule (key translation &optional name) "Add one translation rule, KEY to TRANSLATION, in the current Quail package. KEY is a string meaning a sequence of keystrokes to be translated. -TRANSLATION is a character, a string, a vector, a Quail map, or a function. +TRANSLATION is a character, a string, a vector, a Quail map, +a function, or a cons. It it is a character, it is the sole translation of KEY. If it is a string, each character is a candidate for the translation. If it is a vector, each element (string or character) is a candidate for the translation. +If it is a cons, the car is one of the above and the cdr is a function +to call when translating KEY. In these cases, a key specific Quail map is generated and assigned to KEY. If TRANSLATION is a Quail map or a function symbol which returns a Quail map, @@ -749,6 +764,7 @@ ;; 1997/5/26 by MORIOKA Tomohiko ;; modified for XEmacs (if (not (or (characterp trans) (stringp trans) (vectorp trans) + (consp trans) (symbolp trans) (quail-map-p trans))) (error "Invalid Quail translation `%s'" trans)) @@ -757,6 +773,7 @@ (let ((len (length key)) (idx 0) ch entry) + ;; Make a map for registering TRANS if necessary. (while (< idx len) (if (null (consp map)) ;; We come here, for example, when we try to define a rule @@ -794,41 +811,43 @@ (setcdr entry (append trans (cdr map))))) (setcar map trans))))) -(defun quail-get-translation (map key len) - "Return the translation specified in Quail map MAP for KEY of length LEN. +(defun quail-get-translation (def key len) + "Return the translation specified as DEF for KEY of length LEN. The translation is either a character or a cons of the form (INDEX . VECTOR), where VECTOR is a vector of candidates (character or string) for the translation, and INDEX points into VECTOR to specify the currently selected translation." - (let ((def (car map))) - (if (and def (symbolp def)) - ;; DEF is a symbol of a function which returns valid translation. - (setq def (funcall def key len))) - (cond - ((or (characterp def) (consp def)) - def) + (if (and def (symbolp def)) + ;; DEF is a symbol of a function which returns valid translation. + (setq def (funcall def key len))) + (if (and (consp def) (not (vectorp (cdr def)))) + (setq def (car def))) - ((null def) - ;; No translation. - nil) + (cond + ((or (characterp def) (consp def)) + def) + + ((null def) + ;; No translation. + nil) - ((stringp def) - ;; Each character in DEF is a candidate of translation. Reform - ;; it as (INDEX . VECTOR). - (setq def (string-to-vector def)) - ;; But if the length is 1, we don't need vector but a single - ;; character as the translation. - (if (= (length def) 1) - (aref def 0) - (cons 0 def))) + ((stringp def) + ;; Each character in DEF is a candidate of translation. Reform + ;; it as (INDEX . VECTOR). + (setq def (string-to-vector def)) + ;; But if the length is 1, we don't need vector but a single + ;; candidate as the translation. + (if (= (length def) 1) + (aref def 0) + (cons 0 def))) - ((vectorp def) - ;; Each element (string or character) in DEF is a candidate of - ;; translation. Reform it as (INDEX . VECTOR). - (cons 0 def)) + ((vectorp def) + ;; Each element (string or character) in DEF is a candidate of + ;; translation. Reform it as (INDEX . VECTOR). + (cons 0 def)) - (t - (error "Invalid object in Quail map: %s" def))))) + (t + (error "Invalid object in Quail map: %s" def)))) (defun quail-lookup-key (key len) "Lookup KEY of length LEN in the current Quail map and return the definition. @@ -836,7 +855,7 @@ (let ((idx 0) (map (quail-map)) (kbd-translate (quail-kbd-translate)) - slot ch translation) + slot ch translation def) (while (and map (< idx len)) (setq ch (if kbd-translate (quail-keyboard-translate (aref key idx)) (aref key idx))) @@ -847,12 +866,22 @@ (if (and (cdr slot) (symbolp (cdr slot))) (setcdr slot (funcall (cdr slot) key idx))) (setq map (cdr slot))) - (if (and map (setq translation (quail-get-translation map key len))) + (setq def (car map)) + (if (and map (setq translation (quail-get-translation def key len))) (progn - ;; We may have to reform car part of MAP. - (if (not (equal (car map) translation)) - (setcar map translation)) - (if (consp translation) + (if (and (consp def) (not (vectorp (cdr def)))) + (progn + (if (not (equal (car def) translation)) + ;; We must reflect TRANSLATION to car part of DEF. + (setcar def translation)) + (setq quail-current-data + (if (functionp (cdr def)) + (funcall (cdr def)) + (cdr def)))) + (if (not (equal def translation)) + ;; We must reflect TRANSLATION to car part of MAP. + (setcar map translation))) + (if (and (consp translation) (vectorp (cdr translation))) (progn (setq quail-current-translations translation) (if (quail-forget-last-selection) @@ -1044,6 +1073,8 @@ def ch) (if map (let ((def (car map))) + (if (and (consp def) (not (vectorp (cdr def)))) + (setq def (car def))) (setq quail-current-str (if (consp def) (aref (cdr def) (car def)) def)) ;; Return t only if we can terminate the current translation. @@ -1065,6 +1096,8 @@ (quail-maximum-shortest) (>= len 4) (setq def (car (quail-lookup-key quail-current-key (- len 2)))) + (if (and (consp def) (not (vectorp (cdr def)))) + (setq def (car def))) (quail-lookup-key (substring quail-current-key -2) 2)) ;; Now the sequence is "...ABCD", which can be split into ;; "...AB" and "CD..." to get valid translation. @@ -1350,8 +1383,11 @@ (defun quail-show-translations () "Show the current possible translations." - (let ((key quail-current-key) - (map (quail-lookup-key quail-current-key (length quail-current-key)))) + (let* ((key quail-current-key) + (map (quail-lookup-key quail-current-key (length quail-current-key))) + (def (car map))) + (if (and (consp def) (not (vectorp (cdr def)))) + (setq def (car def))) (save-excursion (set-buffer quail-guidance-buf) (erase-buffer) @@ -1369,9 +1405,9 @@ (insert "]"))) ;; Show list of translations. - (if (consp (car map)) - (let* ((idx (car (car map))) - (translations (cdr (car map))) + (if (and (not (quail-deterministic)) (consp def)) + (let* ((idx (car def)) + (translations (cdr def)) (from (* (/ idx 10) 10)) (to (min (+ from 10) (length translations)))) (indent-to 10) @@ -1431,10 +1467,10 @@ (setq l (cdr l))))))) ;; List all possible translations of KEY in Quail map MAP with -;; indentation INDENT." +;; indentation INDENT. (defun quail-completion-list-translations (map key indent) (let ((translations - (quail-get-translation map key (length key)))) + (quail-get-translation (car map) key (length key)))) (if (integerp translations) (insert "(1/1) 1." translations "\n") ;; We need only vector part. @@ -1533,7 +1569,7 @@ (insert ch) (let* ((map (cdr (assq ch (cdr (quail-map))))) (translation (and map (quail-get-translation - map (char-to-string ch) 1)))) + (car map) (char-to-string ch) 1)))) (if (integerp translation) (insert translation) (if (consp translation)
--- a/lisp/locale/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/locale/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/mailcrypt/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/mailcrypt/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/mel/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/mel/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/mh-e/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/mh-e/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -56,7 +56,6 @@ (put 'mh-compose 'custom-loads '("mh-comp")) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/mh-e/mh-e.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/mh-e/mh-e.el Mon Aug 13 09:44:42 2007 +0200 @@ -63,7 +63,7 @@ ;;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985. ;;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu ;;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu -(defconst mh-e-RCS-id "$Id: mh-e.el,v 1.3 1997/06/11 19:25:57 steve Exp $") +(defconst mh-e-RCS-id "$Id: mh-e.el,v 1.4 1997/06/26 02:31:00 steve Exp $") ;;; Code: @@ -924,7 +924,8 @@ (format "inc %s..." folder))) (setq mh-next-direction 'forward) (goto-char (point-max)) - (let ((start-of-inc (point))) + (let ((start-of-inc (point)) + (coding-system-for-read mh-folder-coding-system)) (if maildrop-name ;; I think MH 5 used "-ms-file" instead of "-file", ;; which would make inc'ing from maildrops fail.
--- a/lisp/modes/auto-autoloads.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/modes/auto-autoloads.el Mon Aug 13 09:44:42 2007 +0200 @@ -229,101 +229,6 @@ ;;;*** -;;;### (autoloads (c-add-style c-set-style java-mode objc-mode c++-mode c-mode) "cc-mode" "modes/cc-mode.el") - -(autoload '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. - -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. - -Key bindings: -\\{c-mode-map}" t nil) - -(autoload 'c++-mode "cc-mode" "\ -Major mode for editing 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. - -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. - -Key bindings: -\\{c++-mode-map}" t nil) - -(autoload 'objc-mode "cc-mode" "\ -Major mode for editing Objective C code. -To submit a problem report, enter `\\[c-submit-bug-report]' from an -objc-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 `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. - -Key bindings: -\\{objc-mode-map}" t nil) - -(autoload 'java-mode "cc-mode" "\ -Major mode for editing Java code. -To submit a problem report, enter `\\[c-submit-bug-report]' from an -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 -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'. - -Key bindings: -\\{java-mode-map}" t nil) - -(autoload 'c-set-style "cc-mode" "\ -Set CC Mode variables to use one of several different indentation styles. -STYLENAME is a string representing the desired style from the list of -styles described in the variable `c-style-alist'. See that variable -for details of setting up styles. - -The variable `c-indentation-style' always contains the buffer's current -style name." t nil) - -(autoload 'c-add-style "cc-mode" "\ -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: - - ((VARIABLE . VALUE) [(VARIABLE . VALUE) ...]) - -See the variable `c-style-alist' for the semantics of 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) - -(fset 'set-c-style 'c-set-style) - -;;;*** - ;;;### (autoloads (common-lisp-indent-function) "cl-indent" "modes/cl-indent.el") (autoload 'common-lisp-indent-function "cl-indent" nil nil nil) @@ -756,7 +661,7 @@ ;;;### (autoloads (ksh-mode) "ksh-mode" "modes/ksh-mode.el") (autoload 'ksh-mode "ksh-mode" "\ -ksh-mode $Revision: 1.1 $ - Major mode for editing (Bourne, Korn or Bourne again) +ksh-mode $Revision: 1.2 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -1371,33 +1276,35 @@ Labels can be created with `\\[reftex-label]' and referenced with `\\[reftex-reference]'. When referencing, you get a menu with all labels of a given type and -context of the label definition. The selected label is inserted as a +context of the label definition. The selected label is inserted as a \\ref macro. Citations can be made with `\\[reftex-citation]' which will use a regular expression to pull out a *formatted* list of articles from your BibTeX -database. The selected citation is inserted as a \\cite macro. +database. The selected citation is inserted as a \\cite macro. A Table of Contents of the entire (multifile) document with browsing capabilities is available with `\\[reftex-toc]'. -Most command have help available on the fly. This help is accessed by +Most command have help available on the fly. This help is accessed by pressing `?' to any prompt mentioning this feature. +Extensive documentation about reftex is in the file header of `reftex.el'. + \\{reftex-mode-map} -Under X, these functions will be available also in a menu on the menu bar. +Under X, these functions will also be available in a menu on the menu bar. ------------------------------------------------------------------------------" t nil) (autoload 'reftex-add-to-label-alist "reftex" "\ -Add label environment descriptions to reftex-label-alist-external-add-ons. -The format of ENTRY-LIST is exactly like reftex-label-alist. See there +Add label environment descriptions to `reftex-label-alist-external-add-ons'. +The format of ENTRY-LIST is exactly like `reftex-label-alist'. See there for details. This function makes it possible to support RefTeX from AUCTeX style files. The entries in ENTRY-LIST will be processed after the user settings in -reftex-label-alist, and before the defaults (specified in -reftex-default-label-alist-entries). Any changes made to -reftex-label-alist-external-add-ons will raise a flag to the effect that a +`reftex-label-alist', and before the defaults (specified in +`reftex-default-label-alist-entries'). Any changes made to +`reftex-label-alist-external-add-ons' will raise a flag to the effect that a mode reset is done on the next occasion." nil nil) ;;;*** @@ -2098,7 +2005,7 @@ (autoload 'vhdl-mode "vhdl-mode" "\ Major mode for editing VHDL code. -vhdl-mode $Revision: 1.1 $ +vhdl-mode $Revision: 1.2 $ To submit a problem report, enter `\\[vhdl-submit-bug-report]' from a vhdl-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the @@ -2215,6 +2122,13 @@ ;;;*** +;;;### (autoloads (winmgr-mode) "winmgr-mode" "modes/winmgr-mode.el") + +(autoload 'winmgr-mode "winmgr-mode" "\ +Major mode for editing winmgr config files." t nil) + +;;;*** + ;;;### (autoloads (xpm-mode) "xpm-mode" "modes/xpm-mode.el") (autoload 'xpm-mode "xpm-mode" "\
--- a/lisp/modes/cc-compat.el Mon Aug 13 09:43:39 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,145 +0,0 @@ -;;; cc-compat.el --- cc-mode compatibility with c-mode.el confusion - -;; Copyright (C) 1985-1995 Free Software Foundation, Inc. - -;; Author: 1994-1995 Barry A. Warsaw -;; Maintainer: cc-mode-help@merlin.cnri.reston.va.us -;; Created: August 1994, split from cc-mode.el -;; Version: 1.5 -;; Last Modified: 1995/06/11 20:15:44 -;; Keywords: c languages oop - -;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Commentary: -;; -;; Boring old c-mode.el (BOCM) is confusion and brain melt. cc-mode.el -;; is clarity of thought and purity of chi. If you are still unwilling -;; to accept enlightenment, this might help, or it may prolong your -;; agony. -;; -;; To use, add the following to your c-mode-hook: -;; -;; (require 'cc-compat) -;; (c-set-style "BOCM") - -;;; Code: - - -;; In case c-mode.el isn't loaded -(defvar c-indent-level 2 - "*Indentation of C statements with respect to containing block.") -(defvar c-brace-imaginary-offset 0 - "*Imagined indentation of a C open brace that actually follows a statement.") -(defvar c-brace-offset 0 - "*Extra indentation for braces, compared with other text in same context.") -(defvar c-argdecl-indent 5 - "*Indentation level of declarations of C function arguments.") -(defvar c-label-offset -2 - "*Offset of C label lines and case statements relative to usual indentation.") -(defvar c-continued-statement-offset 2 - "*Extra indent for lines not starting new statements.") -(defvar c-continued-brace-offset 0 - "*Extra indent for substatements that start with open-braces. -This is in addition to c-continued-statement-offset.") - - - -;; these offsets are taken by brute force testing c-mode.el, since -;; there's no logic to what it does. -(let* ((offsets '(c-offsets-alist . - ((defun-block-intro . cc-block-intro-offset) - (statement-block-intro . cc-block-intro-offset) - (defun-open . 0) - (class-open . 0) - (inline-open . c-brace-offset) - (block-open . c-brace-offset) - (block-close . cc-block-close-offset) - (brace-list-open . c-brace-offset) - (substatement-open . cc-substatement-open-offset) - (substatement . c-continued-statement-offset) - (knr-argdecl-intro . c-argdecl-indent) - (case-label . c-label-offset) - (access-label . c-label-offset) - (label . c-label-offset) - )))) - (c-add-style "BOCM" offsets)) - - -(defun cc-block-intro-offset (langelem) - ;; taken directly from calculate-c-indent confusion - (save-excursion - (c-backward-syntactic-ws) - (if (= (preceding-char) ?{) - (forward-char -1) - (goto-char (cdr langelem))) - (let* ((curcol (save-excursion - (goto-char (cdr langelem)) - (current-column))) - (bocm-lossage - ;; If no previous statement, indent it relative to line - ;; brace is on. For open brace in column zero, don't let - ;; statement start there too. If c-indent-level is zero, - ;; use c-brace-offset + c-continued-statement-offset - ;; instead. For open-braces not the first thing in a line, - ;; add in c-brace-imaginary-offset. - (+ (if (and (bolp) (zerop c-indent-level)) - (+ c-brace-offset c-continued-statement-offset) - c-indent-level) - ;; Move back over whitespace before the openbrace. If - ;; openbrace is not first nonwhite thing on the line, - ;; add the c-brace-imaginary-offset. - (progn (skip-chars-backward " \t") - (if (bolp) 0 c-brace-imaginary-offset)) - ;; If the openbrace is preceded by a parenthesized exp, - ;; move to the beginning of that; possibly a different - ;; line - (progn - (if (eq (preceding-char) ?\)) - (forward-sexp -1)) - ;; Get initial indentation of the line we are on. - (current-indentation))))) - (- bocm-lossage curcol)))) - - -(defun cc-block-close-offset (langelem) - (save-excursion - (let* ((here (point)) - bracep - (curcol (progn - (goto-char (cdr langelem)) - (current-column))) - (bocm-lossage (progn - (goto-char (cdr langelem)) - (if (= (following-char) ?{) - (setq bracep t) - (goto-char here) - (beginning-of-line) - (backward-up-list 1) - (forward-char 1) - (c-forward-syntactic-ws)) - (current-column)))) - (- bocm-lossage curcol - (if bracep 0 c-indent-level))))) - - -(defun cc-substatement-open-offset (langelem) - (+ c-continued-statement-offset c-continued-brace-offset)) - - -(provide 'cc-compat) -;;; cc-compat.el ends here
--- a/lisp/modes/cc-guess.el Mon Aug 13 09:43:39 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,100 +0,0 @@ -;;; cc-guess.el --- guess indentation values by scanning existing code - -;; Copyright (C) 1994-1995 Free Software Foundation, Inc. - -;; Author: 1994-1995 Barry A. Warsaw -;; Maintainer: cc-mode-help@merlin.cnri.reston.va.us -;; Created: August 1994, split from cc-mode.el -;; Version: 1.7 -;; Last Modified: 1995/08/28 20:39:43 -;; Keywords: c languages oop - -;; This file is not part of GNU Emacs. - -;; 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 -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Commentary: -;; -;; This file contains routines that help guess the cc-mode style in a -;; particular region of C, C++, or Objective-C code. It is provided -;; for example and experimentation only. It is not supported in -;; anyway. Some folks have asked for a style guesser and the best way -;; to show my thoughts on the subject is with this sample code. Feel -;; free to improve upon it in anyway you'd like. Please send me the -;; results. Note that style guessing is lossy! -;; -;; The way this is intended to be run is for you to mark a region of -;; code to guess the style of, then run the command, cc-guess-region. - -;;; Code: - -(defvar cc-guessed-style nil - "Currently guessed style.") - -(defvar cc-guess-conversions - '((c . c-lineup-C-comments) - (inher-cont . c-lineup-multi-inher) - (string . -1000) - (comment-intro . c-lineup-comment) - (arglist-cont-nonempty . c-lineup-arglist) - (cpp-macro . -1000))) - - -(defun cc-guess-region (start end &optional reset) - "Sets `c-offset-alist' indentation values based on region of code. -Every line of code in the region is examined and the indentation -values of the various syntactic symbols in `c-offset-alist' is -guessed. The first such positively identified indentation is used, so -if an inconsistent style exists in the C code, the guessed indentation -may be incorrect. - -Note that the larger the region to guess in, the slower the -guessing. Previous guesses can be concatenated together, unless the -optional RESET is provided. - -See `cc-guess-write-style' to find out how to save the guessed style, -and `cc-guess-view-style' for viewing the guessed style." - (interactive "r\nP") - (if (consp reset) - (setq cc-guessed-style nil)) - (save-excursion - (goto-char start) - (while (< (point) end) - (let* ((syntax (c-guess-basic-syntax)) - (relpos (cdr (car syntax))) - (symbol (car (car syntax))) - point-indent relpos-indent) - ;; TBD: for now I can't guess indentation when more than 1 - ;; symbol is on the list, nor for symbols without relpos's - (if (or (/= 1 (length syntax)) - (not (numberp relpos)) - ;; also, don't try to reguess an already guessed - ;; symbol - (assq symbol cc-guessed-style)) - nil - (back-to-indentation) - (setq point-indent (current-column) - relpos-indent (save-excursion - (goto-char relpos) - (current-column))) - ;; guessed indentation is the difference between point's and - ;; relpos's current-column indentation - (setq cc-guessed-style - (cons (cons symbol (- point-indent relpos-indent)) - cc-guessed-style)) - )) - (forward-line 1)))) - -;;; cc-guess.el ends here
--- a/lisp/modes/cc-lobotomy.el Mon Aug 13 09:43:39 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,200 +0,0 @@ -;;; cc-lobotomy.el --- excise portions of cc-mode's brain... for speed - -;; Copyright (C) 1985-1995 Free Software Foundation, Inc. - -;; Author: 1995 Barry A. Warsaw -;; Maintainer: cc-mode-help@merlin.cnri.reston.va.us -;; Created: March 1995, split from cc-mode.el -;; Version: 1.8 -;; Last Modified: 1995/06/11 21:42:31 -;; Keywords: c languages oop - -;; This file is not part of GNU Emacs. - -;; 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 -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Commentary: -;; -;; Every effort has been made to improve the performance of -;; cc-mode. However, due to the nature of the C, C++, and Objective-C -;; language definitions, a trade-off is often required between -;; accuracy of construct recognition and speed. I believe it is always -;; best to be correct, and that the mode is currently fast enough for -;; most normal usage. Others disagree. I have no intention of -;; including these hacks in the main distribution. When cc-mode -;; version 5 comes out, it will include a rewritten indentation engine -;; so that performance will be greatly improved automatically. This -;; was not included in this release of version 4 so that Emacs 18 -;; could still be supported. Note that this implies that cc-mode -;; version 5 will *not* work on Emacs 18! -;; -;; To use, see the variable cc-lobotomy-pith-list and the function -;; cc-lobotomize. The variable contains a good explanation of the -;; speed/accuracy trade-offs for each option. Set it to what you'd -;; like, and call cc-lobotomy in your c-mode-hook. -;; -;; This will redefine certain cc-mode functions and affect all cc-mode -;; buffers globally. -;; -;; This file is completely unsupported! I have no idea whether this -;; will work with such things as cc-mode-18.el. - - -;;; Code: -(require 'cc-mode) - -(defvar cc-lobotomy-pith-list () - "*List of things to dumb-ify to speed up cc-mode. Note that each -incurs a penalty in correct identification of certain code constructs. -Possible values to put on this list: - - 'literal -- `c-in-literal' is lobotomized. This will significantly - speed up parsing over large lists of cpp macros, as seen - for instance in header files. The penalty is that you - cannot put the `#' character as the first non-whitespace - character on a line inside other multi-line literals - (i.e. comments or strings) - - 'class -- `c-narrow-out-enclosing-class' and `c-search-uplist for - classkey' are lobotomized. This speeds up some - indenting inside and around class and struct - definitions. The penalty is that elements inside of - classes and structs may not indent correctly. - - 'lists -- `c-inside-bracelist-p' is lobotomized. This speeds up - indenting inside and around brace lists (e.g. aggregate - initializers, enum lists, etc.). The penalty is that - elements inside these lists may not indent correctly.") - -(defun cc-lobotomize () - "Perform lobotomies on cc-mode as described in `cc-lobotomy-pith-list'." - (let (pithedp) - (if (memq 'literal cc-lobotomy-pith-list) - (progn - (fset 'c-in-literal 'cc-in-literal-lobotomized) - (setq pithedp t))) - (if (memq 'class cc-lobotomy-pith-list) - (progn - (fset 'c-narrow-out-enclosing-class - 'cc-narrow-out-enclosing-class-lobotomized) - (fset 'c-search-uplist-for-classkey - 'cc-search-uplist-for-classkey-lobotomized) - (setq pithedp t))) - (if (memq 'lists cc-lobotomy-pith-list) - (progn - (fset 'c-inside-bracelist-p 'cc-inside-bracelist-p-lobotomized) - (setq pithedp t))) - (if pithedp - (fset 'c-submit-bug-report 'cc-submit-bug-report-lobotomized)) - )) - - -;; This is a faster version of c-in-literal. It trades speed for one -;; approximation, namely that within other literals, the `#' character -;; cannot be the first non-whitespace on a line. -(defun cc-in-literal-lobotomized (&optional lim) - ;; first check the cache - (if (and (boundp 'c-in-literal-cache) - c-in-literal-cache - (= (point) (aref c-in-literal-cache 0))) - (aref c-in-literal-cache 1) - ;; quickly check for cpp macro. this breaks if the `#' character - ;; appears as the first non-whitespace on a line inside another - ;; literal. - (let* (state - (char-at-boi (char-after (c-point 'boi))) - (rtn (cond - ((and char-at-boi (= char-at-boi ?#)) - 'pound) - ((nth 3 (setq state (save-excursion - (parse-partial-sexp - (or lim (c-point 'bod)) - (point))))) - 'string) - ((nth 4 state) (if (nth 7 state) 'c++ 'c)) - (t nil)))) - ;; cache this result if the cache is enabled - (and (boundp 'c-in-literal-cache) - (setq c-in-literal-cache (vector (point) rtn))) - rtn))) - -(defun cc-narrow-out-enclosing-class-lobotomized (dummy1 dummy2) nil) - -(defun cc-search-uplist-for-classkey-lobotomized (dummy) nil) - -(defun cc-inside-bracelist-p-lobotomized (dummy1 dummy2) nil) - -(defun cc-submit-bug-report-lobotomized () - "Submit via mail a bug report on cc-mode." - (interactive) - ;; load in reporter - (let ((reporter-prompt-for-summary-p t) - (reporter-dont-compact-list '(c-offsets-alist))) - (and - (y-or-n-p "Do you want to submit a report on cc-mode? ") - (require 'reporter) - (reporter-submit-bug-report - c-mode-help-address - (concat "cc-mode " c-version " (" - (cond ((eq major-mode 'c++-mode) "C++") - ((eq major-mode 'c-mode) "C") - ((eq major-mode 'objc-mode) "ObjC")) - ")") - (let ((vars (list - ;; report only the vars that affect indentation - 'c-basic-offset - 'c-offsets-alist - 'c-block-comments-indent-p - 'c-cleanup-list - 'c-comment-only-line-offset - 'c-backslash-column - 'c-delete-function - 'c-electric-pound-behavior - 'c-hanging-braces-alist - 'c-hanging-colons-alist - 'c-hanging-comment-ender-p - 'c-tab-always-indent - 'c-recognize-knr-p - 'defun-prompt-regexp - 'tab-width - ))) - (if (not (boundp 'defun-prompt-regexp)) - (delq 'defun-prompt-regexp vars) - vars)) - (function - (lambda () - (insert - (if c-special-indent-hook - (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" - "c-special-indent-hook is set to '" - (format "%s" c-special-indent-hook) - ".\nPerhaps this is your problem?\n" - "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n") - "\n") - (format "c-emacs-features: %s\n" c-emacs-features) - ))) - (function - (lambda () - (insert - "You are using cc-lobotomy.el. You realize that by doing\n" - "so you have already made the decision to trade off accuracy\n" - "for speed? Don't set your hopes too high that your problem\n" - "will be fixed.\n\n" - ))) - "Dear Barry," - )))) - -(provide 'cc-lobotomy) -;;; cc-lobotomy.el ends here
--- a/lisp/modes/cc-mode.el Mon Aug 13 09:43:39 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5556 +0,0 @@ -;;; cc-mode.el --- major mode for editing C, C++, Objective-C, and Java code - -;; Copyright (C) 1985,87,92,93,94,95,96,97 Free Software Foundation, Inc. - -;; Authors: 1992-1997 Barry A. Warsaw -;; 1987 Dave Detlefs and Stewart Clamen -;; 1985 Richard M. Stallman -;; Created: a long, long, time ago. adapted from the original c-mode.el -;; Version: 4.390-x -;; Last Modified: 1997/04/02 15:46:35 -;; Keywords: c languages oop - -;; NOTE: Read the commentary below for the right way to submit bug reports! -;; NOTE: See the accompanying texinfo manual for details on using this mode! - -;; 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 package provides GNU Emacs major modes for editing C, C++, -;; Objective-C, and Java code. As of the latest Emacs and XEmacs -;; releases, it is the default package for editing these languages. -;; This package is called "CC Mode", and should be spelled exactly -;; this way. It supports K&R and ANSI C, ANSI C++, Objective-C, and -;; Java, with a consistent indentation model across all modes. This -;; indentation model is intuitive and very flexible, so that almost -;; any desired style of indentation can be supported. Installation, -;; usage, and programming details are contained in an accompanying -;; texinfo manual. - -;; CC Mode's immediate ancestors were, c++-mode.el, cplus-md.el, and -;; cplus-md1.el.. - -;; NOTE: This mode does not perform font-locking (a.k.a syntactic -;; coloring, keyword highlighting, etc.) for any of the supported -;; modes. Typically this is done by a package called font-lock.el -;; which I do *not* maintain. You should contact the Emacs -;; maintainers for questions about coloring or highlighting in any -;; language mode. - -;; To submit bug reports, type "C-c C-b". These will be sent to -;; bug-gnu-emacs@prep.ai.mit.edu as well as cc-mode-help@python.org, -;; and I'll read about them there (the former is mirrored as the -;; Usenet newsgroup gnu.emacs.bug). Questions can sent to -;; help-gnu-emacs@prep.ai.mit.edu (mirrored as gnu.emacs.help) and/or -;; cc-mode-help@python.org. Please do not send bugs or questions to -;; my personal account. - -;; YOU CAN IGNORE ALL BYTE-COMPILER WARNINGS. They are the result of -;; the cross-Emacsen support. GNU Emacs 19 (from the FSF), GNU XEmacs -;; 19 (formerly Lucid Emacs), and GNU Emacs 18 all do things -;; differently and there's no way to shut the byte-compiler up at the -;; necessary granularity. Let me say this again: YOU CAN IGNORE ALL -;; BYTE-COMPILER WARNINGS (you'd be surprised at how many people don't -;; follow this advice :-). - -;; Many, many thanks go out to all the folks on the beta test list. -;; Without their patience, testing, insight, code contributions, and -;; encouragement CC Mode would be a far inferior package. - -;; You can get the latest version of CC Mode, including PostScript -;; documentation and separate individual files from: -;; -;; http://www.python.org/ftp/emacs/ - -;; Or if you don't have access to the World Wide Web, through -;; anonymous ftp from: -;; -;; ftp://ftp.python.org/pub/emacs - -;; Customization added by Hrvoje Niksic <hniksic@srce.hr> - -;;; Code: - - -;; user definable variables -;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv - -(defgroup cc-mode nil - "Major mode for editing C, C++, Objective-C, and Java code" - :group 'c - :prefix "c-") - -(defgroup cc-style nil - "Styles for cc mode" - :prefix "c-" - :group 'cc-mode) - -(defgroup cc-indent nil - "Indentation of cc-mode" - :prefix "c-" - :group 'cc-mode) - -(defgroup cc-syntax nil - "Syntactical analysis performed by cc-mode" - :prefix "c-" - :group 'cc-mode) - -(defgroup cc-comment nil - "Handling of comments by cc-mode" - :prefix "c-" - :group 'cc-mode) - -(defgroup cc-auto nil - "Auto-insertion features of cc-mode" - :prefix "c-" - :group 'cc-mode) - - -(defcustom c-inhibit-startup-warnings-p nil - "*If non-nil, inhibits start up compatibility warnings." - :type 'boolean - :group 'cc-mode) -(defcustom c-strict-syntax-p nil - "*If non-nil, all syntactic symbols must be found in `c-offsets-alist'. -If the syntactic symbol for a particular line does not match a symbol -in the offsets alist, an error is generated, otherwise no error is -reported and the syntactic symbol is ignored." - :type 'boolean - :group 'cc-syntax) -(defcustom c-echo-syntactic-information-p nil - "*If non-nil, syntactic info is echoed when the line is indented." - :type 'boolean - :group 'cc-syntax) -(defcustom c-basic-offset 4 - "*Amount of basic offset used by + and - symbols in `c-offsets-alist'." - :type 'integer - :group 'cc-indent) - -(defcustom c-offsets-alist - '((string . -1000) - (c . c-lineup-C-comments) - (defun-open . 0) - (defun-close . 0) - (defun-block-intro . +) - (class-open . 0) - (class-close . 0) - (inline-open . +) - (inline-close . 0) - (func-decl-cont . +) - (knr-argdecl-intro . +) - (knr-argdecl . 0) - (topmost-intro . 0) - (topmost-intro-cont . 0) - (member-init-intro . +) - (member-init-cont . 0) - (inher-intro . +) - (inher-cont . c-lineup-multi-inher) - (block-open . 0) - (block-close . 0) - (brace-list-open . 0) - (brace-list-close . 0) - (brace-list-intro . +) - (brace-list-entry . 0) - (statement . 0) - ;; some people might prefer - ;;(statement . c-lineup-runin-statements) - (statement-cont . +) - ;; some people might prefer - ;;(statement-cont . c-lineup-math) - (statement-block-intro . +) - (statement-case-intro . +) - (statement-case-open . 0) - (substatement . +) - (substatement-open . +) - (case-label . 0) - (access-label . -) - (label . 2) - (do-while-closure . 0) - (else-clause . 0) - (comment-intro . c-lineup-comment) - (arglist-intro . +) - (arglist-cont . 0) - (arglist-cont-nonempty . c-lineup-arglist) - (arglist-close . +) - (stream-op . c-lineup-streamop) - (inclass . +) - (cpp-macro . -1000) - (friend . 0) - (objc-method-intro . -1000) - (objc-method-args-cont . c-lineup-ObjC-method-args) - (objc-method-call-cont . c-lineup-ObjC-method-call) - (extern-lang-open . 0) - (extern-lang-close . 0) - (inextern-lang . +) - ) - "*Association list of syntactic element symbols and indentation offsets. -As described below, each cons cell in this list has the form: - - (SYNTACTIC-SYMBOL . OFFSET) - -When a line is indented, CC Mode first determines the syntactic -context of the line by generating a list of symbols called syntactic -elements. This list can contain more than one syntactic element and -the global variable `c-syntactic-context' contains the context list -for the line being indented. Each element in this list is actually a -cons cell of the syntactic symbol and a buffer position. This buffer -position is called the relative indent point for the line. Some -syntactic symbols may not have a relative indent point associated with -them. - -After the syntactic context list for a line is generated, CC Mode -calculates the absolute indentation for the line by looking at each -syntactic element in the list. First, it compares the syntactic -element against the SYNTACTIC-SYMBOL's in `c-offsets-alist'. When it -finds a match, it adds the OFFSET to the column of the relative indent -point. The sum of this calculation for each element in the syntactic -list is the absolute offset for line being indented. - -If the syntactic element does not match any in the `c-offsets-alist', -an error is generated if `c-strict-syntax-p' is non-nil, otherwise the -element is ignored. - -Actually, OFFSET can be an integer, a function, a variable, or one of -the following symbols: `+', `-', `++', `--', `*', or `/'. These -latter designate positive or negative multiples of `c-basic-offset', -respectively: *1, *-1, *2, *-2, *0.5, and *-0.5. If OFFSET is a -function, it is called with a single argument containing the cons of -the syntactic element symbol and the relative indent point. The -function should return an integer offset. - -Here is the current list of valid syntactic element symbols: - - string -- inside multi-line string - c -- inside a multi-line C style block comment - defun-open -- brace that opens a function definition - defun-close -- brace that closes a function definition - defun-block-intro -- the first line in a top-level defun - class-open -- brace that opens a class definition - class-close -- brace that closes a class definition - inline-open -- brace that opens an in-class inline method - inline-close -- brace that closes an in-class inline method - func-decl-cont -- the nether region between a function - declaration and the defun opening brace. - In C++ and Java, this can include `throws' - declarations - knr-argdecl-intro -- first line of a K&R C argument declaration - knr-argdecl -- subsequent lines in a K&R C argument declaration - topmost-intro -- the first line in a topmost construct definition - topmost-intro-cont -- topmost definition continuation lines - member-init-intro -- first line in a member initialization list - member-init-cont -- subsequent member initialization list lines - inher-intro -- first line of a multiple inheritance list - inher-cont -- subsequent multiple inheritance lines - block-open -- statement block open brace - block-close -- statement block close brace - brace-list-open -- open brace of an enum or static array list - brace-list-close -- close brace of an enum or static array list - brace-list-intro -- first line in an enum or static array list - brace-list-entry -- subsequent lines in an enum or static array list - statement -- a C (or like) statement - statement-cont -- a continuation of a C (or like) statement - statement-block-intro -- the first line in a new statement block - statement-case-intro -- the first line in a case `block' - statement-case-open -- the first line in a case block starting with brace - substatement -- the first line after an if/while/for/do/else - substatement-open -- the brace that opens a substatement block - case-label -- a case or default label - access-label -- C++ private/protected/public access label - label -- any non-special C (or like) label - do-while-closure -- the `while' that ends a do/while construct - else-clause -- the `else' of an if/else construct - comment-intro -- a line containing only a comment introduction - arglist-intro -- the first line in an argument list - arglist-cont -- subsequent argument list lines when no - arguments follow on the same line as the - arglist opening paren - arglist-cont-nonempty -- subsequent argument list lines when at - least one argument follows on the same - line as the arglist opening paren - arglist-close -- the solo close paren of an argument list - stream-op -- lines continuing a stream operator construct - inclass -- the construct is nested inside a class definition - cpp-macro -- the start of a cpp macro - friend -- a C++ friend declaration - objc-method-intro -- the first line of an Objective-C method definition - objc-method-args-cont -- lines continuing an Objective-C method definition - objc-method-call-cont -- lines continuing an Objective-C method call - extern-lang-open -- brace that opens an external language block - extern-lang-close -- brace that closes an external language block - inextern-lang -- analogous to `inclass' syntactic symbol -" - :type '(repeat (cons symbol sexp)) - :group 'cc-syntax - :group 'cc-indent) - -(defcustom c-tab-always-indent t - "*Controls the operation of the TAB key. -If t, hitting TAB always just indents the current line. If nil, -hitting TAB indents the current line if point is at the left margin or -in the line's indentation, otherwise it insert a `real' tab character -\(see note\). If other than nil or t, then tab is inserted only -within literals -- defined as comments and strings -- and inside -preprocessor directives, but line is always reindented. - -Note: The value of `indent-tabs-mode' will determine whether a real -tab character will be inserted, or the equivalent number of space. -When inserting a tab, actually the function stored in the variable -`c-insert-tab-function' is called. - -Note: indentation of lines containing only comments is also controlled -by the `c-comment-only-line-offset' variable." - :type '(choice (const :tag "on" t) - (const :tag "off" nil) - (const :tag "insert within literals" other)) - :group 'cc-indent) - -(defcustom c-insert-tab-function 'insert-tab - "*Function used when inserting a tab for \\[TAB]. -Only used when `c-tab-always-indent' indicates a `real' tab character -should be inserted. Value must be a function taking no arguments." - :type 'function - :group 'cc-indent) - -(defcustom c-comment-only-line-offset 0 - "*Extra offset for line which contains only the start of a comment. -Can contain an integer or a cons cell of the form: - - (NON-ANCHORED-OFFSET . ANCHORED-OFFSET) - -Where NON-ANCHORED-OFFSET is the amount of offset given to -non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is -the amount of offset to give column-zero anchored comment-only lines. -Just an integer as value is equivalent to (<val> . -1000)." - :type '(choice integer - (cons integer integer)) - :group 'cc-comment) - -(defcustom c-indent-comments-syntactically-p nil - "*Specifies how comment-only lines should be indented. -When this variable is non-nil, comment-only lines are indented -according to syntactic analysis via `c-offsets-alist', even when -\\[indent-for-comment] is used." - :type 'boolean - :group 'cc-indent - :group 'cc-comment) - -(defcustom c-cleanup-list '(scope-operator) - "*List of various C/C++/ObjC constructs to \"clean up\". -These clean ups only take place when the auto-newline feature is -turned on, as evidenced by the `/a' or `/ah' appearing next to the -mode name. Valid symbols are: - - brace-else-brace -- cleans up `} else {' constructs by placing entire - construct on a single line. This clean up - only takes place when there is nothing but - white space between the braces and the `else'. - Clean up occurs when the open-brace after the - `else' is typed. - brace-elseif-brace -- similar to brace-else-brace, but cleans up - `} else if {' constructs. - empty-defun-braces -- cleans up empty defun braces by placing the - braces on the same line. Clean up occurs when - the defun closing brace is typed. - defun-close-semi -- cleans up the terminating semi-colon on defuns - by placing the semi-colon on the same line as - the closing brace. Clean up occurs when the - semi-colon is typed. - list-close-comma -- cleans up commas following braces in array - and aggregate initializers. Clean up occurs - when the comma is typed. - scope-operator -- cleans up double colons which may designate - a C++ scope operator split across multiple - lines. Note that certain C++ constructs can - generate ambiguous situations. This clean up - only takes place when there is nothing but - whitespace between colons. Clean up occurs - when the second colon is typed." - :type '(repeat (choice (const brace-else-brace) (const brace-elseif-brace) - (const empty-defun-braces) (const defun-close-semi) - (const list-close-comma) (const scope-operator))) - :group 'cc-auto) - -(defcustom c-hanging-braces-alist '((brace-list-open) - (substatement-open after) - (block-close . c-snug-do-while) - (extern-lang-open after) - ) - "*Controls the insertion of newlines before and after braces. -This variable contains an association list with elements of the -following form: (SYNTACTIC-SYMBOL . ACTION). - -When a brace (either opening or closing) is inserted, the syntactic -context it defines is looked up in this list, and if found, the -associated ACTION is used to determine where newlines are inserted. -If the context is not found, the default is to insert a newline both -before and after the brace. - -SYNTACTIC-SYMBOL can be any of: defun-open, defun-close, class-open, -class-close, inline-open, inline-close, block-open, block-close, -substatement-open, statement-case-open, extern-lang-open, -extern-lang-close, brace-list-open, brace-list-close, -brace-list-intro, or brace-list-entry. See `c-offsets-alist' for -details. - -ACTION can be either a function symbol or a list containing any -combination of the symbols `before' or `after'. If the list is empty, -no newlines are inserted either before or after the brace. - -When ACTION is a function symbol, the function is called with a two -arguments: the syntactic symbol for the brace and the buffer position -at which the brace was inserted. The function must return a list as -described in the preceding paragraph. Note that during the call to -the function, the variable `c-syntactic-context' is set to the entire -syntactic context for the brace line." - :type '(repeat (cons symbol (choice (const nil) - (repeat (choice (const before) - (const after))) - function - ))) - :group 'cc-auto) - -(defcustom c-hanging-colons-alist nil - "*Controls the insertion of newlines before and after certain colons. -This variable contains an association list with elements of the -following form: (SYNTACTIC-SYMBOL . ACTION). - -See the variable `c-hanging-braces-alist' for the semantics of this -variable. Note however that making ACTION a function symbol is -currently not supported for this variable." - :type '(repeat (cons symbol (choice (repeat (choice (const before) - (const after))) - ))) - :group 'cc-auto) - -(defcustom c-hanging-semi&comma-criteria '(c-semi&comma-inside-parenlist) - "*List of functions that decide whether to insert a newline or not. -The functions in this list are called, in order, whenever the -auto-newline minor mode is activated (as evidenced by a `/a' or `/ah' -string in the mode line), and a semicolon or comma is typed (see -`c-electric-semi&comma'). Each function in this list is called with -no arguments, and should return one of the following values: - - nil -- no determination made, continue checking - 'stop -- do not insert a newline, and stop checking - (anything else) -- insert a newline, and stop checking - -If every function in the list is called with no determination made, -then no newline is inserted." - :type '(repeat function) - :group 'cc-auto) - -(defcustom c-hanging-comment-ender-p t - "*Controls what \\[fill-paragraph] does to C block comment enders. -When set to nil, C block comment enders are left on their own line. -When set to t, block comment enders will be placed at the end of the -previous line (i.e. they `hang' on that line)." - :type 'boolean - :group 'cc-comment) - -(defcustom c-hanging-comment-starter-p t - "*Controls what \\[fill-paragraph] does to C block comment starters. -When set to nil, C block comment starters are left on their own line. -When set to t, text that follows a block comment starter will be -placed on the same line as the block comment starter (i.e. the text -`hangs' on that line)." - :type 'boolean - :group 'cc-comment) - -(defcustom c-backslash-column 48 - "*Column to insert backslashes when macroizing a region." - :type 'integer - :group 'cc-mode) -(defcustom c-special-indent-hook nil - "*Hook for user defined special indentation adjustments. -This hook gets called after a line is indented by the mode." - :type 'hook - :group 'cc-indent) -(defcustom c-delete-function (if (fboundp 'backward-or-forward-delete-char) - 'backward-or-forward-delete-char - 'backward-delete-char-untabify) - "*Function called by `c-electric-delete' when deleting characters." - :type 'function - :group 'cc-mode) -(defcustom c-electric-pound-behavior nil - "*List of behaviors for electric pound insertion. -Only currently supported behavior is `alignleft'." - :type '(repeat (choice (const alignleft))) - :group 'cc-auto) - -(defcustom c-label-minimum-indentation 1 - "*Minimum indentation for lines inside of top-level constructs. -This variable typically only affects code using the `gnu' style, which -mandates a minimum of one space in front of every line inside -top-level constructs. Specifically, the function -`c-gnu-impose-minimum' on your `c-special-indent-hook' is what -enforces this." - :type 'integer - :group 'cc-indent) - -(defcustom c-progress-interval 5 - "*Interval used to update progress status during long re-indentation. -If a number, percentage complete gets updated after each interval of -that many seconds. Set to nil to inhibit updating. This is only -useful for Emacs 19." - :type 'integer - :group 'cc-indent) - -(defconst c-style-alist - '(("gnu" - (c-basic-offset . 2) - (c-comment-only-line-offset . (0 . 0)) - (c-offsets-alist . ((statement-block-intro . +) - (knr-argdecl-intro . 5) - (substatement-open . +) - (label . 0) - (statement-case-open . +) - (statement-cont . +) - (arglist-intro . c-lineup-arglist-intro-after-paren) - (arglist-close . c-lineup-arglist) - )) - (c-special-indent-hook . c-gnu-impose-minimum) - ) - ("k&r" - (c-basic-offset . 5) - (c-comment-only-line-offset . 0) - (c-offsets-alist . ((statement-block-intro . +) - (knr-argdecl-intro . 0) - (substatement-open . 0) - (label . 0) - (statement-cont . +) - )) - ) - ("bsd" - (c-basic-offset . 4) - (c-comment-only-line-offset . 0) - (c-offsets-alist . ((statement-block-intro . +) - (knr-argdecl-intro . +) - (substatement-open . 0) - (label . 0) - (statement-cont . +) - )) - ) - ("stroustrup" - (c-basic-offset . 4) - (c-comment-only-line-offset . 0) - (c-offsets-alist . ((statement-block-intro . +) - (substatement-open . 0) - (label . 0) - (statement-cont . +) - )) - ) - ("whitesmith" - (c-basic-offset . 4) - (c-comment-only-line-offset . 0) - (c-offsets-alist . ((statement-block-intro . +) - (knr-argdecl-intro . +) - (substatement-open . 0) - (label . 0) - (statement-cont . +) - )) - - ) - ("ellemtel" - (c-basic-offset . 3) - (c-comment-only-line-offset . 0) - (c-hanging-braces-alist . ((substatement-open before after))) - (c-offsets-alist . ((topmost-intro . 0) - (topmost-intro-cont . 0) - (substatement . +) - (substatement-open . 0) - (case-label . +) - (access-label . -) - (inclass . ++) - (inline-open . 0) - )) - ) - ("linux" - (c-basic-offset . 8) - (c-comment-only-line-offset . 0) - (c-hanging-braces-alist . ((brace-list-open) - (substatement-open after) - (block-close . c-snug-do-while))) - (c-cleanup-list . (brace-else-brace)) - (c-offsets-alist . ((statement-block-intro . +) - (knr-argdecl-intro . 0) - (substatement-open . 0) - (label . 0) - (statement-cont . +) - )) - ) - ("python" - (indent-tabs-mode . t) - (c-basic-offset . 8) - (c-offsets-alist . ((substatement-open . 0) - )) - (c-hanging-braces-alist . ((brace-list-open) - (brace-list-intro) - (brace-list-close) - (substatement-open after) - (block-close . c-snug-do-while) - )) - ) - ("java" - (c-basic-offset . 2) - (c-comment-only-line-offset . (0 . 0)) - (c-offsets-alist . ((statement-block-intro . +) - (knr-argdecl-intro . 5) - (substatement-open . +) - (label . 0) - (statement-case-open . +) - (statement-cont . +) - (arglist-intro . c-lineup-arglist-intro-after-paren) - (arglist-close . c-lineup-arglist) - (access-label . 0) - (inher-cont . c-lineup-java-inher) - )) - - ) - ) - "Styles of Indentation. -Elements of this alist are of the form: - - (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...]) - -where STYLE-STRING is a short descriptive string used to select a -style, VARIABLE is any CC Mode variable, and VALUE is the intended -value for that variable when using the selected style. - -There is one special case when VARIABLE is `c-offsets-alist'. In this -case, the VALUE is a list containing elements of the form: - - (SYNTACTIC-SYMBOL . VALUE) - -as described in `c-offsets-alist'. These are passed directly to -`c-set-offset' so there is no need to set every syntactic symbol in -your style, only those that are different from the default. - -Note that all styles inherit from the `cc-mode' style, which is -computed at the time the mode is loaded.") - -(defcustom c-file-style nil - "*Variable interface for setting style via File Local Variables. -In a file's Local Variable section, you can set this variable to a -string suitable for `c-set-style'. When the file is visited, CC Mode -will set the style of the file to this value automatically. - -Note that file style settings are applied before file offset settings -as designated in the variable `c-file-offsets'." - :type '(repeat (cons regexp (string :tag "Style"))) - :group 'cc-style) - -(defcustom c-file-offsets nil - "*Variable interface for setting offsets via File Local Variables. -In a file's Local Variable section, you can set this variable to an -association list similar to the values allowed in `c-offsets-alist'. -When the file is visited, CC Mode will institute these offset settings -automatically. - -Note that file offset settings are applied after file style settings -as designated in the variable `c-file-style'." - :type '(repeat (cons regexp (string :tag "Style"))) - :group 'cc-indent) - -(defcustom c-site-default-style "gnu" - "Default style for your site. -To change the default style at your site, you can set this variable to -any style defined in `c-style-alist'. However, if CC Mode is usually -loaded into your Emacs at compile time, you will need to set this -variable in the `site-init.el' file before CC Mode is loaded, then -re-dump Emacs." - :type 'string - :group 'cc-style) - -(defcustom c-style-variables-are-local-p t - "*Whether style variables should be buffer local by default. -If non-nil, then all indentation style related variables will be made -buffer local by default. If nil, they will remain global. Variables -are made buffer local when this file is loaded, and once buffer -localized, they cannot be made global again. - -The list of variables to buffer localize are: - c-offsets-alist - c-basic-offset - c-file-style - c-file-offsets - c-comment-only-line-offset - c-cleanup-list - c-hanging-braces-alist - c-hanging-colons-alist - c-hanging-comment-starter-p - c-hanging-comment-ender-p - c-backslash-column - c-label-minimum-indentation - c-special-indent-hook - c-indentation-style" - :type 'boolean - :group 'cc-style) - - -(defcustom c-mode-hook nil - "*Hook called by `c-mode'." - :type 'hook - :group 'cc-mode) -(defcustom c++-mode-hook nil - "*Hook called by `c++-mode'." - :type 'hook - :group 'cc-mode) -(defcustom objc-mode-hook nil - "*Hook called by `objc-mode'." - :type 'hook - :group 'cc-mode) -(defcustom java-mode-hook nil - "*Hook called by `java-mode'." - :type 'hook - :group 'cc-mode) - -(defcustom c-mode-common-hook nil - "*Hook called by all CC Mode modes for common initializations." - :type 'hook - :group 'cc-mode) - -(defvar c-mode-menu - '(["Comment Out Region" comment-region (mark)] - ["Macro Expand Region" c-macro-expand (mark)] - ["Backslashify" c-backslash-region (mark)] - ["Indent Expression" c-indent-exp - (memq (following-char) '(?\( ?\[ ?\{))] - ["Indent Line" c-indent-command t] - ["Fill Comment Paragraph" c-fill-paragraph t] - ["Up Conditional" c-up-conditional t] - ["Backward Conditional" c-backward-conditional t] - ["Forward Conditional" c-forward-conditional t] - ["Backward Statement" c-beginning-of-statement t] - ["Forward Statement" c-end-of-statement t] - ) - "Basic XEmacs 19 menu for C/C++/ObjC/Java modes.") - - -;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -;; NO USER DEFINABLE VARIABLES BEYOND THIS POINT - -;; imenu integration -(defvar cc-imenu-c++-generic-expression - (` - ((nil - (, - (concat - "^" ; beginning of line is required - "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" - "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; type specs; there can be no - "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; more than 3 tokens, right? - - "\\(" ; last type spec including */& - "[a-zA-Z0-9_:]+" - "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either ptr/ref sign or ws - "\\)?" ; if there is a last type spec - "\\(" ; name, take into the imenu entry - "[a-zA-Z0-9_:~]+" ; member func, ctor or dtor... - ; (may not contain * because then - ; "a::operator char*" would - ; become "char*"!) - "\\|" - "\\([a-zA-Z0-9_:~]*::\\)?operator" - "[^a-zA-Z1-9_][^(]*" ; ...or operator - " \\)" - "[ \t]*([^)]*)[ \t\n]*[^ ;]" ; require something other than - ; a `;' after the (...) to - ; avoid prototypes. Can't - ; catch cases with () inside - ; the parentheses surrounding - ; the parameters. e.g.: - ; "int foo(int a=bar()) {...}" - - )) 6) - ("Class" - (, (concat - "^" ; beginning of line is required - "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" - "class[ \t]+" - "\\([a-zA-Z0-9_]+\\)" ; the string we want to get - "[ \t]*[:{]" - )) 2))) - "Imenu generic expression for C++ mode. See `imenu-generic-expression'.") - -(defvar cc-imenu-c-generic-expression - cc-imenu-c++-generic-expression - "Imenu generic expression for C mode. See `imenu-generic-expression'.") - -;(defvar cc-imenu-objc-generic-expression -; ()) -; Please contribute one! - -(defvar cc-imenu-java-generic-expression - (` - ((nil - (, - (concat - "^\\([ \t]\\)*" - "\\([A-Za-z0-9_-]+[ \t]+\\)?" ; type specs; there can be - "\\([A-Za-z0-9_-]+[ \t]+\\)?" ; more than 3 tokens, right? - "\\([A-Za-z0-9_-]+[ \t]*[[]?[]]?\\)" - "\\([ \t]\\)" - "\\([A-Za-z0-9_-]+\\)" ; the string we want to get - "\\([ \t]*\\)+(" - "\\([a-zA-Z,_1-9\n \t]*[[]?[]]?\\)*" ; arguments - ")[ \t]*" - "[^;(]" - "[,a-zA-Z_1-9\n \t]*{" - )) 6))) - "Imenu generic expression for Java mode. See `imenu-generic-expression'.") - - - -;; Shut the byte-compiler up. Requires Emacs 19 or JWZ's improved -;; byte-compiler. Otherwise, comment this line out and ignore -;; any warnings. -;;(byte-compiler-options (warnings nil)) - -;; figure out what features this Emacs has -(defconst c-emacs-features - (let ((major (and (boundp 'emacs-major-version) - emacs-major-version)) - (minor (and (boundp 'emacs-minor-version) - emacs-minor-version)) - (re-suite 'old-re) - flavor comments infodock-p) - ;; figure out version numbers if not already discovered - (and (or (not major) (not minor)) - (string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version) - (setq major (string-to-int (substring emacs-version - (match-beginning 1) - (match-end 1))) - minor (string-to-int (substring emacs-version - (match-beginning 2) - (match-end 2))))) - (if (not (and major minor)) - (error "Cannot figure out the major and minor version numbers.")) - ;; calculate the major version - (cond - ((= major 18) (setq major 'v18)) ;Emacs 18 - ((= major 4) (setq major 'v18)) ;Epoch 4 - ((= major 19) (setq major 'v19 ;Emacs 19 - flavor (if (or (string-match "Lucid" emacs-version) - (string-match "XEmacs" emacs-version)) - 'XEmacs 'FSF) - infodock-p (boundp 'infodock-version))) - ((= major 20) (setq major 'v20 ;XEmacs 20 - flavor 'XEmacs)) - ;; I don't know - (t (error "Cannot recognize major version number: %s" major))) - ;; Regular expression suites... - (if (or (eq major 'v20) - (and (eq major 'v19) - (or (and (eq flavor 'XEmacs) (>= minor 14)) - (and (eq flavor 'FSF) (>= minor 30))))) - (setq re-suite 'new-re)) - ;; XEmacs 19 uses 8-bit modify-syntax-entry flags, as do all - ;; patched Emacs 19, Emacs 18, Epoch 4's. Only Emacs 19 uses a - ;; 1-bit flag. Let's be as smart as we can about figuring this - ;; out. - (if (or (eq major 'v20) (eq major 'v19)) - (let ((table (copy-syntax-table))) - (modify-syntax-entry ?a ". 12345678" table) - (cond - ;; XEmacs pre 20 and Emacs pre 19.30 use vectors for syntax tables. - ((vectorp table) - (if (= (logand (lsh (aref table ?a) -16) 255) 255) - (setq comments '8-bit) - (setq comments '1-bit))) - ;; XEmacs 20 is known to be 8-bit - ((eq flavor 'XEmacs) (setq comments '8-bit)) - ;; Emacs 19.30 and beyond are known to be 1-bit - ((eq flavor 'FSF) (setq comments '1-bit)) - ;; Don't know what this is - (t (error "Couldn't figure out syntax table format.")) - )) - ;; Emacs 18 has no support for dual comments - (setq comments 'no-dual-comments)) - ;; lets do some minimal sanity checking. - (if (and (or - ;; Lucid Emacs before 19.6 had bugs - (and (eq major 'v19) (eq flavor 'XEmacs) (< minor 6)) - ;; Emacs 19 before 19.21 has known bugs - (and (eq major 'v19) (eq flavor 'FSF) (< minor 21))) - (not c-inhibit-startup-warnings-p)) - (with-output-to-temp-buffer "*cc-mode warnings*" - (print (format -"The version of Emacs that you are running, %s, -has known bugs in its syntax.c parsing routines which will affect the -performance of CC Mode. You should strongly consider upgrading to the -latest available version. CC Mode may continue to work, after a -fashion, but strange indentation errors could be encountered." - emacs-version)))) - ;; Emacs 18, with no patch is not too good - (if (and (eq major 'v18) (eq comments 'no-dual-comments) - (not c-inhibit-startup-warnings-p)) - (with-output-to-temp-buffer "*cc-mode warnings*" - (print (format -"The version of Emacs 18 you are running, %s, -has known deficiencies in its ability to handle dual C++ comments, -i.e. C++ line style comments and C block style comments. This will -not be much of a problem for you if you are only editing C code, but -if you are doing much C++ editing, you should strongly consider -upgrading to one of the latest Emacs 19's. In Emacs 18, you may also -experience performance degradations. Emacs 19 has some new built-in -routines which will speed things up for you. - -Because of these inherent problems, CC Mode is no longer being -actively maintained for Emacs 18, however, until you can upgrade to -Emacs 19, you may want to look at cc-mode-18.el in the CC Mode -distribution. THIS FILE IS COMPLETELY UNSUPPORTED! If you use it, -you are on your own, although patch contributions will be folded into -the main release." - emacs-version)))) - ;; Emacs 18 with the syntax patches are no longer supported - (if (and (eq major 'v18) (not (eq comments 'no-dual-comments)) - (not c-inhibit-startup-warnings-p)) - (with-output-to-temp-buffer "*cc-mode warnings*" - (print (format -"You are running a syntax patched Emacs 18 variant. While this should -work for you, you may want to consider upgrading to Emacs 19. The -syntax patches are no longer supported either for syntax.c or -CC Mode.")))) - (if infodock-p - (list major comments re-suite 'infodock) - (list major comments re-suite))) - "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: - - Emacs 18/Epoch 4: (v18 no-dual-comments RS) - Emacs 18/Epoch 4 (patch2): (v18 8-bit RS) - XEmacs 19: (v19 8-bit RS) - XEmacs 20: (v20 8-bit RS) - Emacs 19: (v19 1-bit RS) - -RS is the regular expression suite to use. XEmacs versions after -19.13, and Emacs versions after 19.29 use the `new-re' regex suite. -All other Emacsen use the `old-re' suite. - -Infodock (based on XEmacs) has an additional symbol on this list: -'infodock") - -(defvar c++-mode-abbrev-table nil - "Abbrev table in use in c++-mode buffers.") -(define-abbrev-table 'c++-mode-abbrev-table ()) - -(defvar c-mode-abbrev-table nil - "Abbrev table in use in c-mode buffers.") -(define-abbrev-table 'c-mode-abbrev-table ()) - -(defvar objc-mode-abbrev-table nil - "Abbrev table in use in objc-mode buffers.") -(define-abbrev-table 'objc-mode-abbrev-table ()) - -(defvar java-mode-abbrev-table nil - "Abbrev table in use in java-mode buffers.") -(define-abbrev-table 'java-mode-abbrev-table ()) - -(defun c-mode-fsf-menu (name map) - ;; Add menu to a keymap, but don't add them for XEmacs. This - ;; feature test will fail on other than Emacs 19. - (condition-case nil - (progn - (define-key map [menu-bar] (make-sparse-keymap)) - (define-key map [menu-bar c] (cons name (make-sparse-keymap name))) - - (define-key map [menu-bar c comment-region] - '("Comment Out Region" . comment-region)) - (define-key map [menu-bar c c-macro-expand] - '("Macro Expand Region" . c-macro-expand)) - (define-key map [menu-bar c c-backslash-region] - '("Backslashify" . c-backslash-region)) - (define-key map [menu-bar c indent-exp] - '("Indent Expression" . c-indent-exp)) - (define-key map [menu-bar c indent-line] - '("Indent Line" . c-indent-command)) - (define-key map [menu-bar c fill] - '("Fill Comment Paragraph" . c-fill-paragraph)) - (define-key map [menu-bar c separator2] - '("----")) - (define-key map [menu-bar c up] - '("Up Conditional" . c-up-conditional)) - (define-key map [menu-bar c backward] - '("Backward Conditional" . c-backward-conditional)) - (define-key map [menu-bar c forward] - '("Forward Conditional" . c-forward-conditional)) - (define-key map [menu-bar c backward-stmt] - '("Backward Statement" . c-beginning-of-statement)) - (define-key map [menu-bar c forward-stmt] - '("Forward Statement" . c-end-of-statement)) - - ;; RMS says: mouse-3 should not select this menu. mouse-3's - ;; global definition is useful in C mode and we should not - ;; interfere with that. The menu is mainly for beginners, and - ;; for them, the menubar requires less memory than a special - ;; click. - t) - (error nil))) - -(defvar c-mode-map () - "Keymap used in c-mode buffers.") -(if c-mode-map - () - ;; TBD: should we even worry about naming this keymap. My vote: no, - ;; because Emacs and XEmacs do it differently. - (setq c-mode-map (make-sparse-keymap)) - ;; put standard keybindings into MAP - ;; the following mappings correspond more or less directly to BOCM - (define-key c-mode-map "{" 'c-electric-brace) - (define-key c-mode-map "}" 'c-electric-brace) - (define-key c-mode-map ";" 'c-electric-semi&comma) - (define-key c-mode-map "#" 'c-electric-pound) - (define-key c-mode-map ":" 'c-electric-colon) - ;; Lucid Emacs 19.9 defined these two, the second of which was - ;; commented out... - ;; (define-key c-mode-map "\e{" 'c-insert-braces) - ;; Commented out electric square brackets because nobody likes them. - ;; (define-key c-mode-map "[" 'c-insert-brackets) - (define-key c-mode-map "\C-c\C-m" 'c-mark-function) - (define-key c-mode-map "\e\C-q" 'c-indent-exp) - (define-key c-mode-map "\ea" 'c-beginning-of-statement) - (define-key c-mode-map "\ee" 'c-end-of-statement) - ;; Emacs 19.30 introduces fill-paragraph-function, but it's not in - ;; every version of Emacs CC Mode supports. - (if (not (boundp 'fill-paragraph-function)) - ;; I'd rather use an adaptive fill program instead of this. - (define-key c-mode-map "\eq" 'c-fill-paragraph)) - (define-key c-mode-map "\C-c\C-n" 'c-forward-conditional) - (define-key c-mode-map "\C-c\C-p" 'c-backward-conditional) - (define-key c-mode-map "\C-c\C-u" 'c-up-conditional) - (define-key c-mode-map "\t" 'c-indent-command) - (define-key c-mode-map 'delete 'c-electric-delete) - ;; these are new keybindings, with no counterpart to BOCM - (define-key c-mode-map "," 'c-electric-semi&comma) - (define-key c-mode-map "*" 'c-electric-star) - (define-key c-mode-map "\C-c\C-q" 'c-indent-defun) - (define-key c-mode-map "\C-c\C-\\" 'c-backslash-region) - ;; TBD: where if anywhere, to put c-backward|forward-into-nomenclature - (define-key c-mode-map "\C-c\C-a" 'c-toggle-auto-state) - (define-key c-mode-map "\C-c\C-b" 'c-submit-bug-report) - (define-key c-mode-map "\C-c\C-c" 'comment-region) - (define-key c-mode-map "\C-c\C-d" 'c-toggle-hungry-state) - (define-key c-mode-map "\C-c\C-e" 'c-macro-expand) - (define-key c-mode-map "\C-c\C-o" 'c-set-offset) - (define-key c-mode-map "\C-c\C-s" 'c-show-syntactic-information) - (define-key c-mode-map "\C-c\C-t" 'c-toggle-auto-hungry-state) - (define-key c-mode-map "\C-c." 'c-set-style) - ;; conflicts with OOBR - ;;(define-key c-mode-map "\C-c\C-v" 'c-version) - ;; - (if (and - ;; Infodock has it's own menu - (not (memq 'infodock c-emacs-features)) - ;; Emacs 19 defines menus in the mode map. This call will - ;; return t on Emacs 19, otherwise no-op and return nil. - (not (c-mode-fsf-menu "CC Mode" c-mode-map)) - ;; In XEmacs 19, we want the menu to popup when the 3rd button - ;; is hit. In Lucid Emacs 19.10 and beyond this is done - ;; automatically if we put the menu on mode-popup-menu - ;; variable, see c-common-init. Emacs 19 uses C-Mouse-3 for - ;; this, and it works with no special effort. - (boundp 'current-menubar) - (not (boundp 'mode-popup-menu))) - (define-key c-mode-map 'button3 'c-popup-menu))) - -(defvar c++-mode-map () - "Keymap used in c++-mode buffers.") -(if c++-mode-map - () - ;; In Emacs 19, it makes more sense to inherit c-mode-map - (if (or - (memq 'v19 c-emacs-features) - (memq 'v20 c-emacs-features)) - ;; XEmacs and Emacs 19 do this differently - (cond - ;; XEmacs 19.13 - ((fboundp 'set-keymap-parents) - (setq c++-mode-map (make-sparse-keymap)) - (set-keymap-parents c++-mode-map c-mode-map)) - ((fboundp 'set-keymap-parent) - (setq c++-mode-map (make-sparse-keymap)) - (set-keymap-parent c++-mode-map c-mode-map)) - (t (setq c++-mode-map (cons 'keymap c-mode-map)))) - ;; Do it the hard way for Emacs 18 -- given by JWZ - (setq c++-mode-map (nconc (make-sparse-keymap) c-mode-map))) - ;; add bindings which are only useful for C++ - (define-key c++-mode-map "\C-c:" 'c-scope-operator) - (define-key c++-mode-map "/" 'c-electric-slash) - (define-key c++-mode-map "<" 'c-electric-lt-gt) - (define-key c++-mode-map ">" 'c-electric-lt-gt) - ;; Emacs 19 defines menus in the mode map. This call will return - ;; t on Emacs 19, otherwise no-op and return nil. -; (c-mode-fsf-menu "C++" c++-mode-map) - ) - -(defvar objc-mode-map () - "Keymap used in objc-mode buffers.") -(if objc-mode-map - () - ;; In Emacs 19, it makes more sense to inherit c-mode-map - (if (or (memq 'v19 c-emacs-features) (memq 'v20 c-emacs-features)) - ;; XEmacs and Emacs 19 do this differently - (cond - ;; XEmacs 19.13 - ((fboundp 'set-keymap-parents) - (setq objc-mode-map (make-sparse-keymap)) - (set-keymap-parents objc-mode-map c-mode-map)) - ((fboundp 'set-keymap-parent) - (setq objc-mode-map (make-sparse-keymap)) - (set-keymap-parent objc-mode-map c-mode-map)) - (t (setq objc-mode-map (cons 'keymap c-mode-map)))) - ;; Do it the hard way for Emacs 18 -- given by JWZ - (setq objc-mode-map (nconc (make-sparse-keymap) c-mode-map))) - ;; add bindings which are only useful for Objective-C - (define-key objc-mode-map "/" 'c-electric-slash) - ;; Emacs 19 defines menus in the mode map. This call will return - ;; t on Emacs 19, otherwise no-op and return nil. -; (c-mode-fsf-menu "ObjC" objc-mode-map) - ) - -(defvar java-mode-map () - "Keymap used in java-mode buffers.") -(if java-mode-map - () - ;; In Emacs 19, it makes more sense to inherit c-mode-map - (if (or (memq 'v19 c-emacs-features) (memq 'v20 c-emacs-features)) - ;; XEmacs and Emacs 19 do this differently - (cond - ;; XEmacs 19.13 - ((fboundp 'set-keymap-parents) - (setq java-mode-map (make-sparse-keymap)) - (set-keymap-parents java-mode-map c-mode-map)) - ((fboundp 'set-keymap-parent) - (setq java-mode-map (make-sparse-keymap)) - (set-keymap-parent java-mode-map c-mode-map)) - (t (setq java-mode-map (cons 'keymap c-mode-map))) - ) - ;; Do it the hard way for Emacs 18 -- given by JWZ - (setq java-mode-map (nconc (make-sparse-keymap) c-mode-map))) - ;; add bindings which are only useful for Java - (define-key java-mode-map "/" 'c-electric-slash) - ;; Emacs 19 defines menus in the mode map. This call will return t - ;; on Emacs 19, otherwise no-op and return nil. -; (c-mode-fsf-menu "Java" java-mode-map) - ) - -(defun c-populate-syntax-table (table) - ;; Populate the syntax TABLE - ;; DO NOT TRY TO SET _ (UNDERSCORE) TO WORD CLASS! - (modify-syntax-entry ?_ "_" table) - (modify-syntax-entry ?\\ "\\" table) - (modify-syntax-entry ?+ "." table) - (modify-syntax-entry ?- "." table) - (modify-syntax-entry ?= "." table) - (modify-syntax-entry ?% "." table) - (modify-syntax-entry ?< "." table) - (modify-syntax-entry ?> "." table) - (modify-syntax-entry ?& "." table) - (modify-syntax-entry ?| "." table) - (modify-syntax-entry ?\' "\"" table)) - -(defun c-setup-dual-comments (table) - ;; Set up TABLE to handle block and line style comments - (cond - ((memq '8-bit c-emacs-features) - ;; XEmacs 19 has the best implementation - (modify-syntax-entry ?/ ". 1456" table) - (modify-syntax-entry ?* ". 23" table) - (modify-syntax-entry ?\n "> b" table) - ;; Give CR the same syntax as newline, for selective-display - (modify-syntax-entry ?\^m "> b" table)) - ((memq '1-bit c-emacs-features) - ;; Emacs 19 does things differently, but we can work with it - (modify-syntax-entry ?/ ". 124b" table) - (modify-syntax-entry ?* ". 23" table) - (modify-syntax-entry ?\n "> b" table) - ;; Give CR the same syntax as newline, for selective-display - (modify-syntax-entry ?\^m "> b" table)) - )) - -(defvar c-mode-syntax-table nil - "Syntax table used in c-mode buffers.") -(if c-mode-syntax-table - () - (setq c-mode-syntax-table (make-syntax-table)) - (c-populate-syntax-table c-mode-syntax-table) - ;; add extra comment syntax - (modify-syntax-entry ?/ ". 14" c-mode-syntax-table) - (modify-syntax-entry ?* ". 23" c-mode-syntax-table)) - -(defvar c++-mode-syntax-table nil - "Syntax table used in c++-mode buffers.") -(if c++-mode-syntax-table - () - (setq c++-mode-syntax-table (make-syntax-table)) - (c-populate-syntax-table c++-mode-syntax-table) - ;; add extra comment syntax - (c-setup-dual-comments c++-mode-syntax-table) - ;; TBD: does it make sense for colon to be symbol class in C++? - ;; I'm not so sure, since c-label-key is busted on lines like: - ;; Foo::bar( i ); - ;; maybe c-label-key should be fixed instead of commenting this out, - ;; but it also bothers me that this only seems appropriate for C++ - ;; and not C. - ;;(modify-syntax-entry ?: "_" c++-mode-syntax-table) - ) - -(defvar objc-mode-syntax-table nil - "Syntax table used in objc-mode buffers.") -(if objc-mode-syntax-table - () - (setq objc-mode-syntax-table (make-syntax-table)) - (c-populate-syntax-table objc-mode-syntax-table) - ;; add extra comment syntax - (c-setup-dual-comments objc-mode-syntax-table) - ;; everyone gets these - (modify-syntax-entry ?@ "_" objc-mode-syntax-table) - ) - -(defvar java-mode-syntax-table nil - "Syntax table used in java-mode buffers.") -(if java-mode-syntax-table - () - (setq java-mode-syntax-table (make-syntax-table)) - (c-populate-syntax-table java-mode-syntax-table) - ;; add extra comment syntax - (c-setup-dual-comments java-mode-syntax-table) - ;; everyone gets these - (modify-syntax-entry ?@ "_" java-mode-syntax-table) - ) - -(defvar c-hungry-delete-key nil - "Internal state of hungry delete key feature.") -(defvar c-auto-newline nil - "Internal state of auto newline feature.") -(defvar c-auto-hungry-string nil - "Internal auto-newline/hungry-delete designation string for mode line.") -(defvar c-syntactic-context nil - "Variable containing syntactic analysis list during indentation.") -(defvar c-comment-start-regexp nil - "Buffer local variable describing how comment are introduced.") -(defvar c-conditional-key nil - "Buffer local language-specific conditional keyword regexp.") -(defvar c-access-key nil - "Buffer local language-specific access key regexp.") -(defvar c-class-key nil - "Buffer local language-specific class key regexp.") -(defvar c-method-key nil - "Buffer local language-specific method regexp.") -(defvar c-double-slash-is-comments-p nil - "Buffer local language-specific comment style flag.") -(defconst c-protection-key - "\\<\\(public\\|protected\\|private\\)\\>" - "Regexp describing protection keywords.") -(defconst c-symbol-key "\\(\\w\\|\\s_\\)+" - "Regexp describing a C/C++/ObjC symbol. -We cannot use just `word' syntax class since `_' cannot be in word -class. Putting underscore in word class breaks forward word movement -behavior that users are familiar with.") -(defconst c-baseclass-key - (concat - ":?[ \t]*\\(virtual[ \t]+\\)?\\(" - c-protection-key "[ \t]+\\)" c-symbol-key) - "Regexp describing C++ base classes in a derived class definition.") - -;; defconst'd instead of defvar'd to override any old pre-loaded versions -(defconst c-recognize-knr-p t - "Non-nil means K&R style argument declarations are valid.") -(defvar c-indentation-style c-site-default-style - "Name of style installed in the current buffer.") - -;; these variables should always be buffer local. they do not affect -;; indentation styles. -;; -;; minor mode variables -(make-variable-buffer-local 'c-auto-newline) -(make-variable-buffer-local 'c-hungry-delete-key) -(make-variable-buffer-local 'c-auto-hungry-string) -;; language differences -(make-variable-buffer-local 'c-comment-start-regexp) -(make-variable-buffer-local 'c-conditional-key) -(make-variable-buffer-local 'c-access-key) -(make-variable-buffer-local 'c-class-key) -(make-variable-buffer-local 'c-method-key) -(make-variable-buffer-local 'c-double-slash-is-comments-p) -(make-variable-buffer-local 'c-baseclass-key) -(make-variable-buffer-local 'c-recognize-knr-p) -;; style variables are made buffer local at tail end of this file. - -;; cmacexp is lame because it uses no preprocessor symbols. -;; It isn't very extensible either -- hardcodes /lib/cpp. -;; [I add it here only because c-mode has it -- BAW] -(autoload 'c-macro-expand "cmacexp" - "Display the result of expanding all C macros occurring in the region. -The expansion is entirely correct because it uses the C preprocessor." - t) - - -;; constant regular expressions for looking at various constructs -(defconst c-C++-class-key "\\(class\\|struct\\|union\\)" - "Regexp describing a C++ class declaration, including templates.") -(defconst c-C-class-key "\\(struct\\|union\\)" - "Regexp describing a C struct declaration.") -(defconst c-inher-key - (concat "\\(\\<static\\>\\s +\\)?" - c-C++-class-key "[ \t]+" c-symbol-key - "\\([ \t]*:[ \t]*\\)\\s *[^;]") - "Regexp describing a class inheritance declaration.") -(defconst c-switch-label-key - "\\(\\(case[( \t]+\\S .*\\)\\|default[ \t]*\\):" - "Regexp describing a switch's case or default label") -(defconst c-C++-access-key - (concat c-protection-key "[ \t]*:") - "Regexp describing C++ access specification keywords.") -(defconst c-label-key - (concat c-symbol-key ":\\([^:]\\|$\\)") - "Regexp describing any label.") -(defconst c-C-conditionals '("for" "if" "do" "else" "while" "switch") - "Shared conditional keywords for C-like languages.") -(defconst c-C-conditional-key - (concat "\\b\\(" - (mapconcat 'identity c-C-conditionals "\\|") - "\\)\\b[^_]") - "Regexp describing a conditional control for C.") -(defconst c-C++-conditional-key - (concat "\\b\\(" (mapconcat 'identity - (append '("try" "catch") c-C-conditionals) "\\|") - "\\)\\b[^_]") - "Regexp describing a conditional control for C++.") -(defconst c-C++-friend-key - "friend[ \t]+\\|template[ \t]*<.+>[ \t]*friend[ \t]+" - "Regexp describing friend declarations in C++ classes.") - -;; comment starter definitions for various languages. the language -;; modes will set c-comment-start-regexp to this value. -(defconst c-C++-comment-start-regexp "/[/*]") -(defconst c-C-comment-start-regexp "/[*]") -;; We need to match all 3 Java style comments -;; 1) Traditional C block; 2) javadoc /** ...; 3) C++ style -(defconst c-Java-comment-start-regexp "/\\(/\\|[*][*]?\\)") - -(defconst c-ObjC-method-key - (concat - "^\\s *[+-]\\s *" - "\\(([^)]*)\\)?" ; return type - ;; \\s- in objc syntax table does not include \n - ;; since it is considered the end of //-comments. - "[ \t\n]*" c-symbol-key) - "Regexp describing an Objective-C method intro.") -(defconst c-ObjC-access-key - (concat "@" c-protection-key) - "Regexp describing access specification keywords for Objective-C.") -(defconst c-ObjC-class-key - (concat - "@\\(interface\\|implementation\\)\\s +" - c-symbol-key ;name of the class - "\\(\\s *:\\s *" c-symbol-key "\\)?" ;maybe followed by the superclass - "\\(\\s *<[^>]+>\\)?" ;and maybe the adopted protocols list - ) - "Regexp describing a class or protocol declaration for Objective-C.") - -(defconst c-Java-method-key - (concat - "^\\s *[+-]\\s *" - "\\(([^)]*)\\)?" ; return type - ;; \\s- in java syntax table does not include \n - ;; since it is considered the end of //-comments. - "[ \t\n]*" c-symbol-key) - "Regexp describing a Java method intro.") -(defconst c-Java-access-key nil - "Regexp describing access labels for Java.") -(defconst c-Java-class-key - (concat - "\\(" c-protection-key "\\s +\\)?" - "\\(interface\\|class\\)\\s +" - c-symbol-key ;name of the class - "\\(\\s *extends\\s *" c-symbol-key "\\)?" ;maybe followed by superclass - ;;"\\(\\s *implements *[^{]+{\\)?" ;and maybe the adopted protocols list - ) - "Regexp describing a class or protocol declaration for Java.") -(defconst c-Java-special-key "\\(implements\\|extends\\|throws\\)[^_]" - "Regexp describing Java inheritance and throws clauses.") -(defconst c-Java-conditional-key - (concat "\\b\\(" - (mapconcat 'identity - (append '("try" "catch" "finally" "synchronized") - c-C-conditionals) "\\|") - "\\)\\b[^_]") - "Regexp describing a conditional control for Java.") -(defconst c-Java-defun-prompt-regexp - "^[ \t]*\\(\\(\\(public\\|protected\\|private\\|const\\|abstract\\|synchronized\\|final\\|static\\|threadsafe\\|transient\\|native\\|volatile\\)\\s-+\\)*\\(\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*[][_$.a-zA-Z0-9]+\\|[[a-zA-Z]\\)\\s-*\\)\\s-+\\)\\)?\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*\\s-+\\)\\s-*\\)?\\([_a-zA-Z][^][ \t:;.,{}()=]*\\|\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)\\)\\s-*\\(([^);{}]*)\\)?\\([] \t]*\\)\\(\\s-*\\<throws\\>\\s-*\\(\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)[, \t\n\r\f]*\\)+\\)?\\s-*" - "Regexp describing the beginning of a Java top-level definition.") - -;; KLUDGE ALERT. We default these variables to their `C' values so -;; that non-cc-mode-ized modes that depend on c-mode will still work -;; out of the box. The most glaring example is awk-mode. There ought -;; to be a better way. -(setq-default c-conditional-key c-C-conditional-key - c-class-key c-C-class-key - c-comment-start-regexp c-C-comment-start-regexp) - - -;; main entry points for the modes -(defconst c-list-of-mode-names nil) - -;;;###autoload -(defun c-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. - -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. - -Key bindings: -\\{c-mode-map}" - (interactive) - (kill-all-local-variables) - (set-syntax-table c-mode-syntax-table) - (setq major-mode 'c-mode - mode-name "C" - local-abbrev-table c-mode-abbrev-table) - (use-local-map c-mode-map) - (c-common-init) - (setq comment-start "/* " - comment-end " */" - comment-multi-line t - c-conditional-key c-C-conditional-key - c-class-key c-C-class-key - c-baseclass-key nil - c-comment-start-regexp c-C-comment-start-regexp - imenu-generic-expression cc-imenu-c-generic-expression) - (run-hooks 'c-mode-common-hook) - (run-hooks 'c-mode-hook)) -(setq c-list-of-mode-names (cons "C" c-list-of-mode-names)) - -;;;###autoload -(defun c++-mode () - "Major mode for editing 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. - -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. - -Key bindings: -\\{c++-mode-map}" - (interactive) - (kill-all-local-variables) - (set-syntax-table c++-mode-syntax-table) - (setq major-mode 'c++-mode - mode-name "C++" - local-abbrev-table c++-mode-abbrev-table) - (use-local-map c++-mode-map) - (c-common-init) - (setq comment-start "// " - comment-end "" - comment-multi-line nil - c-conditional-key c-C++-conditional-key - c-comment-start-regexp c-C++-comment-start-regexp - c-class-key c-C++-class-key - c-access-key c-C++-access-key - c-double-slash-is-comments-p t - c-recognize-knr-p nil - imenu-generic-expression cc-imenu-c++-generic-expression) - (run-hooks 'c-mode-common-hook) - (run-hooks 'c++-mode-hook)) -(setq c-list-of-mode-names (cons "C++" c-list-of-mode-names)) - -;;;###autoload -(defun objc-mode () - "Major mode for editing Objective C code. -To submit a problem report, enter `\\[c-submit-bug-report]' from an -objc-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 `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. - -Key bindings: -\\{objc-mode-map}" - (interactive) - (kill-all-local-variables) - (set-syntax-table objc-mode-syntax-table) - (setq major-mode 'objc-mode - mode-name "ObjC" - local-abbrev-table objc-mode-abbrev-table) - (use-local-map objc-mode-map) - (c-common-init) - (setq comment-start "// " - comment-end "" - comment-multi-line nil - c-conditional-key c-C-conditional-key - c-comment-start-regexp c-C++-comment-start-regexp - c-class-key c-ObjC-class-key - c-baseclass-key nil - c-access-key c-ObjC-access-key - c-double-slash-is-comments-p t - c-method-key c-ObjC-method-key) - (run-hooks 'c-mode-common-hook) - (run-hooks 'objc-mode-hook)) -(setq c-list-of-mode-names (cons "ObjC" c-list-of-mode-names)) - -;;;###autoload -(defun java-mode () - "Major mode for editing Java code. -To submit a problem report, enter `\\[c-submit-bug-report]' from an -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 -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'. - -Key bindings: -\\{java-mode-map}" - (interactive) - (kill-all-local-variables) - (set-syntax-table java-mode-syntax-table) - (setq major-mode 'java-mode - mode-name "Java" - local-abbrev-table java-mode-abbrev-table) - (use-local-map java-mode-map) - (c-common-init) - (setq comment-start "// " - comment-end "" - comment-multi-line nil - c-conditional-key c-Java-conditional-key - c-comment-start-regexp c-Java-comment-start-regexp - c-class-key c-Java-class-key - c-method-key c-Java-method-key - c-double-slash-is-comments-p t - c-baseclass-key nil - c-recognize-knr-p nil - c-access-key c-Java-access-key - ;defun-prompt-regexp c-Java-defun-prompt-regexp - imenu-generic-expression cc-imenu-java-generic-expression - ) - (c-set-style "java") - (run-hooks 'c-mode-common-hook) - (run-hooks 'java-mode-hook)) -(setq c-list-of-mode-names (cons "Java" c-list-of-mode-names)) - -(defun c-use-java-style () - "Institutes `java' indentation style. -For use with the variable `java-mode-hook'." - (c-set-style "java")) - -(defun c-common-init () - ;; Common initializations for c++-mode and c-mode. - ;; - ;; these variables should always be buffer local; they do not affect - ;; indentation style. - (make-local-variable 'paragraph-start) - (make-local-variable 'paragraph-separate) - (make-local-variable 'paragraph-ignore-fill-prefix) - (make-local-variable 'require-final-newline) - (make-local-variable 'parse-sexp-ignore-comments) - (make-local-variable 'indent-line-function) - (make-local-variable 'indent-region-function) - (make-local-variable 'comment-start) - (make-local-variable 'comment-end) - (make-local-variable 'comment-column) - (make-local-variable 'comment-start-skip) - (make-local-variable 'comment-multi-line) - (make-local-variable 'outline-regexp) - (make-local-variable 'outline-level) - (make-local-variable 'adaptive-fill-regexp) - (make-local-variable 'imenu-generic-expression) ;set in the mode functions - ;; Emacs 19.30 and beyond only, AFAIK - (if (boundp 'fill-paragraph-function) - (progn - (make-local-variable 'fill-paragraph-function) - (setq fill-paragraph-function 'c-fill-paragraph))) - ;; now set their values - (setq paragraph-start (if (memq 'new-re c-emacs-features) - (concat page-delimiter "\\|$") - (concat "^$\\|" page-delimiter)) - paragraph-separate paragraph-start - paragraph-ignore-fill-prefix t - require-final-newline t - parse-sexp-ignore-comments t - indent-line-function 'c-indent-line - indent-region-function 'c-indent-region - outline-regexp "[^#\n\^M]" - outline-level 'c-outline-level - comment-column 32 - comment-start-skip "/\\*+ *\\|// *" - ;; For all but XEmacs 19.13, the default should be nil - adaptive-fill-regexp (and (memq 'v19 c-emacs-features) - (= emacs-minor-version 13) - "[ \t]*\\([#;>*]+ +\\)?") - ) - ;; we have to do something special for c-offsets-alist so that the - ;; buffer local value has its own alist structure. - (setq c-offsets-alist (copy-alist c-offsets-alist)) - ;; setup the comment indent variable in a Emacs version portable way - ;; ignore any byte compiler warnings you might get here - (if (boundp 'comment-indent-function) - (progn - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'c-comment-indent)) - (make-local-variable 'comment-indent-hook) - (setq comment-indent-hook 'c-comment-indent)) - ;; Put C menu into menubar and on popup menu for XEmacs 19. I think - ;; this happens automatically for Emacs 19. Skip it for Infodock. - (if (and (not (memq 'infodock c-emacs-features)) - (boundp 'current-menubar) - current-menubar - (not (assoc mode-name current-menubar))) - ;; its possible that this buffer has changed modes from one of - ;; the other CC Mode modes. In that case, only the menubar - ;; title of the menu changes. - (let ((modes (copy-sequence c-list-of-mode-names)) - changed-p) - (setq modes (delete major-mode modes)) - (while modes - (if (not (assoc (car modes) current-menubar)) - (setq modes (cdr modes)) - (relabel-menu-item (list (car modes)) mode-name) - (setq modes nil - changed-p t))) - (if (not changed-p) - (progn - (set-buffer-menubar (copy-sequence current-menubar)) - (if (fboundp 'add-submenu) - (add-submenu nil (c-mode-menu)) - (add-menu nil mode-name c-mode-menu) - ))))) - (if (boundp 'mode-popup-menu) - (setq mode-popup-menu (c-mode-menu))) - ;; put auto-hungry designators onto minor-mode-alist, but only once - (or (assq 'c-auto-hungry-string minor-mode-alist) - (setq minor-mode-alist - (cons '(c-auto-hungry-string c-auto-hungry-string) - minor-mode-alist)))) - -(defun c-postprocess-file-styles () - "Function that post processes relevant file local variables. -Currently, this function simply applies any style and offset settings -found in the file's Local Variable list. It first applies any style -setting found in `c-file-style', then it applies any offset settings -it finds in `c-file-offsets'." - ;; apply file styles and offsets - (and c-file-style - (c-set-style c-file-style)) - (and c-file-offsets - (mapcar - (function - (lambda (langentry) - (let ((langelem (car langentry)) - (offset (cdr langentry))) - (c-set-offset langelem offset) - ))) - c-file-offsets))) - -;; Add the postprocessing function to hack-local-variables-hook. As -;; of 28-Aug-1995, XEmacs 19.12 and Emacs 19.29 support this. -(and (fboundp 'add-hook) - (add-hook 'hack-local-variables-hook 'c-postprocess-file-styles)) - -(defun c-enable-//-in-c-mode () - "Enables // as a comment delimiter in `c-mode'. -ANSI C currently does *not* allow this, although many C compilers -support optional C++ style comments. To use, call this function from -your `.emacs' file before you visit any C files. The changes are -global and affect all future `c-mode' buffers." - (c-setup-dual-comments c-mode-syntax-table) - (setq-default c-C-comment-start-regexp c-C++-comment-start-regexp)) - - -;; macros must be defined before first use -(defmacro c-add-syntax (symbol &optional relpos) - ;; a simple macro to append the syntax in symbol to the syntax list. - ;; try to increase performance by using this macro - (` (setq syntax (cons (cons (, symbol) (, relpos)) syntax)))) - -(defmacro c-point (position) - ;; Returns the value of point at certain commonly referenced POSITIONs. - ;; POSITION can be one of the following symbols: - ;; - ;; bol -- beginning of line - ;; eol -- end of line - ;; bod -- beginning of defun - ;; boi -- back to indentation - ;; ionl -- indentation of next line - ;; iopl -- indentation of previous line - ;; bonl -- beginning of next line - ;; bopl -- beginning of previous line - ;; - ;; This function does not modify point or mark. - (or (and (eq 'quote (car-safe position)) - (null (cdr (cdr position)))) - (error "bad buffer position requested: %s" position)) - (setq position (nth 1 position)) - (` (let ((here (point))) - (,@ (cond - ((eq position 'bol) '((beginning-of-line))) - ((eq position 'eol) '((end-of-line))) - ((eq position 'bod) - '((beginning-of-defun) - ;; if defun-prompt-regexp is non-nil, b-o-d won't leave - ;; us at the open brace. - (and (boundp 'defun-prompt-regexp) - defun-prompt-regexp - (looking-at defun-prompt-regexp) - (goto-char (match-end 0))) - )) - ((eq position 'boi) '((back-to-indentation))) - ((eq position 'bonl) '((forward-line 1))) - ((eq position 'bopl) '((forward-line -1))) - ((eq position 'iopl) - '((forward-line -1) - (back-to-indentation))) - ((eq position 'ionl) - '((forward-line 1) - (back-to-indentation))) - (t (error "unknown buffer position requested: %s" position)) - )) - (prog1 - (point) - (goto-char here)) - ;; workaround for an Emacs18 bug -- blech! Well, at least it - ;; doesn't hurt for v19 - (,@ nil) - ))) - -(defmacro c-auto-newline () - ;; if auto-newline feature is turned on, insert a newline character - ;; and return t, otherwise return nil. - (` (and c-auto-newline - (not (c-in-literal)) - (not (newline))))) - -(defmacro c-safe (&rest body) - ;; safely execute BODY, return nil if an error occurred - (` (condition-case nil - (progn (,@ body)) - (error nil)))) - -(defun c-insert-special-chars (arg) - ;; simply call self-insert-command in Emacs 19 - (self-insert-command (prefix-numeric-value arg))) - -(defun c-intersect-lists (list alist) - ;; return the element of ALIST that matches the first element found - ;; in LIST. Uses assq. - (let (match) - (while (and list - (not (setq match (assq (car list) alist)))) - (setq list (cdr list))) - match)) - -(defun c-lookup-lists (list alist1 alist2) - ;; first, find the first entry from LIST that is present in ALIST1, - ;; then find the entry in ALIST2 for that entry. - (assq (car (c-intersect-lists list alist1)) alist2)) - - -;; This is used by indent-for-comment to decide how much to indent a -;; comment in C code based on its context. -(defun c-comment-indent () - (if (looking-at (concat "^\\(" c-comment-start-regexp "\\)")) - 0 ;Existing comment at bol stays there. - (let ((opoint (point)) - placeholder) - (save-excursion - (beginning-of-line) - (cond - ;; CASE 1: A comment following a solitary close-brace should - ;; have only one space. - ((looking-at (concat "[ \t]*}[ \t]*\\($\\|" - c-comment-start-regexp - "\\)")) - (search-forward "}") - (1+ (current-column))) - ;; CASE 2: 2 spaces after #endif - ((or (looking-at "^#[ \t]*endif[ \t]*") - (looking-at "^#[ \t]*else[ \t]*")) - 7) - ;; CASE 3: when comment-column is nil, calculate the offset - ;; according to c-offsets-alist. E.g. identical to hitting - ;; TAB. - ((and c-indent-comments-syntactically-p - (save-excursion - (skip-chars-forward " \t") - (or (looking-at comment-start) - (eolp)))) - (let ((syntax (c-guess-basic-syntax))) - ;; BOGOSITY ALERT: if we're looking at the eol, its - ;; because indent-for-comment hasn't put the comment-start - ;; in the buffer yet. this will screw up the syntactic - ;; analysis so we kludge in the necessary info. Another - ;; kludge is that if we're at the bol, then we really want - ;; to ignore any anchoring as specified by - ;; c-comment-only-line-offset since it doesn't apply here. - (if (save-excursion - (beginning-of-line) - (skip-chars-forward " \t") - (eolp)) - (c-add-syntax 'comment-intro)) - (let ((c-comment-only-line-offset - (if (consp c-comment-only-line-offset) - c-comment-only-line-offset - (cons c-comment-only-line-offset - c-comment-only-line-offset)))) - (apply '+ (mapcar 'c-get-offset syntax))))) - ;; CASE 4: use comment-column if previous line is a - ;; comment-only line indented to the left of comment-column - ((save-excursion - (beginning-of-line) - (and (not (bobp)) - (forward-line -1)) - (skip-chars-forward " \t") - (prog1 - (looking-at c-comment-start-regexp) - (setq placeholder (point)))) - (goto-char placeholder) - (if (< (current-column) comment-column) - comment-column - (current-column))) - ;; CASE 5: If comment-column is 0, and nothing but space - ;; before the comment, align it at 0 rather than 1. - ((progn - (goto-char opoint) - (skip-chars-backward " \t") - (and (= comment-column 0) (bolp))) - 0) - ;; CASE 6: indent at comment column except leave at least one - ;; space. - (t (max (1+ (current-column)) - comment-column)) - ))))) - -;; used by outline-minor-mode -(defun c-outline-level () - (save-excursion - (skip-chars-forward "\t ") - (current-column))) - -;; active regions, and auto-newline/hungry delete key -(defun c-keep-region-active () - ;; Do whatever is necessary to keep the region active in - ;; XEmacs 19. ignore byte-compiler warnings you might see - (and (boundp 'zmacs-region-stays) - (setq zmacs-region-stays t))) - -(defun c-update-modeline () - ;; set the c-auto-hungry-string for the correct designation on the modeline - (setq c-auto-hungry-string - (if c-auto-newline - (if c-hungry-delete-key "/ah" "/a") - (if c-hungry-delete-key "/h" nil))) - ;; updates the modeline for all Emacsen - (if (or (memq 'v19 c-emacs-features) (memq 'v20 c-emacs-features)) - (if (boundp 'redraw-modeline) - (redraw-modeline) - (force-mode-line-update)) - (set-buffer-modified-p (buffer-modified-p)))) - -(defun c-calculate-state (arg prevstate) - ;; Calculate the new state of PREVSTATE, t or nil, based on arg. If - ;; arg is nil or zero, toggle the state. If arg is negative, turn - ;; the state off, and if arg is positive, turn the state on - (if (or (not arg) - (zerop (setq arg (prefix-numeric-value arg)))) - (not prevstate) - (> arg 0))) - -(defun c-toggle-auto-state (arg) - "Toggle auto-newline feature. -Optional numeric ARG, if supplied turns on auto-newline when positive, -turns it off when negative, and just toggles it when zero. - -When the auto-newline feature is enabled (as evidenced by the `/a' or -`/ah' on the modeline after the mode name) newlines are automatically -inserted after special characters such as brace, comma, semi-colon, -and colon." - (interactive "P") - (setq c-auto-newline (c-calculate-state arg c-auto-newline)) - (c-update-modeline) - (c-keep-region-active)) - -(defun c-toggle-hungry-state (arg) - "Toggle hungry-delete-key feature. -Optional numeric ARG, if supplied turns on hungry-delete when positive, -turns it off when negative, and just toggles it when zero. - -When the hungry-delete-key feature is enabled (as evidenced by the -`/h' or `/ah' on the modeline after the mode name) the delete key -gobbles all preceding whitespace in one fell swoop." - (interactive "P") - (setq c-hungry-delete-key (c-calculate-state arg c-hungry-delete-key)) - (c-update-modeline) - (c-keep-region-active)) - -(defun c-toggle-auto-hungry-state (arg) - "Toggle auto-newline and hungry-delete-key features. -Optional numeric ARG, if supplied turns on auto-newline and -hungry-delete when positive, turns them off when negative, and just -toggles them when zero. - -See `c-toggle-auto-state' and `c-toggle-hungry-state' for details." - (interactive "P") - (setq c-auto-newline (c-calculate-state arg c-auto-newline)) - (setq c-hungry-delete-key (c-calculate-state arg c-hungry-delete-key)) - (c-update-modeline) - (c-keep-region-active)) - - -;; COMMANDS -(defun c-electric-delete (arg) - "Deletes preceding or following character or whitespace. -If `c-hungry-delete-key' is non-nil, as evidenced by the \"/h\" or -\"/ah\" string on the mode line, then all preceding or following -whitespace is consumed. If however an ARG is supplied, or -`c-hungry-delete-key' is nil, or point is inside a literal then the -function in the variable `c-delete-function' is called." - (interactive "P") - (if (or (not c-hungry-delete-key) - arg - (c-in-literal)) - (funcall c-delete-function (prefix-numeric-value arg)) - (let ((here (point))) - (if (and (boundp 'delete-key-deletes-forward) - delete-key-deletes-forward) - (skip-chars-forward " \t\n") - (skip-chars-backward " \t\n")) - (if (/= (point) here) - (delete-region (point) here) - (funcall c-delete-function 1))))) - -(defun c-electric-pound (arg) - "Electric pound (`#') insertion. -Inserts a `#' character specially depending on the variable -`c-electric-pound-behavior'. If a numeric ARG is supplied, or if -point is inside a literal, nothing special happens." - (interactive "P") - (if (or (c-in-literal) - arg - (not (memq 'alignleft c-electric-pound-behavior))) - ;; do nothing special - (self-insert-command (prefix-numeric-value arg)) - ;; place the pound character at the left edge - (let ((pos (- (point-max) (point))) - (bolp (bolp))) - (beginning-of-line) - (delete-horizontal-space) - (insert-char last-command-char 1) - (and (not bolp) - (goto-char (- (point-max) pos))) - ))) - -(defun c-electric-brace (arg) - "Insert a brace. - -If the auto-newline feature is turned on, as evidenced by the \"/a\" -or \"/ah\" string on the mode line, newlines are inserted before and -after braces based on the value of `c-hanging-braces-alist'. - -Also, the line is re-indented unless a numeric ARG is supplied, there -are non-whitespace characters present on the line after the brace, or -the brace is inserted inside a literal." - (interactive "P") - (let* ((c-state-cache (c-parse-state)) - (safepos (c-safe-position (point) c-state-cache)) - (literal (c-in-literal safepos))) - ;; if we're in a literal, or we're not at the end of the line, or - ;; a numeric arg is provided, or auto-newlining is turned off, - ;; then just insert the character. - (if (or literal arg -; (not c-auto-newline) - (not (looking-at "[ \t]*$"))) - (c-insert-special-chars arg) - (let* ((syms '(class-open class-close defun-open defun-close - inline-open inline-close brace-list-open brace-list-close - brace-list-intro brace-list-entry block-open block-close - substatement-open statement-case-open - extern-lang-open extern-lang-close)) - ;; we want to inhibit blinking the paren since this will - ;; be most disruptive. we'll blink it ourselves later on - (old-blink-paren (if (boundp 'blink-paren-function) - blink-paren-function - blink-paren-hook)) - blink-paren-function ; emacs19 - blink-paren-hook ; emacs18 - (insertion-point (point)) - delete-temp-newline - (preserve-p (= 32 (char-syntax (preceding-char)))) - ;; shut this up too - (c-echo-syntactic-information-p nil) - (syntax (progn - ;; only insert a newline if there is - ;; non-whitespace behind us - (if (save-excursion - (skip-chars-backward " \t") - (not (bolp))) - (progn (newline) - (setq delete-temp-newline t))) - (self-insert-command (prefix-numeric-value arg)) - ;; state cache doesn't change - (c-guess-basic-syntax))) - (newlines (and - c-auto-newline - (or (c-lookup-lists syms syntax c-hanging-braces-alist) - '(ignore before after))))) - ;; If syntax is a function symbol, then call it using the - ;; defined semantics. - (if (and (not (consp (cdr newlines))) - (c-functionp (cdr newlines))) - (let ((c-syntactic-context syntax)) - (setq newlines - (funcall (cdr newlines) (car newlines) insertion-point)))) - ;; does a newline go before the open brace? - (if (memq 'before newlines) - ;; we leave the newline we've put in there before, - ;; but we need to re-indent the line above - (let ((pos (- (point-max) (point))) - (here (point)) - (c-state-cache c-state-cache)) - (forward-line -1) - ;; we may need to update the cache. this should still be - ;; faster than recalculating the state in many cases - (save-excursion - (save-restriction - (narrow-to-region here (point)) - (if (and (c-safe (progn (backward-up-list -1) t)) - (memq (preceding-char) '(?\) ?})) - (progn (widen) - (c-safe (progn (forward-sexp -1) t)))) - (setq c-state-cache - (c-hack-state (point) 'open c-state-cache)) - (if (and (car c-state-cache) - (not (consp (car c-state-cache))) - (<= (point) (car c-state-cache))) - (setq c-state-cache (cdr c-state-cache)) - )))) - (let ((here (point)) - (shift (c-indent-line))) - (setq c-state-cache (c-adjust-state (c-point 'bol) here - (- shift) c-state-cache))) - (goto-char (- (point-max) pos)) - ;; if the buffer has changed due to the indentation, we - ;; need to recalculate syntax for the current line, but - ;; we won't need to update the state cache. - (if (/= (point) here) - (setq syntax (c-guess-basic-syntax)))) - ;; must remove the newline we just stuck in (if we really did it) - (and delete-temp-newline - (save-excursion - ;; if there is whitespace before point, then preserve - ;; at least one space. - (delete-indentation) - (just-one-space) - (if (not preserve-p) - (delete-char -1)))) - ;; since we're hanging the brace, we need to recalculate - ;; syntax. Update the state to accurately reflect the - ;; beginning of the line. We punt if we cross any open or - ;; closed parens because its just too hard to modify the - ;; known state. This limitation will be fixed in v5. - (save-excursion - (let ((bol (c-point 'bol))) - (if (zerop (car (parse-partial-sexp bol (1- (point))))) - (setq c-state-cache (c-whack-state bol c-state-cache) - syntax (c-guess-basic-syntax)) - ;; gotta punt. this requires some horrible kludgery - (beginning-of-line) - (makunbound 'c-state-cache) - (setq c-state-cache (c-parse-state) - syntax nil)))) - ) - ;; now adjust the line's indentation. don't update the state - ;; cache since c-guess-basic-syntax isn't called when the - ;; syntax is passed to c-indent-line - (let ((here (point)) - (shift (c-indent-line syntax))) - (setq c-state-cache (c-adjust-state (c-point 'bol) here - (- shift) c-state-cache))) - ;; Do all appropriate clean ups - (let ((here (point)) - (pos (- (point-max) (point))) - mbeg mend) - ;; clean up empty defun braces - (if (and c-auto-newline - (memq 'empty-defun-braces c-cleanup-list) - (= last-command-char ?\}) - (c-intersect-lists '(defun-close class-close inline-close) - syntax) - (progn - (forward-char -1) - (skip-chars-backward " \t\n") - (= (preceding-char) ?\{)) - ;; make sure matching open brace isn't in a comment - (not (c-in-literal))) - (delete-region (point) (1- here))) - ;; clean up brace-else-brace - (if (and c-auto-newline - (memq 'brace-else-brace c-cleanup-list) - (= last-command-char ?\{) - (re-search-backward "}[ \t\n]*else[ \t\n]*{" nil t) - (progn - (setq mbeg (match-beginning 0) - mend (match-end 0)) - (= mend here)) - (not (c-in-literal))) - (progn - (delete-region mbeg mend) - (insert "} else {"))) - ;; clean up brace-elseif-brace - (if (and c-auto-newline - (memq 'brace-elseif-brace c-cleanup-list) - (= last-command-char ?\{) - (re-search-backward "}[ \t\n]*else[ \t\n]+if[ \t\n]*" nil t) - (save-excursion - (goto-char (match-end 0)) - (c-safe (forward-sexp 1)) - (skip-chars-forward " \t\n") - (setq mbeg (match-beginning 0) - mend (match-end 0)) - (= here (1+ (point)))) - (not (c-in-literal))) - (progn - (delete-region mbeg mend) - (insert "} else if "))) - (goto-char (- (point-max) pos)) - ) - ;; does a newline go after the brace? - (if (memq 'after newlines) - (progn - (newline) - ;; update on c-state-cache - (let* ((bufpos (- (point) 2)) - (which (if (= (char-after bufpos) ?{) 'open 'close)) - (c-state-cache (c-hack-state bufpos which c-state-cache))) - (c-indent-line)))) - ;; blink the paren - (and (= last-command-char ?\}) - old-blink-paren - (save-excursion - (c-backward-syntactic-ws safepos) - (if (boundp 'blink-paren-function) - (funcall old-blink-paren) - (run-hooks old-blink-paren)))) - )))) - -(defun c-electric-slash (arg) - "Insert a slash character. -If slash is second of a double-slash C++ style comment introducing -construct, and we are on a comment-only-line, indent line as comment. -If numeric ARG is supplied or point is inside a literal, indentation -is inhibited." - (interactive "P") - (let ((indentp (and (not arg) - (= (preceding-char) ?/) - (= last-command-char ?/) - (not (c-in-literal)))) - ;; shut this up - (c-echo-syntactic-information-p nil)) - (self-insert-command (prefix-numeric-value arg)) - (if indentp - (c-indent-line)))) - -(defun c-electric-star (arg) - "Insert a star character. -If the star is the second character of a C style comment introducing -construct, and we are on a comment-only-line, indent line as comment. -If numeric ARG is supplied or point is inside a literal, indentation -is inhibited." - (interactive "P") - (self-insert-command (prefix-numeric-value arg)) - ;; if we are in a literal, or if arg is given do not re-indent the - ;; current line, unless this star introduces a comment-only line. - (if (and (not arg) - (memq (c-in-literal) '(c)) - (= (preceding-char) ?*) - (save-excursion - (forward-char -1) - (skip-chars-backward "*") - (if (= (preceding-char) ?/) - (forward-char -1)) - (skip-chars-backward " \t") - (bolp))) - ;; shut this up - (let (c-echo-syntactic-information-p) - (c-indent-line)) - )) - -(defun c-electric-semi&comma (arg) - "Insert a comma or semicolon. -When the auto-newline feature is turned on, as evidenced by the \"/a\" -or \"/ah\" string on the mode line, a newline might be inserted. See -the variable `c-hanging-semi&comma-criteria' for how newline insertion -is determined. - -When semicolon is inserted, the line is re-indented unless a numeric -arg is supplied, point is inside a literal, or there are -non-whitespace characters on the line following the semicolon." - (interactive "P") - (let* ((lim (c-most-enclosing-brace (c-parse-state))) - (literal (c-in-literal lim)) - (here (point)) - ;; shut this up - (c-echo-syntactic-information-p nil)) - (if (or literal - arg - (not (looking-at "[ \t]*$"))) - (c-insert-special-chars arg) - ;; do some special stuff with the character - (self-insert-command (prefix-numeric-value arg)) - ;; do all cleanups, reindentations, and newline insertions, but - ;; only if c-auto-newline is turned on - (if (not c-auto-newline) nil - ;; clean ups - (let ((pos (- (point-max) (point)))) - (if (and (or (and - (= last-command-char ?,) - (memq 'list-close-comma c-cleanup-list)) - (and - (= last-command-char ?\;) - (memq 'defun-close-semi c-cleanup-list))) - (progn - (forward-char -1) - (skip-chars-backward " \t\n") - (= (preceding-char) ?})) - ;; make sure matching open brace isn't in a comment - (not (c-in-literal lim))) - (delete-region (point) here)) - (goto-char (- (point-max) pos))) - ;; re-indent line - (c-indent-line) - ;; check to see if a newline should be added - (let ((criteria c-hanging-semi&comma-criteria) - answer add-newline-p) - (while criteria - (setq answer (funcall (car criteria))) - ;; only nil value means continue checking - (if (not answer) - (setq criteria (cdr criteria)) - (setq criteria nil) - ;; only 'stop specifically says do not add a newline - (setq add-newline-p (not (eq answer 'stop))) - )) - (if add-newline-p - (progn (newline) - (c-indent-line))) - ))))) - -(defun c-semi&comma-inside-parenlist () - "Determine if a newline should be added after a semicolon. -If a comma was inserted, no determination is made. If a semicolon was -inserted inside a parenthesis list, no newline is added otherwise a -newline is added. In either case, checking is stopped. This supports -exactly the old newline insertion behavior." - ;; newline only after semicolon, but only if that semicolon is not - ;; inside a parenthesis list (e.g. a for loop statement) - (if (/= last-command-char ?\;) - nil ; continue checking - (if (condition-case nil - (save-excursion - (up-list -1) - (/= (following-char) ?\()) - (error t)) - t - 'stop))) - -(defun c-electric-colon (arg) - "Insert a colon. - -If the auto-newline feature is turned on, as evidenced by the \"/a\" -or \"/ah\" string on the mode line, newlines are inserted before and -after colons based on the value of `c-hanging-colons-alist'. - -Also, the line is re-indented unless a numeric ARG is supplied, there -are non-whitespace characters present on the line after the colon, or -the colon is inserted inside a literal. - -This function cleans up double colon scope operators based on the -value of `c-cleanup-list'." - (interactive "P") - (let* ((bod (c-point 'bod)) - (literal (c-in-literal bod)) - syntax newlines - ;; shut this up - (c-echo-syntactic-information-p nil)) - (if (or literal - arg - (not (looking-at "[ \t]*$"))) - (c-insert-special-chars arg) - ;; insert the colon, then do any specified cleanups - (self-insert-command (prefix-numeric-value arg)) - (let ((pos (- (point-max) (point))) - (here (point))) - (if (and c-auto-newline - (memq 'scope-operator c-cleanup-list) - (= (preceding-char) ?:) - (progn - (forward-char -1) - (skip-chars-backward " \t\n") - (= (preceding-char) ?:)) - (not (c-in-literal)) - (not (= (char-after (- (point) 2)) ?:))) - (delete-region (point) (1- here))) - (goto-char (- (point-max) pos))) - ;; lets do some special stuff with the colon character - (setq syntax (c-guess-basic-syntax) - ;; some language elements can only be determined by - ;; checking the following line. Lets first look for ones - ;; that can be found when looking on the line with the - ;; colon - newlines - (and c-auto-newline - (or (c-lookup-lists '(case-label label access-label) - syntax c-hanging-colons-alist) - (c-lookup-lists '(member-init-intro inher-intro) - (prog2 - (insert "\n") - (c-guess-basic-syntax) - (delete-char -1)) - c-hanging-colons-alist)))) - ;; indent the current line - (c-indent-line syntax) - ;; does a newline go before the colon? Watch out for already - ;; non-hung colons. However, we don't unhang them because that - ;; would be a cleanup (and anti-social). - (if (and (memq 'before newlines) - (save-excursion - (skip-chars-backward ": \t") - (not (bolp)))) - (let ((pos (- (point-max) (point)))) - (forward-char -1) - (newline) - (c-indent-line) - (goto-char (- (point-max) pos)))) - ;; does a newline go after the colon? - (if (memq 'after (cdr-safe newlines)) - (progn - (newline) - (c-indent-line))) - ))) - -(defun c-electric-lt-gt (arg) - "Insert a less-than, or greater-than character. -When the auto-newline feature is turned on, as evidenced by the \"/a\" -or \"/ah\" string on the mode line, the line will be re-indented if -the character inserted is the second of a C++ style stream operator -and the buffer is in C++ mode. - -The line will also not be re-indented if a numeric argument is -supplied, or point is inside a literal." - (interactive "P") - (let ((indentp (and (not arg) - (= (preceding-char) last-command-char) - (not (c-in-literal)))) - ;; shut this up - (c-echo-syntactic-information-p nil)) - (self-insert-command (prefix-numeric-value arg)) - (if indentp - (c-indent-line)))) - -;; set up electric character functions to work with pending-del, -;; (a.k.a. delsel) mode. All symbols get the t value except -;; c-electric-delete which gets 'supersede. -(mapcar - (function - (lambda (sym) - (put sym 'delete-selection t) ; for delsel (Emacs) - (put sym 'pending-delete t))) ; for pending-del (XEmacs) - '(c-electric-pound - c-electric-brace - c-electric-slash - c-electric-star - c-electric-semi&comma - c-electric-lt-gt - c-electric-colon)) -(put 'c-electric-delete 'delete-selection 'supersede) ; delsel -(put 'c-electric-delete 'pending-delete 'supersede) ; pending-del - - - -(defvar c-read-offset-history nil) - -(defun c-read-offset (langelem) - ;; read new offset value for LANGELEM from minibuffer. return a - ;; legal value only - (let* ((oldoff (cdr-safe (assq langelem c-offsets-alist))) - (defstr (format "(default %s): " oldoff)) - (errmsg (concat "Offset must be int, func, var, " - "or in [+,-,++,--,*,/] " - defstr)) - (prompt (concat "Offset " defstr)) - offset input interned raw) - (while (not offset) - (setq input (completing-read prompt obarray 'fboundp nil nil - 'c-read-offset-history) - offset (cond ((string-equal "" input) oldoff) ; default - ((string-equal "+" input) '+) - ((string-equal "-" input) '-) - ((string-equal "++" input) '++) - ((string-equal "--" input) '--) - ((string-equal "*" input) '*) - ((string-equal "/" input) '/) - ((string-match "^-?[0-9]+$" input) - (string-to-int input)) - ;; a symbol with a function binding - ((fboundp (setq interned (intern input))) - interned) - ;; a lambda function - ((condition-case nil - (c-functionp (setq raw (read input))) - (error nil)) - raw) - ;; a symbol with variable binding - ((boundp interned) interned) - ;; error, but don't signal one, keep trying - ;; to read an input value - (t (ding) - (setq prompt errmsg) - nil)))) - offset)) - -(defun c-set-offset (symbol offset &optional add-p) - "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. Optional ADD says to add SYMBOL to -`c-offsets-alist' if it doesn't already appear there." - (interactive - (let* ((langelem - (intern (completing-read - (concat "Syntactic symbol to change" - (if current-prefix-arg " or add" "") - ": ") - (mapcar - (function - (lambda (langelem) - (cons (format "%s" (car langelem)) nil))) - c-offsets-alist) - nil (not current-prefix-arg) - ;; initial contents tries to be the last element - ;; on the syntactic analysis list for the current - ;; line - (let* ((syntax (c-guess-basic-syntax)) - (len (length syntax)) - (ic (format "%s" (car (nth (1- len) syntax))))) - (if (or (memq 'v19 c-emacs-features) - (memq 'v20 c-emacs-features)) - (cons ic 0) - ic)) - ))) - (offset (c-read-offset langelem))) - (list langelem offset current-prefix-arg))) - ;; sanity check offset - (or (eq offset '+) - (eq offset '-) - (eq offset '++) - (eq offset '--) - (eq offset '*) - (eq offset '/) - (integerp offset) - (c-functionp offset) - (boundp offset) - (error "Offset must be int, func, var, or in [+,-,++,--,*,/]: %s" - offset)) - (let ((entry (assq symbol c-offsets-alist))) - (if entry - (setcdr entry offset) - (if add-p - (setq c-offsets-alist (cons (cons symbol offset) c-offsets-alist)) - (error "%s is not a valid syntactic symbol." symbol)))) - (c-keep-region-active)) - -(defun c-set-style-1 (stylevars) - ;; given a style's variable alist, institute the style - (mapcar - (function - (lambda (conscell) - (let ((attr (car conscell)) - (val (cdr conscell))) - (cond - ((eq attr 'c-offsets-alist) - (mapcar - (function - (lambda (langentry) - (let ((langelem (car langentry)) - (offset (cdr langentry))) - (c-set-offset langelem offset) - ))) - val)) - ((eq attr 'c-special-indent-hook) - (if (listp val) - (while val - (add-hook 'c-special-indent-hook (car val)) - (setq val (cdr val))) - (add-hook 'c-special-indent-hook val))) - (t (set attr val))) - ))) - stylevars)) - -(defvar c-set-style-history nil) - -;;;###autoload -(defun c-set-style (stylename) - "Set CC Mode variables to use one of several different indentation styles. -STYLENAME is a string representing the desired style from the list of -styles described in the variable `c-style-alist'. See that variable -for details of setting up styles. - -The variable `c-indentation-style' always contains the buffer's current -style name." - (interactive (list (let ((completion-ignore-case t) - (prompt (format "Which %s indentation style? " - mode-name))) - (completing-read prompt c-style-alist nil t - (cons c-indentation-style 0) - 'c-set-style-history)))) - (let ((vars (cdr (or (assoc (downcase stylename) c-style-alist) - (assoc (upcase stylename) c-style-alist) - (assoc stylename c-style-alist) - ))) - (default (cdr (assoc "cc-mode" c-style-alist)))) - (or vars (error "Invalid indentation style `%s'" stylename)) - (or default (error "No `cc-mode' style found!")) - ;; first reset the style to `cc-mode' to give every style a common - ;; base. Then institute the new style. - (c-set-style-1 default) - (setq c-indentation-style stylename) - (if (not (string= stylename "cc-mode")) - (c-set-style-1 vars))) - (c-keep-region-active)) - -;;;###autoload -(defun c-add-style (style descrip &optional set-p) - "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: - - ((VARIABLE . VALUE) [(VARIABLE . VALUE) ...]) - -See the variable `c-style-alist' for the semantics of 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." - (interactive - (let ((stylename (completing-read "Style to add: " c-style-alist)) - (description (eval-minibuffer "Style description: "))) - (list stylename description - (y-or-n-p "Set the style too? ")))) - (setq style (downcase style)) - (let ((s (assoc style c-style-alist))) - (if s - (setcdr s (copy-alist descrip)) ; replace - (setq c-style-alist (cons (cons style descrip) c-style-alist)))) - (and set-p (c-set-style style))) - - -(defun c-fill-paragraph (&optional arg) - "Like \\[fill-paragraph] but handles C and C++ style comments. -If any of the current line is a comment or within a comment, -fill the comment or the paragraph of it that point is in, -preserving the comment indentation or line-starting decorations. - -Optional prefix ARG means justify paragraph as well." - (interactive "P") - (let* (comment-start-place - (first-line - ;; Check for obvious entry to comment. - (save-excursion - (beginning-of-line) - (skip-chars-forward " \t\n") - (and (looking-at comment-start-skip) - (setq comment-start-place (point))))) - (re1 (if (memq 'new-re c-emacs-features) - "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$" - "\\|^[ \t]*/\\*[ \t]*$\\|^[ \t]*\\*/[ \t]*$\\|^[ \t/*]*$")) - ) - (if (and c-double-slash-is-comments-p - (save-excursion - (beginning-of-line) - (looking-at ".*//"))) - (let (fill-prefix - ;; Lines containing just a comment start or just an end - ;; should not be filled into paragraphs they are next - ;; to. - (paragraph-start (concat paragraph-start re1)) - (paragraph-separate (concat paragraph-separate re1))) - (save-excursion - (beginning-of-line) - ;; Move up to first line of this comment. - (while (and (not (bobp)) - (looking-at "[ \t]*//[ \t]*[^ \t\n]")) - (forward-line -1)) - (if (not (looking-at ".*//[ \t]*[^ \t\n]")) - (forward-line 1)) - ;; Find the comment start in this line. - (re-search-forward "[ \t]*//[ \t]*") - ;; Set the fill-prefix to be what all lines except the first - ;; should start with. - (setq fill-prefix (buffer-substring (match-beginning 0) - (match-end 0))) - (save-restriction - ;; Narrow down to just the lines of this comment. - (narrow-to-region (c-point 'bol) - (save-excursion - (forward-line 1) - (while (looking-at fill-prefix) - (forward-line 1)) - (point))) - (fill-paragraph arg) - t))) - ;; else C style comments - (if (or first-line - ;; t if we enter a comment between start of function and - ;; this line. - (eq (c-in-literal) 'c) - ;; t if this line contains a comment starter. - (setq first-line - (save-excursion - (beginning-of-line) - (prog1 - (re-search-forward comment-start-skip - (save-excursion (end-of-line) - (point)) - t) - (setq comment-start-place (point)))))) - ;; Inside a comment: fill one comment paragraph. - (let ((fill-prefix - ;; The prefix for each line of this paragraph - ;; is the appropriate part of the start of this line, - ;; up to the column at which text should be indented. - (save-excursion - (beginning-of-line) - (if (looking-at "[ \t]*/\\*.*\\*/") - (progn (re-search-forward comment-start-skip) - (make-string (current-column) ?\ )) - (if first-line (forward-line 1)) - - (let ((line-width (progn (end-of-line) (current-column)))) - (beginning-of-line) - (prog1 - (buffer-substring - (point) - - ;; How shall we decide where the end of the - ;; fill-prefix is? - (progn - (beginning-of-line) - (skip-chars-forward " \t*" (c-point 'eol)) - ;; kludge alert, watch out for */, in - ;; which case fill-prefix should *not* - ;; be "*"! - (if (and (= (following-char) ?/) - (= (preceding-char) ?*)) - (forward-char -1)) - (point))) - - ;; If the comment is only one line followed - ;; by a blank line, calling move-to-column - ;; above may have added some spaces and tabs - ;; to the end of the line; the fill-paragraph - ;; function will then delete it and the - ;; newline following it, so we'll lose a - ;; blank line when we shouldn't. So delete - ;; anything move-to-column added to the end - ;; of the line. We record the line width - ;; instead of the position of the old line - ;; end because move-to-column might break a - ;; tab into spaces, and the new characters - ;; introduced there shouldn't be deleted. - - ;; If you can see a better way to do this, - ;; please make the change. This seems very - ;; messy to me. - (delete-region (progn (move-to-column line-width) - (point)) - (progn (end-of-line) (point)))))))) - - ;; Lines containing just a comment start or just an end - ;; should not be filled into paragraphs they are next - ;; to. - (paragraph-start (concat paragraph-start re1)) - (paragraph-separate (concat paragraph-separate re1)) - (chars-to-delete 0) - ) - (save-restriction - ;; Don't fill the comment together with the code - ;; following it. So temporarily exclude everything - ;; before the comment start, and everything after the - ;; line where the comment ends. If comment-start-place - ;; is non-nil, the comment starter is there. Otherwise, - ;; point is inside the comment. - (narrow-to-region (save-excursion - (if comment-start-place - (goto-char comment-start-place) - (search-backward "/*")) - (if (and (not c-hanging-comment-starter-p) - (looking-at - (concat c-comment-start-regexp - "[ \t]*$"))) - (forward-line 1)) - ;; Protect text before the comment - ;; start by excluding it. Add - ;; spaces to bring back proper - ;; indentation of that point. - (let ((column (current-column))) - (prog1 (point) - (setq chars-to-delete column) - (insert-char ?\ column)))) - (save-excursion - (if comment-start-place - (goto-char (+ comment-start-place 2))) - (search-forward "*/" nil 'move) - (forward-line 1) - (point))) - (fill-paragraph arg) - (save-excursion - ;; Delete the chars we inserted to avoid clobbering - ;; the stuff before the comment start. - (goto-char (point-min)) - (if (> chars-to-delete 0) - (delete-region (point) (+ (point) chars-to-delete))) - ;; Find the comment ender (should be on last line of - ;; buffer, given the narrowing) and don't leave it on - ;; its own line, unless that's the style that's desired. - (goto-char (point-max)) - (forward-line -1) - (search-forward "*/" nil 'move) - (beginning-of-line) - (if (and c-hanging-comment-ender-p - (looking-at "[ \t]*\\*/")) - ;(delete-indentation))))) - (let ((fill-column (+ fill-column 9999))) - (forward-line -1) - (fill-region-as-paragraph (point) (point-max)))))) - t))))) - - -;; better movement routines for ThisStyleOfVariablesCommonInCPlusPlus -;; originally contributed by Terry_Glanfield.Southern@rxuk.xerox.com -(defun c-forward-into-nomenclature (&optional arg) - "Move forward to end of a nomenclature section or word. -With arg, to it arg times." - (interactive "p") - (let ((case-fold-search nil)) - (if (> arg 0) - (re-search-forward "\\W*\\([A-Z]*[a-z0-9]*\\)" (point-max) t arg) - (while (and (< arg 0) - (re-search-backward - "\\(\\(\\W\\|[a-z0-9]\\)[A-Z]+\\|\\W\\w+\\)" - (point-min) 0)) - (forward-char 1) - (setq arg (1+ arg))))) - (c-keep-region-active)) - -(defun c-backward-into-nomenclature (&optional arg) - "Move backward to beginning of a nomenclature section or word. -With optional ARG, move that many times. If ARG is negative, move -forward." - (interactive "p") - (c-forward-into-nomenclature (- arg)) - (c-keep-region-active)) - -(defun c-scope-operator () - "Insert a double colon scope operator at point. -No indentation or other \"electric\" behavior is performed." - (interactive) - (insert "::")) - - -(defun c-beginning-of-statement (&optional count lim sentence-flag) - "Go to the beginning of the innermost C statement. -With prefix arg, go back N - 1 statements. If already at the -beginning of a statement then go to the beginning of the preceding -one. If within a string or comment, or next to a comment (only -whitespace between), move by sentences instead of statements. - -When called from a program, this function takes 3 optional args: the -repetition count, a buffer position limit which is the farthest back -to search, and a flag saying whether to do sentence motion when in a -comment." - (interactive (list (prefix-numeric-value current-prefix-arg) - nil t)) - (let ((here (point)) - (count (or count 1)) - (lim (or lim (c-point 'bod))) - state) - (save-excursion - (goto-char lim) - (setq state (parse-partial-sexp (point) here nil nil))) - (if (and sentence-flag - (or (nth 3 state) - (nth 4 state) -; (looking-at (concat "[ \t]*" comment-start-skip)) - (save-excursion - (skip-chars-backward " \t") - (goto-char (- (point) 2)) - (looking-at "\\*/")))) - (forward-sentence (- count)) - (while (> count 0) - (c-beginning-of-statement-1 lim) - (setq count (1- count))) - (while (< count 0) - (c-end-of-statement-1) - (setq count (1+ count)))) - ;; its possible we've been left up-buf of lim - (goto-char (max (point) lim)) - ) - (c-keep-region-active)) - -(defun c-end-of-statement (&optional count lim sentence-flag) - "Go to the end of the innermost C statement. - -With prefix arg, go forward N - 1 statements. Move forward to end of -the next statement if already at end. If within a string or comment, -move by sentences instead of statements. - -When called from a program, this function takes 3 optional args: the -repetition count, a buffer position limit which is the farthest back -to search, and a flag saying whether to do sentence motion when in a -comment." - (interactive (list (prefix-numeric-value current-prefix-arg) - nil t)) - (c-beginning-of-statement (- (or count 1)) lim sentence-flag) - (c-keep-region-active)) - -;; WARNING: Be *exceptionally* careful about modifications to this -;; function! Much of CC Mode depends on this Doing The Right Thing. -;; If you break it you will be sorry. -(defun c-beginning-of-statement-1 (&optional lim) - ;; move to the start of the current statement, or the previous - ;; statement if already at the beginning of one. - (let ((firstp t) - (substmt-p t) - donep c-in-literal-cache - ;; KLUDGE ALERT: maybe-labelp is used to pass information - ;; between c-crosses-statement-barrier-p and - ;; c-beginning-of-statement-1. A better way should be - ;; implemented. - maybe-labelp saved - (last-begin (point))) - ;; first check for bare semicolon - (if (and (progn (c-backward-syntactic-ws lim) - (= (preceding-char) ?\;)) - (c-safe (progn (forward-char -1) - (setq saved (point)) - t)) - (progn (c-backward-syntactic-ws lim) - (memq (preceding-char) '(?\; ?{ ?} ?:))) - ) - (setq last-begin saved) - (goto-char last-begin) - (while (not donep) - ;; stop at beginning of buffer - (if (bobp) (setq donep t) - ;; go backwards one balanced expression, but be careful of - ;; unbalanced paren being reached - (if (not (c-safe (progn (backward-sexp 1) t))) - (progn - (if firstp - (backward-up-list 1) - (goto-char last-begin)) - ;; skip over any unary operators, or other special - ;; characters appearing at front of identifier - (save-excursion - (c-backward-syntactic-ws lim) - (skip-chars-backward "-+!*&:.~ \t\n") - (if (= (preceding-char) ?\() - (setq last-begin (point)))) - (goto-char last-begin) - (setq last-begin (point) - donep t))) - - (setq maybe-labelp nil) - ;; see if we're in a literal. if not, then this bufpos may be - ;; a candidate for stopping - (cond - ;; CASE 0: did we hit the error condition above? - (donep) - ;; CASE 1: are we in a literal? - ((eq (c-in-literal lim) 'pound) - (beginning-of-line)) - ;; CASE 2: some other kind of literal? - ((c-in-literal lim)) - ;; CASE 3: are we looking at a conditional keyword? - ((or (looking-at c-conditional-key) - (and (= (following-char) ?\() - (save-excursion - (forward-sexp 1) - (c-forward-syntactic-ws) - (/= (following-char) ?\;)) - (let ((here (point)) - (foundp (progn - (c-backward-syntactic-ws lim) - (forward-word -1) - (and lim - (<= lim (point)) - (not (c-in-literal lim)) - (looking-at c-conditional-key) - )))) - ;; did we find a conditional? - (if (not foundp) - (goto-char here)) - foundp))) - ;; are we in the middle of an else-if clause? - (if (save-excursion - (and (not substmt-p) - (c-safe (progn (forward-sexp -1) t)) - (looking-at "\\<else\\>[ \t\n]+\\<if\\>") - (not (c-in-literal lim)))) - (progn - (forward-sexp -1) - (c-backward-to-start-of-if lim))) - ;; are we sitting at an else clause, that we are not a - ;; substatement of? - (if (and (not substmt-p) - (looking-at "\\<else\\>[^_]")) - (c-backward-to-start-of-if lim)) - ;; are we sitting at the while of a do-while? - (if (and (looking-at "\\<while\\>[^_]") - (c-backward-to-start-of-do lim)) - (setq substmt-p nil)) - (setq last-begin (point) - donep substmt-p)) - ;; CASE 4: are we looking at a label? - ((looking-at c-label-key)) - ;; CASE 5: is this the first time we're checking? - (firstp (setq firstp nil - substmt-p (not (c-crosses-statement-barrier-p - (point) last-begin)) - last-begin (point))) - ;; CASE 6: have we crossed a statement barrier? - ((c-crosses-statement-barrier-p (point) last-begin) - (setq donep t)) - ;; CASE 7: ignore labels - ((and maybe-labelp - (or (and c-access-key (looking-at c-access-key)) - ;; with switch labels, we have to go back further - ;; to try to pick up the case or default - ;; keyword. Potential bogosity alert: we assume - ;; `case' or `default' is first thing on line - (let ((here (point))) - (beginning-of-line) - (c-forward-syntactic-ws) - (if (looking-at c-switch-label-key) - t - (goto-char here) - nil)) - (looking-at c-label-key)))) - ;; CASE 8: ObjC or Java method def - ((and c-method-key - (setq last-begin (c-in-method-def-p))) - (setq donep t)) - ;; CASE 9: nothing special - (t (setq last-begin (point))) - )))) - (goto-char last-begin) - ;; we always do want to skip over non-whitespace modifier - ;; characters that didn't get skipped above - (skip-chars-backward "-+!*&:.~" (c-point 'boi)))) - -(defun c-end-of-statement-1 () - (condition-case () - (progn - (while (and (not (eobp)) - (let ((beg (point))) - (forward-sexp 1) - (let ((end (point))) - (save-excursion - (goto-char beg) - (not (re-search-forward "[;{}]" end t))))))) - (re-search-backward "[;}]") - (forward-char 1)) - (error - (let ((beg (point))) - (backward-up-list -1) - (let ((end (point))) - (goto-char beg) - (search-forward ";" end 'move)))))) - -(defun c-crosses-statement-barrier-p (from to) - ;; Does buffer positions FROM to TO cross a C statement boundary? - (let ((here (point)) - (lim from) - crossedp) - (condition-case () - (progn - (goto-char from) - (while (and (not crossedp) - (< (point) to)) - (skip-chars-forward "^;{}:" to) - (if (not (c-in-literal lim)) - (progn - (if (memq (following-char) '(?\; ?{ ?})) - (setq crossedp t) - (if (= (following-char) ?:) - (setq maybe-labelp t)) - (forward-char 1)) - (setq lim (point))) - (forward-char 1)))) - (error (setq crossedp nil))) - (goto-char here) - crossedp)) - - -(defun c-up-conditional (count) - "Move back to the containing preprocessor conditional, leaving mark behind. -A prefix argument acts as a repeat count. With a negative argument, -move forward to the end of the containing preprocessor conditional. -When going backwards, `#elif' is treated like `#else' followed by -`#if'. When going forwards, `#elif' is ignored." - (interactive "p") - (c-forward-conditional (- count) t) - (c-keep-region-active)) - -(defun c-backward-conditional (count &optional up-flag) - "Move back across a preprocessor conditional, leaving mark behind. -A prefix argument acts as a repeat count. With a negative argument, -move forward across a preprocessor conditional." - (interactive "p") - (c-forward-conditional (- count) up-flag) - (c-keep-region-active)) - -(defun c-forward-conditional (count &optional up-flag) - "Move forward across a preprocessor conditional, leaving mark behind. -A prefix argument acts as a repeat count. With a negative argument, -move backward across a preprocessor conditional." - (interactive "p") - (let* ((forward (> count 0)) - (increment (if forward -1 1)) - (search-function (if forward 're-search-forward 're-search-backward)) - (new)) - (save-excursion - (while (/= count 0) - (let ((depth (if up-flag 0 -1)) found) - (save-excursion - ;; Find the "next" significant line in the proper direction. - (while (and (not found) - ;; Rather than searching for a # sign that - ;; comes at the beginning of a line aside from - ;; whitespace, search first for a string - ;; starting with # sign. Then verify what - ;; precedes it. This is faster on account of - ;; the fastmap feature of the regexp matcher. - (funcall search-function - "#[ \t]*\\(if\\|elif\\|endif\\)" - nil t)) - (beginning-of-line) - ;; Now verify it is really a preproc line. - (if (looking-at "^[ \t]*#[ \t]*\\(if\\|elif\\|endif\\)") - (let ((prev depth)) - ;; Update depth according to what we found. - (beginning-of-line) - (cond ((looking-at "[ \t]*#[ \t]*endif") - (setq depth (+ depth increment))) - ((looking-at "[ \t]*#[ \t]*elif") - (if (and forward (= depth 0)) - (setq found (point)))) - (t (setq depth (- depth increment)))) - ;; If we are trying to move across, and we find an - ;; end before we find a beginning, get an error. - (if (and (< prev 0) (< depth prev)) - (error (if forward - "No following conditional at this level" - "No previous conditional at this level"))) - ;; When searching forward, start from next line so - ;; that we don't find the same line again. - (if forward (forward-line 1)) - ;; If this line exits a level of conditional, exit - ;; inner loop. - (if (< depth 0) - (setq found (point)))) - ;; else - (if forward (forward-line 1)) - ))) - (or found - (error "No containing preprocessor conditional")) - (goto-char (setq new found))) - (setq count (+ count increment)))) - (push-mark) - (goto-char new)) - (c-keep-region-active)) - - -;; commands to indent lines, regions, defuns, and expressions -(defun c-indent-command (&optional whole-exp) - "Indent current line as C code, and/or insert some whitespace. - -If `c-tab-always-indent' is t, always just indent the current line. -If nil, indent the current line only if point is at the left margin or -in the line's indentation; otherwise insert some whitespace[*]. If -other than nil or t, then some whitespace[*] is inserted only within -literals (comments and strings) and inside preprocessor directives, -but the line is always reindented. - -A numeric argument, regardless of its value, means indent rigidly all -the lines of the expression starting after point so that this line -becomes properly indented. The relative indentation among the lines -of the expression are preserved. - - [*] The amount and kind of whitespace inserted is controlled by the - variable `c-insert-tab-function', which is called to do the actual - insertion of whitespace. Normally the function in this variable - just inserts a tab character, or the equivalent number of spaces, - depending on the variable `indent-tabs-mode'." - - (interactive "P") - (let ((bod (c-point 'bod))) - (if whole-exp - ;; If arg, always indent this line as C - ;; and shift remaining lines of expression the same amount. - (let ((shift-amt (c-indent-line)) - beg end) - (save-excursion - (if (eq c-tab-always-indent t) - (beginning-of-line)) - (setq beg (point)) - (forward-sexp 1) - (setq end (point)) - (goto-char beg) - (forward-line 1) - (setq beg (point))) - (if (> end beg) - (indent-code-rigidly beg end (- shift-amt) "#"))) - ;; No arg supplied, use c-tab-always-indent to determine - ;; behavior - (cond - ;; CASE 1: indent when at column zero or in lines indentation, - ;; otherwise insert a tab - ((not c-tab-always-indent) - (if (save-excursion - (skip-chars-backward " \t") - (not (bolp))) - (funcall c-insert-tab-function) - (c-indent-line))) - ;; CASE 2: just indent the line - ((eq c-tab-always-indent t) - (c-indent-line)) - ;; CASE 3: if in a literal, insert a tab, but always indent the - ;; line - (t - (if (c-in-literal bod) - (funcall c-insert-tab-function)) - (c-indent-line) - ))))) - -(defun c-indent-exp (&optional shutup-p) - "Indent each line in balanced expression following point. -Optional SHUTUP-P if non-nil, inhibits message printing and error checking." - (interactive "P") - (let ((here (point)) - end progress-p) - (unwind-protect - (let ((c-echo-syntactic-information-p nil) ;keep quiet for speed - (start (progn - ;; try to be smarter about finding the range of - ;; lines to indent. skip all following - ;; whitespace. failing that, try to find any - ;; opening brace on the current line - (skip-chars-forward " \t\n") - (if (memq (following-char) '(?\( ?\[ ?\{)) - (point) - (let ((state (parse-partial-sexp (point) - (c-point 'eol)))) - (and (nth 1 state) - (goto-char (nth 1 state)) - (memq (following-char) '(?\( ?\[ ?\{)) - (point))))))) - ;; find balanced expression end - (setq end (and (c-safe (progn (forward-sexp 1) t)) - (point-marker))) - ;; sanity check - (and (not start) - (not shutup-p) - (error "Cannot find start of balanced expression to indent.")) - (and (not end) - (not shutup-p) - (error "Cannot find end of balanced expression to indent.")) - (c-progress-init start end 'c-indent-exp) - (setq progress-p t) - (goto-char start) - (beginning-of-line) - (while (< (point) end) - (if (not (looking-at "[ \t]*$")) - (c-indent-line)) - (c-progress-update) - (forward-line 1))) - ;; make sure marker is deleted - (and end - (set-marker end nil)) - (and progress-p - (c-progress-fini 'c-indent-exp)) - (goto-char here)))) - -(defun c-indent-defun () - "Re-indents the current top-level function def, struct or class declaration." - (interactive) - (let ((here (point-marker)) - (c-echo-syntactic-information-p nil) - (brace (c-least-enclosing-brace (c-parse-state)))) - (if brace - (goto-char brace) - (beginning-of-defun)) - ;; if we're sitting at b-o-b, it might be because there was no - ;; least enclosing brace and we were sitting on the defun's open - ;; brace. - (if (and (bobp) (not (= (following-char) ?\{))) - (goto-char here)) - ;; if defun-prompt-regexp is non-nil, b-o-d might not leave us at - ;; the open brace. I consider this an Emacs bug. - (and (boundp 'defun-prompt-regexp) - defun-prompt-regexp - (looking-at defun-prompt-regexp) - (goto-char (match-end 0))) - ;; catch all errors in c-indent-exp so we can 1. give more - ;; meaningful error message, and 2. restore point - (unwind-protect - (c-indent-exp) - (goto-char here) - (set-marker here nil)))) - -(defun c-indent-region (start end) - ;; Indent every line whose first char is between START and END inclusive. - (save-excursion - (goto-char start) - ;; Advance to first nonblank line. - (skip-chars-forward " \t\n") - (beginning-of-line) - (let (endmark) - (unwind-protect - (let ((c-tab-always-indent t) - ;; shut up any echo msgs on indiv lines - (c-echo-syntactic-information-p nil) - fence) - (c-progress-init start end 'c-indent-region) - (setq endmark (copy-marker end)) - (while (and (bolp) - (not (eobp)) - (< (point) endmark)) - ;; update progress - (c-progress-update) - ;; Indent one line as with TAB. - (let (nextline sexpend sexpbeg) - ;; skip blank lines - (skip-chars-forward " \t\n") - (beginning-of-line) - ;; indent the current line - (c-indent-line) - (setq fence (point)) - (if (save-excursion - (beginning-of-line) - (looking-at "[ \t]*#")) - (forward-line 1) - (save-excursion - ;; Find beginning of following line. - (setq nextline (c-point 'bonl)) - ;; Find first beginning-of-sexp for sexp extending past - ;; this line. - (beginning-of-line) - (while (< (point) nextline) - (condition-case nil - (progn - (forward-sexp 1) - (setq sexpend (point))) - (error (setq sexpend nil) - (goto-char nextline))) - (c-forward-syntactic-ws)) - (if sexpend - (progn - ;; make sure the sexp we found really starts on the - ;; current line and extends past it - (goto-char sexpend) - (setq sexpend (point-marker)) - (c-safe (backward-sexp 1)) - (setq sexpbeg (point)))) - (if (and sexpbeg (< sexpbeg fence)) - (setq sexpbeg fence))) - ;; check to see if the next line starts a - ;; comment-only line - (save-excursion - (forward-line 1) - (skip-chars-forward " \t") - (if (looking-at c-comment-start-regexp) - (setq sexpbeg (c-point 'bol)))) - ;; If that sexp ends within the region, indent it all at - ;; once, fast. - (condition-case nil - (if (and sexpend - (> sexpend nextline) - (<= sexpend endmark)) - (progn - (goto-char sexpbeg) - (c-indent-exp 'shutup) - (c-progress-update) - (goto-char sexpend))) - (error - (goto-char sexpbeg) - (c-indent-line))) - ;; Move to following line and try again. - (and sexpend - (markerp sexpend) - (set-marker sexpend nil)) - (forward-line 1) - (setq fence (point)))))) - (set-marker endmark nil) - (c-progress-fini 'c-indent-region) - )))) - -(defun c-mark-function () - "Put mark at end of a C, C++, or Objective-C defun, point at beginning." - (interactive) - (let ((here (point)) - ;; there should be a c-point position for 'eod - (eod (save-excursion (end-of-defun) (point))) - (state (c-parse-state)) - brace) - (while state - (setq brace (car state)) - (if (consp brace) - (goto-char (cdr brace)) - (goto-char brace)) - (setq state (cdr state))) - (if (= (following-char) ?{) - (progn - (forward-line -1) - (while (not (or (bobp) - (looking-at "[ \t]*$"))) - (forward-line -1))) - (forward-line 1) - (skip-chars-forward " \t\n")) - (push-mark here) - (push-mark eod nil t))) - - -;; for progress reporting -(defvar c-progress-info nil) - -(defun c-progress-init (start end context) - ;; start the progress update messages. if this emacs doesn't have a - ;; built-in timer, just be dumb about it - (if (not (fboundp 'current-time)) - (message "indenting region... (this may take a while)") - ;; if progress has already been initialized, do nothing. otherwise - ;; initialize the counter with a vector of: - ;; [start end lastsec context] - (if c-progress-info - () - (setq c-progress-info (vector start - (save-excursion - (goto-char end) - (point-marker)) - (nth 1 (current-time)) - context)) - (message "indenting region...")))) - -(defun c-progress-update () - ;; update progress - (if (not (and c-progress-info c-progress-interval)) - nil - (let ((now (nth 1 (current-time))) - (start (aref c-progress-info 0)) - (end (aref c-progress-info 1)) - (lastsecs (aref c-progress-info 2))) - ;; should we update? currently, update happens every 2 seconds, - ;; what's the right value? - (if (< c-progress-interval (- now lastsecs)) - (progn - (message "indenting region... (%d%% complete)" - (/ (* 100 (- (point) start)) (- end start))) - (aset c-progress-info 2 now))) - ))) - -(defun c-progress-fini (context) - ;; finished - (if (or (eq context (aref c-progress-info 3)) - (eq context t)) - (progn - (set-marker (aref c-progress-info 1) nil) - (setq c-progress-info nil) - (message "indenting region...done")))) - - -;; Skipping of "syntactic whitespace" for Emacs 19. Syntactic -;; whitespace is defined as lexical whitespace, C and C++ style -;; comments, and preprocessor directives. Search no farther back or -;; forward than optional LIM. If LIM is omitted, `beginning-of-defun' -;; is used for backward skipping, point-max is used for forward -;; skipping. Note that Emacs 18 support has been moved to cc-mode-18.el. - -(defun c-forward-syntactic-ws (&optional lim) - ;; Forward skip of syntactic whitespace for Emacs 19. - (save-restriction - (let* ((lim (or lim (point-max))) - (here lim) - (hugenum (point-max))) - (narrow-to-region lim (point)) - (while (/= here (point)) - (setq here (point)) - (forward-comment hugenum) - ;; skip preprocessor directives - (if (and (= (following-char) ?#) - (= (c-point 'boi) (point))) - (end-of-line) - ))))) - -(defun c-backward-syntactic-ws (&optional lim) - ;; Backward skip over syntactic whitespace for Emacs 19. - (save-restriction - (let* ((lim (or lim (c-point 'bod))) - (here lim) - (hugenum (- (point-max)))) - (if (< lim (point)) - (progn - (narrow-to-region lim (point)) - (while (/= here (point)) - (setq here (point)) - (forward-comment hugenum) - (if (eq (c-in-literal lim) 'pound) - (beginning-of-line)) - ))) - ))) - - -;; Return `c' if in a C-style comment, `c++' if in a C++ style -;; comment, `string' if in a string literal, `pound' if on a -;; preprocessor line, or nil if not in a comment at all. Optional LIM -;; is used as the backward limit of the search. If omitted, or nil, -;; `beginning-of-defun' is used." - -;; This is for all v19 Emacsen supporting either 1-bit or 8-bit syntax -(defun c-in-literal (&optional lim) - ;; Determine if point is in a C++ literal. we cache the last point - ;; calculated if the cache is enabled - (if (and (boundp 'c-in-literal-cache) - c-in-literal-cache - (= (point) (aref c-in-literal-cache 0))) - (aref c-in-literal-cache 1) - (let ((rtn (save-excursion - (let* ((lim (or lim (c-point 'bod))) - (here (point)) - (state (parse-partial-sexp lim (point)))) - (cond - ((nth 3 state) 'string) - ((nth 4 state) (if (nth 7 state) 'c++ 'c)) - ((progn - (goto-char here) - (beginning-of-line) - (looking-at "[ \t]*#")) - 'pound) - (t nil)))))) - ;; cache this result if the cache is enabled - (and (boundp 'c-in-literal-cache) - (setq c-in-literal-cache (vector (point) rtn))) - rtn))) - - -;; utilities for moving and querying around syntactic elements -(defun c-parse-state () - ;; Finds and records all open parens between some important point - ;; earlier in the file and point. - ;; - ;; if there's a state cache, return it - (if (boundp 'c-state-cache) c-state-cache - (let* (at-bob - (pos (save-excursion - ;; go back 2 bods, but ignore any bogus positions - ;; returned by beginning-of-defun (i.e. open paren - ;; in column zero) - (let ((cnt 2)) - (while (not (or at-bob (zerop cnt))) - (beginning-of-defun) - (if (= (following-char) ?\{) - (setq cnt (1- cnt))) - (if (bobp) - (setq at-bob t)))) - (point))) - (here (save-excursion - ;;(skip-chars-forward " \t}") - (point))) - (last-bod pos) (last-pos pos) - placeholder state sexp-end) - ;; cache last bod position - (while (catch 'backup-bod - (setq state nil) - (while (and pos (< pos here)) - (setq last-pos pos) - (if (and (setq pos (c-safe (scan-lists pos 1 -1))) - (<= pos here)) - (progn - (setq sexp-end (c-safe (scan-sexps (1- pos) 1))) - (if (and sexp-end - (<= sexp-end here)) - ;; we want to record both the start and end - ;; of this sexp, but we only want to record - ;; the last-most of any of them before here - (progn - (if (= (char-after (1- pos)) ?\{) - (setq state (cons (cons (1- pos) sexp-end) - (if (consp (car state)) - (cdr state) - state)))) - (setq pos sexp-end)) - ;; we're contained in this sexp so put pos on - ;; front of list - (setq state (cons (1- pos) state)))) - ;; something bad happened. check to see if we - ;; crossed an unbalanced close brace. if so, we - ;; didn't really find the right `important bufpos' - ;; so lets back up and try again - (if (and (not pos) (not at-bob) - (setq placeholder - (c-safe (scan-lists last-pos 1 1))) - ;;(char-after (1- placeholder)) - (<= placeholder here) - (= (char-after (1- placeholder)) ?\})) - (while t - (setq last-bod (c-safe (scan-lists last-bod -1 1))) - (if (not last-bod) - (error "unbalanced close brace at position %d" - (1- placeholder)) - (setq at-bob (= last-bod (point-min)) - pos last-bod) - (if (= (char-after last-bod) ?\{) - (throw 'backup-bod t))) - )) ;end-if - )) ;end-while - nil)) - state))) - -(defun c-whack-state (bufpos state) - ;; whack off any state information that appears on STATE which lies - ;; after the bounds of BUFPOS. - (let (newstate car) - (while state - (setq car (car state) - state (cdr state)) - (if (consp car) - ;; just check the car, because in a balanced brace - ;; expression, it must be impossible for the corresponding - ;; close brace to be before point, but the open brace to be - ;; after. - (if (<= bufpos (car car)) - nil ; whack it off - ;; its possible that the open brace is before bufpos, but - ;; the close brace is after. In that case, convert this - ;; to a non-cons element. - (if (<= bufpos (cdr car)) - (setq newstate (append newstate (list (car car)))) - ;; we know that both the open and close braces are - ;; before bufpos, so we also know that everything else - ;; on state is before bufpos, so we can glom up the - ;; whole thing and exit. - (setq newstate (append newstate (list car) state) - state nil))) - (if (<= bufpos car) - nil ; whack it off - ;; it's before bufpos, so everything else should too - (setq newstate (append newstate (list car) state) - state nil)))) - newstate)) - -(defun c-hack-state (bufpos which state) - ;; Using BUFPOS buffer position, and WHICH (must be 'open or - ;; 'close), hack the c-parse-state STATE and return the results. - (if (eq which 'open) - (let ((car (car state))) - (if (or (null car) - (consp car) - (/= bufpos car)) - (cons bufpos state) - state)) - (if (not (eq which 'close)) - (error "c-hack-state, bad argument: %s" which)) - ;; 'close brace - (let ((car (car state)) - (cdr (cdr state))) - (if (consp car) - (setq car (car cdr) - cdr (cdr cdr))) - ;; TBD: is this test relevant??? - (if (consp car) - state ;on error, don't change - ;; watch out for balanced expr already on cdr of list - (cons (cons car bufpos) - (if (consp (car cdr)) - (cdr cdr) cdr)) - )))) - -(defun c-adjust-state (from to shift state) - ;; Adjust all points in state that lie in the region FROM..TO by - ;; SHIFT amount (as would be returned by c-indent-line). - (mapcar - (function - (lambda (e) - (if (consp e) - (let ((car (car e)) - (cdr (cdr e))) - (if (and (<= from car) (< car to)) - (setcar e (+ shift car))) - (if (and (<= from cdr) (< cdr to)) - (setcdr e (+ shift cdr)))) - (if (and (<= from e) (< e to)) - (setq e (+ shift e)))) - e)) - state)) - - -(defun c-beginning-of-inheritance-list (&optional lim) - ;; Go to the first non-whitespace after the colon that starts a - ;; multiple inheritance introduction. Optional LIM is the farthest - ;; back we should search. - (let ((lim (or lim (c-point 'bod))) - (placeholder (progn - (back-to-indentation) - (point)))) - (c-backward-syntactic-ws lim) - (while (and (> (point) lim) - (memq (preceding-char) '(?, ?:)) - (progn - (beginning-of-line) - (setq placeholder (point)) - (skip-chars-forward " \t") - (not (looking-at c-class-key)) - )) - (c-backward-syntactic-ws lim)) - (goto-char placeholder) - (skip-chars-forward "^:" (c-point 'eol)))) - -(defun c-beginning-of-macro (&optional lim) - ;; Go to the beginning of the macro. Right now we don't support - ;; multi-line macros too well - (back-to-indentation)) - -(defun c-in-method-def-p () - ;; Return nil if we aren't in a method definition, otherwise the - ;; position of the initial [+-]. - (save-excursion - (beginning-of-line) - (and c-method-key - (looking-at c-method-key) - (point)) - )) - -(defun c-just-after-func-arglist-p (&optional containing) - ;; Return t if we are between a function's argument list closing - ;; paren and its opening brace. Note that the list close brace - ;; could be followed by a "const" specifier or a member init hanging - ;; colon. Optional CONTAINING is position of containing s-exp open - ;; brace. If not supplied, point is used as search start. - (save-excursion - (c-backward-syntactic-ws) - (let ((checkpoint (or containing (point)))) - (goto-char checkpoint) - ;; could be looking at const specifier - (if (and (= (preceding-char) ?t) - (forward-word -1) - (looking-at "\\<const\\>")) - (c-backward-syntactic-ws) - ;; otherwise, we could be looking at a hanging member init - ;; colon - (goto-char checkpoint) - (if (and (= (preceding-char) ?:) - (progn - (forward-char -1) - (c-backward-syntactic-ws) - (looking-at "[ \t\n]*:\\([^:]+\\|$\\)"))) - nil - (goto-char checkpoint)) - ) - (and (= (preceding-char) ?\)) - ;; check if we are looking at a method def - (or (not c-method-key) - (progn - (forward-sexp -1) - (forward-char -1) - (c-backward-syntactic-ws) - (not (or (= (preceding-char) ?-) - (= (preceding-char) ?+) - ;; or a class category - (progn - (forward-sexp -2) - (looking-at c-class-key)) - ))))) - ))) - -;; defuns to look backwards for things -(defun c-backward-to-start-of-do (&optional lim) - ;; Move to the start of the last "unbalanced" do expression. - ;; Optional LIM is the farthest back to search. If none is found, - ;; nil is returned and point is left unchanged, otherwise t is returned. - (let ((do-level 1) - (case-fold-search nil) - (lim (or lim (c-point 'bod))) - (here (point)) - foundp) - (while (not (zerop do-level)) - ;; we protect this call because trying to execute this when the - ;; while is not associated with a do will throw an error - (condition-case nil - (progn - (backward-sexp 1) - (cond - ((memq (c-in-literal lim) '(c c++))) - ((looking-at "while\\b[^_]") - (setq do-level (1+ do-level))) - ((looking-at "do\\b[^_]") - (if (zerop (setq do-level (1- do-level))) - (setq foundp t))) - ((<= (point) lim) - (setq do-level 0) - (goto-char lim)))) - (error - (goto-char lim) - (setq do-level 0)))) - (if (not foundp) - (goto-char here)) - foundp)) - -(defun c-backward-to-start-of-if (&optional lim) - ;; Move to the start of the last "unbalanced" if and return t. If - ;; none is found, and we are looking at an if clause, nil is - ;; returned. If none is found and we are looking at an else clause, - ;; an error is thrown. - (let ((if-level 1) - (here (c-point 'bol)) - (case-fold-search nil) - (lim (or lim (c-point 'bod))) - (at-if (looking-at "if\\b[^_]"))) - (catch 'orphan-if - (while (and (not (bobp)) - (not (zerop if-level))) - (c-backward-syntactic-ws) - (condition-case nil - (backward-sexp 1) - (error - (if at-if - (throw 'orphan-if nil) - (error "No matching `if' found for `else' on line %d." - (1+ (count-lines 1 here)))))) - (cond - ((looking-at "else\\b[^_]") - (setq if-level (1+ if-level))) - ((looking-at "if\\b[^_]") - ;; check for else if... skip over - (let ((here (point))) - (c-safe (forward-sexp -1)) - (if (looking-at "\\<else\\>[ \t]+\\<if\\>") - nil - (setq if-level (1- if-level)) - (goto-char here)))) - ((< (point) lim) - (setq if-level 0) - (goto-char lim)) - )) - t))) - -(defun c-skip-conditional () - ;; skip forward over conditional at point, including any predicate - ;; statements in parentheses. No error checking is performed. - (forward-sexp (cond - ;; else if() - ((looking-at "\\<else\\>[ \t]+\\<if\\>") 3) - ;; do, else, try, finally - ((looking-at "\\<\\(do\\|else\\|try\\|finally\\)\\>") 1) - ;; for, if, while, switch, catch, synchronized - (t 2)))) - -(defun c-skip-case-statement-forward (state &optional lim) - ;; skip forward over case/default bodies, with optional maximal - ;; limit. if no next case body is found, nil is returned and point - ;; is not moved - (let ((lim (or lim (point-max))) - (here (point)) - donep foundp bufpos - (safepos (point)) - (balanced (car state))) - ;; search until we've passed the limit, or we've found our match - (while (and (< (point) lim) - (not donep)) - (setq safepos (point)) - ;; see if we can find a case statement, not in a literal - (if (and (re-search-forward c-switch-label-key lim 'move) - (setq bufpos (match-beginning 0)) - (not (c-in-literal safepos)) - (/= bufpos here)) - ;; if we crossed into a balanced sexp, we know the case is - ;; not part of our switch statement, so just bound over the - ;; sexp and keep looking. - (if (and (consp balanced) - (> bufpos (car balanced)) - (< bufpos (cdr balanced))) - (goto-char (cdr balanced)) - (goto-char bufpos) - (setq donep t - foundp t)))) - (if (not foundp) - (goto-char here)) - foundp)) - -(defun c-search-uplist-for-classkey (brace-state) - ;; search for the containing class, returning a 2 element vector if - ;; found. aref 0 contains the bufpos of the class key, and aref 1 - ;; contains the bufpos of the open brace. - (if (null brace-state) - ;; no brace-state means we cannot be inside a class - nil - (let ((carcache (car brace-state)) - search-start search-end) - (if (consp carcache) - ;; a cons cell in the first element means that there is some - ;; balanced sexp before the current bufpos. this we can - ;; ignore. the nth 1 and nth 2 elements define for us the - ;; search boundaries - (setq search-start (nth 2 brace-state) - search-end (nth 1 brace-state)) - ;; if the car was not a cons cell then nth 0 and nth 1 define - ;; for us the search boundaries - (setq search-start (nth 1 brace-state) - search-end (nth 0 brace-state))) - ;; search-end cannot be a cons cell - (and (consp search-end) - (error "consp search-end: %s" search-end)) - ;; if search-end is nil, or if the search-end character isn't an - ;; open brace, we are definitely not in a class - (if (or (not search-end) - (< search-end (point-min)) - (/= (char-after search-end) ?{)) - nil - ;; now, we need to look more closely at search-start. if - ;; search-start is nil, then our start boundary is really - ;; point-min. - (if (not search-start) - (setq search-start (point-min)) - ;; if search-start is a cons cell, then we can start - ;; searching from the end of the balanced sexp just ahead of - ;; us - (if (consp search-start) - (setq search-start (cdr search-start)))) - ;; now we can do a quick regexp search from search-start to - ;; search-end and see if we can find a class key. watch for - ;; class like strings in literals - (save-excursion - (save-restriction - (goto-char search-start) - (let ((search-key (concat c-class-key "\\|extern[^_]")) - foundp class match-end) - (while (and (not foundp) - (progn - (c-forward-syntactic-ws) - (> search-end (point))) - (re-search-forward search-key search-end t)) - (setq class (match-beginning 0) - match-end (match-end 0)) - (if (c-in-literal search-start) - nil ; its in a comment or string, ignore - (goto-char class) - (skip-chars-forward " \t\n") - (setq foundp (vector (c-point 'boi) search-end)) - (cond - ;; check for embedded keywords - ((let ((char (char-after (1- class)))) - (and char - (memq (char-syntax char) '(?w ?_)))) - (goto-char match-end) - (setq foundp nil)) - ;; make sure we're really looking at the start of a - ;; class definition, and not a forward decl, return - ;; arg, template arg list, or an ObjC or Java method. - ((and c-method-key - (re-search-forward c-method-key search-end t)) - (setq foundp nil)) - ;; Its impossible to define a regexp for this, and - ;; nearly so to do it programmatically. - ;; - ;; ; picks up forward decls - ;; = picks up init lists - ;; ) picks up return types - ;; > picks up templates, but remember that we can - ;; inherit from templates! - ((let ((skipchars "^;=)")) - ;; try to see if we found the `class' keyword - ;; inside a template arg list - (save-excursion - (skip-chars-backward "^<>" search-start) - (if (= (preceding-char) ?<) - (setq skipchars (concat skipchars ">")))) - (skip-chars-forward skipchars search-end) - (/= (point) search-end)) - (setq foundp nil)) - ))) - foundp)) - ))))) - -(defun c-inside-bracelist-p (containing-sexp brace-state) - ;; return the buffer position of the beginning of the brace list - ;; statement if we're inside a brace list, otherwise return nil. - ;; CONTAINING-SEXP is the buffer pos of the innermost containing - ;; paren. BRACE-STATE is the remainder of the state of enclosing braces - ;; - ;; N.B.: This algorithm can potentially get confused by cpp macros - ;; places in inconvenient locations. Its a trade-off we make for - ;; speed. - (or - ;; this will pick up enum lists - (condition-case () - (save-excursion - (goto-char containing-sexp) - (forward-sexp -1) - (if (or (looking-at "enum[\t\n ]+") - (progn (forward-sexp -1) - (looking-at "enum[\t\n ]+"))) - (point))) - (error nil)) - ;; this will pick up array/aggregate init lists, even if they are nested. - (save-excursion - (let (bufpos failedp) - (while (and (not bufpos) - containing-sexp) - (if (consp containing-sexp) - (setq containing-sexp (car brace-state) - brace-state (cdr brace-state)) - ;; see if significant character just before brace is an equal - (goto-char containing-sexp) - (setq failedp nil) - (condition-case () - (progn - (forward-sexp -1) - (forward-sexp 1) - (c-forward-syntactic-ws containing-sexp)) - (error (setq failedp t))) - (if (or failedp (/= (following-char) ?=)) - ;; lets see if we're nested. find the most nested - ;; containing brace - (setq containing-sexp (car brace-state) - brace-state (cdr brace-state)) - ;; we've hit the beginning of the aggregate list - (c-beginning-of-statement-1 (c-most-enclosing-brace brace-state)) - (setq bufpos (point))) - )) - bufpos)) - )) - - -;; defuns for calculating the syntactic state and indenting a single -;; line of C/C++/ObjC code -(defun c-most-enclosing-brace (state) - ;; return the bufpos of the most enclosing brace that hasn't been - ;; narrowed out by any enclosing class, or nil if none was found - (let (enclosingp) - (while (and state (not enclosingp)) - (setq enclosingp (car state) - state (cdr state)) - (if (consp enclosingp) - (setq enclosingp nil) - (if (> (point-min) enclosingp) - (setq enclosingp nil)) - (setq state nil))) - enclosingp)) - -(defun c-least-enclosing-brace (state) - ;; return the bufpos of the least (highest) enclosing brace that - ;; hasn't been narrowed out by any enclosing class, or nil if none - ;; was found. - (c-most-enclosing-brace (nreverse state))) - -(defun c-safe-position (bufpos state) - ;; return the closest known safe position higher up than point - (let ((safepos nil)) - (while state - (setq safepos - (if (consp (car state)) - (cdr (car state)) - (car state))) - (if (< safepos bufpos) - (setq state nil) - (setq state (cdr state)))) - safepos)) - -(defun c-narrow-out-enclosing-class (state lim) - ;; narrow the buffer so that the enclosing class is hidden - (let (inclass-p) - (and state - (setq inclass-p (c-search-uplist-for-classkey state)) - (narrow-to-region - (progn - (goto-char (1+ (aref inclass-p 1))) - (skip-chars-forward " \t\n" lim) - ;; if point is now left of the class opening brace, we're - ;; hosed, so try a different tact - (if (<= (point) (aref inclass-p 1)) - (progn - (goto-char (1+ (aref inclass-p 1))) - (c-forward-syntactic-ws lim))) - (point)) - ;; end point is the end of the current line - (progn - (goto-char lim) - (c-point 'eol)))) - ;; return the class vector - inclass-p)) - -(defun c-guess-basic-syntax () - ;; guess the syntactic description of the current line of C++ code. - (save-excursion - (save-restriction - (beginning-of-line) - (let* ((indent-point (point)) - (case-fold-search nil) - (fullstate (c-parse-state)) - (state fullstate) - (in-method-intro-p (and c-method-key - (looking-at c-method-key))) - literal containing-sexp char-before-ip char-after-ip lim - syntax placeholder c-in-literal-cache inswitch-p - injava-inher - ;; narrow out any enclosing class or extern "C" block - (inclass-p (c-narrow-out-enclosing-class state indent-point)) - (inextern-p (and inclass-p - (save-excursion - (save-restriction - (widen) - (goto-char (aref inclass-p 0)) - (looking-at "extern[^_]"))))) - ) - - ;; get the buffer position of the most nested opening brace, - ;; if there is one, and it hasn't been narrowed out - (save-excursion - (goto-char indent-point) - (skip-chars-forward " \t}") - (skip-chars-backward " \t") - (while (and state - (not in-method-intro-p) - (not containing-sexp)) - (setq containing-sexp (car state) - state (cdr state)) - (if (consp containing-sexp) - ;; if cdr == point, then containing sexp is the brace - ;; that opens the sexp we close - (if (= (cdr containing-sexp) (point)) - (setq containing-sexp (car containing-sexp)) - ;; otherwise, ignore this element - (setq containing-sexp nil)) - ;; ignore the bufpos if its been narrowed out by the - ;; containing class - (if (<= containing-sexp (point-min)) - (setq containing-sexp nil))))) - - ;; set the limit on the farthest back we need to search - (setq lim (or containing-sexp - (if (consp (car fullstate)) - (cdr (car fullstate)) - nil) - (point-min))) - - ;; cache char before and after indent point, and move point to - ;; the most likely position to perform the majority of tests - (goto-char indent-point) - (skip-chars-forward " \t") - (setq char-after-ip (following-char)) - (c-backward-syntactic-ws lim) - (setq char-before-ip (preceding-char)) - (goto-char indent-point) - (skip-chars-forward " \t") - - ;; are we in a literal? - (setq literal (c-in-literal lim)) - - ;; now figure out syntactic qualities of the current line - (cond - ;; CASE 1: in a string. - ((memq literal '(string)) - (c-add-syntax 'string (c-point 'bopl))) - ;; CASE 2: in a C or C++ style comment. - ((memq literal '(c c++)) - ;; we need to catch multi-paragraph C comments - (while (and (zerop (forward-line -1)) - (looking-at "^[ \t]*$"))) - (c-add-syntax literal (c-point 'boi))) - ;; CASE 3: in a cpp preprocessor - ((eq literal 'pound) - (c-beginning-of-macro lim) - (c-add-syntax 'cpp-macro (c-point 'boi))) - ;; CASE 4: in an objective-c method intro - (in-method-intro-p - (c-add-syntax 'objc-method-intro (c-point 'boi))) - ;; CASE 5: Line is at top level. - ((null containing-sexp) - (cond - ;; CASE 5A: we are looking at a defun, class, or - ;; inline-inclass method opening brace - ((= char-after-ip ?{) - (cond - ;; CASE 5A.1: extern declaration - ((save-excursion - (goto-char indent-point) - (skip-chars-forward " \t") - (and (c-safe (progn (backward-sexp 2) t)) - (looking-at "extern[^_]") - (progn - (setq placeholder (point)) - (forward-sexp 1) - (c-forward-syntactic-ws) - (= (following-char) ?\")))) - (goto-char placeholder) - (c-add-syntax 'extern-lang-open (c-point 'boi))) - ;; CASE 5A.2: we are looking at a class opening brace - ((save-excursion - (goto-char indent-point) - (skip-chars-forward " \t{") - ;; TBD: watch out! there could be a bogus - ;; c-state-cache in place when we get here. we have - ;; to go through much chicanery to ignore the cache. - ;; But of course, there may not be! BLECH! BOGUS! - (let ((decl - (if (boundp 'c-state-cache) - (let ((old-cache c-state-cache)) - (prog2 - (makunbound 'c-state-cache) - (c-search-uplist-for-classkey (c-parse-state)) - (setq c-state-cache old-cache))) - (c-search-uplist-for-classkey (c-parse-state)) - ))) - (and decl - (setq placeholder (aref decl 0))) - )) - (c-add-syntax 'class-open placeholder)) - ;; CASE 5A.3: brace list open - ((save-excursion - (c-beginning-of-statement-1 lim) - ;; c-b-o-s could have left us at point-min - (and (bobp) - (c-forward-syntactic-ws indent-point)) - (if (looking-at "typedef[^_]") - (progn (forward-sexp 1) - (c-forward-syntactic-ws indent-point))) - (setq placeholder (c-point 'boi)) - (and (or (looking-at "enum[ \t\n]+") - (= char-before-ip ?=)) - (save-excursion - (skip-chars-forward "^;(" indent-point) - (not (memq (following-char) '(?\; ?\())) - ))) - (c-add-syntax 'brace-list-open placeholder)) - ;; CASE 5A.4: inline defun open - ((and inclass-p (not inextern-p)) - (c-add-syntax 'inline-open) - (c-add-syntax 'inclass (aref inclass-p 0))) - ;; CASE 5A.5: ordinary defun open - (t - (goto-char placeholder) - (c-add-syntax 'defun-open (c-point 'bol)) - ))) - ;; CASE 5B: first K&R arg decl or member init - ((c-just-after-func-arglist-p) - (cond - ;; CASE 5B.1: a member init - ((or (= char-before-ip ?:) - (= char-after-ip ?:)) - ;; this line should be indented relative to the beginning - ;; of indentation for the topmost-intro line that contains - ;; the prototype's open paren - ;; TBD: is the following redundant? - (if (= char-before-ip ?:) - (forward-char -1)) - (c-backward-syntactic-ws lim) - ;; TBD: is the preceding redundant? - (if (= (preceding-char) ?:) - (progn (forward-char -1) - (c-backward-syntactic-ws lim))) - (if (= (preceding-char) ?\)) - (backward-sexp 1)) - (setq placeholder (point)) - (save-excursion - (and (c-safe (backward-sexp 1) t) - (looking-at "throw[^_]") - (c-safe (backward-sexp 1) t) - (setq placeholder (point)))) - (goto-char placeholder) - (c-add-syntax 'member-init-intro (c-point 'boi)) - ;; we don't need to add any class offset since this - ;; should be relative to the ctor's indentation - ) - ;; CASE 5B.2: K&R arg decl intro - (c-recognize-knr-p - (c-add-syntax 'knr-argdecl-intro (c-point 'boi)) - (and inclass-p (c-add-syntax 'inclass (aref inclass-p 0)))) - ;; CASE 5B.3: Nether region after a C++ or Java func - ;; decl, which could include a `throws' declaration. - (t - (c-beginning-of-statement-1 lim) - (c-add-syntax 'func-decl-cont (c-point 'boi)) - ))) - ;; CASE 5C: inheritance line. could be first inheritance - ;; line, or continuation of a multiple inheritance - ((or (and c-baseclass-key (looking-at c-baseclass-key)) - (and (or (= char-before-ip ?:) - ;; watch out for scope operator - (save-excursion - (and (= char-after-ip ?:) - (c-safe (progn (forward-char 1) t)) - (/= (following-char) ?:) - ))) - (save-excursion - (c-backward-syntactic-ws lim) - (if (= char-before-ip ?:) - (progn - (forward-char -1) - (c-backward-syntactic-ws lim))) - (back-to-indentation) - (looking-at c-class-key))) - ;; for Java - (and (eq major-mode 'java-mode) - (let ((fence (save-excursion - (c-beginning-of-statement-1 lim) - (point))) - cont done) - (save-excursion - (while (not done) - (cond ((looking-at c-Java-special-key) - (setq injava-inher (cons cont (point)) - done t)) - ((or (not (c-safe (forward-sexp -1) t)) - (<= (point) fence)) - (setq done t)) - ) - (setq cont t))) - injava-inher) - (not (c-crosses-statement-barrier-p (cdr injava-inher) - (point))) - )) - (cond - ;; CASE 5C.1: non-hanging colon on an inher intro - ((= char-after-ip ?:) - (c-backward-syntactic-ws lim) - (c-add-syntax 'inher-intro (c-point 'boi)) - ;; don't add inclass symbol since relative point already - ;; contains any class offset - ) - ;; CASE 5C.2: hanging colon on an inher intro - ((= char-before-ip ?:) - (c-add-syntax 'inher-intro (c-point 'boi)) - (and inclass-p (c-add-syntax 'inclass (aref inclass-p 0)))) - ;; CASE 5C.3: in a Java implements/extends - (injava-inher - (let ((where (cdr injava-inher)) - (cont (car injava-inher)) - (here (point))) - (goto-char where) - (cond ((looking-at "throws[^_]") - (c-add-syntax 'func-decl-cont - (progn (c-beginning-of-statement-1 lim) - (c-point 'boi)))) - (cont (c-add-syntax 'inher-cont where)) - (t (c-add-syntax 'inher-intro - (progn (goto-char (cdr injava-inher)) - (c-beginning-of-statement-1 lim) - (point)))) - ))) - ;; CASE 5C.4: a continued inheritance line - (t - (c-beginning-of-inheritance-list lim) - (c-add-syntax 'inher-cont (point)) - ;; don't add inclass symbol since relative point already - ;; contains any class offset - ))) - ;; CASE 5D: this could be a top-level compound statement or a - ;; member init list continuation - ((= char-before-ip ?,) - (goto-char indent-point) - (c-backward-syntactic-ws lim) - (while (and (< lim (point)) - (= (preceding-char) ?,)) - ;; this will catch member inits with multiple - ;; line arglists - (forward-char -1) - (c-backward-syntactic-ws (c-point 'bol)) - (if (= (preceding-char) ?\)) - (backward-sexp 1)) - ;; now continue checking - (beginning-of-line) - (c-backward-syntactic-ws lim)) - (cond - ;; CASE 5D.1: hanging member init colon, but watch out - ;; for bogus matches on access specifiers inside classes. - ((and (= (preceding-char) ?:) - (save-excursion - (forward-word -1) - (not (looking-at c-access-key)))) - (goto-char indent-point) - (c-backward-syntactic-ws lim) - (c-safe (backward-sexp 1)) - (c-add-syntax 'member-init-cont (c-point 'boi)) - ;; we do not need to add class offset since relative - ;; point is the member init above us - ) - ;; CASE 5D.2: non-hanging member init colon - ((progn - (c-forward-syntactic-ws indent-point) - (= (following-char) ?:)) - (skip-chars-forward " \t:") - (c-add-syntax 'member-init-cont (point))) - ;; CASE 5D.3: perhaps a multiple inheritance line? - ((looking-at c-inher-key) - (c-add-syntax 'inher-cont (c-point 'boi))) - ;; CASE 5D.4: perhaps a template list continuation? - ((save-excursion - (skip-chars-backward "^<" lim) - ;; not sure if this is the right test, but it should - ;; be fast and mostly accurate. - (and (= (preceding-char) ?<) - (not (c-in-literal lim)))) - ;; we can probably indent it just like and arglist-cont - (c-add-syntax 'arglist-cont (point))) - ;; CASE 5D.5: perhaps a top-level statement-cont - (t - (c-beginning-of-statement-1 lim) - ;; skip over any access-specifiers - (and inclass-p c-access-key - (while (looking-at c-access-key) - (forward-line 1))) - ;; skip over comments, whitespace - (c-forward-syntactic-ws indent-point) - (c-add-syntax 'statement-cont (c-point 'boi))) - )) - ;; CASE 5E: we are looking at a access specifier - ((and inclass-p - c-access-key - (looking-at c-access-key)) - (c-add-syntax 'access-label (c-point 'bonl)) - (c-add-syntax 'inclass (aref inclass-p 0))) - ;; CASE 5F: extern-lang-close? - ((and inextern-p - (= char-after-ip ?})) - (c-add-syntax 'extern-lang-close (aref inclass-p 1))) - ;; CASE 5G: we are looking at the brace which closes the - ;; enclosing nested class decl - ((and inclass-p - (= char-after-ip ?}) - (save-excursion - (save-restriction - (widen) - (forward-char 1) - (and - (condition-case nil - (progn (backward-sexp 1) t) - (error nil)) - (= (point) (aref inclass-p 1)) - )))) - (save-restriction - (widen) - (goto-char (aref inclass-p 0)) - (c-add-syntax 'class-close (c-point 'boi)))) - ;; CASE 5H: we could be looking at subsequent knr-argdecls - ((and c-recognize-knr-p - ;; here we essentially use the hack that is used in - ;; Emacs' c-mode.el to limit how far back we should - ;; look. The assumption is made that argdecls are - ;; indented at least one space and that function - ;; headers are not indented. - (let ((limit (save-excursion - (re-search-backward "^[^ \^L\t\n#]" nil 'move) - (point)))) - (save-excursion - (c-backward-syntactic-ws limit) - (setq placeholder (point)) - (while (and (memq (preceding-char) '(?\; ?,)) - (> (point) limit)) - (beginning-of-line) - (setq placeholder (point)) - (c-backward-syntactic-ws limit)) - (and (= (preceding-char) ?\)) - (or (not c-method-key) - (progn - (forward-sexp -1) - (forward-char -1) - (c-backward-syntactic-ws) - (not (or (= (preceding-char) ?-) - (= (preceding-char) ?+) - ;; or a class category - (progn - (forward-sexp -2) - (looking-at c-class-key)) - ))))) - )) - (save-excursion - (c-beginning-of-statement-1) - (not (looking-at "typedef[ \t\n]+")))) - (goto-char placeholder) - (c-add-syntax 'knr-argdecl (c-point 'boi))) - ;; CASE 5I: we are at the topmost level, make sure we skip - ;; back past any access specifiers - ((progn - (c-backward-syntactic-ws lim) - (while (and inclass-p - c-access-key - (not (bobp)) - (save-excursion - (c-safe (progn (backward-sexp 1) t)) - (looking-at c-access-key))) - (backward-sexp 1) - (c-backward-syntactic-ws lim)) - (or (bobp) - (memq (preceding-char) '(?\; ?\})))) - ;; real beginning-of-line could be narrowed out due to - ;; enclosure in a class block - (save-restriction - (widen) - (c-add-syntax 'topmost-intro (c-point 'bol)) - (if inclass-p - (progn - (goto-char (aref inclass-p 1)) - (if inextern-p - (c-add-syntax 'inextern-lang) - (c-add-syntax 'inclass (c-point 'boi))))) - )) - ;; CASE 5J: we are at an ObjC or Java method definition - ;; continuation line. - ((and c-method-key - (progn - (c-beginning-of-statement-1 lim) - (beginning-of-line) - (looking-at c-method-key))) - (c-add-syntax 'objc-method-args-cont (point))) - ;; CASE 5K: we are at a topmost continuation line - (t - (c-beginning-of-statement-1 lim) - (c-forward-syntactic-ws) - (c-add-syntax 'topmost-intro-cont (c-point 'boi))) - )) ; end CASE 5 - ;; CASE 6: line is an expression, not a statement. Most - ;; likely we are either in a function prototype or a function - ;; call argument list - ((/= (char-after containing-sexp) ?{) - (c-backward-syntactic-ws containing-sexp) - (cond - ;; CASE 6A: we are looking at the arglist closing paren or - ;; at an Objective-C or Java method call closing bracket. - ((and (/= char-before-ip ?,) - (memq char-after-ip '(?\) ?\]))) - (if (and c-method-key - (progn - (goto-char (1- containing-sexp)) - (c-backward-syntactic-ws lim) - (not (looking-at c-symbol-key)))) - (c-add-syntax 'statement-cont containing-sexp) - (goto-char containing-sexp) - (c-add-syntax 'arglist-close (c-point 'boi)))) - ;; CASE 6B: we are looking at the first argument in an empty - ;; argument list. Use arglist-close if we're actually - ;; looking at a close paren or bracket. - ((memq char-before-ip '(?\( ?\[)) - (goto-char containing-sexp) - (c-add-syntax 'arglist-intro (c-point 'boi))) - ;; CASE 6C: we are inside a conditional test clause. treat - ;; these things as statements - ((save-excursion - (goto-char containing-sexp) - (and (c-safe (progn (forward-sexp -1) t)) - (looking-at "\\<for\\>"))) - (goto-char (1+ containing-sexp)) - (c-forward-syntactic-ws indent-point) - (c-beginning-of-statement-1 containing-sexp) - (if (= char-before-ip ?\;) - (c-add-syntax 'statement (point)) - (c-add-syntax 'statement-cont (point)) - )) - ;; CASE 6D: maybe a continued method call. This is the case - ;; when we are inside a [] bracketed exp, and what precede - ;; the opening bracket is not an identifier. - ((and c-method-key - (= (char-after containing-sexp) ?\[) - (save-excursion - (goto-char (1- containing-sexp)) - (c-backward-syntactic-ws (c-point 'bod)) - (if (not (looking-at c-symbol-key)) - (c-add-syntax 'objc-method-call-cont containing-sexp)) - ))) - ;; CASE 6E: we are looking at an arglist continuation line, - ;; but the preceding argument is on the same line as the - ;; opening paren. This case includes multi-line - ;; mathematical paren groupings, but we could be on a - ;; for-list continuation line - ((and (save-excursion - (goto-char (1+ containing-sexp)) - (skip-chars-forward " \t") - (not (eolp))) - (save-excursion - (c-beginning-of-statement-1 lim) - (skip-chars-backward " \t([") - (<= (point) containing-sexp))) - (goto-char containing-sexp) - (c-add-syntax 'arglist-cont-nonempty (c-point 'boi))) - ;; CASE 6F: we are looking at just a normal arglist - ;; continuation line - (t (c-beginning-of-statement-1 containing-sexp) - (forward-char 1) - (c-forward-syntactic-ws indent-point) - (c-add-syntax 'arglist-cont (c-point 'boi))) - )) - ;; CASE 7: func-local multi-inheritance line - ((and c-baseclass-key - (save-excursion - (goto-char indent-point) - (skip-chars-forward " \t") - (looking-at c-baseclass-key))) - (goto-char indent-point) - (skip-chars-forward " \t") - (cond - ;; CASE 7A: non-hanging colon on an inher intro - ((= char-after-ip ?:) - (c-backward-syntactic-ws lim) - (c-add-syntax 'inher-intro (c-point 'boi))) - ;; CASE 7B: hanging colon on an inher intro - ((= char-before-ip ?:) - (c-add-syntax 'inher-intro (c-point 'boi))) - ;; CASE 7C: a continued inheritance line - (t - (c-beginning-of-inheritance-list lim) - (c-add-syntax 'inher-cont (point)) - ))) - ;; CASE 8: we are inside a brace-list - ((setq placeholder (c-inside-bracelist-p containing-sexp state)) - (cond - ;; CASE 8A: brace-list-close brace - ((and (= char-after-ip ?}) - (c-safe (progn (forward-char 1) - (backward-sexp 1) - t)) - (= (point) containing-sexp)) - (c-add-syntax 'brace-list-close (c-point 'boi))) - ;; CASE 8B: we're looking at the first line in a brace-list - ((save-excursion - (goto-char indent-point) - (c-backward-syntactic-ws containing-sexp) - (= (point) (1+ containing-sexp))) - (goto-char containing-sexp) - ;;(if (= char-after-ip ?{) - ;;(c-add-syntax 'brace-list-open (c-point 'boi)) - (c-add-syntax 'brace-list-intro (c-point 'boi)) - ) - ;;)) ; end CASE 8B - ;; CASE 8C: this is just a later brace-list-entry - (t (goto-char (1+ containing-sexp)) - (c-forward-syntactic-ws indent-point) - (if (= char-after-ip ?{) - (c-add-syntax 'brace-list-open (point)) - (c-add-syntax 'brace-list-entry (point)) - )) ; end CASE 8C - )) ; end CASE 8 - ;; CASE 9: A continued statement - ((and (not (memq char-before-ip '(?\; ?} ?:))) - (> (point) - (save-excursion - (c-beginning-of-statement-1 containing-sexp) - (setq placeholder (point)))) - (/= placeholder containing-sexp)) - (goto-char indent-point) - (skip-chars-forward " \t") - (let ((after-cond-placeholder - (save-excursion - (goto-char placeholder) - (if (looking-at c-conditional-key) - (progn - (c-safe (c-skip-conditional)) - (c-forward-syntactic-ws) - (if (memq (following-char) '(?\;)) - (progn - (forward-char 1) - (c-forward-syntactic-ws))) - (point)) - nil)))) - (cond - ;; CASE 9A: substatement - ((and after-cond-placeholder - (>= after-cond-placeholder indent-point)) - (goto-char placeholder) - (if (= char-after-ip ?{) - (c-add-syntax 'substatement-open (c-point 'boi)) - (c-add-syntax 'substatement (c-point 'boi)))) - ;; CASE 9B: open braces for class or brace-lists - ((= char-after-ip ?{) - (cond - ;; CASE 9B.1: class-open - ((save-excursion - (goto-char indent-point) - (skip-chars-forward " \t{") - (let ((decl (c-search-uplist-for-classkey (c-parse-state)))) - (and decl - (setq placeholder (aref decl 0))) - )) - (c-add-syntax 'class-open placeholder)) - ;; CASE 9B.2: brace-list-open - ((or (save-excursion - (goto-char placeholder) - (looking-at "\\<enum\\>")) - (= char-before-ip ?=)) - (c-add-syntax 'brace-list-open placeholder)) - ;; CASE 9B.3: catch-all for unknown construct. - (t - ;; Can and should I add an extensibility hook here? - ;; Something like c-recognize-hook so support for - ;; unknown constructs could be added. It's probably a - ;; losing proposition, so I dunno. - (goto-char placeholder) - (c-add-syntax 'statement-cont (c-point 'boi)) - (c-add-syntax 'block-open)) - )) - ;; CASE 9C: iostream insertion or extraction operator - ((looking-at "<<\\|>>") - (goto-char placeholder) - (and after-cond-placeholder - (goto-char after-cond-placeholder)) - (while (and (re-search-forward "<<\\|>>" indent-point 'move) - (c-in-literal placeholder))) - ;; if we ended up at indent-point, then the first - ;; streamop is on a separate line. Indent the line like - ;; a statement-cont instead - (if (/= (point) indent-point) - (c-add-syntax 'stream-op (c-point 'boi)) - (c-backward-syntactic-ws lim) - (c-add-syntax 'statement-cont (c-point 'boi)))) - ;; CASE 9D: continued statement. find the accurate - ;; beginning of statement or substatement - (t - (c-beginning-of-statement-1 after-cond-placeholder) - ;; KLUDGE ALERT! c-beginning-of-statement-1 can leave - ;; us before the lim we're passing in. It should be - ;; fixed, but I'm worried about side-effects at this - ;; late date. Fix for v5. - (goto-char (or (and after-cond-placeholder - (max after-cond-placeholder (point))) - (point))) - (c-add-syntax 'statement-cont (point))) - ))) - ;; CASE 10: an else clause? - ((looking-at "\\<else\\>[^_]") - (c-backward-to-start-of-if containing-sexp) - (c-add-syntax 'else-clause (c-point 'boi))) - ;; CASE 11: Statement. But what kind? Lets see if its a - ;; while closure of a do/while construct - ((progn - (goto-char indent-point) - (skip-chars-forward " \t") - (and (looking-at "while\\b[^_]") - (save-excursion - (c-backward-to-start-of-do containing-sexp) - (setq placeholder (point)) - (looking-at "do\\b[^_]")) - )) - (c-add-syntax 'do-while-closure placeholder)) - ;; CASE 12: A case or default label - ((looking-at c-switch-label-key) - (goto-char containing-sexp) - ;; check for hanging braces - (if (/= (point) (c-point 'boi)) - (forward-sexp -1)) - (c-add-syntax 'case-label (c-point 'boi))) - ;; CASE 13: any other label - ((looking-at c-label-key) - (goto-char containing-sexp) - (c-add-syntax 'label (c-point 'boi))) - ;; CASE 14: block close brace, possibly closing the defun or - ;; the class - ((= char-after-ip ?}) - (let* ((lim (c-safe-position containing-sexp fullstate)) - (relpos (save-excursion - (goto-char containing-sexp) - (if (/= (point) (c-point 'boi)) - (c-beginning-of-statement-1 lim)) - (c-point 'boi)))) - (cond - ;; CASE 14A: does this close an inline? - ((let ((inclass-p (progn - (goto-char containing-sexp) - (c-search-uplist-for-classkey state)))) - ;; inextern-p in higher level let* - (setq inextern-p (and inclass-p - (progn - (goto-char (aref inclass-p 0)) - (looking-at "extern[^_]")))) - (and inclass-p (not inextern-p))) - (c-add-syntax 'inline-close relpos)) - ;; CASE 14B: if there an enclosing brace that hasn't - ;; been narrowed out by a class, then this is a - ;; block-close - ((and (not inextern-p) - (c-most-enclosing-brace state)) - (c-add-syntax 'block-close relpos)) - ;; CASE 14C: find out whether we're closing a top-level - ;; class or a defun - (t - (save-restriction - (narrow-to-region (point-min) indent-point) - (let ((decl (c-search-uplist-for-classkey (c-parse-state)))) - (if decl - (c-add-syntax 'class-close (aref decl 0)) - (c-add-syntax 'defun-close relpos))))) - ))) - ;; CASE 15: statement catchall - (t - ;; we know its a statement, but we need to find out if it is - ;; the first statement in a block - (goto-char containing-sexp) - (forward-char 1) - (c-forward-syntactic-ws indent-point) - ;; now skip forward past any case/default clauses we might find. - (while (or (c-skip-case-statement-forward fullstate indent-point) - (and (looking-at c-switch-label-key) - (not inswitch-p))) - (setq inswitch-p t)) - ;; we want to ignore non-case labels when skipping forward - (while (and (looking-at c-label-key) - (goto-char (match-end 0))) - (c-forward-syntactic-ws indent-point)) - (cond - ;; CASE 15A: we are inside a case/default clause inside a - ;; switch statement. find out if we are at the statement - ;; just after the case/default label. - ((and inswitch-p - (progn - (goto-char indent-point) - (c-backward-syntactic-ws containing-sexp) - (back-to-indentation) - (setq placeholder (point)) - (looking-at c-switch-label-key))) - (goto-char indent-point) - (skip-chars-forward " \t") - (if (= (following-char) ?{) - (c-add-syntax 'statement-case-open placeholder) - (c-add-syntax 'statement-case-intro placeholder))) - ;; CASE 15B: continued statement - ((= char-before-ip ?,) - (c-add-syntax 'statement-cont (c-point 'boi))) - ;; CASE 15C: a question/colon construct? But make sure - ;; what came before was not a label, and what comes after - ;; is not a globally scoped function call! - ((or (and (memq char-before-ip '(?: ??)) - (save-excursion - (goto-char indent-point) - (c-backward-syntactic-ws lim) - (back-to-indentation) - (not (looking-at c-label-key)))) - (and (memq char-after-ip '(?: ??)) - (save-excursion - (goto-char indent-point) - (skip-chars-forward " \t") - ;; watch out for scope operator - (not (looking-at "::"))))) - (c-add-syntax 'statement-cont (c-point 'boi))) - ;; CASE 15D: any old statement - ((< (point) indent-point) - (let ((safepos (c-most-enclosing-brace fullstate)) - relpos done) - (goto-char indent-point) - (c-beginning-of-statement-1 safepos) - ;; It is possible we're on the brace that opens a nested - ;; function. - (if (and (= (following-char) ?{) - (save-excursion - (c-backward-syntactic-ws safepos) - (/= (preceding-char) ?\;))) - (c-beginning-of-statement-1 safepos)) - (if (and inswitch-p - (looking-at c-switch-label-key)) - (progn - (goto-char placeholder) - (end-of-line) - (forward-sexp -1))) - (setq relpos (c-point 'boi)) - (while (and (not done) - (<= safepos (point)) - (/= relpos (point))) - (c-beginning-of-statement-1 safepos) - (if (= relpos (c-point 'boi)) - (setq done t)) - (setq relpos (c-point 'boi))) - (c-add-syntax 'statement relpos) - (if (= char-after-ip ?{) - (c-add-syntax 'block-open)))) - ;; CASE 15E: first statement in an inline, or first - ;; statement in a top-level defun. we can tell this is it - ;; if there are no enclosing braces that haven't been - ;; narrowed out by a class (i.e. don't use bod here!) - ((save-excursion - (save-restriction - (widen) - (goto-char containing-sexp) - (c-narrow-out-enclosing-class state containing-sexp) - (not (c-most-enclosing-brace state)))) - (goto-char containing-sexp) - ;; if not at boi, then defun-opening braces are hung on - ;; right side, so we need a different relpos - (if (/= (point) (c-point 'boi)) - (progn - (c-backward-syntactic-ws) - (c-safe (forward-sexp (if (= (preceding-char) ?\)) - -1 -2))) - )) - (c-add-syntax 'defun-block-intro (c-point 'boi))) - ;; CASE 15F: first statement in a block - (t (goto-char containing-sexp) - (if (/= (point) (c-point 'boi)) - (c-beginning-of-statement-1 - (if (= (point) lim) - (c-safe-position (point) state) lim))) - (c-add-syntax 'statement-block-intro (c-point 'boi)) - (if (= char-after-ip ?{) - (c-add-syntax 'block-open))) - )) - ) - - ;; now we need to look at any modifiers - (goto-char indent-point) - (skip-chars-forward " \t") - ;; are we looking at a comment only line? - (if (looking-at c-comment-start-regexp) - (c-add-syntax 'comment-intro)) - ;; we might want to give additional offset to friends (in C++). - (if (and (eq major-mode 'c++-mode) - (looking-at c-C++-friend-key)) - (c-add-syntax 'friend)) - ;; return the syntax - syntax)))) - - -;; indent via syntactic language elements -(defun c-get-offset (langelem) - ;; Get offset from LANGELEM which is a cons cell of the form: - ;; (SYMBOL . RELPOS). The symbol is matched against - ;; c-offsets-alist and the offset found there is either returned, - ;; or added to the indentation at RELPOS. If RELPOS is nil, then - ;; the offset is simply returned. - (let* ((symbol (car langelem)) - (relpos (cdr langelem)) - (match (assq symbol c-offsets-alist)) - (offset (cdr-safe match))) - ;; offset can be a number, a function, a variable, or one of the - ;; symbols + or - - (cond - ((not match) - (if c-strict-syntax-p - (error "don't know how to indent a %s" symbol) - (setq offset 0 - relpos 0))) - ((eq offset '+) (setq offset c-basic-offset)) - ((eq offset '-) (setq offset (- c-basic-offset))) - ((eq offset '++) (setq offset (* 2 c-basic-offset))) - ((eq offset '--) (setq offset (* 2 (- c-basic-offset)))) - ((eq offset '*) (setq offset (/ c-basic-offset 2))) - ((eq offset '/) (setq offset (/ (- c-basic-offset) 2))) - ((c-functionp offset) (setq offset (funcall offset langelem))) - ((not (numberp offset)) (setq offset (symbol-value offset))) - ) - (+ (if (and relpos - (< relpos (c-point 'bol))) - (save-excursion - (goto-char relpos) - (current-column)) - 0) - offset))) - -(defun c-indent-line (&optional syntax) - ;; indent the current line as C/C++/ObjC code. Optional SYNTAX is the - ;; syntactic information for the current line. Returns the amount of - ;; indentation change - (let* ((c-syntactic-context (or syntax (c-guess-basic-syntax))) - (pos (- (point-max) (point))) - (indent (apply '+ (mapcar 'c-get-offset c-syntactic-context))) - (shift-amt (- (current-indentation) indent))) - (and c-echo-syntactic-information-p - (message "syntax: %s, indent= %d" c-syntactic-context indent)) - (if (zerop shift-amt) - nil - (delete-region (c-point 'bol) (c-point 'boi)) - (beginning-of-line) - (indent-to indent)) - (if (< (point) (c-point 'boi)) - (back-to-indentation) - ;; If initial point was within line's indentation, position after - ;; the indentation. Else stay at same point in text. - (if (> (- (point-max) pos) (point)) - (goto-char (- (point-max) pos))) - ) - (run-hooks 'c-special-indent-hook) - shift-amt)) - -(defun c-show-syntactic-information (arg) - "Show syntactic information for current line. -With universal argument, inserts the analysis as a comment on that line." - (interactive "P") - (let ((syntax (c-guess-basic-syntax))) - (if (not (consp arg)) - (message "syntactic analysis: %s" (c-guess-basic-syntax)) - (indent-for-comment) - (insert (format "%s" syntax)) - )) - (c-keep-region-active)) - - -;; Standard indentation line-ups -(defun c-lineup-arglist (langelem) - ;; lineup the current arglist line with the arglist appearing just - ;; after the containing paren which starts the arglist. - (save-excursion - (let* ((containing-sexp - (save-excursion - ;; arglist-cont-nonempty gives relpos == - ;; to boi of containing-sexp paren. This - ;; is good when offset is +, but bad - ;; when it is c-lineup-arglist, so we - ;; have to special case a kludge here. - (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty)) - (progn - (beginning-of-line) - (backward-up-list 1) - (skip-chars-forward " \t" (c-point 'eol))) - (goto-char (cdr langelem))) - (point))) - (cs-curcol (save-excursion - (goto-char (cdr langelem)) - (current-column)))) - (if (save-excursion - (beginning-of-line) - (looking-at "[ \t]*)")) - (progn (goto-char (match-end 0)) - (forward-sexp -1) - (forward-char 1) - (c-forward-syntactic-ws) - (- (current-column) cs-curcol)) - (goto-char containing-sexp) - (or (eolp) - (not (memq (following-char) '(?{ ?\( ))) - (let ((eol (c-point 'eol)) - (here (progn - (forward-char 1) - (skip-chars-forward " \t") - (point)))) - (c-forward-syntactic-ws) - (if (< (point) eol) - (goto-char here)))) - (- (current-column) cs-curcol) - )))) - -(defun c-lineup-arglist-intro-after-paren (langelem) - ;; lineup an arglist-intro line to just after the open paren - (save-excursion - (let ((cs-curcol (save-excursion - (goto-char (cdr langelem)) - (current-column))) - (ce-curcol (save-excursion - (beginning-of-line) - (backward-up-list 1) - (skip-chars-forward " \t" (c-point 'eol)) - (current-column)))) - (- ce-curcol cs-curcol -1)))) - -(defun c-lineup-arglist-close-under-paren (langelem) - ;; lineup an arglist-intro line to just after the open paren - (save-excursion - (let ((cs-curcol (save-excursion - (goto-char (cdr langelem)) - (current-column))) - (ce-curcol (save-excursion - (beginning-of-line) - (backward-up-list 1) - (current-column)))) - (- ce-curcol cs-curcol)))) - -(defun c-lineup-streamop (langelem) - ;; lineup stream operators - (save-excursion - (let* ((relpos (cdr langelem)) - (curcol (progn (goto-char relpos) - (current-column)))) - (re-search-forward "<<\\|>>" (c-point 'eol) 'move) - (goto-char (match-beginning 0)) - (- (current-column) curcol)))) - -(defun c-lineup-multi-inher (langelem) - ;; line up multiple inheritance lines - (save-excursion - (let (cs-curcol - (eol (c-point 'eol)) - (here (point))) - (goto-char (cdr langelem)) - (setq cs-curcol (current-column)) - (skip-chars-forward "^:" eol) - (skip-chars-forward " \t:" eol) - (if (or (eolp) - (looking-at c-comment-start-regexp)) - (c-forward-syntactic-ws here)) - (- (current-column) cs-curcol) - ))) - -(defun c-lineup-java-inher (langelem) - ;; line up Java implements and extends continuations - (save-excursion - (let ((cs-curcol (progn (goto-char (cdr langelem)) - (current-column)))) - (forward-word 1) - (if (looking-at "[ \t]*$") - cs-curcol - (c-forward-syntactic-ws) - (- (current-column) cs-curcol))))) - -(defun c-lineup-C-comments (langelem) - ;; line up C block comment continuation lines - (save-excursion - (let ((here (point)) - (stars (progn (back-to-indentation) - (skip-chars-forward "*"))) - (cs-curcol (progn (goto-char (cdr langelem)) - (current-column)))) - (back-to-indentation) - (if (not (re-search-forward "/[*]+" (c-point 'eol) t)) - (progn - (if (not (looking-at "[*]+")) - (progn - ;; we now have to figure out where this comment begins. - (goto-char here) - (back-to-indentation) - (if (looking-at "[*]+/") - (progn (goto-char (match-end 0)) - (forward-comment -1)) - (goto-char (cdr langelem)) - (back-to-indentation)))) - (- (current-column) cs-curcol)) - (if (zerop stars) - (skip-chars-forward " \t")) - (- (current-column) stars cs-curcol)) - ))) - -(defun c-lineup-comment (langelem) - ;; support old behavior for comment indentation. we look at - ;; c-comment-only-line-offset to decide how to indent comment - ;; only-lines - (save-excursion - (back-to-indentation) - ;; this highly kludgiforous flag prevents the mapcar over - ;; c-syntactic-context from entering an infinite loop - (let ((recurse-prevention-flag (boundp 'recurse-prevention-flag))) - (cond - ;; CASE 1: preserve comment-column - (recurse-prevention-flag 0) - ((= (current-column) comment-column) - ;; we have to subtract out all other indentation - (- comment-column (apply '+ (mapcar 'c-get-offset - c-syntactic-context)))) - ;; indent as specified by c-comment-only-line-offset - ((not (bolp)) - (or (car-safe c-comment-only-line-offset) - c-comment-only-line-offset)) - (t - (or (cdr-safe c-comment-only-line-offset) - (car-safe c-comment-only-line-offset) - -1000)) ;jam it against the left side - )))) - -(defun c-lineup-runin-statements (langelem) - ;; line up statements in coding standards which place the first - ;; statement on the same line as the block opening brace. - (if (= (char-after (cdr langelem)) ?{) - (save-excursion - (let ((curcol (progn - (goto-char (cdr langelem)) - (current-column)))) - (forward-char 1) - (skip-chars-forward " \t") - (- (current-column) curcol))) - 0)) - -(defun c-lineup-math (langelem) - ;; line up math statement-cont after the equals - (save-excursion - (let* ((relpos (cdr langelem)) - (equalp (save-excursion - (goto-char (c-point 'boi)) - (skip-chars-forward "^=" (c-point 'eol)) - (and (= (following-char) ?=) - (- (point) (c-point 'boi))))) - (curcol (progn - (goto-char relpos) - (current-column))) - donep) - (while (and (not donep) - (< (point) (c-point 'eol))) - (skip-chars-forward "^=" (c-point 'eol)) - (if (c-in-literal (cdr langelem)) - (forward-char 1) - (setq donep t))) - (if (/= (following-char) ?=) - ;; there's no equal sign on the line - c-basic-offset - ;; calculate indentation column after equals and ws, unless - ;; our line contains an equals sign - (if (not equalp) - (progn - (forward-char 1) - (skip-chars-forward " \t") - (setq equalp 0))) - (- (current-column) equalp curcol)) - ))) - -(defun c-lineup-ObjC-method-call (langelem) - ;; Line up methods args as elisp-mode does with function args: go to - ;; the position right after the message receiver, and if you are at - ;; (eolp) indent the current line by a constant offset from the - ;; opening bracket; otherwise we are looking at the first character - ;; of the first method call argument, so lineup the current line - ;; with it. - (save-excursion - (let* ((extra (save-excursion - (back-to-indentation) - (c-backward-syntactic-ws (cdr langelem)) - (if (= (preceding-char) ?:) - (- c-basic-offset) - 0))) - (open-bracket-pos (cdr langelem)) - (open-bracket-col (progn - (goto-char open-bracket-pos) - (current-column))) - (target-col (progn - (forward-char) - (forward-sexp) - (skip-chars-forward " \t") - (if (eolp) - (+ open-bracket-col c-basic-offset) - (current-column)))) - ) - (- target-col open-bracket-col extra)))) - -(defun c-lineup-ObjC-method-args (langelem) - ;; Line up the colons that separate args. This is done trying to - ;; align colons vertically. - (save-excursion - (let* ((here (c-point 'boi)) - (curcol (progn (goto-char here) (current-column))) - (eol (c-point 'eol)) - (relpos (cdr langelem)) - (first-col-column (progn - (goto-char relpos) - (skip-chars-forward "^:" eol) - (and (= (following-char) ?:) - (current-column))))) - (if (not first-col-column) - c-basic-offset - (goto-char here) - (skip-chars-forward "^:" eol) - (if (= (following-char) ?:) - (+ curcol (- first-col-column (current-column))) - c-basic-offset))))) - -(defun c-lineup-ObjC-method-args-2 (langelem) - ;; Line up the colons that separate args. This is done trying to - ;; align the colon on the current line with the previous one. - (save-excursion - (let* ((here (c-point 'boi)) - (curcol (progn (goto-char here) (current-column))) - (eol (c-point 'eol)) - (relpos (cdr langelem)) - (prev-col-column (progn - (skip-chars-backward "^:" relpos) - (and (= (preceding-char) ?:) - (- (current-column) 1))))) - (if (not prev-col-column) - c-basic-offset - (goto-char here) - (skip-chars-forward "^:" eol) - (if (= (following-char) ?:) - (+ curcol (- prev-col-column (current-column))) - c-basic-offset))))) - -(defun c-snug-do-while (syntax pos) - "Dynamically calculate brace hanginess for do-while statements. -Using this function, `while' clauses that end a `do-while' block will -remain on the same line as the brace that closes that block. - -See `c-hanging-braces-alist' for how to utilize this function as an -ACTION associated with `block-close' syntax." - (save-excursion - (let (langelem) - (if (and (eq syntax 'block-close) - (setq langelem (assq 'block-close c-syntactic-context)) - (progn (goto-char (cdr langelem)) - (if (= (following-char) ?{) - (c-safe (forward-sexp -1))) - (looking-at "\\<do\\>[^_]"))) - '(before) - '(before after))))) - -(defun c-gnu-impose-minimum () - "Imposes a minimum indentation for lines inside a top-level construct. -The variable `c-label-minimum-indentation' specifies the minimum -indentation amount." - (let ((non-top-levels '(defun-block-intro statement statement-cont - statement-block-intro statement-case-intro - statement-case-open substatement substatement-open - case-label label do-while-closure else-clause - )) - (syntax c-syntactic-context) - langelem) - (while syntax - (setq langelem (car (car syntax)) - syntax (cdr syntax)) - ;; don't adjust comment-only lines - (cond ((eq langelem 'comment-intro) - (setq syntax nil)) - ((memq langelem non-top-levels) - (save-excursion - (setq syntax nil) - (back-to-indentation) - (if (zerop (current-column)) - (insert (make-string c-label-minimum-indentation 32))) - )) - )))) - - -;;; This page handles insertion and removal of backslashes for C macros. - -(defun c-backslash-region (from to delete-flag) - "Insert, align, or delete end-of-line backslashes on the lines in the region. -With no argument, inserts backslashes and aligns existing backslashes. -With an argument, deletes the backslashes. - -This function does not modify blank lines at the start of the region. -If the region ends at the start of a line, it always deletes the -backslash (if any) at the end of the previous line. - -You can put the region around an entire macro definition and use this -command to conveniently insert and align the necessary backslashes." - (interactive "r\nP") - (save-excursion - (goto-char from) - (let ((column c-backslash-column) - (endmark (make-marker))) - (move-marker endmark to) - ;; Compute the smallest column number past the ends of all the lines. - (if (not delete-flag) - (while (< (point) to) - (end-of-line) - (if (= (preceding-char) ?\\) - (progn (forward-char -1) - (skip-chars-backward " \t"))) - (setq column (max column (1+ (current-column)))) - (forward-line 1))) - ;; Adjust upward to a tab column, if that doesn't push past the margin. - (if (> (% column tab-width) 0) - (let ((adjusted (* (/ (+ column tab-width -1) tab-width) tab-width))) - (if (< adjusted (window-width)) - (setq column adjusted)))) - ;; Don't modify blank lines at start of region. - (goto-char from) - (while (and (< (point) endmark) (eolp)) - (forward-line 1)) - ;; Add or remove backslashes on all the lines. - (while (< (point) endmark) - (if (and (not delete-flag) - ;; Un-backslashify the last line - ;; if the region ends right at the start of the next line. - (save-excursion - (forward-line 1) - (< (point) endmark))) - (c-append-backslash column) - (c-delete-backslash)) - (forward-line 1)) - (move-marker endmark nil))) - (c-keep-region-active)) - -(defun c-append-backslash (column) - (end-of-line) - ;; Note that "\\\\" is needed to get one backslash. - (if (= (preceding-char) ?\\) - (progn (forward-char -1) - (delete-horizontal-space) - (indent-to column)) - (indent-to column) - (insert "\\"))) - -(defun c-delete-backslash () - (end-of-line) - (or (bolp) - (progn - (forward-char -1) - (if (looking-at "\\\\") - (delete-region (1+ (point)) - (progn (skip-chars-backward " \t") (point))))))) - - -;; defuns for submitting bug reports - -(defconst c-version "4.390" - "CC Mode version number.") -(defconst c-mode-help-address - "bug-gnu-emacs@prep.ai.mit.edu, cc-mode-help@python.org" - "Address for CC Mode bug reports.") - -(defun c-version () - "Echo the current version of CC Mode in the minibuffer." - (interactive) - (message "Using CC Mode version %s" c-version) - (c-keep-region-active)) - -;; get reporter-submit-bug-report when byte-compiling -(eval-when-compile - (require 'reporter)) - -(defun c-submit-bug-report () - "Submit via mail a bug report on CC Mode." - (interactive) - ;; load in reporter - (let ((reporter-prompt-for-summary-p t) - (reporter-dont-compact-list '(c-offsets-alist)) - (style c-indentation-style) - (hook c-special-indent-hook) - (c-features c-emacs-features)) - (and - (if (y-or-n-p "Do you want to submit a report on CC Mode? ") - t (message "") nil) - (require 'reporter) - (reporter-submit-bug-report - c-mode-help-address - (concat "CC Mode " c-version " (" - (cond ((eq major-mode 'c++-mode) "C++") - ((eq major-mode 'c-mode) "C") - ((eq major-mode 'objc-mode) "ObjC") - ((eq major-mode 'java-mode) "Java") - ) - ")") - (let ((vars (list - ;; report only the vars that affect indentation - 'c-basic-offset - 'c-offsets-alist - 'c-cleanup-list - 'c-comment-only-line-offset - 'c-backslash-column - 'c-delete-function - 'c-electric-pound-behavior - 'c-hanging-braces-alist - 'c-hanging-colons-alist - 'c-hanging-comment-starter-p - 'c-hanging-comment-ender-p - 'c-indent-comments-syntactically-p - 'c-tab-always-indent - 'c-recognize-knr-p - 'c-label-minimum-indentation - 'defun-prompt-regexp - 'tab-width - ))) - (if (not (boundp 'defun-prompt-regexp)) - (delq 'defun-prompt-regexp vars) - vars)) - (function - (lambda () - (insert - "Buffer Style: " style "\n\n" - (if hook - (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" - "c-special-indent-hook is set to '" - (format "%s" hook) - ".\nPerhaps this is your problem?\n" - "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n") - "\n") - (format "c-emacs-features: %s\n" c-features) - ))) - nil - "Dear Barry," - )))) - - -;; menus for XEmacs 19 -(defun c-mode-menu () - (cons (concat mode-name " Mode Commands") c-mode-menu)) - -(defun c-popup-menu (e) - "Pops up the C/C++/ObjC menu." - (interactive "@e") - (popup-menu (c-mode-menu)) - (c-keep-region-active)) - - -;; Emacs/XEmacs Compatibility -;; XEmacs has these, Emacs does not - -(if (fboundp 'functionp) - (defalias 'c-functionp 'functionp) - ;; Lift XEmacs 19.13's functionp from subr.el - (defun c-functionp (obj) - "Returns t if OBJ is a function, nil otherwise." - (cond - ((symbolp obj) (fboundp obj)) - ((subrp obj)) - ((compiled-function-p obj)) - ((consp obj) - (if (eq (car obj) 'lambda) (listp (car (cdr obj))))) - (t nil)))) - -(if (fboundp 'copy-tree) - (defalias 'c-copy-tree 'copy-tree) - ;; Lift XEmacs 19.12's copy-tree - (defun c-copy-tree (tree) - (if (consp tree) - (cons (c-copy-tree (car tree)) - (c-copy-tree (cdr tree))) - (if (vectorp tree) - (let* ((new (copy-sequence tree)) - (i (1- (length new)))) - (while (>= i 0) - (aset new i (c-copy-tree (aref new i))) - (setq i (1- i))) - new) - tree)))) - - -;; Dynamically append the default value of most variables. This is -;; crucial because future c-set-style calls will always reset the -;; variables first to the `cc-mode' style before instituting the new -;; style. Only do this once! -(or (assoc "cc-mode" c-style-alist) - (progn - (c-add-style "cc-mode" - (mapcar - (function - (lambda (var) - (let ((val (symbol-value var))) - (cons var (if (atom val) val - (c-copy-tree val) - )) - ))) - '(c-backslash-column - c-basic-offset - c-cleanup-list - c-comment-only-line-offset - c-electric-pound-behavior - c-hanging-braces-alist - c-hanging-colons-alist - c-hanging-comment-starter-p - c-hanging-comment-ender-p - c-offsets-alist - ))) - ;; the default style is now GNU. This can be overridden in - ;; c-mode-common-hook or {c,c++,objc,java}-mode-hook. - (c-set-style c-site-default-style))) - -(if c-style-variables-are-local-p - (progn - ;; style variables - (make-variable-buffer-local 'c-offsets-alist) - (make-variable-buffer-local 'c-basic-offset) - (make-variable-buffer-local 'c-file-style) - (make-variable-buffer-local 'c-file-offsets) - (make-variable-buffer-local 'c-comment-only-line-offset) - (make-variable-buffer-local 'c-cleanup-list) - (make-variable-buffer-local 'c-hanging-braces-alist) - (make-variable-buffer-local 'c-hanging-colons-alist) - (make-variable-buffer-local 'c-hanging-comment-starter-p) - (make-variable-buffer-local 'c-hanging-comment-ender-p) - (make-variable-buffer-local 'c-backslash-column) - (make-variable-buffer-local 'c-label-minimum-indentation) - (make-variable-buffer-local 'c-special-indent-hook) - (make-variable-buffer-local 'c-indentation-style))) - - -;; fsets for compatibility with BOCM -(fset 'electric-c-brace 'c-electric-brace) -(fset 'electric-c-semi 'c-electric-semi&comma) -(fset 'electric-c-sharp-sign 'c-electric-pound) -;; there is no CC Mode equivalent for electric-c-terminator -(fset 'mark-c-function 'c-mark-function) -(fset 'indent-c-exp 'c-indent-exp) -;;;###autoload (fset 'set-c-style 'c-set-style) -;; Lucid Emacs 19.9 + font-lock + CC Mode - c++-mode lossage -(fset 'c++-beginning-of-defun 'beginning-of-defun) -(fset 'c++-end-of-defun 'end-of-defun) - -;; set up bc warnings for obsolete variables, but for now lets not -;; worry about obsolete functions. maybe later some will be important -;; to flag -(and (or (memq 'v19 c-emacs-features) (memq 'v20 c-emacs-features)) - (let* ((na "Nothing appropriate.") - (vars - (list - (cons 'c++-c-mode-syntax-table 'c-mode-syntax-table) - (cons 'c++-tab-always-indent 'c-tab-always-indent) - (cons 'c++-always-arglist-indent-p na) - (cons 'c++-block-close-brace-offset 'c-offsets-alist) - (cons 'c++-paren-as-block-close-p na) - (cons 'c++-continued-member-init-offset 'c-offsets-alist) - (cons 'c++-member-init-indent 'c-offsets-alist) - (cons 'c++-friend-offset na) - (cons 'c++-access-specifier-offset 'c-offsets-alist) - (cons 'c++-empty-arglist-indent 'c-offsets-alist) - (cons 'c++-comment-only-line-offset 'c-comment-only-line-offset) - (cons 'c++-C-block-comments-indent-p na) - (cons 'c++-cleanup-list 'c-cleanup-list) - (cons 'c++-hanging-braces 'c-hanging-braces-alist) - (cons 'c++-hanging-member-init-colon 'c-hanging-colons-alist) - (cons 'c++-auto-hungry-initial-state - "Use `c-auto-newline' and `c-hungry-delete-key' instead.") - (cons 'c++-auto-hungry-toggle na) - (cons 'c++-relative-offset-p na) - (cons 'c++-special-indent-hook 'c-special-indent-hook) - (cons 'c++-delete-function 'c-delete-function) - (cons 'c++-electric-pound-behavior 'c-electric-pound-behavior) - (cons 'c++-hungry-delete-key 'c-hungry-delete-key) - (cons 'c++-auto-newline 'c-auto-newline) - (cons 'c++-match-header-strongly na) - (cons 'c++-defun-header-strong-struct-equivs na) - (cons 'c++-version 'c-version) - (cons 'c++-mode-help-address 'c-mode-help-address) - (cons 'c-indent-level 'c-basic-offset) - (cons 'c-brace-imaginary-offset na) - (cons 'c-brace-offset 'c-offsets-alist) - (cons 'c-argdecl-indent 'c-offsets-alist) - (cons 'c-label-offset 'c-offsets-alist) - (cons 'c-continued-statement-offset 'c-offsets-alist) - (cons 'c-continued-brace-offset 'c-offsets-alist) - (cons 'c-default-macroize-column 'c-backslash-column) - (cons 'c++-default-macroize-column 'c-backslash-column) - (cons 'c-block-comments-indent-p na) - ))) - (mapcar - (function - (lambda (elt) - (make-obsolete-variable (car elt) (cdr elt)))) - vars))) - -(provide 'cc-mode) -;;; cc-mode.el ends here
--- a/lisp/modes/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/modes/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -14,7 +14,6 @@ (put 'minibuffer 'custom-loads '()) (put 'environment 'custom-loads '()) (put 'sound 'custom-loads '()) -(put 'cc-style 'custom-loads '("cc-mode")) (put 'icon 'custom-loads '("icon")) (put 'holidays 'custom-loads '()) (put 'texinfo 'custom-loads '("texinfo")) @@ -28,7 +27,6 @@ (put 'docs 'custom-loads '("texinfo")) (put 'lisp-indent 'custom-loads '("cl-indent")) (put 'tools 'custom-loads '("make-mode")) -(put 'cc-comment 'custom-loads '("cc-mode")) (put 'editing-basics 'custom-loads '()) (put 'internal 'custom-loads '()) (put 'calendar 'custom-loads '()) @@ -50,7 +48,6 @@ (put 'message-sending 'custom-loads '()) (put 'data 'custom-loads '()) (put 'ps-print 'custom-loads '()) -(put 'cc-indent 'custom-loads '("cc-mode")) (put 'backup 'custom-loads '()) (put 'fortran-comment 'custom-loads '("fortran")) (put 'outl-mouse 'custom-loads '("outl-mouse")) @@ -63,14 +60,12 @@ (put 'toolbar 'custom-loads '()) (put 'compilation 'custom-loads '()) (put 'dired 'custom-loads '()) -(put 'cc-auto 'custom-loads '("cc-mode")) (put 'c-macro 'custom-loads '("cmacexp")) (put 'killing 'custom-loads '()) (put 'paren-blinking 'custom-loads '()) (put 'vrml 'custom-loads '("vrml-mode")) (put 'find-file 'custom-loads '()) (put 'fortran 'custom-loads '("f90" "fortran")) -(put 'cc-mode 'custom-loads '("cc-mode")) (put 'gnuserv 'custom-loads '()) (put 'maint 'custom-loads '()) (put 'fill-comments 'custom-loads '()) @@ -78,19 +73,17 @@ (put 'windows 'custom-loads '()) (put 'message-various 'custom-loads '()) (put 'resize-minibuffer 'custom-loads '("rsz-minibuf")) -(put 'languages 'custom-loads '("asm-mode" "fortran" "icon" "pascal" "prolog" "rexx-mode" "sh-script" "tcl" "verilog-mode" "vrml-mode" "xrdb-mode")) +(put 'languages 'custom-loads '("asm-mode" "fortran" "icon" "pascal" "prolog" "rexx-mode" "sh-script" "tcl" "verilog-mode" "vrml-mode" "winmgr-mode" "xrdb-mode")) (put 'fill 'custom-loads '()) (put 'debug 'custom-loads '()) (put 'display 'custom-loads '()) (put 'diary 'custom-loads '()) -(put 'cc-syntax 'custom-loads '("cc-mode")) (put 'browse-url 'custom-loads '()) (put 'enriched 'custom-loads '("enriched")) (put 'processes 'custom-loads '("executable")) (put 'rexx 'custom-loads '("rexx-mode")) (put 'executable 'custom-loads '("executable")) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'wp 'custom-loads '("enriched")) (put 'vc 'custom-loads '()) (put 'sh 'custom-loads '("sh-script")) @@ -102,8 +95,9 @@ (put 'whitespace 'custom-loads '("whitespace-mode")) (put 'editing 'custom-loads '()) (put 'matching 'custom-loads '("whitespace-mode")) +(put 'winmgr 'custom-loads '("winmgr-mode")) (put 'ps-print-color 'custom-loads '()) (put 'unix 'custom-loads '("sh-script")) (put 'undo 'custom-loads '()) (put 'x 'custom-loads '()) -(put 'c 'custom-loads '("cc-mode" "cmacexp")) +(put 'c 'custom-loads '("cmacexp"))
--- a/lisp/modes/reftex.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/modes/reftex.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,12 +1,10 @@ ;; reftex.el --- Minor mode for doing \label, \ref and \cite in LaTeX + ;; Copyright (c) 1997 Free Software Foundation, Inc. ;; Author: Carsten Dominik <dominik@strw.LeidenUniv.nl> -;; Version: 2.13 ;; Keywords: tex -;; Derived from: $Id: reftex.el,v 1.1 1997/06/04 08:26:19 steve Exp $ - ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify @@ -49,50 +47,50 @@ ;; ;; OVERVIEW ;; -;; 1. USING \label AND \ref. Labels and references are one of the -;; strong points of LaTeX. But, in documents with hundreds of +;; 1. USING \label AND \ref. Labels and references are one of the +;; strong points of LaTeX. But, in documents with hundreds of ;; equations, figures, tables etc. it becomes quickly impossible to -;; find good label names and to actually remember them. Then, also -;; completion of labels in not enough. One actually needs to see the +;; find good label names and to actually remember them. Then, also +;; completion of labels in not enough. One actually needs to see the ;; context of the label definition to find the right one. ;; -;; - RefTeX distinguishes labels for different environments. It +;; - RefTeX distinguishes labels for different environments. It ;; always knows if a certain label references a figure, table -;; etc. You can configure RefTeX to recognize any additional +;; etc.. You can configure RefTeX to recognize any additional ;; labeled environments you might have defined yourself. ;; ;; - RefTeX defines automatically unique labels. Type `C-c (' -;; (reftex-label) to insert a label at point. RefTeX will either +;; (reftex-label) to insert a label at point. RefTeX will either ;; - derive a label from context (default for section labels) ;; - insert a simple label consisting of a prefix and a number ;; (default for equations and enumerate items) or -;; - prompt for a label string (figures and tables) +;; - prompt for a label string (figures and tables). ;; Which labels are created how can be controlled with the variable -;; reftex-insert-label-flags. +;; `reftex-insert-label-flags'. ;; ;; - Referencing labels is a snap and I promise you'll love it. -;; In order to make a reference, type `C-c )' (reftex-reference). +;; In order to make a reference, type `C-c )' (`reftex-reference'). ;; This shows an outline of the documents with all labels of a ;; certain type (figure, equation,...) and context of the label ;; definition. Selecting one of the labels inserts a \ref macro -;; into the original buffer. Online help during the selection is +;; into the original buffer. Online help during the selection is ;; available with `?'. ;; -;; 2. CITATIONS. After typing `C-c [' (reftex-citation), RefTeX will +;; 2. CITATIONS. After typing `C-c [' (`reftex-citation'), RefTeX will ;; let you specify a regexp to search in current BibTeX database files ;; (as specified in the \bibliography command) and pull out a formatted -;; list of matches for you to choose from. The list is *formatted* and -;; thus much easier to read than the raw database entries. It can also -;; be sorted. The text inserted into the buffer is by default just +;; list of matches for you to choose from. The list is *formatted* and +;; thus much easier to read than the raw database entries. It can also +;; be sorted. The text inserted into the buffer is by default just ;; `\cite{KEY}', but can also contain author names and the year in a -;; configurable way. See documentation of the variable -;; reftex-cite-format. +;; configurable way. See documentation of the variable +;; `reftex-cite-format'. ;; -;; 3. TABLE OF CONTENTS. Typing `C-c =' (reftex-toc) will show -;; a table of contents of the document. From that buffer, you can -;; jump quickly to every part of your document. This is similar to +;; 3. TABLE OF CONTENTS. Typing `C-c =' (`reftex-toc') will show +;; a table of contents of the document. From that buffer, you can +;; jump quickly to every part of your document. This is similar to ;; imenu, only it works for entire multifile documents and uses the -;; keyboard rather than the mouse. The initial version of this +;; keyboard rather than the mouse. The initial version of this ;; function was contributed by Stephen Eglen. ;; ;; 4. MULTIFILE DOCUMENTS are supported in the same way as by AUCTeX. @@ -108,19 +106,20 @@ ;; This will only take effect when you load the file next time or when ;; you reset RefTeX with M-x reftex-reset-mode. ;; -;; RefTeX will also recognize the file variable tex-main-file. This -;; variable is used by the Emacs TeX modes and works just like AUCTeX's -;; TeX-master variable. See the documentation of your TeX/LaTeX modes. +;; RefTeX will also recognize the file variable tex-main-file. This +;; variable is used by the Emacs TeX modes and works just like +;; AUCTeX's TeX-master variable. See the documentation of your TeX/LaTeX +;; modes. ;; ;; RefTeX knows about all files related to a document via input and -;; include. It provides functions to run regular expression searches and +;; include. It provides functions to run regular expression searches and ;; replaces over the entire document and to create a TAGS file. ;; -;; 5. DOCUMENT PARSING. RefTeX needs to parse the document in order to find -;; labels and other information. It will do it automatically once, when -;; you start working with a document. If you need to enforce reparsing -;; later, call any of the functions reftex-citation, reftex-label, -;; reftex-reference, reftex-toc with a raw C-u prefix. +;; 5. DOCUMENT PARSING. RefTeX needs to parse the document in order to find +;; labels and other information. It will do it automatically once, when +;; you start working with a document. If you need to enforce reparsing +;; later, call any of the functions `reftex-citation', `reftex-label', +;; `reftex-reference', `reftex-toc' with a raw C-u prefix. ;; ;;------------------------------------------------------------------------- ;; @@ -132,17 +131,17 @@ ;; mark non-standard environments. RefTeX always understands LaTeX section ;; commands and the following environments: figure, figure*, ;; sidewaysfigure, table, table*, sidewaystable, equation, eqnarray, -;; enumerate. For everythings else, it needs to be configured. +;; enumerate. For everythings else, it needs to be configured. ;; ;; A good way to configure RefTeX is with the custom.el package by Per -;; Abrahamsen, shipped with Emacs 20 and XEmacs 19.15. To do this, just +;; Abrahamsen, shipped with Emacs 20 and XEmacs 19.15. To do this, just ;; say `M-x reftex-customize'. This will not work with older versions ;; of custom.el. ;; ;; Here is a complete list of the RefTeX configuration variables with -;; their default settings. You could copy this list to your .emacs file -;; and change whatever is necessary. Each variable has an extensive -;; documentation string. Look it up for more information! +;; their default settings. You could copy this list to your .emacs file +;; and change whatever is necessary. Each variable has an extensive +;; documentation string. Look it up for more information! ;; ;; ;; Configuration Variables and User Options for RefTeX ------------------ ;; ;; Support for \label and \ref -------------------------------------- @@ -167,6 +166,7 @@ ;; (setq reftex-toc-follow-mode nil) ;; ;; Miscellaneous configurations ----------------------------------------- ;; (setq reftex-extra-bindings nil) +;; (setq reftex-plug-into-AUCTeX nil) ;; (setq reftex-use-fonts t) ;; (setq reftex-keep-temporary-buffers t) ;; (setq reftex-auto-show-entry t) @@ -213,27 +213,27 @@ ;; ("\\myfig" ?f "fig:" nil t))) ;; ;; The type indicator characters ?a and ?h are used for prompts when -;; RefTeX queries for a label type. Note that "h" was chosen for "theorem" -;; since "t" is already taken by "table". Note that also "s", "f", "e", "n" +;; RefTeX queries for a label type. Note that "h" was chosen for "theorem" +;; since "t" is already taken by "table". Note that also "s", "f", "e", "n" ;; are taken by the standard environments. ;; The automatic labels for Axioms and Theorems will look like "ax:23" or ;; "thr:24". ;; The "\ref{%s}" is a format string indicating how to insert references to -;; these labels. The nil format in the \myfig entry means to use the same +;; these labels. The nil format in the \myfig entry means to use the same ;; format as other figure labels. ;; The next item indicates how to grab context of the label definition. ;; - t means to get it from a default location (from the beginning of a \macro -;; or after the \begin statement). t is *not* a good choice for eqnarray +;; or after the \begin statement). t is *not* a good choice for eqnarray ;; and similar environments. ;; - nil means to use the text right after the label definition. ;; - For more complex ways of getting context, see the docstring of -;; reftex-label-alist. +;; `reftex-label-alist'. ;; The strings at the end of each entry are used to guess the correct label ;; type from the word before point when creating a reference. E.g. if you ;; write: "as we have shown in Theorem" and then press `C-)', RefTeX will ;; know that you are looking for a Theorem label and restrict the labels in ;; the menu to only these labels without even asking. -;; See also the documentation string of the variable reftex-label-alist. +;; See also the documentation string of the variable `reftex-label-alist'. ;; ;; Depending on how you would like the label insertion and selection for the ;; new environments to work, you might want to add the letters "a" and "h" @@ -243,12 +243,12 @@ ;; reftex-label-menu-flags ;; ;; The individual flags in these variables can be set to t or nil to enable or -;; disable the feature for all label types. They may also contain a string of +;; disable the feature for all label types. They may also contain a string of ;; label type letters in order to turn on the feature for those types only. ;; ;; ----- ;; If you are writing in a language different from english you might want to -;; add magic words for that language. Here is a German example: +;; add magic words for that language. Here is a German example: ;; ;; (setq reftex-label-alist ;; '((nil ?s nil nil nil ("Kapitel" "Kap." "Abschnitt" "Teil")) @@ -257,20 +257,20 @@ ;; (nil ?f nil nil nil ("Figur" "Abbildung" "Abb.")) ;; (nil ?n nil nil nil ("Punkt")))) ;; -;; Using `nil' as first item in each entry makes sure that this entry does +;; Using nil as first item in each entry makes sure that this entry does ;; not replace the original entry for that label type. ;; ;; HOOKS ;; ----- -;; Loading reftex.el runs the hook reftex-load-hook. Turning on reftex-mode -;; runs reftex-mode-hook. +;; Loading reftex.el runs the hook `reftex-load-hook'. +;; Turning on reftex-mode runs `reftex-mode-hook'. ;; ;;------------------------------------------------------------------------- ;; ;; KEY BINDINGS ;; ;; All important functions of RefTeX can be reached from its menu which -;; is installed in the menu bar as "Ref" menu. Only the more frequently used +;; is installed in the menu bar as "Ref" menu. Only the more frequently used ;; functions have key bindings. ;; ;; Here is the default set of keybindings from RefTeX. @@ -282,7 +282,7 @@ ;; C-c & reftex-view-crossref ;; ;; I've used these bindings in order to avoid interfering with AUCTeX's -;; settings. Personally, I also bind some functions in the C-c LETTER +;; settings. Personally, I also bind some functions in the C-c LETTER ;; map for easier access: ;; ;; C-c t reftex-toc @@ -298,7 +298,7 @@ ;; (setq reftex-extra-bindings t) ;; ;; It is possible to bind the function for viewing cross references to a -;; mouse event. Something like the following in .emacs will do the trick: +;; mouse event. Something like the following in .emacs will do the trick: ;; ;; (add-hook 'reftex-load-hook ;; '(lambda () @@ -317,42 +317,64 @@ ;; ;; http://www.sunsite.auc.dk/auctex/ ;; -;; AUCTeX version 9.7f and later can be configured to delegate label -;; insertion to RefTeX. Do do that, say in your .emacs file +;; Instead of using the RefTeX functions described above directly, you +;; can also use them indirectly through AUCTeX (>9.7p). RefTeX provides +;; several interface functions which can be used as replacement for +;; corresponding AUCTeX functions dealing with labels and citations. +;; In this way you can work normally with AUCTeX and use RefTeX +;; internals to create and complete labels and citation keys. ;; -;; (setq LaTeX-label-function 'reftex-label) +;; `reftex-label' can be used as the `LaTeX-label-function' which does +;; label insertion when new environments are created with C-c C-e. ;; -;; RefTeX also provides functions which can replace TeX-arg-label and -;; TeX-arg-cite in AUCTeX. These functions are compatible with the originals, -;; but use RefTeX internals to create and select labels and citation keys. -;; There are 3 functions: reftex-arg-label, reftex-arg-ref, reftex-arg-cite. +;; `reftex-arg-label', `reftex-arg-ref' and `reftex-arg-cite' can replace +;; the corresponding `TeX-arg-...' functions. E.g. when you insert a +;; label macro with `C-c RET label RET', RefTeX will be transparently used +;; to create the label. +;; +;; In order to plug all 4 functions into AUCTeX, use in .emacs: +;; +;; (setq reftex-plug-into-AUCTeX t) +;; +;; You may also choose to plug in only some of these functions. The +;; following setting will leave TeX-arg-cite as it was while replacing +;; the other 3 AUCTeX functions: ;; -;; AUCTeX can support RefTeX via style files. A style file may contain -;; calls to reftex-add-to-label-alist which defines additions to -;; reftex-label-alist. The argument taken by this function must have exactly -;; the same format as reftex-label-alist. E.g. a good entry in a style file -;; for the amsmath package would be +;; (setq reftex-plug-into-AUCTeX '(t t t nil)) +;; +;; AUCTeX can support RefTeX via style files. A style file may contain +;; calls to `reftex-add-to-label-alist' which defines additions to +;; `reftex-label-alist'. The argument taken by this function must have +;; the same format as `reftex-label-alist'. The `amsmath.el' style file +;; of AUCTeX (>9.7p) for example contains the following: ;; -;; (if (featurep 'reftex) -;; (reftex-add-to-label-alist '(AMSTeX))) +;; (TeX-add-style-hook "amsmath" +;; (function +;; (lambda () +;; (if (featurep 'reftex) +;; (reftex-add-to-label-alist '(AMSTeX)))))) ;; -;; while a package defining a proposition environment with \newtheorem -;; might use +;; while a package `myprop' defining a proposition environment with +;; \newtheorem might use ;; -;; (if (featurep 'reftex) -;; (reftex-add-to-label-alist -;; '(("proposition" ?p "prop:" "~\\ref{%s}" t -;; ("Proposition" "Prop."))))) +;; (TeX-add-style-hook "myprop" +;; (function +;; (lambda () +;; (if (featurep 'reftex) +;; (reftex-add-to-label-alist +;; '(("proposition" ?p "prop:" "~\\ref{%s}" t +;; ("Proposition" "Prop.")))))))) ;; ;; Bib-cite.el ;; ----------- -;; Once you have written a document with labels, refs and citations, it can be -;; nice to read such a file like a hypertext document. RefTeX has some support -;; for that (reftex-view-crossref, reftex-search-document). A more elegant -;; interface with mouse support and links into Hyperbole is provided (among -;; other things) by Peter S. Galbraith's bib-cite.el. There is some overlap in -;; the functionalities of bib-cite and RefTeX. Bib-cite.el comes bundled with -;; AUCTeX. You can also get the latest version from +;; Once you have written a document with labels, refs and citations, +;; it can be nice to read such a file like a hypertext document. +;; RefTeX has some support for that (`reftex-view-crossref', +;; `reftex-search-document'). A more elegant interface with mouse +;; support and links into Hyperbole is provided (among other things) +;; by Peter S. Galbraith's `bib-cite.el'. There is some overlap in the +;; functionalities of Bib-cite and RefTeX. Bib-cite.el comes bundled +;; with AUCTeX. You can also get the latest version from ;; ;; ftp://ftp.phys.ocean.dal.ca/users/rhogee/elisp/bib-cite.el ;; @@ -361,38 +383,38 @@ ;; PERFORMANCE ISSUES ;; ;; 1. RefTeX will load other parts of a multifile document as well as BibTeX -;; database files for lookup purposes. These buffers are kept, so that -;; subsequent lookup in the same files is fast. For large documents and -;; large BibTeX databases, this can use up a lot of memory. If you have +;; database files for lookup purposes. These buffers are kept, so that +;; subsequent lookup in the same files is fast. For large documents and +;; large BibTeX databases, this can use up a lot of memory. If you have ;; more time than memory, try the following option, which will remove ;; buffers created for lookup after use. ;; ;; (setq reftex-keep-temporary-buffers nil) ;; ;; 2. Parsing the document for labels and their context can be slow. -;; Therefore, RefTeX does it just once automatically. Further parsing +;; Therefore, RefTeX does it just once automatically. Further parsing ;; happens only on user request -;; - with a raw C-u prefix arg to any of the functions reftex-label, -;; reftex-reference, reftex-citation, reftex-toc. +;; - with a raw C-u prefix arg to any of the functions `reftex-label', +;; `reftex-reference', `reftex-citation', `reftex-toc'. ;; - with the `r' key from the label selection menu or the *toc* buffer. ;; -;; *** If you use reftex-label to create labels, the list will be updated -;; *** internally, so that no extra parsing is required. +;; *** If you use `reftex-label' to create labels, the list will be +;; *** updated internally, so that no extra parsing is required. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; KNOWN BUGS ;; -;; o If you change reftex-label-alist in an editing session, you need to +;; o If you change `reftex-label-alist' in an editing session, you need to ;; reset reftex with `M-x reftex-reset-mode' in order to make these ;; changes effective. Changes introduced with the function -;; reftex-add-to-label-alist as well as changes applied from the +;; `reftex-add-to-label-alist' as well as changes applied from the ;; customization buffer automatically trigger a reset. ;; ;; o At times the short context shown by RefTeX may not be what you want. ;; In particular, eqnarray environments can be difficult to -;; parse. RefTeX's default behavior for eqnarrays is to scan backwards to -;; either a double backslash or the beginning of the environment. If this +;; parse. RefTeX's default behavior for eqnarrays is to scan backwards to +;; either a double backslash or the beginning of the environment. If this ;; gives unsatisfactory results, make it a habit to place the label ;; *before* each equation ;; @@ -419,21 +441,21 @@ ;; ;; o When the document is scanned, RefTeX creates a large buffer containing ;; the entire document instead of scanning the individual files one by -;; one. This is necessary since a file might not contain the context +;; one. This is necessary since a file might not contain the context ;; needed by RefTeX. ;; ;; o If you have two identical section headings in the same file, -;; reftex-toc will only let you jump to the first one because it searches -;; for the section heading from the beginning of the file. You can work +;; `reftex-toc' will only let you jump to the first one because it searches +;; for the section heading from the beginning of the file. You can work ;; around this by changing one of the section titles in a way LaTeX does -;; not see, e.g. with extra white space. RefTeX will distinguish +;; not see, e.g. with extra white space. RefTeX will distinguish ;; \section{Introduction} from \section{ Introduction}. ;; ;; o RefTeX sees also labels in regions commented out and will refuse to -;; make duplicates of such a label. This is considered to be a feature. +;; make duplicates of such a label. This is considered to be a feature. ;; ;; o When RefTeX tries to show a window full of context from inside a -;; section hidden with outline-minor-mode, it will unhide that section. +;; section hidden with `outline-minor-mode', it will unhide that section. ;; This change will not be reversed automatically. ;; ;;--------------------------------------------------------------------------- @@ -515,26 +537,26 @@ ;; Support for \label and \ref -------------------------------------- (defgroup reftex-label-support nil - "Support for creation, insertion and referencing of labels in LaTeX" + "Support for creation, insertion and referencing of labels in LaTeX." :group 'reftex) (defgroup reftex-defining-label-environments nil - "Definition of environments and macros to do with label" + "Definition of environments and macros to do with label." :group 'reftex-label-support) (defcustom reftex-label-alist nil "Alist with information on environments for \\label-\\ref use. -See the definition of reftex-label-alist-builtin for examples. This variable +See the definition of `reftex-label-alist-builtin' for examples. This variable should define additions and changes to the default. The only things you MUST -NOT change is that '?s' is the type indicator for section labels and SPACE is -for the 'any' label type. These are hard-coded at other places in the code. - -Changes to this variable after reftex.el has been loaded become only +NOT change is that `?s' is the type indicator for section labels and SPACE is +for the `any' label type. These are hard-coded at other places in the code. + +Changes to this variable after RefTeX has been loaded become only effective when RefTeX is reset with \\[reftex-reset-mode]. Each list entry is a list describing an environment or macro carrying a -label. The elements of each list entry are: +label. The elements of each list entry are: 0. Name of the environment (like \"table\") or macro (like \"\\\\myfig\"). Special names: `section' for section labels, `any' to define a group @@ -542,37 +564,37 @@ This may also be nil if this entry is only meant to change some settings associated with the type indicator character (see below). -1. Type indicator character, like ?t. +1. Type indicator character, like `?t'. The type indicator is a single character used in prompts for - label types. It must be a printable character. The same character + label types. It must be a printable character. The same character may occur several times in this list, to cover cases in which different environments carry the same label type (like equation and eqnarray). 2. Label prefix string, like \"tab:\". - The prefix is a short string used as the start of a label. It may be the + The prefix is a short string used as the start of a label. It may be the empty string. -3. Format string for reference insert in buffer. Each %s will be replaced by - the label (yes, several %s can be in there, so that you can set this to: +3. Format string for reference insert in buffer. Each `%s' will be replaced + by the label (several `%s' can be there to do this: \"\\ref{%s} on page~\\pageref{%s}\"). - When the format starts with ~, whitespace before point will be removed so - that the reference cannot be separated from the word before it. + When the format starts with `~', whitespace before point will be removed + so that the reference cannot be separated from the word before it. 4. Indication on how to find the short context. - - If `nil', use the text following the \\label{...} macro. - - If `t', use + - If nil, use the text following the \\label{...} macro. + - If t, use - text following the \\begin{...} statement of environments (not a good choice in in eqnarray or enumerate environments!) - the section heading for section labels. - the begin of the macro for macros. - - If a string, use as regexp to search *backward* from the label. Context - is then the text following the end of the match. E.g. putting this to + - If a string, use as regexp to search *backward* from the label. Context + is then the text following the end of the match. E.g. putting this to \"\\\\\\\\caption{\" will use the beginning of the caption in a figure - or table environment. \"\\\\\\\\begin{eqnarray}\\\\|\\\\\\\\\\\\\\\\\" - works for eqnarrays. + or table environment. + \"\\\\\\\\begin{eqnarray}\\\\|\\\\\\\\\\\\\\\\\" works for eqnarrays. - If a function, call this function with the name of the environment/macro - as argument. On call, point will be just after the \\label macro. The - function is expected to return a suitable context string. It should + as argument. On call, point will be just after the \\label macro. The + function is expected to return a suitable context string. It should throw an exception (error) when failing to find context. Consider the following example, which would return the 10 characters following the label as context: @@ -582,12 +604,12 @@ (buffer-substring (point) (+ 10 (point))) (error \"Buffer too small\"))) - Setting the variable reftex-use-text-after-label-as-context to t overrides - the setting here. - -5. List of magic words which identify a reference to be of this type. If the - word before point is equal to one of these words when calling - reftex-reference, the label list offered will be automatically restricted + Setting the variable `reftex-use-text-after-label-as-context' to t + overrides the setting here. + +5. List of magic words which identify a reference to be of this type. + If the word before point is equal to one of these words when calling + `reftex-reference', the label list offered will be automatically restricted to labels of the correct type. If the type indicator characters of two or more entries are the same, RefTeX @@ -595,10 +617,10 @@ - the first non-nil format and prefix - the magic words of all involved entries. -Any list entry may also be a symbol. If that has an association in -reftex-label-alist-builtin, the cdr of that association is spliced into the -list. See the AMSTeX configuration example in the comment section of -reftex.el." +Any list entry may also be a symbol. If that has an association in +`reftex-label-alist-builtin', the cdr of that association is spliced into the +list. See the AMSTeX configuration example in the comment section of +`reftex.el'." :group 'reftex-defining-label-environments :set 'reftex-set-dirty :type '(list @@ -638,17 +660,20 @@ widget)))) (defcustom reftex-default-label-alist-entries '(Sideways LaTeX) - "Default label alist specifications. LaTeX should be the last entry. -This list describes the default label environments RefTeX should always use in -addition to the specifications in reftex-label-alist. It is probably a + "Default label alist specifications. LaTeX should be the last entry. +This list describes the default label environments RefTeX should always use +in addition to the specifications in reftex-label-alist. It is probably a mistake to remove the LaTeX symbol from this list. -Here are the current options: - +The options include: LaTeX The standard LaTeX environments Sideways The sidewaysfigure and sidewaystable environments AMSTeX The math environments in the AMS_LaTeX amsmath package -AAS The deluxetable environment from the American Astronomical Society" + +For the full list of options, see the constant `reftex-label-alist-builtin'. +Better still, try + +M-x customize-variable RET reftex-default-label-alist-entries RET." :group 'reftex-defining-label-environments :set 'reftex-set-dirty :type '(list :indent 4 @@ -668,8 +693,8 @@ (defcustom reftex-use-text-after-label-as-context nil "*t means, grab context from directly after the \\label{..} macro. This is the fastest method for obtaining context of the label definition, but -requires discipline when placing labels. Setting this variable to t takes -precedence over the individual settings in reftex-label-alist. +requires discipline when placing labels. Setting this variable to t takes +precedence over the individual settings in `reftex-label-alist'. This variable may be set to t, nil, or a string of label type letters indicating the label types for which it should be true." :group 'reftex-defining-label-environments @@ -681,38 +706,38 @@ ;; Label insertion (defgroup reftex-making-and-inserting-labels nil - "Options on how to create new labels" + "Options on how to create new labels." :group 'reftex-label-support) (defcustom reftex-insert-label-flags '("s" "sft") - "Flags governing label insertion. First flag DERIVE, second flag PROMPT. + "Flags governing label insertion. First flag DERIVE, second flag PROMPT. If DERIVE is t, RefTeX will try to derive a sensible label from context. A section label for example will be derived from the section heading. The conversion of the context to a legal label is governed by the -specifications given in reftex-derive-label-parameters. +specifications given in `reftex-derive-label-parameters'. If RefTeX fails to derive a label, it will prompt the user. -If PROMPT is t, the user will be prompted for a label string. The prompt will +If PROMPT is t, the user will be prompted for a label string. The prompt will already contain the prefix, and (if DERIVE is t) a default label derived from context. When PROMPT is nil, the default label will be inserted without query. -So the combination of DERIVE and PROMPT controls label insertion. Here is a +So the combination of DERIVE and PROMPT controls label insertion. Here is a table describing all four possibilities: DERIVE PROMPT ACTION ------------------------------------------------------------------------- - nil nil Insert simple label, like eq:22 or sec:13. No query. - nil t Prompt for label - t nil Derive a label from context and insert without query - t t Derive a label from context and prompt for confirmation + nil nil Insert simple label, like eq:22 or sec:13. No query. + nil t Prompt for label. + t nil Derive a label from context and insert without query. + t t Derive a label from context and prompt for confirmation. Each flag may be set to t, nil, or a string of label type letters indicating the label types for which it should be true. -Thus, the combination may be set differently for each label type. The +Thus, the combination may be set differently for each label type. The default settings \"s\" and \"sft\" mean: Derive section labels from headings -(with confirmation). Prompt for figure and table labels. Use simple labels +(with confirmation). Prompt for figure and table labels. Use simple labels without confirmation for everything else." :group 'reftex-making-and-inserting-labels :type '(list (choice :tag "Derive label from context" @@ -733,11 +758,11 @@ ILLEGAL nil: Throw away any words containing characters illegal in labels. t: Throw away only the illegal characters, not the whole word. ABBREV nil: Never abbreviate words. - t: Always abbreviate words (see reftex-abbrev-parameters). + t: Always abbreviate words (see `reftex-abbrev-parameters'). not t and not nil: Abbreviate words if necessary to shorten label string below MAXCHAR. -SEPARATOR String separating different words in the label -IGNOREWORDS List of words which should not be part of labels" +SEPARATOR String separating different words in the label. +IGNOREWORDS List of words which should not be part of labels." :group 'reftex-making-and-inserting-labels :type '(list (integer :tag "Number of words " 3) (integer :tag "Maximum label length " 20) @@ -761,10 +786,10 @@ (defcustom reftex-abbrev-parameters '(4 2 "^saeiou" "aeiou") "Parameters for abbreviation of words. -MIN-CHARS minimum number of characters remaining after abbreviation -MIN-KILL minimum number of characters to remove when abbreviating words -BEFORE character class before abbrev point in word -AFTER character class after abbrev point in word" +MIN-CHARS Minimum number of characters remaining after abbreviation. +MIN-KILL Minimum number of characters to remove when abbreviating words. +BEFORE Character class before abbrev point in word. +AFTER Character class after abbrev point in word." :group 'reftex-making-and-inserting-labels :type '(list (integer :tag "Minimum chars per word" 4) @@ -776,7 +801,7 @@ ;; Label referencing (defgroup reftex-referencing-labels nil - "Options on how to reference labels" + "Options on how to reference labels." :group 'reftex-label-support) (defcustom reftex-label-menu-flags '(t t nil nil nil nil) @@ -785,17 +810,17 @@ TABLE-OF-CONTENTS Show the labels embedded in a table of context. SECTION-NUMBERS Include section numbers (like 4.1.3) in table of contents. -COUNTERS Show counters. This just numbers the labels in the menu. +COUNTERS Show counters. This just numbers the labels in the menu. NO-CONTEXT Non-nil means do NOT show the short context. -FOLLOW follow full context in other window. -SHOW-COMMENTED Show labels from regions which are commented out. RefTeX +FOLLOW Follow full context in other window. +SHOW-COMMENTED Show labels from regions which are commented out. RefTeX sees these labels, but does not normally show them. Each of these flags can be set to t or nil, or to a string of type letters -indicating the label types for which it should be true. These strings work -like character classes in regular expressions. Thus, setting one of the +indicating the label types for which it should be true. These strings work +like character classes in regular expressions. Thus, setting one of the flags to \"sf\" makes the flag true for section and figure labels, nil -for everything else. Setting it to \"^ft\" makes it the other way round. +for everything else. Setting it to \"^ft\" makes it the other way round. Most options can also be switched from the label menu itself - so if you decide here to not have a table of contents in the label menu, you can still @@ -822,18 +847,18 @@ (defcustom reftex-guess-label-type t - "*Non-nil means, reftex-reference will try to guess the label type. + "*Non-nil means, `reftex-reference' will try to guess the label type. To do that, RefTeX will look at the word before the cursor and compare it with -the words given in reftex-label-alist. When it finds a match, RefTeX will +the words given in `reftex-label-alist'. When it finds a match, RefTeX will immediately offer the correct label menu - otherwise it will prompt you for -a label type. If you set this variable to nil, RefTeX will always prompt." +a label type. If you set this variable to nil, RefTeX will always prompt." :group 'reftex-referencing-labels :type '(boolean)) ;; BibteX citation configuration ---------------------------------------- (defgroup reftex-citation-support nil - "Support for referencing bibliographic data with BibTeX" + "Support for referencing bibliographic data with BibTeX." :group 'reftex) (defcustom reftex-bibpath-environment-variables '("BIBINPUTS" "TEXBIB") @@ -845,7 +870,7 @@ (defcustom reftex-bibfile-ignore-list nil "List of files in \\bibliography{..} RefTeX should *not* parse. The file names have to be in the exact same form as in the bibliography -macro - i.e. without the .bib extension. +macro - i.e. without the `.bib' extension. Intended for files which contain only `@string' macro definitions and the like, which are ignored by RefTeX anyway." :group 'reftex-citation-support @@ -868,29 +893,29 @@ (defcustom reftex-cite-format 'reftex-cite-format-default "Defines the format of citations to be inserted into the buffer. It can be a string, a list of strings, or an alist with characters as keys -and a list of strings in the car. In the simplest case, this can just -be the string \"\\cite{KEY}\", which is also the default. See the -definition of the reftex-cite-format-XXXX constants for more complex +and a list of strings in the car. In the simplest case, this can just +be the string \"\\cite{KEY}\", which is also the default. See the +definition of the `reftex-cite-format-XXXX' constants for more complex examples. - If reftex-cite-format is a string, it will be used as the format. In -the format, AUTHOR will be replaced by the last name of the + If `reftex-cite-format' is a string, it will be used as the format. +In the format, AUTHOR will be replaced by the last name of the author, YEAR will be replaced by the year and KEY by the citation -key. If AUTHOR is present several times, it will be replaced with +key. If AUTHOR is present several times, it will be replaced with successive author names. -See the constant reftex-cite-format-default for an example. - If reftex-cite-format is a list of strings, the string used will -depend upon the number of authors of the article. No authors means, -the first string will be used, 1 author means, the second string will -be used etc. The last string in the list will be used for all articles -with too many authors. See reftex-cite-format-1-author-simple for an +See the constant `reftex-cite-format-default' for an example. + If `reftex-cite-format' is a list of strings, the string used will +depend upon the number of authors of the article. No authors means, +the first string will be used; 1 author means, the second string will +be used etc.. The last string in the list will be used for all articles +with too many authors. See `reftex-cite-format-1-author-simple' for an example. - If reftex-cite-format is a list of cons cells, the car of each cell -needs to be a character. When a selected reference is accepted by + If `reftex-cite-format' is a list of cons cells, the car of each cell +needs to be a character. When a selected reference is accepted by pressing that key, the cdr of the associated list will be used as -described above. See reftex-cite-format-2-authors for an example. +described above. See `reftex-cite-format-2-authors' for an example. In order to configure this variable, you can either set -reftex-cite-format directly yourself or set it to the SYMBOL of one of -the predefined constants. E.g.: +`reftex-cite-format' directly yourself or set it to the SYMBOL of one of +the predefined constants. E.g.: (setq reftex-cite-format 'reftex-cite-format-2-authors)" :group 'reftex-citation-support :type @@ -927,15 +952,46 @@ ;; Miscellaneous configurations ----------------------------------------- (defgroup reftex-miscellaneous-configurations nil - "Collection of further configurations" + "Collection of further configurations." :group 'reftex) (defcustom reftex-extra-bindings nil "Non-nil means, make additional key bindings on startup. -These extra bindings are located in the users C-c letter map." +These extra bindings are located in the users `C-c letter' map." :group 'reftex-miscellaneous-configurations :type '(boolean)) +(defcustom reftex-plug-into-AUCTeX nil + "Plug-in flags for AUCTeX interface. +This variable is a list of 4 boolean flags. When a flag is non-nil, it +means: + + Flag 1: use `reftex-label' as `LaTeX-label-function'. + Flag 2: use `reftex-arg-label' as `TeX-arg-label' + Flag 3: use `reftex-arg-ref' as `TeX-arg-ref' + Flag 4: use `reftex-arg-cite' as `TeX-arg-cite' + +You may also set the variable itself to t or nil in order to turn all +plug-ins on or off, respectively. +\\<LaTeX-mode-map>`LaTeX-label-function' is the function used for label insertion when you +enter a new environment in AUCTeX with \\[LaTeX-environment]. +The `TeX-arg-label' etc. functions are for entering macro arguments during +macro insertion with \\[TeX-insert-macro]. +See the AUCTeX documentation for more information. +RefTeX uses `fset' to take over the function calls. Changing the variable +may require a restart of Emacs in order to become effective." + :group 'reftex-miscellaneous-configurations + :type '(choice (const :tag "No plug-ins" nil) + (const :tag "All possible plug-ins" t) + (list + :tag "Individual choice" + :value (nil nil nil nil) + (boolean :tag "Use reftex-label as LaTeX-label-function") + (boolean :tag "Use reftex-arg-label as TeX-arg-label ") + (boolean :tag "Use reftex-arg-ref as TeX-arg-ref ") + (boolean :tag "Use reftex-arg-cite as TeX-arg-cite ") + ))) + (defcustom reftex-use-fonts t "*Non-nil means, use fonts in label menu and on-the-fly help. Font-lock must be loaded as well to actually get fontified display." @@ -945,16 +1001,16 @@ (defcustom reftex-keep-temporary-buffers t "*Non-nil means, keep any TeX and BibTeX files loaded for lookup. Nil means, kill it immediately after use unless it was already an existing -buffer before the lookup happened. It is faster to keep the buffers, but can +buffer before the lookup happened. It is faster to keep the buffers, but can use a lot of memory, depending on the size of your database and document." :group 'reftex-miscellaneous-configurations :type '(boolean)) (defcustom reftex-auto-show-entry t "*Non-nil means, showing context in another window may unhide a section. -This is important when using outline-minor-mode. If the context to be shown +This is important when using outline-minor-mode. If the context to be shown is in a hidden section, RefTeX will issue a \"show-entry\" command in order -to show it. This is not reversed when the label is selected - so the section +to show it. This is not reversed when the label is selected - so the section remains shown after command completion." :group 'reftex-miscellaneous-configurations :type '(boolean)) @@ -967,6 +1023,9 @@ ;;; Define the formal stuff for a minor mode named RefTeX. ;;; +(defconst reftex-version "2.14 for Emacs distribution." + "Version string for RefTeX.") + (defvar reftex-mode nil "Determines if RefTeX minor mode is active.") (make-variable-buffer-local 'reftex-mode) @@ -987,21 +1046,23 @@ Labels can be created with `\\[reftex-label]' and referenced with `\\[reftex-reference]'. When referencing, you get a menu with all labels of a given type and -context of the label definition. The selected label is inserted as a +context of the label definition. The selected label is inserted as a \\ref macro. Citations can be made with `\\[reftex-citation]' which will use a regular expression to pull out a *formatted* list of articles from your BibTeX -database. The selected citation is inserted as a \\cite macro. +database. The selected citation is inserted as a \\cite macro. A Table of Contents of the entire (multifile) document with browsing capabilities is available with `\\[reftex-toc]'. -Most command have help available on the fly. This help is accessed by +Most command have help available on the fly. This help is accessed by pressing `?' to any prompt mentioning this feature. +Extensive documentation about reftex is in the file header of `reftex.el'. + \\{reftex-mode-map} -Under X, these functions will be available also in a menu on the menu bar. +Under X, these functions will also be available in a menu on the menu bar. ------------------------------------------------------------------------------" @@ -1013,6 +1074,7 @@ (if reftex-mode (progn (easy-menu-add reftex-mode-menu) + (reftex-plug-into-AUCTeX) (run-hooks 'reftex-mode-hook)) (easy-menu-remove reftex-mode-menu))) @@ -1026,6 +1088,22 @@ minor-mode-map-alist))) + + + + + + + + +;;; =========================================================================== +;;; +;;; Silence warnings about variables in other packages. +(defvar TeX-master) +(defvar LaTeX-label-function) +(defvar tex-main-file) +(defvar outline-minor-mode) + ;;; =========================================================================== ;;; ;;; Interfaces for other packages @@ -1035,7 +1113,7 @@ ;;; ------ (defun reftex-arg-label (optional &optional prompt definition) - "Use reftex-label to create a label and insert it with TeX-argument-insert. + "Use `reftex-label' to create label. Insert it with `TeX-argument-insert'. This function is intended for AUCTeX macro support." (let ((label (reftex-label nil t))) (if (and definition (not (string-equal "" label))) @@ -1043,7 +1121,7 @@ (TeX-argument-insert label optional optional))) (defun reftex-arg-ref (optional &optional prompt definition) - "Use reftex-reference to select a label, insert it with TeX-argument-insert. + "Use `reftex-reference' to select label. Insert with `TeX-argument-insert'. This function is intended for AUCTeX macro support." (let ((label (reftex-reference nil t))) (if (and definition (not (string-equal "" label))) @@ -1051,24 +1129,50 @@ (TeX-argument-insert label optional optional))) (defun reftex-arg-cite (optional &optional prompt definition) - "Use reftex-citation to select a key, insert it with TeX-argument-insert. + "Use reftex-citation to select a key. Insert with `TeX-argument-insert'. This function is intended for AUCTeX macro support." (let ((key (reftex-citation nil t))) (TeX-argument-insert (or key "") optional optional))) +(defun reftex-plug-into-AUCTeX () + ;; Replace AucTeX functions with RefTeX functions. + ;; Which functions are replaced is controlled by the variable + ;; `reftex-plug-into-AUCTeX'. + (let ((flags + (cond ((eq reftex-plug-into-AUCTeX t) '(t t t t)) + ((eq reftex-plug-into-AUCTeX nil) '(nil nil nil nil)) + (t reftex-plug-into-AUCTeX)))) + + (and (nth 0 flags) + (boundp 'LaTeX-label-function) + (setq LaTeX-label-function 'reftex-label)) + + (and (nth 1 flags) + (fboundp 'TeX-arg-label) + (fset 'TeX-arg-label 'reftex-arg-label)) + + (and (nth 2 flags) + (fboundp 'TeX-arg-ref) + (fset 'TeX-arg-ref 'reftex-arg-ref)) + + (and (nth 3 flags) + (fboundp 'TeX-arg-cite) + (fset 'TeX-arg-cite 'reftex-arg-cite)))) + + (defvar reftex-label-alist-external-add-ons nil "List of label alist entries added with reftex-add-to-label-alist.") ;;;###autoload (defun reftex-add-to-label-alist (entry-list) - "Add label environment descriptions to reftex-label-alist-external-add-ons. -The format of ENTRY-LIST is exactly like reftex-label-alist. See there + "Add label environment descriptions to `reftex-label-alist-external-add-ons'. +The format of ENTRY-LIST is exactly like `reftex-label-alist'. See there for details. This function makes it possible to support RefTeX from AUCTeX style files. The entries in ENTRY-LIST will be processed after the user settings in -reftex-label-alist, and before the defaults (specified in -reftex-default-label-alist-entries). Any changes made to -reftex-label-alist-external-add-ons will raise a flag to the effect that a +`reftex-label-alist', and before the defaults (specified in +`reftex-default-label-alist-entries'). Any changes made to +`reftex-label-alist-external-add-ons' will raise a flag to the effect that a mode reset is done on the next occasion." (let (entry) (while entry-list @@ -1085,10 +1189,9 @@ ;;; ;;; Technical notes: Multifile works as follows: We keep just one list ;;; of labels for each master file - this can save a lot of memory. -;;; reftex-master-index-list is an alist which connects the true file name +;;; `reftex-master-index-list' is an alist which connects the true file name ;;; of each master file with the symbols holding the information on that -;;; document. Each buffer has local variables which point to these symbols. - +;;; document. Each buffer has local variables which point to these symbols. ;; List of variables which handle the multifile stuff. ;; This list is used to tie, untie, and reset these symbols. @@ -1096,30 +1199,29 @@ '(reftex-label-numbers-symbol reftex-list-of-labels-symbol reftex-bibfile-list-symbol)) -;; Alist connecting master file names with the corresponding lisp symbols +;; Alist connecting master file names with the corresponding lisp symbols. (defvar reftex-master-index-list nil) -;; Last index used for a master file +;; Last index used for a master file. (defvar reftex-multifile-index 0) ;; Alist connecting a master file with all included files. -;; This information is not yet used, just collected. (defvar reftex-master-include-list nil) -;; Variable holding the symbol with current value of label postfix +;; Variable holding the symbol with current value of label postfix. (defvar reftex-label-numbers-symbol nil ) (make-variable-buffer-local 'reftex-label-numbers-symbol) ;; Variable holding the symbol with the label list of the document. ;; Each element of the label list is again a list with the following elements: -;; 0: One character label type indicator -;; 1: Short context to put into label menu -;; 2: The label -;; 3: The name of the file where the label is defined +;; 0: One character label type indicator. +;; 1: Short context to put into label menu. +;; 2: The label. +;; 3: The name of the file where the label is defined. (defvar reftex-list-of-labels-symbol nil) (make-variable-buffer-local 'reftex-list-of-labels-symbol) -;; Variable holding the symbol with a list of library files for this document +;; Variable holding the symbol with a list of library files for this document. (defvar reftex-bibfile-list-symbol nil) (make-variable-buffer-local 'reftex-bibfile-list-symbol) @@ -1137,27 +1239,27 @@ (symbol nil) (symname nil) (newflag nil)) - ;; find the correct index + ;; Find the correct index. (if index ;; symbols do exist (setq index (cdr index)) - ;; get a new index and add info to the alist + ;; Get a new index and add info to the alist. (setq index (reftex-next-multifile-index) reftex-master-index-list (cons (cons master index) reftex-master-index-list) newflag t)) - ;; get/create symbols and tie them + ;; Get/create symbols and tie them. (while symlist (setq symbol (car symlist) symlist (cdr symlist) symname (symbol-name symbol)) (set symbol (intern (concat symname "-" (int-to-string index)))) - ;; initialize if new symbols + ;; Initialize if new symbols. (if newflag (set (symbol-value symbol) nil))) - ;; Return t if the symbols did already exist, nil when we've made them + ;; Return t if the symbols did already exist, nil when we've made them. (not newflag))) (defun reftex-untie-multifile-symbols () @@ -1178,7 +1280,7 @@ (let ((master (cond - ((fboundp 'TeX-master-file) ; AUCTeX is loaded. Use its mechanism. + ((fboundp 'TeX-master-file) ; AUCTeX is loaded. Use its mechanism. (TeX-master-file t)) ((boundp 'TeX-master) ; The variable is defined - lets use it. (cond @@ -1192,37 +1294,37 @@ (setq TeX-master (read-file-name "Master file: " nil nil t nil))))) ((boundp 'tex-main-file) - ;; This is the variable from the default TeX modes + ;; This is the variable from the default TeX modes. (cond ((stringp tex-main-file) ;; ok, this must be it tex-main-file) (t - ;; In this case, the buffer is its own master + ;; In this case, the buffer is its own master. (buffer-file-name)))) (t - ;; Know nothing about master file. Assume this is a master file. + ;; Know nothing about master file. Assume this is a master file. (buffer-file-name))))) (cond ((null master) - (error "Need a filename for this buffer. Please save it first.")) + (error "Need a filename for this buffer. Please save it first.")) ((or (file-exists-p master) (reftex-get-buffer-visiting master)) - ;; We either see the file, or have a buffer on it. OK. + ;; We either see the file, or have a buffer on it. OK. ) ((or (file-exists-p (concat master ".tex")) (reftex-get-buffer-visiting (concat master ".tex"))) ;; Ahh, an extra .tex was missing... (setq master (concat master ".tex"))) (t - ;; Something is wrong here. Throw an exception. + ;; Something is wrong here. Throw an exception. (error "No such master file %s" master))) (expand-file-name master))) (defun reftex-make-master-buffer (master-file mode) "Make a master buffer which contains the MASTER-FILE and all includes. This is to prepare a buffer containing the entire document in correct -sequence for parsing. Therefore it will even expand includes which are +sequence for parsing. Therefore it will even expand includes which are commented out. The function returns the number of input/include files not found." @@ -1232,26 +1334,26 @@ (erase-buffer) (if (not (eq major-mode mode)) (funcall mode)) - ;; first insert the master file + ;; First insert the master file. (if (not (file-exists-p master-file)) (error "No such master file: %s" master-file)) (reftex-insert-buffer-or-file master-file) (subst-char-in-region (point-min) (point-max) ?\r ?\n t) (setq file-list (cons master-file file-list)) (goto-char 1) - ;; remember from which file these lines came + ;; Remember from which file these lines came. (put-text-property (point-min) (point-max) 'file (expand-file-name master-file)) - ;; Now find recursively all include/input statements and expand them + ;; Make the default directory that of the master file. + ;; All input and include stuff works relative to that directory. + (cd (file-name-directory (expand-file-name master-file))) + ;; Now find recursively all include/input statements and expand them. (while (re-search-forward "^[ \t]*\\\\\\(include\\|input\\){\\([^}\n]+\\)}" nil t) - ;; Change default directory, so that relative fine names work correctly (setq file (reftex-no-props (match-string 2))) - (save-match-data - (cd (file-name-directory - (get-text-property (match-beginning 0) 'file))) - (if (not (string-match "\\.tex$" file)) - (setq file (concat file ".tex")))) + (if (not (and (> (length file) 4) + (string= (substring file -4) ".tex"))) + (setq file (concat file ".tex"))) (if (file-exists-p file) (progn (replace-match @@ -1260,16 +1362,16 @@ (match-string 1) file)) (beginning-of-line 0) (narrow-to-region (point) (point)) - ;; insert the file + ;; Insert the file. (reftex-insert-buffer-or-file file) (subst-char-in-region (point-min) (point-max) ?\r ?\n t) (setq file-list (cons (expand-file-name file) file-list)) - ;; remember from which file these lines came + ;; Remember from which file these lines came. (put-text-property (point-min) (point-max) 'file (expand-file-name file)) (goto-char (point-min)) (widen)) - (message "Input/include file %s not found. Ignored. Continuing..." + (message "Input/include file %s not found. Ignored. Continuing..." file) (setq not-found (1+ not-found)))) (setq file-list (nreverse file-list)) @@ -1284,7 +1386,7 @@ (if buffer (let (beg end beg1 end1) (save-excursion - ;; make sure we get the whole buffer + ;; Make sure we get the whole buffer. (set-buffer buffer) (setq beg (point-min) end (point-max)) (widen) @@ -1308,8 +1410,8 @@ (reftex-access-scan-info t)))) (defun reftex-access-scan-info (&optional rescan) - ;; Access the scanning info. When the multifile symbols are not yet tied, - ;; tie them. When they are have to be created, do a buffer scan to + ;; Access the scanning info. When the multifile symbols are not yet tied, + ;; tie them. When they are have to be created, do a buffer scan to ;; fill them. ;; If RESCAN is non-nil, enforce document scanning @@ -1317,12 +1419,12 @@ (catch 'exit (let ((rescan (or (equal rescan t) (equal rescan '(4))))) - ;; Reset the mode if we had changes from style hooks + ;; Reset the mode if we had changes from style hooks. (and reftex-tables-dirty (reftex-reset-mode)) (if (eq reftex-list-of-labels-symbol nil) - ;; Symbols are not yet tied: Tie them and see if they are set + ;; Symbols are not yet tied: Tie them and see if they are set. (reftex-tie-multifile-symbols)) (if (and (symbol-value reftex-list-of-labels-symbol) @@ -1338,7 +1440,7 @@ (save-window-excursion (save-excursion - ;; do the scanning + ;; Do the scanning. (let ((label-list-symbol reftex-list-of-labels-symbol) (label-numbers-symbol reftex-label-numbers-symbol) @@ -1362,7 +1464,7 @@ (defun reftex-create-tags-file () "Create TAGS file by running `etags' on the current document. -The TAGS file is also immediately visited with `visit-tags-table." +The TAGS file is also immediately visited with `visit-tags-table'." (interactive) (reftex-access-scan-info current-prefix-arg) (let* ((master (reftex-TeX-master-file)) @@ -1380,7 +1482,7 @@ "Last grep command used in \\[reftex-grep-document]; default for next grep.") (defun reftex-grep-document (grep-cmd) - "Run grep query through all files related to this document. + "Run grep query through all files related to this document. With prefix arg, force to rescan document. This works also without an active TAGS table." @@ -1405,7 +1507,7 @@ (defun reftex-search-document (&optional regexp) "Regexp search through all files of the current TeX document. -Starts always in the master file. Stops when a match is found. +Starts always in the master file. Stops when a match is found. To continue searching for next match, use command \\[tags-loop-continue]. This works also without an active TAGS table." (interactive) @@ -1459,7 +1561,7 @@ (format "\\\\\\1{%s}" to)))) (defun reftex-this-word (&optional class) -;; grab the word around point +;; Grab the word around point. (setq class (or class "-a-zA-Z0-9:_/.*;|")) (save-excursion (buffer-substring-no-properties @@ -1468,41 +1570,41 @@ ;;; =========================================================================== ;;; -;;; Functions to create and reference automatic labels - -;; The following constants are derived from reftex-label-alist - -;; Prompt used for label type querys directed to the user +;;; Functions to create and reference automatic labels. + +;; The following constants are derived from `reftex-label-alist'. + +;; Prompt used for label type querys directed to the user. (defconst reftex-type-query-prompt nil) -;; Help string for label type querys +;; Help string for label type querys. (defconst reftex-type-query-help nil) -;; Alist relating label type to reference format +;; Alist relating label type to reference format. (defconst reftex-typekey-to-format-alist nil) -;; Alist relating label type to label affix +;; Alist relating label type to label affix. (defconst reftex-typekey-to-prefix-alist nil) -;; Alist relating environments or macros to label type and context regexp +;; Alist relating environments or macros to label type and context regexp. (defconst reftex-env-or-mac-alist nil) -;; List of macros carrying a label +;; List of macros carrying a label. (defconst reftex-label-mac-list nil) -;; List of environments carrying a label +;; List of environments carrying a label. (defconst reftex-label-env-list nil) -;; List of all typekey letters in use +;; List of all typekey letters in use. (defconst reftex-typekey-list nil) -;; Alist relating magic words to a label type +;; Alist relating magic words to a label type. (defconst reftex-words-to-typekey-alist nil) -;; The last list-of-labels entry used in a reference +;; The last list-of-labels entry used in a reference. (defvar reftex-last-used-reference (list nil nil nil nil)) -;; The regular expression used to abbreviate words +;; The regular expression used to abbreviate words. (defconst reftex-abbrev-regexp (concat "^\\(" @@ -1512,15 +1614,15 @@ "[" (nth 3 reftex-abbrev-parameters) "]" (make-string (1- (nth 1 reftex-abbrev-parameters)) ?.))) -;; Global variables used for communication between functions +;; Global variables used for communication between functions. (defvar reftex-default-context-position nil) (defvar reftex-location-start nil) (defvar reftex-call-back-to-this-buffer nil) -;; List of buffers created temporarily for lookup, which should be killed +;; List of buffers created temporarily for lookup, which should be killed. (defvar reftex-buffers-to-kill nil) -;; The regexp used to find section statements +;; The regexp used to find section statements. (defconst reftex-section-regexp "^[ ]*\\\\\\(part\\|chapter\\|section\\|subsection\\|subsubsection\\|paragraph\\|subparagraph\\|subsubparagraph\\)\\*?\\(\\[[^]]*\\]\\)?{") ;; LaTeX section commands and level numbers @@ -1537,7 +1639,7 @@ )) (defun reftex-label (&optional environment no-insert) - "Insert a unique label. Return the label. + "Insert a unique label. Return the label. If ENVIRONMENT is given, don't bother to find out yourself. If NO-INSERT is non-nil, do not insert label into buffer. With prefix arg, force to rescan document first. @@ -1546,30 +1648,30 @@ (interactive) - ;; Ensure access to scanning info and rescan buffer if prefix are is '(4) + ;; Ensure access to scanning info and rescan buffer if prefix are is '(4). (reftex-access-scan-info current-prefix-arg) - ;; Find out what kind of environment this is and abort if necessary + ;; Find out what kind of environment this is and abort if necessary. (if (or (not environment) (not (assoc environment reftex-env-or-mac-alist))) (setq environment (reftex-label-location))) (if (not environment) (error "Can't figure out what kind of label should be inserted")) - ;; Ok, go ahead + ;; Ok, go ahead. (let (label num typekey prefix entry cell lab valid default force-prompt) (setq typekey (nth 1 (assoc environment reftex-env-or-mac-alist))) (setq prefix (or (cdr (assoc typekey reftex-typekey-to-prefix-alist)) (concat typekey "-"))) - ;; make a default label + ;; Make a default label. (cond ((reftex-typekey-check typekey (nth 0 reftex-insert-label-flags)) - ;; derive a label from context + ;; Derive a label from context. (setq default (nth 2 (reftex-label-info " "))) - ;; catch the cases where the is actually no context available + ;; Catch the cases where the is actually no context available. (if (or (string-match "NO MATCH FOR CONTEXT REGEXP" default) (string-match "ILLEGAL VALUE OF PARSE" default) (string-match "SECTION HEADING NOT FOUND" default) @@ -1579,7 +1681,7 @@ force-prompt t) ; need to prompt (setq default (concat prefix (reftex-string-to-label default))) - ;; make it unique + ;; Make it unique. (setq label default) (setq num 1) (while (assoc label (symbol-value reftex-list-of-labels-symbol)) @@ -1587,11 +1689,11 @@ (setq default label))) ((reftex-typekey-check typekey (nth 1 reftex-insert-label-flags)) ; prompt - ;; Minimal default: the user will be prompted + ;; Minimal default: the user will be prompted. (setq default prefix)) (t - ;; make an automatic label + ;; Make an automatic label. (while (assoc (setq default (concat prefix (reftex-next-label-number typekey))) (symbol-value reftex-list-of-labels-symbol))))) @@ -1650,7 +1752,7 @@ "\\\\\\(include\\|input\\){[^}\n]+}" pos t) (re-search-forward reftex-section-regexp pos t) (null look-for)) - (setq note "POSITION UNCERTAIN. RESCAN TO FIX."))) + (setq note "POSITION UNCERTAIN. RESCAN TO FIX."))) (if (not look-for) (set reftex-list-of-labels-symbol (cons (list label typekey text file note) @@ -1751,7 +1853,7 @@ (defun reftex-next-label-number (type) - ;; Increment value of automatic labels in current buffer. Return new value. + ;; Increment value of automatic labels in current buffer. Return new value. ;; Ensure access to scanning info (reftex-access-scan-info) @@ -1783,10 +1885,10 @@ RETURN Accept current label") (defun reftex-reference (&optional type no-insert) - "Make a LaTeX reference. Look only for labels of a certain TYPE. -With prefix arg, force to rescan buffer for labels. This should only be + "Make a LaTeX reference. Look only for labels of a certain TYPE. +With prefix arg, force to rescan buffer for labels. This should only be necessary if you have recently entered labels yourself without using -reftex-label. Rescanning of the buffer can also be requested from the +reftex-label. Rescanning of the buffer can also be requested from the label selection menu. The function returns the selected label or nil. If NO-INSERT is non-nil, do not insert \\ref command, just return label. @@ -1833,7 +1935,7 @@ label)) (defun reftex-goto-label (&optional arg) - "Go to a LaTeX label. With prefix ARG: go to label in another window." + "Go to a LaTeX label. With prefix ARG, go to label in another window." (interactive "P") (let (type label file pair) (if (not type) @@ -1859,7 +1961,7 @@ (defvar reftex-label-index-list nil) (defun reftex-offer-label-menu (typekey) - ;; Offer a menu with the appropriate labels. Return (label . file). + ;; Offer a menu with the appropriate labels. Return (label . file). (let* ((buf (current-buffer)) (near-label (reftex-find-nearby-label)) (toc (reftex-typekey-check typekey reftex-label-menu-flags 0)) @@ -1899,7 +2001,7 @@ "\n[^.]" 2 reftex-reference-label-help - '(?r ?c ?t ?s ?# ?a) + '(?r ?g ?c ?t ?s ?# ?a) offset 'reftex-select-label-callback follow)) (setq key (car rtn) @@ -1907,7 +2009,8 @@ offset (1+ cnt)) (if (not key) (throw 'exit nil)) (cond - ((equal key ?r) + ((or (equal key ?r) + (equal key ?g)) ;; rescan buffer (reftex-parse-document buf)) ((equal key ?c) @@ -1981,7 +2084,7 @@ all (cdr all)) (if (null (nth 2 cell)) - ;; No context yet. Quick update + ;; No context yet. Quick update (progn (setq cell (reftex-label-info-update cell)) (setcar (nthcdr index @@ -2070,7 +2173,7 @@ (font (reftex-use-fonts)) (bound 0) (highest-level 100) - file (level 1) start star text text1 label section-number macro find) + file (level 1) star text text1 label section-number macro find) (set label-list-symbol nil) (goto-char 0) @@ -2146,7 +2249,7 @@ (buf (reftex-get-file-buffer-force file (not reftex-keep-temporary-buffers)))) (if (not buf) - (list label typekey "" file "LOST LABEL. RESCAN TO FIX.") + (list label typekey "" file "LOST LABEL. RESCAN TO FIX.") (save-excursion (set-buffer buf) (save-restriction @@ -2156,7 +2259,7 @@ (if (re-search-forward (concat "\\\\label{" (regexp-quote label) "}") nil t) (append (reftex-label-info label file) (list note)) - (list label typekey "" file "LOST LABEL. RESCAN TO FIX."))))))) + (list label typekey "" file "LOST LABEL. RESCAN TO FIX."))))))) (defun reftex-label-info (label &optional file bound) ;; Return info list on LABEL at point. @@ -2209,7 +2312,7 @@ (reftex-context-substring)) "NO MATCH FOR CONTEXT REGEXP"))) ((fboundp parse) - ;; A hook function. Call it. + ;; A hook function. Call it. (save-excursion (condition-case error-var (funcall parse env) @@ -2287,7 +2390,7 @@ (if buffer ;; good - the file is available (switch-to-buffer-other-window buffer) - ;; we have got a problem here. The file does not exist. + ;; we have got a problem here. The file does not exist. ;; Let' get out of here.. (ding) (throw 'exit nil)) @@ -2358,7 +2461,7 @@ (reftex-uniquify (symbol-value reftex-list-of-labels-symbol))))) (setq dlist (reftex-uniquify dlist)) (if (null dlist) (error "No duplicate labels in document")) - (switch-to-buffer-other-window "*Help*") + (switch-to-buffer-other-window "*Duplicate Labels*") (make-local-variable 'TeX-master) (setq TeX-master master) (erase-buffer) @@ -2376,7 +2479,7 @@ (goto-char (point-min)))) (defun reftex-all-assoc-string (key list) - ;; Return a list of all associations of KEY in LIST. Comparison with string= + ;; Return a list of all associations of KEY in LIST. Comparison with string= (let (rtn) (while list (if (string= (car (car list)) key) @@ -2446,7 +2549,7 @@ "Stores the name of the tex file that `reftex-toc' was last run on.") (defvar reftex-last-toc-file nil - "Stores the file name from which `reftex-toc' was called. For redo command.") + "Stores the file name from which `reftex-toc' was called. For redo command.") (defvar reftex-toc-return-marker (make-marker) "Marker which makes it possible to return from toc to old position.") @@ -2456,11 +2559,13 @@ To see the corresponding part of the LaTeX document, use within the *toc* buffer: -SPC Show the corresponding section of the LaTeX document -RET Goto the section and hide the *toc* buffer -q Hide the *toc* window and return to position of last reftex-toc command -Q Kill the *toc* buffer and return to position of last reftex-toc command -f Toggle follow mode on and off +SPC Show the corresponding section of the LaTeX document. +RET Goto the section and hide the *toc* buffer. +q Hide the *toc* window and return to position of last reftex-toc command. +Q Kill the *toc* buffer and return to position of last reftex-toc command. +f Toggle follow mode on and off. +r Reparse the LaTeX document. +g Revert buffer (like `r'). When called with a raw C-u prefix, rescan the document first." @@ -2504,9 +2609,12 @@ (local-set-key " " 'reftex-toc-view-line) (local-set-key "\C-m" 'reftex-toc-goto-line-and-hide) (local-set-key "r" 'reftex-toc-redo) + (local-set-key "g" 'revert-buffer) (local-set-key "q" 'reftex-toc-quit) (local-set-key "Q" 'reftex-toc-quit-and-kill) (local-set-key "f" 'reftex-toc-toggle-follow) + (make-local-variable 'revert-buffer-function) + (setq revert-buffer-function 'reftex-toc-redo) (setq truncate-lines t) (make-local-hook 'post-command-hook) (make-local-hook 'pre-command-hook) @@ -2515,7 +2623,7 @@ (insert (format "TABLE-OF-CONTENTS on %s -MENU: SPC=view RET=goto [q]uit [Q]uit+kill [r]escan [f]ollow-mode on/off +MENU: SPC=view RET=goto [q]uit [Q]uit+kill [r]escan [f]ollow-mode ------------------------------------------------------------------------------- " (abbreviate-file-name reftex-last-toc-master))) (setq startpos (point)) @@ -2609,7 +2717,7 @@ (defun reftex-toc-toggle-follow () "Toggle toc-follow mode. -(it is not really a mode, just a flag)." +(It is not really a mode, just a flag)." (interactive) (setq reftex-toc-follow-mode (not reftex-toc-follow-mode))) (defun reftex-toc-view-line () @@ -2617,7 +2725,7 @@ (interactive) (reftex-toc-visit-line)) (defun reftex-toc-goto-line-and-hide () - "Go to document location in other window. Hide the *toc* window." + "Go to document location in other window. Hide the *toc* window." (interactive) (reftex-toc-visit-line 'hide)) (defun reftex-toc-quit () @@ -2633,7 +2741,7 @@ (delete-window) (switch-to-buffer (marker-buffer reftex-toc-return-marker)) (goto-char (marker-position reftex-toc-return-marker))) -(defun reftex-toc-redo () +(defun reftex-toc-redo (&rest ignore) "Regenerate the *toc* buffer. Call only from within the *toc* buffer" (interactive) (switch-to-buffer (reftex-get-file-buffer-force reftex-last-toc-file)) @@ -2692,6 +2800,9 @@ ;; Variables and constants +;; Define variable to silence compiler warnings +(defvar reftex-found-list) + ;; Internal variable, but used from different functions (defvar reftex-cite-format1 nil) @@ -2702,25 +2813,25 @@ (defconst reftex-citation-help "AVAILABLE KEYS IN MAKE CITATION MENU --------------------------------------- - n / p Go to next/previous entry (Cursor motion works as well) - r restrict selection with another regexp - SPACE Show full database entry in other window - f Toggle follow mode: Other window will follow with full db entry - q Quit without inserting \\cite macro into buffer - ? Display this help message - C-r Recursive edit into other window + n / p Go to next/previous entry (Cursor motion works as well). + r Restrict selection with another regexp. + SPACE Show full database entry in other window. + f Toggle follow mode: Other window will follow with full db entry. + q Quit without inserting \\cite macro into buffer. + ? Display this help message. + C-r Recursive edit into other window. RETURN ... Accept current entry and insert in format according to - reftex-cite-format") + `reftex-cite-format'") (defconst reftex-cite-format-default "\\cite{KEY}" "The default value for reftex-cite-format. -Uses the string version of scitex-cite-format.") +Uses the string version of `reftex-cite-format'.") (defconst reftex-cite-format-1-author-simple '( "\\cite{KEY}" "AUTHOR \\cite{KEY}" "AUTHOR {\it et al.} \\cite{KEY}") "Value for reftex-cite format establishing a simple citation with name of the first author. -Uses the list version of reftex-cite-format.") +Uses the list version of `reftex-cite-format'.") (defconst reftex-cite-format-2-authors '((?\C-m @@ -2741,11 +2852,11 @@ (?\[ . ("[\\cite{KEY}]" "AUTHOR [\\cite{KEY}]" "AUTHOR \\& AUTHOR [\\cite{KEY}]" "AUTHOR \\etal{} [\\cite{KEY}]"))) - "Value for reftex-cite-format that estabishes an Author/Year citation -where the year is supplied from BibTeX. Depending on which character + "Value for `reftex-cite-format' that estabishes an Author/Year citation +where the year is supplied from BibTeX. Depending on which character is used during selection to accept the label, an extra ,;: or pair of parenthesis will be inserted. -Uses the list-of-cons-cells version of reftex-cite-format.") +Uses the list-of-cons-cells version of `reftex-cite-format'.") ;; Find bibtex files @@ -2790,7 +2901,7 @@ nil)))) (defun reftex-find-files-on-path (file-list path-list &optional error-string) - ;; Search for all files in FILE-LIST on the PATH-LIST. Return absolute names. + ;; Search for all files in FILE-LIST on the PATH-LIST. Return absolute names. ;; A missing file throws an exception with the error message ERROR-STRING. (let (found-list found file) (while file-list @@ -2819,7 +2930,7 @@ ;; Find BibTeX KEY in any file in FILE-LIST in another window. ;; If mark-to-kill is non-nil, mark new buffer to kill." - (let* ((re (concat "@[a-zA-Z]+[ \t\n\r]*{[ \t\n\r]*" (regexp-quote key) "[ \t\n\r,]")) + (let* ((re (concat "@[a-zA-Z]+[ \t\n\r]*[{(][ \t\n\r]*" (regexp-quote key) "[ \t\n\r,]")) (window-conf (current-window-configuration)) file buf) (catch 'exit @@ -2888,7 +2999,7 @@ (catch 'search-again (setq key-point (point)) (if (not (re-search-backward - "^[ \t]*@\\([a-zA-Z]+\\)[ \t\n\r]*{" nil t)) + "^[ \t]*@\\([a-zA-Z]+\\)[ \t\n\r]*[{(]" nil t)) (throw 'search-again nil)) (setq start-point (point)) (goto-char (match-end 0)) @@ -2978,7 +3089,7 @@ (save-restriction (widen) (if (re-search-forward - (concat "@\\w+{[ \t\n\r]*" (regexp-quote crkey) "[ \t\n\r]*,") nil t) + (concat "@\\w+[{(][ \t\n\r]*" (regexp-quote crkey) "[ \t\n\r]*,") nil t) (progn (setq start (match-beginning 0)) (condition-case nil @@ -3020,7 +3131,7 @@ (goto-char (point-min)) (if (re-search-forward - "@\\(\\w+\\)[ \t\n\r]*{[ \t\n\r]*\\([^ \t\n\r,]+\\)" nil t) + "@\\(\\w+\\)[ \t\n\r]*[{(][ \t\n\r]*\\([^ \t\n\r,]+\\)" nil t) (setq alist (list (cons "&type" (downcase (reftex-no-props (match-string 1)))) @@ -3117,16 +3228,16 @@ ;; Make a citation (defun reftex-citation (&optional arg no-insert) - "Make a citation unsing BibTeX database files. + "Make a citation using BibTeX database files. After asking for a Regular Expression, it scans the buffers with bibtex entries (taken from the \\bibliography command) and offers the -matching entries for selection. The selected entry is formated according -to reftex-cite-format and inserted into the buffer. +matching entries for selection. The selected entry is formated 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. +The regular expression uses an expanded syntax: && is interpreted as `and'. +Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'. When this function is called with point inside the braces of a \\cite -command, it will add another key, ignoring the value of reftex-cite-format. +command, it will add another key, ignoring the value of `reftex-cite-format'. When called with a numeric prefix, that many citations will be made and all put into the same \\cite command. When called with just C-u as prefix, enforces rescan of buffer for @@ -3177,15 +3288,15 @@ (let* (key entry cnt rtn ins-string re-list re ;; scan bibtex files (lazy-lock-minimum-size 1) - (found-list (reftex-extract-bib-entries - (reftex-get-bibfile-list))) + (reftex-found-list (reftex-extract-bib-entries + (reftex-get-bibfile-list))) (found-list-r nil) (accept-keys (if (and (listp reftex-cite-format1) (listp (car reftex-cite-format1))) (mapcar 'car reftex-cite-format1) '(?\C-m)))) - (if (not found-list) + (if (not reftex-found-list) (error "Sorry, no matches found")) ;; remember where we came from @@ -3196,7 +3307,7 @@ (switch-to-buffer-other-window "*RefTeX Select*") (erase-buffer) (mapcar '(lambda (x) (insert (cdr (assoc "&formatted" x)))) - found-list) + reftex-found-list) (if (= 0 (buffer-size)) (error "Sorry, no matches found")) (setq truncate-lines t) @@ -3240,18 +3351,18 @@ (cdr (assoc "&entry" x))) x "")) - found-list)))) + reftex-found-list)))) (if found-list-r - (setq found-list found-list-r) + (setq reftex-found-list found-list-r) (ding)) (erase-buffer) (mapcar '(lambda (x) (insert (cdr (assoc "&formatted" x)))) - found-list) + reftex-found-list) (goto-char 1)) ((or (member key accept-keys) (equal key ?\C-m) (equal key 'return)) - (setq entry (nth cnt found-list)) + (setq entry (nth cnt reftex-found-list)) (throw 'exit t)) (t (ding))))) @@ -3324,12 +3435,10 @@ ;; this is slow and not recommended for follow mode (defun reftex-bibtex-selection-callback (cnt) ;; Callback function to be called from the BibTeX selection, in - ;; order to display context. This function is relatively slow and not + ;; order to display context. This function is relatively slow and not ;; recommended for follow mode, just for individual lookups. - ;; When compiled, this gives a warning about found-list. However, - ;; the calling function binds found-list with let. (let ((win (selected-window)) - (key (reftex-get-bib-field "&key" (nth cnt found-list))) + (key (reftex-get-bib-field "&key" (nth cnt reftex-found-list))) (bibfile-list (save-excursion (set-buffer reftex-call-back-to-this-buffer) (reftex-get-bibfile-list)))) @@ -3345,7 +3454,7 @@ (defvar reftex-recursive-edit-marker (make-marker)) (defun reftex-check-recursive-edit () - ;; Check if we are already in a recursive edit. Abort with helpful + ;; Check if we are already in a recursive edit. Abort with helpful ;; message if so. (if (marker-position reftex-recursive-edit-marker) (error @@ -3355,11 +3464,11 @@ (defun reftex-select-item (buffer prompt next-re end-re size help-string event-list &optional offset call-back cb-flag) -;; Select an item from the buffer BUFFER. Show PROMPT to user, find +;; Select an item from the buffer BUFFER. Show PROMPT to user, find ;; next item with NEXT-RE regular expression, return on any of the -;; events listed in EVENT-LIST. The function returns the event along -;; with an integer indicating which item was selected. When OFFSET is -;; specified, starts at that item in the list. When CALL-BACK is +;; events listed in EVENT-LIST. The function returns the event along +;; with an integer indicating which item was selected. When OFFSET is +;; specified, starts at that item in the list. When CALL-BACK is ;; given, it is a function which is called with the match of the ;; NEXT-RE match and the index of the element. (let* (key key-sq b e ev cnt cmd @@ -3478,7 +3587,7 @@ (other-window 1) (message (substitute-command-keys - "Recursive edit. Return to selection with \\[exit-recursive-edit]")) + "Recursive edit. Return to selection with \\[exit-recursive-edit]")) (recursive-edit))) (if (not (equal (marker-buffer reftex-recursive-edit-marker) @@ -3514,7 +3623,7 @@ (let* ((pos (point)) (re "\\\\[a-z]*\\(cite\\|ref\\)\\(\\[[^{}]*\\]\\)?{\\([^}]+\\)}") (my-window (get-buffer-window (current-buffer))) - pop-window cmd args macro label entry key-start point) + pop-window cmd args macro label key-start point) (if (save-excursion (forward-char 1) @@ -3580,20 +3689,20 @@ (defun reftex-what-macro (which &optional bound) ;; Find out if point is within the arguments of any TeX-macro. - ;; The return value is either (\"\\\\macro\" . (point)) or a list of them. + ;; The return value is either ("\\macro" . (point)) or a list of them. ;; If WHICH is nil, immediately return nil. ;; If WHICH is t, return list of all macros enclosing point. ;; If WHICH is a list of macros, look only for those macros and return the ;; name of the first macro in this list found to enclose point. ;; If the optional BOUND is an integer, bound backwards directed - ;; searches to this point. If it is nil, limit to nearest \\section - + ;; searches to this point. If it is nil, limit to nearest \section - ;; like statement. ;; This function is pretty stable, but can be fooled if the text contains - ;; things like \\macro{aa}{bb} where \\macro is defined to take only one - ;; argument. As RefTeX cannot know this, the string \"bb\" would still be - ;; considered an argument of macro \\macro. + ;; things like \macro{aa}{bb} where \macro is defined to take only one + ;; argument. As RefTeX cannot know this, the string "bb" would still be + ;; considered an argument of macro \macro. (catch 'exit (if (null which) (throw 'exit nil)) @@ -3629,7 +3738,7 @@ (defun reftex-what-environment (which &optional bound) ;; Find out if point is inside a LaTeX environment. - ;; The return value is (e.g.) either (\"equation\" . (point)) or a list of + ;; The return value is (e.g.) either ("equation" . (point)) or a list of ;; them. ;; If WHICH is nil, immediately return nil. @@ -3639,7 +3748,7 @@ ;; point. ;; If the optional BOUND is an integer, bound backwards directed searches to - ;; this point. If it is nil, limit to nearest \\section - like statement. + ;; this point. If it is nil, limit to nearest \section - like statement. (catch 'exit (save-excursion @@ -3664,7 +3773,7 @@ (nreverse env-list))))) (defun reftex-word-before-point () - ;; Return the word before point. Word means here: + ;; Return the word before point. Word means here: ;; Consists of [a-zA-Z0-9.:] and ends at point or whitespace. (let ((pos (point))) (save-excursion @@ -3719,7 +3828,7 @@ (t (error "Please report this problem to dominik@strw.leidenuniv.nl")))) (defun reftex-get-file-buffer-force (file &optional mark-to-kill) - ;; Return a buffer visiting file. Make one, if necessary. + ;; Return a buffer visiting file. Make one, if necessary. ;; If neither such a buffer no the file exist, return nil. ;; If MARK-TO-KILL in non-nil, put any new buffers into the kill list." @@ -3752,8 +3861,8 @@ (nreverse rtn))) (defun reftex-uniquify (alist &optional keep-list) - ;; Return a list of all elements in ALIST, but each car only once - ;; Elements of KEEP-LIST are not removed even if duplicate + ;; Return a list of all elements in ALIST, but each car only once. + ;; Elements of KEEP-LIST are not removed even if duplicate. (let (new elm) (while alist (setq elm (car alist) @@ -3765,12 +3874,12 @@ new)) (defun reftex-use-fonts () - ;; Return t if we can and want to use fonts + ;; Return t if we can and want to use fonts. (and window-system reftex-use-fonts (boundp 'font-lock-keyword-face))) -;; Highlighting uses overlays. If this is for XEmacs, we need to load +;; Highlighting uses overlays. If this is for XEmacs, we need to load ;; the overlay library, available in version 19.15 (and (not (fboundp 'make-overlay)) (condition-case nil @@ -3797,7 +3906,7 @@ (delete-overlay (aref reftex-highlight-overlays index))) (defun reftex-highlight-shall-die () - ;; Function used in pre-command-hook to remove highlights + ;; Function used in pre-command-hook to remove highlights. (remove-hook 'pre-command-hook 'reftex-highlight-shall-die) (reftex-unhighlight 0)) @@ -3876,6 +3985,12 @@ ("sidewaysfigure" ?f nil nil "\\\\caption\\(\\[[^]]*\\]\\)?{") ("sidewaystable" ?t nil nil "\\\\caption\\(\\[[^]]*\\]\\)?{")) + (Subfigure + "Subfigure environments and macro" + ("subfigure" ?f nil nil "\\\\caption\\(\\[[^]]*\\]\\)?{") + ("subfigure*" ?f nil nil "\\\\caption\\(\\[[^]]*\\]\\)?{") + ("\\subfigure" ?f nil nil "\\\\subfigure[[{]")) + (AMSTeX "AMS-LaTeX: amsmath package environents" ("align" ?e "eq:" "~\\eqref{%s}" "\\\\begin{align}\\|\\\\\\\\") @@ -3894,15 +4009,27 @@ ;;; Functions to compile the tables, reset the mode etc. (defun reftex-reset-mode () - "Reset RefTeX Mode. Required to implement changes to some list variables. -This function will compile the information in reftex-label-alist and similar -variables. It is called when RefTeX is first used, and after changes to -these variables via reftex-add-to-label-alist." + "Reset RefTeX Mode. Required to implement changes to some list variables. +This function will compile the information in `reftex-label-alist' and similar +variables. It is called when RefTeX is first used, and after changes to +these variables via `reftex-add-to-label-alist'." (interactive) - ; record that we have done this + ;; Record that we have done this (setq reftex-tables-dirty nil) + ;; Kill temporary buffers associated with RefTeX - just in case they + ;; were not cleaned up properly + (let ((buffer-list '("*reftex-master.tex*" "*RefTeX Help*" "*RefTeX Select*" + "*Duplicate Labels*" "*toc*" "*RefTeX-scratch*"))) + (while buffer-list + (if (get-buffer (car buffer-list)) + (kill-buffer (car buffer-list))) + (setq buffer-list (cdr buffer-list)))) + + ;; Plug functions into AUCTeX if the user option says so + (reftex-plug-into-AUCTeX) + ;; To update buffer-local variables (hack-local-variables) (message "updating internal tables...") @@ -4084,6 +4211,7 @@ ; Make sure tabels are compiled (message "updating internal tables...") (reftex-compute-ref-cite-tables) +(message "updating internal tables...done") (setq reftex-tables-dirty nil) (provide 'reftex)
--- a/lisp/modes/rsz-minibuf.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/modes/rsz-minibuf.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,61 +1,68 @@ ;;; rsz-minibuf.el --- dynamically resize minibuffer to display entire contents -;;; Copyright (C) 1990 Roland McGrath -;;; Copyright (C) 1993, 1994 Noah S. Friedman +;; Copyright (C) 1990 Roland McGrath +;; Copyright (C) 1993, 1994 Noah S. Friedman -;;; Author: Noah Friedman <friedman@prep.ai.mit.edu> -;;; Roland McGrath <roland@prep.ai.mit.edu> -;;; Modified for Lucid Emacs By: Peter Stout <pds@cs.cmu.edu> -;;; Maintainer: friedman@prep.ai.mit.edu -;;; Keywords: minibuffer, window, frames, display -;;; Status: Known to work in FSF GNU Emacs 19.23 and Lucid Emacs 19.9. +;; Author: Noah Friedman <friedman@prep.ai.mit.edu> +;; Author: Roland McGrath <roland@prep.ai.mit.edu> +;; Modified for Lucid Emacs By: Peter Stout <pds@cs.cmu.edu> +;; Maintainer: friedman@prep.ai.mit.edu +;; Keywords: minibuffer, window, frames, display +;; Status: Known to work in FSF GNU Emacs 19.23 and Lucid Emacs 19.9. -;;; $Id: rsz-minibuf.el,v 1.4 1997/04/19 23:21:04 steve Exp $ +;; This file is part of XEmacs. -;;; 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, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, you can either send email to this -;;; program's maintainer or write to: The Free Software Foundation, -;;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA. +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, you can either +;; send email to this program's maintainer or write to: The Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not synched. ;;; Commentary: -;;; This package allows the entire contents (or as much as possible) of the -;;; minibuffer to be visible at once when typing. As the end of a line is -;;; reached, the minibuffer will resize itself. When the user is done -;;; typing, the minibuffer will return to its original size. +;; This file has received maintenance by the XEmacs development team. + +;; $Id: rsz-minibuf.el,v 1.5 1997/06/26 02:31:05 steve Exp $ -;;; In window systems where it is possible to have a frame in which the -;;; minibuffer is the only window, the frame itself can be resized. In FSF -;;; GNU Emacs 19.22 and earlier, the frame may not be properly returned to -;;; its original size after it ceases to be active because -;;; `minibuffer-exit-hook' didn't exist until version 19.23. +;; This package allows the entire contents (or as much as possible) of the +;; minibuffer to be visible at once when typing. As the end of a line is +;; reached, the minibuffer will resize itself. When the user is done +;; typing, the minibuffer will return to its original size. -;;; NOTE: The code to resize frames has not been tested under Lucid Emacs, -;;; because detached minibuffers are broken. +;; In window systems where it is possible to have a frame in which the +;; minibuffer is the only window, the frame itself can be resized. In FSF +;; GNU Emacs 19.22 and earlier, the frame may not be properly returned to +;; its original size after it ceases to be active because +;; `minibuffer-exit-hook' didn't exist until version 19.23. -;;; Note that the minibuffer and echo area are not the same! They simply -;;; happen to occupy roughly the same place on the frame. Messages put in -;;; the echo area will not cause any resizing by this package. +;; NOTE: The code to resize frames has not been tested under Lucid Emacs, +;; because detached minibuffers are broken. + +;; Note that the minibuffer and echo area are not the same! They simply +;; happen to occupy roughly the same place on the frame. Messages put in +;; the echo area will not cause any resizing by this package. -;;; This package is considered a minor mode but it doesn't put anything in -;;; minor-mode-alist because this mode is specific to the minibuffer, which -;;; has no modeline. +;; This package is considered a minor mode but it doesn't put anything in +;; minor-mode-alist because this mode is specific to the minibuffer, which +;; has no modeline. -;;; To use this package, put the following in your .emacs: -;;; -;;; (autoload 'resize-minibuffer-mode "rsz-minibuf" nil t) -;;; -;;; Invoking the command `resize-minibuffer-mode' will then enable this mode. +;; To use this package, put the following in your .emacs: +;; +;; (autoload 'resize-minibuffer-mode "rsz-minibuf" nil t) +;; +;; Invoking the command `resize-minibuffer-mode' will then enable this mode. ;;; Code: @@ -264,4 +271,4 @@ (add-hook 'minibuffer-setup-hook 'resize-minibuffer-setup) -;; rsz-minibuf.el ends here +;;; rsz-minibuf.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/modes/view-process-mode.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,3523 @@ +;;; view-process-mode.el --- Display current running processes + +;; Copyright (C) 1994, 1995, 1996 Heiko Muenkel + +;; Author: Heiko Muenkel <muenkel@tnt.uni-hannover.de> +;; Keywords: processes + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; See the file COPYING. if not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Emacs 20.1 + +;;; Commentary: + +;; DollarId: view-process-mode.el,v 1.113 1996/08/17 15:12:01 muenkel Exp $ +;; This file defines the the view-process-mode, a mode for displaying +;; the current processes with ps on UNIX systems. There are also +;; commands to sort and filter the output and to send signals to the +;; processes. + +;; You can display the processes with the command `view-processes'. +;; If you are familar with the UNIX ps command and its switches, +;; then you can also use the command `View-process-status' or +;; it's short cut `ps', which are asking for the command +;; switches. You can also run the commands on a remote system +;; via rsh. For that you must give a prefix arg to the +;; commands. This leads to a question for the remote host name. + +;; You need also the files: adapt.el +;; view-process-system-specific.el +;; view-process-xemacs.el +;; view-process-emacs-19.el +;; +;; Installation: +;; +;; Put this file and the file adapt.el +;; in one of your your load-path directories and +;; the following line in your ~/.emacs (without leading ;;;): +;; (autoload 'ps "view-process-mode" +;; "Prints a list with processes in the buffer `View-process-buffer-name'. +;; COMMAND-SWITCHES is a string with the command switches (ie: -aux). +;; IF the optional argument REMOTE-HOST is given, then the command will +;; be executed on the REMOTE-HOST. If an prefix arg is given, then the +;; function asks for the name of the remote host." +;; t) +;; +;; In the FSF Emacs 19 you should (but must not) put the following +;; line in your ~/.emacs: +;;; (transient-mark-mode nil) + +;;; Code: + +(provide 'view-process-mode) +(require 'view-process-system-specific) + +(defconst View-process-package-version "2.4") + +(defconst View-process-package-name "hm--view-process") + +(defconst View-process-package-maintainer "muenkel@tnt.uni-hannover.de") + +(defun View-process-xemacs-p () + "Returns non nil if the editor is the XEmacs or lemacs." + (or (string-match "Lucid" emacs-version) + (string-match "XEmacs" emacs-version))) + +(defun View-process-lemacs-p () + "Returns non nil if the editor is the lemacs." + (string-match "Lucid" emacs-version)) + +(if (not (View-process-xemacs-p)) + (require 'view-process-adapt) + ) + +(defvar View-process-status-command "ps" + "*Command which reports process status (ps). +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-status-command) + +(defvar View-process-status-command-switches-bsd "-auxw" + "*Switches for the command `view-processes' on BSD systems. +Switches which suppresses the header line are not allowed here.") + +(defvar View-process-status-command-switches-system-v "-edaf" + "*Switches for the command `view-processes' on System V systems. +Switches which suppresses the header line are not allowed here.") + +(defvar View-process-status-last-command-switches nil + "Switches of the last `View-process-status-command'. +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-status-last-command-switches) + +(defvar View-process-signal-command "kill" + "*Command which sends a signal to a process (kill). +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-signal-command) + +(defvar View-process-renice-command "renice" + "*Command which alter priority of running processes.") + +(make-variable-buffer-local 'View-process-renice-command) + +(defvar View-process-default-nice-value "4" + "*Default nice value for altering the priority of running processes.") + +(defvar View-process-rsh-command "rsh" + "*Remote shell command (rsh). +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-rsh-command) + +(defvar View-process-uname-command "uname" + "*The uname command (It returns the system name). +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-uname-command) + +(defvar View-process-uname-switches "-sr" + "*Switches for uname, so that it returns the sysname and the release.") + +(defvar View-process-test-command "test" + "*The test command.") + +(make-variable-buffer-local 'View-process-test-command) + +(defvar View-process-test-switches "-x" + "*Switches for test, to test if an executable exists.") + +(defvar View-process-uptime-command "uptime" + "*The uptime command. +No idea at the moment, if this exists on all systems. +It should return some informations over the system.") + +(make-variable-buffer-local 'View-process-uptime-command) + +(defvar View-process-buffer-name "*ps*" + "Name of the output buffer for the 'View-process-mode'. +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-buffer-name) + +(defvar View-process-mode-hook nil + "*This hook is run after reading in the processes.") + +(defvar View-process-motion-help t + "*If non nil, then help messages are displayed during mouse motion. +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-motion-help) + +(defvar View-process-display-with-2-windows t + "*Determines the display type of the `View-process-mode'. +If it is non nil, then 2 windows are used instead of one window. +In the second window are the header lines displayed.") + +(defvar View-process-hide-header t + "*The header lines in the view processes buffer are hide, if this is t.") + +(make-variable-buffer-local 'View-process-hide-header) + +(defvar View-process-truncate-lines t + "*Truncates the liens in the view process buffer if t.") + +(make-variable-buffer-local 'View-process-truncate-lines) + +(defvar View-process-display-short-key-descriptions t + "*Controls, whether short key descriptions are displayed or not.") + +(defvar View-process-display-uptime t + "*Controls, whether the uptime is displayed or not.") + +(defvar View-process-use-font-lock t + "*Determines, if the `font-lock-mode' should be used or not.") + +(defvar View-process-ps-header-window-offset 2 + "Offset for the size of the ps header window.") + +(defvar View-process-ps-header-window-size 0 + "Internal variable. The size of the window with the *ps header* buffer.") + +(make-variable-buffer-local 'View-process-ps-header-window-size) + +(defvar View-process-stop-motion-help nil + "Internal variable. Stops motion help temporarily.") + +(defvar View-process-deleted-lines nil + "Internal variable. A list with lines, which are deleted by a filter.") + +(make-variable-buffer-local 'View-process-deleted-lines) + +(defvar View-process-header-buffer-name "*ps header*" + "Name of the view process header buffer.") + +(make-variable-buffer-local 'View-process-header-buffer-name) + +(defvar View-process-header-mode-name "psheader" + "Name of the `view process header mode'.") + +(defvar View-process-header-mode-hook nil + "*This hook is run after building the header buffer.") + +(defvar View-process-header-mode-line-off t + "t means do not display modeline in view-process-header-mode. +This does only work in the XEmacs 19.12 or higher.") + +(defvar View-process-header-line-detection-list '("PID" "COMMAND" "COMD" "CMD") + "*The header line is detected with the help of this list. +At least one of these words must be in a header line. Otherwise +an error is signaled. YOu must only change this list, if your ps +prodices header lines with strings, that are not in this list.") + +(defvar View-process-header-line-background "yellow" + "*Background color of the header line.") + +(defvar View-process-header-line-foreground "blue" + "*Foreground color of the header line.") + +(defvar View-process-header-line-font (face-font 'bold) + "*Font of the header line") + +(defvar View-process-header-line-underline-p t + "*T, if the header line should be underlined.") + +(defvar View-process-no-mark ?_ + "*A character with specifies, that a line isn't marked.") + +(defvar View-process-signaled-line-background nil + "*Background color of the line with a signaled or reniced process.") + +(defvar View-process-signaled-line-foreground "grey80" + "*Foreground color of the line with a signaled or reniced process.") + +(defvar View-process-signaled-line-font (face-font 'italic) + "*Font of the line with a signaled or reniced process.") + +(defvar View-process-signaled-line-underline-p nil + "*T, if the \"signaled line\" should be underlined.") + +(defvar View-process-signaled-line-mark ?s + "*A character, which is used as a mark for \"signaled lines\".") + +(defvar View-process-signal-line-background nil + "*Background color of the line with the process which should be signaled.") + +(defvar View-process-signal-line-foreground "red" + "*Foreground color of the line with the process which should be signaled.") + +(defvar View-process-signal-line-font (face-font 'bold) + "*Font of the line with the process which should be signaled.") + +(defvar View-process-signal-line-underline-p nil + "*T, if the \"signal line\" should be underlined.") + +(defvar View-process-signal-line-mark ?K + "*A character, which is used as a mark for \"signal lines\".") + +(defvar View-process-renice-line-background nil + "*Background color of the line with the process which should be reniced.") + +(defvar View-process-renice-line-foreground "red" + "*Foreground color of the line with the process which should be reniced.") + +(defvar View-process-renice-line-font (face-font 'bold) + "*Font of the line with the process which should be reniced.") + +(defvar View-process-renice-line-underline-p nil + "*T, if the \"renice line\" should be underlined.") + +(defvar View-process-renice-line-mark ?N + "*A character, which is used as a mark for \"renice lines\".") + +(defvar View-process-child-line-background nil + "*Background color of a line with a child process.") + +(defvar View-process-child-line-foreground "darkviolet" + "*Foreground color of a line with a child process.") + +(defvar View-process-child-line-font (face-font 'italic) + "*Font color of a line with a child process.") + +(defvar View-process-child-line-underline-p nil + "*T, if the \"line with a child process\" should be underlined.") + +(defvar View-process-child-line-mark ?C + "*A character, which is used as a mark for child processes.") + +(defvar View-process-parent-line-background "LightBlue" + "*Background color of a line with a parent process.") + +(defvar View-process-parent-line-foreground "darkviolet" + "*Foreground color of a line with a parent process.") + +(defvar View-process-parent-line-font (face-font 'bold) + "*Font color of a line with a parent process.") + +(defvar View-process-parent-line-underline-p t + "*T, if the \"line with a parent\" should be underlined.") + +(defvar View-process-parent-line-mark ?P + "*A character, which is used as a mark for parent processes.") + +(defvar View-process-single-line-background nil + "*Background color of a line with a single line mark.") + +(defvar View-process-single-line-foreground "darkblue" + "*Foreground color of a line with a single line mark.") + +(defvar View-process-single-line-font (face-font 'bold) + "*Font color of a line with a single line mark.") + +(defvar View-process-single-line-underline-p t + "*T, if the \"line with a single line mark\" should be underlined.") + +(defvar View-process-single-line-mark ?* + "*A character, which is used as a single line mark.") + +(defvar View-process-font-lock-keywords + (list + (cons (concat "^" + (char-to-string View-process-child-line-mark) + " .*") + 'View-process-child-line-face) + (cons (concat "^" + (char-to-string View-process-parent-line-mark) + " .*") + 'View-process-parent-line-face) + (cons (concat "^\\" + (char-to-string View-process-single-line-mark) + " .*") + 'View-process-single-line-face) + (cons (concat "^" + (char-to-string View-process-signaled-line-mark) + " .*") + 'View-process-signaled-line-face) + (cons (concat "^" + (char-to-string View-process-signal-line-mark) + " .*") + 'View-process-signal-line-face) + (cons (concat "^" + (char-to-string View-process-renice-line-mark) + " .*") + 'View-process-renice-line-face) + ) + "The font lock keywords for the `View-process-mode'." + ) + +(defvar View-process-pid-mark-alist nil + "Internal variable. An alist with marks and pids.") + +(make-variable-buffer-local 'View-process-pid-mark-alist) + +(defvar View-process-last-pid-mark-alist nil + "Internal variable. An alist withthe last marks and pids.") + +(make-variable-buffer-local 'View-process-last-pid-mark-alist) + +(defvar View-process-sorter-and-filter nil + "*A list, which specifies sorter and filter commands. +These commands will be run over the ps output, every time after +ps has create a new output. +The list consists of sublists, whereby every sublist specifies a +command. The first element of each list is a keyword, which +determines a command. +The following keywords are allowed: + sort - Sort the output by an output field + filter - Filter the output by an output field, delete non matching l. + exclude-filter - Filter the output by an output field, delete matching lines + grep - Filter the output by the whole line, delete non matching l. + exclude-grep - Filter the output by the whole line, delete matching lines + reverse - Reverse the order of the output lines. + +The cdr of each sublist depends on the keyword. The following shows +the syntax of the different sublist types: + (sort <fieldname>) + (filter <fieldname> <regexp>) + (exclude-filter <fieldname> <regexp>) + (grep <regexp>) + (exclude-grep <regexp>) + (reverse) + +Where <fieldname> is a string with determines the name of an output field +and <regexp> is a string with an regular expression. The output field names +are derived from the header line of the ps output.") + +(defvar View-process-actual-sorter-and-filter nil + "Internal variable. It holds the actual sorter and filter commands. +Don't change it!") + +(make-variable-buffer-local 'View-process-actual-sorter-and-filter) + +(defvar View-process-itimer-value 5 + "*Value of the view process itimer.") + +(defvar View-process-system-type nil + "Internal variable. Type of the system, on which the ps command is called. +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-system-type) + +(defvar View-process-remote-host nil + "Internal variable. Name of the remote host or nil. +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-remote-host) + +(defvar View-process-header-start nil + "Internal variable. Start of the ps output header line. +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-header-start) + +(defvar View-process-header-end nil + "Internal variable. End of the ps output header line. +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-header-end) + +(defvar View-process-output-start nil + "Internal variable. Start of the ps output (after the header). +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-output-start) + +(defvar View-process-output-end nil + "Internal variable. End of the ps output (after the header). +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-output-end) + +(defvar View-process-old-window-configuration nil + "Internal variable. Window configuration before the first ps command.") + +(make-variable-buffer-local 'View-process-old-window-configuration) + +(defvar View-process-max-fields nil + "Internal variable. Number of output fields. +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-max-fields) + +(defvar View-process-field-names nil + "Internal variable. An alist with the fieldnames and fieldnumbers. +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-max-fields) + +(defvar View-process-field-blanks-already-replaced nil + "Internal variable. It is t, if blanks in fields are already replaced.") + +(make-variable-buffer-local 'View-process-field-blanks-already-replaced) + +(defvar View-process-kill-signals nil + "An alist with the possible signals for the kill command. +Don't change it by hand! +The variable is initialised each time after running ps. +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-kill-signals) + +(defvar View-process-kill-signals-general + '(("SIGHUP" "1") ("SIGKILL" "9") ("SIGTERM" "15") + ("1" "1") ("2" "2") ("3" "3") ("4" "4") ("5" "5") ("6" "6") ("7" "7") + ("8" "8") ("9" "9") ("10" "10") ("11" "11") ("12" "12") ("13" "13") + ("14" "14") ("15" "15") ("16" "16") ("17" "17") ("18" "18") + ("19" "19") ("20" "20") ("21" "21") ("22" "22") ("23" "23") + ("24" "24") ("25" "25") ("26" "26") ("27" "27") ("28" "28") + ("29" "29") ("30" "30") ("31" "31")) + "An alist with the possible signals for the kill command. +This list is used, if no system specific list is defined. +It may be that you've other signals on your system. Try to test +it with \"kill -l\" in a shell.") + +(defvar View-process-default-kill-signal "SIGTERM" + "*Default signal for the function `View-process-send-signal-to-process'. +The string must be also in the alist `View-process-kill-signals'!") + +(defvar View-process-pid-field-name "PID" + "*The name of the field with the PID's. +The name must be the same as in the first outputline of the +command `View-process-status-command' (ps). +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-pid-field-name) + +(defvar View-process-ppid-field-name "PPID" + "*The name of the field with the PPID's. +The name must be the same as in the first outputline of the +command `View-process-status-command' (ps). +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-ppid-field-name) + +(defvar View-process-host-names-and-system-types nil + "A list with the names and the system types of hosts. +Each entry of the list looks like the following: + (<hostname> (<system-type> <version-number> <bsd-or-system-v> + <field-name-descriptions> + <kill-signals>)) +Here are some examples: + (\"daedalus\" (\"sunos\" \"4\" \"bsd\" + View-process-field-name-descriptions-sunos4 + View-process-kill-signals-sunos4)) + (\"bach\" (\"linux\" nil \"bsd\" + nil + View-process-kill-signals-linux + )) + (\"cesar\" (nil nil \"bsd\")) +The list will be anhanced by the program, each time you run ps on +a new system. But you can also set this variable by hand in your +.emacs. If the host name is found in this list, then the system +type will not be checked again." + ) + +(defvar View-process-status-history nil + "A list with the command switch history of the status command (ps).") + +(defvar View-process-remote-host-history nil + "A list with the remote host history.") + +(defvar View-process-field-name-history nil + "A list with the field name history.") + +(defvar View-process-filter-history nil + "A list with the filter history.") + +(defvar View-process-signal-history nil + "A list with the signal history.") + +(defvar View-process-field-name-descriptions nil + "Help list with the descriptions of ps fields. +Don't change it by hand! +The variable is initialised each time after running ps. +The variable is buffer local.") + +(make-variable-buffer-local 'View-process-field-name-descriptions) + +(defvar View-process-field-name-descriptions-general + '( + ("m" "Mark column of the View Processes Mode.") ; not a real field name + ("ADDR" "The memory address of the process. ") + ("%CPU" "CPU usage in percentage.") + ("%MEM" "Real Memory usage in percentage.") + ("COMMAND" "Command Name.") + ("F" ("Status= " + ("0" "0=not in main memory.") + ("1" "1=in main memory.") + ("2" "2=system process.") + ("4" "4=blocked in the main memory.") + ("10" "10=swapped out.") + ("20" "20=controlled by another one."))) + ("NI" "UNIX nice value, a positive value means less CPU time.") + ("PAGEIN" "Number of major page faults.") + ("PGID" "Process group id. ") + ("PID" "The process id.") + ("PPID" "The process id of the parent process.") + ("PRI" "Priority, a big value is a small priority.") + ("RSS" "Real (resident set) size, KBytes of program in memory.") + ("SHARE" "Shared memory") + ("SID" "ID of the session to which the process belongs. ") + ("SIZE" "Virtual image size, size of text+data+stack (in KByte ?).") + ("START" "Start time.") + ("STAT" ("Status. " + ("R" "R=runnable. ") + ("S" "S=sleeping. ") + ("D" "D=un-interruptible sleep (eg disk or NFS I/O). ") + ("T" "T=stopped or traced. ") + ("Z" "Z=zombie (terminated). ") + ("W" "W=waiting on an event. ") + ("I" "I=intermediate status. ") + ("N" "N=started with nice. ") + )) + ("SWAP" "Kilobytes (with -p pages) on swap device.") + ("TIME" "Elapsed process time.") + ("TPGID" "Process group id of the associated terminal. ") + ("TRS" "Text resident size.") + ("TT" ("Dialog station. " ("?" "?=No dialog station"))) + ("TTY" ("Dialog station. " ("?" "?=No dialog station"))) + ("UID" "User Id.") + ("USER" "Owner of the process.") + ("WCHAN" "Name of the kernel function where the process is sleeping.") + ) + "Help list with the descriptions of ps fields. +This is a general list, which should be true for many systems. +This list will only be used, if there is no entry in a special +list for the system.") + +(defvar View-process-insert-blank-alist + '(("SZ" behind-predecessor 0) + ("SIZE" behind-predecessor 0) + ("RSS" behind-predecessor 0) + ("START" behind 1)) + "Determines places in the output, where a blank should be inserted. +It is an alist and each sublist has the following structure: + (field-name position-descriptor offset) +The field-name is a string with the name of the field. +The position-descriptor determines a position. It has one of the +following values: +`in-front' => insert in front of the field. +`in-front-successor' => insert in front of the successor of the field. +`behind' => insert behind of the field. +`behind-predecessor' => insert behind the predecessor of the field. +The offset is an integer , which specifies an offset.") + +(defvar View-process-mode-syntax-table nil + "Syntax table for the `View-process-mode'.") + +(if (not View-process-mode-syntax-table) + (let ((i 0)) + (setq View-process-mode-syntax-table (make-syntax-table)) + (setq i ?!) + (while (<= i ?#) + (modify-syntax-entry i "w" View-process-mode-syntax-table) + (setq i (1+ i))) + (modify-syntax-entry ?, "w" View-process-mode-syntax-table) + (modify-syntax-entry ?. "w" View-process-mode-syntax-table) + (setq i ?:) + (while (<= i ?\;) + (modify-syntax-entry i "w" View-process-mode-syntax-table) + (setq i (1+ i))) + (setq i ??) + (while (<= i ?@) + (modify-syntax-entry i "w" View-process-mode-syntax-table) + (setq i (1+ i))) + (modify-syntax-entry ?\\ "w" View-process-mode-syntax-table) + (modify-syntax-entry ?^ "w" View-process-mode-syntax-table) + (modify-syntax-entry ?` "w" View-process-mode-syntax-table) + (modify-syntax-entry ?' "w" View-process-mode-syntax-table) + (modify-syntax-entry ?~ "w" View-process-mode-syntax-table) + (modify-syntax-entry ?¡ "w" View-process-mode-syntax-table) + )) + +(defvar View-process-digit-bindings-send-signal nil + "The digits 1 to 9 will be bind to send signal commands, if t.") + +(defvar View-process-mode-mark-map nil + "Local subkeymap for View-process-mode buffers.") + +(if View-process-mode-mark-map + nil + (setq View-process-mode-mark-map (make-keymap)) + (define-key View-process-mode-mark-map "m" 'View-process-mark-current-line) + (define-key View-process-mode-mark-map "u" 'View-process-unmark-current-line) + (define-key View-process-mode-mark-map "U" 'View-process-unmark-all) + (define-key View-process-mode-mark-map "c" + 'View-process-mark-childs-in-current-line) + (define-key View-process-mode-mark-map "l" 'View-process-reset-last-marks) + ) + +(defvar View-process-mode-i-map nil + "Local subkeymap for View-process-mode buffers.") + +(if View-process-mode-i-map + nil + (setq View-process-mode-i-map (make-keymap)) + (define-key View-process-mode-i-map "s" 'View-process-start-itimer) + (define-key View-process-mode-i-map "d" 'View-process-delete-itimer) + ) + +(defvar View-process-mode-comma-map nil + "Local subkeymap for View-process-mode buffers.") + +(if View-process-mode-comma-map + nil + (setq View-process-mode-comma-map (make-keymap)) + (define-key View-process-mode-comma-map "k" + 'View-process-send-signal-to-processes-with-mark) + (define-key View-process-mode-comma-map "a" + 'View-process-renice-processes-with-mark)) + +(defvar View-process-mode-period-map nil + "Local subkeymap for View-process-mode buffers.") + +(if View-process-mode-period-map + nil + (setq View-process-mode-period-map (make-keymap)) + (define-key View-process-mode-period-map "f" + 'View-process-filter-region-by-current-field) + (define-key View-process-mode-period-map "l" + 'View-process-filter-region) + (define-key View-process-mode-period-map "s" + 'View-process-sort-region-by-current-field) + (define-key View-process-mode-period-map "r" + 'View-process-reverse-region) + (define-key View-process-mode-period-map "k" + 'View-process-send-signal-to-processes-in-region) + (define-key View-process-mode-period-map "a" + 'View-process-renice-processes-in-region) + (define-key View-process-mode-period-map "v" + 'View-process-status)) + + +(defvar View-process-mode-map nil + "Local keymap for View-process-mode buffers.") + +(if View-process-mode-map + nil + (setq View-process-mode-map (make-keymap)) + (define-key View-process-mode-map "q" 'View-process-quit) + (define-key View-process-mode-map "V" 'View-process-display-version) + (define-key View-process-mode-map " " 'scroll-up) + (define-key View-process-mode-map "b" 'scroll-down) + (define-key View-process-mode-map "t" 'View-process-toggle-truncate-lines) + (define-key View-process-mode-map "u" 'View-process-status-update) + (define-key View-process-mode-map "U" + 'View-process-remove-all-filter-and-sorter) + (define-key View-process-mode-map "g" 'revert-buffer) +; (define-key View-process-mode-map "v" 'View-process-status) + (define-key View-process-mode-map "v" 'view-processes) + (define-key View-process-mode-map "f" + 'View-process-filter-by-current-field-g) + (define-key View-process-mode-map "F" + 'View-process-filter-output-by-current-field) + (define-key View-process-mode-map "l" + 'View-process-filter-g) + (define-key View-process-mode-map "L" + 'View-process-filter-output) + (define-key View-process-mode-map "s" + 'View-process-sort-by-current-field-g) + (define-key View-process-mode-map "S" + 'View-process-sort-output-by-current-field) + (define-key View-process-mode-map "r" + 'View-process-reverse-g) + (define-key View-process-mode-map "R" + 'View-process-reverse-output) + (define-key View-process-mode-map "k" + 'View-process-send-signal-to-processes-g) + (define-key View-process-mode-map "K" + 'View-process-send-signal-to-process-in-line) + (define-key View-process-mode-map "a" + 'View-process-renice-processes-g) + (define-key View-process-mode-map "A" + 'View-process-renice-process-in-line) +; (define-key View-process-mode-map "k" +; 'View-process-send-signal-to-process) + (define-key View-process-mode-map "?" + 'View-process-which-field-name) + (define-key View-process-mode-map "h" + 'View-process-show-field-names) + (define-key View-process-mode-map "e" + 'View-process-display-emacs-pid) + (define-key View-process-mode-map "w" 'View-process-show-pid-and-command) + (define-key View-process-mode-map "n" 'View-process-next-field) + (define-key View-process-mode-map "p" 'View-process-previous-field) + (define-key View-process-mode-map "<" 'View-process-output-start) + (define-key View-process-mode-map ">" 'View-process-output-end) + (define-key View-process-mode-map [return] + 'View-process-goto-first-field-next-line) + (define-key View-process-mode-map "M" 'View-process-submit-bug-report) + (define-key View-process-mode-map "m" View-process-mode-mark-map) + (define-key View-process-mode-map "." View-process-mode-period-map) + (define-key View-process-mode-map "," View-process-mode-comma-map) + (define-key View-process-mode-map "i" View-process-mode-i-map) + ) + +(defvar View-process-pulldown-menu-name "Processes" + "Name of the pulldown menu in the `View-process-mode'.") + +(defvar View-process-pulldown-menu nil + "Pulldown menu list for the `View-process-mode'.") + +(defvar View-process-region-menu nil + "Menu list for the `View-process-mode', used if a region is active.") + +(defvar View-process-marked-menu nil + "Menu list for the `View-process-mode', used if marked lines exists. +Not used, if a region is active.") + +(defvar View-process-non-region-menu nil + "Menu list for the `View-process-mode', used if a region is not active.") + +(defvar View-process-mode-name "Processes" + "Name of the `view process mode'.") + +(defun View-process-make-field-postition-alist-1 () +"Internal function of View-process-make-field-postition-alist." + (if (>= (point) View-process-header-end) + nil + (let (start end) + (skip-chars-forward " ") + (setq start (current-column)) + (skip-chars-forward "^ ") + (setq end (current-column)) + (cons (list start end) + (View-process-make-field-postition-alist-1)))) + ) + +(defun View-process-make-field-postition-alist () + "Returns an alist with the start and end positions of each field. +The list looks like ((start1 end1) (start2 end2) ...)." + (save-restriction + (widen) + (goto-char View-process-header-start) + (View-process-make-field-postition-alist-1))) + +(defun View-process-overwrite-chars-in-region (begin end char) + "Overwrite region between BEGIN and END with CHAR." + (let ((region-begin (if (< begin end) begin end)) + (region-end (if (> end begin) end begin))) + (save-excursion + (goto-char region-begin) + (while (> region-end (point)) + (delete-char 1) + (View-process-insert-and-inherit char))))) + +(defun View-process-replaces-blanks-in-the-fields-of-this-line + (field-position-alist) + "Replaces the blanks in the fields of this line with underscores. +FIELD-POSITION-ALIST is an alist with the name and the +aproximated start and end positions of each field." + (if (cdr field-position-alist) ; don't change the last field + (let ((field-start (+ (View-process-return-beginning-of-line) + (car (car field-position-alist)))) + (field-end (+ (View-process-return-beginning-of-line) + (car (cdr (car field-position-alist))))) + (next-field-start (+ (View-process-return-beginning-of-line) + (car (car + (cdr field-position-alist)))))) + (goto-char field-start) + (skip-chars-forward " ") + (if (> (point) field-end) + (progn (goto-char field-start) + (delete-char 1) + (View-process-insert-and-inherit "_")) + (let ((search-result (search-forward-regexp "[ ]+" field-end t)) + (match-beginning nil)) + (if search-result + (if (not (= search-result field-end)) + (View-process-overwrite-chars-in-region (match-beginning 0) + (match-end 0) + ?_) + (setq match-beginning (match-beginning 0)) + (if (and (search-forward-regexp "[^ ]+" next-field-start t) + (not (eq (point) next-field-start))) + (View-process-overwrite-chars-in-region + match-beginning + (match-beginning 0) + ?_)))) + )) + (View-process-replaces-blanks-in-the-fields-of-this-line + (cdr field-position-alist))))) + +(defun View-process-replaces-blanks-in-fields () + "Replaces the blanks in fields with underscrores." + (save-excursion + (save-window-excursion + (let ((field-position-alist (View-process-make-field-postition-alist)) + (read-only buffer-read-only)) + (setq buffer-read-only nil) + (goto-char View-process-output-start) + (while (< (point) View-process-output-end) + (beginning-of-line) + (View-process-replaces-blanks-in-the-fields-of-this-line + field-position-alist) + (forward-line)) + (setq buffer-read-only read-only))))) + +(defun View-process-replaces-blanks-in-fields-if-necessary () + "Replaces blanks in fields, if necessary. +For that it checks `View-process-field-blanks-already-replaced'." + (if View-process-field-blanks-already-replaced + nil + (View-process-replaces-blanks-in-fields) + (setq View-process-field-blanks-already-replaced t))) + +(defun View-process-insert-column-in-region (char + column + begin + end + &optional overwrite + not-looking-at) + "Inserts the CHAR at the COLUMN in the region from BEGIN TO END. +The first line must have sufficient columns. No tabs are allowed. +If the optional argument OVERWRITE is non nil, then the CHAR +overwrites the char in the COLUMN. +The optional argument NOT-LOOKING-AT is nil or a regular expression. +In the second case the insertation will only be done, if NOT-LOOKING-AT +isn't a string starting at the column." + (save-excursion + (let ((no-of-lines (count-lines begin end)) + (line 1)) + (goto-char begin) + (beginning-of-line) + (while (<= line no-of-lines) + (forward-char column) + (if (not (= (current-column) column)) + (View-process-insert-and-inherit + (make-string (- column (current-column)) ? ))) + (if overwrite + (progn + (delete-char -1) + (View-process-insert-and-inherit char)) + (if (or (not not-looking-at) + (not (looking-at not-looking-at))) + (progn + (View-process-insert-and-inherit char) + (forward-char -1) + ))) + (forward-line 1) + (setq line (1+ line)))))) + +(defun View-process-insert-blank-in-column (column + &optional overwrite + not-looking-at) + "Inserts a blank in all lines of the ps output in column COLUMN. +If OVERWRITE is non nil, then it overwrites the old column char. +The optional argument NOT-LOOKING-AT is nil or a regular expression. +In the second case the insertation will only be done, if NOT-LOOKING-AT +isn't a string starting at the column." + (let ((read-only buffer-read-only)) + (setq buffer-read-only nil) + (View-process-insert-column-in-region ? + column + View-process-header-start + View-process-output-end + overwrite + not-looking-at) + (setq View-process-output-end (point-max)) + (setq buffer-read-only read-only))) + +;(defun View-process-insert-blanks-at-line-start () +; "Inserts some blanks at the beginning of each output line. +;This space is used for the marks." +; (save-excursion +; (goto-char View-process-header-start) +; (insert "m ") +; (forward-line) +; (while (< (point) View-process-output-end) +; (insert "_ ") +; (forward-line)))) + +(defun View-process-insert-blanks-at-line-start () + "Inserts some blanks at the beginning of each output line. +This space is used for the marks." + (save-excursion + (goto-char View-process-output-end) + (forward-line -1) + (while (> (point) View-process-header-start) + (insert "_ ") + (forward-line -1)) + (insert "m "))) + +(defun View-process-return-position (field-name position-descriptor) + "Returns a position deppending on the FIELD-NAME and the POSITION-DESCRIPTOR. +The POSITION-DESCRIPTOR must be one of the 4 values: `in-front', +`in-front-successor', `behind' and `behind-predecessor'. +If the FIELD-NAME isn't in the header-line, then it return nil." + (save-excursion + (goto-char View-process-header-start) + (beginning-of-line) + (if (search-forward field-name (View-process-return-end-of-line) t) + (cond ((eq position-descriptor 'behind-predecessor) + (goto-char (match-beginning 0)) + (skip-chars-backward " ") + (current-column)) + ((eq position-descriptor 'behind) + (current-column)) + ((eq position-descriptor 'in-front) + (goto-char (match-beginning 0)) + (current-column)) + ((eq position-descriptor 'in-front-successor) + (skip-chars-forward " ") + (current-column)))))) + +(defun View-process-split-merged-fields (insert-blank-alist) + "Tries to split merged fields. +At the moment this is done by inserting a blank between fields, +which are often merged together. The fields are determined by the +alist INSERT-BLANK-ALIST." + (cond (insert-blank-alist + (let ((position (View-process-return-position + (car (car insert-blank-alist)) + (car (cdr (car insert-blank-alist)))))) + (if position + (View-process-insert-blank-in-column + (+ position + (car (cdr (cdr (car insert-blank-alist))))) + nil + "[^ ][^ ]? "))) + (View-process-split-merged-fields (cdr insert-blank-alist))) + (t))) + +(defun View-process-replace-colons-with-blanks () + "Replaces colons with blanks, if a colon is also in the header line. +This fixes the output of the IRIX ps on SGI's." + (save-excursion + (goto-char View-process-header-start) + (while (search-forward ":" (View-process-return-end-of-line) t) + (View-process-insert-blank-in-column (current-column) + t)))) + +(defun View-process-mode () + "Mode for displaying and killing processes. +The mode has the following keybindings: +\\{View-process-mode-map}. + +The first column of each outputline will be used to display marked lines. +The following mark signs are possible (one can change them by changing +the variables in the second column of the following table): + +Sign Variable Description +_ View-process-no-mark Process isn't marked +* View-process-single-line-mark The normal mark. +C View-process-child-line-mark Marked as a child of P (see also P) +K View-process-signal-line-mark Used during signaling +N View-process-renice-line-mark Used during renicing +P View-process-parent-line-mark Marked as the parent of P (see also C) +s View-process-signaled-line-mark Process was signaled or reniced. + +The signal and renice commands are working also on marked processes!" +; (kill-all-local-variables) + (make-local-variable 'revert-buffer-function) + (setq revert-buffer-function 'View-process-revert-buffer) + (View-process-change-display-type View-process-display-with-2-windows) + (use-local-map View-process-mode-map) + (set-syntax-table View-process-mode-syntax-table) + (setq major-mode 'View-process-mode + mode-name View-process-mode-name) +; (View-process-replaces-blanks-in-fields) + (setq View-process-deleted-lines nil) + (View-process-call-sorter-and-filter View-process-actual-sorter-and-filter) + (setq truncate-lines View-process-truncate-lines) + (View-process-install-pulldown-menu) +; (View-process-install-mode-motion) + (View-process-hide-header (and View-process-display-with-2-windows + View-process-hide-header)) + (View-process-install-font-lock) + (View-process-install-mode-motion) + (run-hooks 'View-process-mode-hook) + ) + +(defun View-process-build-field-name-list () + "Returns an alist with the field names and the field number. +The list looks like ((\"USER\" 1) (\"PID\" 2) (\"COMMAND\" 3))." + (goto-char View-process-header-start) + (forward-word 1) + (setq View-process-field-names '()) + (let ((i 1)) + (while (<= (point) View-process-header-end) + (setq View-process-field-names (cons (list (current-word) i) + View-process-field-names)) + (setq i (1+ i)) + (forward-word 1)))) + +(defun View-process-field-name-exists-p (field-name) + "Returns non nil, if the field FIELD_NAME exists." + (assoc field-name View-process-field-names)) + +(defun View-process-translate-field-name-to-position (field-name) + "Returns the position of the field with the name FIELD-NAME." + (car (cdr (assoc field-name View-process-field-names))) + ) + +(defun View-process-translate-field-position-to-name (position) + "Returns the field name of the field with the position POSITION." + (if (> position View-process-max-fields) + (car (View-process-assoc-2th View-process-max-fields + View-process-field-names)) + (car (View-process-assoc-2th position View-process-field-names)) + )) + +(defun View-process-get-system-type-from-host-list (host-name) + "Returns nil, or the system type of the host with the name HOST-NAME." + (car (cdr (assoc host-name View-process-host-names-and-system-types)))) + +(defun View-process-put-system-type-in-host-list (host-name system-type) + "Puts the HOST-NAME and the SYSTEM-TYPE in a special host list. +The list has the name `View-process-host-names-and-system-types'." + (if (not (member (list host-name system-type) + View-process-host-names-and-system-types)) + (setq View-process-host-names-and-system-types + (cons (list host-name system-type) + View-process-host-names-and-system-types)))) + +(defun View-process-bsd-or-system-v (&optional remote-host) + "This function determines, if the system is a BSD or a System V. +For that it uses the ps command. +If REMOTE-HOST is non nil, then the system of the REMOTE-HOST will +be tested." + (if remote-host + (if (eq 0 (call-process View-process-rsh-command + nil + nil + nil + remote-host + (concat View-process-status-command + " " + "-dfj"))) + "system-v" + "bsd") + (if (eq 0 (call-process View-process-status-command + nil + nil + nil + "-dfj")) + "system-v" + "bsd"))) + +(defun View-process-program-exists-p (program &optional remote-host) + "Returns t, if the PROGRAM exists. +If REMOTE_HOST is non nil, then the program will be searched remote +on that host." + (if remote-host + (or (= 0 (call-process View-process-rsh-command + nil + nil + nil + remote-host + (concat View-process-test-command + " " + View-process-test-switches + " " + program))) + (= 0 (call-process View-process-rsh-command + nil + nil + nil + remote-host + (concat View-process-test-command + " " + View-process-test-switches + " " + "/bin/" + program))) + (= 0 (call-process View-process-rsh-command + nil + nil + nil + remote-host + (concat View-process-test-command + " " + View-process-test-switches + " " + "/usr/bin/" + program)))) + (or (= 0 (call-process View-process-test-command + nil + nil + nil + View-process-test-switches + program)) + (= 0 (call-process View-process-test-command + nil + nil + nil + View-process-test-switches + (concat "/bin/" program))) + (= 0 (call-process View-process-test-command + nil + nil + nil + View-process-test-switches + (concat "/usr/bin/" program)))))) + +(defun View-process-search-system-type-in-system-list-1 (system-type + system-list) + "Internal function of `View-process-search-system-type-in-system-list'." + (cond ((not system-list) nil) + ((equal system-type (car (car system-list))) + (cons (car system-list) + (View-process-search-system-type-in-system-list-1 + system-type + (cdr system-list)))) + (t (View-process-search-system-type-in-system-list-1 system-type + (cdr system-list)) + ))) + +(defun View-process-search-system-type-in-system-list (system-type system-list) + "Searches the SYSTEM-TYPE in SYSTEM-LIST. +It returns the entry or nil, if the SYSTEM-TYPE isn't in the list. +If more then one entry with the same SYSTEM-TYPE are found, then the +version number is also checked. If the version number isn't in the +list, then nil is returned." + (let ((system-type-entries (View-process-search-system-type-in-system-list-1 + (car system-type) + system-list))) + (if system-type-entries + (if (= 1 (length system-type-entries)) + (car system-type-entries) + (View-process-assoc-2th (car (cdr system-type)) system-type-entries)) + nil))) + + +(defun View-process-generalize-system-type (system-type &optional remote-host) + "Generalize the SYSTEM-TYPE. +Determines, if the system is in the `View-process-specific-system-list' +and if it is a BSD or a System V system. It returns a list which looks +like the following: (<system-type> <version-no> <bsd-or-system-v>). +The elements <system-type> and <version-no> are set to nil, if the +<system-type> isn't in the `View-process-specific-system-list'. In that +case the third element (<bsd-or-system-v>) is determined with the help +of the ps output. if REMOTE-HOST is non nil, the the ps command to check +the system type is run on the remote host REMOTE-HOST." + (let ((new-system-type (View-process-search-system-type-in-system-list + system-type + View-process-specific-system-list))) + (if new-system-type + new-system-type + (list nil nil (View-process-bsd-or-system-v))))) + +(defun View-process-get-local-system-type () + "Returns the system type of the local host." + (let ((system-type (View-process-get-system-type-from-host-list + (system-name)))) + (if (not system-type) ; t, if the host isn't in the list + (progn + (if (View-process-program-exists-p View-process-uname-command) + (save-excursion + (let ((buffer (generate-new-buffer "*system-type*"))) + (call-process View-process-uname-command + nil + buffer + nil + View-process-uname-switches) + (set-buffer buffer) + (forward-line -1) + (setq system-type (downcase (current-word))) + (forward-word 2) + (setq system-type + (list system-type (downcase (current-word)))) + (kill-buffer buffer) + ;; determine, if the system is in the + ;; View-process-specific-system-list and if it is + ;; a BSD or a System V system; + ;; The system type will be set to nil, + ;; if it isn't in the list + (setq system-type (View-process-generalize-system-type + system-type)) + )) + (setq system-type (list nil nil (View-process-bsd-or-system-v)))) + (View-process-put-system-type-in-host-list (system-name) + system-type) + system-type) + system-type))) + +(defun View-process-get-remote-system-type () + "Returns the system type of the remote host `View-process-remote-host'." + (let ((system-type (View-process-get-system-type-from-host-list + View-process-remote-host))) + (if system-type ; nil, if the host isn't in the list + system-type + (if (View-process-program-exists-p View-process-uname-command + View-process-remote-host) + (let ((buffer (generate-new-buffer "*system-type*"))) + (save-excursion + (call-process View-process-rsh-command + nil + buffer + nil + View-process-remote-host + (concat View-process-uname-command + " " + View-process-uname-switches)) + (set-buffer buffer) + (forward-line -1) + (setq system-type (downcase (current-word))) + (forward-word 2) + (setq system-type + (list system-type (downcase (current-word)))) + (kill-buffer buffer) + ;; determine, if the system is in the + ;; View-process-specific-system-list and if it is + ;; a BSD or a System V system; + ;; The system type will be set to nil, + ;; if it isn't in the list + (setq system-type (View-process-generalize-system-type + system-type + View-process-remote-host)) + )) + (setq system-type (list nil nil (View-process-bsd-or-system-v + View-process-remote-host)))) + (View-process-put-system-type-in-host-list View-process-remote-host + system-type) + system-type))) + +(defun View-process-get-system-type () + "Returns the type of the system on which ps was executed." + (if View-process-remote-host + (View-process-get-remote-system-type) + (View-process-get-local-system-type) + )) + +(defun View-process-get-kill-signal-list (system-type) + "Returns a kill signal list for the SYSTEM-TYPE." + (if (= 3 (length system-type)) + (if (string= "bsd" (nth 2 system-type)) + (if View-process-kill-signals-bsd + View-process-kill-signals-bsd + View-process-kill-signals-general) + (if View-process-kill-signals-system-v + View-process-kill-signals-system-v + View-process-kill-signals-general)) + (if (eval (nth 4 system-type)) + (eval (nth 4 system-type)) + (if (string= "bsd" (nth 2 system-type)) + (if View-process-kill-signals-bsd + View-process-kill-signals-bsd + View-process-kill-signals-general) + (if View-process-kill-signals-system-v + View-process-kill-signals-system-v + View-process-kill-signals-general))))) + +(defun View-process-get-field-name-description-list (system-type) + "Returns a field name description list for the SYSTEM-TYPE. +It returns nil, if no system specific list exists." + (if (= 3 (length system-type)) + (if (string= "bsd" (nth 2 system-type)) + (if View-process-field-name-descriptions-bsd + View-process-field-name-descriptions-bsd) + (if View-process-field-name-descriptions-system-v + View-process-field-name-descriptions-system-v)) + (if (eval (nth 3 system-type)) + (eval (nth 3 system-type)) + (if (string= "bsd" (nth 2 system-type)) + (if View-process-field-name-descriptions-bsd + View-process-field-name-descriptions-bsd) + (if View-process-field-name-descriptions-system-v + View-process-field-name-descriptions-system-v))))) + +(defun View-process-init-internal-variables (use-last-sorter-and-filer) + "Init internal variables. + (without `View-process-header-start'). +If USE-LAST-SORTER-AND-FILER is t, then +'View-process-actual-sorter-and-filter' will not be changed" + ;; don't replace blanks now + (setq View-process-field-blanks-already-replaced t) + + (goto-char View-process-header-start) + (end-of-line) + (setq View-process-header-end (point)) + ;; (newline) + (forward-line) + (setq View-process-output-start (point)) + (setq View-process-output-end (point-max)) + (goto-char View-process-header-end) + (forward-word -1) + (setq View-process-max-fields (View-process-current-field-number)) + (View-process-build-field-name-list) + (setq View-process-system-type (View-process-get-system-type)) + (setq View-process-kill-signals (View-process-get-kill-signal-list + View-process-system-type)) + (setq View-process-field-name-descriptions + (View-process-get-field-name-description-list View-process-system-type) + ) + ;; Replace the blanks the next time if it is necessary + (setq View-process-field-blanks-already-replaced nil) + (if (not use-last-sorter-and-filer) + (setq View-process-actual-sorter-and-filter + View-process-sorter-and-filter)) + + (if View-process-pid-mark-alist + (progn + (setq View-process-last-pid-mark-alist View-process-pid-mark-alist) + (setq View-process-pid-mark-alist nil))) +) + +(defun View-process-insert-short-key-descriptions () + "Insert short key descriptions at the current point. +If `View-process-display-short-key-descriptions' is nil, then +nothing will be inserted." + (if View-process-display-short-key-descriptions + (let ((local-map (current-local-map))) + (use-local-map View-process-mode-map) + (insert + (substitute-command-keys + (concat + " \\[view-processes]: new output " + "\\[View-process-status]: new output with new options " + " \\[revert-buffer]: update output \n" + " \\[View-process-filter-by-current-field-g]: field filter " + "\\[View-process-filter-g]: line filter " + "\\[View-process-sort-by-current-field-g]: sort " + "\\[View-process-reverse-g]: reverse " + "\\[View-process-send-signal-to-processes-g]: send signal " + "\\[View-process-quit]: quit\n"))) + (use-local-map local-map)))) + +(defun View-process-insert-uptime (&optional remote-host) + "Inserts uptime information at the current point. +if `View-process-display-uptime' is nil, then nothing will be inserted. +If REMOTE-HOST is non nil, then its the name of the remote host." + (if View-process-display-uptime + (progn +; (newline) + (if remote-host + (call-process View-process-rsh-command + nil + t + nil + remote-host + View-process-uptime-command) + (call-process View-process-uptime-command + nil + t + nil))))) + +(defun View-process-insert-title-lines (command-switches + remote-host + use-last-sorter-and-filter) + "Insert the title lines in the output lines. +REMOTE-HOST is nil or the name of the host on which the +ps command was executed. USE-LAST-SORTER-AND-FILTER determines, if +the last sorter and filter (from `View-process-actual-sorter-and-filter') +are used." + (insert (or remote-host (system-name) "") + ;;(getenv "HOST") (getenv "HOSTNAME") "") + ", " + (current-time-string) + ", " + View-process-status-command + " " + command-switches + "\n") + (View-process-insert-uptime remote-host) + (View-process-insert-short-key-descriptions) + (if (or (and use-last-sorter-and-filter + View-process-actual-sorter-and-filter) + View-process-sorter-and-filter) + (insert + "This output is filtered! Look at `View-process-sorter-and-filter'.\n")) + (newline 1) + (setq View-process-ps-header-window-size + (+ View-process-ps-header-window-offset + (count-lines (point-min) (point)) + (if (and (View-process-xemacs-p) + (not (View-process-lemacs-p)) + View-process-header-mode-line-off) + -1 + 0)))) + +(defun View-process-search-header-line-1 (header-dectection-list + no-error-message) + "Internal funtion of `View-process-search-header-line'." + (cond (header-dectection-list + (goto-char View-process-header-start) + (if (search-forward (car header-dectection-list) nil t) + (setq View-process-header-start + (View-process-return-beginning-of-line)) + (View-process-search-header-line-1 (cdr header-dectection-list) + no-error-message))) + (t (setq mode-motion-hook nil) ; otherwise emacs hangs + (if no-error-message + nil + (error (concat "ERROR: No header line detected! " + "Look at View-process-header-line-detection-list!") + ))))) + + +(defun View-process-search-header-line (&optional no-error-message) + "Function searches the headerline and sets `View-process-header-start'. +The header line must have at least one of the words of the list +`View-process-header-line-detection-list'. +If NO-ERROR-MESSAGE is t and no header-line is found, then only +nil (without an error message) will be returned." + (save-excursion + (View-process-search-header-line-1 View-process-header-line-detection-list + no-error-message) + )) + +(defun View-process-save-position () + "Saves the current line and column in a cons cell and returns it." + (save-restriction + (widen) + (if (< View-process-header-start (point-max)) + (cons (- (count-lines (or View-process-header-start (point-min)) + (point)) + (if (= 0 (current-column)) + 0 + 1)) + (current-column)) + nil))) + +(defun View-process-goto-position (position) + "Sets the point to the POSITION. +POSITION is a cons cell with a linenumber and a column." + (if position + (save-restriction + (widen) + (goto-char View-process-header-start) + (forward-line (car position)) + (move-to-column (cdr position) t) +; (setq temporary-goal-column (cdr position)) ; doesn't work :-( + ))) + +(defun View-process-status (command-switches + &optional remote-host + use-last-sorter-and-filter) + "Prints a list with processes in the buffer `View-process-buffer-name'. +COMMAND-SWITCHES is a string with the command switches (ie: -aux). +IF the optional argument REMOTE-HOST is given, then the command will +be executed on the REMOTE-HOST. If an prefix arg is given, then the +function asks for the name of the remote host. +If USE-LAST-SORTER-AND-FILTER is t, then the last sorter and filter +commands are used. Otherwise the sorter and filter from the list +'View-process-sorter-and-filter' are used." + (interactive + (let ((View-process-stop-motion-help t)) + (list + (read-string "Command switches: " + (or View-process-status-last-command-switches + (if (bufferp (get-buffer View-process-buffer-name)) + (cdr + (assoc + 'View-process-status-last-command-switches + (buffer-local-variables + (get-buffer View-process-buffer-name))))) + (if (string= "bsd" (View-process-bsd-or-system-v)) + View-process-status-command-switches-bsd + View-process-status-command-switches-system-v)) + 'View-process-status-history) + (if current-prefix-arg + (setq View-process-remote-host + (read-string "Remote host name: " + View-process-remote-host + 'View-process-remote-host-history)) + (setq View-process-remote-host nil))))) + (View-process-save-old-window-configuration) + (let ((buffer (get-buffer-create View-process-buffer-name)) + (position nil)) +; (point-after-ps nil)) + (if (window-minibuffer-p (selected-window)) + (set-buffer buffer) + (switch-to-buffer buffer)) + + ;; set switches for the next view process command + (setq View-process-status-last-command-switches command-switches) + (if (string= "bsd" (View-process-bsd-or-system-v)) + (setq View-process-status-command-switches-bsd command-switches) + (setq View-process-status-command-switches-system-v command-switches)) + + (setq buffer-read-only nil) + (if (not (= (point-min) (point-max))) + (progn + (setq position (View-process-save-position)) +; (setq point-after-ps (point-min)) +; (setq point-after-ps (point)) + (erase-buffer))) + (View-process-insert-title-lines command-switches + remote-host + use-last-sorter-and-filter) + (setq View-process-header-start (point)) + (if remote-host + (call-process View-process-rsh-command + nil + t + t + remote-host + (concat View-process-status-command + " " + command-switches)) + (call-process View-process-status-command + nil + t + t + command-switches)) + (View-process-search-header-line) + (setq View-process-output-end (point-max)) + (View-process-replace-colons-with-blanks) + (View-process-insert-blanks-at-line-start) + (View-process-split-merged-fields View-process-insert-blank-alist) + (View-process-init-internal-variables use-last-sorter-and-filter) + (View-process-highlight-header-line) + (goto-char View-process-output-start) + (View-process-goto-position position) +; (goto-char (cond ((> point-after-ps (point-max)) (point-max)) +; ((= point-after-ps (point-min)) View-process-output-start) +; ((< point-after-ps View-process-output-start) +; View-process-output-start) +; (t point-after-ps))) + (setq buffer-read-only t) + (let ((View-process-stop-motion-help t)) +; (setq View-process-stop-motion-help t) + (View-process-mode) +; (setq View-process-stop-motion-help nil) +; (View-process-redraw) ; only the first time (fixes an Emacs 19 bug) + ) + )) + +(defun View-process-status-update () + "Runs the `View-process-status' with the last switches +and sorter and filter commands." + (interactive) + (if View-process-status-last-command-switches + (View-process-status View-process-status-last-command-switches + View-process-remote-host + t) + (error "ERROR: No view process buffer exists for update!"))) + +(defun view-processes (&optional remote-host) + "Prints a list with processes in the buffer `View-process-buffer-name'. +It calls the function `View-process-status' with default switches. +As the default switches on BSD like systems the value of the variable +`View-process-status-command-switches-bsd' is used. +On System V like systems the value of the variable +`View-process-status-command-switches-system-v' is used. +IF the optional argument REMOTE-HOST is given, then the command will +be executed on the REMOTE-HOST. If an prefix arg is given, then the +function asks for the name of the remote host." + (interactive + (let ((View-process-stop-motion-help t)) + (list (if current-prefix-arg + (setq View-process-remote-host + (read-string "Remote host name: " + View-process-remote-host + 'View-process-remote-host-history)) + (setq View-process-remote-host nil))))) + (if (string= "bsd" (nth 2 (View-process-get-system-type))) + (View-process-status View-process-status-command-switches-bsd + View-process-remote-host) + (View-process-status View-process-status-command-switches-system-v + remote-host))) + +;;; itimer functions (to repeat the ps output) + +(defun View-process-status-itimer-function () + "Itimer function for updating the ps output." + (save-excursion + (save-window-excursion + (View-process-status-update))) + ;;(View-process-start-itimer) + ) + + +;;; help functions + +(defun View-process-show-pid-and-command-or-field-name () + "Displays the pid and the command of the current line or the field name. +If the point is at a blank, then the pid and the command of the current +line are displayed. Otherwise the name of the field and its description +are displayed." + (interactive) + (if (looking-at " ") + (View-process-show-pid-and-command) + (View-process-which-field-name))) + +(defun View-process-show-pid-and-command () + "Displays the pid and the command of the current line. +It assumes, that the command is displayed at the end of the line." + (interactive) + (if (>= (point) View-process-output-start) + (message "PID= %s, %s" + (View-process-get-pid-from-current-line) + (View-process-get-field-value-from-current-line + View-process-max-fields + View-process-max-fields)))) + +(defun View-process-show-field-names () + "Displays the name(s) of the ps output field(s). +If the point is at a blank, then the header line with all field names +is displayed. Otherwise only the name of the field at the point is +displayed." + (interactive) + (if (looking-at " ") + (View-process-show-header-line) + (View-process-which-field-name))) + +(defun View-process-show-header-line () + "Displays the header line in the buffer at the current line." + (interactive) + (save-window-excursion + (let ((header-line (save-restriction + (widen) + (concat + (buffer-substring View-process-header-start + View-process-header-end) + "\n")))) + (momentary-string-display header-line + (View-process-return-beginning-of-line))))) + +(defun View-process-which-field-name () + "Displays the name of the field under the point in the echo area." + (interactive) + (if (>= (point) View-process-header-start) + (let ((field-name (View-process-translate-field-position-to-name + (View-process-current-field-number)))) + (message + (View-process-replace-in-string + "%" + "%%" + (concat field-name + ": " + (View-process-get-field-name-description field-name))))))) + +(defun View-process-get-field-name-description (field-name) + "Returns a string with a desciption of the ps output field FIELD-NAME." + (let ((description + (or (car (cdr (assoc field-name + View-process-field-name-descriptions))) + (car (cdr (assoc field-name + View-process-field-name-descriptions-general)))) + )) + (if (stringp description) + description + (concat (car description) + (View-process-get-value-description + (View-process-get-field-value-from-current-line + (View-process-translate-field-name-to-position field-name) + View-process-max-fields) + (cdr description)))))) + +(defun View-process-get-value-description (values value-descriptions) + "Returns a string with the description of the VALUES. +VALUE-DESCRIPTIONS is an alist with the possible values and its +descriptions." + (cond ((string= values "") "") + ((or (eq (aref values 0) ?_) (eq (aref values 0) ? )) + (View-process-get-value-description (substring values 1) + value-descriptions)) + (t (concat + (car + (cdr + (assoc + (substring values 0 (string-match "[ _]" values)) + value-descriptions))) + (if (string-match "[ _]" values) + (View-process-get-value-description + (substring values (string-match "[ _]" values)) + value-descriptions) + ""))))) + + +;;; sort functions + +(defun View-process-current-field-number () + "Returns the field number of the point. +The functions fails with an error message, if the character under +the point is a blank." + (View-process-replaces-blanks-in-fields-if-necessary) + (save-excursion + (if (looking-at " ") + (error "Point is on a blank and not in a field!") + (if (and (eq (point) (point-max)) + (eq (current-column) 0)) + (error "Point is not in a field!") + (let ((field-point (point)) + (i 0)) + (beginning-of-line) + (skip-chars-forward " ") + (while (>= field-point (point)) + (setq i (1+ i)) + (skip-chars-forward "^ ") + (skip-chars-forward " ")) + i))))) + +(defun View-process-sort-fields-in-region (field + beg + end + &optional sort-function) + "Sort lines in region by the ARGth field of each line. +Fields are separated by whitespace and numbered from 1 up. +With a negative arg, sorts by the ARGth field counted from the right. +BEG and END specify region to sort. +If the optional SORT-FUNCTION is nil, then the region is at first +sorted with the function `sort-fields' and then with the function +`sort-float-fields'. Otherwise a sort function like `sort-fields' +must be specified." + (let ((position (View-process-save-position)) +; (point (point)) ;; that's, because save-excursion +; (column (current-column)) ;; doesn't work :-( + (field-no (if (< field View-process-max-fields) + field + View-process-max-fields))) + (if sort-function + (eval (list sort-function field-no beg end)) + (sort-fields field-no beg end) + (sort-float-fields field-no beg end)) + (View-process-goto-position position))) +; (goto-char point) +; (goto-char (+ point (- column (current-column)))))) + +(defun View-process-remove-sorter (sorter alist) + "Removes the SORTER entry from the ALIST." + (cond ((not alist) nil) + ((eq sorter (car (car alist))) (cdr alist)) + (t (cons (car alist) + (View-process-remove-sorter sorter (cdr alist)))))) + +(defun View-process-sort-output-by-field (field-name + &optional dont-remember) + "Sort the ps output by the field FIELD-NAME. +If DONT-REMEMBER is t, then the filter command isn't inserted +in the `View-process-actual-sorter-and-filter' list." + (interactive + (let ((View-process-stop-motion-help t)) + (list + (completing-read "Field Name for sorting: " + View-process-field-names + nil + t + (car View-process-field-name-history) + View-process-field-name-history)))) + (setq buffer-read-only nil) + (View-process-sort-fields-in-region + (View-process-translate-field-name-to-position field-name) + View-process-output-start + View-process-output-end) + (setq buffer-read-only t) + (if (not dont-remember) + (setq View-process-actual-sorter-and-filter + (append (View-process-remove-sorter + 'reverse + (View-process-remove-sorter + 'sort + View-process-actual-sorter-and-filter)) + (list (list 'sort field-name)))))) + +(defun View-process-sort-by-current-field-g () + "Sort the ps output by the field under the point. +It is a generic interface to `View-process-sort-region-by-current-field' +and `View-process-sort-output-by-current-field'.The first will be called +if a region is active and the other one if not. +With a prefix arg, it uses the NTH field instead of the current one." + (interactive) + (if (View-process-region-active-p) + (call-interactively 'View-process-sort-region-by-current-field) + (call-interactively 'View-process-sort-output-by-current-field))) + +(defun View-process-sort-output-by-current-field (&optional nth dont-remember) + "Sort the whole ps output by the field under the point. +With a prefix arg, it uses the NTH field instead of the current one. +If DONT-REMEMBER is t, then the filter command isn't inserted +in the `View-process-actual-sorter-and-filter' list." + (interactive "P") + (let ((field-number (if nth + (if (and (>= nth 1) (<= nth View-process-max-fields)) + nth + (error "ERROR: Wrong field number!")) + (View-process-current-field-number)))) + (setq buffer-read-only nil) + (View-process-sort-fields-in-region field-number + View-process-output-start + View-process-output-end) + (setq buffer-read-only t) + (if (not dont-remember) + (setq View-process-actual-sorter-and-filter + (append (View-process-remove-sorter + 'reverse + (View-process-remove-sorter + 'sort + View-process-actual-sorter-and-filter)) + (list + (list 'sort + (View-process-translate-field-position-to-name + field-number)))))))) + +(defun View-process-sort-region-by-current-field (&optional nth) + "Sort the region by the field under the point. +With a prefix arg, it uses the NTH field instead of the current one." + (interactive "P") + (let ((field-number (if nth + (if (and (>= nth 1) (<= nth View-process-max-fields)) + nth + (error "ERROR: Wrong field number!")) + (View-process-current-field-number)))) + (setq buffer-read-only nil) + (View-process-sort-fields-in-region + field-number + (save-excursion + (goto-char (region-beginning)) + (View-process-return-beginning-of-line)) + (save-excursion + (goto-char (region-end)) + (View-process-return-end-of-line))) + (setq buffer-read-only t))) + +(defun View-process-reverse-output (&optional dont-remember) + "Reverses the whole output lines. +If DONT-REMEMBER is t, then the filter command isn't inserted +in the `View-process-actual-sorter-and-filter' list." + (interactive) + (setq buffer-read-only nil) + (let ((position (View-process-save-position))) +; (line (count-lines (point-min) (point))) +; (column (current-column))) + (reverse-region View-process-output-start View-process-output-end) + (View-process-goto-position position)) +; (goto-line line) +; (beginning-of-line) +; (forward-char column)) + (setq buffer-read-only t) + (if (not dont-remember) + (setq View-process-actual-sorter-and-filter + (if (assq 'reverse View-process-actual-sorter-and-filter) + (View-process-remove-sorter + 'reverse + View-process-actual-sorter-and-filter) + (append View-process-actual-sorter-and-filter + (list (list 'reverse))))))) + +(defun View-process-reverse-region () + "Reverses the output lines in the region." + (interactive) + (setq buffer-read-only nil) + (let ((region-beginning (if (< (region-beginning) (region-end)) + (region-beginning) + (region-end))) + (region-end (if (> (region-end) (region-beginning)) + (region-end) + (region-beginning))) + (position (View-process-save-position))) +; (line (count-lines (point-min) (point))) +; (column (current-column))) + (reverse-region (if (< region-beginning View-process-output-start) + View-process-output-start + (goto-char region-beginning) + (View-process-return-beginning-of-line)) + (if (> region-end View-process-output-end) + View-process-output-end + (goto-char region-end) + (View-process-return-end-of-line))) + (View-process-goto-position position)) +; (goto-line line) +; (beginning-of-line) +; (forward-char column)) + (setq buffer-read-only t)) + +(defun View-process-reverse-g () + "Reverses the output lines. +It is a generic interface to `View-process-reverse-region' +and `View-process-reverse-output'. The first will be called +if a region is active and the other one if not." + (interactive) + (if (View-process-region-active-p) + (call-interactively 'View-process-reverse-region) + (call-interactively 'View-process-reverse-output))) + +;;; filter functions + +(defun View-process-delete-region (start end) + "Stores deleted lines in `View-process-deleted-lines'." + (setq View-process-deleted-lines + (cons (buffer-substring start end) + View-process-deleted-lines)) + (delete-region start end)) + +(defun View-process-remove-all-filter-and-sorter () + "Undeletes all filtered lines from `View-process-deleted-lines'. +It removes also all filter and sorter from the list +`View-process-actual-sorter-and-filter'." + (interactive) + (let ((buffer-read-only)) + (goto-char View-process-output-end) + (mapcar '(lambda (line) + (insert line)) + View-process-deleted-lines) + (setq View-process-output-end (point)) + (setq View-process-actual-sorter-and-filter nil) + (goto-char View-process-output-start))) + +(defun View-process-filter-fields-in-region (regexp + field-no + beg + end + &optional exclude) + "Filters a region with a REGEXP in the field FIELD-NO. +The region start is at BEG and the end at END. If FIELD-NO +is nil, then the whole line is used. All lines which passes +not the filter are deleted in the buffer, if EXCLUDE is nil. +Otherwise only these lines are not deleted." + (save-restriction + (widen) + (let ((region-start (if (< beg end) beg end)) + (region-end (if (> beg end) beg end))) + (if (< region-start View-process-output-start) + (setq region-start View-process-output-start)) + (goto-char region-end) + (if field-no + (while (>= (point) region-start) + (if (string-match regexp + (View-process-get-field-value-from-current-line + field-no + View-process-max-fields)) + (if exclude + (View-process-delete-region + (1- (View-process-return-beginning-of-line)) + (View-process-return-end-of-line)) + (forward-line -1)) + (if exclude + (forward-line -1) + (View-process-delete-region + (1- (View-process-return-beginning-of-line)) + (View-process-return-end-of-line))) + )) + (beginning-of-line) + (while (>= (point) region-start) + (if (search-forward-regexp regexp + (View-process-return-end-of-line) t) + (if exclude + (progn + (View-process-delete-region + (1- (View-process-return-beginning-of-line)) + (View-process-return-end-of-line)) + (beginning-of-line)) + (forward-line -1)) + (if exclude + (forward-line -1) + (View-process-delete-region + (1- (View-process-return-beginning-of-line)) + (View-process-return-end-of-line)) + (beginning-of-line)) + ))) + (goto-char region-start)) + (setq View-process-output-end (point-max)) + (if (> View-process-output-start View-process-output-end) + (progn + (newline) + (setq View-process-output-end View-process-output-start))))) + +(defun View-process-filter-output-by-field (field-name + regexp + &optional exclude + dont-remember) + "Filter the whole output by the field FIELD-NAME with REGEXP. +The matching lines are deleted, if EXCLUDE is t. The non matching +lines are deleted, if EXCLUDE is nil. If you call this function +interactive, then you can give a prefix arg to set EXCLUDE to non nil. +If DONT-REMEMBER is t, then the filter command isn't inserted +in the `View-process-actual-sorter-and-filter' list." + (interactive + (let ((View-process-stop-motion-help t)) + (list + (completing-read "Field Name for filtering: " + View-process-field-names + nil + t + (car View-process-field-name-history) + View-process-field-name-history) + (read-string "Regexp for filtering the output in the field: " + (car View-process-filter-history) + View-process-filter-history) + current-prefix-arg + ))) + (setq buffer-read-only nil) + (View-process-filter-fields-in-region + regexp + (View-process-translate-field-name-to-position field-name) + View-process-output-start + View-process-output-end + exclude) + (setq buffer-read-only t) + (if (not dont-remember) + (setq View-process-actual-sorter-and-filter + (append View-process-actual-sorter-and-filter + (list (list (if exclude 'exclude-filter 'filter) + field-name + regexp)))))) + +(defun View-process-filter-output-by-current-field (regexp + &optional exclude + dont-remember) + "Filter the whole output by the field under the point with REGEXP. +The matching lines are deleted, if EXCLUDE is t. The non matching +lines are deleted, if EXCLUDE is nil. If you call this function +interactive, then you can give a prefix arg to set EXCLUDE to non nil. +If DONT-REMEMBER is t, then the filter command isn't inserted +in the `View-process-actual-sorter-and-filter' list." +; (interactive "sRegexp for filtering the output in the current field: \nP") + (interactive + (let* ((View-process-stop-motion-help t) + (regexp (read-string + "sRegexp for filtering the output in the current field: ")) + (exclude current-prefix-arg)) + (list regexp exclude))) + (let ((current-field-number (View-process-current-field-number))) + (setq buffer-read-only nil) + (View-process-filter-fields-in-region regexp + current-field-number + View-process-output-start + View-process-output-end + exclude) + (setq buffer-read-only t) + (if (not dont-remember) + (setq View-process-actual-sorter-and-filter + (append View-process-actual-sorter-and-filter + (list + (list (if exclude 'exclude-filter 'filter) + (View-process-translate-field-position-to-name + current-field-number) + regexp))))))) + +(defun View-process-filter-region-by-current-field (regexp &optional exclude) + "Filter the region by the field under the point with REGEXP. +The matching lines are deleted, if EXCLUDE is t. The non matching +lines are deleted, if EXCLUDE is nil. If you call this function +interactive, then you can give a prefix arg to set EXCLUDE to non nil." +; (interactive "sRegexp for filtering the region in the current field: \nP") + (interactive + (let* ((View-process-stop-motion-help t) + (regexp (read-string + "sRegexp for filtering the region in the current field: ")) + (exclude current-prefix-arg)) + (list regexp exclude))) + (setq buffer-read-only nil) + (View-process-filter-fields-in-region + regexp + (View-process-current-field-number) + (save-excursion + (goto-char (region-beginning)) + (View-process-return-beginning-of-line)) + (save-excursion + (goto-char (region-end)) + (View-process-return-end-of-line)) + exclude) + (setq buffer-read-only t)) + +(defun View-process-filter-by-current-field-g (&optional exclude) + "Filter the whole output by the field under the point with an Regexp. +It is a generic interface to `View-process-filter-region-by-current-field' +and `View-process-filter-output-by-current-field'. The first will be called +if a region is active and the other one if not. +The matching lines are deleted, if EXCLUDE is t. The non matching +lines are deleted, if EXCLUDE is nil. If you call this function +interactive, then you can give a prefix arg to set EXCLUDE to non nil." + (interactive "P") + (setq prefix-arg current-prefix-arg) + (if (View-process-region-active-p) + (call-interactively 'View-process-filter-region-by-current-field) + (call-interactively 'View-process-filter-output-by-current-field))) + +(defun View-process-filter-output (regexp &optional exclude dont-remember) + "Filter the whole output with REGEXP. +The matching lines are deleted, if EXCLUDE is t. The non matching +lines are deleted, if EXCLUDE is nil. If you call this function +interactive, then you can give a prefix arg to set EXCLUDE to non nil. +If DONT-REMEMBER is t, then the filter command isn't inserted +in the `View-process-actual-sorter-and-filter' list." +; (interactive "sRegexp for filtering the output: \nP") + (interactive + (let* ((View-process-stop-motion-help t) + (regexp (read-string + "sRegexp for filtering the output: ")) + (exclude current-prefix-arg)) + (list regexp exclude))) + (setq buffer-read-only nil) + (View-process-filter-fields-in-region regexp + nil + View-process-output-start + View-process-output-end + exclude) + (setq buffer-read-only t) + (if (not dont-remember) + (setq View-process-actual-sorter-and-filter + (append View-process-actual-sorter-and-filter + (list (list (if exclude 'exclude-grep 'grep) + regexp)))))) + +(defun View-process-filter-region (regexp &optional exclude) + "Filter the region with REGEXP. +The matching lines are deleted, if EXCLUDE is t. The non matching +lines are deleted, if EXCLUDE is nil. If you call this function +interactive, then you can give a prefix arg to set EXCLUDE to non nil." +; (interactive "sRegexp for filtering the region: \nP") + (interactive + (let* ((View-process-stop-motion-help t) + (regexp (read-string + "sRegexp for filtering the region: ")) + (exclude current-prefix-arg)) + (list regexp exclude))) + (setq buffer-read-only nil) + (View-process-filter-fields-in-region + regexp + nil + (save-excursion + (goto-char (region-beginning)) + (View-process-return-beginning-of-line)) + (save-excursion + (goto-char (region-end)) + (View-process-return-end-of-line)) + exclude) + (setq buffer-read-only t)) + +(defun View-process-filter-g (&optional exclude) + "Filters the output by the field under the point with an Regexp. +It is a generic interface to `View-process-filter-region' +and `View-process-filter-output'. The first will be called +if a region is active and the other one if not. +The matching lines are deleted, if EXCLUDE is t. The non matching +lines are deleted, if EXCLUDE is nil. If you call this function +interactive, then you can give a prefix arg to set EXCLUDE to non nil." + (interactive "P") + (setq prefix-arg current-prefix-arg) + (if (View-process-region-active-p) + (call-interactively 'View-process-filter-region) + (call-interactively 'View-process-filter-output))) + + +;;; call sorter, filter or grep after running ps + +(defun View-process-call-sorter-and-filter (sorter-and-filter-list) + "Call sorter, filter or grep after running ps. +The sorter, filter or grep commands and its parameters are called +from SORTER-AND-FILTER-LIST." + (cond ((not sorter-and-filter-list) t) + ((eq 'grep (car (car sorter-and-filter-list))) + (View-process-filter-output (car (cdr (car sorter-and-filter-list))) + nil + t) + (View-process-call-sorter-and-filter (cdr sorter-and-filter-list))) + ((eq 'exclude-grep (car (car sorter-and-filter-list))) + (View-process-filter-output (car (cdr (car sorter-and-filter-list))) + t + t) + (View-process-call-sorter-and-filter (cdr sorter-and-filter-list))) + ((eq 'sort (car (car sorter-and-filter-list))) + (if (assoc (car (cdr (car sorter-and-filter-list))) + View-process-field-names) + (View-process-sort-output-by-field + (car (cdr (car sorter-and-filter-list))) + t)) + (View-process-call-sorter-and-filter (cdr sorter-and-filter-list))) + ((eq 'filter (car (car sorter-and-filter-list))) + (if (assoc (car (cdr (car sorter-and-filter-list))) + View-process-field-names) + (View-process-filter-output-by-field + (car (cdr (car sorter-and-filter-list))) + (car (cdr (cdr (car sorter-and-filter-list)))) + nil + t)) + (View-process-call-sorter-and-filter (cdr sorter-and-filter-list))) + ((eq 'exclude-filter (car (car sorter-and-filter-list))) + (if (assoc (car (cdr (car sorter-and-filter-list))) + View-process-field-names) + (View-process-filter-output-by-field + (car (cdr (car sorter-and-filter-list))) + (car (cdr (cdr (car sorter-and-filter-list)))) + t + t)) + (View-process-call-sorter-and-filter (cdr sorter-and-filter-list))) + ((eq 'reverse (car (car sorter-and-filter-list))) + (View-process-reverse-output t) + (View-process-call-sorter-and-filter (cdr sorter-and-filter-list))) + (t (error "Filter/Sorter command not implemented!")))) + + +;;; Child processes + +(defun View-process-get-child-process-list-1 (pid pid-ppid-alist) + "Internal function of `View-process-get-child-process-list'." + (cond ((car pid-ppid-alist) + (if (not (string= pid (cdr (car pid-ppid-alist)))) + (View-process-get-child-process-list-1 pid (cdr pid-ppid-alist)) + (cons (car (car pid-ppid-alist)) + (View-process-get-child-process-list-1 pid + (cdr pid-ppid-alist)) + ))))) + +(defun View-process-get-child-process-list (pid pid-ppid-alist) + "Returns a list with all direct childs of the processes with the PID. +The list PID-PPID-ALIST is an alist with the pid's as car's +and ppid's as cdr's. +Example list: (\"0\" \"10\" \"20\") +With \"0\" eq PID as the parent of the direct childs \"10\" and \"20\"." + (cons pid (View-process-get-child-process-list-1 pid pid-ppid-alist))) + +(defun View-process-get-child-process-tree (pid) + "Returns a list with all childs and subchilds of the processes with the PID. +Example list: (\"0\" (\"10\") (\"20\" (\"30\" \"40\"))) +With \"0\" eq PID as the parent of the direct childs \"10\" and \"20\" +and with \"20\" as the parent of the direct childs \"30\" and \"40\"." + (cons pid + (mapcar 'View-process-get-child-process-tree + (cdr (View-process-get-child-process-list + pid + (save-excursion + (View-process-get-pid-ppid-list-from-region + View-process-output-start + View-process-output-end))))))) + +;(defun View-process-highlight-process-tree (process-tree) +; "Highlights all processes in the list process-tree." +; (cond ((not process-tree)) +; ((listp (car process-tree)) +; (View-process-highlight-process-tree (car process-tree)) +; (View-process-highlight-process-tree (cdr process-tree))) +; ((stringp (car process-tree)) +; (View-process-highlight-line-with-pid (car process-tree) +; 'View-process-child-line-face +; View-process-child-line-mark) +; (View-process-highlight-process-tree (cdr process-tree))) +; (t (error "Bug in 'View-process-highlight-process-tree' !")))) + +;(defun View-process-highlight-recursive-all-childs (pid) +; "Highlights all childs of the process with the PID." +; (interactive "sParent PID: ") +; (if (not +; (View-process-field-name-exists-p View-process-ppid-field-name)) +; (error "ERROR: No field `%s' in the output. Try `M-x ps -j' to get it." +; View-process-ppid-field-name) +; (View-process-highlight-line-with-pid pid +; 'View-process-parent-line-face +; View-process-parent-line-mark) +; (View-process-highlight-process-tree +; (cdr (View-process-get-child-process-tree pid))))) + +;(defun View-process-highlight-recursive-all-childs-in-line () +; "Highlights all the child processes of the process in the current line." +; (interactive) +; (View-process-highlight-recursive-all-childs +; (View-process-get-pid-from-current-line))) + +;;; kill processes + +(defun View-process-send-signal-to-processes-with-mark (signal) + "Sends a SIGNAL to all processes, which are marked." + (interactive + (let* ((View-process-stop-motion-help t) + (signal (completing-read "Signal: " + View-process-kill-signals + nil + t + View-process-default-kill-signal + View-process-signal-history))) + (list signal))) + (if View-process-pid-mark-alist + (View-process-call-function-on-pid-and-mark-list + 'View-process-send-signal-to-process-in-line + View-process-pid-mark-alist + t + signal) + (error "ERROR: There is no marked process!."))) + +(defun View-process-send-signal-to-processes-in-region (signal) + "Sends a SIGNAL to all processes in the current region." + (interactive + (let* ((View-process-stop-motion-help t) + (signal (completing-read "Signal: " + View-process-kill-signals + nil + t + View-process-default-kill-signal + View-process-signal-history))) + (list signal))) + (let ((region-start (if (> (region-beginning) View-process-output-start) + (region-beginning) + View-process-output-start)) + (region-end (if (< (region-end) View-process-output-end) + (region-end) + View-process-output-end))) + (save-excursion + (goto-char region-start) + (beginning-of-line) + (let ((pid-list (View-process-get-pid-list-from-region (point) + region-end))) + (View-process-send-signal-to-processes-in-pid-list signal + pid-list + nil + t) + )))) + +(defun View-process-send-signal-to-processes-in-pid-list (signal + pid-list + &optional + dont-ask + dont-update) + "Sends a SIGNAL to all processes with a pid in PID-LIST. +If DONT-ASK is non nil, then no confirmation question will be asked. +If DONT-UPDATE is non nil, then the command `View-process-status-update' +will not be run after sending a signal." + (if (not pid-list) + t + (View-process-send-signal-to-process signal + (car pid-list) + dont-ask + dont-update) + (View-process-send-signal-to-processes-in-pid-list signal + (cdr pid-list) + dont-ask + dont-update))) + +(defun View-process-send-signal-to-process-in-line (signal) + "Sends a SIGNAL to the process in the current line." + (interactive + (let* ((View-process-stop-motion-help t) + (signal (completing-read "Signal: " + View-process-kill-signals + nil + t + View-process-default-kill-signal + View-process-signal-history))) + (list signal))) + (if (and (>= (point) View-process-output-start) + (< (point) View-process-output-end)) + (View-process-send-signal-to-process + signal + (View-process-get-pid-from-current-line) + nil + t))) + +(defun View-process-send-key-as-signal-to-processes () + "Converts the key which invokes this command to a signal. +After that it sends this signal to the process in the current line, +or, if an active region exists, to all processes in the region. +For this function only numbers could be used as keys." + (interactive) + (let ((signal (View-process-return-current-command-key-as-string))) + (if (not (= 0 (string-to-int signal))) + (if (View-process-region-active-p) + (View-process-send-signal-to-processes-in-region signal) + (View-process-send-signal-to-process-in-line signal)) + (error "ERROR: This command must be bind to and call by an integer!") + ))) + +(defun View-process-send-signal-to-processes-g () + "Sends a signal to processes. +It is a generic interface to `View-process-send-signal-to-processes-in-region' +and `View-process-send-signal-to-process-in-line'. The first will be called +if a region is active and the other one if not. If the region isn't +active, but marks are set, then the function is called on every +marked process." + (interactive) + (cond ((View-process-region-active-p) + (call-interactively 'View-process-send-signal-to-processes-in-region)) + (View-process-pid-mark-alist + (call-interactively 'View-process-send-signal-to-processes-with-mark)) + (t + (call-interactively 'View-process-send-signal-to-process-in-line)))) + +(defun View-process-send-signal-to-process (signal + pid + &optional + dont-ask + dont-update) + "Sends the SIGNAL to the process with the PID. +If DONT-ASK is non nil, then no confirmation question will be asked. +If DONT-UPDATE is non nil, then the command `View-process-status-update' +will not be run after sending the signal." + (interactive + (let* ((View-process-stop-motion-help t) + (signal (completing-read "Signal: " + View-process-kill-signals + nil + t + View-process-default-kill-signal + View-process-signal-history)) + (pid (int-to-string (read-number "Process Id (PID): ")))) + (list signal pid))) + (if (and (eq (string-to-int pid) (emacs-pid)) + (or (not View-process-remote-host) + (string= View-process-remote-host (getenv "HOSTNAME")))) + (error "Hey, are you a murderer? You've just tried to kill me!") + (let ( +; (signal-line-extent +; (View-process-highlight-line-with-pid +; pid +; 'View-process-signal-line-face +; View-process-signal-line-mark)) + (signal-number (car (cdr (assoc signal View-process-kill-signals))))) + (View-process-mark-line-with-pid pid View-process-signal-line-mark) + (if (or dont-ask + (if (string= signal-number signal) + (y-or-n-p (format + "Do you realy want to send signal %s to PID %s " + signal + pid)) + (y-or-n-p + (format "Do you realy want to send signal %s (%s) to PID %s " + signal + signal-number + pid)))) + (progn + (if View-process-remote-host + (call-process View-process-rsh-command + nil + nil + nil + View-process-remote-host + (concat View-process-signal-command + " -" + signal-number + " " + pid)) + (call-process View-process-signal-command + nil + nil + nil + (concat "-" signal-number) + pid)) + (if (not dont-update) + (View-process-status-update) + (View-process-mark-line-with-pid pid + View-process-signaled-line-mark) + )) +; (View-process-delete-extent signal-line-extent) + (if (View-process-goto-line-with-pid pid) + (View-process-unmark-current-line)) + )))) + + +;;; renice processes + +(defun View-process-read-nice-value () + "Reads and returns a valid nice value." + (let ((nice-value nil) + (min-value (if (string= (user-real-login-name) "root") -20 1)) + (prompt "Add nice value [%d ... 20]: ")) + (while (not nice-value) + (setq nice-value (read-string (format prompt min-value) + View-process-default-nice-value)) + (if (and (string= (int-to-string (string-to-int nice-value)) + nice-value) + (>= (string-to-int nice-value) min-value) + (<= (string-to-int nice-value) 20) + (not (= (string-to-int nice-value) 0))) + (if (> (string-to-int nice-value) 0) + (setq nice-value + (concat "+" (int-to-string (string-to-int nice-value))))) + (setq nice-value nil) + (setq prompt + "Wrong Format! Try again. Add nice value [%d ... 20]: "))) + nice-value)) + +(defun View-process-renice-process (nice-value + pid + &optional + dont-ask + dont-update) + "Alter priority of the process with the PID. +NICE-VALUE is the value, which will be added to the old nice value. +If DONT-ASK is non nil, then no confirmation question will be asked. +If DONT-UPDATE is non nil, then the command `View-process-status-update' +will not be run after renicing." + (interactive + (let* ((View-process-stop-motion-help t) + (nice-value (View-process-read-nice-value)) + (pid (int-to-string (read-number "Process Id (PID): ")))) + (list nice-value pid))) +; (let ((signal-line-extent +; (View-process-highlight-line-with-pid +; pid +; 'View-process-signal-line-face +; View-process-renice-line-mark))) + (View-process-mark-line-with-pid pid View-process-renice-line-mark) + (if (or dont-ask + (y-or-n-p (format + "Do you realy want to renice PID %s with %s " + pid + nice-value))) + (progn + (if View-process-remote-host + (call-process View-process-rsh-command + nil + nil + nil + View-process-remote-host + (concat View-process-renice-command + " " + nice-value + " " + pid)) + (call-process View-process-renice-command + nil + nil + nil + nice-value + pid)) + (if (not dont-update) + (View-process-status-update) + (View-process-mark-line-with-pid pid View-process-signaled-line-mark) + )) +; (View-process-delete-extent signal-line-extent) + (if (View-process-goto-line-with-pid pid) + (View-process-unmark-current-line)))) + +(defun View-process-renice-processes-with-mark (nice-value) + "Alter priority of all processes, which are marked. +NICE-VALUE is the value, which will be added to the old nice value." + (interactive + (let* ((View-process-stop-motion-help t) + (nice-value (View-process-read-nice-value))) + (list nice-value))) + (if View-process-pid-mark-alist + (View-process-call-function-on-pid-and-mark-list + 'View-process-renice-process-in-line + View-process-pid-mark-alist + t + nice-value) + (error "ERROR: There is no marked process!."))) + +(defun View-process-renice-processes-in-region (nice-value) + "Alter priority of all processes in the current region. +NICE-VALUE is the value, which will be added to the old nice value." + (interactive + (let* ((View-process-stop-motion-help t) + (nice-value (View-process-read-nice-value))) + (list nice-value))) + (let ((region-start (if (> (region-beginning) View-process-output-start) + (region-beginning) + View-process-output-start)) + (region-end (if (< (region-end) View-process-output-end) + (region-end) + View-process-output-end))) + (save-excursion + (goto-char region-start) + (beginning-of-line) + (let ((pid-list (View-process-get-pid-list-from-region (point) + region-end))) + (View-process-renice-processes-in-pid-list nice-value pid-list nil t) + )))) + +(defun View-process-renice-processes-in-pid-list (nice-value + pid-list + &optional + dont-ask + dont-update) + "Alter priority all processes with a pid in PID-LIST. +NICE-VALUE is the value, which will be added to the old nice value. +If DONT-ASK is non nil, then no confirmation question will be asked. +If DONT-UPDATE is non nil, then the command `View-process-status-update' +will not be run after renicing" + (if (not pid-list) + t + (View-process-renice-process nice-value + (car pid-list) + dont-ask + dont-update) + (View-process-renice-processes-in-pid-list nice-value + (cdr pid-list) + dont-ask + dont-update))) + +(defun View-process-renice-process-in-line (nice-value) + "Alter priority of to the process in the current line. +NICE-VALUE is the value, which will be added to the old nice value." + (interactive + (let* ((View-process-stop-motion-help t) + (nice-value (View-process-read-nice-value))) + (list nice-value))) + (if (and (>= (point) View-process-output-start) + (< (point) View-process-output-end)) + (View-process-renice-process + nice-value + (View-process-get-pid-from-current-line) + nil + t))) + +(defun View-process-renice-processes-g () + "Alter priority of processes. +It is a generic interface to `View-process-renice-processes-in-region' +and `View-process-renice-process-in-line'. The first will be called +if a region is active and the other one if not. If the region isn't +active, but marks are set, then the function is called on every +marked process." + (interactive) + (cond ((View-process-region-active-p) + (call-interactively 'View-process-renice-processes-in-region)) + (View-process-pid-mark-alist + (call-interactively 'View-process-renice-processes-with-mark)) + (t + (call-interactively 'View-process-renice-process-in-line)))) + + +;;; Returning field values + +(defun View-process-get-pid-from-current-line () + "Returns a string with the pid of the process in the current line." + (View-process-get-field-value-from-current-line + (View-process-translate-field-name-to-position View-process-pid-field-name) + View-process-max-fields) + ) + +(defun View-process-get-ppid-from-current-line () + "Returns a string with the ppid of the process in the current line." + (View-process-get-field-value-from-current-line + (View-process-translate-field-name-to-position View-process-ppid-field-name) + View-process-max-fields) + ) + +(defun View-process-get-pid-list-from-region (begin end) + "Returns a list with all PID's in the region from BEGIN to END." + (goto-char begin) + (if (>= (point) end) + nil + (cons (View-process-get-pid-from-current-line) + (progn (forward-line) + (View-process-get-pid-list-from-region (point) end))))) + +(defun View-process-get-pid-ppid-list-from-region (begin end) + "Returns a list with all PID's ant its PPID's in the region +from BEGIN to END. END must be greater than BEGIN." + (goto-char begin) + (if (>= (point) end) + nil + (cons (cons (View-process-get-pid-from-current-line) + (View-process-get-ppid-from-current-line)) + (progn (forward-line) + (View-process-get-pid-ppid-list-from-region (point) end))))) + +(defun View-process-get-field-value-from-current-line (field-no max-fields) + "Returns the value of the field FIELD-NO from the current line as string. +If the FIELD-NO is >= max-fields, then the rest of the line after the +start of the field FIELD-NO will be returned." + (save-excursion + (View-process-jump-to-field field-no max-fields) + (if (>= field-no max-fields) + (buffer-substring (point) (View-process-return-end-of-line)) + (current-word))) + ) + +(defun View-process-jump-to-field (field-no max-fields) + "Sets the point at the start of field FIELD-NO in the current line. +MAX_FIELDS is used instead of FIELD-NO, if FIELD-NO > MAX_FIELDS." + (View-process-replaces-blanks-in-fields-if-necessary) + (beginning-of-line) + (skip-chars-forward " ") + (if (< field-no 1) + (error "Parameter FIELD-NO must be >= 1")) + (if (> field-no max-fields) + (setq field-no max-fields)) + (if (= field-no 1) + (point) + (skip-chars-forward "^ ") + (skip-chars-forward " ") + (View-process-jump-to-field-1 (1- field-no)))) + +(defun View-process-jump-to-field-1 (field-no) + "Internal function of View-process-jump-to-field" + (if (= field-no 1) + (point) + (skip-chars-forward "^ ") + (skip-chars-forward " ") + (View-process-jump-to-field-1 (1- field-no)))) + + +(defun View-process-display-emacs-pid () + "Sets the point to the line with the emacs process." + (interactive) + (message (format "This emacs has the PID `%d'!" (emacs-pid)))) + + +;;; mouse functions + +(defun View-process-mouse-kill (event) + "Function for kill a process with the mouse." + (interactive "e") + (mouse-set-point event) + (View-process-send-signal-to-process-in-line "SIGTERM")) + + +;;; Highlighting functions + +(defun View-process-highlight-current-line (face) + "Highlights the current line with the FACE." + (let ((read-only buffer-read-only)) + (setq buffer-read-only nil) + (let ((extent (make-extent (View-process-return-beginning-of-line) + (View-process-return-end-of-line)))) + (set-extent-face extent face) + (setq buffer-read-only read-only) + extent) + )) + +(defun View-process-goto-line-with-pid (pid) + "Sets the point in the line with the PID. +It returns nil, if there is no line with the PID in the output." + (if (string= pid (View-process-get-pid-from-current-line)) + t + (goto-char View-process-output-start) + (while (and (< (point) View-process-output-end) + (not (string= pid (View-process-get-pid-from-current-line)))) + (forward-line)) + (< (point) View-process-output-end))) + +;(defun View-process-highlight-line-with-pid (pid face mark) +; "Highlights the line with the PID with the FACE and sets the MARK. +;It returns the extent of the line." +; (save-excursion +; (View-process-goto-line-with-pid pid) +; (View-process-set-mark-in-current-line mark) +; (View-process-save-pid-and-mark pid mark) +; (View-process-highlight-current-line face) +; )) + +;(defun View-process-delete-extent (extent) +; "Deletes the extent EXTENT." +; (let ((read-only buffer-read-only)) +; (save-excursion +; (goto-char (extent-start-position extent)) +; (View-process-set-mark-in-current-line View-process-no-mark) +; (setq buffer-read-only nil) +; (delete-extent extent) +; (setq buffer-read-only read-only)))) + +;;; mark functions + +(defun View-process-save-pid-and-mark (pid mark) + "Saves the PID and the MARK in a special alist. +The name of the alist is `View-process-pid-mark-alist'." + (if (assoc pid View-process-pid-mark-alist) + (setcdr (assoc pid View-process-pid-mark-alist) (list mark )) + (setq View-process-pid-mark-alist + (cons (list pid mark) View-process-pid-mark-alist)))) + +(defun View-process-remove-pid-and-mark-1 (pid pid-mark-alist) + "Internal function of `View-process-remove-pid-and-mark'." + (cond ((not pid-mark-alist) + nil) + ((string= pid (car (car pid-mark-alist))) + (View-process-remove-pid-and-mark-1 pid (cdr pid-mark-alist))) + (t + (cons (car pid-mark-alist) + (View-process-remove-pid-and-mark-1 pid (cdr pid-mark-alist))) + ))) + +(defun View-process-remove-pid-and-mark (pid) + "Removes the PID from the alist `View-process-pid-mark-alist'." + (setq View-process-pid-mark-alist + (View-process-remove-pid-and-mark-1 pid View-process-pid-mark-alist)) + ) + +(defun View-process-set-mark-in-current-line (mark) + "Sets the MARK at the start of the current line." + (let ((buffer-read-only nil)) + (save-excursion + (beginning-of-line) + (delete-char 1) + (insert mark)))) + +(defun View-process-mark-line-with-pid (pid &optional mark) + "Sets the MARK in the line with the PID. +It uses the 'View-process-single-line-mark', if mark is nil." +; (interactive "sPID: ") + (interactive (let ((View-process-stop-motion-help t)) + (list (read-string "PID: ")))) + (save-excursion + (View-process-goto-line-with-pid pid) + (View-process-set-mark-in-current-line (or mark + View-process-single-line-mark)) + (View-process-save-pid-and-mark pid + (or mark + View-process-single-line-mark)) + )) + +(defun View-process-mark-current-line (&optional mark) + "Sets a mark in the current line. +It uses the 'View-process-single-line-mark' if MARK is nil." + (interactive) + (if (or (< (point) View-process-output-start) + (> (point) View-process-output-end)) + (error "ERROR: Not in a process line!") + (View-process-set-mark-in-current-line (or mark + View-process-single-line-mark)) + (View-process-save-pid-and-mark (View-process-get-pid-from-current-line) + (or mark + View-process-single-line-mark)))) + + +(defun View-process-unmark-current-line () + "Unsets a mark in the current line." + (interactive) + (if (and (>= (point) View-process-output-start) + (<= (point) View-process-output-end)) + (progn + (View-process-remove-pid-and-mark + (View-process-get-pid-from-current-line)) + (View-process-set-mark-in-current-line View-process-no-mark) + ) + (error "ERROR: Not in a process line!"))) + +(defun View-process-mark-process-tree (process-tree) + "Marks all processes in the list process-tree." + (cond ((not process-tree)) + ((listp (car process-tree)) + (View-process-mark-process-tree (car process-tree)) + (View-process-mark-process-tree (cdr process-tree))) + ((stringp (car process-tree)) + (View-process-mark-line-with-pid (car process-tree) + View-process-child-line-mark) + (View-process-mark-process-tree (cdr process-tree))) + (t (error "Bug in 'View-process-mark-process-tree' !")))) + +(defun View-process-mark-childs (pid) + "Marks all childs of the process with the PID." +; (interactive "sParent PID: ") + (interactive (let ((View-process-stop-motion-help t)) + (list (read-string "Parent PID: ")))) + (if (not + (View-process-field-name-exists-p View-process-ppid-field-name)) + (error "ERROR: No field `%s' in the output. Try `M-x ps -j' to get it." + View-process-ppid-field-name) + (View-process-mark-line-with-pid pid View-process-parent-line-mark) + (View-process-mark-process-tree + (cdr (View-process-get-child-process-tree pid))))) + +(defun View-process-mark-childs-in-current-line () + "Marks all the child processes of the process in the current line." + (interactive) + (View-process-mark-childs + (View-process-get-pid-from-current-line))) + +(defun View-process-call-function-on-pid-and-mark-list (function + pid-mark-alist + &optional + not-interactive + &rest + non-interactive-args) + "Calls the FUNCTION on every process in the PID-MARK-ALIST. +FUNCTION must be an interactive function, which works on the +process in the current line, if INTERACTIVE is nil. +If INTERACTIVE is t, then the function will be called non interactive +with the NON-INTERACTIVE-ARGS." + (cond ((not pid-mark-alist)) + ((View-process-goto-line-with-pid (car (car pid-mark-alist))) + (if not-interactive + (eval (cons function non-interactive-args)) + (call-interactively function)) + (eval (append (list 'View-process-call-function-on-pid-and-mark-list + 'function + '(cdr pid-mark-alist) + 'not-interactive) + non-interactive-args))) + (t + (eval (append (list 'View-process-call-function-on-pid-and-mark-list + 'function + '(cdr pid-mark-alist) + 'not-interactive) + non-interactive-args))) + )) + +(defun View-process-set-marks-from-pid-mark-alist (pid-mark-alist) + "Sets the marks of the PID-MARK-ALIST to the pids of the PID-MARK-ALIST." + (cond ((not pid-mark-alist)) + ((View-process-goto-line-with-pid (car (car pid-mark-alist))) + (View-process-mark-current-line (car (cdr (car pid-mark-alist)))) + (View-process-set-marks-from-pid-mark-alist (cdr pid-mark-alist))) + (t + (View-process-set-marks-from-pid-mark-alist (cdr pid-mark-alist))))) + +(defun View-process-reset-last-marks () + "Resets the last marks." + (interactive) + (View-process-set-marks-from-pid-mark-alist View-process-last-pid-mark-alist) + ) + +(defun View-process-unmark-all () + "Unmarks all processes." + (interactive) + (View-process-call-function-on-pid-and-mark-list + 'View-process-unmark-current-line + View-process-pid-mark-alist + t)) + + +;;; commands to moving around in a ps buffer + +(defun View-process-output-start () + "Set point to the first field after the output start." + (interactive) + (goto-char View-process-output-start) + (skip-chars-forward " ")) + +(defun View-process-output-end () + "Set point to the first field before the output end." + (interactive) + (goto-char View-process-output-end) + (skip-chars-backward " ") + (skip-chars-backward "^ ")) + +(defun View-process-next-field () + "Moves forward one field." + (interactive) + (if (< (point) View-process-output-start) + (View-process-output-start) + (skip-chars-forward " ") + (if (< (point) View-process-output-end) + (if (= View-process-max-fields (View-process-current-field-number)) + (progn + (forward-line) + (skip-chars-forward " ") + (if (>= (point) View-process-output-end) + (progn + (goto-char View-process-output-start) + (skip-chars-forward " ")))) + (skip-chars-forward "^ ") + (skip-chars-forward " ") + ) + (goto-char View-process-output-start) + (skip-chars-forward " ")))) + +(defun View-process-previous-field () + "Moves backward one field." + (interactive) + (skip-chars-backward " ") + (backward-char) + (if (> (point) View-process-output-start) + (if (= View-process-max-fields (View-process-current-field-number)) + (View-process-jump-to-field View-process-max-fields + View-process-max-fields) + (skip-chars-backward "^ \n") + (if (< (point) View-process-output-start) + (progn + (goto-char View-process-output-end) + (forward-line -1) + (View-process-jump-to-field View-process-max-fields + View-process-max-fields)))) + (goto-char View-process-output-end) + (forward-line -1) + (View-process-jump-to-field View-process-max-fields + View-process-max-fields))) + +(defun View-process-goto-first-field-next-line () + "Set point to the first field in the next line." + (interactive) + (if (< (point) View-process-output-start) + (View-process-output-start) + (forward-line) + (if (>= (point) View-process-output-end) + (View-process-output-start) + (View-process-jump-to-field 1 View-process-max-fields)))) + + +;;; buffer renaming + +(defun View-process-rename-current-output-buffer (new-buffer-name) + "Renames the ps output buffer to NEW-BUFFER-NAME." + (interactive + (let ((View-process-stop-motion-help t)) + (list + (read-string "New PS output buffer name: " + (generate-new-buffer-name + (concat "*ps-" + (or View-process-remote-host + (getenv "HOSTNAME")) + "*")))))) + (if (not (string= mode-name View-process-mode-name)) + (error "ERROR: Not in a View-process-mode buffer!") + (if (get-buffer new-buffer-name) + (error "ERROR: Buffer %s exists!" new-buffer-name) + (rename-buffer new-buffer-name) + (setq View-process-buffer-name new-buffer-name) + (if (or View-process-display-with-2-windows + (get-buffer View-process-header-buffer-name)) + (let ((new-header-buffer-name + (generate-new-buffer-name + (concat (substring new-buffer-name 0 -1) + " header*"))) + (buffer (current-buffer))) + (set-buffer View-process-header-buffer-name) + (rename-buffer new-header-buffer-name) + (set-buffer buffer) + (setq View-process-header-buffer-name new-header-buffer-name)) + )))) + +;;; For newer versions of field.el +(if (not (fboundp 'sort-float-fields)) + (defalias 'sort-float-fields 'sort-numeric-fields)) + + +;;; Display Functions + +(defun View-process-header-mode () + "The mode of the buffer with the view process header." + (set-syntax-table View-process-mode-syntax-table) + (setq major-mode 'View-process-header-mode + mode-name View-process-header-mode-name) + (setq truncate-lines View-process-truncate-lines) +; (setq buffer-modeline (not View-process-header-mode-line-off)) + (view-process-switch-buffer-modeline (not View-process-header-mode-line-off)) + (run-hooks 'View-process-header-mode-hook) + ) + +(defun View-process-top-window-p (&optional window) + "Returns t, if the WINDOW is the top one. +If WINDOW is nil, then the current window is tested." + (eq 0 (car (cdr (window-pixel-edges window))))) + +(defun View-process-change-display-type (display-with-2-windows) + "If DISPLAY-WITH-2-WINDOWS is non nil, then a 2 windows display is used." + (if display-with-2-windows + (let ((window-size View-process-ps-header-window-size)) + (cond ((eq (count-windows 'NO-MINI) 1) + ;; split window + (split-window nil window-size) + (select-window (next-window nil 'no-minibuf)) + ) + ((= (count-windows 'NO-MINI) 2) + (if (View-process-top-window-p) + (progn + ;; delete other windows + (delete-other-windows) + ;; split window + (split-window nil window-size)) + (select-window (next-window nil 'no-minibuf)) +; (shrink-window (- (window-height) window-size)) + ) + (select-window (next-window nil 'no-minibuf)) + ) + ((> (count-windows 'NO-MINI) 2) + ;; delete other windows + (delete-other-windows) + ;; split window + (split-window nil window-size) + (select-window (next-window nil 'no-minibuf)) + )) + ;; copy header lines + (let ((header-lines (buffer-substring (point-min) + View-process-header-end)) + (buffer (get-buffer-create View-process-header-buffer-name))) + (select-window (next-window nil 'no-minibuf)) + ;; load *ps-header* buffer in window + (set-window-buffer (get-buffer-window (current-buffer)) buffer) + (setq buffer-read-only nil) + (erase-buffer) + ;; insert header lines + (insert header-lines) + (setq buffer-read-only t) + (goto-char (point-min)) + (View-process-header-mode) + (if (not (= (window-height) window-size)) + (shrink-window (- (window-height) window-size))) + (select-window (next-window nil 'no-minibuf)) + )) + (let ((header-buffer (get-buffer View-process-header-buffer-name))) + (if header-buffer + (progn + (if (get-buffer-window header-buffer) + (delete-window (get-buffer-window header-buffer))) + (kill-buffer header-buffer)))))) + +(defun View-process-toggle-display-with-2-windows (&optional arg) + "Change whether the view process output is displayed with two windows. +With ARG, set `View-process-display-with-2-windows' to t, if ARG is +positive. ARG is a prefix arg." + (interactive "P") + (if arg + (if (>= (prefix-numeric-value arg) 0) + (setq View-process-display-with-2-windows t) + (setq View-process-display-with-2-windows nil)) + (if View-process-display-with-2-windows + (setq View-process-display-with-2-windows nil) + (setq View-process-display-with-2-windows t))) + (View-process-change-display-type View-process-display-with-2-windows) + (if View-process-display-with-2-windows + (View-process-toggle-hide-header '(1)) + (View-process-toggle-hide-header '(-1)))) + +(defun View-process-save-old-window-configuration () + "Saves the window configuration before the first call of view process." + (if (not View-process-old-window-configuration) + (setq View-process-old-window-configuration + (current-window-configuration)) + )) + +(defun View-process-hide-header (hide-header) + "Hides the header lines in the view processes buffer, if HIDE-HEADER is t." + (if hide-header + (if (<= View-process-output-start (point-max)) + (narrow-to-region View-process-output-start (point-max)) + (narrow-to-region (point-max) (point-max))) + (widen))) + +(defun View-process-toggle-hide-header (&optional arg) + "Change whether the header are hided. +With ARG, set `View-process-hide-header' to t, if ARG is positive. +ARG is a prefix arg." + (interactive "P") + (if arg + (if (>= (prefix-numeric-value arg) 0) + (setq View-process-hide-header t) + (setq View-process-hide-header nil)) + (if View-process-hide-header + (setq View-process-hide-header nil) + (setq View-process-hide-header t))) + (View-process-hide-header View-process-hide-header)) + +;;; Misc. commands + +(defun View-process-quit () + "Kills the *ps* buffer." + (interactive) + (if (y-or-n-p + "Do you want really want to quit the view process mode? ") + (progn + (if (get-buffer View-process-buffer-name) + (kill-buffer View-process-buffer-name)) + (if (or View-process-display-with-2-windows + (get-buffer View-process-header-buffer-name)) + (kill-buffer View-process-header-buffer-name)) + (set-window-configuration View-process-old-window-configuration) + (setq View-process-old-window-configuration nil) + ))) + +(defun View-process-submit-bug-report () + "Submit via mail a bug report on View-process-mode." + (interactive) + (require 'reporter) + (let ((bsd-or-system-v (View-process-bsd-or-system-v))) + (reporter-submit-bug-report + View-process-package-maintainer + (concat View-process-package-name " " View-process-package-version) + (list 'emacs-version + 'major-mode + 'View-process-buffer-name + 'View-process-header-buffer-name + 'View-process-sorter-and-filter + 'View-process-actual-sorter-and-filter + 'View-process-display-with-2-windows + 'View-process-hide-header + 'View-process-truncate-lines + 'View-process-motion-help + 'View-process-old-window-configuration + 'View-process-field-names + 'View-process-max-fields + 'View-process-output-start + 'View-process-output-end + 'View-process-header-start + 'View-process-header-end + 'View-process-host-names-and-system-types + 'View-process-remote-host + 'View-process-system-type + 'bsd-or-system-v + 'View-process-rsh-command + 'View-process-signal-command + 'View-process-status-command-switches-bsd + 'View-process-status-command-switches-system-v + 'View-process-status-last-command-switches + 'View-process-status-command + 'View-process-test-command + 'View-process-test-switches + 'View-process-uname-command + 'View-process-uname-switches + ) + nil + nil + (concat + "If it is possible, you should send this bug report from the buffer\n" + "with the view process mode. Please answer the following questions.\n" + "Which is the name of your system? \n" + "Is your system a BSD Unix? \n" + "Is your system a System V Unix? \n" + "Describe your bug: " + )))) + +(defun View-process-display-version () + "Displays the current version of the mode." + (interactive) + (message "View Process Mode, %s, Author: Heiko Münkel." + View-process-package-version)) + +(defun View-process-toggle-truncate-lines (&optional arg) + "Change whether the lines in this buffer are truncated. +With ARG, set `truncate-lines' to t, if ARG is positive. +ARG is a prefix arg. +It saves also the state of `truncate-lines' for the next +view process command in `View-process-truncate-lines'. +It truncates also the lines in the view process header buffer, +if it is run in a view process mode buffer." + (interactive "P") + (if arg + (if (>= (prefix-numeric-value arg) 0) + (setq truncate-lines t) + (setq truncate-lines nil)) + (if truncate-lines + (setq truncate-lines nil) + (setq truncate-lines t))) + (setq View-process-truncate-lines truncate-lines) + (setq-default View-process-truncate-lines truncate-lines) + (if (and (eq major-mode 'View-process-mode) + (or View-process-display-with-2-windows + (get-buffer View-process-header-buffer-name))) + (let ((buffer (current-buffer)) + (truncate truncate-lines)) + (set-buffer View-process-header-buffer-name) + (setq truncate-lines truncate) + (set-buffer buffer)))) + +(defun View-process-return-beginning-of-line () + "Returns the beginning of the current line. +The point isn't changed." + (save-excursion + (beginning-of-line) + (point))) + +(defun View-process-return-end-of-line () + "Returns the end of the current line. +The point isn't changed." + (save-excursion + (end-of-line) + (point))) + +(defun View-process-assoc-2th (key list) + "Return non-nil if KEY is `equal' to the 2th of an element of LIST. +The value is actually the element of LIST whose 2th is KEY." + (cond ((not list) nil) + ((equal (car (cdr (car list))) key) (car list)) + (t (View-process-assoc-2th key (cdr list))))) + + +(defun View-process-replace-in-string (from-string + to-string + in-string + &optional start) + "Replace FROM-STRING with TO-STRING in IN-STRING. +The optional argument START set the start position > 0. +FROM-STRING is a regular expression." + (setq start (or start 0)) + (let ((start-of-from-string (string-match from-string in-string start))) + (if start-of-from-string + (concat (substring in-string start start-of-from-string) + to-string + (View-process-replace-in-string from-string + to-string + in-string + (match-end 0))) + (substring in-string start)))) + + +(defun View-process-toggle-digit-bindings (&optional arg) + "Change whether the digit keys sends signals to the processes. + With ARG, set `View-process-digit-bindings-send-signal' to t, +if ARG is positive. ARG is a prefix arg." + (interactive "P") + (if arg + (if (>= (prefix-numeric-value arg) 0) + (setq View-process-digit-bindings-send-signal t) + (setq View-process-digit-bindings-send-signal nil)) + (if View-process-digit-bindings-send-signal + (setq View-process-digit-bindings-send-signal nil) + (setq View-process-digit-bindings-send-signal t))) + (if View-process-digit-bindings-send-signal + (progn + (define-key View-process-mode-map "0" + 'undefined) + (define-key View-process-mode-map "1" + 'View-process-send-key-as-signal-to-processes) + (define-key View-process-mode-map "2" + 'View-process-send-key-as-signal-to-processes) + (define-key View-process-mode-map "3" + 'View-process-send-key-as-signal-to-processes) + (define-key View-process-mode-map "4" + 'View-process-send-key-as-signal-to-processes) + (define-key View-process-mode-map "5" + 'View-process-send-key-as-signal-to-processes) + (define-key View-process-mode-map "6" + 'View-process-send-key-as-signal-to-processes) + (define-key View-process-mode-map "7" + 'View-process-send-key-as-signal-to-processes) + (define-key View-process-mode-map "8" + 'View-process-send-key-as-signal-to-processes) + (define-key View-process-mode-map "9" + 'View-process-send-key-as-signal-to-processes) + ) + (define-key View-process-mode-map "0" + 'digit-argument) + (define-key View-process-mode-map "1" + 'digit-argument) + (define-key View-process-mode-map "2" + 'digit-argument) + (define-key View-process-mode-map "3" + 'digit-argument) + (define-key View-process-mode-map "4" + 'digit-argument) + (define-key View-process-mode-map "5" + 'digit-argument) + (define-key View-process-mode-map "6" + 'digit-argument) + (define-key View-process-mode-map "7" + 'digit-argument) + (define-key View-process-mode-map "8" + 'digit-argument) + (define-key View-process-mode-map "9" + 'digit-argument) + )) + +(if View-process-digit-bindings-send-signal + (View-process-toggle-digit-bindings 1) + (View-process-toggle-digit-bindings -1)) + +(defun View-process-revert-buffer (&optional ignore-auto noconfirm) + "Updates the view-process buffer with `View-process-status-update'." + (View-process-status-update)) + + +;;; Emacs version specific stuff + +(if (View-process-xemacs-p) + (require 'view-process-xemacs) + (require 'view-process-emacs-19)) + + +;;; face setting + +(if (facep 'View-process-child-line-face) + nil + (make-face 'View-process-child-line-face) + (if (View-process-search-color View-process-child-line-foreground) + (set-face-foreground 'View-process-child-line-face + (View-process-search-color + View-process-child-line-foreground))) + (if (View-process-search-color View-process-child-line-background) + (set-face-background 'View-process-child-line-face + (View-process-search-color + View-process-child-line-background))) + (set-face-font 'View-process-child-line-face + View-process-child-line-font) + (set-face-underline-p 'View-process-child-line-face + View-process-child-line-underline-p)) + +(if (facep 'View-process-parent-line-face) + nil + (make-face 'View-process-parent-line-face) + (if (View-process-search-color View-process-parent-line-foreground) + (set-face-foreground 'View-process-parent-line-face + (View-process-search-color + View-process-parent-line-foreground))) + (if (View-process-search-color View-process-parent-line-background) + (set-face-background 'View-process-parent-line-face + (View-process-search-color + View-process-parent-line-background))) + (set-face-font 'View-process-parent-line-face + View-process-parent-line-font) + (set-face-underline-p 'View-process-parent-line-face + View-process-parent-line-underline-p)) + +(if (facep 'View-process-single-line-face) + nil + (make-face 'View-process-single-line-face) + (if (View-process-search-color View-process-single-line-foreground) + (set-face-foreground 'View-process-single-line-face + (View-process-search-color + View-process-single-line-foreground))) + (if (View-process-search-color View-process-single-line-background) + (set-face-background 'View-process-single-line-face + (View-process-search-color + View-process-single-line-background))) + (set-face-font 'View-process-single-line-face + View-process-single-line-font) + (set-face-underline-p 'View-process-single-line-face + View-process-single-line-underline-p)) + +(if (facep 'View-process-signaled-line-face) + nil + (make-face 'View-process-signaled-line-face) + (if (View-process-search-color View-process-signaled-line-foreground) + (set-face-foreground 'View-process-signaled-line-face + (View-process-search-color + View-process-signaled-line-foreground))) + (if (View-process-search-color View-process-signaled-line-background) + (set-face-background 'View-process-signaled-line-face + (View-process-search-color + View-process-signaled-line-background))) + (set-face-font 'View-process-signaled-line-face + View-process-signaled-line-font) + (set-face-underline-p 'View-process-signaled-line-face + View-process-signaled-line-underline-p)) + +(if (facep 'View-process-signal-line-face) + nil + (make-face 'View-process-signal-line-face) + (if (View-process-search-color View-process-signal-line-foreground) + (set-face-foreground 'View-process-signal-line-face + (View-process-search-color + View-process-signal-line-foreground))) + (if (View-process-search-color View-process-signal-line-background) + (set-face-background 'View-process-signal-line-face + (View-process-search-color + View-process-signal-line-background))) + (set-face-font 'View-process-signal-line-face + View-process-signal-line-font) + (set-face-underline-p 'View-process-signal-line-face + View-process-signal-line-underline-p)) + +(if (facep 'View-process-renice-line-face) + nil + (make-face 'View-process-renice-line-face) + (if (View-process-search-color View-process-renice-line-foreground) + (set-face-foreground 'View-process-renice-line-face + (View-process-search-color + View-process-renice-line-foreground))) + (if (View-process-search-color View-process-renice-line-background) + (set-face-background 'View-process-renice-line-face + (View-process-search-color + View-process-renice-line-background))) + (set-face-font 'View-process-renice-line-face + View-process-renice-line-font) + (set-face-underline-p 'View-process-renice-line-face + View-process-renice-line-underline-p)) + +(if (facep 'View-process-header-line-face) + nil + (make-face 'View-process-header-line-face) + (if (View-process-search-color View-process-header-line-foreground) + (set-face-foreground 'View-process-header-line-face + (View-process-search-color + View-process-header-line-foreground))) + (if (View-process-search-color View-process-header-line-background) + (set-face-background 'View-process-header-line-face + (View-process-search-color + View-process-header-line-background))) + (set-face-font 'View-process-header-line-face + View-process-header-line-font) + (set-face-underline-p 'View-process-header-line-face + View-process-header-line-underline-p)) + +(defun View-process-highlight-header-line () + "Highlights the headerline with the face `View-process-header-line-face'." + (let ((extent + (make-extent View-process-header-start View-process-header-end) + )) + (set-extent-face extent 'View-process-header-line-face) + (set-extent-property extent 'duplicable t)) + ) + +;;; A short cut for the View-process-status command + +(defalias 'ps 'View-process-status) + +;;; view-process-mode.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/modes/view-process-system-specific.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,373 @@ +;;; view-process-system-specific.el --- System specific stuff for view-process + +;; Copyright (C) 1995 Heiko Muenkel + +;; Author: Heiko Muenkel <muenkel@tnt.uni-hannover.de> +;; Keywords: processes + +;; This file is part of XEmacs. + +;;; $Id: view-process-system-specific.el,v 1.2 1997/06/26 02:31:06 steve Exp $ + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. if not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Emacs 20.1. + +;;; Commentary: + +;; This file contains system specific stuff for the +;; view-process-mode. It isn't necessary, that each systems has +;; an entry in this file, because there are default values, which +;; are used, if no entry exists. + +;; Installation: +;; +;; Put this file in one of you lisp load path directories. +;; + +;;; Code: + +(provide 'view-process-system-specific) + +(defvar View-process-specific-system-list + '(("linux" nil "bsd" + nil + View-process-kill-signals-linux) + ("sunos" "4" "bsd" + View-process-field-name-descriptions-sunos4 + View-process-kill-signals-sunos4) + ("sunos" "5" "system-v" + View-process-field-name-descriptions-sunos5 + View-process-kill-signals-sunos5) + ("irix" nil "system-v" + View-process-field-name-descriptions-irix + View-process-kill-signals-irix) + ("hp-ux" nil "system-v" + View-process-field-name-descriptions-hpux + View-process-kill-signals-hpux) + ) + "This is a list with all systems, for which specific information about +allowed signals and about the ps output exists. Set it to nil, if you don't +want to use this specific information. +The first string of each sublist is the name of the system, the second +string is the mayor version number or nil. The third one determines, +if the ps command is BSD or System V like. The mayor version is only +necessary, if there are BSD and System V versions with the same system +names (SUN has done such a stupid system naming.), otherwise it is nil. +The fifth entry is nil or the name of a special list with field name +descriptions. The sixth entry is nil or the name of a special list with +kill signals.") + +;;; signals + +(defvar View-process-kill-signals-bsd nil + "An alist with the possible signals for the kill command for BSD +systems. It is only used, if the system type can't be determined or if +it is not in the `View-process-specific-system-list'.") + +(defvar View-process-kill-signals-system-v nil + "An alist with the possible signals for the kill command for BSD +systems. It is only used, if the system type can't be determined or if +it is not in the `View-process-specific-system-list'.") + +(defvar View-process-kill-signals-sunos4 + '(("SIGHUP" "1") ("SIGINT" "2") ("SIGQUIT" "3") ("SIGILL" "4") + ("SIGTRAP" "5") ("SIGIOT" "6") ("SIGABRT" "6") ("SIGEMT" "7") + ("SIGFPE" "8") ("SIGKILL" "9") ("SIGBUS" "10") ("SIGSEGV" "11") + ("SIGSYS" "12") ("SIGPIPE" "13") ("SIGALRM" "14") ("SIGTERM" "15") + ("SIGURG" "16") ("SIGSTOP" "17") ("SIGTSTP" "18") ("SIGCONT" "19") + ("SIGCHLD" "20") ("SIGCLD" "20") ("SIGTTIN" "21") ("SIGTTOU" "22") + ("SIGIO" "23") ("SIGPOLL" "23") ("SIGXCPU" "24") ("SIGXFSZ" "25") + ("SIGVTALRM" "26") ("SIGPROF" "27") ("SIGWINCH" "28") + ("SIGLOST" "29") ("SIGUSR1" "30") ("SIGUSR2" "31") + ("1" "1") ("2" "2") ("3" "3") ("4" "4") ("5" "5") ("6" "6") ("7" "7") + ("8" "8") ("9" "9") ("10" "10") ("11" "11") ("12" "12") ("13" "13") + ("14" "14") ("15" "15") ("16" "16") ("17" "17") ("18" "18") + ("19" "19") ("20" "20") ("21" "21") ("22" "22") ("23" "23") + ("24" "24") ("25" "25") ("26" "26") ("27" "27") ("28" "28") + ("29" "29") ("30" "30") ("31" "31")) + "An alist with the possible signals for the kill command for SunOS 4. +It may be that you've other signals on your system. Try to test +it with \"kill -l\" in a shell.") + +(defvar View-process-kill-signals-sunos5 + '(("SIGHUP" "1") ("SIGINT" "2") ("SIGQUIT" "3") ("SIGILL" "4") + ("SIGTRAP" "5") ("SIGIOT" "6") ("SIGABRT" "6") ("SIGEMT" "7") + ("SIGFPE" "8") ("SIGKILL" "9") ("SIGBUS" "10") ("SIGSEGV" "11") + ("SIGSYS" "12") ("SIGPIPE" "13") ("SIGALRM" "14") ("SIGTERM" "15") + ("SIGUSR1" "16") ("SIGUSR2" "17") ("SIGCHLD" "18") ("SIGCLD" "18") + ("SIGPWR" "19") ("SIGWINCH" "20") ("SIGURG" "21") ("SIGPOLL" "22") + ("SIGIO" "22") ("SIGSTOP" "23") ("SIGTSTP" "24") ("SIGCONT" "25") + ("SIGTTIN" "26") ("SIGTTOU" "27") ("SIGVTALRM" "28") ("SIGPROF" "29") + ("SIGXCPU" "30") ("SIGXFSZ" "31") ("SIGWAITING" "32") ("SIGLWP" "33") + ("SIGFREEZE" "34") ("SIGTHAW" "36") ("SIGRTMIN" "36") ("SIGRTMAX" "43") + ("1" "1") ("2" "2") ("3" "3") ("4" "4") ("5" "5") ("6" "6") ("7" "7") + ("8" "8") ("9" "9") ("10" "10") ("11" "11") ("12" "12") ("13" "13") + ("14" "14") ("15" "15") ("16" "16") ("17" "17") ("18" "18") + ("19" "19") ("20" "20") ("21" "21") ("22" "22") ("23" "23") + ("24" "24") ("25" "25") ("26" "26") ("27" "27") ("28" "28") + ("29" "29") ("30" "30") ("31" "31") ("32" "32") ("33" "33") + ("34" "34") ("36" "36") ("43" "43")) + "An alist with the possible signals for the kill command for SunOS 5. +It may be that you've other signals on your system. Try to test +it with \"kill -l\" in a shell.") + +(defvar View-process-kill-signals-irix + '(("SIGHUP" "1") ("SIGINT" "2") ("SIGQUIT" "3") ("SIGILL" "4") + ("SIGTRAP" "5") ("SIGIOT" "6") ("SIGABRT" "6") ("SIGEMT" "7") + ("SIGFPE" "8") ("SIGKILL" "9") ("SIGBUS" "10") ("SIGSEGV" "11") + ("SIGSYS" "12") ("SIGPIPE" "13") ("SIGALRM" "14") ("SIGTERM" "15") + ("SIGUSR1" "16") ("SIGUSR2" "17") ("SIGCLD" "18") ("SIGCHLD" "18") + ("SIGPWR" "19") ("SIGWINCH" "20") ("SIGURG" "21") ("SIGPOLL" "22") + ("SIGIO" "22") ("SIGSTOP" "23") ("SIGTSTP" "24") ("SIGCONT" "25") + ("SIGTTIN" "26") ("SIGTTOU" "27") ("SIGVTALRM" "28") ("SIGPROF" "29") + ("SIGXCPU" "30") ("SIGXFSZ" "31") ("SIG32" "32") + ("1" "1") ("2" "2") ("3" "3") ("4" "4") ("5" "5") ("6" "6") ("7" "7") + ("8" "8") ("9" "9") ("10" "10") ("11" "11") ("12" "12") ("13" "13") + ("14" "14") ("15" "15") ("16" "16") ("17" "17") ("18" "18") + ("19" "19") ("20" "20") ("21" "21") ("22" "22") ("23" "23") + ("24" "24") ("25" "25") ("26" "26") ("27" "27") ("28" "28") + ("29" "29") ("30" "30") ("31" "31") ("32" "32")) + "An alist with the possible signals for the kill command for IRIX. +It may be that you've other signals on your system. Try to test +it with \"kill -l\" in a shell.") + +(defvar View-process-kill-signals-linux + '(("SIGHUP" "1") ("SIGINT" "2") ("SIGQUIT" "3") ("SIGILL" "4") + ("SIGTRAP" "5") ("SIGIOT" "6") ("SIGBUS" "7") ("SIGFPE" "8") + ("SIGKILL" "9") ("SIGUSR1" "10") ("SIGSEGV" "11") ("SIGUSR2" "12") + ("SIGPIPE" "13") ("SIGALRM" "14") ("SIGTERM" "15") ("SIGCHLD" "17") + ("SIGCONT" "18") ("SIGSTOP" "19") ("SIGTSTP" "20") ("SIGTTIN" "21") + ("SIGTTOU" "22") ("SIGIO" "23") ("SIGXCPU" "24") ("SIGXFSZ" "25") + ("SIGVTALRM" "26") ("SIGPROF" "27") ("SIGWINCH" "28") ("SIGPWR" "30") + ("1" "1") ("2" "2") ("3" "3") ("4" "4") ("5" "5") ("6" "6") ("7" "7") + ("8" "8") ("9" "9") ("10" "10") ("11" "11") ("12" "12") ("13" "13") + ("14" "14") ("15" "15") ("17" "17") ("18" "18") ("19" "19") + ("20" "20") ("21" "21") ("22" "22") ("23" "23") ("24" "24") + ("25" "25") ("26" "26") ("27" "27") ("28" "28") ("30" "30")) + "An alist with the possible signals for the kill command for linux. +It may be that you've other signals on your system. Try to test +it with \"kill -l\" in a shell.") + +;; all Linux signals +;(defvar View-process-kill-signals +; '(("SIGHUP" "1") ("SIGINT" "2") ("SIGQUIT" "3") ("SIGILL" "4") +; ("SIGTRAP" "5") ("SIGIOT" "6") ("SIGBUS" "7") ("SIGFPE" "8") +; ("SIGKILL" "9") ("SIGUSR1" "10") ("SIGSEGV" "11") ("SIGUSR2" "12") +; ("SIGPIPE" "13") ("SIGALRM" "14") ("SIGTERM" "15") ("SIGCHLD" "17") +; ("SIGCONT" "18") ("SIGSTOP" "19") ("SIGTSTP" "20") ("SIGTTIN" "21") +; ("SIGTTOU" "22") ("SIGIO" "23") ("SIGXCPU" "24") ("SIGXFSZ" "25") +; ("SIGVTALRM" "26") ("SIGPROF" "27") ("SIGWINCH" "28") ("SIGPWR" "30") +; ("1" "1") ("2" "2") ("3" "3") ("4" "4") ("5" "5") ("6" "6") ("7" "7") +; ("8" "8") ("9" "9") ("10" "10") ("11" "11") ("12" "12") ("13" "13") +; ("14" "14") ("15" "15") ("17" "17") ("18" "18") ("19" "19") +; ("20" "20") ("21" "21") ("22" "22") ("23" "23") ("24" "24") +; ("25" "25") ("26" "26") ("27" "27") ("28" "28") ("30" "30")) +; "An alist with the possible signals for the kill command. +;It may be that you've other signals on your system. Try to test +;it with \"kill -l\" in a shell.") + +(defvar View-process-kill-signals-hpux + '(("SIGHUP" "1") ("SIGINT" "2") ("SIGQUIT" "3") ("SIGILL" "4") + ("SIGTRAP" "5") ("SIGIOT" "6") ("SIGABRT" "6") ("SIGEMT" "7") + ("SIGFPE" "8") ("SIGKILL" "9") ("SIGBUS" "10") ("SIGSEGV" "11") + ("SIGSYS" "12") ("SIGPIPE" "13") ("SIGALRM" "14") ("SIGTERM" "15") + ("SIGUSR1" "16") ("SIGUSR2" "17") ("SIGCLD" "18") ("SIGCHLD" "18") + ("SIGPWR" "19") ("SIGVTALRM" "20") ("SIGPROF" "21") ("SIGIO" "22") + ("SIGWINCH" "23") ("SIGSTOP" "24") ("SIGTSTP" "25") ("SIGCONT" "26") + ("SIGTTIN" "27") ("SIGTTOU" "28") ("SIGURG" "29") ("SIGLOST" "30") + ("1" "1") ("2" "2") ("3" "3") ("4" "4") ("5" "5") ("6" "6") ("7" "7") + ("8" "8") ("9" "9") ("10" "10") ("11" "11") ("12" "12") ("13" "13") + ("14" "14") ("15" "15") ("16" "16") ("17" "17") ("18" "18") + ("19" "19") ("20" "20") ("21" "21") ("22" "22") ("23" "23") + ("24" "24") ("25" "25") ("26" "26") ("27" "27") ("28" "28") + ("29" "29") ("30" "30") ("31" "31") ("32" "32")) + "An alist with the possible signals for the kill command for HP-UX. +It may be that you've other signals on your system. Try to test +it with \"kill -l\" in a shell.") + +;;; process field descriptions + +;; more general descriptions for BSD and System V + +(defvar View-process-field-name-descriptions-bsd + '( + ("CP" "Short-term CPU utilization factor (used in scheduling). ") + ("F" "Flags (in hex) associated with process as in <sys/proc.h>. ") + ("LIM" ("Soft limit on memory used. " + ("xx" "xx=no limit. "))) + ("RE" "Residency time (seconds in core)") + ("SIZE" "Virtual image size, size data+stack (in KByte).") + ("SL" "Sleep time of the process (seconds blocked).") + ("STAT" ("Status. " + ("R" "R=runnable. ") + ("S" "S=sleeping < 20s. ") + ("D" "D=un-interruptible wait (eg disk or NFS I/O). ") + ("T" "T=stopped. ") + ("Z" "Z=zombie (terminated). ") + ("W" "W=Swapped out. ") + ("I" "I=idle, sleeping > 20s. ") + ("P" "P=Page Wait." ) + ("N" "N=started with nice. ") + (">" ">=exceeded memory limit. ") + ("SW" "S=sleeping. W=waiting on an event. ") + ("IW" "I=intermediate status. W=waiting on an event. "))) + ("SZ" "Virtual image size, size data+stack (in KByte). ") + ("WCHAN" "Event on which process is waiting. ") + ) + "Help list with the descriptions of ps fields for BSD systems.") + +(defvar View-process-field-name-descriptions-system-v + '( + ("C" "Processor utilization for scheduling. ") + ("CLS" "Scheduling class. ") + ("F" "Flags (in hex) No meaning should be currently ascribed to them. ") + ("PRI" "Priority, without -c: no > => prio <, with -c: no > => prio > .") + ("S" ("State. " + ("O" "O=Process is running on a processor. ") + ("S" "S=Sleeping, process is waiting for an event. ") + ("R" "R=Runnable, process is on run queue. ") + ("I" "I=Idle, process is being created. ") + ("Z" "Z=Zombie state, process terminated and parent not waiting. ") + ("T" "T=Traced, process stopped by a signal, parent is tracing it. ") + ("X" "X=SXBRK state: process is waiting for more primary memory. ") + )) + ("STIME" "Start time. ") + ("SZ" "Size (in Pages) of the swappable process's image in main memory. ") + ("WCHAN" "Event on which process is waiting or in SXBRK state. ") + ) + "Help list with the descriptions of ps fields for System V.") + +;; for specifc systems + +(defvar View-process-field-name-descriptions-sunos4 + '( + ("CP" "Short-term CPU utilization factor (used in scheduling). ") + ("F" "Flags (in hex) associated with process as in <sys/proc.h>. ") + ("LIM" ("Soft limit on memory used. " + ("xx" "xx=no limit. "))) + ("RE" "Residency time (seconds in core)") + ("SIZE" "Virtual image size, size data+stack (in KByte).") + ("SL" "Sleep time of the process (seconds blocked).") + ("STAT" ("Status. " + ("R" "R=runnable. ") + ("S" "S=sleeping < 20s. ") + ("D" "D=un-interruptible wait (eg disk or NFS I/O). ") + ("T" "T=stopped. ") + ("Z" "Z=zombie (terminated). ") + ("W" "W=Swapped out. ") + ("I" "I=idle, sleeping > 20s. ") + ("P" "P=Page Wait." ) + ("N" "N=started with nice. ") + (">" ">=exceeded memory limit. ") + ("SW" "S=sleeping. W=waiting on an event. ") + ("IW" "I=intermediate status. W=waiting on an event. "))) + ("SZ" "Virtual image size, size data+stack (in KByte). ") + ("WCHAN" "Event on which process is waiting. ") + ) + "Help list with the descriptions of ps fields for SunOS 4.") + +(defvar View-process-field-name-descriptions-sunos5 + '( + ("C" "Processor utilization for scheduling. ") + ("CLS" "Scheduling class. ") + ("F" "Flags (in hex) No meaning should be currently ascribed to them. ") + ("PRI" "Priority, without -c: no > => prio <, with -c: no > => prio > .") + ("S" ("State. " + ("O" "O=Process is running on a processor. ") + ("S" "S=Sleeping, process is waiting for an event. ") + ("R" "R=Runnable, process is on run queue. ") + ("I" "I=Idle, process is being created. ") + ("Z" "Z=Zombie state, process terminated and parent not waiting. ") + ("T" "T=Traced, process stopped by a signal, parent is tracing it. ") + ("X" "X=SXBRK state: process is waiting for more primary memory. ") + )) + ("STIME" "Start time. ") + ("SZ" "Size (in Pages) of the swappable process's image in main memory. ") + ("WCHAN" "Event on which process is waiting or in SXBRK state. ") + ) + "Help list with the descriptions of ps fields for SunOS 5.") + +(defvar View-process-field-name-descriptions-irix + '( + ("F" ("Flags. " + ("01" "01=Process is a system (resident) process. ") + ("02" "02=Process is being traced. ") + ("04" "04=Stopped process has been given to parent via wait. ") + ("08" "08=Process is sleeping at a non-interruptible priority. ") + ("10" "10=Process is in core. ") + ("20" "20=Process user area is in core. ") + ("40" "40=Process has enabled atomic operator emulation. ") + ("80" "80=Process in stream poll or select. "))) + ("C" "Processor utilization for scheduling. ") + ("CLS" "Scheduling class. ") + ("COMD" "The command name. ") + ("P" "Number of processor on which the process is executing. ") + ("RSS" "Total resident size (in pages/4096 Bytes) of process. ") + ("S" ("State. " + ("0" "0=Process is running on a processor. ") + ("S" "S=Process is sleeping, waiting for a resource. ") + ("R" "R=Process is running. ") + ("Z" "Z=Process is terminated and parent not waiting. ") + ("T" "T=Process is stopped. ") + ("I" "I=Process is in intermediate state of creation. ") + ("X" "X=Process is waiting for memory. "))) + ("STIME" "The starting time of the process. ") + ("SZ" "Total size (in pages/4096 Bytes) of the process. ") + ("WCHAN" "Event on which process is waiting. ") + ) + "Help list with the descriptions of ps fields for IRIX.") + +(defvar View-process-field-name-descriptions-hpux + '( + ("F" ("Flags. " + ("00" "00=Process is swapped. ") + ("01" "01=Process is in core. ") + ("02" "01=Process is a system process. ") + ("04" "04=Process is locked in core (e.g., for physical I/O). ") + ("10" "10=Process is being traced by another process. ") + ("20" "20=Process is being traced by another process. ") + ;; another tracing flag + )) + ("UID" + "Real user ID number of the process owner. Login name under the -f option. ") + ("PID" "The process ID of the process. ") + ("PPID" "The process ID of the parent process. ") + ("PRI" "The priority of the process; higher numbers mean lower priority. ") + ("NI" "Nice value; used in priority computation. ") + ("ADDR" "Memory address of the process, if resident, or disk address. ") + ("TTY" "The controlling terminal for the process. ") + ("TIME" "The cumulative execution time for the process [min:sec]. ") + ("STIME" + "Starting time of the process, or starting date if elapsed > 24h. ") + ("C" "Processor utilization for scheduling. ") + ("COMD" "The command name. ") + ("COMMAND" "The command name. ") + ("S" ("State. " + ("0" "0=Process is non-existing. ") + ("S" "S=Process is sleeping. ") + ("W" "Process is waiting for a resource. ") + ("R" "R=Process is running. ") + ("Z" "Z=Process is terminated and parent not waiting. ") + ("T" "T=Process is stopped. ") + ("I" "I=Process is in intermediate state of creation. ") + ("X" "X=Process is waiting for memory. "))) + ("SZ" "Total size (in pages/4096 Bytes) of the process. ") + ("WCHAN" "Event on which process is waiting. ") + ) + "Help list with the descriptions of ps fields for HP-UX.") + +;;; view-process-system-specific.el ends here.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/modes/view-process-xemacs.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,474 @@ +;;; view-process-xemacs.el --- XEmacs specific code for view-process + +;; Copyright (C) 1995, 1996 Heiko Muenkel + +;; AUthor: Heiko Muenkel +;; Keywords: processes + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Emacs 20.1 + +;;; Commentary: + +;; This file contains lisp code, which works only in the XEmacs. + +;; Installation: + +;; Put this file in one of your lisp load directories. +;; + +;;; Code: + +(provide 'view-process-xemacs) + +;;; variables + +(defvar View-process-itimer-name "view-process" + "Name of the view process itimer.") + + +;;; special keybindings + +(define-key View-process-mode-map '(button2) 'View-process-mouse-kill) +(define-key View-process-mode-map '(button3) 'View-process-popup-menu) + + +;;; menus + +(if (not View-process-pulldown-menu) + (setq + View-process-pulldown-menu + '("View-process-pulldown-menu-name" + ["Rename Buffer" View-process-rename-current-output-buffer t] + ["Submit Bug Report" View-process-submit-bug-report t] + ["Quit" View-process-quit t] + ("Options" + ["Truncate Lines" + View-process-toggle-truncate-lines + :style toggle + :selected truncate-lines] + ["Motion Help" + View-process-toggle-motion-help + :style toggle + :selected View-process-motion-help] + ["Two Windows" + View-process-toggle-display-with-2-windows + :style toggle + :selected View-process-display-with-2-windows] + ["Hide Header" + View-process-toggle-hide-header + :style toggle + :selected View-process-hide-header + :active View-process-display-with-2-windows] + ["Digits Send Signals" + View-process-toggle-digit-bindings + :style toggle + :selected View-process-digit-bindings-send-signal] + ) + ))) + + +(if (not View-process-region-menu) + (setq + View-process-region-menu + '("PS Region Menu" + ["View Processes" view-processes nil] + ["New PS" View-process-status nil] + ["Update" View-process-status-update nil] + ("Periodic Output" + ["Start " + View-process-start-itimer + :style radio + :selected (not (get-itimer View-process-itimer-name)) + :active nil] + ["Stop" + View-process-delete-itimer + :style radio + :selected (get-itimer View-process-itimer-name) + :active nil] + ) + ("Send Signal" + ["SIGHUP" + (View-process-send-signal-to-processes-in-region "SIGHUP") t] + ["SIGTERM" + (View-process-send-signal-to-processes-in-region "SIGTERM") t] + ["SIGKILL" + (View-process-send-signal-to-processes-in-region "SIGKILL") t] + ["SIGSTOP" + (View-process-send-signal-to-processes-in-region "SIGSTOP") t] + ["SIGCONT" + (View-process-send-signal-to-processes-in-region "SIGCONT") t] + ["SIGQUIT" + (View-process-send-signal-to-processes-in-region "SIGQUIT") t] + "----" + ["Any Signal..." View-process-send-signal-to-processes-in-region t] + "----" + ["Alter Priority..." View-process-renice-processes-in-region t] + ) + ("Mark" + ["Mark" View-process-mark-current-line nil] + ["Mark Childs" View-process-mark-childs-in-current-line nil] + ["Remark Last Marks" View-process-reset-last-marks nil] + "----" + ["Unmark" View-process-unmark-current-line nil] + ["Unmark All" View-process-unmark-all nil] + ) + "----" + ["Sort" View-process-sort-region-by-current-field (looking-at "[^ ]")] + ["Reverse" View-process-reverse-region t] + ["Field Filter..." + View-process-filter-region-by-current-field + (looking-at "[^ ]")] + ["Exlude Field Filter..." + (progn (setq current-prefix-arg '(-1)) + (call-interactively + 'View-process-filter-region-by-current-field)) + :keys "C-u -1 M-c f" + :active (looking-at "[^ ]")] + ["Line Filter..." View-process-filter-region t] + ["Exclude Line Filter..." + (progn (setq current-prefix-arg '(-1)) + (call-interactively + 'View-process-filter-region)) + :keys "C-u -1 M-c g" + :active t] + "----" + ("Help" + ["PID and Command" View-process-show-pid-and-command nil] + ["Field Name" View-process-which-field-name nil] + ["Header Line" View-process-show-header-line nil] + ["Own PID" View-process-display-emacs-pid nil] + ) + ) + ) + ) + +(if (not View-process-marked-menu) + (setq + View-process-marked-menu + '("PS Marked Menu" + ["View Processes" view-processes t] + ["New PS" View-process-status t] + ["Update" View-process-status-update t] + ("Periodic Output" + ["Start " + View-process-start-itimer + :style radio + :selected (not (get-itimer View-process-itimer-name)) + :active nil] + ["Stop" + View-process-delete-itimer + :style radio + :selected (get-itimer View-process-itimer-name) + :active nil] + ) + ("Send Signal" + ["SIGHUP" (View-process-send-signal-to-processes-with-mark "SIGHUP") t] + ["SIGTERM" + (View-process-send-signal-to-processes-with-mark "SIGTERM") + t] + ["SIGKILL" + (View-process-send-signal-to-processes-with-mark "SIGKILL") + t] + ["SIGSTOP" + (View-process-send-signal-to-processes-with-mark "SIGSTOP") + t] + ["SIGCONT" + (View-process-send-signal-to-processes-with-mark "SIGCONT") + t] + ["SIGQUIT" + (View-process-send-signal-to-processes-with-mark "SIGQUIT") + t] + "----" + ["Any Signal..." View-process-send-signal-to-processes-with-mark t] + "----" + ["Alter Priority..." View-process-renice-processes-with-mark t] + ) + ("Mark" + ["Mark" View-process-mark-current-line t] + ["Mark Childs" View-process-mark-childs-in-current-line t] + ["Remark Last Marks" View-process-reset-last-marks t] + "----" + ["Unmark" View-process-unmark-current-line t] + ["Unmark All" View-process-unmark-all t] + ) + "----" + ["Sort" View-process-sort-output-by-current-field (looking-at "[^ ]")] + ["Reverse" View-process-reverse-output t] + ["Field Filter..." + View-process-filter-output-by-current-field (looking-at "[^ ]")] + ["Exlude Field Filter..." + (progn (setq current-prefix-arg '(-1)) + (call-interactively + 'View-process-filter-output-by-current-field)) + :keys "C-u -1 F" + :active (looking-at "[^ ]")] + ["Line Filter..." View-process-filter-output t] + ["Exclude Line Filter..." + (progn (setq current-prefix-arg '(-1)) + (call-interactively + 'View-process-filter-output)) + :keys "C-u -1 G" + :active t] + "----" + ("Help" + ["PID and Command" View-process-show-pid-and-command t] + ["Field Name" View-process-which-field-name (looking-at "[^ ]")] + ["Header Line" View-process-show-header-line t] + ["Own PID" View-process-display-emacs-pid t] + ) + ) + ) + ) + +(if (not View-process-non-region-menu) + (setq + View-process-non-region-menu + '("PS Non Region Menu" + ["View Processes" view-processes t] + ["New PS" View-process-status t] + ["Update" View-process-status-update t] + ("Periodic Output" + ["Start " + View-process-start-itimer + :style radio + :selected (not (get-itimer View-process-itimer-name))] + ["Stop" + View-process-delete-itimer + :style radio + :selected (get-itimer View-process-itimer-name)] + ) + ("Send Signal" + ["SIGHUP" (View-process-send-signal-to-process-in-line "SIGHUP") t] + ["SIGTERM" (View-process-send-signal-to-process-in-line "SIGTERM") t] + ["SIGKILL" (View-process-send-signal-to-process-in-line "SIGKILL") t] + ["SIGSTOP" (View-process-send-signal-to-process-in-line "SIGSTOP") t] + ["SIGCONT" (View-process-send-signal-to-process-in-line "SIGCONT") t] + ["SIGQUIT" (View-process-send-signal-to-process-in-line "SIGQUIT") t] + "----" + ["Any Signal..." View-process-send-signal-to-process-in-line t] + "----" + ["Alter Priority..." View-process-renice-process-in-line t] + ) + ("Mark" + ["Mark" View-process-mark-current-line t] + ["Mark Childs" View-process-mark-childs-in-current-line t] + ["Remark Last Marks" View-process-reset-last-marks t] + "----" + ["Unmark" View-process-unmark-current-line nil] + ["Unmark All" View-process-unmark-all nil] + ) + "----" + ["Sort" View-process-sort-output-by-current-field (looking-at "[^ ]")] + ["Reverse" View-process-reverse-output t] + ["Field Filter..." + View-process-filter-output-by-current-field + (looking-at "[^ ]")] + ["Exlude Field Filter..." + (progn (setq current-prefix-arg '(-1)) + (call-interactively + 'View-process-filter-output-by-current-field)) + :keys "C-u -1 F" + :active (looking-at "[^ ]")] + ["Line Filter..." View-process-filter-output t] + ["Exclude Line Filter..." + (progn (setq current-prefix-arg '(-1)) + (call-interactively + 'View-process-filter-output)) + :keys "C-u -1 G" + :active t] + "----" + ("Help" + ["PID and Command" View-process-show-pid-and-command t] + ["Field Name" View-process-which-field-name (looking-at "[^ ]")] + ["Header Line" View-process-show-header-line t] + ["Own PID" View-process-display-emacs-pid t] + ) + ) + ) + ) + +(defun View-process-popup-menu (event) + "Pops up a menu for the `View-process-mode'." + (interactive "e") + (mouse-set-point event) + (popup-menu + (cond ((View-process-region-active-p) View-process-region-menu) + (View-process-pid-mark-alist View-process-marked-menu) + (t View-process-non-region-menu)))) + +(defun View-process-install-pulldown-menu () + "Installs a pulldown menu for the `View-process-mode'." + (if (and current-menubar + (not (assoc View-process-pulldown-menu-name current-menubar))) + (progn + (set-buffer-menubar (copy-sequence current-menubar)) + (add-submenu nil + (cons View-process-pulldown-menu-name + (cdr View-process-pulldown-menu))) + (add-submenu (list View-process-pulldown-menu-name) + View-process-region-menu + "Submit Bug Report") + (add-submenu (list View-process-pulldown-menu-name) + View-process-marked-menu + "Submit Bug Report") + (add-submenu (list View-process-pulldown-menu-name) + View-process-non-region-menu + "Submit Bug Report") + ))) + + +;;; mode motion + +(defun View-process-mode-motion-highlight-line (event) + "For use as the value of `mode-motion-hook' in the `View-process-mode'. +It highlights the line under the mouse and displays help messages during +mouse motion, if `View-process-motion-help' is non nil." + (if (and (event-point event) + (> (event-point event) View-process-header-end)) + (progn + (mode-motion-highlight-line event) + (if (and View-process-motion-help + (not View-process-stop-motion-help)) + (save-excursion + (mouse-set-point event) + (View-process-show-pid-and-command-or-field-name) + ))) + (message "") + )) + +(defun View-process-install-mode-motion () + "Installs the `mode-motion-hook'." + (make-local-variable 'mode-motion-hook) + (setq mode-motion-hook 'View-process-mode-motion-highlight-line)) + +(defun View-process-toggle-motion-help (&optional arg) + "Change whether a help message is displayed during mouse motion. +With a positive ARG the variable 'View-process-motion-help' is set +to t and with a negative ARG it is set to nil." + (interactive "P") + (if arg + (if (>= (prefix-numeric-value arg) 0) + (setq View-process-motion-help t) + (setq View-process-motion-help nil)) + (if View-process-motion-help + (setq View-process-motion-help nil) + (setq View-process-motion-help t)))) + +; necessary for the Emacs 19 +(defalias 'View-process-insert-and-inherit 'insert) + +;;; timer functions + +(defun View-process-start-itimer () + "Starts or restarts the itimer for updating the process output." + (interactive) + (if (get-itimer View-process-itimer-name) + (progn + (set-itimer-value (get-itimer View-process-itimer-name) + View-process-itimer-value) + (set-itimer-restart (get-itimer View-process-itimer-name) + View-process-itimer-value)) + (start-itimer View-process-itimer-name + 'View-process-status-itimer-function + View-process-itimer-value + View-process-itimer-value))) + +(defun View-process-delete-itimer () + "Stops (deletes) the view process itimer." + (interactive) + (if (get-itimer View-process-itimer-name) + (delete-itimer View-process-itimer-name))) + + +;;; region + +(defun View-process-region-active-p () + "Returns t, if a region is active. +If `zmacs-regions' is nil, then this return always nil." + (if zmacs-regions + (mark))) + + +;;; Misc + +(defun View-process-return-current-command-key-as-string () + "Returns the key, which invokes the current command as string." + (events-to-keys (this-command-keys))) + +(defun View-process-redraw () + "Dummy function. It does nothing in the XEmacs." + ) + + +;;; font-lock and colors + +(defun View-process-install-font-lock () + "Installs the `font-lock-mode', if `View-process-use-font-lock' is t." + (if View-process-use-font-lock + (font-lock-mode 1))) + +(if (not (fboundp 'valid-color-name-p)) + (defalias 'valid-color-name-p 'x-valid-color-name-p)) + +(defun View-process-search-color-in-color-list (color-list) + "Searches a valid color in the COLOR-LIST." + (cond ((not color-list) nil) + ((listp color-list) + (if (valid-color-name-p (car color-list)) + (car color-list) + (View-process-search-color-in-color-list (cdr color-list)))))) + +(defun View-process-search-color (color) + "It returns a color, which could be displayed by the window manager. +COLOR is either a string with a color or a list with possible +colors." + (cond ((not color) nil) + ((stringp color) + (if (valid-color-name-p color) color nil)) + ((listp color) + (View-process-search-color-in-color-list color)) + (t nil))) + +;;; missing function window-pixel-edges in XEmacs < 19.12 +;;; Attention: This emulation is only valid, to test if a value +;;; is 0 or not. +(if (not (fboundp 'window-pixel-edges)) + (defalias 'window-pixel-edges 'window-edges)) + + +;;; Modeline + +(if (fboundp 'set-specifier) + +(defun view-process-switch-buffer-modeline (modeline-on) + "Switches the current modeline on, if MODELINE-ON is t. +Otherwise the modeline is switched off." + (set-specifier has-modeline-p (cons (current-buffer) modeline-on))) + + +(defun view-process-switch-buffer-modeline (modeline-on) + "Dummy function. +Sorry, the modeline can't be switched off in this emacs version. +You have to update at least to XEmacs 19.12." + ) + +) + +;;; view-process-xemacs.el ends here.
--- a/lisp/modes/winmgr-mode.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/modes/winmgr-mode.el Mon Aug 13 09:44:42 2007 +0200 @@ -66,26 +66,31 @@ ;;; Code: -(defvar winmgr-mode-hook nil - "Hook to be run when `winmgr-mode' is entered.") + +(defgroup winmgr nil + "Generic window manager mode." + :tag "Window Managers" + :group 'languages) + -(defvar winmgr-basic-offset 4 - "*Number of spaces per indentation level.") +(defcustom winmgr-basic-offset 4 + "*Number of spaces per indentation level." + :type 'integer + :group 'winmgr) + +(defcustom winmgr-mode-hook nil + "Hook to be run when `winmgr-mode' is entered." + :type 'hook + :group 'winmgr) -;; font-lock-isms -(defvar font-lock-m4-face 'default - "New face for m4 macros.") - -(defun winmgr-init-font-lock () - ;; initialize font-lock faces for winmgr-mode - (condition-case nil - (progn - (copy-face 'default 'm4-face) - (set-face-foreground 'm4-face "blue") - (set-face-background 'm4-face "white") - (setq font-lock-m4-face 'm4-face)) - (error nil))) +(defface font-lock-m4-face + '((((class color)) + (:foreground "blue")) + (t + (:underline t))) + "Font-lock face for M4 macros." + :group 'winmgr) (defvar winmgr-font-lock-keywords '(("^[A-Za-z]+[ \n\t]" . font-lock-function-name-face) @@ -93,7 +98,6 @@ ("^[A-Za-z]+(.*)" . font-lock-m4-face)) "Default font-lock keywords.") - ;; major-mode stuff (defvar winmgr-mode-abbrev-table nil @@ -119,6 +123,7 @@ ) +;;;###autoload (defun winmgr-mode () "Major mode for editing winmgr config files." (interactive)
--- a/lisp/mu/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/mu/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/mule/arabic-hooks.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/mule/arabic-hooks.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,61 +0,0 @@ -;;; arabic-hooks.el --- pre-loaded support for Arabic. - -;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. -;; Copyright (C) 1995 Amdahl Corporation. -;; Copyright (C) 1995 Sun Microsystems. - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: Mule 2.3. - -;; Three character sets for Arabic -(make-charset 'arabic-0 "Arabic digits" - '(registry "MuleArabic-0" - dimension 1 - chars 94 - final ?2 - graphic 0 - direction l2r - )) - -(make-charset 'arabic-1 "one-column Arabic" - '(registry "MuleArabic-1" - dimension 1 - chars 94 - final ?3 - graphic 0 - direction r2l - )) - -(make-charset 'arabic-2 "two-column Arabic" - '(registry "MuleArabic-2" - dimension 1 - chars 94 - final ?4 - graphic 0 - direction r2l - )) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; ARABIC -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define-language-environment 'arabic - "Arabic" - (lambda () - (require 'arabic)))
--- a/lisp/mule/arabic.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/mule/arabic.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,667 +0,0 @@ -;;; arabic.el --- minor mode for editing Arabic. -;; Copyright (C) 1994 Free Software Foundation, Inc. - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: Mule 2.3. - -;;; 94.6.13 created for Mule Ver.1.1 by Takahashi N. <ntakahas@etl.go.jp> - -(require 'visual-mode) - -(defvar arabic-mode-indicator " [2](3=a:GJ[0](B" - "String displayed in mode-line. -\" Arabic\" for Arabic keyboard input, \" [2](3=a:GJ[0](B\".") - -(make-variable-buffer-local 'arabic-mode-indicator) - -;;;###autoload -(defvar arabic-mode nil - "Non-nil if in arabic-mode.") - -(make-variable-buffer-local 'arabic-mode) - -(if (not (assq 'arabic-mode minor-mode-alist)) - (setq minor-mode-alist - (cons '(arabic-mode arabic-mode-indicator) minor-mode-alist))) - -(define-key global-map [(meta \\)] 'arabic-mode) - -(defvar arabic-input-arabic-char t - "Non-nil if key input is Arabic. Nil if key input is ASCII.") - -(make-variable-buffer-local 'arabic-input-arabic-char) - -(defvar arabic-input-keymap 'arabic-keymap-0 - "Specify which input table is used for Arabic input. Should be on of: -arabic-keymap-0 (default), -arabic-keymap-1 (Farsi standard), or -arabic-keymap-2 (Microsoft Arabic).") - -(defvar arabic-translate-table - (cond - ((eq arabic-input-keymap 'arabic-keymap-0) - [?[2](3![0](B ?[2](3"[0](B ?[2](3-[0](B nil nil nil nil ?' ?[2](3#[0](B ?[2](3$[0](B nil nil ?[2](3%[0](B nil ?[2](3&[0](B ?[2](49[0](B - ?(2!(B ?(2"(B ?(2#(B ?(2$(B ?(2%(B ?(2&(B ?(2'(B ?(2((B ?(2)(B ?(2*(B ?[2](3'[0](B ?[2](3([0](B ?[2](3*[0](B nil ?[2](3+[0](B ?[2](3)[0](B - nil ?[2](4][0](B nil ?[2](4g[0](B ?[2](4A[0](B nil nil ?[2](4O[0](B ?[2](4-[0](B nil nil ?[2](41[0](B nil nil nil nil - nil nil nil ?[2](4=[0](B ?[2](4E[0](B nil nil nil ?[2](3h[0](B nil ?[2](4I[0](B nil nil nil nil nil - ?[2](4M[0](B ?[2](38[0](B ?[2](4#[0](B ?[2](4'[0](B ?[2](3B[0](B nil ?[2](4Q[0](B ?[2](4k[0](B ?[2](3Z[0](B nil ?[2](4)[0](B ?[2](4U[0](B ?[2](4Y[0](B ?[2](3T[0](B ?[2](4[[0](B ?[2](3<[0](B - ?[2](4e[0](B ?[2](4S[0](B ?[2](3F[0](B ?[2](45[0](B ?[2](4%[0](B nil nil ?[2](3^[0](B ?[2](3D[0](B ?[2](4_[0](B ?[2](3H[0](B nil ?| nil nil]) - ((eq arabic-input-keymap 'arabic-keymap-1) - [?[2](3![0](B ?[2](3"[0](B nil nil nil nil nil nil ?[2](3#[0](B ?[2](3$[0](B nil nil ?[2](3%[0](B nil ?[2](3&[0](B nil - ?(2!(B ?(2"(B ?(2#(B ?(2$(B ?(2%(B ?(2&(B ?(2'(B ?(2((B ?(2)(B ?(2*(B ?[2](3'[0](B ?[2](4U[0](B ?[2](3*[0](B nil ?[2](3+[0](B ?[2](3)[0](B - nil nil ?[2](3h[0](B nil nil nil ?[2](4e[0](B ?[2](3.[0](B nil nil nil nil nil nil nil nil - nil nil nil nil nil nil ?[2](30[0](B nil nil nil nil ?[2](4)[0](B nil ?[2](4g[0](B nil nil - nli ?[2](49[0](B ?[2](3H[0](B ?[2](3D[0](B ?[2](4_[0](B ?[2](4S[0](B ?[2](4#[0](B ?[2](38[0](B ?[2](4%[0](B nil ?[2](4Y[0](B ?[2](4[[0](B ?[2](3T[0](B ?[2](3^[0](B ?[2](3F[0](B ?[2](41[0](B - ?[2](4-[0](B ?[2](4A[0](B ?[2](4Q[0](B ?[2](45[0](B ?[2](4O[0](B ?[2](3Z[0](B ?[2](3B[0](B ?[2](4=[0](B ?[2](4E[0](B ?[2](4M[0](B ?[2](4I[0](B nil nli nil nil ]) - (t - [?[2](3![0](B ?[2](3"[0](B ?\" ?# ?$ ?% ?& ?' ?[2](3#[0](B ?[2](3$[0](B ?* ?+ ?[2](3^[0](B ?- ?[2](3H[0](B ?[2](4I[0](B - ?(2!(B ?(2"(B ?(2#(B ?(2$(B ?(2%(B ?(2&(B ?(2'(B ?(2((B ?(2)(B ?(2*(B ?[2](3'[0](B ?[2](4U[0](B ?, ?= ?. ?[2](3)[0](B - ?@ nil ?[2](3b[0](B ?{ ?[ nil ?] ?[2](3c[0](B ?[2](30[0](B nil nil ?[2](3%[0](B ?/ ?` ?[2](3.[0](B nil - ?[2](3([0](B nil nil nil ?[2](3d[0](B ?' ?} nil nil ?[2](34[0](B ?~ ?[2](4)[0](B ?\\ ?[2](3B[0](B ?^ ?_ - ?[2](3D[0](B ?[2](49[0](B ?[2](3e[0](B ?[2](32[0](B ?[2](4_[0](B ?[2](4'[0](B ?[2](4#[0](B ?[2](4Y[0](B ?[2](38[0](B ?[2](3Z[0](B ?[2](4%[0](B ?[2](4[[0](B ?[2](3T[0](B ?[2](3<[0](B ?[2](4][0](B ?[2](41[0](B - ?[2](4-[0](B ?[2](4A[0](B ?[2](4S[0](B ?[2](45[0](B ?[2](4Q[0](B ?[2](4M[0](B ?[2](3F[0](B ?[2](4=[0](B ?[2](3-[0](B ?[2](4O[0](B ?[2](4)) - -(defvar arabic-mode-map - (let ((map (make-keymap))) - (substitute-key-definition 'self-insert-command - 'arabic-self-insert-command - map global-map) - - (define-key map [(control c) (control c)] 'arabic-mode) - (define-key map [(control d)] 'arabic-delete-char) - (define-key map [(control k)] 'arabic-kill-line) - (define-key map [(control m)] 'arabic-newline) - (define-key map [(control o)] 'arabic-open-line) - (define-key map [(control w)] 'arabic-kill-region) - (define-key map [(control y)] 'arabic-yank) - (define-key map [delete] 'arabic-backward-delete-char) - (define-key map [(meta d)] 'arabic-delete-word) - (define-key map [(meta y)] 'arabic-yank-pop) - (define-key map [(meta z)] 'arabic-help) - (define-key map [(meta \\)] 'arabic-toggle-input-char) - (define-key map [(meta delete)] 'arabic-backward-kill-word) - - (define-key map [(control n)] 'visual-next-line) - (define-key map [(control p)] 'visual-previous-line) - (define-key map [(meta <)] 'visual-beginning-of-buffer) - (define-key map [(meta >)] 'visual-end-of-buffer) - (define-key map [up] 'visual-previous-line) - (define-key map [down] 'visual-next-line) - (define-key map [home] 'visual-beginning-of-buffer) - (define-key map [end] 'visual-end-of-buffer) - (define-key map [left] 'visual-move-to-left-char) - (define-key map [right] 'visual-move-to-right-char) - (define-key map [(meta left)] 'visual-move-to-left-word) - (define-key map [(meta right)] 'visual-move-to-right-word) - - (if visual-use-lr-commands - (progn - (define-key map [(control a)] 'visual-left-end-of-line) - (define-key map [(control b)] 'visual-move-to-left-char) - (define-key map [(control e)] 'visual-right-end-of-line) - (define-key map [(control f)] 'visual-move-to-right-char) - (define-key map [(meta b)] 'visual-move-to-left-word) - (define-key map [(meta f)] 'visual-move-to-right-word)) - (define-key map [(control a)] 'visual-beginning-of-line) - (define-key map [(control b)] 'visual-backward-char) - (define-key map [(control e)] 'visual-end-of-line) - (define-key map [(control f)] 'visual-forward-char) - (define-key map [(meta b)] 'visual-backward-word) - (define-key map [(meta f)] 'visual-forward-word)) - - (cond - ((eq arabic-input-keymap 'arabic-keymap-0) - (define-key map [?~] 'arabic-insert-madda) - (define-key map [?'] 'arabic-insert-hamza) - (define-key map [?a] 'arabic-insert-alif) - (define-key map [?_] 'arabic-make-connection) - (define-key map [?|] 'arabic-cut-connection)) - ((eq arabic-input-keymap 'arabic-keymap-1) - (define-key map [?~] 'arabic-insert-madda) - (define-key map [?'] 'arabic-insert-hamza) - (define-key map [?a] 'arabic-insert-alif) - (define-key map [?_] 'arabic-make-connection) - (define-key map [?|] 'arabic-cut-connection) - (define-key map [(alt \;)] 'arabic-insert-gaaf) - (define-key map [(alt v)] 'arabic-insert-isolated-hamza)) - (t - (define-key map [(alt z)] 'arabic-insert-madda) - (define-key map [(alt x)] 'arabic-insert-hamza) - (define-key map [(alt h)] 'arabic-insert-alif) - (define-key map [(alt _)] 'arabic-make-connection) - (define-key map [(alt |)] 'arabic-cut-connection))) - - map) - "minor-mode-keymap for arabic-mode.") - - (if (not (assq 'arabic-mode minor-mode-map-alist)) - (setq minor-mode-map-alist - (cons (cons 'arabic-mode arabic-mode-map) minor-mode-map-alist))) - - (defvar arabic-help-string - (cond - ((eq arabic-input-keymap 'arabic-keymap-0) - "\ - Keymap in Arabic-mode - - +----------------------------------------------------------------+ - |! [2](3"[0](B |@ |# |$ |% |^ |& |* |( [2](3#[0](B |) [2](3$[0](B |_ |+ |~ | - |1 (2"(B |2 (2#(B |3 (2$(B |4 (2%(B |5 (2&(B |6 (2'(B |7 (2((B |8 (2)(B |9 (2*(B |0 (2!(B |- |= |` [2](4M[0](B| - +----------------------------------------------------------------+ - |Q |W |E |R |T [2](4E[0](B|Y |U |I |O |P | - |q [2](4S[0](B|w [2](3^[0](B |e |r [2](3F[0](B |t [2](4%[0](B|y [2](4_[0](B|u |i |o [2](3<[0](B |p [2](4e[0](B| - +--------------------------------------------------------+ - |A [2](4][0](B|S [2](4=[0](B|D [2](4A[0](B|F |G [2](4O[0](B|H [2](4-[0](B|J |K [2](41[0](B|L |: [2](3'[0](B |\" [2](3-[0](B | - |a [2](38[0](B |s [2](45[0](B|d [2](3B[0](B |f [2](4Q[0](B|g [2](4k[0](B|h [2](3Z[0](B |j [2](4)[0](B|k [2](4U[0](B|l [2](4Y[0](B|; [2](3([0](B |' | - +------------------------------------------------------+ - |Z [2](4I[0](B|X [2](3h[0](B |C [2](4g[0](B|V |B |N |M |< [2](3*[0](B |> [2](3+[0](B |? [2](3)[0](B | - |z [2](3H[0](B |x [2](3D[0](B |c [2](4'[0](B|v |b [2](4#[0](B|n [2](4[[0](B|m [2](3T[0](B |, [2](3%[0](B |. [2](3&[0](B |/ [2](49[0](B| - +-------------------------------------------------+") - - ((eq arabic-input-keymap 'arabic-keymap-1) - "\ - Keymap in Arabic-mode +--------------+ - | ALT SHIFT| - +-------------------------------------------------+ |ASCII ARABIC| -| [2](3"[0](B | | | | | | | | [2](3#[0](B | [2](3$[0](B | +--------------+ -|1 (2"(B |2 (2#(B |3 (2$(B |4 (2%(B |5 (2&(B |6 (2'(B |7 (2((B |8 (2)(B |9 (2*(B |0 (2!(B | -+-------------------------------------------------------------+ - | | | | | | | | | | | | | - |q [2](4A[0](B|w [2](4=[0](B|e [2](4S[0](B|r [2](4Q[0](B|t [2](4O[0](B|y [2](4M[0](B|u [2](3Z[0](B |i |o [2](41[0](B|p [2](4-[0](B|[ [2](4)[0](B|] [2](4g[0](B| - +-----------------------------------------------------------+ - | | | | [2](4e[0](B| [2](3.[0](B | | | | |[2](4k[0](B [2](3'[0](B| - |a [2](49[0](B|s [2](45[0](B|d [2](4_[0](B|f [2](4#[0](B|g [2](38[0](B |h [2](4%[0](B|j [2](4Y[0](B|k [2](4[[0](B|l [2](3T[0](B |; [2](4U[0](B| - +---------------------------------------------------+ - | | | |[2](3-[0](B [2](30[0](B | [2](3h[0](B | | | [2](3*[0](B | [2](3+[0](B | [2](3)[0](B | - |z [2](4I[0](B|x [2](4E[0](B|c [2](3D[0](B |v [2](3B[0](B |b [2](3H[0](B |n [2](3F[0](B |m [2](3^[0](B |, [2](3%[0](B |. [2](3&[0](B |/ | - +-------------------------------------------------+") - - (t - "\ - +-----------------+ - |S-ASCII S-Arabic| - | ASCII Arabic | +----+ - +-----------------+ || || - |\\ \\| -+-----------------------------------------------------------+ -|! [2](3"[0](B|@ @|# #|$ $|% %|^ ^|& &|* *|( [2](3#[0](B|) [2](3$[0](B|_ _|+ +| -|1 (2"(B|2 (2#(B|3 (2$(B|4 (2%(B|5 (2&(B|6 (2'(B|7 (2((B|8 (2)(B|9 (2*(B|0 (2!(B|- -|= =| -+-------------------------------------------------------------+ - |Q |W |E |R |T [2](3d[0](B|Y [2](34[0](B|U '|I |O |P [2](3([0](B|{ <|} >| - | [2](4A[0](B| [2](4=[0](B| [2](4'[0](B| [2](4S[0](B| [2](4Q[0](B| [2](4O[0](B| [2](4M[0](B| [2](3Z[0](B| [2](41[0](B| [2](4-[0](B|[ [2](4)[0](B|] [2](3B[0](B| - +-------------------------------------------------------------+ - |A |S |D [|F ]|G [2](3c[0](B|H [2](30[0](B|J |K [2](3%[0](B|L /|: [2](3'[0](B|\" \" |~[2](3,[0](B | - | [2](49[0](B| [2](45[0](B| [2](4_[0](B| [2](4#[0](B| [2](4Y[0](B| [2](38[0](B| [2](4%[0](B| [2](4[[0](B| [2](3T[0](B|\; [2](4U[0](B|' [2](4E[0](B|` [2](3D[0](B| - +-----------------------------------------------------------+ - |Z ~|X |C {|V }|B [2](3b[0](B|N [2](3.[0](B|M `|< ,|> [2](3&[0](B|? [2](3)[0](B| - | [2](4![0](B| [2](3-[0](B| [2](32[0](B| [2](3F[0](B| [2](3e[0](B| [2](4][0](B| [2](3<[0](B|, [2](3^[0](B|. [2](3H[0](B|/ [2](4I[0](B| - +-------------------------------------------------+")) - - "Document shown by arabic-help (M-z).") - -;;;###autoload -(defun arabic-mode (&optional arg) - "Toggle arabic-mode. With ARG, turn arabic-mode on iff ARG is positive." - (interactive "P") - (if (null arg) - (if arabic-mode (exit-arabic-mode) (enter-arabic-mode)) - (if (> (prefix-numeric-value arg) 0) - (enter-arabic-mode) - (exit-arabic-mode)))) - -(defun enter-arabic-mode nil - "Enter arabic-mode." - (interactive) - (if (not arabic-mode) - (progn - (setq arabic-mode t - arabic-input-arabic-char t - arabic-mode-indicator " [2](3=a:GJ[0](B") - (redraw-modeline t) - (message "M-z to display arabic keymap.") - (run-hooks 'arabic-mode-hooks)))) - -(defun exit-arabic-mode nil - "Exit arabic-mode." - (interactive) - (if arabic-mode - (progn - (setq arabic-mode nil) - (redraw-modeline t)))) - -(defconst *arabic-adding-connection-to-right* - '((?[2](3.[0](B . ?[2](3/[0](B ) (?[2](3/[0](B . ?[2](3/[0](B ) - (?[2](30[0](B . ?[2](31[0](B ) (?[2](31[0](B . ?[2](31[0](B ) - (?[2](32[0](B . ?[2](33[0](B ) (?[2](33[0](B . ?[2](33[0](B ) - (?[2](34[0](B . ?[2](35[0](B ) (?[2](35[0](B . ?[2](35[0](B ) - (?[2](4![0](B . ?[2](4"[0](B) (?[2](36[0](B . ?[2](37[0](B ) (?[2](37[0](B . ?[2](37[0](B ) (?[2](4"[0](B . ?[2](4"[0](B) - (?[2](36[0](B . ?[2](37[0](B ) (?[2](37[0](B . ?[2](37[0](B ) - (?[2](38[0](B . ?[2](39[0](B ) (?[2](39[0](B . ?[2](39[0](B ) - (?[2](4#[0](B . ?[2](4$[0](B) (?[2](3:[0](B . ?[2](3;[0](B ) (?[2](3;[0](B . ?[2](3;[0](B ) (?[2](4$[0](B . ?[2](4$[0](B) - (?[2](3<[0](B . ?[2](3=[0](B ) (?[2](3=[0](B . ?[2](3=[0](B ) - (?[2](4%[0](B . ?[2](4&[0](B) (?[2](3>[0](B . ?[2](3?[0](B ) (?[2](3?[0](B . ?[2](3?[0](B ) (?[2](4&[0](B . ?[2](4&[0](B) - (?[2](4'[0](B . ?[2](4([0](B) (?[2](3@[0](B . ?[2](3A[0](B ) (?[2](3A[0](B . ?[2](3A[0](B ) (?[2](4([0](B . ?[2](4([0](B) - (?[2](4)[0](B . ?[2](4,[0](B) (?[2](4*[0](B . ?[2](4+[0](B) (?[2](4+[0](B . ?[2](4+[0](B) (?[2](4,[0](B . ?[2](4,[0](B) - (?[2](4-[0](B . ?[2](40[0](B) (?[2](4.[0](B . ?[2](4/[0](B) (?[2](4/[0](B . ?[2](4/[0](B) (?[2](40[0](B . ?[2](40[0](B) - (?[2](41[0](B . ?[2](44[0](B) (?[2](42[0](B . ?[2](43[0](B) (?[2](43[0](B . ?[2](43[0](B) (?[2](44[0](B . ?[2](44[0](B) - (?[2](3B[0](B . ?[2](3C[0](B ) (?[2](3C[0](B . ?[2](3C[0](B ) - (?[2](3D[0](B . ?[2](3E[0](B ) (?[2](3E[0](B . ?[2](3E[0](B ) - (?[2](3F[0](B . ?[2](3G[0](B ) (?[2](3G[0](B . ?[2](3G[0](B ) - (?[2](3H[0](B . ?[2](3I[0](B ) (?[2](3I[0](B . ?[2](3I[0](B ) - (?[2](45[0](B . ?[2](48[0](B) (?[2](46[0](B . ?[2](47[0](B) (?[2](47[0](B . ?[2](47[0](B) (?[2](48[0](B . ?[2](48[0](B) - (?[2](49[0](B . ?[2](4<[0](B) (?[2](4:[0](B . ?[2](4;[0](B) (?[2](4;[0](B . ?[2](4;[0](B) (?[2](4<[0](B . ?[2](4<[0](B) - (?[2](4=[0](B . ?[2](4@[0](B) (?[2](4>[0](B . ?[2](4?[0](B) (?[2](4?[0](B . ?[2](4?[0](B) (?[2](4@[0](B . ?[2](4@[0](B) - (?[2](4A[0](B . ?[2](4D[0](B) (?[2](4B[0](B . ?[2](4C[0](B) (?[2](4C[0](B . ?[2](4C[0](B) (?[2](4D[0](B . ?[2](4D[0](B) - (?[2](4E[0](B . ?[2](4H[0](B) (?[2](4F[0](B . ?[2](4G[0](B) (?[2](4G[0](B . ?[2](4G[0](B) (?[2](4H[0](B . ?[2](4H[0](B) - (?[2](4I[0](B . ?[2](4L[0](B) (?[2](4J[0](B . ?[2](4K[0](B) (?[2](4K[0](B . ?[2](4K[0](B) (?[2](4L[0](B . ?[2](4L[0](B) - (?[2](4M[0](B . ?[2](4N[0](B) (?[2](3J[0](B . ?[2](3K[0](B ) (?[2](3K[0](B . ?[2](3K[0](B ) (?[2](4N[0](B . ?[2](4N[0](B) - (?[2](4O[0](B . ?[2](4P[0](B) (?[2](3L[0](B . ?[2](3M[0](B ) (?[2](3M[0](B . ?[2](3M[0](B ) (?[2](4P[0](B . ?[2](4P[0](B) - (?[2](4Q[0](B . ?[2](4R[0](B) (?[2](3N[0](B . ?[2](3O[0](B ) (?[2](3O[0](B . ?[2](3O[0](B ) (?[2](4R[0](B . ?[2](4R[0](B) - (?[2](4S[0](B . ?[2](4T[0](B) (?[2](3P[0](B . ?[2](3Q[0](B ) (?[2](3Q[0](B . ?[2](3Q[0](B ) (?[2](4T[0](B . ?[2](4T[0](B) - (?[2](4U[0](B . ?[2](4X[0](B) (?[2](4V[0](B . ?[2](4W[0](B) (?[2](4W[0](B . ?[2](4W[0](B) (?[2](4X[0](B . ?[2](4X[0](B) - (?[2](4Y[0](B . ?[2](4Z[0](B) (?[2](3R[0](B . ?[2](3S[0](B ) (?[2](3S[0](B . ?[2](3S[0](B ) (?[2](4Z[0](B . ?[2](4Z[0](B) - (?[2](3T[0](B . ?[2](3W[0](B ) (?[2](3U[0](B . ?[2](3V[0](B ) (?[2](3V[0](B . ?[2](3V[0](B ) (?[2](3W[0](B . ?[2](3W[0](B ) - (?[2](4[[0](B . ?[2](4\[0](B) (?[2](3X[0](B . ?[2](3Y[0](B ) (?[2](3Y[0](B . ?[2](3Y[0](B ) (?[2](4\[0](B . ?[2](4\[0](B) - (?[2](3Z[0](B . ?[2](3][0](B ) (?[2](3[[0](B . ?[2](3\[0](B ) (?[2](3\[0](B . ?[2](3\[0](B ) (?[2](3][0](B . ?[2](3][0](B ) - (?[2](3^[0](B . ?[2](3_[0](B ) (?[2](3_[0](B . ?[2](3_[0](B ) - (?[2](4][0](B . ?[2](4^[0](B) (?[2](4^[0](B . ?[2](4^[0](B) - (?[2](4_[0](B . ?[2](4`[0](B) (?[2](3`[0](B . ?[2](3a[0](B ) (?[2](3a[0](B . ?[2](3a[0](B ) (?[2](4`[0](B . ?[2](4`[0](B) - (?[2](3b[0](B . ?[2](4a[0](B) (?[2](4a[0](B . ?[2](4a[0](B) - (?[2](3c[0](B . ?[2](4b[0](B) (?[2](4b[0](B . ?[2](4b[0](B) - (?[2](3d[0](B . ?[2](4c[0](B) (?[2](4c[0](B . ?[2](4c[0](B) - (?[2](3e[0](B . ?[2](4d[0](B) (?[2](4d[0](B . ?[2](4d[0](B) - (?[2](4e[0](B . ?[2](4f[0](B) (?[2](3f[0](B . ?[2](3g[0](B ) (?[2](3g[0](B . ?[2](3g[0](B ) (?[2](4f[0](B . ?[2](4f[0](B) - (?[2](4g[0](B . ?[2](4j[0](B) (?[2](4h[0](B . ?[2](4i[0](B) (?[2](4i[0](B . ?[2](4i[0](B) (?[2](4j[0](B . ?[2](4j[0](B) - (?[2](3h[0](B . ?[2](3i[0](B ) (?[2](3i[0](B . ?[2](3i[0](B ) - (?[2](4k[0](B . ?[2](4n[0](B) (?[2](4l[0](B . ?[2](4m[0](B) (?[2](4m[0](B . ?[2](4m[0](B) (?[2](4n[0](B . ?[2](4n[0](B))) - -(defconst *arabic-adding-connection-to-left* - '((?[2](4 (?[2](36[0](B . ?[2](36[0](B ) (?[2](37[0](B . ?[2](37[0](B ) (?[2](4"[0](B . ?[2](37[0](B) - (?[2](4#[0](B . ?[2](3:[0](B ) (?[2](3:[0](B . ?[2](3:[0](B ) (?[2](3;[0](B . ?[2](3;[0](B ) (?[2](4$[0](B . ?[2](3;[0](B ) - (?[2](4%[0](B . ?[2](3>[0](B ) (?[2](3>[0](B . ?[2](3>[0](B ) (?[2](3?[0](B . ?[2](3?[0](B ) (?[2](4&[0](B . ?[2](3?[0](B ) - (?[2](4'[0](B . ?[2](3@[0](B ) (?[2](3@[0](B . ?[2](3@[0](B ) (?[2](3A[0](B . ?[2](3A[0](B ) (?[2](4([0](B . ?[2](3A[0](B ) - (?[2](4)[0](B . ?[2](4*[0](B) (?[2](4*[0](B . ?[2](4*[0](B) (?[2](4+[0](B . ?[2](4+[0](B) (?[2](4,[0](B . ?[2](4+[0](B) - (?[2](4-[0](B . ?[2](4.[0](B) (?[2](4.[0](B . ?[2](4.[0](B) (?[2](4/[0](B . ?[2](4/[0](B) (?[2](40[0](B . ?[2](4/[0](B) - (?[2](41[0](B . ?[2](42[0](B) (?[2](42[0](B . ?[2](42[0](B) (?[2](43[0](B . ?[2](43[0](B) (?[2](44[0](B . ?[2](43[0](B) - (?[2](45[0](B . ?[2](46[0](B) (?[2](46[0](B . ?[2](46[0](B) (?[2](47[0](B . ?[2](47[0](B) (?[2](48[0](B . ?[2](47[0](B) - (?[2](49[0](B . ?[2](4:[0](B) (?[2](4:[0](B . ?[2](4:[0](B) (?[2](4;[0](B . ?[2](4;[0](B) (?[2](4<[0](B . ?[2](4;[0](B) - (?[2](4=[0](B . ?[2](4>[0](B) (?[2](4>[0](B . ?[2](4>[0](B) (?[2](4?[0](B . ?[2](4?[0](B) (?[2](4@[0](B . ?[2](4?[0](B) - (?[2](4A[0](B . ?[2](4B[0](B) (?[2](4B[0](B . ?[2](4B[0](B) (?[2](4C[0](B . ?[2](4C[0](B) (?[2](4D[0](B . ?[2](4C[0](B) - (?[2](4E[0](B . ?[2](4F[0](B) (?[2](4F[0](B . ?[2](4F[0](B) (?[2](4G[0](B . ?[2](4G[0](B) (?[2](4H[0](B . ?[2](4G[0](B) - (?[2](4I[0](B . ?[2](4J[0](B) (?[2](4J[0](B . ?[2](4J[0](B) (?[2](4K[0](B . ?[2](4K[0](B) (?[2](4L[0](B . ?[2](4K[0](B) - (?[2](4M[0](B . ?[2](3J[0](B ) (?[2](3J[0](B . ?[2](3J[0](B ) (?[2](3K[0](B . ?[2](3K[0](B ) (?[2](4N[0](B . ?[2](3K[0](B ) - (?[2](4O[0](B . ?[2](3L[0](B ) (?[2](3L[0](B . ?[2](3L[0](B ) (?[2](3M[0](B . ?[2](3M[0](B ) (?[2](4P[0](B . ?[2](3M[0](B ) - (?[2](4Q[0](B . ?[2](3N[0](B ) (?[2](3N[0](B . ?[2](3N[0](B ) (?[2](3O[0](B . ?[2](3O[0](B ) (?[2](4R[0](B . ?[2](3O[0](B ) - (?[2](4S[0](B . ?[2](3P[0](B ) (?[2](3P[0](B . ?[2](3P[0](B ) (?[2](3Q[0](B . ?[2](3Q[0](B ) (?[2](4T[0](B . ?[2](3Q[0](B ) - (?[2](4U[0](B . ?[2](4V[0](B) (?[2](4V[0](B . ?[2](4V[0](B) (?[2](4W[0](B . ?[2](4W[0](B) (?[2](4X[0](B . ?[2](4W[0](B) - (?[2](4Y[0](B . ?[2](3R[0](B ) (?[2](3R[0](B . ?[2](3R[0](B ) (?[2](3S[0](B . ?[2](3S[0](B ) (?[2](4Z[0](B . ?[2](3S[0](B ) - (?[2](3T[0](B . ?[2](3U[0](B ) (?[2](3U[0](B . ?[2](3U[0](B ) (?[2](3V[0](B . ?[2](3V[0](B ) (?[2](3W[0](B . ?[2](3V[0](B ) - (?[2](4[[0](B . ?[2](3X[0](B ) (?[2](3X[0](B . ?[2](3X[0](B ) (?[2](3Y[0](B . ?[2](3Y[0](B ) (?[2](4\[0](B . ?[2](3Y[0](B ) - (?[2](3Z[0](B . ?[2](3[[0](B ) (?[2](3[[0](B . ?[2](3[[0](B ) (?[2](3\[0](B . ?[2](3\[0](B ) (?[2](3][0](B . ?[2](3\[0](B ) - (?[2](4_[0](B . ?[2](3`[0](B ) (?[2](3`[0](B . ?[2](3`[0](B ) (?[2](3a[0](B . ?[2](3a[0](B ) (?[2](4`[0](B . ?[2](3a[0](B ) - (?[2](4e[0](B . ?[2](3f[0](B ) (?[2](3f[0](B . ?[2](3f[0](B ) (?[2](3g[0](B . ?[2](3g[0](B ) (?[2](4f[0](B . ?[2](3g[0](B) - (?[2](4g[0](B . ?[2](4h[0](B) (?[2](4h[0](B . ?[2](4h[0](B) (?[2](4i[0](B . ?[2](4i[0](B) (?[2](4j[0](B . ?[2](4i[0](B) - (?[2](4k[0](B . ?[2](4l[0](B) (?[2](4l[0](B . ?[2](4l[0](B) (?[2](4m[0](B . ?[2](4m[0](B) (?[2](4n[0](B . ?[2](4m[0](B))) - -(defconst *arabic-removing-connection-from-right* - '((?[2](3/[0](B . ?[2](3.[0](B ) - (?[2](31[0](B . ?[2](30[0](B ) - (?[2](33[0](B . ?[2](32[0](B ) - (?[2](35[0](B . ?[2](34[0](B ) - (?[2](4"[0](B . ?[2](4 (?[2](37[0](B . ?[2](36[0](B ) - (?[2](39[0](B . ?[2](38[0](B ) - (?[2](4$[0](B . ?[2](4#[0](B) (?[2](3;[0](B . ?[2](3:[0](B ) - (?[2](3=[0](B . ?[2](3<[0](B ) - (?[2](4&[0](B . ?[2](4%[0](B) (?[2](3?[0](B . ?[2](3>[0](B ) - (?[2](4([0](B . ?[2](4'[0](B) (?[2](3A[0](B . ?[2](3@[0](B ) - (?[2](4,[0](B . ?[2](4)[0](B) (?[2](4+[0](B . ?[2](4*[0](B) - (?[2](40[0](B . ?[2](4-[0](B) (?[2](4/[0](B . ?[2](4.[0](B) - (?[2](44[0](B . ?[2](41[0](B) (?[2](43[0](B . ?[2](42[0](B) - (?[2](3C[0](B . ?[2](3B[0](B ) - (?[2](3E[0](B . ?[2](3D[0](B ) - (?[2](3G[0](B . ?[2](3F[0](B ) - (?[2](3I[0](B . ?[2](3H[0](B ) - (?[2](48[0](B . ?[2](45[0](B) (?[2](47[0](B . ?[2](46[0](B) - (?[2](4<[0](B . ?[2](49[0](B) (?[2](4;[0](B . ?[2](4:[0](B) - (?[2](4@[0](B . ?[2](4=[0](B) (?[2](4?[0](B . ?[2](4>[0](B) - (?[2](4D[0](B . ?[2](4A[0](B) (?[2](4C[0](B . ?[2](4B[0](B) - (?[2](4H[0](B . ?[2](4E[0](B) (?[2](4G[0](B . ?[2](4F[0](B) - (?[2](4L[0](B . ?[2](4I[0](B) (?[2](4K[0](B . ?[2](4J[0](B) - (?[2](4N[0](B . ?[2](4M[0](B) (?[2](3K[0](B . ?[2](3J[0](B ) - (?[2](4P[0](B . ?[2](4O[0](B) (?[2](3M[0](B . ?[2](3L[0](B ) - (?[2](4R[0](B . ?[2](4Q[0](B) (?[2](3O[0](B . ?[2](3N[0](B ) - (?[2](4T[0](B . ?[2](4S[0](B) (?[2](3Q[0](B . ?[2](3P[0](B ) - (?[2](4X[0](B . ?[2](4U[0](B) (?[2](4W[0](B . ?[2](4V[0](B) - (?[2](4Z[0](B . ?[2](4Y[0](B) (?[2](3S[0](B . ?[2](3R[0](B ) - (?[2](3W[0](B . ?[2](3T[0](B ) (?[2](3V[0](B . ?[2](3U[0](B ) - (?[2](4\[0](B . ?[2](4[[0](B) (?[2](3Y[0](B . ?[2](3X[0](B ) - (?[2](3][0](B . ?[2](3Z[0](B ) (?[2](3\[0](B . ?[2](3[[0](B ) - (?[2](3_[0](B . ?[2](3^[0](B ) - (?[2](4^[0](B . ?[2](4][0](B) - (?[2](4`[0](B . ?[2](4_[0](B) (?[2](3a[0](B . ?[2](3`[0](B ) - (?[2](4a[0](B . ?[2](3b[0](B ) - (?[2](4b[0](B . ?[2](3c[0](B ) - (?[2](4c[0](B . ?[2](3d[0](B ) - (?[2](4d[0](B . ?[2](3e[0](B ) - (?[2](4f[0](B . ?[2](4e[0](B) (?[2](3g[0](B . ?[2](3f[0](B ) - (?[2](4j[0](B . ?[2](4g[0](B) (?[2](4i[0](B . ?[2](4h[0](B) - (?[2](3i[0](B . ?[2](3h[0](B) - (?[2](4n[0](B . ?[2](4k[0](B) (?[2](4m[0](B . ?[2](4l[0](B))) - -(defconst *arabic-removing-connection-from-left* - '((?[2](36[0](B . ?[2](4 (?[2](37[0](B . ?[2](4"[0](B) - (?[2](3:[0](B . ?[2](4#[0](B) (?[2](3;[0](B . ?[2](4$[0](B) - (?[2](3>[0](B . ?[2](4%[0](B) (?[2](3?[0](B . ?[2](4&[0](B) - (?[2](3@[0](B . ?[2](4'[0](B) (?[2](3A[0](B . ?[2](4([0](B) - (?[2](4*[0](B . ?[2](4)[0](B) (?[2](4+[0](B . ?[2](4,[0](B) - (?[2](4.[0](B . ?[2](4-[0](B) (?[2](4/[0](B . ?[2](40[0](B) - (?[2](42[0](B . ?[2](41[0](B) (?[2](43[0](B . ?[2](44[0](B) - (?[2](46[0](B . ?[2](45[0](B) (?[2](47[0](B . ?[2](48[0](B) - (?[2](4:[0](B . ?[2](49[0](B) (?[2](4;[0](B . ?[2](4<[0](B) - (?[2](4>[0](B . ?[2](4=[0](B) (?[2](4?[0](B . ?[2](4@[0](B) - (?[2](4D[0](B . ?[2](4A[0](B) (?[2](4C[0](B . ?[2](4A[0](B) - (?[2](4F[0](B . ?[2](4E[0](B) (?[2](4G[0](B . ?[2](4H[0](B) - (?[2](4J[0](B . ?[2](4I[0](B) (?[2](4K[0](B . ?[2](4L[0](B) - (?[2](3J[0](B . ?[2](4M[0](B) (?[2](3K[0](B . ?[2](4N[0](B) - (?[2](3L[0](B . ?[2](4O[0](B) (?[2](3M[0](B . ?[2](4P[0](B) - (?[2](3N[0](B . ?[2](4Q[0](B) (?[2](3O[0](B . ?[2](4R[0](B) - (?[2](3P[0](B . ?[2](4S[0](B) (?[2](3Q[0](B . ?[2](4T[0](B) - (?[2](4V[0](B . ?[2](4U[0](B) (?[2](4W[0](B . ?[2](4X[0](B) - (?[2](3R[0](B . ?[2](4Y[0](B) (?[2](3S[0](B . ?[2](4Z[0](B) - (?[2](3U[0](B . ?[2](3T[0](B ) (?[2](3V[0](B . ?[2](3W[0](B ) - (?[2](3X[0](B . ?[2](4[[0](B) (?[2](3Y[0](B . ?[2](4\[0](B) - (?[2](3[[0](B . ?[2](3Z[0](B ) (?[2](3\[0](B . ?[2](3][0](B ) - (?[2](3`[0](B . ?[2](4_[0](B) (?[2](3a[0](B . ?[2](4`[0](B) - (?[2](4h[0](B . ?[2](4g[0](B) (?[2](4i[0](B . ?[2](4j[0](B) - (?[2](4l[0](B . ?[2](4k[0](B) (?[2](4m[0](B . ?[2](4n[0](B))) - -(defun arabic-make-connection nil - "If possible, tie the two characters around the cursor." - (interactive) - (let ((lch (assoc (visual-char-left) *arabic-adding-connection-to-right*)) - (rch (assoc (visual-char-right) *arabic-adding-connection-to-left*))) - (if (not (and lch rch)) - (arabic-cut-connection) - (visual-replace-left-1-char (cdr lch)) - (visual-replace-right-1-char (cdr rch))))) - -(defun arabic-cut-connection nil - "Remove the connection between the two characters around the cursor, if any." - (interactive) - (let - ((lch (assoc (visual-char-left) *arabic-removing-connection-from-right*)) - (rch (assoc (visual-char-right) *arabic-removing-connection-from-left*))) - (if lch - (visual-replace-left-1-char (cdr lch))) - (if rch - (visual-replace-right-1-char (cdr rch))))) - -(defun arabic-insert-char (ch arg) - "Insert ARG (2nd arg; > 0) number of CHs (1st arg; character) around -visual point. -If CH is l2r, inserted on the left. Otherwise, on the right." - (while (> arg 0) - (arabic-insert-1-char ch) - (setq arg (1- arg)))) - -(defun arabic-insert-1-char (ch) - "Insert CH (1st arg; character) around visual point. -If CH is l2r, inserted on the left. Otherwise, on the right." - (if (= (visual-char-direction ch) 0) - ; if visual-char-direction = 0, always disjoint. - (progn - (arabic-cut-connection) - (visual-insert-left-1-char ch)) - (visual-insert-left-1-char ch) - (arabic-make-connection) - (visual-move-to-left-1-char) - (arabic-make-connection))) - -(defun arabic-self-insert-command (arg) - "Self-insert-command for arabic-mode." - (interactive "*p") - (let ((ch last-command-char)) - (if arabic-input-arabic-char - (setq ch (aref arabic-translate-table (- ch 32)))) - (if (null ch) - (beep) - (while (> arg 0) - (arabic-keyboard-insert-1-char ch) - (setq arg (1- arg)))))) - -(defun arabic-keyboard-insert-1-char (ch) - "Insert CH (1st arg; Arabic character) at visual cursor position. -if last-command is arabic-cut-connection, CH will not connected to the -right adjacent character (but connected to the left, if possible)." - (let ((rch (visual-char-right))) - (cond - ((= (visual-char-direction ch) 0) - (arabic-cut-connection) - (visual-insert-left-1-char ch)) - ((eq last-command 'arabic-cut-connection) - (visual-insert-right-1-char ch) - (arabic-make-connection)) - (t - (arabic-insert-1-char ch))))) - -(defun arabic-insert-gaaf (arg) - "Insert gaaf as if it were typed from keyboard." - (interactive "*p") - (while (> arg 0) - (arabic-keyboard-insert-1-char ?[2](4k[0](B) - (setq arg (1- arg)))) - -(defun arabic-insert-isolated-hamza (arg) - "Insert an isolated hamza as if it were typed from keyboard." - (interactive "*p") - (while (> arg 0) - (arabic-keyboard-insert-1-char ?[2](3-[0](B) - (setq arg (1- arg)))) - -(defun arabic-insert-madda nil - "Put madda on the previous alif." - (interactive) - (let ((rch (visual-char-right))) - (cond - ((eq rch ?[2](38[0](B ) (visual-replace-right-1-char ?[2](3.[0](B )) - ((eq rch ?[2](39[0](B ) (visual-replace-right-1-char ?[2](3/[0](B )) - ((eq rch ?[2](3e[0](B ) (visual-replace-right-1-char ?[2](3b[0](B )) - ((eq rch ?[2](4d[0](B) (visual-replace-right-1-char ?[2](4a[0](B)) - (t (beep))))) - -(defun arabic-insert-alif (arg) - "Insert ARG number of alif's. -If the previous character is a laam, replace it with an alif+laam ligature." - (interactive "*p") - (let (rch) - (while (> arg 0) - (setq rch (visual-char-right)) - (cond - ((eq last-command 'arabic-cut-connection) - (visual-insert-right-1-char ?[2](38[0](B)) - ((or (eq rch ?[2](4Y[0](B) (eq rch ?[2](3R[0](B )) - (visual-replace-right-1-char ?[2](3e[0](B )) - ((or (eq rch ?[2](3S[0](B ) (eq rch ?[2](4Z[0](B)) - (visual-replace-right-1-char ?[2](4d[0](B)) - (t - (visual-insert-left-1-char ?[2](38[0](B ) - (arabic-make-connection) - (visual-move-to-left-1-char))) - (setq arg (1- arg))) - (arabic-cut-connection))) - -(defun arabic-insert-hamza (arg) - "Insert ARG number of hamza's. -Put it on/under previous characters, if possible." - (interactive "*p") - (let (rch) - (while (> arg 0) - (setq rch (visual-char-right)) - (cond - ((eq last-command 'arabic-cut-connection) - (visual-insert-right-1-char ?[2](3-[0](B)) - ((eq rch ?[2](38[0](B ) (visual-replace-right-1-char ?[2](30[0](B )) - ((eq rch ?[2](39[0](B ) (visual-replace-right-1-char ?[2](31[0](B )) - ((eq rch ?[2](30[0](B ) (visual-replace-right-1-char ?[2](34[0](B )) - ((eq rch ?[2](31[0](B ) (visual-replace-right-1-char ?[2](35[0](B )) - ((eq rch ?[2](3^[0](B ) (visual-replace-right-1-char ?[2](32[0](B )) - ((eq rch ?[2](3_[0](B ) (visual-replace-right-1-char ?[2](33[0](B )) - ((eq rch ?[2](4_[0](B) (visual-replace-right-1-char ?[2](4) - ((eq rch ?[2](3`[0](B ) (visual-replace-right-1-char ?[2](36[0](B )) - ((eq rch ?[2](3a[0](B ) (visual-replace-right-1-char ?[2](37[0](B )) - ((eq rch ?[2](4`[0](B) (visual-replace-right-1-char ?[2](4"[0](B)) - ((eq rch ?[2](4][0](B) (visual-replace-right-1-char ?[2](4) - ((eq rch ?[2](4^[0](B) (visual-replace-right-1-char ?[2](4"[0](B)) - ((eq rch ?[2](3e[0](B ) (visual-replace-right-1-char ?[2](3c[0](B )) - ((eq rch ?[2](4d[0](B) (visual-replace-right-1-char ?[2](4b[0](B)) - ((eq rch ?[2](3c[0](B ) (visual-replace-right-1-char ?[2](3d[0](B )) - ((eq rch ?[2](4b[0](B) (visual-replace-right-1-char ?[2](4c[0](B)) - (t (arabic-cut-connection) - (visual-insert-right-1-char ?[2](3-[0](B))) - (setq arg (1- arg))))) - -(defun arabic-toggle-input-char nil - "Toggle Arabic key input and ASCII key input." - (interactive) - (if arabic-input-arabic-char - (setq arabic-input-arabic-char nil - arabic-mode-indicator " Arabic") - (setq arabic-input-arabic-char t - arabic-mode-indicator " [2](3=a:GJ[0](B")) - (redraw-modeline t)) - -(defun arabic-newline (arg) - "Newline for arabic-mode." - (interactive "*p") - (arabic-insert-char ?\n arg)) - -(defun arabic-open-line (arg) - "Openline for arabic-mode." - (interactive "*p") - (arabic-insert-char ?\n arg) - (visual-backward-char arg)) - -(defun arabic-delete-char (arg) - "Delete ARG (1st arg; integer) chars visually after visual point. -After that, Arabic ligature is performed." - (interactive "*p") - (visual-delete-char arg) - (arabic-make-connection)) - -(defun arabic-backward-delete-char (arg) - "Delete ARG (1st arg; integer) chars visually before visual point. -After that, Arabic ligature is performed." - (interactive "*p") - (visual-backward-delete-char arg) - (arabic-make-connection)) - -(defun arabic-kill-region (beg end) - "Kill-region command for arabic-mode." - (interactive "r") - (if (or (and buffer-read-only (not inhibit-read-only)) - (text-property-not-all beg end 'read-only nil)) - (visual-kill-region beg end) - (visual-kill-region beg end) - (arabic-make-connection))) - -(defun arabic-kill-word (arg) - "Kill-word command for arabic-mode." - (interactive "*p") - (visual-kill-word arg) - (arabic-make-connection)) - -(defun arabic-backward-kill-word (arg) - "Backword-ill-word command for arabic-mode." - (interactive "*p") - (visual-backward-kill-word arg) - (arabic-make-connection)) - -(defun arabic-kill-line (&optional arg) - "Kill-line command for arabic-mode." - (interactive "*P") - (visual-kill-line arg) - (arabic-make-connection)) - -(defun arabic-yank (&optional arg) - "yank command for arabic-mode." - (interactive "*P") - (visual-yank arg) - (let ((p1 (point)) (p2 (mark t))) - (arabic-make-connection) - (goto-char p2) - (arabic-make-connection) - (goto-char p1) - (set-marker (mark-marker) p2 (current-buffer)) - nil)) - -(defun arabic-yank-pop (arg) - "yank-pop command for arabic-mode." - (interactive "*p") - (visual-yank-pop arg) - (let ((p1 (point)) (p2 (mark t))) - (arabic-make-connection) - (goto-char p2) - (arabic-make-connection) - (goto-char p1) - (set-marker (mark-marker) p2 (current-buffer)) - nil)) - -(defun arabic-help nil - "Display keymap in Arabic-mode." - (interactive) - (let ((arabic-help-buffer (get-buffer-create "*Help*"))) - (set-buffer arabic-help-buffer) - (erase-buffer) - (insert arabic-help-string) - (goto-char (point-min)) - (display-buffer (current-buffer)))) - - -;; arabic LR commands - -(defun arabic-delete-left-char (arg) - "Kill N (1st arg; integer) characters on the left of visual point." - (interactive "*p") - (if display-direction - (arabic-delete-char arg) - (arabic-backward-delete-char arg))) - -(defun arabic-delete-right-char (arg) - "Kill N (1st arg; integer) characters on the right of visual point." - (interactive "*p") - (if display-direction - (arabic-backward-delete-char arg) - (arabic-delete-char arg))) - -(defun arabic-kill-left-word (arg) - "Kill N (1st arg; integer) words on the left of visual point." - (interactive "*p") - (if display-direction - (arabic-kill-word arg) - (arabic-backward-kill-word arg))) - -(defun arabic-kill-right-word (arg) - "Kill N (1st arg; integer) words on the right of visual point." - (interactive "*p") - (if display-direction - (arabic-backward-kill-word arg) - (arabic-kill-word arg))) - -;;; -(provide 'arabic)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mule/auto-autoloads.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,243 @@ +;;; DO NOT MODIFY THIS FILE +(if (not (featurep 'mule-autoloads)) + (progn + +;;;### (autoloads (isearch-fep-quail isearch-fep-canna isearch-fep-egg isearch-fep-string) "isearch-mule" "mule/isearch-mule.el") + +(defvar search-string-char-prompt "*Enter string... ") + +(autoload 'isearch-fep-string "isearch-mule" "\ +Read string from minibuffer for incremental search." t nil) + +(autoload 'isearch-fep-egg "isearch-mule" "\ +Read string for incremental search by using egg." t nil) + +(autoload 'isearch-fep-canna "isearch-mule" "\ +Read string for incremental search by using canna." t nil) + +(autoload 'isearch-fep-quail "isearch-mule" "\ +Read string for incremental search by using quail." t nil) + +;;;*** + +;;;### (autoloads (define-ccl-program ccl-dump ccl-compile ccl-program-p) "mule-ccl" "mule/mule-ccl.el") + +(autoload 'ccl-program-p "mule-ccl" "\ +T if OBJECT is a valid CCL compiled code." nil nil) + +(autoload 'ccl-compile "mule-ccl" "\ +Compile a CCL source program and return the compiled equivalent. +The return value will be a vector of integers." nil nil) + +(autoload 'ccl-dump "mule-ccl" "\ +Disassemble compiled CCL-CODE." nil nil) + +(autoload 'define-ccl-program "mule-ccl" "\ +Does (defconst NAME (ccl-compile (eval CCL-PROGRAM)) DOC). +Byte-compiler expand this macro while compiling." nil 'macro) + +;;;*** + +;;;### (autoloads (dump-coding-systems dump-charsets mule-diag list-fontset describe-fontset list-font describe-font list-coding-system list-coding-system-briefly describe-coding-system list-charsets) "mule-debug" "mule/mule-debug.el") + +(autoload 'list-charsets "mule-debug" "\ +Display a list of existing character sets." t nil) + +(autoload 'describe-coding-system "mule-debug" "\ +Display documentation of the coding-system CS." t nil) + +(autoload 'list-coding-system-briefly "mule-debug" "\ +Display coding-systems currently used with a brief format in mini-buffer." t nil) + +(autoload 'list-coding-system "mule-debug" "\ +Describe coding-systems currently used with a detailed format. +If optional arg ALL is non-nil, all coding-systems are listed in +machine readable simple format." t nil) + +(autoload 'describe-font "mule-debug" "\ +Display information about fonts which partially match FONTNAME." t nil) + +(autoload 'list-font "mule-debug" "\ +Display a list of fonts." t nil) + +(autoload 'describe-fontset "mule-debug" "\ +Display information about FONTSET." t nil) + +(autoload 'list-fontset "mule-debug" "\ +Display a list of fontsets." t nil) + +(autoload 'mule-diag "mule-debug" "\ +Show diagnosis of the current running Mule." t nil) + +(autoload 'dump-charsets "mule-debug" nil nil nil) + +(autoload 'dump-coding-systems "mule-debug" nil nil nil) + +;;;*** + +;;;### (autoloads (set-keyboard-coding-system) "mule-keyboard" "mule/mule-keyboard.el") + +(defvar keyboard-allow-latin-input nil "\ +If non-nil, \"ESC , Fe\" and \"ESC - Fe\" are used for inputting +Latin characters.") + +(autoload 'set-keyboard-coding-system "mule-keyboard" "\ +Set variable keyboard-coding-system to CODESYS and modify keymap for it." t nil) + +;;;*** + +;;;### (autoloads (define-word-regexp regexp-word-compile regexp-compile) "mule-trex" "mule/mule-trex.el") + +(autoload 'regexp-compile "mule-trex" nil nil nil) + +(autoload 'regexp-word-compile "mule-trex" nil nil nil) + +(autoload 'define-word-regexp "mule-trex" nil nil 'macro) + +;;;*** + +;;;### (autoloads (decompose-composite-char compose-chars decompose-region compose-region set-coding-system-alist lookup-nested-alist set-nested-alist truncate-string-to-width store-substring) "mule-util" "mule/mule-util.el") + +(defsubst string-to-sequence (string type) "Convert STRING to a sequence of TYPE which contains characters in STRING.\nTYPE should be `list' or `vector'.\nMultibyte characters are conserned." (map type (function identity) string)) + +(defsubst string-to-list (string) "Return a list of characters in STRING." (mapcar (function identity) string)) + +(defsubst string-to-vector (string) "Return a vector of characters in STRING." (string-to-sequence string 'vector)) + +(autoload 'store-substring "mule-util" "\ +Embed OBJ (string or character) at index IDX of STRING." nil nil) + +(autoload 'truncate-string-to-width "mule-util" "\ +Truncate string STR to fit in WIDTH columns. +Optional 1st arg START-COLUMN if non-nil specifies the starting column. +Optional 2nd arg PADDING if non-nil is a padding character to be padded at +the head and tail of the resulting string to fit in WIDTH if necessary. +If PADDING is nil, the resulting string may be narrower than WIDTH." nil nil) + +(defalias 'truncate-string 'truncate-string-to-width) + +(defsubst nested-alist-p (obj) "Return t if OBJ is a nesetd alist.\n\nNested alist is a list of the form (ENTRY . BRANCHES), where ENTRY is\nany Lisp object, and BRANCHES is a list of cons cells of the form\n(KEY-ELEMENT . NESTED-ALIST).\n\nYou can use a nested alist to store any Lisp object (ENTRY) for a key\nsequence KEYSEQ, where KEYSEQ is a sequence of KEY-ELEMENT. KEYSEQ\ncan be a string, a vector, or a list." (and obj (listp obj) (listp (cdr obj)))) + +(autoload 'set-nested-alist "mule-util" "\ +Set ENTRY for KEYSEQ in a nested alist ALIST. +Optional 4th arg LEN non-nil means the firlst LEN elements in KEYSEQ + 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) + +(autoload 'lookup-nested-alist "mule-util" "\ +Look up key sequence KEYSEQ in nested alist ALIST. Return the definition. +Optional 1st argument LEN specifies the length of KEYSEQ. +Optional 2nd argument START specifies index of the starting key. +The returned value is normally a nested alist of which +car part is the entry for KEYSEQ. +If ALIST is not deep enough for KEYSEQ, return number which is + 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) + +(autoload 'set-coding-system-alist "mule-util" "\ +Update `coding-system-alist' according to the arguments. +TARGET-TYPE specifies a type of the target: `file', `process', or `network'. + TARGET-TYPE tells which slots of coding-system-alist should be affected. + If `file', it affects slots for insert-file-contents and write-region. + If `process', it affects slots for call-process, call-process-region, and + start-process. + If `network', it affects a slot for open-network-process. +REGEXP is a regular expression matching a target of I/O operation. +CODING-SYSTEM is a coding system to perform code conversion + on the I/O operation, or a cons of coding systems for decoding and + encoding respectively, or a function symbol which returns the cons. +Optional arg OPERATION if non-nil specifies directly one of slots above. + The valid value is: insert-file-contents, write-region, + call-process, call-process-region, start-process, or open-network-stream. +If OPERATION is specified, TARGET-TYPE is ignored. +See the documentation of `coding-system-alist' for more detail." nil nil) + +(autoload 'compose-region "mule-util" "\ +Compose characters in the current region into one composite character. +From a Lisp program, pass two arguments, START to END. +The composite character replaces the composed characters. +BUFFER defaults to the current buffer if omitted." t nil) + +(autoload 'decompose-region "mule-util" "\ +Decompose any composite characters in the current region. +From a Lisp program, pass two arguments, START to END. +This converts each composite character into one or more characters, +the individual characters out of which the composite character was formed. +Non-composite characters are left as-is. BUFFER defaults to the current +buffer if omitted." t nil) + +(defconst reference-point-alist '((tl . 0) (tc . 1) (tr . 2) (ml . 3) (mc . 4) (mr . 5) (bl . 6) (bc . 7) (br . 8) (top-left . 0) (top-center . 1) (top-right . 2) (mid-left . 3) (mid-center . 4) (mid-right . 5) (bottom-left . 6) (bottom-center . 7) (bottom-right . 8) (0 . 0) (1 . 1) (2 . 2) (3 . 3) (4 . 4) (5 . 5) (6 . 6) (7 . 7) (8 . 8)) "\ +Alist of reference point symbols vs reference point codes. +Meanings of 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:ml or mid-left + | 4 <--+---- center 4:mc or mid-center + | | 5:mr or mid-right +--- 3 5 <-- baseline 6:bl or bottom-left + | | 7:bc or bottom-center + 6----7----8 <-- descent 8:br or bottom-right + +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 8 and NEW-REF-POINT is 1, the +overall glyph is updated as follows: + + +-------+--+ <--- new ascent + | | | + | global| | + | glyph | | +--- | | | <--- baseline (doesn't change) + +----+--+--+ + | | new | + | |glyph| + +----+-----+ <--- new descent +") + +(autoload 'compose-chars "mule-util" "\ +Return one char string composed from the arguments. +Each argument is a character (including a composite chararacter) +or a composition rule. +A composition rule has the form (GLOBAL-REF-POINT . NEW-REF-POINT). +See the documentation of `reference-point-alist' for more detail." nil nil) + +(autoload 'decompose-composite-char "mule-util" "\ +Convert composite character CHAR to a string containing components of CHAR. +Optional 1st arg TYPE specifies the type of sequence returned. +It should be `string' (default), `list', or `vector'. +Optional 2nd arg WITH-COMPOSITION-RULE non-nil means the returned +sequence contains embedded composition rules if any. In this case, the +order of elements in the sequence is the same as arguments for +`compose-chars' to create CHAR. +If TYPE is omitted or is `string', composition rules are omitted +even if WITH-COMPOSITION-RULE is t." nil nil) + +;;;*** + +;;;### (autoloads (vn-decompose-viqr-buffer vn-decompose-viqr vn-compose-viqr-buffer vn-compose-viqr) "vietnamese" "mule/vietnamese.el") + +(autoload 'vn-compose-viqr "vietnamese" "\ +Convert 'VIQR' mnemonics of the current region to +pre-composed Vietnamese characaters." t nil) + +(autoload 'vn-compose-viqr-buffer "vietnamese" nil t nil) + +(autoload 'vn-decompose-viqr "vietnamese" "\ +Convert pre-composed Vietnamese characaters of the current region to +'VIQR' mnemonics." t nil) + +(autoload 'vn-decompose-viqr-buffer "vietnamese" nil t nil) + +;;;*** + +(provide 'mule-autoloads) +))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mule/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,64 @@ +(put 'copyright 'custom-loads '()) +(put 'eldoc 'custom-loads '()) +(put 'execute 'custom-loads '()) +(put 'mouse 'custom-loads '()) +(put 'mail-abbrevs 'custom-loads '()) +(put 'etags 'custom-loads '()) +(put 'limits 'custom-loads '()) +(put 'minibuffer 'custom-loads '()) +(put 'environment 'custom-loads '()) +(put 'sound 'custom-loads '()) +(put 'holidays 'custom-loads '()) +(put 'auto-save 'custom-loads '()) +(put 'ispell 'custom-loads '()) +(put 'fortran-indent 'custom-loads '()) +(put 'lpr 'custom-loads '()) +(put 'message-headers 'custom-loads '()) +(put 'editing-basics 'custom-loads '()) +(put 'internal 'custom-loads '()) +(put 'calendar 'custom-loads '()) +(put 'help-appearance 'custom-loads '()) +(put 'display-time 'custom-loads '()) +(put 'lisp 'custom-loads '()) +(put 'diff 'custom-loads '()) +(put 'paren-matching 'custom-loads '()) +(put 'help 'custom-loads '()) +(put 'local 'custom-loads '()) +(put 'keyboard 'custom-loads '()) +(put 'minubuffer 'custom-loads '()) +(put 'message-sending 'custom-loads '()) +(put 'data 'custom-loads '()) +(put 'ps-print 'custom-loads '()) +(put 'backup 'custom-loads '()) +(put 'frames 'custom-loads '()) +(put 'customize 'custom-loads '()) +(put 'abbrev 'custom-loads '()) +(put 'toolbar 'custom-loads '()) +(put 'compilation 'custom-loads '()) +(put 'dired 'custom-loads '()) +(put 'killing 'custom-loads '()) +(put 'paren-blinking 'custom-loads '()) +(put 'find-file 'custom-loads '()) +(put 'gnuserv 'custom-loads '()) +(put 'maint 'custom-loads '()) +(put 'fill-comments 'custom-loads '()) +(put 'message-mail 'custom-loads '()) +(put 'windows 'custom-loads '()) +(put 'message-various 'custom-loads '()) +(put 'resize-minibuffer 'custom-loads '()) +(put 'fill 'custom-loads '()) +(put 'debug 'custom-loads '()) +(put 'display 'custom-loads '()) +(put 'diary 'custom-loads '()) +(put 'browse-url 'custom-loads '()) +(put 'message-insertion 'custom-loads '()) +(put 'vc 'custom-loads '()) +(put 'alloc 'custom-loads '()) +(put 'isearch 'custom-loads '()) +(put 'modeline 'custom-loads '()) +(put 'processes-basics 'custom-loads '()) +(put 'editing 'custom-loads '()) +(put 'matching 'custom-loads '()) +(put 'ps-print-color 'custom-loads '()) +(put 'undo 'custom-loads '()) +(put 'x 'custom-loads '())
--- a/lisp/mule/ethiopic-hooks.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/mule/ethiopic-hooks.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,60 +0,0 @@ -;;; ethiopic-hooks.el --- pre-loaded support for Ethiopic. - -;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. -;; Copyright (C) 1995 Amdahl Corporation. -;; Copyright (C) 1995 Sun Microsystems. - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: Mule 2.3. - -;; Ethiopic -(make-charset 'ethiopic "Ethiopic" - '(registry "Ethio" - dimension 2 - chars 94 - final ?2 - graphic 0 - )) - - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; ETHIOPIC -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define-category ?E "Ethiopic (Ge'ez) character.") -(modify-category-entry 'ethiopic ?E) - -(define-ccl-program ccl-ethiopic - '(((r0 -= #x21) - (r1 -= #x21) - (r0 *= 94) - (r1 += r0) - (if (r1 < 256) (r0 = 0) ((r1 -= 256) (r0 = 1)))))) - -(set-charset-ccl-program 'ethiopic ccl-ethiopic) - -(add-hook 'quail-package-alist '("ethio" "quail-ethio")) - -(define-language-environment 'ethiopic - "Ethiopic" - #'(lambda () - (setq-default quail-current-package - (assoc "ethio" quail-package-alist))))
--- a/lisp/mule/ethiopic.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/mule/ethiopic.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,1093 +0,0 @@ -;; Ethiopic language utilities for Mule -;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. - -;; This file is part of XEmacs. -;; This file contains Ethiopic characters. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; 94.10.13 created for Mule Ver.2.1 by TAKAHASHI Naoto <ntakahas@etl.go.jp> -;;; 94.12.27 modified for Mule Ver.2.2 by TAKAHASHI Naoto <ntakahas@etl.go.jp> -;;; 95.7.24 modified for Mule Ver.2.3 by TAKAHASHI Naoto <ntakahas@etl.go.jp> - -;; -;; ETHIOPIC UTILITY FUNCTIONS -;; - -;; To automatically convert Ethiopic text to SERA format when sending mail, -;; (add-hook 'mail-send-hook 'fidel-to-sera-mail) -;; -;; To automatically convert SERA format to Ethiopic when receiving mail, -;; (add-hook 'rmail-show-message-hook 'sera-to-fidel-mail) -;; -;; To automatically convert Ethiopic text to SERA format when posting news, -;; (add-hook 'news-inews-hook 'fidel-to-sera-mail) -;; -;; If the filename ends in ".sera", editing will be done in fidel -;; while file I/O will be done in sera. -;; -;; The following two functions have been removed. -;; fidel-to-sera-for-disksave -;; sera-to-fidel-for-disksave - -;; -;; SERA to FIDEL -;; - -(defconst sera-to-fidel-table - [ - nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil - nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil -;;; SP ! " # $ % & ' ( ) * + , - . / - nil nil nil nil nil nil nil ("") nil nil nil nil ("$(2$Q(B") nil ("$(2$P(B") nil -;;; 0 1 2 3 4 5 6 7 8 9 : ; < = > ? @ - nil nil nil nil nil nil nil nil nil nil ("$(2$S(B") ("$(2$R(B") nil nil nil nil nil -;;; A - ("$(2"V(B" (?2 "$(2#b(B")) -;;; B - ("$(2!F(B" (?e "$(2!A(B") (?u "$(2!B(B") (?i "$(2!C(B") (?a "$(2!D(B") (?E "$(2!E(B") (?o "$(2!G(B") (?| "$(2!F(B") - (?W "$(2!H(B" (?a "$(2!H(B") - (?e "$(2!F#L(B") (?u "$(2!F#M(B") (?i "$(2!F#N(B") (?E "$(2!F#P(B") (?' "$(2!F#M(B"))) -;;; C - ("$(2"8(B" (?e "$(2"3(B") (?u "$(2"4(B") (?i "$(2"5(B") (?a "$(2"6(B") (?E "$(2"7(B") (?o "$(2"9(B") (?| "$(2"8(B") - (?W "$(2":(B" (?a "$(2":(B") - (?e "$(2"8#L(B") (?u "$(2"8#M(B") (?i "$(2"8#N(B") (?E "$(2"8#P(B") (?' "$(2"8#M(B"))) -;;; D - ("$(2$0(B" (?e "$(2$+(B") (?u "$(2$,(B") (?i "$(2$-(B") (?a "$(2$.(B") (?E "$(2$/(B") (?o "$(2$1(B") (?| "$(2$0(B")) -;;; E - ("$(2"W(B" (?2 "$(2#c(B")) -;;; F - ("$(2"@(B" (?e "$(2";(B") (?u "$(2"<(B") (?i "$(2"=(B") (?a "$(2">(B") (?E "$(2"?(B") (?o "$(2"A(B") (?| "$(2"@(B") - (?W "$(2"B(B" (?a "$(2"B(B") - (?e "$(2"@#L(B") (?u "$(2"@#M(B") (?i "$(2"@#N(B") (?E "$(2"@#P(B") (?' "$(2"@#M(B"))) -;;; G - ("$(2$>(B" (?e "$(2$9(B") (?u "$(2$:(B") (?i "$(2$;(B") (?a "$(2$<(B") (?E "$(2$=(B") (?o "$(2$?(B") (?| "$(2$>(B")) -;;; H - ("$(2$"(B" (?e "$(2#{(B") (?u "$(2#|(B") (?i "$(2#}(B") (?a "$(2#~(B") (?E "$(2$!(B") (?o "$(2$#(B") (?| "$(2$"(B")) -;;; I - ("$(2"X(B" (?2 "$(2#d(B")) -;;; J - ("$(2$7(B" (?e "$(2$2(B") (?u "$(2$3(B") (?i "$(2$4(B") (?a "$(2$5(B") (?E "$(2$6(B") (?o "$(2$8(B") (?| "$(2$7(B")) -;;; K - ("$(2"x(B" (?e "$(2"s(B") (?u "$(2"t(B") (?i "$(2"u(B") (?a "$(2"v(B") (?E "$(2"w(B") (?o "$(2"y(B") (?| "$(2"x(B") - (?W "$(2"{(B" (?e "$(2"z(B") (?u "$(2"{(B") (?i "$(2"|(B") (?a "$(2"}(B") (?E "$(2"~(B"))) -;;; L - ("$(2!&(B" (?e "$(2!!(B") (?u "$(2!"(B") (?i "$(2!#(B") (?a "$(2!$(B") (?E "$(2!%(B") (?o "$(2!'(B") (?| "$(2!&(B") - (?W "$(2!((B" (?a "$(2!((B") - (?e "$(2!&#L(B") (?u "$(2!&#M(B") (?i "$(2!&#N(B") (?E "$(2!&#P(B") (?' "$(2!&#M(B"))) -;;; M - ("$(2!.(B" (?e "$(2!)(B") (?u "$(2!*(B") (?i "$(2!+(B") (?a "$(2!,(B") (?E "$(2!-(B") (?o "$(2!/(B") (?| "$(2!.(B") - (?W "$(2!0(B" (?a "$(2!0(B") - (?e "$(2!.#L(B") (?u "$(2!.#M(B") (?i "$(2!.#N(B") (?E "$(2!.#P(B") (?' "$(2!.#M(B"))) -;;; N - ("$(2!n(B" (?e "$(2!i(B") (?u "$(2!j(B") (?i "$(2!k(B") (?a "$(2!l(B") (?E "$(2!m(B") (?o "$(2!o(B") (?| "$(2!n(B") - (?W "$(2!p(B" (?a "$(2!p(B") - (?e "$(2!n#L(B") (?u "$(2!n#M(B") (?i "$(2!n#N(B") (?E "$(2!n#P(B") (?' "$(2!n#M(B"))) -;;; O - ("$(2"Y(B" (?2 "$(2#e(B")) -;;; P - ("$(2$E(B" (?e "$(2$@(B") (?u "$(2$A(B") (?i "$(2$B(B") (?a "$(2$C(B") (?E "$(2$D(B") (?o "$(2$F(B") (?| "$(2$E(B")) -;;; Q - ("$(2#2(B" (?e "$(2#-(B") (?u "$(2#.(B") (?i "$(2#/(B") (?a "$(2#0(B") (?E "$(2#1(B") (?o "$(2#3(B") (?| "$(2#2(B") - (?W "$(2#5(B" (?e "$(2#4(B") (?u "$(2#5(B") (?i "$(2#6(B") (?a "$(2#7(B") (?E "$(2#8(B"))) -;;; R - ("$(2!6(B" (?e "$(2!1(B") (?u "$(2!2(B") (?i "$(2!3(B") (?a "$(2!4(B") (?E "$(2!5(B") (?o "$(2!7(B") (?| "$(2!6(B") - (?W "$(2!8(B" (?a "$(2!8(B") - (?e "$(2!6#L(B") (?u "$(2!6#M(B") (?i "$(2!6#N(B") (?E "$(2!6#P(B") (?' "$(2!6#M(B"))) -;;; S - ("$(2"P(B" (?e "$(2"K(B") (?u "$(2"L(B") (?i "$(2"M(B") (?a "$(2"N(B") (?E "$(2"O(B") (?o "$(2"Q(B") (?| "$(2"P(B") - (?W "$(2"R(B" (?a "$(2"R(B") - (?e "$(2"P#L(B") (?u "$(2"P#M(B") (?i "$(2"P#N(B") (?E "$(2"P#P(B") (?' "$(2"P#M(B")) - (?2 "$(2#](B" (?| "$(2#](B") - (?e "$(2#X(B") (?u "$(2#Y(B") (?i "$(2#Z(B") (?a "$(2#[(B") (?E "$(2#\(B") (?o "$(2#^(B") - (?W "$(2"R(B" - (?a "$(2"R(B") - (?e "$(2#]#L(B") (?u "$(2#]#M(B") (?i "$(2#]#N(B") (?E "$(2#]#P(B") (?' "$(2#]#M(B")))) - -;;; T - ("$(2"0(B" (?e "$(2"+(B") (?u "$(2",(B") (?i "$(2"-(B") (?a "$(2".(B") (?E "$(2"/(B") (?o "$(2"1(B") (?| "$(2"0(B") - (?W "$(2"2(B" (?a "$(2"2(B") - (?e "$(2"0#L(B") (?u "$(2"0#M(B") (?i "$(2"0#N(B") (?E "$(2"0#P(B") (?' "$(2"0#M(B"))) -;;; U - ("$(2"T(B" (?2 "$(2#`(B")) -;;; V - ("$(2!N(B" (?e "$(2!I(B") (?u "$(2!J(B") (?i "$(2!K(B") (?a "$(2!L(B") (?E "$(2!M(B") (?o "$(2!O(B") (?| "$(2!N(B") - (?W "$(2!P(B" (?a "$(2!P(B") - (?e "$(2!N#L(B") (?u "$(2!N#M(B") (?i "$(2!N#N(B") (?E "$(2!N#P(B") (?' "$(2!N#M(B"))) -;;; W - ("$(2#M(B" (?e "$(2#L(B") (?u "$(2#M(B") (?i "$(2#N(B") (?a "$(2#O(B") (?E "$(2#P(B")) -;;; X - ("$(2#y(B" (?e "$(2#t(B") (?u "$(2#u(B") (?i "$(2#v(B") (?a "$(2#w(B") (?E "$(2#x(B") (?o "$(2#z(B") (?| "$(2#y(B")) -;;; Y - ("$(2$)(B" (?e "$(2$$(B") (?u "$(2$%(B") (?i "$(2$&(B") (?a "$(2$'(B") (?E "$(2$((B") (?o "$(2$*(B") (?| "$(2$)(B")) -;;; Z - ("$(2!~(B" (?e "$(2!y(B") (?u "$(2!z(B") (?i "$(2!{(B") (?a "$(2!|(B") (?E "$(2!}(B") (?o "$(2"!(B") (?| "$(2!~(B") - (?W "$(2""(B" (?a "$(2""(B") - (?e "$(2!~#L(B") (?u "$(2!~#M(B") (?i "$(2!~#N(B") (?E "$(2!~#P(B") (?' "$(2!~#M(B"))) -;;; [ \ ] ^ _ - nil nil nil nil nil -;;; ` - ("`" - (?e "$(2#_(B") (?u "$(2#`(B") (?U "$(2#`(B") (?i "$(2#a(B") (?a "$(2#b(B") (?A "$(2#b(B") - (?E "$(2#c(B") (?I "$(2#d(B") (?o "$(2#e(B") (?O "$(2#e(B") - (?s "$(2#V(B" - (?e "$(2#Q(B") (?u "$(2#R(B") (?i "$(2#S(B") (?a "$(2#T(B") (?E "$(2#U(B") (?o "$(2#W(B") (?| "$(2#V(B") - (?W "$(2"J(B" (?a "$(2"J(B") - (?e "$(2#V#L(B") (?u "$(2#V#M(B") (?i "$(2#V#N(B") (?E "$(2#V#P(B") (?' "$(2#V#M(B"))) - (?S "$(2#](B" - (?e "$(2#X(B") (?u "$(2#Y(B") (?i "$(2#Z(B") (?a "$(2#[(B") (?E "$(2#\(B") (?o "$(2#^(B") (?| "$(2#](B") - (?W "$(2"R(B" (?a "$(2"R(B") - (?e "$(2#]#L(B") (?u "$(2#]#M(B") (?i "$(2#]#N(B") (?E "$(2#]#P(B") (?' "$(2#]#M(B"))) - (?h "$(2#k(B" - (?e "$(2#f(B") (?u "$(2#g(B") (?i "$(2#h(B") (?a "$(2#i(B") (?E "$(2#j(B") (?o "$(2#l(B") (?| "$(2#k(B") - (?W "$(2"c(B" (?e "$(2"b(B") (?u "$(2"c(B") (?i "$(2"d(B") (?a "$(2"e(B") (?E "$(2"f(B"))) - (?k "$(2#r(B" - (?e "$(2#m(B") (?u "$(2#n(B") (?i "$(2#o(B") (?a "$(2#p(B") (?E "$(2#q(B") (?o "$(2#s(B") (?| "$(2#r(B"))) -;;; a - ("$(2"S(B" (?2 "$(2#b(B")) - -;;; b - ("$(2!F(B" (?e "$(2!A(B") (?u "$(2!B(B") (?i "$(2!C(B") (?a "$(2!D(B") (?E "$(2!E(B") (?o "$(2!G(B") (?| "$(2!F(B") - (?W "$(2!H(B" (?a "$(2!H(B") - (?e "$(2!F#L(B") (?u "$(2!F#M(B") (?i "$(2!F#N(B") (?E "$(2!F#P(B") (?' "$(2!F#M(B"))) -;;; c - ("$(2!^(B" (?e "$(2!Y(B") (?u "$(2!Z(B") (?i "$(2![(B") (?a "$(2!\(B") (?E "$(2!](B") (?o "$(2!_(B") (?| "$(2!^(B") - (?W "$(2!`(B" (?a "$(2!`(B") - (?e "$(2!^#L(B") (?u "$(2!^#M(B") (?i "$(2!^#N(B") (?E "$(2!^#P(B") (?' "$(2!^#M(B"))) -;;; d - ("$(2"((B" (?e "$(2"#(B") (?u "$(2"$(B") (?i "$(2"%(B") (?a "$(2"&(B") (?E "$(2"'(B") (?o "$(2")(B") (?| "$(2"((B") - (?W "$(2"*(B" (?a "$(2"*(B") - (?e "$(2"(#L(B") (?u "$(2"(#M(B") (?i "$(2"(#N(B") (?E "$(2"(#P(B") (?' "$(2"(#M(B"))) -;;; e - ("$(2"S(B" (?2 "$(2#_(B") (?3 "$(2"Z(B")) -;;; f - ("$(2"@(B" (?e "$(2";(B") (?u "$(2"<(B") (?i "$(2"=(B") (?a "$(2">(B") (?E "$(2"?(B") (?o "$(2"A(B") (?| "$(2"@(B") - (?W "$(2"B(B" (?a "$(2"B(B") - (?e "$(2"@#L(B") (?u "$(2"@#M(B") (?i "$(2"@#N(B") (?E "$(2"@#P(B") (?' "$(2"@#M(B"))) -;;; g - ("$(2#>(B" (?e "$(2#9(B") (?u "$(2#:(B") (?i "$(2#;(B") (?a "$(2#<(B") (?E "$(2#=(B") (?o "$(2#?(B") (?| "$(2#>(B") - (?W "$(2#A(B" (?e "$(2#@(B") (?u "$(2#A(B") (?i "$(2#B(B") (?a "$(2#C(B") (?E "$(2#D(B"))) -;;; h - ("$(2"`(B" (?e "$(2"[(B") (?u "$(2"\(B") (?i "$(2"](B") (?a "$(2"^(B") (?E "$(2"_(B") (?o "$(2"a(B") (?| "$(2"`(B") - (?W "$(2"c(B" (?e "$(2"b(B") (?u "$(2"c(B") (?i "$(2"d(B") (?a "$(2"e(B") (?E "$(2"f(B")) - (?2 "$(2#k(B" (?e "$(2#f(B") (?u "$(2#g(B") (?i "$(2#h(B") (?a "$(2#i(B") (?E "$(2#j(B") (?o "$(2#l(B") - (?| "$(2#k(B") - (?W "$(2"c(B" (?e "$(2"b(B") (?u "$(2"c(B") (?i "$(2"d(B") (?a "$(2"e(B") (?E "$(2"f(B")))) -;;; i - ("$(2"U(B" (?2 "$(2#a(B")) -;;; j - ("$(2$7(B" (?e "$(2$2(B") (?u "$(2$3(B") (?i "$(2$4(B") (?a "$(2$5(B") (?E "$(2$6(B") (?o "$(2$8(B") (?| "$(2$7(B")) -;;; k - ("$(2"l(B" (?e "$(2"g(B") (?u "$(2"h(B") (?i "$(2"i(B") (?a "$(2"j(B") (?E "$(2"k(B") (?o "$(2"m(B") (?| "$(2"l(B") - (?W "$(2"o(B" (?e "$(2"n(B") (?u "$(2"o(B") (?i "$(2"p(B") (?a "$(2"q(B") (?E "$(2"r(B")) - (?2 "$(2#r(B" (?e "$(2#m(B") (?u "$(2#n(B") (?i "$(2#o(B") (?a "$(2#p(B") (?E "$(2#q(B") (?o "$(2#s(B") - (?| "$(2#r(B"))) -;;; l - ("$(2!&(B" (?e "$(2!!(B") (?u "$(2!"(B") (?i "$(2!#(B") (?a "$(2!$(B") (?E "$(2!%(B") (?o "$(2!'(B") (?| "$(2!&(B") - (?W "$(2!((B" (?a "$(2!((B") - (?e "$(2!&#L(B") (?u "$(2!&#M(B") (?i "$(2!&#N(B") (?E "$(2!&#P(B") (?' "$(2!&#M(B"))) -;;; m - ("$(2!.(B" (?e "$(2!)(B") (?u "$(2!*(B") (?i "$(2!+(B") (?a "$(2!,(B") (?E "$(2!-(B") (?o "$(2!/(B") (?| "$(2!.(B") - (?W "$(2!0(B" (?a "$(2!0(B") - (?e "$(2!.#L(B") (?u "$(2!.#M(B") (?i "$(2!.#N(B") (?E "$(2!.#P(B") (?' "$(2!.#M(B"))) -;;; n - ("$(2!f(B" (?e "$(2!a(B") (?u "$(2!b(B") (?i "$(2!c(B") (?a "$(2!d(B") (?E "$(2!e(B") (?o "$(2!g(B") (?| "$(2!f(B") - (?W "$(2!h(B" (?a "$(2!h(B") - (?e "$(2!f#L(B") (?u "$(2!f#M(B") (?i "$(2!f#N(B") (?E "$(2!f#P(B") (?' "$(2!f#M(B"))) -;;; o - ("$(2"Y(B" (?2 "$(2#e(B")) -;;; p - ("$(2$L(B" (?e "$(2$G(B") (?u "$(2$H(B") (?i "$(2$I(B") (?a "$(2$J(B") (?E "$(2$K(B") (?o "$(2$M(B") (?| "$(2$L(B")) -;;; q - ("$(2#&(B" (?e "$(2#!(B") (?u "$(2#"(B") (?i "$(2##(B") (?a "$(2#$(B") (?E "$(2#%(B") (?o "$(2#'(B") (?| "$(2#&(B") - (?W "$(2#)(B" (?e "$(2#((B") (?u "$(2#)(B") (?i "$(2#*(B") (?a "$(2#+(B") (?E "$(2#,(B"))) -;;; r - ("$(2!6(B" (?e "$(2!1(B") (?u "$(2!2(B") (?i "$(2!3(B") (?a "$(2!4(B") (?E "$(2!5(B") (?o "$(2!7(B") (?| "$(2!6(B") - (?W "$(2!8(B" (?a "$(2!8(B") - (?e "$(2!6#L(B") (?u "$(2!6#M(B") (?i "$(2!6#N(B") (?E "$(2!6#P(B") (?' "$(2!6#M(B"))) -;;; s - ("$(2"H(B" (?e "$(2"C(B") (?u "$(2"D(B") (?i "$(2"E(B") (?a "$(2"F(B") (?E "$(2"G(B") (?o "$(2"I(B") (?| "$(2"H(B") - (?W "$(2"J(B" (?a "$(2"J(B") - (?e "$(2"H#L(B") (?u "$(2"H#M(B") (?i "$(2"H#N(B") (?E "$(2"H#P(B") (?' "$(2"H#M(B")) - (?2 "$(2#V(B" (?e "$(2#Q(B") (?u "$(2#R(B") (?i "$(2#S(B") (?a "$(2#T(B") (?E "$(2#U(B") (?o "$(2#W(B") - (?| "$(2#V(B") - (?W "$(2"J(B" (?a "$(2"J(B") - (?e "$(2#V#L(B") (?u "$(2#V#M(B") (?i "$(2#V#N(B") (?E "$(2#V#P(B") - (?' "$(2#V#M(B")))) -;;; t - ("$(2!V(B" (?e "$(2!Q(B") (?u "$(2!R(B") (?i "$(2!S(B") (?a "$(2!T(B") (?E "$(2!U(B") (?o "$(2!W(B") (?| "$(2!V(B") - (?W "$(2!X(B" (?a "$(2!X(B") - (?e "$(2!V#L(B") (?u "$(2!V#M(B") (?i "$(2!V#N(B") (?E "$(2!V#P(B") (?' "$(2!V#M(B"))) -;;; u - ("$(2"T(B" (?2 "$(2#`(B")) -;;; v - ("$(2!N(B" (?e "$(2!I(B") (?u "$(2!J(B") (?i "$(2!K(B") (?a "$(2!L(B") (?E "$(2!M(B") (?o "$(2!O(B") (?| "$(2!N(B") - (?W "$(2!P(B" (?a "$(2!P(B") - (?e "$(2!N#L(B") (?u "$(2!N#M(B") (?i "$(2!N#N(B") (?E "$(2!N#P(B") (?' "$(2!N#M(B"))) -;;; w - ("$(2#J(B" (?e "$(2#E(B") (?u "$(2#F(B") (?i "$(2#G(B") (?a "$(2#H(B") (?E "$(2#I(B") (?o "$(2#K(B") (?| "$(2#J(B") - (?W "$(2#M(B" (?e "$(2#L(B") (?u "$(2#M(B") (?i "$(2#N(B") (?a "$(2#O(B") (?E "$(2#P(B"))) -;;; x - ("$(2!>(B" (?e "$(2!9(B") (?u "$(2!:(B") (?i "$(2!;(B") (?a "$(2!<(B") (?E "$(2!=(B") (?o "$(2!?(B") (?| "$(2!>(B") - (?W "$(2!@(B" (?a "$(2!@(B") - (?e "$(2!>#L(B") (?u "$(2!>#M(B") (?i "$(2!>#N(B") (?E "$(2!>#P(B") (?' "$(2!>#M(B"))) -;;; y - ("$(2$)(B" (?e "$(2$$(B") (?u "$(2$%(B") (?i "$(2$&(B") (?a "$(2$'(B") (?E "$(2$((B") (?o "$(2$*(B") (?| "$(2$)(B")) -;;; z - ("$(2!v(B" (?e "$(2!q(B") (?u "$(2!r(B") (?i "$(2!s(B") (?a "$(2!t(B") (?E "$(2!u(B") (?o "$(2!w(B") (?| "$(2!v(B") - (?W "$(2!x(B" (?a "$(2!x(B") - (?e "$(2!v#L(B") (?u "$(2!v#M(B") (?i "$(2!v#N(B") (?E "$(2!v#P(B") (?' "$(2!v#M(B"))) - ]) - -;;;###autoload -(defun sera-to-fidel-region (beg end &optional ascii-mode force) - "Translates the characters in region from SERA to FIDEL. - -If the 1st optional parameter ASCII-MODE is non-NIL, assumes that the -region begins in ASCII script. - -If the 2nd optional parametr FORCE is non-NIL, translates even if the -buffer is read-only." - - (interactive "r\nP") - (save-excursion - (save-restriction - (narrow-to-region beg end) - (sera-to-fidel-buffer ascii-mode force)))) - -;;;###autoload -(defun sera-to-fidel-buffer (&optional ascii-mode force) - "Translates the current buffer from SERA to FIDEL. - -If the 1st optional parameter ASCII-MODE is non-NIL, assumes that the -current buffer begins in ASCII script. - -If the 2nd optional panametr FORCE is non-NIL, translates even if the -buffer is read-only." - - (interactive "P") - (if (and buffer-read-only - (not force) - (not (y-or-n-p "Buffer is read-only. Force to convert? "))) - (error "")) - (let (start pre fol hard table table2 (buffer-read-only nil)) - (goto-char (point-min)) - (while (not (eobp)) - (setq start (point)) - (forward-char 1) - (setq pre (preceding-char) - fol (following-char)) - - (if ascii-mode - (cond - - ;; ascii mode, pre != \ - ((/= pre ?\\ )) - - ;; ascii mode, pre = \, fol = ! - ((= fol ?!) - (backward-delete-char 1) - (delete-char 1) - (setq ascii-mode nil - hard (not hard))) - - ;; hard ascii mode, pre = \, fol != ! - (hard) - - ;; soft ascii mode, pre = \, fol = {\ _ * < > 0..9 ~} - ((or (backward-delete-char 1) ; always nil - (eobp) - (sera-to-fidel-backslash))) - - ;; soft ascii mode, pre = \, fol = SPC - ((= fol 32) - (delete-char 1) - (setq ascii-mode nil)) - - ;; soft ascii mode, pre = \, fol = . - ((= fol ?.) - (delete-char 1) - (insert ?$(2$P(B)) - - ;; soft ascii mode, pre = \, fol = , - ((= fol ?,) - (delete-char 1) - (insert ?$(2$Q(B)) - - ;; soft ascii mode, pre = \, fol = ; - ((= fol ?\;) - (delete-char 1) - (insert ?$(2$R(B)) - - ;; soft ascii mode, pre = \, fol = : - ((= fol ?:) - (delete-char 1) - (insert ?$(2$S(B)) - - ;; soft ascii mode, pre = \, fol = others - (t - (setq ascii-mode nil))) - - (cond - - ;; very special: skip "<" to ">" (or "&" to ";") if in w3-mode - ((and (boundp 'sera-being-called-by-w3) - sera-being-called-by-w3 - (or (= pre ?<) (= pre ?&))) - (search-forward (if (= pre ?<) ">" ";") - nil 0)) - - ;; ethio mode, pre != sera - ((or (< pre ?') (> pre ?z))) - - ;; ethio mode, pre != \ - ((/= pre ?\\ ) - (setq table (aref sera-to-fidel-table pre)) - (while (setq table2 (cdr (assoc (following-char) table))) - (setq table table2) - (forward-char 1)) - (if (car table) - (progn - (delete-region start (point)) - (insert (car table))))) - - ;; ethio mode, pre = \, fol = ! - ((= fol ?!) - (backward-delete-char 1) - (delete-char 1) - (setq ascii-mode t - hard (not hard))) - - ;; hard ethio mode, pre = \, fol != ! - (hard) - - ;; soft ethio mode, pre = \, fol = {\ _ * < > 0..9 ~} - ((or (backward-delete-char 1) ; always nil - (eobp) - (sera-to-fidel-backslash))) - - ;; soft ethio mode, pre = \, fol = SPC - ((= fol 32) - (delete-char 1) - (setq ascii-mode t)) - - ;; soft ethio mode, pre = \, fol = {. , ; : | ' `} - ((memq fol '(?. ?, ?\; ?: ?| ?' ?`)) - (forward-char 1)) - - ;; soft ethio mode, pre = \, fol = others - (t - (setq ascii-mode t)))))) - (goto-char (point-min))) - -(defun sera-to-fidel-backslash nil - "Handle SERA backslash escapes common to ethio- and ascii-mode. -Returns t if something has been processed." - (let ((ch (following-char)) - (converted t)) - (if (and (>= ch ?1) (<= ch ?9)) - (ethio-convert-digit) - (delete-char 1) - (cond - ((= ch ?\\ ) - (insert ?\\ )) - ((= ch ?_) - (insert ?$(2$O(B)) - ((= ch ?*) - (insert ?$(2$T(B)) - ((= ch ?<) - (insert ?$(2$U(B)) - ((= ch ?>) - (insert ?$(2$V(B)) - ((= ch ?~) - (setq ch (following-char)) - (delete-char 1) - (cond - ((= ch ?e) - (insert "$(2$k(B")) - ((= ch ?E) - (insert "$(2$l(B")) - ((= ch ?a) - (insert "$(2$m(B")) - ((= ch ?A) - (insert "$(2$n(B")))) - (t - (insert ch) - (backward-char 1) - (setq converted nil)))) - converted)) - -(defun ethio-convert-digit nil - "Convert Arabic digits to Ethiopic digits." - (let (ch z) - (while (and (>= (setq ch (following-char)) ?1) - (<= ch ?9)) - (delete-char 1) - - ;; count up following zeros - (setq z 0) - (while (= (following-char) ?0) - (delete-char 1) - (setq z (1+ z))) - - (cond - - ;; first digit is 10, 20, ..., or 90 - ((= (mod z 2) 1) - ;; (- ch 40) means ?1 -> 9, ?2 -> 10, etc. - (insert (aref [?$(2$`(B ?$(2$a(B ?$(2$b(B ?$(2$c(B ?$(2$d(B ?$(2$e(B ?$(2$f(B ?$(2$g(B ?$(2$h(B] (- ch ?1))) - (setq z (1- z))) - - ;; first digit is 2, 3, ..., or 9 - ((/= ch ?1) - (insert (aref [?$(2$X(B ?$(2$Y(B ?$(2$Z(B ?$(2$[(B ?$(2$\(B ?$(2$](B ?$(2$^(B ?$(2$_(B] (- ch ?2)))) - - ;; single 1 - ((= z 0) - (insert "$(2$W(B"))) - - ;; 100 - (if (= (mod z 4) 2) - (insert"$(2$i(B")) - - ;; 10000 - (insert-char ?$(2$j(B (/ z 4))))) - -;;;###autoload -(defun sera-to-fidel-mail (&optional arg) - "Does SERA to FIDEL conversion for reading/writing mail and news. - -If the buffer contains the markers \"<sera>\" and \"</sera>\", -converts the segment between the two markers in Ethio start mode and -the subject field in ASCII start mode. - -If invoked interactively and there is no marker, converts both the -whole body and the subject field in Ethio start mode. - -For backward compatibility, \"<ethiopic>\" and \"<>\" can be used instead of -\"<sera>\" and \"</sera>\"." - - (interactive "p") - (let* ((buffer-read-only nil) border) - - (save-excursion - (goto-char (point-min)) - (setq border - (search-forward - (if (eq major-mode 'rmail-mode) - "\n\n" - (concat "\n" mail-header-separator "\n")))) - - (cond - - ;; with markers - ((re-search-forward "^<sera>\n" nil t) - (goto-char (match-beginning 0)) - (while (re-search-forward "^<sera>\n" nil t) - (replace-match "" nil t) - (sera-to-fidel-region - (point) - (progn - (if (re-search-forward "^</sera>\n" nil 0) - (replace-match "" nil t)) - (point)))) - - (goto-char (point-min)) - (if (re-search-forward "^Subject: " border t) - (sera-to-fidel-region - (point) - (progn (end-of-line) (point)) - 'ascii-start))) - - ;; backward compatibility - ((re-search-forward "^<ethiopic>\n" nil t) - (goto-char (match-beginning 0)) - (while (re-search-forward "^<ethiopic>\n" nil t) - (replace-match "" nil t) - (sera-to-fidel-region - (setq border (point)) - (progn - (if (re-search-forward "^<>\n" nil 0) - (replace-match "" nil t)) - (point)))) - - (goto-char (point-min)) - (if (re-search-forward "^Subject: " border t) - (sera-to-fidel-region - (point) - (progn (end-of-line) (point)) - 'ascii-start))) - - ;; interactive & no markers - (arg - (sera-to-fidel-region border (point-max)) - (goto-char (point-min)) - (if (re-search-forward "^Subject: " border t) - (sera-to-fidel-region - (point) - (progn (end-of-line) (point)))))) - - ;; adjust the rmail marker - (if (eq major-mode 'rmail-mode) - (set-marker - (aref rmail-message-vector (1+ rmail-current-message)) - (point-max)))))) - -;;;###autoload -(defun sera-to-fidel-marker nil - "If the buffer contains the markers \"<sera>\" and \"</sera>\", -converts the segment between the two markers from SERA to Fidel -in Ethio start mode. The markers will not be removed." - - (interactive) - (if (and buffer-read-only - (not (y-or-n-p "Buffer is read-only. Force to convert? "))) - (error "")) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "<sera>" nil t) - (sera-to-fidel-region - (point) - (if (re-search-forward "</sera>" nil t) - (match-beginning 0) - (point-max)) - nil - 'force)))) - -;; -;; FIDEL to SERA -;; - -(defconst fidel-to-sera-map - ["le" "lu" "li" "la" "lE" "l" "lo" "lWa" - "me" "mu" "mi" "ma" "mE" "m" "mo" "mWa" - "re" "ru" "ri" "ra" "rE" "r" "ro" "rWa" - "xe" "xu" "xi" "xa" "xE" "x" "xo" "xWa" - "be" "bu" "bi" "ba" "bE" "b" "bo" "bWa" - "ve" "vu" "vi" "va" "vE" "v" "vo" "vWa" - "te" "tu" "ti" "ta" "tE" "t" "to" "tWa" - "ce" "cu" "ci" "ca" "cE" "c" "co" "cWa" - "ne" "nu" "ni" "na" "nE" "n" "no" "nWa" - "Ne" "Nu" "Ni" "Na" "NE" "N" "No" "NWa" - "ze" "zu" "zi" "za" "zE" "z" "zo" "zWa" - "Ze" "Zu" "Zi" "Za" "ZE" "Z" "Zo" "ZWa" - "de" "du" "di" "da" "dE" "d" "do" "dWa" - "Te" "Tu" "Ti" "Ta" "TE" "T" "To" "TWa" - "Ce" "Cu" "Ci" "Ca" "CE" "C" "Co" "CWa" - "fe" "fu" "fi" "fa" "fE" "f" "fo" "fWa" - "se" "su" "si" "sa" "sE" "s" "so" "sWa" - "Se" "Su" "Si" "Sa" "SE" "S" "So" "SWa" - "a" "u" "i" "A" "E" "I" "o" "e3" - "he" "hu" "hi" "ha" "hE" "h" "ho" "hWe" "hWu" "hWi" "hWa" "hWE" - "ke" "ku" "ki" "ka" "kE" "k" "ko" "kWe" "kWu" "kWi" "kWa" "kWE" - "Ke" "Ku" "Ki" "Ka" "KE" "K" "Ko" "KWe" "KWu" "KWi" "KWa" "KWE" - "qe" "qu" "qi" "qa" "qE" "q" "qo" "qWe" "qWu" "qWi" "qWa" "qWE" - "Qe" "Qu" "Qi" "Qa" "QE" "Q" "Qo" "QWe" "QWu" "QWi" "QWa" "QWE" - "ge" "gu" "gi" "ga" "gE" "g" "go" "gWe" "gWu" "gWi" "gWa" "gWE" - "we" "wu" "wi" "wa" "wE" "w" "wo" "wWe" "wWu" "wWi" "wWa" "wWE" - "`se" "`su" "`si" "`sa" "`sE" "`s" "`so" - "`Se" "`Su" "`Si" "`Sa" "`SE" "`S" "`So" - "`e" "`u" "`i" "`a" "`E" "`I" "`o" - "`he" "`hu" "`hi" "`ha" "`hE" "`h" "`ho" - "`ke" "`ku" "`ki" "`ka" "`kE" "`k" "`ko" - "Xe" "Xu" "Xi" "Xa" "XE" "X" "Xo" - "He" "Hu" "Hi" "Ha" "HE" "H" "Ho" - "ye" "yu" "yi" "ya" "yE" "y" "yo" - "De" "Du" "Di" "Da" "DE" "D" "Do" - "je" "ju" "ji" "ja" "jE" "j" "jo" - "Ge" "Gu" "Gi" "Ga" "GE" "G" "Go" - "Pe" "Pu" "Pi" "Pa" "PE" "P" "Po" - "pe" "pu" "pi" "pa" "pE" "p" "po" - " " "\\_" "." "," ";" ":" "\\*" "\\<" "\\>" - "1" "2" "3" "4" "5" "6" "7" "8" "9" - "10" "20" "30" "40" "50" "60" "70" "80" "90" - "100" "10000" - "\\~e" "\\~E" "\\~a" "\\~A"]) - -(defvar ethio-use-tigrigna-style nil - "*If non-NIL, use \"e\" instead of \"a\" for the first lone vowel -translation in sera-to-fidel and fidel-to-sera conversions.") - -(defvar ethio-quote-vowel-always nil - "*If non-NIL, lone vowels are always transcribed by \"an apostrophe -+ the vowel\" except at word initial. Otherwise, they are quoted by -an apostrophe only if the preceding Ethiopic character is a lone -consonant.") - -(defvar ethio-W-sixth-always nil - "*If non-NIL, the Wu-form of a 12-form consonant is transcribed by -\"W'\" instead of \"Wu\".") - -(defvar ethio-numeric-reduction 0 - "*Degree of reduction in transcribing Ethiopic digits by Arabic -digits. For example, $(2$`$_$i$g$](B ({10}{9}{100}{80}{7}) will be -transcribed by: - \10\9\100\80\7 if ETHIO-NUMERIC-REDUCTION is 0, - \109100807 is 1, - \10900807 is 2.") - -;;;###autoload -(defun fidel-to-sera-region (begin end &optional ascii-mode force) - "Replaces all the FIDEL characters in the region to sera format. - -If the 1st optional parameter ASCII-MODE is non-NIL, converts the -region so that it begins in ASCII script. - -If the 2nd optional parameter FORCE is non-NIL, converts even if the -buffer is read-only." - - (interactive "r\nP") - (save-excursion - (save-restriction - (narrow-to-region begin end) - (fidel-to-sera-buffer ascii-mode force)))) - -;;;###autoload -(defun fidel-to-sera-buffer (&optional ascii-mode force) - "Replace all the FIDEL characters in the current buffer to sera format. - -If the 1st optional parameter ASCII-MODE is non-NIL, -convert the current buffer so that it begins in ASCII script. - -If the 2nd optional parameter FORCE is non-NIL, converts even if the -buffer is read-only. - -See also the description of the variables ethio-use-tigrigna-style, -ethio-quote-vowel-on-demand and ethio-numeric-reduction." - - (interactive "P") - (if (and buffer-read-only - (not force) - (not (y-or-n-p "Buffer is read-only. Force to convert? "))) - (error "")) - - ;; user's preference in transcription - (aset fidel-to-sera-map 144 (if ethio-use-tigrigna-style "e" "a")) - (let ((i 160) - (x (if ethio-W-sixth-always - '("hW'" "kW'" "KW'" "qW'" "QW'" "gW'" "wW'") - '("hWu" "kWu" "KWu" "qWu" "QWu" "gWu" "wWu")))) - (while x - (aset fidel-to-sera-map i (car x)) - (setq i (+ i 12) - x (cdr x)))) - - ;; main conversion routine - (let ((lonec nil) ; if lonec = t, previous char was a lone consonant. - (fidel nil) ; if fidel = t, previous char was a fidel. - (digit nil) ; if digit = t, previous char was an Ethiopic digit. - (buffer-read-only nil) - ch) - (goto-char (point-min)) - (while (not (eobp)) - (setq ch (following-char)) - - ;; ethiopic charactes - (if (= (char-charset ch) 'ethiopic) - (progn - (setq ch (char-to-ethiocode ch)) - (delete-char 1) - - (cond - - ;; fidels - ((<= ch 326) - (if ascii-mode - (insert "\\ ")) - (if (and (memq ch '(144 145 146 147 148 150 151)) ; (auiAEoe3) - (or lonec - (and ethio-quote-vowel-always - fidel))) - (insert "'")) - (insert (aref fidel-to-sera-map ch)) - (setq ascii-mode nil - lonec (ethio-lone-consonant-p ch) - fidel t - digit nil)) - - ;; punctuations and symbols - ((or (< ch 336) (> ch 355)) - (if (and ascii-mode - (memq ch '(329 330 331 332))) ; (.,;:) - (insert "\\")) - (insert (aref fidel-to-sera-map ch)) - (setq lonec nil - fidel nil - digit nil)) - - ;; now CH must be an ethiopic digit - - ;; reduction = 0 or leading digit - ((or (= ethio-numeric-reduction 0) - (not digit)) - (insert "\\" (aref fidel-to-sera-map ch)) - (setq lonec nil - fidel nil - digit t)) - - ;; reduction = 2 and following 10s, 100s, 10000s - ((and (= ethio-numeric-reduction 2) - (memq ch '(345 354 355))) - (insert (substring (aref fidel-to-sera-map ch) 1)) - (setq lonec nil - fidel nil - digit t)) - - ;; ordinary following digits - (t - (insert (aref fidel-to-sera-map ch)) - (setq lonec nil - fidel nil - digit t)))) - - ;; non-ethiopic characters - (cond - - ;; backslash is always quoted - ((= ch ?\\ ) - (insert "\\")) - - ;; nothing to do if in ascii-mode - (ascii-mode) - - ;; ethio-mode -> ascii-mode - ((or (and (>= ch ?a) (<= ch ?z)) - (and (>= ch ?A) (<= ch ?Z)) - (memq ch '(?| ?' ?`))) - (insert "\\ ") - (setq ascii-mode t)) - - ;; ascii punctuations in ethio-mode - ((memq ch '(?. ?, ?\; ?:)) - (insert "\\"))) - - (forward-char 1) - (setq lonec nil - fidel nil - digit nil))) - - ;; a few modifications for readability - (goto-char (point-min)) - (while (re-search-forward "\\([]!\"#$%&()*+/<=>?@[^_-]+\\)\\\\ " nil t) - (replace-match "\\\\ \\1")) - - (goto-char (point-min)) - (while (re-search-forward "\n\\([ \t]*\\)\\\\ " nil t) - (replace-match "\\\\\n\\1"))) - - (goto-char (point-min))) - -(defun ethio-lone-consonant-p (code) - "If the ethiocode CODE is an Ethiopic lone consonant, return t." - (cond - ((< code 144) - (= (mod code 8) 5)) - ((< code 153) - nil) - ((< code 236) - (= (mod code 12) 1)) - ((< code 327) - (= (mod code 7) 3)))) - -;;;###autoload -(defun fidel-to-sera-mail nil - "Does FIDEL to SERA conversion for reading/writing mail and news. - -If the buffer contains at least one Ethiopic character, - 1) inserts the string \"<sera>\" right after the header-body separator, - 2) inserts \"</sera>\" at the end of the buffer, - 3) converts the body into SERA in Ethiopic start mode, and - 4) converts the subject field in ASCII start mode." - - (interactive) - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "\\cE" nil t) - (let ((buffer-read-only nil) border) - - (goto-char (point-min)) - (setq border - (search-forward - (if (eq major-mode 'rmail-mode) - "\n\n" - (concat "\n" mail-header-separator "\n")))) - (insert "<sera>\n") - - (fidel-to-sera-region (point) (point-max)) - - (goto-char (point-max)) - (if (/= (preceding-char) ?\n) - (insert "\n")) - (insert "</sera>\n") - - (goto-char (point-min)) - (if (re-search-forward "^Subject: " border t) - (fidel-to-sera-region - (point) - (progn (end-of-line) (point)) - 'ascii-start)) - - ;; adjust the rmail marker - (if (eq major-mode 'rmail-mode) - (set-marker - (aref rmail-message-vector (1+ rmail-current-message)) - (point-max)))) - - (message "No Ethiopic characters in this buffer.")))) - -;;;###autoload -(defun fidel-to-sera-marker nil - "If the buffer contains the markers \"<sera>\" and \"</sera>\", -converts the segment between the two markers from Fidel to SERA -in Ethio start mode. The markers will not be removed." - - (interactive) - (if (and buffer-read-only - (not (y-or-n-p "Buffer is read-only. Force to convert? "))) - (error "")) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^<sera>\n" nil t) - (fidel-to-sera-region - (point) - (if (re-search-forward "^</sera>\n" nil t) - (match-beginning 0) - (point-max)) - nil - 'force)))) - -;; -;; file I/O hooks -;; - -(if (not (assoc "\\.sera$" auto-mode-alist)) - (setq auto-mode-alist - (cons '("\\.sera$" . sera-to-fidel-find-file) auto-mode-alist))) -(add-hook 'write-file-hooks 'fidel-to-sera-write-file) -(add-hook 'after-save-hook 'sera-to-fidel-after-save) - -;;;###autoload -(defun sera-to-fidel-find-file nil - "Intended to be called when a file whose name ends in \".sera\" is read in." - (sera-to-fidel-buffer nil 'force) - (set-buffer-modified-p nil) - nil) - -;;;###autoload -(defun fidel-to-sera-write-file nil - "Intended to be used as write-file-hooks for the files -whose name ends in \".sera\"." - (if (string-match "\\.sera$" (buffer-file-name)) - (save-excursion - (fidel-to-sera-buffer nil 'force) - (set-buffer-modified-p nil))) - nil) - -;;;###autoload -(defun sera-to-fidel-after-save nil - "Intended to be used as after-save-hook for the files -whose name ends in \".sera\"." - (if (string-match "\\.sera$" (buffer-file-name)) - (save-excursion - (sera-to-fidel-buffer nil 'force) - (set-buffer-modified-p nil))) - nil) - -;; -;; vowel modification -;; - -;;;###autoload -(defun ethio-modify-vowel nil - "Modify the vowel of the FIDEL that is under the cursor." - (interactive) - (let ((ch (following-char)) newch base vowel) - (if (= (char-charset ch) 'ethiopic) - (setq ch (char-to-ethiocode ch)) - (error "Not a valid character.")) - (if (or (and (>= ch 144) (<= ch 151)) ; lone vowels - (and (>= ch 250) (<= ch 256)) ; secondary lone vowels - (>= ch 327)) ; not FIDEL - (error "Not a valid character.")) - (message "Modify vowel to: ") - (if (null (setq vowel (memq (read-char) '(?e ?u ?i ?a ?E ?' ?o)))) - (error "Not a valid vowel.") - ;; ?e -> 0, ?u -> 1, ?i -> 2, ?a -> 3, ?E -> 4, ?' -> 5, ?o -> 6 - (setq vowel (- 7 (length vowel)))) - - (cond - - ;; 8-form consonant - ((<= ch 143) - (setq base (* (/ ch 8) 8)) - (cond - ((< (mod ch 8) 7) ; e-form <= ch <= o-form - (setq newch (+ base vowel))) - ((= vowel 3) ; 3 = a - (setq newch (+ base 7))) ; (+ base 7) = Wa-form - ((= vowel 5) ; 5 = ' - (setq newch - (cons (+ base 5) ; (+ base 5) = lone consonant - 232))) ; 232 = Wu - (t - (setq newch - (cons (+ base 5) ; (+ base 5) = lone consonant - (+ 231 vowel)))))) ; 231 = We - - ;; 12-form consonant - ((<= ch 235) - (setq ch (- ch 152) ; 152 = 12-form consonant offset - base (* (/ ch 12) 12)) - (cond - ((< (mod ch 12) 7) ; e-form <= ch <= o-form - (setq newch (+ base vowel 152))) - ((< vowel 5) ; We-form <= ch <= WE-form - (setq newch (+ base vowel 159))) ; 159 = 152 (offset) + 7 (We-form) - ((= vowel 5) ; 5 = ' (= u in this case) - (setq newch (+ base 160))) ; 160 = 152 (offset) + 8 (Wu-form) - (t - (error "Not a valid vowel.")))) - - ;; 7-form consonant - (t ; 236 = 7-form consonant offset - (setq newch (+ (* (/ (- ch 236) 7) 7) vowel 236)))) - - (delete-char 1) - - (cond - ((consp newch) - (insert (ethiocode-to-char (car newch)) - (ethiocode-to-char (cdr newch))) - (backward-char 2)) - (t - (insert (ethiocode-to-char newch)) - (backward-char 1))))) - -(defun ethiocode-to-char (code) - (make-char 'ethiopic (+ (/ code 94) 33) (+ (mod code 94) 33))) - -(defun char-to-ethiocode (ch) - (and (eq (char-charset ch) 'ethiopic) - (+ (* (- (char-octet ch 0) 33) 94) - (- (char-octet ch 1) 33)))) - -;; -;; space replacement -;; - -;;;###autoload -(defun ethio-replace-space (ch begin end) - "In the specified region, replace spaces between two Ethiopic characters." - (interactive "*cReplace spaces to: 1 (sg col), 2 (dbl col), 3 (Ethiopic)\nr") - (if (not (memq ch '(?1 ?2 ?3))) - (error "")) - (save-excursion - (save-restriction - (narrow-to-region begin end) - (goto-char (point-min)) - - (cond - - ((= ch ?1) - - ;; A double column space or an Ethiopic word separator is always - ;; converted to an ASCII space. - (while (re-search-forward "[$(2$N$O(B]" nil t) - (replace-match " " nil nil))) - - ((= ch ?2) - - ;; An Ethiopic word separator is always converted to - ;; a double column space. - (while (search-forward "$(2$O(B" nil t) - (replace-match "$(2$N(B")) - - (goto-char (point-min)) - - ;; ASCII spaces are converted only if they are placed - ;; between two Ethiopic characters. - (while (re-search-forward "\\(\\cE\\)\\( \\)\\( *\\cE\\)" nil t) - - ;; Converting the first ASCII space - (replace-match "\\1$(2$N(B\\3") - - ;; A double column space is \cE, so going back to the just - ;; converted double column space makes it possible to find - ;; the following ASCII spaces. - (goto-char (match-beginning 2)))) - - ((= ch ?3) - - ;; If more than one consecutive space (either ASCII or double - ;; width) is found between two Ethiopic characters, the first - ;; space will be converted to an Ethiopic word separator. - (let (pred succ) - (while (re-search-forward "[ $(2$N(B]\\([ $(2$N(B]*\\)" nil t) - (and (setq pred (char-before (match-beginning 0))) - (= (char-charset pred) 'ethiopic) - (setq succ (char-after (match-end 0))) - (= (char-charset succ) 'ethiopic) - (replace-match "$(2$O(B\\1" nil nil))))))))) - -;; -;; special characters -;; - -;;;###autoload -(defun ethio-input-special-character (arg) - "Allow the user to input special characters." - (interactive "*cInput number: 1.$(2$k(B 2.$(2$l(B 3.$(2$m(B 4.$(2$n(B") - (cond - ((= arg ?1) - (insert ?$(2$k(B)) - ((= arg ?2) - (insert ?$(2$l(B)) - ((= arg ?3) - (insert ?$(2$m(B)) - ((= arg ?4) - (insert ?$(2$n(B)) - (t - (error "")))) - -;; -;; key bindings -;; - -(define-key global-map [f4] 'sera-to-fidel-buffer) -(define-key global-map [(shift f4)] 'sera-to-fidel-region) -(define-key global-map [(control f4)] 'sera-to-fidel-marker) -(define-key global-map [f5] 'fidel-to-sera-buffer) -(define-key global-map [(shift f5)] 'fidel-to-sera-region) -(define-key global-map [(control f5)] 'fidel-to-sera-marker) -(define-key global-map [f6] 'ethio-modify-vowel) -(define-key global-map [f7] 'ethio-replace-space) -(define-key global-map [(shift f2)] 'ethio-replace-space) ; as requested -(define-key global-map [f8] 'ethio-input-special-character) - -(add-hook - 'rmail-mode-hook - '(lambda nil - (define-key rmail-mode-map [(control f4)] 'sera-to-fidel-mail) - (define-key rmail-mode-map [(control f5)] 'fidel-to-sera-mail))) - -(add-hook - 'mail-mode-hook - '(lambda nil - (define-key mail-mode-map [(control f4)] 'sera-to-fidel-mail) - (define-key mail-mode-map [(control f5)] 'fidel-to-sera-mail))) - -;; -(provide 'ethio)
--- a/lisp/mule/mule-cmds.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/mule/mule-cmds.el Mon Aug 13 09:44:42 2007 +0200 @@ -31,18 +31,18 @@ "Keymap for MULE (Multilingual environment) specific commands.") (fset 'mule-prefix mule-keymap) -;; Keep "C-x C-k ..." for mule specific commands. -(define-key ctl-x-map "\C-k" 'mule-prefix) +;; Keep "C-x C-m ..." for mule specific commands. +(define-key ctl-x-map "\C-m" 'mule-prefix) -(defvar mule-describe-language-support-map - (make-sparse-keymap "Describe Language Support")) -(fset 'mule-describe-language-support-prefix - mule-describe-language-support-map) +;; (defvar mule-describe-language-support-map +;; (make-sparse-keymap "Describe Language Support")) +;; (fset 'mule-describe-language-support-prefix +;; mule-describe-language-support-map) -(defvar mule-set-language-environment-map - (make-sparse-keymap "Set Language Environment")) -(fset 'mule-set-language-environment-prefix - mule-set-language-environment-map) +;; (defvar mule-set-language-environment-map +;; (make-sparse-keymap "Set Language Environment")) +;; (fset 'mule-set-language-environment-prefix +;; mule-set-language-environment-map) (define-key mule-keymap "f" 'set-buffer-file-coding-system) (define-key mule-keymap "F" 'set-default-buffer-file-coding-system) ; XEmacs @@ -74,7 +74,9 @@ (defun view-hello-file () "Display the HELLO file which list up many languages and characters." (interactive) - (find-file-read-only (expand-file-name "HELLO" data-directory))) + ;; We have to decode the file in any environment. + (let ((coding-system-for-read 'iso-2022-7)) + (find-file-read-only (expand-file-name "HELLO" data-directory)))) ;;; Language support staffs. @@ -86,7 +88,7 @@ (defvar language-info-alist nil "Alist of language names vs the corresponding information of various kind. Each element looks like: - (LANGUAGE-NAME . ((KEY . INFO) ...)) + (LANGUAGE-NAME . ((KEY . INFO) ...)) where LANGUAGE-NAME is a string, KEY is a symbol denoting the kind of information, INFO is any Lisp object which contains the actual information related @@ -98,21 +100,7 @@ KEY is a symbol denoting the kind of required information." (let ((lang-slot (assoc language-name language-info-alist))) (if lang-slot - (cdr (assq key (cdr lang-slot)))))) - -;; Return a lambda form which calls `describe-language-support' with -;; argument LANG. -(defun build-describe-language-support-function (lang) - `(lambda () - (interactive) - (describe-language-support ,lang))) - -;; Return a lambda form which calls `set-language-environment' with -;; argument LANG. -(defun build-set-language-environment-function (lang) - `(lambda () - (interactive) - (set-language-environment ,lang))) + (cdr (assq key (cdr lang-slot)))))) (defun set-language-info (language-name key info) "Set for LANGUAGE-NAME the information INFO under KEY. @@ -123,40 +111,50 @@ Currently, the following KEYs are used by Emacs: charset: list of symbols whose values are charsets specific to the language. coding-system: list of coding systems specific to the langauge. -setup-function: see the documentation of `set-language-environment'. tutorial: a tutorial file name written in the language. sample-text: one line short text containing characters of the language. -documentation: a docstring describing how the language is supported, - or a fuction to call to describe it, - or t which means call `describe-language-support' to describe it. input-method: alist of input method names for the language vs information for activating them. Use `register-input-method' (which see) to add a new input method to the alist. +documentation: a string describing how Emacs supports the langauge. +describe-function: a function to call for descriebing how Emacs supports + the language. The function uses information listed abobe. +setup-function: a function to call for setting up environment + convenient for the language. -Emacs will use more KEYs in the future. To avoid the conflition, users -should use prefix \"user-\" in the name of KEY." +Emacs will use more KEYs in the future. To avoid conflict, users +should use prefix \"user-\" in the name of KEY if he wants to set +different kind of information." (let (lang-slot key-slot) (setq lang-slot (assoc language-name language-info-alist)) - (if (null lang-slot) ; If no slot for the language, add it. - (setq lang-slot (list language-name) - language-info-alist (cons lang-slot language-info-alist))) + (if (null lang-slot) ; If no slot for the language, add it. + (setq lang-slot (list language-name) + language-info-alist (cons lang-slot language-info-alist))) (setq key-slot (assq key lang-slot)) - (if (null key-slot) ; If no slot for the key, add it. - (progn - (setq key-slot (list key)) - (setcdr lang-slot (cons key-slot (cdr lang-slot))))) + (if (null key-slot) ; If no slot for the key, add it. + (progn + (setq key-slot (list key)) + (setcdr lang-slot (cons key-slot (cdr lang-slot))))) (setcdr key-slot info) ;; Setup menu. - (cond ((eq key 'documentation) - (define-key mule-describe-language-support-map - (vector (intern language-name)) - (cons language-name - (build-describe-language-support-function language-name)))) - ((eq key 'setup-function) - (define-key mule-set-language-environment-map - (vector (intern language-name)) - (cons language-name - (build-set-language-environment-function language-name))))) + (cond ((eq key 'describe-function) + ;; (define-key-after mule-describe-language-support-map + ;; (vector (intern language-name)) + ;; (cons language-name info) + ;; t) + (eval-after-load "x-menubar" + `(add-menu-button '("Mule" "Describe Language Support") + (vector ,language-name ',info t))) + ) + ((eq key 'setup-function) + ;; (define-key-after mule-set-language-environment-map + ;; (vector (intern language-name)) + ;; (cons language-name info) + ;; t) + (eval-after-load "x-menubar" + `(add-menu-button '("Mule" "Set Language Environment") + (vector ,language-name ',info t))) + )) )) (defun set-language-info-alist (language-name alist) @@ -170,13 +168,13 @@ (defun read-language-name (key prompt &optional initial-input) "Read language name which has information for KEY, prompting with PROMPT." (let* ((completion-ignore-case t) - (name (completing-read prompt - language-info-alist - (function (lambda (elm) (assq key elm))) - t - initial-input))) + (name (completing-read prompt + language-info-alist + (function (lambda (elm) (assq key elm))) + t + initial-input))) (and (> (length name) 0) - (car (assoc-ignore-case (downcase name) language-info-alist))))) + (car (assoc-ignore-case (downcase name) language-info-alist))))) ;;; Multilingual input methods. @@ -189,7 +187,7 @@ (defvar current-input-method-title nil "Title string of the current input method shown in mode line. -Every input method should set this an appropriate value when activated.") +Every input method should set this to an appropriate value when activated.") (make-variable-buffer-local 'current-input-method-title) (put 'current-input-method-title 'permanent-local t) @@ -224,7 +222,7 @@ "Register INPUT-METHOD as an input method of LANGUAGE-NAME. LANGUAGE-NAME is a string. INPUT-METHOD is a list of the form: - (METHOD-NAME ACTIVATE-FUNC ARG ...) + (METHOD-NAME ACTIVATE-FUNC ARG ...) where METHOD-NAME is the name of this method, ACTIVATE-FUNC is the function to call for activating this method. Arguments for the function are METHOD-NAME and ARGs." @@ -242,25 +240,25 @@ "Read a language names and the corresponding input method from a minibuffer. Return a cons of those names." (let ((language-name (read-language-name - 'input-method - "Language: " - (if previous-input-method - (cons (car previous-input-method) 0))))) + 'input-method + "Language: " + (if previous-input-method + (cons (car previous-input-method) 0))))) (if (null language-name) - (error "No input method for the specified language")) + (error "No input method for the specified language")) (let* ((completion-ignore-case t) - (key-slot (cdr (assq 'input-method - (assoc language-name language-info-alist)))) - (method-name - (completing-read "Input method: " key-slot nil t - (if (and previous-input-method - (string= language-name - (car previous-input-method))) - (cons (cdr previous-input-method) 0))))) + (key-slot (cdr (assq 'input-method + (assoc language-name language-info-alist)))) + (method-name + (completing-read "Input method: " key-slot nil t + (if (and previous-input-method + (string= language-name + (car previous-input-method))) + (cons (cdr previous-input-method) 0))))) (if (= (length method-name) 0) - (error "No input method specified")) + (error "No input method specified")) (list language-name - (car (assoc-ignore-case (downcase method-name) key-slot)))))) + (car (assoc-ignore-case (downcase method-name) key-slot)))))) (defun set-default-input-method (language-name method-name) "Set the default input method to METHOD-NAME for inputting LANGUAGE-NAME. @@ -279,23 +277,23 @@ The information for activating METHOD-NAME is stored in `language-info-alist' under the key 'input-method. The format of the information has the form: - ((METHOD-NAME ACTIVATE-FUNC ARG ...) ...) + ((METHOD-NAME ACTIVATE-FUNC ARG ...) ...) where ACTIVATE-FUNC is a function to call for activating this method. Arguments for the function are METHOD-NAME and ARGs." (interactive (read-language-and-input-method-name)) (let* ((key-slot (get-language-info language-name 'input-method)) - (method-slot (assoc method-name key-slot))) + (method-slot (assoc method-name key-slot))) (if (null method-slot) - (error "No input method `%s' for %s" method-name language-name)) + (error "No input method `%s' for %s" method-name language-name)) (if current-input-method - (progn - (if (not (equal previous-input-method current-input-method)) - (setq previous-input-method current-input-method)) - (funcall inactivate-current-input-method-function))) + (progn + (if (not (equal previous-input-method current-input-method)) + (setq previous-input-method current-input-method)) + (funcall inactivate-current-input-method-function))) (setq method-slot (cdr method-slot)) (apply (car method-slot) method-name (cdr method-slot)) (setq default-input-method - (setq current-input-method (cons language-name method-name))) + (setq current-input-method (cons language-name method-name))) (setq default-input-method-title current-input-method-title) (setq current-input-method default-input-method))) @@ -320,7 +318,7 @@ (interactive) (if current-input-method (if (and (symbolp describe-current-input-method-function) - (fboundp describe-current-input-method-function)) + (fboundp describe-current-input-method-function)) (funcall describe-current-input-method-function) (message "No way to describe the current input method `%s'" (cdr current-input-method)) @@ -328,18 +326,18 @@ (message "No input method is activated now") (ding))) -;; (defun read-multilingual-string (prompt &optional initial-input -;; language-name method-name) -;; "Read a multilingual string from minibuffer, prompting with string PROMPT. -;; The input method selected last time is activated in minibuffer. -;; If non-nil, second arg INITIAL-INPUT is a string to insert before reading. -;; Optional 3rd and 4th arguments LANGUAGE-NAME and METHOD-NAME specify -;; the input method to be activated instead of the one selected last time." -;; (let ((minibuffer-setup-hook '(toggle-input-method)) -;; (default-input-method default-input-method)) -;; (if (and language-name method-name) -;; (set-default-input-method language-name method-name)) -;; (read-string prompt initial-input))) +(defun read-multilingual-string (prompt &optional initial-input + language-name method-name) + "Read a multilingual string from minibuffer, prompting with string PROMPT. +The input method selected last time is activated in minibuffer. +If non-nil, second arg INITIAL-INPUT is a string to insert before reading. +Optional 3rd and 4th arguments LANGUAGE-NAME and METHOD-NAME specify + the input method to be activated instead of the one selected last time." + (let ((minibuffer-setup-hook '(toggle-input-method)) + (default-input-method default-input-method)) + (if (and language-name method-name) + (set-default-input-method language-name method-name)) + (read-string prompt initial-input))) ;; Variables to control behavior of input methods. All input methods ;; should react to these variables. @@ -350,14 +348,14 @@ For instance, Quail input method does not show guidance buffer while inputting at minibuffer if this flag is t.") -;; (defvar input-method-activate-hook nil -;; "Normal hook run just after an input method is activated.") +(defvar input-method-activate-hook nil + "Normal hook run just after an input method is activated.") -;; (defvar input-method-inactivate-hook nil -;; "Normal hook run just after an input method is inactivated.") +(defvar input-method-inactivate-hook nil + "Normal hook run just after an input method is inactivated.") -;; (defvar input-method-after-insert-chunk-hook nil -;; "Normal hook run just after an input method insert some chunk of text.") +(defvar input-method-after-insert-chunk-hook nil + "Normal hook run just after an input method insert some chunk of text.") ;;; Language specific setup functions. @@ -381,52 +379,59 @@ (princ "\n")) (defun describe-language-support (language-name) - "Show documentation about how Emacs supports LANGUAGE-NAME." + "Describe how Emacs supports LANGUAGE-NAME. + +For that, a function returned by: + (get-language-info LANGUAGE-NAME 'describe-function) +is called." (interactive (list (read-language-name 'documentation "Language: "))) - (let (doc) + (let (func) (if (or (null language-name) - (null (setq doc - (get-language-info language-name 'documentation)))) + (null (setq func + (get-language-info language-name 'describe-function)))) (error "No documentation for the specified language")) - (with-output-to-temp-buffer "*Help*" - (if (not (eq doc t)) - (cond ((stringp doc) - (princ doc)) - ((and (symbolp doc) (fboundp doc)) - (funcall doc)) - (t - (error "Invalid documentation data for %s" language-name))) - (princ-list "List of items specific to " - language-name - " environment") - (princ "-----------------------------------------------------------\n") - (let ((str (get-language-info language-name 'sample-text))) - (if (stringp str) - (progn - (princ "<sample text>\n") - (princ-list " " str)))) - (princ "<input methods>\n") - (let ((l (get-language-info language-name 'input-method))) - (while l - (princ-list " " (car (car l))) - (setq l (cdr l)))) - (princ "<character sets>\n") - (let ((l (get-language-info language-name 'charset))) - (if (null l) - (princ-list " nothing specific to " language-name) - (while l - (princ-list " " (car l) - (format ":%3d:\n\t" (charset-id (car l))) - (charset-description (car l))) - (setq l (cdr l))))) - (princ "<coding systems>\n") - (let ((l (get-language-info language-name 'coding-system))) - (if (null l) - (princ-list " nothing specific to " language-name) - (while l - (princ-list " " (car l) ":\n\t" - (coding-system-docstring (car l))) - (setq l (cdr l))))))))) + (funcall func))) + +;; Print LANGUAGE-NAME specific information such as input methods, +;; charsets, and coding systems. This function is intended to be +;; called from various describe-LANGUAGE-support functions defined in +;; lisp/language/LANGUAGE.el. +(defun describe-language-support-internal (language-name) + (with-output-to-temp-buffer "*Help*" + (let ((doc (get-language-info language-name 'documentation))) + (if (stringp doc) + (princ-list doc))) + (princ "-----------------------------------------------------------\n") + (princ-list "List of items specific to " + language-name + " support") + (princ "-----------------------------------------------------------\n") + (let ((str (get-language-info language-name 'sample-text))) + (if (stringp str) + (progn + (princ "<sample text>\n") + (princ-list " " str)))) + (princ "<input methods>\n") + (let ((l (get-language-info language-name 'input-method))) + (while l + (princ-list " " (car (car l))) + (setq l (cdr l)))) + (princ "<character sets>\n") + (let ((l (get-language-info language-name 'charset))) + (if (null l) + (princ-list " nothing specific to " language-name) + (while l + (princ-list " " (car l) ": " + (charset-description (car l))) + (setq l (cdr l))))) + (princ "<coding systems>\n") + (let ((l (get-language-info language-name 'coding-system))) + (if (null l) + (princ-list " nothing specific to " language-name) + (while l + (princ-list " " (car l) ":\n\t" + (coding-system-docstring (car l))) + (setq l (cdr l))))))) ;;; Charset property @@ -469,6 +474,4 @@ ;; (nconc plist (list propname value)))) ;; (aset char-code-property-table char (list propname value))))) -(provide 'mule-cmds) - ;;; mule-cmds.el ends here
--- a/lisp/mule/mule-coding.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/mule/mule-coding.el Mon Aug 13 09:44:42 2007 +0200 @@ -73,6 +73,8 @@ "Return the 'mnemonic property of CODING-SYSTEM." (coding-system-property coding-system 'mnemonic)) +(defalias 'coding-system-docstring 'coding-system-doc-string) + (defun coding-system-eol-type (coding-system) "Return the 'eol-type property of CODING-SYSTEM." (coding-system-property coding-system 'eol-type))
--- a/lisp/mule/mule-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/mule/mule-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -54,11 +54,11 @@ ;; Now load files to set up all the different languages/environments ;; that Mule knows about. -(load-gc "arabic-hooks") +(load-gc "language/arabic") (load-gc "language/chinese") (load-gc "language/cyrillic") (load-gc "language/english") -(load-gc "ethiopic-hooks") +(load-gc "language/ethiopic") (load-gc "language/european") (load-gc "language/greek") (load-gc "hebrew-hooks")
--- a/lisp/mule/mule-misc.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/mule/mule-misc.el Mon Aug 13 09:44:42 2007 +0200 @@ -153,51 +153,7 @@ ;; Following definition were imported from Emacs/mule-delta. -(defun truncate-string-to-width (str width &optional start-column padding) - "Truncate string STR to fit in WIDTH columns. -Optional 1st arg START-COLUMN if non-nil specifies the starting column. -Optional 2nd arg PADDING if non-nil, space characters are padded at -the head and tail of the resulting string to fit in WIDTH if necessary. -If PADDING is nil, the resulting string may be narrower than WIDTH." - (or start-column - (setq start-column 0)) - (let ((len (length str)) - (idx 0) - (column 0) - (head-padding "") (tail-padding "") - ch last-column last-idx from-idx) - (condition-case nil - (while (< column start-column) - (setq ch (sref str idx) - column (+ column (char-width ch)) - idx (+ idx (char-bytes ch)))) - (args-out-of-range (setq idx len))) - (if (< column start-column) - (if padding (make-string width ?\ ) "") - (if (and padding (> column start-column)) - (setq head-padding (make-string (- column start-column) ?\ ))) - (setq from-idx idx) - (condition-case nil - (while (< column width) - (setq last-column column - last-idx idx - ch (sref str idx) - column (+ column (char-width ch)) - idx (+ idx (char-bytes ch)))) - (args-out-of-range (setq idx len))) - (if (> column width) - (setq column last-column idx last-idx)) - (if (and padding (< column width)) - (setq tail-padding (make-string (- width column) ?\ ))) - (setq str (substring str from-idx idx)) - (if padding - (concat head-padding str tail-padding) - str)))) - -;;; For backward compatiblity ... -;;;###autoload -(defalias 'truncate-string 'truncate-string-to-width) -(make-obsolete 'truncate-string 'truncate-string-to-width) +;; Function `truncate-string-to-width' was moved to mule-util.el. ;; end of imported definition
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mule/mule-util.el Mon Aug 13 09:44:42 2007 +0200 @@ -0,0 +1,404 @@ +;;; mule-util.el --- Utility functions for mulitilingual environment (mule) + +;; Copyright (C) 1995 Free Software Foundation, Inc. +;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Copyright (C) 1997 MORIOKA Tomohiko + +;; Keywords: mule, multilingual + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Code: + +;;; String manipulations while paying attention to multibyte +;;; characters. + +;;;###autoload +(defsubst string-to-sequence (string type) + "Convert STRING to a sequence of TYPE which contains characters in STRING. +TYPE should be `list' or `vector'. +Multibyte characters are conserned." + (map type (function identity) string)) + +;;;###autoload +(defsubst string-to-list (string) + "Return a list of characters in STRING." + (mapcar (function identity) string)) + +;;;###autoload +(defsubst string-to-vector (string) + "Return a vector of characters in STRING." + (string-to-sequence string 'vector)) + +;;;###autoload +(defun store-substring (string idx obj) + "Embed OBJ (string or character) at index IDX of STRING." + (let* ((str (cond ((stringp obj) obj) + ((characterp obj) (char-to-string obj)) + (t (error + "Invalid argument (should be string or character): %s" + obj)))) + (string-len (length string)) + (len (length str)) + (i 0)) + (while (and (< i len) (< idx string-len)) + (aset string idx (aref str i)) + (setq idx (1+ idx) i (1+ i))) + string)) + +;;;###autoload +(defun truncate-string-to-width (str width &optional start-column padding) + "Truncate string STR to fit in WIDTH columns. +Optional 1st arg START-COLUMN if non-nil specifies the starting column. +Optional 2nd arg PADDING if non-nil is a padding character to be padded at +the head and tail of the resulting string to fit in WIDTH if necessary. +If PADDING is nil, the resulting string may be narrower than WIDTH." + (or start-column + (setq start-column 0)) + (let ((len (length str)) + (idx 0) + (column 0) + (head-padding "") (tail-padding "") + ch last-column last-idx from-idx) + (condition-case nil + (while (< column start-column) + (setq ch (sref str idx) + column (+ column (char-width ch)) + idx (+ idx (char-bytes ch)))) + (args-out-of-range (setq idx len))) + (if (< column start-column) + (if padding (make-string width padding) "") + (if (and padding (> column start-column)) + (setq head-padding (make-string (- column start-column) ?\ ))) + (setq from-idx idx) + (condition-case nil + (while (< column width) + (setq last-column column + last-idx idx + ch (sref str idx) + column (+ column (char-width ch)) + idx (+ idx (char-bytes ch)))) + (args-out-of-range (setq idx len))) + (if (> column width) + (setq column last-column idx last-idx)) + (if (and padding (< column width)) + (setq tail-padding (make-string (- width column) padding))) + (setq str (substring str from-idx idx)) + (if padding + (concat head-padding str tail-padding) + str)))) + +;;; For backward compatiblity ... +;;;###autoload +(defalias 'truncate-string 'truncate-string-to-width) +(make-obsolete 'truncate-string 'truncate-string-to-width) + +;;; Nested alist handler. Nested alist is alist whose elements are +;;; also nested alist. + +;;;###autoload +(defsubst nested-alist-p (obj) + "Return t if OBJ is a nesetd alist. + +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). + +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 +can be a string, a vector, or a list." + (and obj (listp obj) (listp (cdr obj)))) + +;;;###autoload +(defun set-nested-alist (keyseq entry alist &optional len branches) + "Set ENTRY for KEYSEQ in a nested alist ALIST. +Optional 4th arg LEN non-nil means the firlst LEN elements in KEYSEQ + 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." + (or (nested-alist-p alist) + (error "Invalid arguement %s" alist)) + (let ((islist (listp keyseq)) + (len (or len (length keyseq))) + (i 0) + key-elt slot) + (while (< i len) + (if (null (nested-alist-p alist)) + (error "Keyseq %s is too long for this nested alist" keyseq)) + (setq key-elt (if islist (nth i keyseq) (aref keyseq i))) + (setq slot (assoc key-elt (cdr alist))) + (if (null slot) + (progn + (setq slot (cons key-elt (list t))) + (setcdr alist (cons slot (cdr alist))))) + (setq alist (cdr slot)) + (setq i (1+ i))) + (setcar alist entry) + (if branches + (if (cdr alist) + (error "Can't set branches for keyseq %s" keyseq) + (setcdr alist branches))))) + +;;;###autoload +(defun lookup-nested-alist (keyseq alist &optional len start nil-for-too-long) + "Look up key sequence KEYSEQ in nested alist ALIST. Return the definition. +Optional 1st argument LEN specifies the length of KEYSEQ. +Optional 2nd argument START specifies index of the starting key. +The returned value is normally a nested alist of which +car part is the entry for KEYSEQ. +If ALIST is not deep enough for KEYSEQ, return number which is + 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." + (or (nested-alist-p alist) + (error "invalid arguement %s" alist)) + (or len + (setq len (length keyseq))) + (let ((i (or start 0))) + (if (catch 'lookup-nested-alist-tag + (if (listp keyseq) + (while (< i len) + (if (setq alist (cdr (assoc (nth i keyseq) (cdr alist)))) + (setq i (1+ i)) + (throw 'lookup-nested-alist-tag t)))) + (while (< i len) + (if (setq alist (cdr (assoc (aref keyseq i) (cdr alist)))) + (setq i (1+ i)) + (throw 'lookup-nested-alist-tag t)))) + ;; KEYSEQ is too long. + (if nil-for-too-long nil i) + alist))) + +;; Coding system related functions. + +;;;###autoload +(defun set-coding-system-alist (target-type regexp coding-system + &optional operation) + "Update `coding-system-alist' according to the arguments. +TARGET-TYPE specifies a type of the target: `file', `process', or `network'. + TARGET-TYPE tells which slots of coding-system-alist should be affected. + If `file', it affects slots for insert-file-contents and write-region. + If `process', it affects slots for call-process, call-process-region, and + start-process. + If `network', it affects a slot for open-network-process. +REGEXP is a regular expression matching a target of I/O operation. +CODING-SYSTEM is a coding system to perform code conversion + on the I/O operation, or a cons of coding systems for decoding and + encoding respectively, or a function symbol which returns the cons. +Optional arg OPERATION if non-nil specifies directly one of slots above. + The valid value is: insert-file-contents, write-region, + call-process, call-process-region, start-process, or open-network-stream. +If OPERATION is specified, TARGET-TYPE is ignored. +See the documentation of `coding-system-alist' for more detail." + (or (stringp regexp) + (error "Invalid regular expression: %s" regexp)) + (or (memq target-type '(file process network)) + (error "Invalid target type: %s" target-type)) + (if (symbolp coding-system) + (if (not (fboundp coding-system)) + (progn + (check-coding-system coding-system) + (setq coding-system (cons coding-system coding-system)))) + (check-coding-system (car coding-system)) + (check-coding-system (cdr coding-system))) + (let ((op-list (if operation (list operation) + (cond ((eq target-type 'file) + '(insert-file-contents write-region)) + ((eq target-type 'process) + '(call-process call-process-region start-process)) + (t ; i.e. (eq target-type network) + '(open-network-stream))))) + slot) + (while op-list + (setq slot (assq (car op-list) coding-system-alist)) + (if slot + (let ((chain (cdr slot))) + (if (catch 'tag + (while chain + (if (string= regexp (car (car chain))) + (progn + (setcdr (car chain) coding-system) + (throw 'tag nil))) + (setq chain (cdr chain))) + t) + (setcdr slot (cons (cons regexp coding-system) (cdr slot))))) + (setq coding-system-alist + (cons (cons (car op-list) (list (cons regexp coding-system))) + coding-system-alist))) + (setq op-list (cdr op-list))))) + + +;;; Composite charcater manipulations. + +;;;###autoload +(defun compose-region (start end &optional buffer) + "Compose characters in the current region into one composite character. +From a Lisp program, pass two arguments, START to END. +The composite character replaces the composed characters. +BUFFER defaults to the current buffer if omitted." + (interactive "r") + (let ((ch (make-composite-char (buffer-substring start end buffer)))) + (delete-region start end buffer) + (insert-char ch nil nil buffer))) + +;;;###autoload +(defun decompose-region (start end &optional buffer) + "Decompose any composite characters in the current region. +From a Lisp program, pass two arguments, START to END. +This converts each composite character into one or more characters, +the individual characters out of which the composite character was formed. +Non-composite characters are left as-is. BUFFER defaults to the current +buffer if omitted." + (interactive "r") + (save-excursion + (set-buffer buffer) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (let ((compcharset (get-charset 'composite))) + (while (< (point) (point-max)) + (let ((ch (char-after (point)))) + (if (eq compcharset (char-charset ch)) + (progn + (delete-char 1) + (insert (composite-char-string ch)))))))))) + +;;;###autoload +(defconst reference-point-alist + '((tl . 0) (tc . 1) (tr . 2) + (ml . 3) (mc . 4) (mr . 5) + (bl . 6) (bc . 7) (br . 8) + (top-left . 0) (top-center . 1) (top-right . 2) + (mid-left . 3) (mid-center . 4) (mid-right . 5) + (bottom-left . 6) (bottom-center . 7) (bottom-right . 8) + (0 . 0) (1 . 1) (2 . 2) + (3 . 3) (4 . 4) (5 . 5) + (6 . 6) (7 . 7) (8 . 8)) + "Alist of reference point symbols vs reference point codes. +Meanings of 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:ml or mid-left + | 4 <--+---- center 4:mc or mid-center + | | 5:mr or mid-right +--- 3 5 <-- baseline 6:bl or bottom-left + | | 7:bc or bottom-center + 6----7----8 <-- descent 8:br or bottom-right + +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 8 and NEW-REF-POINT is 1, the +overall glyph is updated as follows: + + +-------+--+ <--- new ascent + | | | + | global| | + | glyph | | +--- | | | <--- baseline (doesn't change) + +----+--+--+ + | | new | + | |glyph| + +----+-----+ <--- new descent +") + +;; Return a string for char CH to be embedded in multibyte form of +;; composite character. +(defun compose-chars-component (ch) + (if (< ch 128) + (format "\240%c" (+ ch 128)) + (let ((str (char-to-string ch))) + (if (cmpcharp ch) + (if (/= (aref str 1) ?\xFF) + (error "Char %c can't be composed" ch) + (substring str 2)) + (aset str 0 (+ (aref str 0) ?\x20)) + str)))) + +;; Return a string for composition rule RULE to be embedded in +;; multibyte form of composite character. +(defsubst compose-chars-rule (rule) + (char-to-string (+ ?\xA0 + (* (cdr (assq (car rule) reference-point-alist)) 9) + (cdr (assq (cdr rule) reference-point-alist))))) + +;;;###autoload +(defun compose-chars (first-component &rest args) + "Return one char string composed from the arguments. +Each argument is a character (including a composite chararacter) +or a composition rule. +A composition rule has the form \(GLOBAL-REF-POINT . NEW-REF-POINT). +See the documentation of `reference-point-alist' for more detail." + (if (= (length args) 0) + (char-to-string first-component) + (let* ((with-rule (consp (car args))) + (str (if with-rule (concat (vector leading-code-composition ?\xFF)) + (char-to-string leading-code-composition)))) + (setq str (concat str (compose-chars-component first-component))) + (while args + (if with-rule + (progn + (if (not (consp (car args))) + (error "Invalid composition rule: %s" (car args))) + (setq str (concat str (compose-chars-rule (car args)) + (compose-chars-component (car (cdr args)))) + args (cdr (cdr args)))) + (setq str (concat str (compose-chars-component (car args))) + args (cdr args)))) + str))) + +;;;###autoload +(defun decompose-composite-char (char &optional type with-composition-rule) + "Convert composite character CHAR to a string containing components of CHAR. +Optional 1st arg TYPE specifies the type of sequence returned. +It should be `string' (default), `list', or `vector'. +Optional 2nd arg WITH-COMPOSITION-RULE non-nil means the returned +sequence contains embedded composition rules if any. In this case, the +order of elements in the sequence is the same as arguments for +`compose-chars' to create CHAR. +If TYPE is omitted or is `string', composition rules are omitted +even if WITH-COMPOSITION-RULE is t." + (or type + (setq type 'string)) + (let* ((len (composite-char-component-count char)) + (i (1- len)) + l) + (setq with-composition-rule (and with-composition-rule + (not (eq type 'string)) + (composite-char-composition-rule-p char))) + (while (> i 0) + (setq l (cons (composite-char-component char i) l)) + (if with-composition-rule + (let ((rule (- (composite-char-composition-rule char i) ?\xA0))) + (setq l (cons (cons (/ rule 9) (% rule 9)) l)))) + (setq i (1- i))) + (setq l (cons (composite-char-component char 0) l)) + (cond ((eq type 'string) + (apply 'concat-chars l)) + ((eq type 'list) + l) + (t ; i.e. TYPE is vector + (vconcat l))))) + +;;; mule-util.el ends here
--- a/lisp/mule/visual-mode.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/mule/visual-mode.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,1176 +0,0 @@ -;; visual.el -- cursor motion, insertion, deletion, etc. in visual order -;; Copyright (C) 1992 Free Software Foundation, Inc. - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; 94.5.15 created for Mule Ver.1.1 by Takahashi N. <ntakahas@etl.go.jp> - -;;;###autoload -(defvar visual-mode nil "non-nil if in visual-mode.") - -(make-variable-buffer-local 'visual-mode) - -(defvar visual-use-lr-commands nil - "If non-nil, use visual-left-* and visual-right-* commands instead of -visual-forward-* and visual-backward-* commands.") - -(defvar visual-mode-map - (let ((map (make-keymap))) - (substitute-key-definition 'self-insert-command - 'visual-self-insert-command - map global-map) - ; visual basic commands - (define-key map [(control d)] 'visual-delete-char) - (define-key map [(control k)] 'visual-kill-line) - (define-key map [(control m)] 'visual-newline) - (define-key map [(control o)] 'visual-open-line) - (define-key map [(control p)] 'visual-previous-line) - (define-key map [(control w)] 'visual-kill-region) - (define-key map [(control y)] 'visual-yank) - (define-key map [delete] 'visual-backward-delete-char) - (define-key map [(meta <)] 'visual-beginning-of-buffer) - (define-key map [(meta >)] 'visual-end-of-buffer) - (define-key map [(meta d)] 'visual-kill-word) - (define-key map [(meta w)] 'visual-kill-ring-save) - (define-key map [(meta y)] 'visual-yank-pop) - (define-key map [(meta delete)] 'visual-backward-kill-word) - (define-key map [up] 'visual-previous-line) - (define-key map [down] 'visual-next-line) - (define-key map [home] 'visual-beginning-of-buffer) - (define-key map [end] 'visual-end-of-buffer) - (define-key map [left] 'visual-move-to-left-char) - (define-key map [right] 'visual-move-to-right-char) - (define-key map [(meta left)] 'visual-move-to-left-word) - (define-key map [(meta right)] 'visual-move-to-right-word) - (define-key map [(control c) (control c)] 'exit-visual-mode) - (define-key map [(control c) <] 'l2r-mode) - (define-key map [(control c) >] 'r2l-mode) - ; LR commands - (if visual-use-lr-commands - (progn - (define-key map [(control a)] 'visual-left-end-of-line) - (define-key map [(control b)] 'visual-move-to-left-char) - (define-key map [(control e)] 'visual-right-end-of-line) - (define-key map [(control f)] 'visual-move-to-right-char) - (define-key map [(meta b)] 'visual-move-to-left-word) - (define-key map [(meta f)] 'visual-move-to-right-word)) - (define-key map [(control a)] 'visual-beginning-of-line) - (define-key map [(control b)] 'visual-backward-char) - (define-key map [(control e)] 'visual-end-of-line) - (define-key map [(control f)] 'visual-forward-char) - (define-key map [(meta b)] 'visual-backward-word) - (define-key map [(meta f)] 'visual-forward-word)) - map) - "minor-mode-keymap for visual-mode.") - -(if (not (assq 'visual-mode minor-mode-map-alist)) - (setq minor-mode-map-alist - (cons (cons 'visual-mode visual-mode-map) - minor-mode-map-alist))) - -(defvar visual-mode-indicator nil - "string displayed in mode line. \" l2r\" or \" r2l\".") -(make-variable-buffer-local 'visual-mode-indicator) - -(if (not (assq 'visual-mode minor-mode-alist)) - (setq minor-mode-alist - (cons '(visual-mode visual-mode-indicator) - minor-mode-alist))) - -(setq auto-mode-alist - (append '(("\\.l2r$" . l2r-mode) ("\\.r2l$" . r2l-mode)) - auto-mode-alist)) - -(defvar visual-mode-hooks nil) - -;;;###autoload -(defun visual-mode (&optional arg) - "Toggle visual-mode. With ARG, turn visual-mode on iff ARG is positive." - (interactive "P") - (if (null arg) - (if visual-mode (exit-visual-mode) (enter-visual-mode)) - (if (> (prefix-numeric-value arg) 0) - (enter-visual-mode) - (exit-visual-mode)))) - -(defun enter-visual-mode nil - "Enter visual-mode. Cursor moves in visual order." - (interactive) - (if (not visual-mode) - (progn - (setq visual-mode t - visual-mode-indicator (if display-direction " r2l" " l2r")) - (redraw-display) - (run-hooks 'visual-mode-hooks)))) - -(defun exit-visual-mode nil - "Exit visual-mode. Cursor moves in logical order." - (interactive) - (if visual-mode - (progn - (setq visual-mode nil) - (redraw-modeline t)))) - -(defun l2r-mode nil - "Set display-direction left to right." - (interactive) - (if (not visual-mode) - (enter-visual-mode)) - (setq display-direction nil) - (setq visual-mode-indicator " l2r") - (redraw-display)) - -(defun r2l-mode nil - "Set display-direction right to left." - (interactive) - (if (not visual-mode) - (enter-visual-mode)) - (setq display-direction t) - (setq visual-mode-indicator " r2l") - (redraw-display)) - - -;; cursor motion - -(defun visual-forward-char (arg) - "Move the cursor visually forward by ARG (integer) characters. -if ARG is negative, move backward." - (interactive "p") - (if (< arg 0) - (while (< arg 0) - (visual-backward-1-char) - (setq arg (1+ arg))) - (while (> arg 0) - (visual-forward-1-char) - (setq arg (1- arg))))) - -(defun visual-forward-1-char nil - "Move the cursor visually forward by 1 character." - (let ((r-dir (if display-direction 0 1)) - (a-dir (visual-char-direction-after-point)) - (aa-dir (visual-char-direction-after-after-point)) - (b-dir (visual-char-direction-before-point))) - - ; symbols used in the following comments - ; ^ : point in here - ; ~ : point will be there - ; d : character whose direction is the same as display-direction - ; r : character whose direction is opposite to display-direction - ; !d : r or nil - ; !r : d or nil - ; r* : 0 or more r's - ; d* : 0 or more d's - - (cond - ((null a-dir) - ; ... nil - ; ^ - (error "end of buffer")) - - ((eq a-dir r-dir) - (if (eq b-dir r-dir) - - ; ... r r ... - ; ~ ^ - (backward-char 1) - - ; ... !r r r* ... - ; ^ ~ - (skip-direction-forward r-dir))) - - ((eq aa-dir r-dir) - ; ... d r* r ... - ; ^ ~ - (forward-char 1) - (skip-direction-forward r-dir) - (backward-char 1)) - - (t - ; ... d !r ... - ; ^ ~ - (forward-char 1))))) - -(defun visual-backward-char (arg) - "Move the cursor visually backward by ARG (integer) characters. -if ARG is negative, move forward." - (interactive "p") - (if (< arg 0) - (while (< arg 0) - (visual-forward-1-char) - (setq arg (1+ arg))) - (while (> arg 0) - (visual-backward-1-char) - (setq arg (1- arg))))) - -(defun visual-backward-1-char nil - "Move the cursor visually backward by 1 character." - (let ((r-dir (if display-direction 0 1)) - (a-dir (visual-char-direction-after-point)) - (aa-dir (visual-char-direction-after-after-point)) - (b-dir (visual-char-direction-before-point))) - - ; symbols used in the following comments - ; ^ : point in here - ; ~ : point will be there - ; d : character whose direction is the same as display-direction - ; r : character whose direction is opposite to display-direction - ; !d : r or nil - ; !r : d or nil - ; r* : 0 or more r's - ; d* : 0 or more d's - - (cond - ((eq a-dir r-dir) - (if (eq aa-dir r-dir) - ; ... r r ... - ; ^ ~ - (forward-char 1) - - ; ... !r r* !r ... - ; ~ ^ - (skip-direction-backward r-dir) - (if (visual-char-direction-before-point) - (backward-char 1) - (skip-direction-forward r-dir) - (backward-char 1) - (error "beginning of buffer")))) - - ((null b-dir) - ; nil !r ... - ; ^ - (error "beginning of buffer")) - - ((eq b-dir r-dir) - ; ... r* r !r - ; ~ ^ - (skip-direction-backward r-dir)) - - (t - ; ... d !r ... - ; ~ ^ - (backward-char 1))))) - -(defun visual-char-direction (ch) - "Return the direction of CH (character). -Newline's direction will be same as display-direction." - (cond - ((null ch) nil) - ((= ch ?\n) (if display-direction 1 0)) - (t (char-direction ch)))) - -(defun visual-char-direction-after-point nil - "Return the direction of after-point-character. -0: left-to-right, 1: right-to-left" - (visual-char-direction (char-after (point)))) - -(defun visual-char-direction-after-after-point nil - "Return the direction of after-after-point-character. -0: left-to-right, 1: right-to-left" - (if (= (point) (point-max)) - nil - (save-excursion - (forward-char 1) - (visual-char-direction (char-after (point)))))) - -(defun visual-char-direction-before-point nil - "Return the direction of before-point-character. -0: left-to-right, 1: right-to-left" - (visual-char-direction (char-before (point)))) - -(defun skip-direction-forward (dir) - "Move point forward as long as DIR-direction characters continue." - (while (eq (visual-char-direction-after-point) dir) - (forward-char 1))) - -(defun skip-direction-backward (dir) - "Move point backward as long as DIR-direction characters continue." - (while (eq (visual-char-direction-before-point) dir) - (backward-char 1))) - -(defvar *visual-punctuations* - '(? ?. ?, ?: ?; ?? ?! ?- ?_ ?' ?\" ?/ ?( ?) ?[ ?] ?{ ?} ?\n ?\t ; ASCII - ? ?. ?, ?: ?; ?? ?! ?- ?_ ?' ?" ?( ?) ?[ ?] ; Hebrew - ?›2](3!›0](B ?›2](3&›0](B ?›2](3%›0](B ?›2](3)›0](B ?›2](3"›0](B ?›2](3'›0](B ?›2](3(›0](B ?›2](3#›0](B ?›2](3$›0](B ?›2](3*›0](B ?›2](3+›0](B )) ; Arabic - -(defun visual-forward-word (arg) - "Move the cursor visually forward by ARG (integer) words. -If ARG is negative, move the cursor backward." - (interactive "p") - (if (< arg 0) - (while (< arg 0) - (visual-backward-1-word) - (setq arg (1+ arg))) - (while (> arg 0) - (visual-forward-1-word) - (setq arg (1- arg))))) - -(defun visual-backward-word (arg) - "Move the cursor visually backward by ARG (integer) words. -If ARG is negative, move the cursor forward." - (interactive "p") - (if (< arg 0) - (while (< arg 0) - (visual-forward-1-word) - (setq arg (1+ arg))) - (while (> arg 0) - (visual-backward-1-word) - (setq arg (1- arg))))) - -(defun visual-forward-1-word nil - "Move the cursor visually forward by one word." - (while (memq (visual-char-after) *visual-punctuations*) - (visual-forward-1-char)) - (while (not (memq (visual-char-after) *visual-punctuations*)) - (visual-forward-1-char))) - -(defun visual-backward-1-word nil - "Move the cursor visually backward by one word." - (while (memq (visual-char-before) *visual-punctuations*) - (visual-backward-1-char)) - (while (not (memq (visual-char-before) *visual-punctuations*)) - (visual-backward-1-char))) - -(defun visual-char-before nil - "Return the character visually before the cursor. -If such position is out of range, returns nil." - ; almost same as visual-backward-1-char - (save-excursion - (let ((r-dir (if display-direction 0 1)) - (a-dir (visual-char-direction-after-point)) - (aa-dir (visual-char-direction-after-after-point)) - (b-dir (visual-char-direction-before-point))) - (cond - ((eq a-dir r-dir) - (if (eq aa-dir r-dir) - (progn - (forward-char 1) - (char-after (point))) - (skip-direction-backward r-dir) - (if (visual-char-direction-before-point) - (progn - (backward-char 1) - (char-after (point))) - nil))) - ((null b-dir) - nil) - ((eq b-dir r-dir) - (skip-direction-backward r-dir) - (char-after (point))) - (t - (backward-char 1) - (char-after (point))))))) - -(defun visual-char-after nil - "Return the character under the cursor. -If such position is out of range, returns nil." - (char-after (point))) - -(defun visual-beginning-of-line (&optional arg) - "Move the cursor to the visual beginning of line. -With ARG not nil, move forward ARG - 1 lines first. -If scan reaches end of buffer, stop there without error." - (interactive "P") - (beginning-of-line arg) - (let ((a-dir (visual-char-direction-after-point)) - (d-dir (if display-direction 1 0))) - (if (and a-dir (/= a-dir d-dir)) - (progn (skip-direction-forward a-dir) - (backward-char 1))))) - -(fset 'visual-end-of-line 'end-of-line) - -(defun visual-beginning-of-buffer nil - "Move the cursor to the visual beginning of current buffer." - (interactive) - (beginning-of-buffer) - (visual-beginning-of-line)) - -(fset 'visual-end-of-buffer 'end-of-buffer) - -(defvar visual-temporary-goal-column 0 - "temporary-goal-column command for visual-mode.") - -(defun visual-next-line (arg) - "next-line command for visual-mode." - (interactive "p") - (if (and (not (eq last-command 'visual-next-line)) - (not (eq last-command 'visual-previous-line))) - (setq visual-temporary-goal-column (visual-current-column))) - (next-line arg) - (visual-goto-column visual-temporary-goal-column)) - -(defun visual-previous-line (arg) - "previous-line command for visual-mode." - (interactive "p") - (if (and (not (eq last-command 'visual-next-line)) - (not (eq last-command 'visual-previous-line))) - (setq visual-temporary-goal-column (visual-current-column))) - (previous-line arg) - (visual-goto-column visual-temporary-goal-column)) - -(defun visual-current-column nil - "Return the current column counted in visual order." - (let ((c 0) (p (point))) - (visual-beginning-of-line) - (while (/= (point) p) - (setq c (+ c (char-width (visual-char-after)))) - (visual-forward-1-char)) - c)) - -(defun visual-goto-column (col) - "Move the cursor to visual column N (integer) in the current line. -If it is impossible to go to column N, the cursor is put on the nearest column -M (M < N). Returns N - M." - (if (< col 0) - (error "argument must be positive.")) - (let ((c 0)) - (visual-beginning-of-line) - (while (and (< c col) (not (eolp))) - (setq c (+ c (char-width (visual-char-after)))) - (visual-forward-1-char)) - (if (> c col) - (progn - (visual-backward-1-char) - (setq c (- c (char-width (visual-char-after)))))) - (- col c))) - - -;; insertion - -(defun visual-insert-char (ch arg) - "Insert character CH visually before the cursor. -With ARG (integer) insert that many characters." - (if (< arg 0) - (error "arg must be >= 0.")) - (while (> arg 0) - (visual-insert-1-char ch) - (setq arg (1- arg)))) - -(defun visual-insert-1-char (ch) - "Insert character CH visually before the cursor. -The cursor moves visually forward." - (let ((c-dir (visual-char-direction ch)) - (r-dir (if display-direction 0 1)) - (a-dir (visual-char-direction-after-point)) - (tmp)) - - ; symbols used in the following comments - ; d : character whose direction is the same as display-direction - ; r : character whose direction is opposite to display-direction - ; !d : r or nil - ; !r : d or nil - ; ^d : point is here and the character to be inserted is d - ; ^r : point is here and the character to be inserted is d - - (if (eq c-dir r-dir) - (if (eq a-dir r-dir) - - ; ... r ... - ; ^r - (progn - (forward-char 1) - (insert ch) - (backward-char 2)) - - ; ... !r ... - ; ^r - (skip-direction-backward c-dir) - (insert ch) - (skip-direction-forward c-dir)) - - (if (or (eq a-dir nil) - (eq a-dir c-dir)) - - ; ... !r ... - ; ^d - (insert ch) - - ; ... r ... - ; ^d - (forward-char 1) - (setq tmp (delete-direction-backward r-dir)) - (skip-direction-forward r-dir) - (insert ch tmp) - (backward-char 1))))) - -(defun delete-direction-forward (dir) - "From current point, delete DIR-direction characters forward. -Returns the deleted string." - (let ((p (point))) - (skip-direction-forward dir) - (prog1 - (buffer-substring (point) p) - (delete-region (point) p)))) - -(defun delete-direction-backward (dir) - "From current point, delete DIR-direction characters backward. -Return the deleted string." - (let ((p (point))) - (skip-direction-backward dir) - (prog1 - (buffer-substring (point) p) - (delete-region (point) p)))) - -(defun visual-self-insert-command (arg) - "Insert this character (32 <= CH < 127). -With ARG (integer), insert that many characters. -If display-direction is non-nil, the cursor stays at the same position." - (interactive "*p") - (visual-insert-char last-command-char arg) - (if display-direction - (visual-backward-char arg))) - -;; wire us into pending-delete -(put 'visual-self-insert-command 'pending-delete t) - -(defun visual-newline (arg) - "newline command for visual-mode. -With ARG (integer), insert that many newlines." - (interactive "*p") - (visual-insert-char ?\n arg)) - -(defun visual-open-line (arg) - "open-line command for visual-mode. -With arg (integer), insert that many newlines." - (interactive "*p") - (visual-insert-char ?\n arg) - (visual-backward-char arg)) - - -;; deletion - -(defun visual-delete-char (arg) - "Delete ARG (integer) characters visually forward. -If ARG is negative, delete backward." - (interactive "*p") - (if (< arg 0) - (while (< arg 0) - (visual-backward-delete-1-char) - (setq arg (1+ arg))) - (while (> arg 0) - (visual-delete-1-char) - (setq arg (1- arg))))) - -(defun visual-backward-delete-char (arg) - "Delete ARG (integer) characters visually backward. -If arg is negative, delete forward." - (interactive "*p") - (if (< arg 0) - (while (< arg 0) - (visual-delete-1-char) - (setq arg (1+ arg))) - (while (> arg 0) - (visual-backward-delete-1-char) - (setq arg (1- arg))))) - -(fset 'visual-delete-backward-char 'visual-backward-delete-char) - -(defun visual-backward-delete-1-char nil - "Delete a character visually before the cursor. -Ther cursor moves visually backward." - (let ((d-dir (if display-direction 1 0)) - (r-dir (if display-direction 0 1)) - (a-dir (visual-char-direction-after-point)) - (aa-dir (visual-char-direction-after-after-point)) - (b-dir (visual-char-direction-before-point)) - (tmp)) - - ; symbols used in the following comments - ; ^ : point in here - ; d : character whose direction is the same as display-direction - ; r : character whose direction is opposite to display-direction - ; !d : r or nil - ; !r : d or nil - ; r* : 0 or more r's - ; d* : 0 or more d's - - (if (eq a-dir r-dir) - (cond - ((eq aa-dir r-dir) - ; ... r r ... - ; ^ - (forward-char 1) - (delete-char 1) - (backward-char 1)) - - ((save-excursion - (skip-direction-backward r-dir) - (backward-char 1) - (and (eq (visual-char-direction-after-point) d-dir) - (eq (visual-char-direction-before-point) r-dir))) - ; ... r d r* r !r ... - ; ^ - (forward-char 1) - (setq tmp (delete-direction-backward r-dir)) - (delete-backward-char 1) - (skip-direction-backward r-dir) - (insert tmp) - (backward-char 1)) - - (t - ; .....!r d r* r !r ... - ; ^ - (skip-direction-backward r-dir) - (delete-backward-char 1) - (skip-direction-forward r-dir) - (backward-char 1))) - - (cond - ((null b-dir) - ; nil !r ... - ; ^ - (error "beginning of buffer")) - - ((eq b-dir r-dir) - ; ... r !r ... - ; ^ - (skip-direction-backward r-dir) - (delete-char 1) - (skip-direction-forward r-dir)) - - (t - ; ... !r !r ... - ; ^ - (delete-backward-char 1)))))) - -(fset 'visual-delete-backward-1-char 'visual-backward-delete-1-char) - -(defun visual-delete-1-char nil - "Delete a character under the cursor. -Visually, the cursor stays at the same position." - (let ((d-dir (if display-direction 1 0)) - (r-dir (if display-direction 0 1)) - (a-dir (visual-char-direction-after-point)) - (aa-dir (visual-char-direction-after-after-point)) - (b-dir (visual-char-direction-before-point)) - (tmp)) - - ; symbols used in the following comments - ; ^ : point in here - ; d : character whose direction is the same as display-direction - ; r : character whose direction is opposite to display-direction - ; !d : r or nil - ; !r : d or nil - ; r* : 0 or more r's - ; d* : 0 or more d's - - (cond - ((null a-dir) - ; ... nil - ; ^ - (error "end of buffer")) - - ((eq a-dir r-dir) - (if (eq b-dir r-dir) - - ; ... r r ... - ; ^ - (progn (delete-char 1) - (backward-char 1)) - - ; ... !r r ... - ; ^ - (delete-char 1) - (skip-direction-forward r-dir))) - - ((not (eq aa-dir r-dir)) - ; ... d !r ... - ; ^ - (delete-char 1)) - - ((eq b-dir r-dir) - ; ... r d r ... - ; ^ - (delete-char 1) - (setq tmp (delete-direction-forward r-dir)) - (skip-direction-backward r-dir) - (insert tmp) - (backward-char 1)) - - (t - ; ...!r d r ... - ; ^ - (delete-char 1) - (skip-direction-forward r-dir) - (backward-char 1))))) - -(defun visual-delete-region (beg end) - "delete-region command for visual-mode." - (interactive "*r") - (let ((begl) (begc) (endl) (endc) (l)) - - ; swap beg & end if necessary - (goto-char beg) - (setq begl (current-line) - begc (visual-current-column)) - (goto-char end) - (setq endl (current-line) - endc (visual-current-column)) - (if (or (> begl endl) - (and (= begl endl) - (> begc endc))) - (progn - (setq beg (prog1 end (setq end beg)) - begl (prog1 endl (setq endl begl)) - begc (prog1 endc (setq endc begc))) - (goto-char end))) - - ; insert a newline visually at END - (visual-insert-1-char ?\n) - (visual-backward-1-char) - (setq l (current-line)) - - ; insert a newline visually at BEG - (goto-line begl) - (visual-goto-column begc) - (visual-insert-1-char ?\n) - (beginning-of-line) - - (delete-region - (point) - (progn - (goto-line (1+ l)) - (end-of-line) - (point))) - (backward-char 1) - (visual-delete-char 2))) - -(defun current-line nil - "Return the current line number (in the buffer) of point." - (interactive) - (save-excursion - (beginning-of-line) - (1+ (count-lines 1 (point))))) - - -;; kill - -(defun visual-kill-region (beg end) - "kill-region command for visual-mode." - (interactive "r") - (let ((begl) (begc) (endl) (endc) (l)) - - ; swap beg & end if necessary - (goto-char beg) - (setq begl (current-line) - begc (visual-current-column)) - (goto-char end) - (setq endl (current-line) - endc (visual-current-column)) - (if (or (> begl endl) - (and (= begl endl) (> begc endc))) - (progn - (setq beg (prog1 end (setq end beg)) - begl (prog1 endl (setq endl begl)) - begc (prog1 endc (setq endc begc))) - (goto-char end))) - - (if (or (and buffer-read-only (not inhibit-read-only)) - (text-property-not-all beg end 'read-only nil)) - (progn - (visual-copy-region-as-kill beg end) - (if kill-read-only-ok - (message "Read only text copied to kill ring") - (barf-if-buffer-read-only))) - - ; insert a newline visually at END - (visual-insert-1-char ?\n) - (visual-backward-1-char) - (setq l (current-line)) - - ; insert a newline visually at BEG - (goto-line begl) - (visual-goto-column begc) - (visual-insert-1-char ?\n) - (beginning-of-line) - - (kill-region - (point) - (progn - (goto-line (1+ l)) - (end-of-line) - (point))) - (backward-char 1) - (visual-delete-char 2))) - - (setq this-command 'kill-region)) - -(defun visual-kill-word (arg) - "Kill ARG (integer) words visually forward. -If ARG is negative, kill backward." - (interactive "*p") - (visual-kill-region - (point) - (progn - (visual-forward-word arg) - (point)))) - -(defun visual-backward-kill-word (arg) - "Kill ARG (integer) words visually backward. -If ARG is negative, kill forward." - (interactive "*p") - (visual-kill-region - (point) - (progn - (visual-backward-word arg) - (point)))) - -(defun visual-kill-line (&optional arg) - "kill-line command for visual-mode." - (interactive "*P") - (visual-kill-region - (point) - (progn - (if arg - (progn - (forward-line (prefix-numeric-value arg)) - (visual-beginning-of-line)) - (if (eobp) - (signal 'end-of-buffer nil)) - (if (not (eolp)) - (visual-end-of-line) - (forward-line 1) - (visual-beginning-of-line))) - (point)))) - -(defun visual-copy-region-as-kill (beg end) - "copy-region-as-kill command for visual-mode." - (interactive "r") - (let ((buffer-read-only nil) - (auto-save-mode 0) - (p (point))) - (visual-kill-region beg end) - (visual-yank 1) - (if (/= (point) p) - (exchange-point-and-mark))) - nil) - -(defun visual-kill-ring-save (beg end) - "kill-ring-save command for visual-mode." - (interactive "r") - (visual-copy-region-as-kill beg end) - (if (interactive-p) - (let ((other-end (if (= (point) beg) end beg)) - (opoint (point)) - (inhibit-quit t)) - (if (pos-visible-in-window-p other-end (selected-window)) - (progn - (set-marker (mark-marker) (point) (current-buffer)) - (goto-char other-end) - (sit-for 1) - (set-marker (mark-marker) other-end (current-buffer)) - (goto-char opoint) - (and quit-flag mark-active - (deactivate-mark))) - (let* ((killed-text (current-kill 0)) - (message-len (min (length killed-text) 40))) - (if (= (point) beg) - (message "Saved text until \"%s\"" - (substring killed-text (- message-len))) - (message "Saved text from \"%s\"" - (substring killed-text 0 message-len)))))))) - - -;; yank - -(defun visual-yank (&optional arg) - "yank command for visual-mode." - (interactive "*P") - (setq this-command t) - - (let ((l1 (current-line)) (c1 (visual-current-column)) l2 c2) - - ;; Insert a newline both before and after current point. - (visual-insert-char ?\n 2) - (visual-backward-1-char) - - ;; Reinsert killed string between the two newlines. - (insert (current-kill (cond - ((listp arg) 0) - ((eq arg '-) -1) - (t (1- arg))))) - - ;; Delete the latter newline visually. - (visual-delete-1-char) - (setq l2 (current-line) - c2 (visual-current-column)) - - ;; Delete the former newline visually. - (goto-line l1) - (end-of-line) - (visual-delete-1-char) - (push-mark (point)) - - ;; Go back to the end of yanked string. - (if (= (- l2 l1) 1) - (visual-goto-column (+ c1 c2)) - (goto-line (1- l2)) - (visual-goto-column c2)) - - ;; Exchange point and mark if necessary. - (if (consp arg) - (goto-char (prog1 (mark t) - (set-marker (mark-marker) (point) (current-buffer)))))) - - (setq this-command 'yank) - nil) - -(defun visual-yank-pop (arg) - "yank-pop command for visual-mode." - (interactive "*p") - (if (not (eq last-command 'yank)) - (error "Previous command was not a yank")) - (setq this-command 'yank) - (let (l1 c1 l2 c2 before) - - (save-excursion - (setq l2 (current-line) - c2 (visual-current-column)) - (goto-char (mark t)) - (setq l1 (current-line) - c1 (visual-current-column)) - (if (or (> l1 l2) - (and (= l1 l2) (> c1 c2))) - (setq before t))) - - (visual-delete-region (point) (mark t)) - (setq l1 (current-line) - c1 (visual-current-column)) - - ;; Insert a newline both before and after current point. - (visual-insert-char ?\n 2) - (visual-backward-1-char) - - ;; Reinsert killed string between the two newlines. - (insert (current-kill arg)) - - ;; Delete the latter newline visually. - (visual-delete-1-char) - (setq l2 (current-line) - c2 (visual-current-column)) - - ;; Delete the former newline visually. - (goto-line l1) - (end-of-line) - (visual-delete-1-char) - (set-marker (mark-marker) (point) (current-buffer)) - - ;; Go back to the end of yanked string. - (if (= (- l2 l1) 1) - (visual-goto-column (+ c1 c2)) - (goto-line (1- l2)) - (visual-goto-column c2)) - - ;; Exchange point and mark if necessary. - (if before - (goto-char (prog1 (mark t) - (set-marker (mark-marker) (point) (current-buffer)))))) - - nil) - - -;; misc - -(defun visual-reverse-direction-word nil - "Reverse the char order of the word before point." - (interactive "*") - (goto-char - (prog1 - (point) - (reverse-region - (point) - (progn (skip-direction-backward (visual-char-direction-before-point)) - (point)))))) - -(defun visual-reverse-region (begin end) - "Reverse the order of chars between BEGIN and END." - (interactive "*r") - (apply 'insert - (nreverse - (string-to-char-list - (prog1 (buffer-substring begin end) (delete-region begin end)))))) - - -;; LR commands - -(defun visual-char-left nil - "Return the character on the left of visual point." - (if display-direction - (visual-char-after) - (visual-char-before))) - -(defun visual-char-right nil - "Return the character on the right of visual point." - (if display-direction - (visual-char-before) - (visual-char-after))) - -(defun visual-move-to-left-char (arg) - "Move the cursor visually left by ARG (integer) characters. -If ARG is negative, move the cursor right." - (interactive "p") - (if display-direction - (visual-forward-char arg) - (visual-backward-char arg))) - -(defun visual-move-to-left-1-char nil - "Move the cursor visually left by 1 character." - (interactive "p") - (if display-direction - (visual-forward-1-char) - (visual-backward-1-char))) - -(defun visual-move-to-right-char (arg) - "Move the cursor visually right by ARG (integer) characters. -If ARG is negative, move the cursor left." - (interactive "p") - (if display-direction - (visual-backward-char arg) - (visual-forward-char arg))) - -(defun visual-move-to-right-1-char nil - "Move the cursor visually right by 1 character." - (interactive "p") - (if display-direction - (visual-backward-1-char) - (visual-forward-1-char))) - -(defun visual-move-to-left-word (arg) - "Move the cursor visually left by ARG (integer) words. -If ARG is negative, move the cursor right." - (interactive "p") - (if display-direction - (visual-forward-word arg) - (visual-backward-word arg))) - -(defun visual-move-to-right-word (arg) - "Move the cursor visually right by ARG (integer) words. -If ARG is negative, move the cursor left." - (interactive "p") - (if display-direction - (visual-backward-word arg) - (visual-forward-word arg))) - -(defun visual-left-end-of-line (arg) - "Move the line cursor to the left-end of line. -With ARG not nil, move forward ARG - 1 lines first. -If scan reaches end of buffer, stop there without error." - (interactive "P") - (if display-direction - (visual-end-of-line arg) - (visual-beginning-of-line arg))) - -(defun visual-right-end-of-line (arg) - "Move the line cursor to the right-end of line. -With ARG not nil, move forward ARG - 1 lines first. -If scan reaches end of buffer, stop there without error." - (interactive "P") - (if display-direction - (visual-beginning-of-line arg) - (visual-end-of-line arg))) - -(defun visual-insert-char-left (ch arg) - "Insert CH (character) on the left of visual point as many as -ARG (integer)." - (if (< arg 0) - (error "ARG must be >= 0.")) - (visual-insert-char ch arg) - (and display-direction - (visual-backward-char arg))) - -(defun visual-insert-left-1-char (ch) - "Insert CH (character) on the left of visual point." - (visual-insert-1-char ch) - (and display-direction - (visual-backward-1-char))) - -(defun visual-insert-char-right (ch arg) - "Insert CH (character) on the right of visual point as many as -ARG (integer)." - (if (< arg 0) - (error "ARG must be >= 0.")) - (visual-insert-char ch arg) - (or display-direction - (visual-backward-char arg))) - -(defun visual-insert-right-1-char (ch) - "Insert CH (character) on the right of visual point." - (visual-insert-1-char ch) - (or display-direction - (visual-backward-1-char))) - -(defun visual-delete-left-char (arg) - "Delete ARG (integer) characters on the left of visual point. -If ARG is negative, on the right." - (interactive "*p") - (if display-direction - (visual-delete-char arg) - (visual-backward-delete-char arg))) - -(defun visual-delete-left-1-char nil - "Delete 1 character on the left of visual point." - (interactive "*p") - (if display-direction - (visual-delete-1-char) - (visual-backward-delete-1-char))) - -(defun visual-delete-right-char (arg) - "Delete ARG (integer) characters on the right of visual point. -If ARG is negative, on the left." - (interactive "*p") - (if display-direction - (visual-backward-delete-char arg) - (visual-delete-char arg))) - -(defun visual-delete-right-1-char nil - "Delete 1 character on the right of visual point." - (interactive "*p") - (if display-direction - (visual-backward-delete-1-char) - (visual-delete-1-char))) - -(defmacro visual-replace-left-1-char (ch) - (list - 'progn - '(visual-delete-left-1-char) - (list 'visual-insert-left-1-char ch))) - -(defmacro visual-replace-right-1-char (ch) - (list - 'progn - '(visual-delete-right-1-char) - (list 'visual-insert-right-1-char ch))) - -(defun visual-kill-left-word (arg) - "Kill ARG (integer) words on the left of visual pointer. -If ARG is negative, kill on the right." - (interactive "*p") - (if display-direction - (visual-kill-word arg) - (visual-backward-kill-word arg))) - -(defun visual-kill-right-word (arg) - "Kill ARG (integer) words on the right of visual point. -If ARG is negative, kill on the left." - (interactive "*p") - (if display-direction - (visual-backward-kill-word arg) - (visual-kill-word arg))) - -;;; -(provide 'visual-mode)
--- a/lisp/oobr/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/oobr/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/packages/auto-autoloads.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/packages/auto-autoloads.el Mon Aug 13 09:44:42 2007 +0200 @@ -161,7 +161,7 @@ ;;;*** -;;;### (autoloads (bookmark-menu-delete bookmark-menu-rename bookmark-menu-locate bookmark-menu-jump bookmark-menu-insert bookmark-bmenu-list bookmark-load bookmark-save bookmark-write bookmark-delete bookmark-insert bookmark-rename bookmark-insert-location bookmark-relocate bookmark-jump bookmark-set) "bookmark" "packages/bookmark.el") +;;;### (autoloads (bookmark-menu-delete bookmark-menu-rename bookmark-menu-locate bookmark-menu-jump bookmark-menu-insert bookmark-bmenu-list bookmark-load bookmark-save bookmark-write bookmark-delete bookmark-insert bookmark-rename bookmark-insert-location bookmark-relocate bookmark-jump bookmark-set bookmark-all-names) "bookmark" "packages/bookmark.el") (if (symbolp (key-binding "r")) nil (progn (define-key ctl-x-map "rb" 'bookmark-jump) (define-key ctl-x-map "rm" 'bookmark-set) (define-key ctl-x-map "rl" 'bookmark-bmenu-list))) @@ -200,6 +200,9 @@ (add-hook 'kill-emacs-hook (function (lambda nil (and (featurep 'bookmark) bookmark-alist (bookmark-time-to-save-p t) (bookmark-save))))) +(autoload 'bookmark-all-names "bookmark" "\ +Return a list of all current bookmark names." nil nil) + (autoload 'bookmark-set "bookmark" "\ Set a bookmark named NAME inside a file. If name is nil, then the user will be prompted. @@ -1626,6 +1629,8 @@ ;;;### (autoloads (turn-on-lazy-lock lazy-lock-mode) "lazy-lock" "packages/lazy-lock.el") +(defvar lazy-lock-mode nil) + (autoload 'lazy-lock-mode "lazy-lock" "\ Toggle Lazy Lock mode. With arg, turn Lazy Lock mode on if and only if arg is positive and the buffer @@ -1652,7 +1657,7 @@ (autoload 'turn-on-lazy-lock "lazy-lock" "\ Unconditionally turn on Lazy Lock mode." nil nil) -(when (fboundp 'add-minor-mode) (defvar lazy-lock-mode nil) (add-minor-mode 'lazy-lock-mode nil)) +(add-minor-mode 'lazy-lock-mode " Lazy") ;;;***
--- a/lisp/packages/balloon-help.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/packages/balloon-help.el Mon Aug 13 09:44:42 2007 +0200 @@ -479,7 +479,8 @@ (cons 'minibuffer (minibuffer-window junk-frame)) '(width . 3) - '(height . 1))))) + '(height . 1) + '(balloon-help . t))))) (set-face-font 'default balloon-help-font frame) (set-face-foreground 'default balloon-help-foreground frame) (set-face-background 'default balloon-help-background frame)
--- a/lisp/packages/bookmark.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/packages/bookmark.el Mon Aug 13 09:44:42 2007 +0200 @@ -338,7 +338,7 @@ "Return name of FULL-RECORD \(an alist element instead of a string\)." (car full-record)) - +;;;###autoload (defun bookmark-all-names () "Return a list of all current bookmark names." (bookmark-maybe-load-default-file) @@ -2087,7 +2087,7 @@ (x-popup-menu event (bookmark-menu-build-paned-menu name entries))) (t ; XEmacs (get-popup-menu-response - (cons title + (cons name (mapcar (function (lambda (x)
--- a/lisp/packages/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/packages/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -91,7 +91,7 @@ (put 'supercite-hooks 'custom-loads '("supercite")) (put 'display 'custom-loads '()) (put 'texinfo-tex 'custom-loads '("texnfo-tex")) -(put 'faces 'custom-loads '("fast-lock" "ps-print")) +(put 'faces 'custom-loads '("fast-lock" "hyper-apropos" "ps-print")) (put 'pages 'custom-loads '("page-ext")) (put 'diary 'custom-loads '()) (put 'supercite-frames 'custom-loads '("supercite"))
--- a/lisp/packages/gnuserv.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/packages/gnuserv.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,7 +1,7 @@ ;;; gnuserv.el --- Lisp interface code between Emacs and gnuserv ;; Copyright (C) 1989-1997 Free Software Foundation, Inc. -;; Version: 3.3 +;; Version: 3.4 ;; Author: Andy Norman (ange@hplb.hpl.hp.com), originally based on server.el ;; Hrvoje Niksic <hniksic@srce.hr> ;; Maintainer: Jan Vroonhof <vroonhof@math.ethz.ch>, @@ -74,13 +74,13 @@ ;; ;; Hrvoje Niksic <hniksic@srce.hr> May/1997 ;; Completely rewritten. Now uses `defstruct' and other CL stuff -;; to define clients cleanly. Dave, thanks! +;; to define clients cleanly. Many thanks to Dave Gillespie! ;;; Code: (defconst gnuserv-rcs-version - "$Id: gnuserv.el,v 1.10 1997/05/29 23:50:05 steve Exp $") + "$Id: gnuserv.el,v 1.11 1997/06/26 02:31:17 steve Exp $") (defgroup gnuserv nil "The gnuserv suite of programs to talk to Emacs from outside." @@ -187,16 +187,24 @@ ;; The old functions are provided as aliases, to avoid breaking .emacs ;; files. However, they are obsolete and should be avoided. -(defvaralias 'server-frame 'gnuserv-frame) -(defvaralias 'server-done-function 'gnuserv-done-function) -(defvaralias 'server-done-temp-file-function 'gnuserv-done-temp-file-function) -(defvaralias 'server-find-file-function 'gnuserv-find-file-function) -(defvaralias 'server-program 'gnuserv-program) -(defvaralias 'server-visit-hook 'gnuserv-visit-hook) -(defvaralias 'server-done-hook 'gnuserv-done-hook) -(defvaralias 'server-kill-quietly 'gnuserv-kill-quietly) -(defvaralias 'server-temp-file-regexp 'gnuserv-temp-file-regexp) -(defvaralias 'server-make-temp-file-backup 'gnuserv-make-temp-file-backup) +(define-obsolete-variable-alias 'server-frame 'gnuserv-frame) +(define-obsolete-variable-alias 'server-done-function 'gnuserv-done-function) +(define-obsolete-variable-alias 'server-done-temp-file-function + 'gnuserv-done-temp-file-function) +(define-obsolete-variable-alias 'server-find-file-function + 'gnuserv-find-file-function) +(define-obsolete-variable-alias 'server-program + 'gnuserv-program) +(define-obsolete-variable-alias 'server-visit-hook + 'gnuserv-visit-hook) +(define-obsolete-variable-alias 'server-done-hook + 'gnuserv-done-hook) +(define-obsolete-variable-alias 'server-kill-quietly + 'gnuserv-kill-quietly) +(define-obsolete-variable-alias 'server-temp-file-regexp + 'gnuserv-temp-file-regexp) +(define-obsolete-variable-alias 'server-make-temp-file-backup + 'gnuserv-make-temp-file-backup) ;;; Internal variables: @@ -475,12 +483,10 @@ ;; `gnuserv-buffer-p' when appropriate, for instance. (defun gnuserv-buffer-clients (buffer) "Returns a list of clients to which BUFFER belongs." - (let ((client gnuserv-clients) - res) - (while client - (if (memq buffer (gnuclient-buffers (car client))) - (push (car client) res)) - (pop client)) + (let (res) + (dolist (client gnuserv-clients) + (when (memq buffer (gnuclient-buffers client)) + (push client res))) res)) ;; Like `gnuserv-buffer-clients', but returns a boolean; doesn't @@ -499,14 +505,12 @@ "Remove the buffer from the buffer lists of all the clients it belongs to. Any client that remains \"empty\" after the removal is informed that the editing has ended." - (let* ((buf (current-buffer)) - (clients (gnuserv-buffer-clients buf))) - (while clients - (callf2 delq buf (gnuclient-buffers (car clients))) + (let* ((buf (current-buffer))) + (dolist (client (gnuserv-buffer-clients buf)) + (callf2 delq buf (gnuclient-buffers client)) ;; If no more buffers, kill the client. - (when (null (gnuclient-buffers (car clients))) - (gnuserv-kill-client (car clients))) - (pop clients)))) + (when (null (gnuclient-buffers client)) + (gnuserv-kill-client client))))) (add-hook 'kill-buffer-hook 'gnuserv-kill-buffer-function) @@ -534,15 +538,13 @@ ;; as well. This is why we hook into `delete-device-hook'. (defun gnuserv-check-device (device) (when (memq device gnuserv-devices) - (let ((client gnuserv-clients)) - (while client - (when (eq device (gnuclient-device (car client))) - ;; we must make sure that the server kill doesn't result in - ;; killing the device, because it would cause a device-dead - ;; error when `delete-device' tries to do the job later. - (gnuserv-kill-client (car client) t)) - (pop client))) - (callf2 delq device gnuserv-devices))) + (dolist (client gnuserv-clients) + (when (eq device (gnuclient-device client)) + ;; we must make sure that the server kill doesn't result in + ;; killing the device, because it would cause a device-dead + ;; error when `delete-device' tries to do the job later. + (gnuserv-kill-client (car client) t)))) + (callf2 delq device gnuserv-devices)) (add-hook 'delete-device-hook 'gnuserv-check-device) @@ -589,21 +591,19 @@ ;; Do away with the buffer. (defun gnuserv-buffer-done-1 (buffer) - (let ((clients (gnuserv-buffer-clients buffer))) - (while clients - (callf2 delq buffer (gnuclient-buffers (car clients))) - (when (null (gnuclient-buffers (car clients))) - (gnuserv-kill-client (car clients))) - (pop clients)) - ;; Get rid of the buffer - (save-excursion - (set-buffer buffer) - (run-hooks 'gnuserv-done-hook) - (setq gnuserv-minor-mode nil) - (funcall (if (gnuserv-temp-file-p buffer) - gnuserv-done-temp-file-function - gnuserv-done-function) - buffer)))) + (dolist (client (gnuserv-buffer-clients buffer)) + (callf2 delq buffer (gnuclient-buffers client)) + (when (null (gnuclient-buffers client)) + (gnuserv-kill-client client))) + ;; Get rid of the buffer + (save-excursion + (set-buffer buffer) + (run-hooks 'gnuserv-done-hook) + (setq gnuserv-minor-mode nil) + (funcall (if (gnuserv-temp-file-p buffer) + gnuserv-done-temp-file-function + gnuserv-done-function) + buffer))) ;;; Higher-level functions @@ -629,7 +629,7 @@ ;; Else, try to find any client with at least one buffer, and ;; return its first buffer. ((setq client - (car (member-if-not 'null gnuserv-clients + (car (member-if-not #'null gnuserv-clients :key 'gnuclient-buffers))) (car (gnuclient-buffers client))) ;; Oh, give up.
--- a/lisp/packages/hyper-apropos.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/packages/hyper-apropos.el Mon Aug 13 09:44:42 2007 +0200 @@ -109,9 +109,7 @@ (defgroup hyper-apropos-faces nil "Faces defined by hyper-apropos." :prefix "hyper-apropos-" - :group 'hyper-apropos) -(define-obsolete-variable-alias - 'hypropos-faces 'hyper-apropos-faces) + :group 'faces) (defface hyper-apropos-documentation '((((class color) (background light)) @@ -292,7 +290,7 @@ (defun hyper-apropos-toggle-programming-flag () (interactive) - (eval-in-buffer hyper-apropos-apropos-buf + (with-current-buffer hyper-apropos-apropos-buf (set (make-local-variable 'hyper-apropos-programming-apropos) (not hyper-apropos-programming-apropos))) (message "Re-running apropos...")
--- a/lisp/packages/info.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/packages/info.el Mon Aug 13 09:44:42 2007 +0200 @@ -292,6 +292,11 @@ ;; ;; Modified Info-search to use with-caps-disable-folding +;; Modified 6/21/97 by Hrvoje Niksic +;; +;; Fixed up Info-next-reference to work sanely when n < 0. +;; Added S-tab binding. + ;; Code: (defgroup info nil @@ -855,7 +860,7 @@ (let ((buffer-read-only nil) (bufmod (buffer-modified-p)) (case-fold-search t)) - (while (re-search-forward "\\*Note\\([ \n]\\)" nil t) + (while (re-search-forward "\\*[Nn]ote\\([ \n]\\)" nil t) (replace-match (concat "*" Info-footnote-tag "\ "))) (set-buffer-modified-p bufmod)))) (Info-reannotate-node) @@ -1217,28 +1222,46 @@ (interactive "p") (let ((pat (format "\\*%s[ \n\t]*\\([^:]*\\):\\|^\\* .*:\\|<<.*>>" Info-footnote-tag)) - (case-fold-search nil) - (old-pt (point))) + (old-pt (point)) + wrapped found-nomenu) (while (< n 0) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward pat nil t) - (setq n (1+ n))) + (unless (re-search-backward pat nil t) + ;; Don't wrap more than once in a buffer where only the + ;; menu references are found. + (when (and wrapped (not found-nomenu)) + (goto-char old-pt) + (error "No cross references in this node")) + (setq wrapped t) + (goto-char (point-max)) + (unless (re-search-backward pat nil t) + (goto-char old-pt) + (error "No cross references in this node"))) + (unless (save-excursion + (goto-char (match-beginning 0)) + (when (looking-at "\\* Menu:") + (decf n))) + (setq found-nomenu t)) + (incf n)) + (while (> n 0) + (or (eobp) (forward-char 1)) + (unless (re-search-forward pat nil t) + (when (and wrapped (not found-nomenu)) + (goto-char old-pt) + (error "No cross references in this node")) + (setq wrapped t) (goto-char (point-min)) - (if (re-search-forward "^\\* Menu:" nil t) - (setq n (1- n))))) - (while (>= (setq n (1- n)) 0) - (or (eobp) (forward-char 1)) - (or (re-search-forward pat nil t) - (progn - (goto-char (point-min)) - (or (re-search-forward pat nil t) - (progn - (goto-char old-pt) - (error "No cross references in this node"))))) - (goto-char (match-beginning 0)) - (if (looking-at "\\* Menu:") - (setq n (1+ n)))))) + (unless (re-search-forward pat nil t) + (goto-char old-pt) + (error "No cross references in this node"))) + (unless (save-excursion + (goto-char (match-beginning 0)) + (when (looking-at "\\* Menu:") + (incf n))) + (setq found-nomenu t)) + (decf n)) + (when (looking-at "\\* Menu:") + (error "No cross references in this node")) + (goto-char (match-beginning 0)))) (defun Info-prev-reference (n) (interactive "p") @@ -2074,8 +2097,9 @@ (define-key Info-mode-map "@" 'Info-follow-nearest-node) (define-key Info-mode-map "," 'Info-index-next) (define-key Info-mode-map "*" 'Info-elisp-ref) - (define-key Info-mode-map "\t" 'Info-next-reference) - (define-key Info-mode-map "\e\t" 'Info-prev-reference) + (define-key Info-mode-map [tab] 'Info-next-reference) + (define-key Info-mode-map [(meta tab)] 'Info-prev-reference) + (define-key Info-mode-map [(shift tab)] 'Info-prev-reference) (define-key Info-mode-map "\r" 'Info-follow-nearest-node) ;; XEmacs addition (define-key Info-mode-map 'backspace 'Info-scroll-prev)
--- a/lisp/packages/lazy-lock.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/packages/lazy-lock.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,10 +1,17 @@ ;;; lazy-lock.el --- Lazy demand-driven fontification for fast Font Lock mode. -;; Copyright (C) 1994, 1995, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Simon Marshall <simon@gnu.ai.mit.edu> ;; Keywords: faces files -;; Version: 1.16 +;; Version: 1.14 + +;; LCD Archive Entry: +;; lazy-lock|Simon Marshall|simon@gnu.ai.mit.edu| +;; Lazy Font Lock mode (with fast demand-driven fontification).| +;; 13-Oct-95|1.14|~/modes/lazy-lock.el.Z| + +;; The archive is archive.cis.ohio-state.edu in /pub/gnu/emacs/elisp-archive. ;;; This file is part of GNU Emacs. @@ -19,9 +26,10 @@ ;; 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. +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Synched up with: Not in FSF. (This seems very strange to me.) ;;; Commentary: @@ -100,107 +108,8 @@ ;; These kinds of things with `advice' aren't done automatically because they ;; cause large packages (advice.el plus bytecomp.el and friends) to be loaded. -;; Implementation differences with version 2: -;; -;; - Version 1 of lazy-lock.el is a bit of a hack. Version 1 demand-driven -;; fontification, the core feature of lazy-lock.el, is implemented by placing a -;; function on `post-command-hook'. This function fontifies where necessary, -;; i.e., where a window scroll has occurred. However, there are a number of -;; problems with using `post-command-hook': -;; -;; (a) As the name suggests, `post-command-hook' is run after every command, -;; i.e., frequently and regardless of whether scrolling has occurred. -;; (b) Scrolling can occur during a command, when `post-command-hook' is not -;; run, i.e., it is not necessarily run after scrolling has occurred. -;; (c) When `post-command-hook' is run, there is nothing to suggest where -;; scrolling might have occurred, i.e., which windows have scrolled. -;; -;; Thus lazy-lock.el's function is called almost as often as possible, usually -;; when it need not be called, yet it is not always called when it is needed. -;; Also, lazy-lock.el's function must check each window to see if a scroll has -;; occurred there. Worse still, lazy-lock.el's function must fontify a region -;; twice as large as necessary to make sure the window is completely fontified. -;; Basically, `post-command-hook' is completely inappropriate for lazy-lock.el. -;; -;; Ideally, we want to attach lazy-lock.el's function to a hook that is run -;; only when scrolling occurs, e.g., `window-start' has changed, and tells us -;; as much information as we need, i.e., the window and its new buffer region. -;; Richard Stallman implemented a `window-scroll-functions' for Emacs 19.30. -;; Functions on it are run when `window-start' has changed, and are supplied -;; with the window and the window's new `window-start' position. (It would be -;; better if it also supplied the window's new `window-end' position, but that -;; is calculated as part of the redisplay process, and the functions on -;; `window-scroll-functions' are run before redisplay has finished.) Thus, the -;; hook deals with the above problems (a), (b) and (c). -;; -;; If only life was that easy. Version 2 demand-driven fontification is mostly -;; implemented by placing a function on `window-scroll-functions'. However, -;; not all scrolling occurs when `window-start' has changed. A change in -;; window size, e.g., via C-x 1, or a significant deletion, e.g., of a number -;; of lines, causes text previously invisible (i.e., after `window-end') to -;; become visible without changing `window-start'. Arguably, these events are -;; not scrolling events, but fontification must occur for lazy-lock.el to work. -;; Hooks `window-size-change-functions' and `redisplay-end-trigger-functions' -;; were added for these circumstances. +;; Caveats: ;; -;; (Ben Wing thinks these hooks are "horribly horribly kludgy", and implemented -;; a `pre-idle-hook', a `mother-of-all-post-command-hooks', for XEmacs 19.14. -;; He then hacked up a version 1 lazy-lock.el to use `pre-idle-hook' rather -;; than `post-command-hook'. Whereas functions on `post-command-hook' are -;; called almost as often as possible, functions on `pre-idle-hook' really are -;; called as often as possible, even when the mouse moves and, on some systems, -;; while XEmacs is idle. Thus, the hook deals with the above problem (b), but -;; unfortunately it makes (a) worse and does not address (c) at all. -;; -;; I freely admit that `redisplay-end-trigger-functions' and, to a much lesser -;; extent, `window-size-change-functions' are not pretty. However, I feel that -;; a `window-scroll-functions' feature is cleaner than a `pre-idle-hook', and -;; the result is faster and smaller, less intrusive and more targeted, code. -;; Since `pre-idle-hook' is pretty much like `post-command-hook', there is no -;; point in making this version of lazy-lock.el work with it. Anyway, that's -;; Lit 30 of my humble opinion. -;; -;; Steve Baur reverted to a non-hacked version 1 lazy-lock.el for XEmacs 19.15 -;; and 20.0. Obviously, the above `post-command-hook' problems still apply.) -;; -;; - Version 1 stealth fontification is also implemented by placing a function -;; on `post-command-hook'. This function waits for a given amount of time, -;; and, if Emacs remains idle, fontifies where necessary. Again, there are a -;; number of problems with using `post-command-hook': -;; -;; (a) Functions on `post-command-hook' are run sequentially, so this function -;; can interfere with other functions on the hook, and vice versa. -;; (b) This function waits for a given amount of time, so it can interfere with -;; various features that are dealt with by Emacs after a command, e.g., -;; region highlighting, asynchronous updating and keystroke echoing. -;; (c) Fontification may be required during a command, when `post-command-hook' -;; is not run. (Version 2 deferred fontification only.) -;; -;; Again, `post-command-hook' is completely inappropriate for lazy-lock.el. -;; Richard Stallman and Morten Welinder implemented internal Timers and Idle -;; Timers for Emacs 19.31. Functions can be run independently at given times -;; or after given amounts of idle time. Thus, the feature deals with the above -;; problems (a), (b) and (c). Version 2 deferral and stealth are implemented -;; by functions on Idle Timers. (A function on XEmacs' `pre-idle-hook' is -;; similar to an Emacs Idle Timer function with a fixed zero second timeout.) -;; -;; - Version 1 has the following problems (relative to version 2): -;; -;; (a) It is slow when it does its job. -;; (b) It does not always do its job when it should. -;; (c) It slows all interaction (when it doesn't need to do its job). -;; (d) It interferes with other package functions on `post-command-hook'. -;; (e) It interferes with Emacs things within the read-eval loop. -;; -;; Ben's hacked-up lazy-lock.el 1.14 almost solved (b) but made (c) worse. -;; -;; - Version 2 has the following additional features (relative to version 1): -;; -;; (a) It can defer fontification (both on-the-fly and on-scrolling). -;; (b) It can fontify contextually (syntactically true on-the-fly). - -;; Caveats: - ;; Lazy Lock mode does not work efficiently with Outline mode. This is because ;; when in Outline mode, although text may be hidden (not visible in the ;; window), the text is visible to Emacs Lisp code (not surprisingly) and Lazy @@ -253,179 +162,230 @@ ;; ;; For XEmacs 19.11 and Lucid Emacs 19.10 users, lazy-lock sort-of works. ;; There are bugs in text property and point/window primatives. Upgrade! + +;; Feedback: ;; -;; Currently XEmacs does not have the features to support version 2 of -;; lazy-lock.el. Maybe it will one day. +;; Feedback is welcome. +;; To submit a bug report (or make comments) please use the mechanism provided: +;; +;; M-x lazy-lock-submit-bug-report RET ;; History: ;; ;; 0.01--1.00: ;; - Changed name from fore-lock to lazy-lock. Shame though. ;; - Dropped `advice'-wrapping completely. Ask me if you're interested in it. -;; - Made `lazy-lock-mode' ignore `post-command-hook' and `buffer-file-name' -;; - Made `lazy-lock-fontify-window' check `lazy-lock-mode' and `this-command' -;; - Made `lazy-lock-fontify-window' redisplay via `sit-for' -;; - Added `lazy-lock-minimum-size' to control `lazy-lock-mode' +;; - Made `lazy-lock-mode' ignore `post-command-hook' and `buffer-file-name'. +;; - Made `lazy-lock-fontify-window' check `lazy-lock-mode' and `this-command'. +;; - Made `lazy-lock-fontify-window' redisplay via `sit-for'. +;; - Added `lazy-lock-minimum-size' to control `lazy-lock-mode'. ;; 1.00--1.01: -;; - Added `lazy-lock-fontify-buffer' -;; - Made `lazy-lock-fontify-window' ignore `lazy-lock-mode' -;; - Made `lazy-lock-fontify-window' suspicious of `window-' favourites again -;; - Added `lazy-lock-delay-commands' (idea from William G. Dubuque) -;; - Added `lazy-lock-ignore-commands' for completeness -;; - Added `lazy-lock-continuity-time' for normal input delay +;; - Added `lazy-lock-fontify-buffer'. +;; - Made `lazy-lock-fontify-window' ignore `lazy-lock-mode'. +;; - Made `lazy-lock-fontify-window' suspicious of `window-' favourites again. +;; - Added `lazy-lock-delay-commands' (idea from William G. Dubuque). +;; - Added `lazy-lock-ignore-commands' for completeness. +;; - Added `lazy-lock-continuity-time' for normal input delay. ;; 1.01--1.02: -;; - Made `lazy-lock-fontify-window' cope with multiple unfontified regions -;; - Made `lazy-lock-mode' remove `fontified' properties if turned off -;; - Made `lazy-lock-fontify-window' fontify by lines -;; - Added `lazy-lock-cache-position' buffer local to detect visibility change -;; - Added `lazy-lock-post-command-hook' to do the waiting -;; - Made `lazy-lock-fontify-window' just do the fontification -;; - Made `lazy-lock-mode' append `lazy-lock-post-command-hook' -;; - Added `lazy-lock-walk-windows' to hack multi-window motion -;; - Made `lazy-lock-post-command-hook' `walk-windows' if variable is non-nil -;; - Removed `lazy-lock-ignore-commands' since insertion may change window -;; - Added `lazy-lock-fontify-stealthily' and `lazy-lock-stealth-time' -;; - Made `lazy-lock-post-command-hook' use them +;; - Made `lazy-lock-fontify-window' cope with multiple unfontified regions. +;; - Made `lazy-lock-mode' remove `fontified' properties if turned off. +;; - Made `lazy-lock-fontify-window' fontify by lines. +;; - Added `lazy-lock-cache-position' buffer local to detect visibility change. +;; - Added `lazy-lock-post-command-hook' to do the waiting. +;; - Made `lazy-lock-fontify-window' just do the fontification. +;; - Made `lazy-lock-mode' append `lazy-lock-post-command-hook'. +;; - Added `lazy-lock-walk-windows' to hack multi-window motion. +;; - Made `lazy-lock-post-command-hook' `walk-windows' if variable is non-nil. +;; - Removed `lazy-lock-ignore-commands' since insertion may change window. +;; - Added `lazy-lock-fontify-stealthily' and `lazy-lock-stealth-time'. +;; - Made `lazy-lock-post-command-hook' use them. ;; 1.02--1.03: -;; - Made `lazy-lock-fontify-stealthily' do `forward-line' not `previous-line' -;; - Made `lazy-lock-fontify-stealthily' `move-to-window-line' first -;; - Made `lazy-lock-fontify-stealthily' use `text-property-any' for region -;; - Made `lazy-lock-post-command-hook' loop on `lazy-lock-fontify-stealthily' +;; - Made `lazy-lock-fontify-stealthily' do `forward-line' not `previous-line'. +;; - Made `lazy-lock-fontify-stealthily' `move-to-window-line' first. +;; - Made `lazy-lock-fontify-stealthily' use `text-property-any' for region. +;; - Made `lazy-lock-post-command-hook' loop on `lazy-lock-fontify-stealthily'. ;; 1.03--1.04: -;; - Made `lazy-lock-mode' reset `lazy-lock-cache-position' -;; - Made `lazy-lock-post-command-hook' `widen' for `if' `text-property-any' -;; - Made `lazy-lock-fontify-stealthily' return `text-property-any' -;; - Added `lazy-lock-percent-fontified' for a/be-musement -;; - Made `lazy-lock-post-command-hook' use it -;; - Made `lazy-lock-mode' use `make-local-hook' etc. if available -;; - Made `lazy-lock-mode' use `before-revert-hook' and `after-revert-hook' -;; - Made `lazy-lock-post-command-hook' protect `deactivate-mark' -;; - Adds `lazy-lock-post-command-hook' globally to `post-command-hook' +;; - Made `lazy-lock-mode' reset `lazy-lock-cache-position'. +;; - Made `lazy-lock-post-command-hook' `widen' for `if' `text-property-any'. +;; - Made `lazy-lock-fontify-stealthily' return `text-property-any'. +;; - Added `lazy-lock-percent-fontified' for a/be-musement. +;; - Made `lazy-lock-post-command-hook' use it. +;; - Made `lazy-lock-mode' use `make-local-hook' etc. if available. +;; - Made `lazy-lock-mode' use `before-revert-hook' and `after-revert-hook'. +;; - Made `lazy-lock-post-command-hook' protect `deactivate-mark'. +;; - Adds `lazy-lock-post-command-hook' globally to `post-command-hook'. ;; 1.04--1.05: -;; - Made `lazy-lock-mode' test `make-local-hook' not `emacs-minor-version' +;; - Made `lazy-lock-mode' test `make-local-hook' not `emacs-minor-version'. ;; 1.05--1.06: -;; - Added `lazy-lock-ignore-commands' for commands that leave no event but do -;; - Made `lazy-lock-post-command-hook' check `lazy-lock-ignore-commands' +;; - Added `lazy-lock-ignore-commands' for commands that leave no event but do. +;; - Made `lazy-lock-post-command-hook' check `lazy-lock-ignore-commands'. ;; 1.06--1.07: -;; - Removed `before-revert-hook' and `after-revert-hook' use +;; - Removed `before-revert-hook' and `after-revert-hook' use. ;; 1.07--1.08: -;; - Added `lazy-lock-submit-bug-report' -;; - Made `lazy-lock-post-command-hook' check `executing-macro' -;; - Made it sort-of/almost work for XEmacs (help from Jonas Jarnestrom) -;; - XEmacs: Fix `text-property-not-all' (fix based on fast-lock.el 3.05 fix) -;; - XEmacs: Set `font-lock-no-comments' and alias `frame-parameters' -;; - Made `byte-compile-warnings' omit `unresolved' on compilation -;; - Made `lazy-lock-post-command-hook' protect `buffer-undo-list' -;; - Moved `deactivate-mark' and `buffer-undo-list' protection to functions -;; - Added `lazy-lock-invisible-foreground' (idea from Boris Goldowsky) -;; - XEmacs: Fix to use `text-property-not-all' t, not `text-property-any' nil -;; - Made `lazy-lock-percent-fontified' return `round' to an integer -;; - XEmacs: Fix `text-property-any' (fix and work around for a bug elsewhere) -;; - XEmacs: Fix `lazy-lock-submit-bug-report' for reporter.el & vm-window.el -;; - XEmacs: Made `lazy-lock-fontify-window' loop `while' `<' not `/=' -;; - Use `font-lock-after-change-function' to do the fontification +;; - Added `lazy-lock-submit-bug-report'. +;; - Made `lazy-lock-post-command-hook' check `executing-macro'. +;; - Made it sort-of/almost work for XEmacs (help from Jonas Jarnestrom). +;; - XEmacs: Fix `text-property-not-all' (fix based on fast-lock.el 3.05 fix). +;; - XEmacs: Set `font-lock-no-comments' and alias `frame-parameters'. +;; - Made `byte-compile-warnings' omit `unresolved' on compilation. +;; - Made `lazy-lock-post-command-hook' protect `buffer-undo-list'. +;; - Moved `deactivate-mark' and `buffer-undo-list' protection to functions. +;; - Added `lazy-lock-invisible-foreground' (idea from Boris Goldowsky). +;; - XEmacs: Fix to use `text-property-not-all' t, not `text-property-any' nil. +;; - Made `lazy-lock-percent-fontified' return `round' to an integer. +;; - XEmacs: Fix `text-property-any' (fix and work around for a bug elsewhere). +;; - XEmacs: Fix `lazy-lock-submit-bug-report' for reporter.el & vm-window.el. +;; - XEmacs: Made `lazy-lock-fontify-window' loop `while' `<' not `/='. +;; - Use `font-lock-after-change-function' to do the fontification. ;; 1.08--1.09: -;; - Made `lazy-lock-post-command-hook' protect with `condition-case' -;; - Made `lazy-lock-cache-start' to cache `window-start' -;; - Made `lazy-lock-fontify-window' check and cache `lazy-lock-cache-start' -;; - Renamed `lazy-lock-cache-position' to `lazy-lock-cache-end' -;; - XEmacs: Fix for `font-lock-after-change-function' -;; - Adds `lazy-lock-post-command-hook' globally to `window-setup-hook' +;; - Made `lazy-lock-post-command-hook' protect with `condition-case'. +;; - Made `lazy-lock-cache-start' to cache `window-start'. +;; - Made `lazy-lock-fontify-window' check and cache `lazy-lock-cache-start'. +;; - Renamed `lazy-lock-cache-position' to `lazy-lock-cache-end'. +;; - XEmacs: Fix for `font-lock-after-change-function'. +;; - Adds `lazy-lock-post-command-hook' globally to `window-setup-hook'. ;; 1.09--1.10: -;; - Made `buffer-file-name' be `let' to prevent supersession (Kevin Broadey) -;; - Made `lazy-lock-submit-bug-report' `require' reporter (Ilya Zakharevich) -;; - Made `lazy-lock-mode' and `turn-on-lazy-lock' succeed `autoload' cookies -;; - Added `lazy-lock-fontify-walk-windows' for walking window fontification -;; - Added `lazy-lock-fontify-walk-stealthily' for walking stealth -;; - Removed `move-to-window-line' from `lazy-lock-fontify-stealthily' -;; - Made `lazy-lock-percent-fontified' use `truncate' rather than `round' -;; - Added other `*-argument' to `lazy-lock-ignore-commands' (Kevin Broadey) -;; - Made `lazy-lock-fontify-stealthily' not assume buffer is part `fontified' -;; - Emacs: Fix for `font-lock-fontify-region' -;; - Made `lazy-lock-post-command-hook' check for minibuffer (Kevin Broadey) -;; - Added `lazy-lock-stealth-nice' for niceness during stealth fontification -;; - Added `lazy-lock-stealth-lines' for chunks of stealth fontification +;; - Made `buffer-file-name' be `let' to prevent supersession (Kevin Broadey). +;; - Made `lazy-lock-submit-bug-report' `require' reporter (Ilya Zakharevich). +;; - Made `lazy-lock-mode' and `turn-on-lazy-lock' succeed `autoload' cookies. +;; - Added `lazy-lock-fontify-walk-windows' for walking window fontification. +;; - Added `lazy-lock-fontify-walk-stealthily' for walking stealth. +;; - Removed `move-to-window-line' from `lazy-lock-fontify-stealthily'. +;; - Made `lazy-lock-percent-fontified' use `truncate' rather than `round'. +;; - Added other `*-argument' to `lazy-lock-ignore-commands' (Kevin Broadey). +;; - Made `lazy-lock-fontify-stealthily' not assume buffer is part `fontified'. +;; - Emacs: Fix for `font-lock-fontify-region'. +;; - Made `lazy-lock-post-command-hook' check for minibuffer (Kevin Broadey). +;; - Added `lazy-lock-stealth-nice' for niceness during stealth fontification. +;; - Added `lazy-lock-stealth-lines' for chunks of stealth fontification. ;; 1.10--1.11: incorporated hack by Ben Wing from William Dubuque's fontifly.el -;; - Made `lazy-lock-fontify-stealthily' see a non `fontified' preceding line -;; - XEmacs: Fix `text-property-any' and `text-property-not-all' (Ben Wing) -;; - XEmacs: Fix `lazy-lock-continuity-time' (Ben Wing) -;; - Added awful `lazy-lock-running-xemacs-p' (Ben Wing) -;; - Made loading set `emacs-minor-version' if it's not bound -;; - Added `lazy-lock-hide-invisible' to control redisplay -;; - Made `lazy-lock-post-command-hook' use it in `sit-for' (Ben Wing) -;; - Made `lazy-lock-fontify-window' move relative to `end-of-line' if non-nil -;; - Added `lazy-lock-fontify-region' so packages can ensure fontification -;; - Made `lazy-lock-fontify-walk-stealthily' do stealth widening -;; - Made `lazy-lock-fontify-stealthily' always do adjacent preceding regions -;; - Added `lazy-lock-after-fontify-buffer' -;; - XEmacs: Removed `font-lock-no-comments' incompatibility code -;; - Removed `lazy-lock-delay-time' and `lazy-lock-delay-commands' -;; - Removed `lazy-lock-post-command' and split the functionality -;; - Adds `lazy-lock-post-command-fontify-windows' on first -;; - Adds `lazy-lock-post-command-fontify-stealthily' on last -;; - Made `lazy-lock-mode' ensure both first and last on `post-command-hook' -;; - Made `lazy-lock-mode' ensure `font-lock-mode' is on -;; - Wrap `lazy-lock-post-command-fontify-stealthily' for errors (David Karr) -;; - Added `calcDigit-key' to `lazy-lock-ignore-commands' (Bob Glickstein) -;; - Wrap `lazy-lock-running-xemacs-p' with `eval-and-compile' (Erik Naggum) -;; - XEmacs: Fix use of `previous-single-property-change' (Jim Thompson) -;; - XEmacs: Fix `next-single-property-change' fix for 19.11 (Jim Thompson) -;; - Added `lazy-lock-post-resize-fontify-windows' to fontify on resizing -;; - Adds globally to `window-size-change-functions' -;; - Added `lazy-lock-post-setup-fontify-windows' to fontify after start up -;; - Adds globally to `window-setup-hook' -;; - Made `lazy-lock-post-command-fontify-windows' check for `input-pending-p' -;; - Made `save-selected-window' to restore the `selected-window' -;; - Use `save-selected-window' rather than `save-window-excursion' +;; - Made `lazy-lock-fontify-stealthily' see a non `fontified' preceding line. +;; - XEmacs: Fix `text-property-any' and `text-property-not-all' (Ben Wing). +;; - XEmacs: Fix `lazy-lock-continuity-time' (Ben Wing). +;; - Added awful `lazy-lock-running-xemacs-p' (Ben Wing). +;; - Made loading set `emacs-minor-version' if it's not bound. +;; - Added `lazy-lock-hide-invisible' to control redisplay. +;; - Made `lazy-lock-post-command-hook' use it in `sit-for' (Ben Wing). +;; - Made `lazy-lock-fontify-window' move relative to `end-of-line' if non-nil. +;; - Added `lazy-lock-fontify-region' so packages can ensure fontification. +;; - Made `lazy-lock-fontify-walk-stealthily' do stealth widening. +;; - Made `lazy-lock-fontify-stealthily' always do adjacent preceding regions. +;; - Added `lazy-lock-after-fontify-buffer'. +;; - XEmacs: Removed `font-lock-no-comments' incompatibility code. +;; - Removed `lazy-lock-delay-time' and `lazy-lock-delay-commands'. +;; - Removed `lazy-lock-post-command' and split the functionality. +;; - Adds `lazy-lock-post-command-fontify-windows' on first. +;; - Adds `lazy-lock-post-command-fontify-stealthily' on last. +;; - Made `lazy-lock-mode' ensure both first and last on `post-command-hook'. +;; - Made `lazy-lock-mode' ensure `font-lock-mode' is on. +;; - Wrap `lazy-lock-post-command-fontify-stealthily' for errors (David Karr). +;; - Added `calcDigit-key' to `lazy-lock-ignore-commands' (Bob Glickstein). +;; - Wrap `lazy-lock-running-xemacs-p' with `eval-and-compile' (Erik Naggum). +;; - XEmacs: Fix use of `previous-single-property-change' (Jim Thompson). +;; - XEmacs: Fix `next-single-property-change' fix for 19.11 (Jim Thompson). +;; - Added `lazy-lock-post-resize-fontify-windows' to fontify on resizing. +;; - Adds globally to `window-size-change-functions'. +;; - Added `lazy-lock-post-setup-fontify-windows' to fontify after start up. +;; - Adds globally to `window-setup-hook'. +;; - Made `lazy-lock-post-command-fontify-windows' check for `input-pending-p'. +;; - Made `save-selected-window' to restore the `selected-window'. +;; - Use `save-selected-window' rather than `save-window-excursion'. ;; 1.11--1.12: -;; - Made `lazy-lock-post-command-fontify-windows' do `set-buffer' first -;; - Made `lazy-lock-fontify-stealthily' respect narrowing before point -;; - Added `lazy-lock-post-setup-ediff-control-frame' for Ediff control frame -;; - Adds globally to `ediff-after-setup-control-frame-hooks' -;; - Wrap `save-selected-window' with `save-excursion' for `current-buffer' +;; - Made `lazy-lock-post-command-fontify-windows' do `set-buffer' first. +;; - Made `lazy-lock-fontify-stealthily' respect narrowing before point. +;; - Added `lazy-lock-post-setup-ediff-control-frame' for Ediff control frame. +;; - Adds globally to `ediff-after-setup-control-frame-hooks'. +;; - Wrap `save-selected-window' with `save-excursion' for `current-buffer'. ;; 1.12--1.13: -;; - XEmacs: Add `lazy-lock-after-fontify-buffer' to the Font Lock hook -;; - Made `buffer-file-truename' also wrapped for supersession (Rick Sladkey) -;; - Made `font-lock-beginning-of-syntax-function' wrapped for fontification -;; - Added `lazy-lock-stealth-verbose' (after harassment from Ben Wing) -;; - XEmacs: Made `font-lock-verbose' wrapped for stealth fontification +;; - XEmacs: Add `lazy-lock-after-fontify-buffer' to the Font Lock hook. +;; - Made `buffer-file-truename' also wrapped for supersession (Rick Sladkey). +;; - Made `font-lock-beginning-of-syntax-function' wrapped for fontification. +;; - Added `lazy-lock-stealth-verbose' (after harassment from Ben Wing). +;; - XEmacs: Made `font-lock-verbose' wrapped for stealth fontification. ;; 1.13--1.14: -;; - Wrap `lazy-lock-colour-invisible' for `set-face-foreground' (Jari Aalto) -;; 1.14--1.15: -;; - Made `lazy-lock-post-command-setup'; may add to `post-command-idle-hook' -;; 1.15--1.16: -;; - Test `emacs-major-version' as well as `emacs-minor-version' -;; - Barf if Emacs 19.30 or up is running -;; - Adds globally to `ediff-after-setup-control-frame-hook' too -;; - Renamed `lazy-lock-running-xemacs-p' to `lazy-lock-running-xemacs' -;; - Removed `lazy-lock-submit-bug-report' and bade farewell +;; - Wrap `lazy-lock-colour-invisible' for `set-face-foreground' (Jari Aalto). -;;; Code: - (require 'font-lock) -;; Make sure lazy-lock.el isn't depreciated. -(if (if (save-match-data (string-match "Lucid\\|XEmacs" (emacs-version))) - nil - (or (> emacs-major-version 19) (> emacs-minor-version 29))) - (error "`lazy-lock' version 2 should be used for Emacs 19.30 or later")) +(eval-when-compile + ;; Only `require' so `ediff-multiframe-setup-p' is expanded at compile time. + (condition-case nil (require 'ediff) (file-error)) + ;; Well, shouldn't Lazy Lock be as lazy as possible? + ;(setq byte-compile-dynamic t byte-compile-dynamic-docstrings t) + ;; Shut Emacs' byte-compiler up (cf. stop me getting mail from users). + (setq byte-compile-warnings '(free-vars callargs redefine))) + +(defun lazy-lock-submit-bug-report () + "Submit via mail a bug report on lazy-lock.el." + (interactive) + (require 'reporter) + (let ((reporter-prompt-for-summary-p t)) + (reporter-submit-bug-report "simon@gnu.ai.mit.edu" "lazy-lock 1.14" + '(lazy-lock-walk-windows lazy-lock-continuity-time + lazy-lock-stealth-time lazy-lock-stealth-nice + lazy-lock-stealth-lines lazy-lock-stealth-verbose + lazy-lock-hide-invisible lazy-lock-invisible-foreground + lazy-lock-minimum-size lazy-lock-ignore-commands) + nil nil + (concat "Hi Si., + +I want to report a bug. I've read the `Bugs' section of `Info' on Emacs, so I +know how to make a clear and unambiguous report. To reproduce the bug: + +Start a fresh Emacs via `" invocation-name " -no-init-file -no-site-file'. +In the `*scratch*' buffer, evaluate:")))) + +;; Let's define `emacs-major-version', `emacs-minor-version', and +;; `emacs-version>=' if no-one else has. -(eval-when-compile - ;; - ;; We don't do this at the top-level as we only use non-autoloaded macros. - (require 'cl) - ;; - ;; Well, shouldn't Lazy Lock be as lazy as possible? - (setq byte-compile-dynamic t byte-compile-dynamic-docstrings t)) +(if (not (boundp 'emacs-major-version)) + (eval-and-compile + (defconst emacs-major-version + (progn (or (string-match "^[0-9]+" emacs-version) + (error "emacs-version unparsable")) + (string-to-int (match-string 0 emacs-version))) + "Major version number of this version of Emacs, as an integer. +Warning, this variable did not exist in Emacs versions earlier than: + FSF Emacs: 19.23 + XEmacs: 19.10"))) +(if (not (boundp 'emacs-minor-version)) + (eval-and-compile + (defconst emacs-minor-version + (progn (or (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version) + (error "emacs-version unparsable")) + (string-to-int (match-string 1 emacs-version))) + "Minor version number of this version of Emacs, as an integer. +Warning, this variable did not exist in Emacs versions earlier than: + FSF Emacs: 19.23 + XEmacs: 19.10"))) + +(if (not (fboundp 'emacs-version>=)) + (eval-and-compile + (defun emacs-version>= (major &optional minor) + "Return true if the Emacs version is >= to the given MAJOR and MINOR numbers. + +The MAJOR version number argument is required, but the MINOR version number +argument is optional. If the minor version number is not specified (or is the +symbol `nil') then only the major version numbers are considered in the test." + (if (null minor) + (>= emacs-major-version major) + (or (> emacs-major-version major) + (and (= emacs-major-version major) + (>= emacs-minor-version minor)) + ) + )))) + +;; Yuck, but we make so much use of this variable it's probably worth it. (eval-and-compile - ;; Yuck, but we make so much use of this variable it's probably worth it. - (defconst lazy-lock-running-xemacs + (defconst lazy-lock-running-xemacs-p (not (null (save-match-data (string-match "Lucid" emacs-version)))))) (defvar lazy-lock-cache-start nil) ; for window fontifiction (defvar lazy-lock-cache-end nil) ; for window fontifiction (defvar lazy-lock-cache-continue nil) ; for stealth fontifiction + +;;;###autoload (defvar lazy-lock-mode nil) ; for modeline ;; User Variables: @@ -442,12 +402,9 @@ ;; XEmacs 19.11 and below exercise a bug in the Xt event loop. (defvar lazy-lock-continuity-time - (cond ((not lazy-lock-running-xemacs) - 0) - ((and (= emacs-major-version 19) (< emacs-minor-version 12)) - (if (featurep 'lisp-float-type) (/ (float 1) (float 1000)) 1)) - (t - 0)) + (if (or (not lazy-lock-running-xemacs-p) (emacs-version>= 19 12)) + 0 + (if (featurep 'lisp-float-type) 0.001 1)) "*Time in seconds to delay before normal window fontification. Window fontification occurs if there is no input within this time.") @@ -455,28 +412,25 @@ ;; `text-property-any', `text-property-not-all' and ;; `next-single-property-change' up to XEmacs 19.11 are too broke. (defvar lazy-lock-stealth-time - (when (or (> emacs-major-version 19) - (and (not lazy-lock-running-xemacs) (> emacs-minor-version 25)) - (and lazy-lock-running-xemacs (> emacs-minor-version 11))) - 30) + (if (emacs-version>= 19 (if lazy-lock-running-xemacs-p 12 26)) 30) "*Time in seconds to delay before beginning stealth fontification. Stealth fontification occurs if there is no input within this time. If nil, means no fontification by stealth.") (defvar lazy-lock-stealth-lines - (if lazy-lock-running-xemacs - (if font-lock-maximum-decoration 50 100) - (if font-lock-maximum-decoration 100 250)) + (cond ((boundp 'font-lock-maximum-decoration) + (if font-lock-maximum-decoration 75 150)) + ((boundp 'font-lock-use-maximal-decoration) + (if font-lock-use-maximal-decoration 50 100)) + (t + 50)) "*If non-nil, the maximum size of a chunk of stealth fontification. Each iteration of stealth fontification can fontify this number of lines. To speed up input response during stealth fontification, at the cost of stealth taking longer to fontify, you could reduce the value of this variable. If nil, means use `window-height' for the maximum chunk size.") -(defvar lazy-lock-stealth-nice - (if lazy-lock-running-xemacs - (if (featurep 'lisp-float-type) (/ (float 1) (float 4)) 1) - (if (featurep 'lisp-float-type) (/ (float 1) (float 8)) 1)) +(defvar lazy-lock-stealth-nice (if (featurep 'lisp-float-type) 0.125 1) "*Time in seconds to pause during chunks of stealth fontification. To reduce machine load during stealth fontification, at the cost of stealth taking longer to fontify, you could increase the value of this variable.") @@ -495,7 +449,7 @@ To speed up typing response, at the cost of Lazy Lock not fontifying when insertion causes scrolling, you could add `self-insert-command' to this list.") -(defvar lazy-lock-hide-invisible lazy-lock-running-xemacs +(defvar lazy-lock-hide-invisible lazy-lock-running-xemacs-p "*If non-nil, hide invisible text while it is fontified. If non-nil, redisplay is delayed until after fontification occurs. If nil, text is shown (in `lazy-lock-invisible-foreground') while it is fontified. @@ -542,8 +496,8 @@ (progn (add-hook 'font-lock-mode-hook 'turn-on-lazy-lock) (font-lock-mode 1)) + (lazy-lock-fixup-hooks) ;; Let's get down to business. - (lazy-lock-post-command-setup) (if (not lazy-lock-mode) (let ((modified (buffer-modified-p)) (inhibit-read-only t) (buffer-undo-list t) @@ -561,16 +515,56 @@ "Unconditionally turn on Lazy Lock mode." (lazy-lock-mode 1)) -(when (and (= emacs-major-version 19) - (< emacs-minor-version (if lazy-lock-running-xemacs 12 29))) - ;; We don't need this in Emacs 19.29 or XEmacs 19.12. - (defun lazy-lock-fontify-buffer () - "Fontify the current buffer where necessary." - (interactive) - (lazy-lock-fontify-region (point-min) (point-max)))) +(if (not (emacs-version>= 19 (if lazy-lock-running-xemacs-p 12 29))) + ;; We don't need this in Emacs 19.29 or XEmacs 19.12. + (defun lazy-lock-fontify-buffer () + "Fontify the current buffer where necessary." + (interactive) + (lazy-lock-fontify-region (point-min) (point-max)))) ;; API Functions: +(defun lazy-lock-fixup-hooks () + ;; Make sure our hooks are correct. + (remove-hook 'pre-idle-hook 'lazy-lock-pre-idle-fontify-windows) + (remove-hook 'post-command-hook 'lazy-lock-post-command-fontify-stealthily) + ;; Make sure our hooks are at the end. Font-lock in XEmacs installs + ;; its own pre-idle-hook to implement deferral (#### something that + ;; should really be merged with this file; or more likely, lazy-lock + ;; in its entirety should be merged into font-lock). + (add-hook 'pre-idle-hook 'lazy-lock-pre-idle-fontify-windows t) + (add-hook 'post-command-hook 'lazy-lock-post-command-fontify-stealthily t) + ;; Fascistically remove font-lock's after-change-function and install + ;; our own. We know better than font-lock what to do. Otherwise, + ;; revert-buffer, insert-file, etc. cause full refontification of the + ;; entire changed area. + (if lazy-lock-mode + (progn + (remove-hook 'after-change-functions 'font-lock-after-change-function + t) + (make-local-hook 'after-change-functions) + (add-hook 'after-change-functions 'lazy-lock-after-change-function + nil t)) + (remove-hook 'after-change-functions 'lazy-lock-after-change-function t) + (if font-lock-mode + (add-hook 'after-change-functions 'font-lock-after-change-function + nil t))) +) + +;; use put-nonduplicable-text-property to avoid unfriendly behavior +;; when doing undo, etc. We really don't want syntax-highlighting text +;; properties copied into strings or tracked by undo. +;; +;; #### If start-open and end-open really behaved like they are supposed to, +;; we wouldn't really need this. I kind of fixed them up, but there's still +;; a bug -- inserting text into the middle of a region of +;; (start-open t end-open t) text should cause it not to inherit, but it +;; does. + +(if lazy-lock-running-xemacs-p + (defalias 'lazy-lock-put-text-property 'put-nonduplicable-text-property) + (defalias 'lazy-lock-put-text-property 'put-text-property)) + (defun lazy-lock-fontify-region (start end &optional buffer) "Fontify between START and END in BUFFER where necessary." (save-excursion @@ -586,18 +580,19 @@ (let ((modified (buffer-modified-p)) (inhibit-read-only t) (buffer-undo-list t) deactivate-mark buffer-file-name buffer-file-truename) - (put-text-property (point-min) (point-max) 'fontified t) + (lazy-lock-put-text-property (point-min) (point-max) 'fontified t) (or modified (set-buffer-modified-p nil)))) ;; Just a cleaner-looking way of coping with Emacs' and XEmacs' `sit-for'. (defmacro lazy-lock-sit-for (seconds &optional nodisp) - (if lazy-lock-running-xemacs + (if lazy-lock-running-xemacs-p (` (sit-for (, seconds) (, nodisp))) (` (sit-for (, seconds) 0 (, nodisp))))) ;; Using `save-window-excursion' provokes `window-size-change-functions'. ;; I prefer `save-walking-excursion', of course, because I have a warped mind. -(unless (fboundp 'save-selected-window) +(if (fboundp 'save-selected-window) + nil (eval-and-compile (defmacro save-selected-window (&rest body) "Execute the BODY forms, restoring the selected window. @@ -610,26 +605,90 @@ ;; Functions for hooks: -(defun lazy-lock-post-command-fontify-windows () - ;; We might not be where we think we are, since `post-command-hook' is run - ;; before `command_loop_1' makes sure we have the correct buffer selected. -; (set-buffer (window-buffer)) - ;; Do groovy things if (a) not in a macro, (b) no input pending, (c) got a - ;; real command, (d) not in the minibuffer, and (e) no input after waiting - ;; for `lazy-lock-continuity-time'. - (if (or executing-kbd-macro - (input-pending-p) - (memq this-command lazy-lock-ignore-commands) - (window-minibuffer-p (selected-window))) +;; lazy-lock optimization: +;; +;; pre-idle-hook is called an awful lot -- pretty much every time the +;; mouse moves or a timeout expires, for example. On Linux (sometimes), +;; IRIX 5.x, and Solaris 2.something, it happens every 1/4 of a second +;; due to the 1/4-second timers installed to compensate for various +;; operating system deficiencies in the handling of SIGIO and SIGCHLD. +;; (Those timers cause a cycle of the event loop. They don't necessarily +;; have to, but rewriting to avoid this is fairly tricky and requires +;; having significant amounts of code called from signal handlers, which +;; (despite that fact that FSF Emacs reads its X input during a signal +;; handler ?!), is almost always a bad idea -- it's extremely easy to +;; introduce race conditions, which are very hard to track down. +;; +;; So to improve things, I added `frame-modified-tick'. This is an +;; internal counter that gets ticked any time that any internal +;; redisplay variable gets ticked. If `frame-modified-tick' is +;; the same as the last time we checked, it means that redisplay will +;; do absolutely nothing when encountering this frame, and thus we +;; can skip out immediately. This happens when the 1/4-second timer +;; fires while we're idle, or if we just move the mouse. (Moving +;; around in a buffer changes `frame-modified-tick' because the +;; internal redisplay variable "point_changed" gets ticked. We could +;; easily improve things further by adding more tick counters, mirroring +;; more closely the internal redisplay counters -- e.g. if we had +;; another counter that didn't get ticked when point moved, we could +;; tell if anything was going to happen by seeing if point is within +;; window-start and window-end, since we know that redisplay will +;; only do a window-scroll if it's not. (If window-start or window-end +;; or window-buffer or anything else changed, windows_changed or +;; some other variable will get ticked.)) +;; +;; Also, it's wise to try and avoid things that cons. Avoiding +;; `save-window-excursion', as we do, is definitely a major win +;; because that's a heavy-duty function as regards consing and such. + +(defvar lazy-lock-pre-idle-frame-modified-tick nil) +(defvar lazy-lock-pre-idle-selected-frame nil) + +(defun lazy-lock-pre-idle-fontify-windows () + ;; Do groovy things always unless we're in one of the ignored commands. + ;; The old version did the following five checks: + ;; + ;; (a) not in a macro, + ;; (b) no input pending, + ;; (c) got a real command (i.e. not an ignored command) + ;; (d) not in the minibuffer + ;; (e) no input after waiting for `lazy-lock-continuity-time'. + ;; + ;; (a), (b), and (e) are automatically taken care of by `pre-idle-hook'. + ;; I removed (d) because there doesn't seem to be any reason for it. + ;; + ;; Also, we do not have to `set-buffer' and in fact it would be + ;; incorrect to do so, since we may be being called from + ;; `accept-process-output' or whatever. + ;; + (if (memq this-command lazy-lock-ignore-commands) (setq lazy-lock-cache-continue nil) (setq lazy-lock-cache-continue t) - (if (lazy-lock-sit-for lazy-lock-continuity-time lazy-lock-hide-invisible) - ;; Do the visible parts of the buffer(s), i.e., the window(s). - (if (or (not lazy-lock-walk-windows) - (and (eq lazy-lock-walk-windows t) (one-window-p t))) - (if lazy-lock-mode (condition-case nil (lazy-lock-fontify-window))) - (lazy-lock-fontify-walk-windows))))) + ;; #### we don't yet handle frame-modified-tick on multiple frames. + ;; handling this shouldn't be hard but I just haven't done it yet. + (if (or (eq 'all-frames lazy-lock-walk-windows) + (not (eq lazy-lock-pre-idle-selected-frame (selected-frame))) + (not (eq lazy-lock-pre-idle-frame-modified-tick + (frame-modified-tick (selected-frame))))) + (progn + ;; Do the visible parts of the buffer(s), i.e., the window(s). + (if (or (not lazy-lock-walk-windows) + (and (eq lazy-lock-walk-windows t) (one-window-p t))) + (if lazy-lock-mode (condition-case nil + (lazy-lock-fontify-window))) + (lazy-lock-fontify-walk-windows)) + (setq lazy-lock-pre-idle-selected-frame (selected-frame)) + (setq lazy-lock-pre-idle-frame-modified-tick + (frame-modified-tick (selected-frame))))))) +(defun lazy-lock-after-change-function (beg end old-len) + (and lazy-lock-mode + (if (= beg end) + (font-lock-after-change-function beg end old-len) + (lazy-lock-put-text-property beg end 'fontified nil)))) + +;; DO NOT put this as a pre-idle hook! The sit-for messes up +;; mouse dragging. (defun lazy-lock-post-command-fontify-stealthily () ;; Do groovy things if (a-d) above, (e) not moving the mouse, and (f) no ;; input after after waiting for `lazy-lock-stealth-time'. @@ -640,48 +699,38 @@ (lazy-lock-fontify-walk-stealthily)) (error (message "Fontifying stealthily... %s" data))))) +;; In XEmacs 19.14 with pre-idle-hook we do not have to call this. (defun lazy-lock-post-resize-fontify-windows (frame) ;; Fontify all windows in FRAME. (let ((lazy-lock-walk-windows t) executing-kbd-macro this-command) (save-excursion (save-selected-window (select-frame frame) - (lazy-lock-post-command-fontify-windows))))) + (lazy-lock-pre-idle-fontify-windows))))) (defun lazy-lock-post-setup-emacs-fontify-windows () ;; Fontify all windows in all frames. (let ((lazy-lock-walk-windows 'all-frames) executing-kbd-macro this-command) - (lazy-lock-post-command-fontify-windows))) + (lazy-lock-pre-idle-fontify-windows))) (defun lazy-lock-post-setup-ediff-control-frame () ;; Fontify all windows in all frames when using the Ediff control frame. (make-local-variable 'lazy-lock-walk-windows) (setq lazy-lock-walk-windows (if (ediff-multiframe-setup-p) 'all-frames t)) - (lazy-lock-post-command-setup)) - -(defun lazy-lock-post-command-setup () - ;; Make sure that we're in the correct positions to avoid hassle. - (remove-hook 'post-command-hook 'lazy-lock-post-command-fontify-windows) - (remove-hook 'post-command-hook 'lazy-lock-post-command-fontify-stealthily) - (add-hook 'post-command-hook 'lazy-lock-post-command-fontify-windows) - (add-hook (if (boundp 'post-command-idle-hook) - 'post-command-idle-hook - 'post-command-hook) - 'lazy-lock-post-command-fontify-stealthily t)) + (lazy-lock-fixup-hooks)) ;; Functions for fontification: (defun lazy-lock-fontify-window () ;; Fontify the visible part of the buffer where necessary. - (let (ws we wh) - ;; Find the bounds of the visible part exactly or conservatively. - (if (not lazy-lock-hide-invisible) - (setq ws (min (max (window-start) (point-min)) (point-max)) - we (min (max (1- (window-end)) (point-min)) (point-max))) - (setq wh (window-height) ; Buggy: (window-displayed-height) - ws (save-excursion (forward-line (- wh)) (point)) - we (save-excursion (forward-line wh) (point)))) - ;; Find whether bounds have changed since previous fontification. + (let ((ws (if lazy-lock-hide-invisible + (save-excursion + (end-of-line) (forward-line (- (window-height))) (point)) + (min (max (window-start) (point-min)) (point-max)))) + (we (if lazy-lock-hide-invisible + (save-excursion + (end-of-line) (forward-line (window-height)) (point)) + (min (max (1- (window-end)) (point-min)) (point-max))))) (if (or (/= ws lazy-lock-cache-start) (/= we lazy-lock-cache-end)) ;; Find where we haven't `fontified' before. (let* ((start (or (text-property-not-all ws we 'fontified t) ws)) @@ -697,8 +746,11 @@ font-lock-verbose) (while (< start end) ;; Fontify and flag the region as `fontified'. - (font-lock-after-change-function start end 0) - (put-text-property start end 'fontified t) + ;; XEmacs: need to bind `font-lock-always-fontify-immediately' + ;; or we'll mess up in the presence of deferred font-locking. + (let ((font-lock-always-fontify-immediately t)) + (font-lock-after-change-function start end 0)) + (lazy-lock-put-text-property start end 'fontified t) ;; Find the next region. (setq start (or (text-property-not-all ws we 'fontified t) ws) end (or (text-property-any start we 'fontified t) we))) @@ -764,8 +816,11 @@ (or (previous-single-property-change prev 'fontified nil (point)) (point))))) ;; Fontify and flag the region as `fontified'. - (font-lock-after-change-function start end 0) - (put-text-property start end 'fontified t) + ;; XEmacs: need to bind `font-lock-always-fontify-immediately' + ;; or we'll mess up in the presence of deferred font-locking. + (let ((font-lock-always-fontify-immediately t)) + (font-lock-after-change-function start end 0)) + (lazy-lock-put-text-property start end 'fontified t) (or modified (set-buffer-modified-p nil))))) (defun lazy-lock-fontify-walk-stealthily () @@ -810,8 +865,8 @@ (setq end (or (text-property-not-all start max 'fontified t) max) size (+ size (- end start)) start end)) - ;; Float because using integer multiplication will frequently overflow. - (truncate (* (/ (float size) (point-max)) 100))))) + ;; Saying "99% done" is probably better than "100% done" when it isn't. + (truncate (/ (* size 100.0) (buffer-size)))))) (defun lazy-lock-colour-invisible () ;; Fontify the current buffer in `lazy-lock-invisible-face'. @@ -829,222 +884,216 @@ (condition-case nil (set-face-foreground face fore) (error (message "Unable to use foreground \"%s\"" fore)))) - (put-text-property (point-min) (point-max) 'face face) - (put-text-property (point-min) (point-max) 'fontified nil) + (lazy-lock-put-text-property (point-min) (point-max) 'face face) + (lazy-lock-put-text-property (point-min) (point-max) 'fontified nil) (or modified (set-buffer-modified-p nil))))) ;; Functions for Emacs: ;; This fix is for a number of bugs in the function in Emacs 19.28. -(when (and (not lazy-lock-running-xemacs) - (= emacs-major-version 19) (< emacs-minor-version 28)) - (defun font-lock-fontify-region (start end &optional loudly) - "Put proper face on each string and comment between START and END." - (save-excursion - (save-restriction - (widen) - (goto-char start) - (beginning-of-line) - (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) - (let ((inhibit-read-only t) (buffer-undo-list t) - buffer-file-name buffer-file-truename - (modified (buffer-modified-p)) - (old-syntax (syntax-table)) - (synstart (if comment-start-skip - (concat "\\s\"\\|" comment-start-skip) - "\\s\"")) - (comstart (if comment-start-skip - (concat "\\s<\\|" comment-start-skip) - "\\s<")) - (startline (point)) - state prev prevstate) - (unwind-protect - (progn - (if font-lock-syntax-table - (set-syntax-table font-lock-syntax-table)) - ;; Find the state at the line-beginning before START. - (if (eq startline font-lock-cache-position) - (setq state font-lock-cache-state) - ;; Find outermost containing sexp. - (beginning-of-defun) - ;; Find the state at STARTLINE. - (while (< (point) startline) - (setq state (parse-partial-sexp (point) startline 0))) - (setq font-lock-cache-state state - font-lock-cache-position (point))) - ;; Now find the state precisely at START. - (setq state (parse-partial-sexp (point) start nil nil state)) - ;; If the region starts inside a string, show the extent of it. - (if (nth 3 state) - (let ((beg (point))) - (while (and (re-search-forward "\\s\"" end 'move) - (nth 3 (parse-partial-sexp beg (point) nil nil - state)))) - (put-text-property beg (point) 'face font-lock-string-face) - (setq state (parse-partial-sexp beg (point) - nil nil state)))) - ;; Likewise for a comment. - (if (or (nth 4 state) (nth 7 state)) - (let ((beg (point))) - (save-restriction - (narrow-to-region (point-min) end) - (condition-case nil - (progn - (re-search-backward comstart (point-min) 'move) - (forward-comment 1) - ;; forward-comment skips all whitespace, - ;; so go back to the real end of the comment. - (skip-chars-backward " \t")) - (error (goto-char end)))) - (put-text-property beg (point) 'face - font-lock-comment-face) - (setq state (parse-partial-sexp beg (point) - nil nil state)))) - ;; Find each interesting place between here and END. - (while (and (< (point) end) - (setq prev (point) prevstate state) - (re-search-forward synstart end t) - (progn - ;; Clear out the fonts of what we skip over. - (remove-text-properties prev (point) '(face nil)) - ;; Verify the state at that place - ;; so we don't get fooled by \" or \;. - (setq state (parse-partial-sexp prev (point) - nil nil state)))) - (let ((here (point))) - (if (or (nth 4 state) (nth 7 state)) - ;; We found a real comment start. - (let ((beg (match-beginning 0))) - (goto-char beg) - (save-restriction - (narrow-to-region (point-min) end) - (condition-case nil - (progn - (forward-comment 1) - ;; forward-comment skips all whitespace, - ;; so go back to the real end of the comment. - (skip-chars-backward " \t")) - (error (goto-char end)))) - (put-text-property beg (point) 'face - font-lock-comment-face) - (setq state (parse-partial-sexp here (point) - nil nil state))) - (if (nth 3 state) +(if (and (not lazy-lock-running-xemacs-p) + (not (emacs-version>= 19 29))) + (defun font-lock-fontify-region (start end &optional loudly) + "Put proper face on each string and comment between START and END." + (save-excursion + (save-restriction + (widen) + (goto-char start) + (beginning-of-line) + (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) + (let ((inhibit-read-only t) (buffer-undo-list t) + buffer-file-name buffer-file-truename + (modified (buffer-modified-p)) + (old-syntax (syntax-table)) + (synstart (if comment-start-skip + (concat "\\s\"\\|" comment-start-skip) + "\\s\"")) + (comstart (if comment-start-skip + (concat "\\s<\\|" comment-start-skip) + "\\s<")) + (startline (point)) + state prev prevstate) + (unwind-protect + (progn + (if font-lock-syntax-table + (set-syntax-table font-lock-syntax-table)) + ;; Find the state at the line-beginning before START. + (if (eq startline font-lock-cache-position) + (setq state font-lock-cache-state) + ;; Find outermost containing sexp. + (beginning-of-defun) + ;; Find the state at STARTLINE. + (while (< (point) startline) + (setq state (parse-partial-sexp (point) startline 0))) + (setq font-lock-cache-state state + font-lock-cache-position (point))) + ;; Now find the state precisely at START. + (setq state (parse-partial-sexp (point) start nil nil state)) + ;; If the region starts inside a string, show the extent of it. + (if (nth 3 state) + (let ((beg (point))) + (while (and (re-search-forward "\\s\"" end 'move) + (nth 3 (parse-partial-sexp beg (point) nil nil + state)))) + (lazy-lock-put-text-property + beg (point) 'face font-lock-string-face) + (setq state (parse-partial-sexp beg (point) + nil nil state)))) + ;; Likewise for a comment. + (if (or (nth 4 state) (nth 7 state)) + (let ((beg (point))) + (save-restriction + (narrow-to-region (point-min) end) + (condition-case nil + (progn + (re-search-backward comstart (point-min) 'move) + (forward-comment 1) + ;; forward-comment skips all whitespace, + ;; so go back to the real end of the comment. + (skip-chars-backward " \t")) + (error (goto-char end)))) + (lazy-lock-put-text-property beg (point) 'face + font-lock-comment-face) + (setq state (parse-partial-sexp beg (point) + nil nil state)))) + ;; Find each interesting place between here and END. + (while (and (< (point) end) + (setq prev (point) prevstate state) + (re-search-forward synstart end t) + (progn + ;; Clear out the fonts of what we skip over. + (remove-text-properties prev (point) '(face nil)) + ;; Verify the state at that place + ;; so we don't get fooled by \" or \;. + (setq state (parse-partial-sexp prev (point) + nil nil state)))) + (let ((here (point))) + (if (or (nth 4 state) (nth 7 state)) + ;; We found a real comment start. (let ((beg (match-beginning 0))) - (while (and (re-search-forward "\\s\"" end 'move) - (nth 3 (parse-partial-sexp - here (point) nil nil state)))) - (put-text-property beg (point) 'face - font-lock-string-face) + (goto-char beg) + (save-restriction + (narrow-to-region (point-min) end) + (condition-case nil + (progn + (forward-comment 1) + ;; forward-comment skips all whitespace, + ;; so go back to the real end of the comment. + (skip-chars-backward " \t")) + (error (goto-char end)))) + (lazy-lock-put-text-property + beg (point) 'face font-lock-comment-face) (setq state (parse-partial-sexp here (point) - nil nil state)))))) - ;; Make sure PREV is non-nil after the loop - ;; only if it was set on the very last iteration. - (setq prev nil))) - (set-syntax-table old-syntax) - (and prev - (remove-text-properties prev end '(face nil))) - (and (buffer-modified-p) - (not modified) - (set-buffer-modified-p nil)))))))) + nil nil state))) + (if (nth 3 state) + (let ((beg (match-beginning 0))) + (while (and (re-search-forward "\\s\"" end 'move) + (nth 3 (parse-partial-sexp + here (point) nil nil state)))) + (lazy-lock-put-text-property + beg (point) 'face font-lock-string-face) + (setq state (parse-partial-sexp here (point) + nil nil state)))))) + ;; Make sure PREV is non-nil after the loop + ;; only if it was set on the very last iteration. + (setq prev nil))) + (set-syntax-table old-syntax) + (and prev + (remove-text-properties prev end '(face nil))) + (and (buffer-modified-p) + (not modified) + (set-buffer-modified-p nil)))))))) ;; Functions for XEmacs: ;; These fix bugs in `text-property-any' and `text-property-not-all'. They may ;; not work perfectly in 19.11 and below because `next-single-property-change' ;; is also broke and not easily fixable in Lisp. -(when (and lazy-lock-running-xemacs - (= emacs-major-version 19) (< emacs-minor-version 12)) - ;; Loop through property changes until found. This fix includes a work - ;; around which prevents a bug in `window-start' causing a barf here. - (defun text-property-any (start end prop value &optional buffer) - "Check text from START to END to see if PROP is ever `eq' to VALUE. +(if (and lazy-lock-running-xemacs-p + (not (emacs-version>= 19 12))) + (progn + ;; Loop through property changes until found. This fix includes a work + ;; around which prevents a bug in `window-start' causing a barf here. + (defun text-property-any (start end prop value &optional buffer) + "Check text from START to END to see if PROP is ever `eq' to VALUE. If so, return the position of the first character whose PROP is `eq' to VALUE. Otherwise return nil." - (let ((start (min start end)) (end (max start end))) - (while (and start (not (eq (get-text-property start prop buffer) value))) - (setq start (next-single-property-change start prop buffer end))) - start)) - ;; No need to loop here; if it's not at START it's at the next change. - ;; However, `next-single-property-change' sometimes returns LIMIT, or - ;; `point-max', if no change is found and sometimes returns nil. - (defun text-property-not-all (start end prop value &optional buffer) - "Check text from START to END to see if PROP is ever not `eq' to VALUE. + (let ((start (min start end)) (end (max start end))) + (while (and start (not (eq (get-text-property start prop buffer) value))) + (setq start (next-single-property-change start prop buffer end))) + start)) + ;; No need to loop here; if it's not at START it's at the next change. + ;; However, `next-single-property-change' sometimes returns LIMIT, or + ;; `point-max', if no change is found and sometimes returns nil. + (defun text-property-not-all (start end prop value &optional buffer) + "Check text from START to END to see if PROP is ever not `eq' to VALUE. If so, return the position of the first character whose PROP is not `eq' to VALUE. Otherwise, return nil." - (if (not (eq value (get-text-property start prop buffer))) - start - (let ((next (next-single-property-change start prop buffer end)) - (end (or end (save-excursion (and buffer (set-buffer buffer)) - (point-max))))) - (and next (< next end) next))))) + (if (not (eq value (get-text-property start prop buffer))) + start + (let ((next (next-single-property-change start prop buffer end)) + (end (or end (save-excursion (and buffer (set-buffer buffer)) + (point-max))))) + (and next (< next end) next)))))) ;; XEmacs 19.11 function `font-lock-any-extents-p' looks for `text-prop' rather ;; than `face'. Since `font-lock-unfontify-region' only removes `face', and we ;; have non-font-lock properties hanging about, `text-prop' never gets removed. ;; Unfortunately `font-lock-any-extents-p' is inlined so we can't redefine it. -(when (and lazy-lock-running-xemacs - (= emacs-major-version 19) (< emacs-minor-version 12)) - (add-hook 'font-lock-mode-hook - (function (lambda () - (remove-hook 'after-change-functions 'font-lock-after-change-function) - (add-hook 'after-change-functions - (function (lambda (beg end old-len) - (let ((a-c-beg beg) (a-c-end end)) - (save-excursion - ;; First set `text-prop' to nil for `font-lock-any-extents-p'. - (goto-char end) (forward-line 1) (setq end (point)) - (goto-char beg) (beginning-of-line) (setq beg (point)) - (put-text-property beg end 'text-prop nil) - ;; Then do the real `font-lock-after-change-function'. - (font-lock-after-change-function a-c-beg a-c-end old-len) - ;; Now set `fontified' to t to stop `lazy-lock-fontify-window'. - (put-text-property beg end 'fontified t)))))))))) +(if (and lazy-lock-running-xemacs-p + (not (emacs-version>= 19 12))) + (add-hook 'font-lock-mode-hook + (function (lambda () + (remove-hook 'after-change-functions 'font-lock-after-change-function) + (add-hook 'after-change-functions + (function (lambda (beg end old-len) + (let ((a-c-beg beg) (a-c-end end)) + (save-excursion + ;; First set `text-prop' to nil for `font-lock-any-extents-p'. + (goto-char end) (forward-line 1) (setq end (point)) + (goto-char beg) (beginning-of-line) (setq beg (point)) + (lazy-lock-put-text-property beg end 'text-prop nil) + ;; Then do the real `font-lock-after-change-function'. + (font-lock-after-change-function a-c-beg a-c-end old-len) + ;; Now set `fontified' to t to stop `lazy-lock-fontify-window'. + (lazy-lock-put-text-property beg end 'fontified t)))))))))) -;; XEmacs 19.12 font-lock.el's `font-lock-fontify-buffer' runs a hook. -(when lazy-lock-running-xemacs - (add-hook 'font-lock-after-fontify-buffer-hook - 'lazy-lock-after-fontify-buffer)) +(if (and lazy-lock-running-xemacs-p (emacs-version>= 19 12)) + ;; XEmacs 19.12 font-lock.el's `font-lock-fontify-buffer' runs a hook. + (add-hook 'font-lock-after-fontify-buffer-hook + 'lazy-lock-after-fontify-buffer)) -;; Cope with the differences between Emacs and earlier [LX]Emacs. -(unless (fboundp 'frame-parameters) - (defalias 'frame-parameters 'screen-parameters)) - -;; Cope with the differences between Emacs and earlier [LX]Emacs. Buggy. -;(unless (fboundp 'window-displayed-height) -; (defalias 'window-displayed-height 'window-height)) +;; Cope with the differences between Emacs and [LX]Emacs. +(or (fboundp 'frame-parameters) + (defalias 'frame-parameters 'screen-parameters)) ;; Install ourselves: ;; We don't install ourselves on `font-lock-mode-hook' as other packages can be ;; used with font-lock.el, and lazy-lock.el should be dumpable without forcing ;; people to get lazy or making it difficult for people to use alternatives. - -;; After a command is run. -(lazy-lock-post-command-setup) - -;; After some relevant event. +;; make sure we add after font-lock's own pre-idle-hook. (add-hook 'window-setup-hook 'lazy-lock-post-setup-emacs-fontify-windows) -(add-hook 'window-size-change-functions 'lazy-lock-post-resize-fontify-windows) +;Not needed in XEmacs 19.14: +;(add-hook 'window-size-change-functions 'lazy-lock-post-resize-fontify-windows) ;; Package-specific. -(add-hook 'ediff-after-setup-control-frame-hooks ; Emacs 19.29, Ediff 2.26. - 'lazy-lock-post-setup-ediff-control-frame) -(add-hook 'ediff-after-setup-control-frame-hook ; Emacs 19.30, Ediff 2.47. +(add-hook 'ediff-after-setup-control-frame-hooks 'lazy-lock-post-setup-ediff-control-frame) ;; Might as well uninstall too. Package-local symbols would be nice... -(when (fboundp 'unintern) - (unintern 'lazy-lock-running-xemacs) - (unintern 'lazy-lock-sit-for)) +(and (fboundp 'unintern) (unintern 'lazy-lock-running-xemacs-p)) +(and (fboundp 'unintern) (unintern 'lazy-lock-sit-for)) +;; Maybe save on the modeline? +;;(setcdr (assq 'font-lock-mode minor-mode-alist) '(" Lazy")) + +;(or (assq 'lazy-lock-mode minor-mode-alist) +; (setq minor-mode-alist (cons '(lazy-lock-mode " Lazy") minor-mode-alist))) + +;; XEmacs change: do it the right way. This works with modeline mousing. ;;;###autoload -(when (fboundp 'add-minor-mode) - (defvar lazy-lock-mode nil) - (add-minor-mode 'lazy-lock-mode nil)) -;;;###dont-autoload -(unless (assq 'lazy-lock-mode minor-mode-alist) - (setq minor-mode-alist (append minor-mode-alist '((lazy-lock-mode nil))))) +(add-minor-mode 'lazy-lock-mode " Lazy") ;; Provide ourselves:
--- a/lisp/packages/time.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/packages/time.el Mon Aug 13 09:44:42 2007 +0200 @@ -24,7 +24,7 @@ ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. -;;; Version: 1.15 (I choose the version number starting at 1.1 +;;; Version: 1.17 (I choose the version number starting at 1.1 ;;; to indicate that 1.0 was the old version ;;; before I hacked away on it -jtl) @@ -56,12 +56,22 @@ ;;; Code: (require 'itimer) +;;; Not sure for now... +;;;(require 'balloon-help) (defconst display-time-version-number "1.15" "Version number of time.el") (defconst display-time-version (format "Time.el version %s for XEmacs" display-time-version-number) "The full version string for time.el") +;;; Doesn't work by now.... +;;;(defvar display-time-keymap nil) +;;; +;;;(if display-time-keymap () +;;; (setq display-time-keymap (make-sparse-keymap)) +;;; (suppress-keymap display-time-keymap) +;;; (define-key display-time-keymap 'button1 'balloon-help)) + ;; We need the progn to kill off the defgroup-tracking mechanism. ;; This package changes the state of XEmacs by loading it, which is ;; why it's potentially dangerous. @@ -493,11 +503,15 @@ (make-glyph (concat display-time-icons-dir "letter.xpm")))) (set-extent-property (car display-time-mail-sign) 'balloon-help 'display-time-mail-balloon) +;;; (set-extent-keymap (car display-time-mail-sign) +;;; display-time-keymap) (defvar display-time-no-mail-sign (cons (make-extent nil nil) (make-glyph (concat display-time-icons-dir "no-letter.xpm")))) (set-extent-property (car display-time-no-mail-sign) 'balloon-help display-time-no-mail-balloon) +;;; (set-extent-keymap (car display-time-no-mail-sign) +;;; display-time-keymap) (defvar display-time-1-glyph nil) (defvar display-time-2-glyph nil) (defvar display-time-3-glyph nil) @@ -553,6 +567,7 @@ (char-to-string elem) "-glyph")))) (set-extent-property (car elem) 'balloon-help balloon-help) +;;; (set-extent-keymap (car elem) display-time-keymap) (push elem tmp)) (reverse tmp)))) @@ -976,6 +991,7 @@ (defun display-time-function () (let* ((now (current-time)) + (nowhigh (* (- (nth 0 now) (* (/ (nth 0 now) 10) 10)) 65536)) (time (current-time-string now)) (load (condition-case () (if (zerop (car (load-average))) "" @@ -989,17 +1005,21 @@ (mail (and (stringp mail-spool-file) (or (null display-time-server-down-time) ;; If have been down for 20 min, try again. - (> (- (nth 1 (current-time)) + (> (- (+ (nth 1 now) nowhigh) display-time-server-down-time) 1200)) (let ((start-time (current-time))) (prog1 (display-time-file-nonempty-p mail-spool-file) - (if (> (- (nth 1 (current-time)) (nth 1 start-time)) + (setq now (current-time) + nowhigh (* (- (nth 0 now) (* (/ (nth 0 now) 10) 10)) 65536)) + (if (> (- (+ (nth 1 now) nowhigh) + (+ (nth 1 start-time) + (* (- (nth 0 start-time) (* (/ (nth 0 start-time) 10) 10)) 65536))) 20) ;; Record that mail file is not accessible. (setq display-time-server-down-time - (nth 1 (current-time))) + (+ (nth 1 now) nowhigh)) ;; Record that mail file is accessible. (setq display-time-server-down-time nil)))))) (24-hours (substring time 11 13))
--- a/lisp/pcl-cvs/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/pcl-cvs/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/prim/about.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/prim/about.el Mon Aug 13 09:44:42 2007 +0200 @@ -3,7 +3,7 @@ ;; Copyright (c) 1997 Free Software Foundation, Inc. ;; Keywords: extensions -;; Version: 2.2 +;; Version: 2.3 ;; Maintainer: Hrvoje Niksic <hniksic@srce.hr> ;; This file is part of XEmacs. @@ -849,7 +849,7 @@ (let* ((entry (assq who xemacs-hackers)) (name (cadr entry)) (address (caddr entry))) - (let ((widget-link-prefix nil) (widget-link-suffix nil)) + (let ((widget-link-prefix "") (widget-link-suffix "")) (widget-create 'link :help-echo (concat "Find out more about " name) :action 'about-maintainer :tag name
--- a/lisp/prim/auto-autoloads.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/prim/auto-autoloads.el Mon Aug 13 09:44:42 2007 +0200 @@ -223,13 +223,17 @@ ;;;*** -;;;### (autoloads (pretty-print-profiling-info) "profile" "prim/profile.el") +;;;### (autoloads (profile pretty-print-profiling-info) "profile" "prim/profile.el") (autoload 'pretty-print-profiling-info "profile" "\ Print profiling info INFO to standard output in a pretty format. If INFO is omitted, the current profiling info is retrieved using `get-profiling-info'." nil nil) +(autoload 'profile "profile" "\ +Turn on profiling, execute FORMS and stop profiling. +Returns the profiling info, printable by `pretty-print-profiling-info'." nil 'macro) + ;;;*** ;;;### (autoloads (clear-rectangle string-rectangle open-rectangle insert-rectangle yank-rectangle kill-rectangle extract-rectangle delete-extract-rectangle delete-rectangle) "rect" "prim/rect.el")
--- a/lisp/prim/cmdloop.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/prim/cmdloop.el Mon Aug 13 09:44:42 2007 +0200 @@ -58,10 +58,11 @@ If this character is typed while lisp code is executing, it will be treated as an interrupt. If this character is typed at top-level, this simply beeps. -If `zmacs-regions' is true, and the zmacs region is active, then this - key deactivates the region without beeping or signalling." +If `zmacs-regions' is true, and the zmacs region is active in this buffer, +then this key deactivates the region without beeping or signalling." (interactive) - (if (and zmacs-regions (zmacs-deactivate-region)) + (if (and (region-active-p) + (eq (current-buffer) (zmacs-region-buffer))) ;; pseudo-zmacs compatibility: don't beep if this ^G is simply ;; deactivating the region. If it is inactive, beep. nil @@ -104,7 +105,7 @@ (setq standard-output t) (setq standard-input t) (setq executing-kbd-macro nil) - (zmacs-deactivate-region) +; (zmacs-deactivate-region) (discard-input) (setq last-error error-object) @@ -222,18 +223,22 @@ )) -(defvar teach-extended-commands-p t +(defcustom teach-extended-commands-p t "*If true, then `\\[execute-extended-command]' will teach you keybindings. Any time you execute a command with \\[execute-extended-command] which has a shorter keybinding, you will be shown the alternate binding before the command executes. There is a short pause after displaying the binding, before executing it; the length can be controlled by -`teach-extended-commands-timeout'.") +`teach-extended-commands-timeout'." + :type 'boolean + :group 'keyboard) -(defvar teach-extended-commands-timeout 2 +(defcustom teach-extended-commands-timeout 4 "*How long to pause after displaying a keybinding before executing. The value is measured in seconds. This only applies if -`teach-extended-commands-p' is true.") +`teach-extended-commands-p' is true." + :type 'number + :group 'keyboard) ;That damn RMS went off and implemented something differently, after ;we had already implemented it. We can't support both properly until @@ -276,20 +281,31 @@ (t "M-x "))))) - (if (and teach-extended-commands-p (interactive-p)) - (let ((keys (where-is-internal this-command))) - (if keys - (progn - (message "M-x %s (bound to key%s: %s)" - this-command - (if (cdr keys) "s" "") - (mapconcat 'key-description - (sort keys #'(lambda (x y) - (< (length x) (length y)))) - ", ")) - (sit-for teach-extended-commands-timeout))))) - - (command-execute this-command t)) + (if (and teach-extended-commands-p + (interactive-p)) + ;; We need to fiddle with keys: remember the keys, run the + ;; command, and show the keys (if any). + (let ((_execute_command_keys_ (where-is-internal this-command)) + (_execute_command_name_ this-command)) ; the name can change + (command-execute this-command t) + (when (and _execute_command_keys_ + ;; Wait for a while, so the user can see a message + ;; printed, if any. + (sit-for 1)) + (display-message + 'no-log + (format "Command `%s' is bound to key%s: %s" + _execute_command_name_ + (if (cdr _execute_command_keys_) "s" "") + (mapconcat 'key-description + (sort _execute_command_keys_ + #'(lambda (x y) + (< (length x) (length y)))) + ", "))) + (sit-for teach-extended-commands-timeout) + (clear-message 'no-log))) + ;; Else, just run the command. + (command-execute this-command t))) ;;; C code calls this; the underscores in the variable names are to avoid
--- a/lisp/prim/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/prim/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -24,7 +24,7 @@ (put 'paren-matching 'custom-loads '()) (put 'help 'custom-loads '("help")) (put 'local 'custom-loads '()) -(put 'keyboard 'custom-loads '()) +(put 'keyboard 'custom-loads '("cmdloop")) (put 'minubuffer 'custom-loads '("minibuf")) (put 'message-sending 'custom-loads '()) (put 'data 'custom-loads '("files")) @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '("files")) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '("isearch-mode"))
--- a/lisp/prim/dumped-lisp.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/prim/dumped-lisp.el Mon Aug 13 09:44:42 2007 +0200 @@ -126,11 +126,11 @@ ;; Now load files to set up all the different languages/environments ;; that Mule knows about. -#+mule "arabic-hooks" +#+mule "language/arabic" #+mule "language/chinese" #+mule "language/cyrillic" #+mule "language/english" -#+mule "ethiopic-hooks" +#+mule "language/ethiopic" #+mule "language/european" #+mule "language/greek" #+mule "hebrew-hooks" @@ -176,6 +176,8 @@ ;;; formerly in sunpro/sunpro-load.el #+sparcworks "cc-mode" #+sparcworks "sunpro-init" +#+sparcworks "ring" +#+sparcworks "comint" #+sparcworks "annotations" ;;; formerly in eos/sun-eos-load.el #+sparcworks "sun-eos-init"
--- a/lisp/prim/files.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/prim/files.el Mon Aug 13 09:44:42 2007 +0200 @@ -1221,6 +1221,8 @@ ("[Mm]akefile\\(\\.\\|\\'\\)" . makefile-mode) ("\\.X\\(defaults\\|environment\\|resources\\|modmap\\)\\'" . xrdb-mode) ("/app-defaults/" . xrdb-mode) + ("\\.[^/]*wm\\'" . winmgr-mode) + ("\\.[^/]*wm2?rc" . winmgr-mode) ) "Alist of filename patterns vs. corresponding major mode functions. Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
--- a/lisp/prim/help.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/prim/help.el Mon Aug 13 09:44:42 2007 +0200 @@ -188,16 +188,17 @@ (define-key help-mode-map 'delete 'scroll-down) (defun help-mode-quit () - "Exits from help mode, possibly restoring the previous window configuration." + "Exits from help mode, possibly restoring the previous window configuration. +Bury the help buffer to the end of the buffer list." (interactive) - (cond ((frame-property (selected-frame) 'help-window-config) + (let ((buf (current-buffer))) + (cond ((frame-property (selected-frame) 'help-window-config) (set-window-configuration (frame-property (selected-frame) 'help-window-config)) (set-frame-property (selected-frame) 'help-window-config nil)) - ((one-window-p) - (bury-buffer)) - (t - (delete-window)))) + ((not (one-window-p)) + (delete-window))) + (bury-buffer buf))) (defun help-quit () (interactive)
--- a/lisp/prim/make-docfile.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/prim/make-docfile.el Mon Aug 13 09:44:42 2007 +0200 @@ -128,7 +128,7 @@ ;; (print (prin1-to-string (append options processed))) -(print "Spawning make-docfile ...") +(princ "Spawning make-docfile ...") ;; (print (prin1-to-string (append options processed))) (setq exec-path (list (concat default-directory "../lib-src"))) @@ -142,6 +142,7 @@ nil (append options processed)) +(princ "Spawning make-docfile ...done\n") ;; (write-region-internal (point-min) (point-max) "/tmp/DOC") (kill-emacs)
--- a/lisp/prim/minibuf.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/prim/minibuf.el Mon Aug 13 09:44:42 2007 +0200 @@ -230,10 +230,11 @@ (defun minibuffer-keyboard-quit () "Abort recursive edit. -If `zmacs-regions' is true, and the zmacs region is active, then this -key deactivates the region without beeping." +If `zmacs-regions' is true, and the zmacs region is active in this buffer, +then this key deactivates the region without beeping." (interactive) - (if (and zmacs-regions (zmacs-deactivate-region)) + (if (and (region-active-p) + (eq (current-buffer) (zmacs-region-buffer))) ;; pseudo-zmacs compatibility: don't beep if this ^G is simply ;; deactivating the region. If it is inactive, beep. nil
--- a/lisp/prim/profile.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/prim/profile.el Mon Aug 13 09:44:42 2007 +0200 @@ -38,15 +38,27 @@ (setq info (nreverse (sort info #'cdr-less-than-cdr))) (princ "Function Count %\n") (princ "---------------------------------------------------------------------\n") - (let ((sum 0.0) - (info2 info)) - (while info2 - (setq sum (+ sum (cdar info2))) - (setq info2 (cdr info2))) + (let ((sum 0.0)) + (dolist (info2 info) + (incf sum (cdr info2))) (while info (let ((f (caar info))) (princ (format "%-50s%10d %6.3f\n" f (cdar info) (* 100 (/ (cdar info) sum))))) (setq info (cdr info))))) +;;;###autoload +(defmacro profile (&rest forms) + "Turn on profiling, execute FORMS and stop profiling. +Returns the profiling info, printable by `pretty-print-profiling-info'." + `(progn + (unwind-protect + (progn + (start-profiling) + ,@forms) + (stop-profiling)) + (get-profiling-info))) + +(put 'profile 'lisp-indent-function 0) + ;;; profile.el ends here
--- a/lisp/prim/simple.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/prim/simple.el Mon Aug 13 09:44:42 2007 +0200 @@ -1168,7 +1168,7 @@ ;; just isn't aware of this. However, there's no harm in putting ;; the region's text in the kill ring, anyway. ((or (and buffer-read-only (not inhibit-read-only)) - (text-property-not-all beg end 'read-only nil)) + (text-property-not-all (min beg end) (max beg end) 'read-only nil)) ;; This is redundant. ;; (if verbose (message "Copying %d characters" ;; (- (max beg end) (min beg end)))) @@ -1195,11 +1195,13 @@ ;; Search back in buffer-undo-list for this string, ;; in case a change hook made property changes. (setq tail buffer-undo-list) - (while (not (stringp (car-safe (car-safe tail)))) ; XEmacs - (setq tail (cdr tail))) + (while (and tail + (not (stringp (car-safe (car-safe tail))))) ; XEmacs + (pop tail)) ;; Take the same string recorded for undo ;; and put it in the kill-ring. - (kill-new (car (car tail))))) + (and tail + (kill-new (car (car tail)))))) (t ;; if undo is not kept, grab the string then delete it (which won't
--- a/lisp/prim/subr.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/prim/subr.el Mon Aug 13 09:44:42 2007 +0200 @@ -532,13 +532,8 @@ (interactive) nil) -(defmacro eval-in-buffer (buffer &rest forms) - "Evaluate FORMS in BUFFER. -See also: `save-current-buffer' and `save-excursion'." - ;; by Stig@hackvan.com - (` (save-current-buffer - (set-buffer (, buffer)) - (,@ forms)))) +(define-function 'eval-in-buffer 'with-current-buffer) +(make-obsolete 'eval-in-buffer 'with-current-buffer) ;;; The real defn is in abbrev.el but some early callers ;;; (eg lisp-mode-abbrev-table) want this before abbrev.el is loaded...
--- a/lisp/psgml/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/psgml/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -61,7 +61,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'psgml-insert 'custom-loads '("psgml")) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '())
--- a/lisp/rmail/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/rmail/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/sunpro/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/sunpro/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/term/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/term/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/term/sun-mouse.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/term/sun-mouse.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,44 +1,47 @@ ;;; sun-mouse.el --- mouse handling for Sun windows -;; Copyright (C) 1987 Free Software Foundation, Inc. +;; Copyright (C) 1987, 1997 Free Software Foundation, Inc. ;; Author: Jeff Peck ;; Maintainer: FSF ;; Keywords: hardware -;; This file is part of GNU Emacs. +;; This file is part of XEmacs. -;; 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 +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. -;; 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. +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Unknown ;;; Commentary: -;;; Jeff Peck, Sun Microsystems, Jan 1987. -;;; Original idea by Stan Jefferson +;; Jeff Peck, Sun Microsystems, Jan 1987. +;; Original idea by Stan Jefferson -;;; -;;; Modelled after the GNUEMACS keymap interface. -;;; -;;; User Functions: -;;; make-mousemap, copy-mousemap, -;;; define-mouse, global-set-mouse, local-set-mouse, -;;; use-global-mousemap, use-local-mousemap, -;;; mouse-lookup, describe-mouse-bindings -;;; -;;; Options: -;;; extra-click-wait, scrollbar-width -;;; +;; +;; Modelled after the GNUEMACS keymap interface. +;; +;; User Functions: +;; make-mousemap, copy-mousemap, +;; define-mouse, global-set-mouse, local-set-mouse, +;; use-global-mousemap, use-local-mousemap, +;; mouse-lookup, describe-mouse-bindings +;; +;; Options: +;; extra-click-wait, scrollbar-width +;; ;;; Code: @@ -164,18 +167,6 @@ (defmacro sm::loc-x (loc) (list 'nth 1 loc)) (defmacro sm::loc-y (loc) (list 'nth 2 loc)) -(defmacro eval-in-buffer (buffer &rest forms) - "Macro to switches to BUFFER, evaluates FORMS, returns to original buffer." - ;; When you don't need the complete window context of eval-in-window - (` (let ((StartBuffer (current-buffer))) - (unwind-protect - (progn - (set-buffer (, buffer)) - (,@ forms)) - (set-buffer StartBuffer))))) - -(put 'eval-in-buffer 'lisp-indent-function 1) - ;;; this is used extensively by sun-fns.el ;;; (defmacro eval-in-window (window &rest forms) @@ -247,7 +238,7 @@ (*mouse-x* (sm::loc-x loc)) (*mouse-y* (sm::loc-y loc)) (mouse-code (mouse-event-code hit loc))) - (let ((form (eval-in-buffer (window-buffer *mouse-window*) + (let ((form (with-current-buffer (window-buffer *mouse-window*) (mouse-lookup mouse-code)))) (cond ((null form) (if (not (sm::hit-up-p hit)) ; undefined up hits are ok.
--- a/lisp/tl/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/tl/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/tm/auto-autoloads.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/tm/auto-autoloads.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,6 +1,9 @@ ;;; DO NOT MODIFY THIS FILE (if (not (featurep 'tm-autoloads)) (progn + +(provide 'tm-autoloads) +)) ;;;### (autoloads (mime/editor-mode) "tm-edit" "tm/tm-edit.el") @@ -144,6 +147,3 @@ (defalias 'edit-mime 'mime/editor-mode) ;;;*** - -(provide 'tm-autoloads) -))
--- a/lisp/tm/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/tm/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/tooltalk/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/tooltalk/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/utils/autoload.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/utils/autoload.el Mon Aug 13 09:44:42 2007 +0200 @@ -319,11 +319,13 @@ (while (< (point) output-end) (let ((beg (point))) (end-of-line) - (if (> (- (point) beg) 900) - (progn - (message "A line is too long--over 900 characters") - (sleep-for 2) - (goto-char output-end)))) + ;; Emacs -- I still haven't figured this one out. + ;; (if (> (- (point) beg) 900) + ;; (progn + ;; (message "A line is too long--over 900 characters") + ;; (sleep-for 2) + ;; (goto-char output-end))) + ) (forward-line 1)) (goto-char output-end) (insert generate-autoload-section-trailer)))
--- a/lisp/utils/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/utils/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -68,7 +68,6 @@ (put 'news 'custom-loads '("highlight-headers")) (put 'highlight-headers 'custom-loads '("highlight-headers")) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'savehist 'custom-loads '("savehist")) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '())
--- a/lisp/utils/lib-complete.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/utils/lib-complete.el Mon Aug 13 09:44:42 2007 +0200 @@ -36,7 +36,7 @@ ;; Last Modified By: Heiko M|nkel <muenkel@tnt.uni-hannover.de> ;; Additional XEmacs integration By: Chuck Thompson <cthomp@cs.uiuc.edu> ;; Last Modified On: Thu Jul 1 14:23:00 1994 -;; RCS Info : $Revision: 1.4 $ $Locker: $ +;; RCS Info : $Revision: 1.5 $ $Locker: $ ;; ======================================================================== ;; NOTE: XEmacs must be redumped if this file is changed. ;; @@ -121,8 +121,10 @@ (message "%s" (, MESSAGE)) (progn (,@ FORMS)) (message ""))))) +#+infodock (defalias 'lib-funcall-with-msg 'progn-with-message) (put 'progn-with-message 'lisp-indent-hook 1) +#+infodock (put 'lib-funcall-with-message 'lisp-indent-hook 1) ;;=== Completion caching ================================================== @@ -136,6 +138,7 @@ where each <cache-record> has the form (<root> <modtimes> <completion-table>)") +#+infodock (defvaralias 'lib-completions 'lib-complete:cache) (defun lib-complete:better-root (ROOT1 ROOT2) "Return non-nil if ROOT1 is a superset of ROOT2." @@ -190,7 +193,7 @@ path-modtimes completion-table) completion-table)))) -(defvar lib-complete:max-cache-size 20 +(defvar lib-complete:max-cache-size 40 "*Maximum number of search paths which are cached.") (defun lib-complete:cache-completions (key root modtimes table) @@ -315,6 +318,7 @@ (if current-prefix-arg (read-coding-system "Coding System: ")))) (find-file-other-window library codesys)) +#+infodock (defalias 'lib-edit-other-window 'find-library-other-window) (defun find-library-other-frame (library &optional codesys) "Load the library named LIBRARY in a newly-created frame. @@ -332,7 +336,8 @@ (define-key global-map "\C-x4l" 'find-library-other-window) (define-key global-map "\C-x5l" 'find-library-other-frame) +#+infodock (defalias 'lib-where-is 'locate-library) +#+infodock (provide 'lib) (provide 'lib-complete) - ;;; lib-complete.el ends here
--- a/lisp/utils/live-icon.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/utils/live-icon.el Mon Aug 13 09:44:42 2007 +0200 @@ -125,9 +125,10 @@ (defun live-icon-one-frame (&optional frame) "Gives FRAME (defaulting to (selected-frame)) a live icon." (interactive) - (if (not frame) - (setq frame (selected-frame))) - (set-glyph-image frame-icon-glyph (live-icon-from-frame frame) frame)) + (unless frame + (setq frame (selected-frame))) + (unless (frame-property frame 'balloon-help) + (set-glyph-image frame-icon-glyph (live-icon-from-frame frame) frame))) ;;(defun live-icon-all-frames () ;; "Gives all your frames live-icons." @@ -138,7 +139,7 @@ ;; fr)) ;; (frame-list))) -(add-hook 'unmap-screen-hook 'live-icon-one-frame) +(add-hook 'unmap-frame-hook 'live-icon-one-frame) ;;(start-itimer "live-icon" 'live-icon-all-frames 120 120) (provide 'live-icon)
--- a/lisp/utils/ph.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/utils/ph.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,11 +1,11 @@ ;;; ph.el --- Client for the CCSO directory system (aka PH/QI) -;; Copyright (C) 1997 Oscar Figueiredo +;; Copyright (C) 1997 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> ;; Created: May 1997 -;; Version: $Revision: 1.2 $ +;; Version: 2.1 ;; Keywords: help ;; This file is part of XEmacs @@ -21,26 +21,21 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to +;; along with XEmacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: - -;; LCD Archive Entry (not registered yet): -;; ph|Oscar Figueiredo|Oscar.Figueiredo@di.epfl.ch| -;; Client for the CCSO directory system (aka PH/QI)| -;; 27-May-1997|Version $Revision: 1.2 $|ftp://(Not Available) - -;; This package provides functions to query CCSO nameservers through an -;; interactive form or replace inline query strings in buffers with -;; appropriately formatted query results (especially used to expand email -;; addresses in message buffers). It also interfaces with the BBDB package -;; to let you register entries of the CCSO directory into your own database. -;; The CCSO white pages system was developped at UIUC and is in use in more +;; This package provides functions to query CCSO PH/QI nameservers +;; through an interactive form or replace inline query strings in +;; buffers with appropriately formatted query results (especially +;; used to expand email addresses in message buffers). It also +;; interfaces with the BBDB package to let you register entries of +;; the CCSO PH/QI directory into your own database. The CCSO PH/QI +;; white pages system was developped at UIUC and is in use in more ;; than 300 sites in the world. The distribution can be found at -;; ftp://uiarchive.cso.uiuc.edu/pub/packages/ph -;; Traditionally the server is called QI while the client is called PH. +;; ftp://uiarchive.cso.uiuc.edu/pub/packages/ph Traditionally the +;; server is called QI while the client is called PH. ;;; Installation: ;; This package uses the custom and widget libraries. If they are not already @@ -48,21 +43,19 @@ ;; Then uncomment and add the following to your .emacs file: ;; (require 'ph) ;; (eval-after-load "message" -;; (define-key message-mode-map [(control ?c) (tab)] 'ph-expand-inline)) +;; '(define-key message-mode-map [(control ?c) (tab)] 'ph-expand-inline)) ;; (eval-after-load "mail" -;; (define-key mail-mode-map [(control ?c) (tab)] 'ph-expand-inline)) - -;; This package should run under XEmacs 19.15 or 20 as well as under Emacs 19.34 and above +;; '(define-key mail-mode-map [(control ?c) (tab)] 'ph-expand-inline)) ;;; Usage: -;; * Provided you did the installation as proposed in the above section, +;; - Provided you did the installation as proposed in the above section, ;; inline expansion will be available when you compose an email ;; message. Type the name of somebody recorded in your PH/QI server and hit ;; C-c TAB, this will overwrite the name with the corresponding email ;; address -;; * M-x ph-customize to customize inline expansion and other features to +;; - M-x ph-customize to customize inline expansion and other features to ;; your needs. -;; * Look for the Ph submenu in the tools menu for more. +;; - Look for the Ph submenu in the Tools menu for more. ;;; Code: @@ -73,7 +66,10 @@ (require 'overlay)) (if (locate-library "timer") (require 'timer)) + (autoload 'custom-menu-create "cus-edit") +(autoload 'bbdb-create-internal "bbdb-com") +(autoload 'bbdb-display-records "bbdb") ;;{{{ Package customization variables @@ -116,7 +112,7 @@ (const :menu-tag "None" nil)) :group 'ph) -(defcustom ph-duplicate-fields-handling-method 'list +(defcustom ph-duplicate-fields-handling-method '((email . duplicate)) "*A method to handle entries containing duplicate fields. This is either an alist (FIELD . METHOD) or a symbol METHOD. The alist form of the variable associates a method to an individual field, @@ -170,26 +166,26 @@ (symbol :tag ""))) :group 'ph) -(defcustom ph-form-fields '(name firstname email phone) +(defcustom ph-form-fields '(name email phone) "*A list of fields presented in the query form." :tag "Default Fields in Query Forms" :type '(repeat (symbol :tag "Field name")) :group 'ph) (defcustom ph-fieldname-formstring-alist '((url . "URL") - (unix_gid . "Unix GID") - (unix_uid . "Unix UID") - (unit_code . "Unit Code") - (department_code . "Department Code") - (high_school . "High School") - (home_phone . "Home Phone") - (office_phone . "Office Phone") - (callsign . "HAM Call Sign") - (office_address . "Office Address") - (office_location . "Office Location") - (id . "ID") - (email . "E-Mail") - (firstname . "First Name")) + (unix_gid . "Unix GID") + (unix_uid . "Unix UID") + (unit_code . "Unit Code") + (department_code . "Department Code") + (high_school . "High School") + (home_phone . "Home Phone") + (office_phone . "Office Phone") + (callsign . "HAM Call Sign") + (office_address . "Office Address") + (office_location . "Office Location") + (id . "ID") + (email . "E-Mail") + (firstname . "First Name")) "*A mapping of CCSO database field names onto prompt strings used in query/response forms. Prompt strings for fields that are not in this are derived by capitalizing the field name." @@ -199,13 +195,31 @@ (string :tag "Prompt string"))) :group 'ph) -(defcustom ph-bbdb-mapping-alist '((name . (firstname name)) - (email . net)) - "*A mapping of CCSO database field names onto BBDB field names" - :tag "CCSO to BBDB Field Name Mapping" +(defcustom ph-bbdb-conversion-alist '((name . name) + (net . email) + (address . (ph-bbdbify-address address "Address")) + (phone . ((ph-bbdbify-phone phone "Phone") + (ph-bbdbify-phone office_phone "Office Phone")))) + "*A mapping from BBDB to PH/QI fields. +This is a list of cons cells (BBDB-FIELD . SPEC-OR-LIST) where BBDB-FIELD +is the name of a field that must be defined in your BBDB (standard field +names are `name', `company', `net', `phone', `address' and `notes'). +SPEC-OR-LIST is either a single SPEC or a list of SPECs. Lists of specs are +valid only for the `phone' and `address' BBDB fields. +SPECs are sexps which are evaluated: + -a string evaluates to itself + -a symbol evaluates to the symbol value. Symbols naming PH/QI fields + present in the record evaluate to the value of the field in the record + -a form is evaluated as a function. The argument list may contain PH/QI + field names which eval to the corresponding values in the record. The form + evaluation should return something appropriate for the particular + BBDB-FIELD (see bbdb-create-internal). ph-bbdbify-phone and + ph-bbdbify-address are provided as convenience functions to parse phones + and addresses." + :tag "BBDB to CCSO Field Name Mapping" :type '(repeat (cons :tag "Field Name" - (symbol :tag "CCSO") - (sexp :tag "BBDB"))) + (symbol :tag "BBDB Field") + (sexp :tag "Conversion Spec"))) :group 'ph) (defcustom ph-options-file "~/.emacs" @@ -235,6 +249,20 @@ (defvar ph-process-buffer nil) (defvar ph-read-point) + + + +;;; FSF Emacs does not provide that one +(if (not (fboundp 'split-string)) + (defun split-string (string pattern) + "Return a list of substrings of STRING which are separated by PATTERN." + (let (parts (start 0)) + (while (string-match pattern string start) + (setq parts (cons (substring string start (match-beginning 0)) parts) + start (match-end 0))) + (nreverse (cons (substring string start) parts)) + ))) + (defun ph-display-records (records &optional raw-field-names) "Display the record list RECORDS in a formatted buffer. If RAW-FIELD-NAMES is non nil, no translation to form strings or @@ -398,10 +426,10 @@ (memq 'all fields) (memq current-key fields)) (if key - (setq record (cons (cons key value) record)) - (setcdr (car record) (cons value (if (listp (cdar record)) - (cdar record) - (cons (cdar record) nil))))))))) + (setq record (cons (cons key value) record)) ; New key + (setcdr (car record) (if (listp (cdar record)) + (append (cdar record) (list value)) + (list (cdar record) value)))))))) (and (not ignore) (or (null fields) (memq 'all fields) @@ -573,17 +601,129 @@ (buffer-substring (point) match-end) return-code)))) -;;; FSF Emacs does not provide that one -(if (not (fboundp 'split-string)) - (defun split-string (string pattern) - "Return a list of substrings of STRING which are separated by PATTERN." - (let (parts (start 0)) - (while (string-match pattern string start) - (setq parts (cons (substring string start (match-beginning 0)) parts) - start (match-end 0))) - (nreverse (cons (substring string start) parts)) - ))) +(defun ph-create-bbdb-record (record) + "Create a BBDB record using the RECORD alist. +RECORD is an alist of (KEY . VALUE) where KEY is a symbol naming a field +of the PH/QI database and VALUE is the corresponding value for the record" + ;; This function runs in a special context where lisp symbols corresponding + ;; to field names in record are bound to the corresponding values + (eval + `(let* (,@(mapcar '(lambda (c) + (list (car c) (if (listp (cdr c)) + (list 'quote (cdr c)) + (cdr c)))) + record) + bbdb-name + bbdb-company + bbdb-net + bbdb-address + bbdb-phones + bbdb-notes + spec + bbdb-record + value) + + ;; BBDB standard fields + (setq bbdb-name (ph-parse-spec (cdr (assq 'name ph-bbdb-conversion-alist)) record nil) + bbdb-company (ph-parse-spec (cdr (assq 'company ph-bbdb-conversion-alist)) record nil) + bbdb-net (ph-parse-spec (cdr (assq 'net ph-bbdb-conversion-alist)) record nil) + bbdb-notes (ph-parse-spec (cdr (assq 'notes ph-bbdb-conversion-alist)) record nil)) + (setq spec (cdr (assq 'address ph-bbdb-conversion-alist))) + (setq bbdb-address (delq nil (ph-parse-spec (if (listp (car spec)) + spec + (list spec)) + record t))) + (setq spec (cdr (assq 'phone ph-bbdb-conversion-alist))) + (setq bbdb-phones (delq nil (ph-parse-spec (if (listp (car spec)) + spec + (list spec)) + record t))) + ;; BBDB custom fields + (setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes))) + (mapcar (function + (lambda (mapping) + (if (and (not (memq (car mapping) + '(name company net address phone notes))) + (setq value (ph-parse-spec (cdr mapping) record nil))) + (cons (car mapping) value)))) + ph-bbdb-conversion-alist))) + (setq bbdb-notes (delq nil bbdb-notes)) + (setq bbdb-record (bbdb-create-internal bbdb-name + bbdb-company + bbdb-net + bbdb-address + bbdb-phones + bbdb-notes)) + + (bbdb-display-records (list bbdb-record)) + ))) +(defun ph-parse-spec (spec record recurse) + "Parse the conversion SPEC using RECORD. +If RECURSE is non-nil then SPEC may be a list of atomic specs" + (cond + ((or (stringp spec) + (symbolp spec) + (and (listp spec) + (symbolp (car spec)) + (fboundp (car spec)))) + (condition-case nil + (eval spec) + (void-variable nil))) + ((and recurse + (listp spec)) + (mapcar '(lambda (spec-elem) + (ph-parse-spec spec-elem record nil)) + spec)) + (t + (error "Invalid mapping specification for `%s'. Fix ph-bbdb-conversion-alist" spec)))) + +(defun ph-bbdbify-address (addr location) + "Parse ADDR into a vector compatible with bbdb-create-internal. +ADR should be an address string of no more than four lines or a +list of lines. +The last line is searched for the zip code, city and state name. +LOCATION is used as the address location for bbdb" + (let* ((addr-components (if (listp addr) + (reverse addr) + (reverse (split-string addr "\n")))) + (lastl (pop addr-components)) + zip city state) + (setq addr-components (nreverse addr-components)) + (cond + ;; American style + ((string-match "\\(\\w+\\)\\W*\\([A-Z][A-Z]\\)\\W*\\([0-9]+\\)" lastl) + (setq city (match-string 1 lastl) + state (match-string 2 lastl) + zip (string-to-number (match-string 3 lastl)))) + ;; European style + ((string-match "\\([0-9]+\\)[ \t]+\\(.*\\)" lastl) + (setq city (match-string 2 lastl) + zip (string-to-number (match-string 1 lastl)))) + (t + (error "ph-bbdbify-address was unable to parse the address. Customize ph-bbdb-conversion-alist"))) + (vector location + (or (nth 0 addr-components) "") + (or (nth 1 addr-components) "") + (or (nth 2 addr-components) "") + (or city "") + (or state "") + zip))) + +(defun ph-bbdbify-phone (phone location) + "Parse PHONE into a vector compatible with bbdb-create-internal. +PHONE is either a string supposedly containing a phone number or +a list of such strings which are concatenated. +LOCATION is used as the phone location for bbdb" + (let ((phone-string (cond + ((stringp phone) + phone) + ((listp phone) + (mapconcat 'identity phone ", ")) + (t + (error "Invalid phone specification. Cannot create bbdb record"))))) + (vector location phone-string))) + ;;}}} ;;{{{ High-level interfaces (interactive functions) @@ -596,8 +736,8 @@ (defun ph-set-server (server) "Set the server to SERVER." (interactive "sNew PH/QI Server: ") - (setq ph-server server) - (message "Selected PH/QI server is now %s" server)) + (message "Selected PH/QI server is now %s" server) + (setq ph-server server)) (defun ph-get-email (name) "Get the email field of NAME from the PH/QI directory server." @@ -834,6 +974,17 @@ (save-buffer)) ) + +(defun ph-insert-record-at-point-into-bbdb () + "Insert record at point into the BBDB database. +This function can only be called from a PH/QI query result buffer." + (interactive) + (let ((record (and (overlays-at (point)) + (overlay-get (car (overlays-at (point))) 'ph-record)))) + (if (null record) + (error "Point is not over a record.") + (ph-create-bbdb-record record)))) + ;;}}} ;;{{{ Menu interface @@ -844,6 +995,11 @@ `(["---" nil nil] ["Query Form" ph-query-form t] ["Expand Inline" ph-expand-inline t] + ["Insert Record into BBDB" ph-insert-record-at-point-into-bbdb + (and (or (featurep 'bbdb) + (locate-library 'bbdb)) + (overlays-at (point)) + (overlay-get (car (overlays-at (point))) 'ph-record))] ["---" nil nil] ["Get Email" ph-get-email t] ["Get Phone" ph-get-phone t]
--- a/lisp/version.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/version.el Mon Aug 13 09:44:42 2007 +0200 @@ -40,11 +40,16 @@ (defconst emacs-version (purecopy - (format "%d.%d \"%s\"%s%s" + (format "%d.%d %s%s%s" emacs-major-version emacs-minor-version - xemacs-codename - " XEmacs Lucid" + (if xemacs-codename + (concat "\"" xemacs-codename "\"") + "") + (concat " XEmacs " + (if (not (featurep 'infodock)) + " Lucid" + "")) (if xemacs-betaname (concat " " xemacs-betaname) ""))) @@ -83,8 +88,11 @@ (interactive "p") (let ((version-string (format - "XEmacs %s [Lucid] (%s%s) of %s %s on %s" + "XEmacs %s %s(%s%s) of %s %s on %s" (substring emacs-version 0 (string-match " XEmacs" emacs-version)) + (if (not (featurep 'infodock)) + "[Lucid] " + "") system-configuration (cond ((or (and (fboundp 'featurep) (featurep 'mule))
--- a/lisp/viper/auto-autoloads.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/viper/auto-autoloads.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,6 +1,9 @@ ;;; DO NOT MODIFY THIS FILE (if (not (featurep 'viper-autoloads)) (progn + +(provide 'viper-autoloads) +)) ;;;### (autoloads (viper-mode) "viper" "viper/viper.el") @@ -10,6 +13,3 @@ Turn on Viper emulation of Vi." t nil) ;;;*** - -(provide 'viper-autoloads) -))
--- a/lisp/viper/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/viper/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/vm/auto-autoloads.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/vm/auto-autoloads.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,6 +1,9 @@ ;;; DO NOT MODIFY THIS FILE (if (not (featurep 'vm-autoloads)) (progn + +(provide 'vm-autoloads) +)) ;;;### (autoloads (vm-easy-menu-create-keymaps vm-easy-menu-define) "vm-easymenu" "vm/vm-easymenu.el") @@ -71,6 +74,3 @@ (autoload 'vm-easy-menu-create-keymaps "vm-easymenu" nil nil nil) ;;;*** - -(provide 'vm-autoloads) -))
--- a/lisp/vm/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/vm/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/w3/ChangeLog Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/ChangeLog Mon Aug 13 09:44:42 2007 +0200 @@ -2,8 +2,263 @@ * Makefile (xemacs-w3): Special target for XEmacs Build. +Wed Jun 25 07:29:46 1997 William M. Perry <wmperry@aventail.com> + +* Makefile.in (Makefile): Ditto + +* texi/Makefile.in: Automatically rebuilds out-of-date Makefiles + +* configure.in: Make sure we create texi/Makefile + +* w3-display.el (w3-table-ascii-border-chars): Slightly nicer rounded + edges for ascii borders on tables. + +Tue Jun 24 14:35:05 1997 William M. Perry <wmperry@aventail.com> + +* Moved texinfo stuff into its own subdirectory, integrated into + configure, make, and install procedures. + +* url-file.el: Visiting directories with an index file works in asynch + mode now. + +* docomp.el (cl): Load cl during builds + +* w3.el (w3-find-default-stylesheets): Added more directories to the + stylesheet search path. + (w3-do-setup): Make sure we don't infinitely recurse if we are using + html bookmarks. w3-parse-hotlist could call w3-parse-buffer, which will + call w3-do-setup if we don't set our global flag as 't'. + +* Makefile.in (SOURCES): Some reordering to make the stupid thing at least + compile with Emacs 19. + +Tue Jun 24 11:44:59 1997 Per Abrahamsen <abraham@dina.kvl.dk> + +* w3.el (w3-mode): Avoid calling the global bindings for RET and mouse-2. + +1997-06-24 William M. Perry <wmperry@aventail.com> + +* Synch'd up to custom/widget 1.9936 + +* Emacs/W3 3.0.90 released + +* Moved the documentation into its own subdirectory + +* w3-menu.el: Slightly less complete version of id-menubar-set when not in + InfoDock - was causing lots of errors in XEmacs when trying to run a + non-existent hook. Bleah. + +* configure.in: Fixed AC_CHECK_PROG for emacs/xemacs - duh. + +* aclocal.m4: Don't check custom sanity if it was specified on the + configure line + +1997-06-23 William M. Perry <wmperry@aventail.com> + +* url-file.el (url-file): Make sure we set the content-type when loading + files. Was screwed when we were asynch. + +* Upped planned release # to 4.0 + +* Emacs/W3 3.0.89 released. + +* configure.in: Fixed --with-x*emacs switches. + +* Emacs/W3 3.0.88 aborted. + +* w3-display.el (w3-display-node): deal with empty selections + +* Now uses autoconf to deal with all configuration issues, including + sanity checking the installation of the custom and widget libraries. + +Mon Jun 23 17:08:55 1997 Per Abrahamsen <abraham@dina.kvl.dk> + +* w3.el (w3-mode): Don't call `widget-minor-mode'. + +* w3-vars.el (w3-mode-map): Use `make-sparse-keymap'. + Use `widget-keymap' as parent. + (wid-edit): require. + +Mon Jun 23 07:09:51 1997 William M. Perry <wmperry@aventail.com> + +* w3-parse.el (w3-parse-buffer): Make sure we always have a newline at the + end of the buffer before starting the parse. + +Fri Jun 20 11:23:28 1997 William M. Perry <wmperry@aventail.com> + +* Synch'd up to Widget 1.9929 + +* w3-mouse.el: Deal with InfoDock button bindings - we don't need to bind + _anything_ since hyperbole knows all about hyperlinks and stuff. + +* w3-menu.el (w3-menu-install-menubar): Deal with InfoDock way of + specifying mode menubars. + +* w3-toolbar.el (w3-add-toolbar-to-buffer): Don't install the toolbar + under InfoDock - it uses different toolbars than straight XEmacs. + +* w3-mouse.el: Don't bind shift-button2 - this is reserved for hyperbole. + This is now on meta. + +1997-06-19 William M. Perry <wmperry@aventail.com> + +* w3.el (w3-map-links): Deal with new keywords. + +* w3-menu.el (w3-menu-links-constructor): Deal with new keywords on + links/images. + (w3-popup-menu): Ditto. + +* w3-display.el (w3-widget-echo): Deal with new keywords we use on widgets. + (w3-follow-hyperlink): Ditto. + (w3-balloon-help-callback): Ditto. + (w3-maybe-start-image-download): Ditto. + (w3-handle-image): Use new keywords. + (w3-display-convert-arglist): New function to convert an assoc list into + a property list with real CL-style keywords. + (w3-display-node): Use it when building a hyperlink. + (w3-resurrect-hyperlinks): Now uses widget-convert-text instead of nasty + knowledge of internals of the widget library. + +Tue Jun 17 21:45:06 1997 William M. Perry <wmperry@aventail.com> + +* custom-check: Was misusing 'tr' + +Sun Jun 15 22:17:01 1997 William M. Perry <wmperry@aventail.com> + +* Synch'd up to custom 1.9920 + +Sat Jun 14 15:37:09 1997 William M. Perry <wmperry@aventail.com> + +* Synch'd up to custom 1.9918 - now distribute all of custom, just to be + anal. + +* w3-display.el (w3-display-line-break): Ebola vaccination + (w3-maybe-start-background-image-download): Don't try to load background + images in Emacs 19 or on a TTY. + (w3-display-node): Keep track of the active face of a hyperlink. Need + to make the widget library smarter about this. + +Fri Jun 13 22:16:59 1997 William M. Perry <wmperry@aventail.com> + +* w3-parse.el: Some stupid sites put meta tags in the middle of their + documents. Sigh. Allow it, but bitch and moan. + +* Added custom library to the distribution. + +1997-06-11 William M. Perry <wmperry@aventail.com> + +* w3-parse.el : Allow <meta> tags in %body.content for stupid cnn.com + site. + +* Emacs/W3 3.0.87 released. + +* Synched up to Widget 1.9907 - you must be running this version for most + things to work. Make sure you are not picking up a widget library from + gnus or something like that before the one in the w3 directory. + +* w3-display.el (w3-maybe-start-background-image-download): New function + that takes a URL and a face and does its best to set the background + pixmap of that face to the image pointed to by the URL. + (w3-display-node): Implemented 'background' property on 'body' or 'html' + tags. + (w3-finalize-image-download): Changed a fair bit - shared between normal + image downloads and background image downloads. + (w3-display-node): w3-user-colors-take-precedence now controls whether + background faces are retrieved or not. + (w3-face-for-element): Stylesheets use of background-image should almost + work now. + (w3-display-node): Stylesheets use of background-image should work + completely now. + +Tue Jun 10 07:24:09 1997 William M. Perry <wmperry@aventail.com> + +* w3.el (w3-only-links): This will now use w3-map-links + (w3-mode): Dont' set inhibit-read-only, ever. + (w3-mode): back to using widget-minor-mode, since inheriting the keymap + doesn't seem to do much good. + +* w3-vars.el: Don't bind anything to widget-button-press, let + widget-minor-mode do that. + +* w3.el (w3-map-links): Revamped this to work with the new way widget is + using overlays instead of text properties. + (w3-mode): Use widget-minor-mode instead of binding a lot of + navigational commands ourselves. + +* w3-display.el: Make sure we don't try to redefine the w3-dingbats + character set when loading this file more than once. + (w3-display-node): Rearranged some of the insert-before handling so that + any text inserted does _not_ have the properties of the tag on it + (colors on hyperlinks won't bleed anymore) + (w3-resurrect-hyperlinks): New semi-working way of resurrecting + hyperlinks + +Mon Jun 9 22:53:14 1997 William M. Perry <wmperry@aventail.com> + +* w3-display.el (w3-display-node): Protect against stylesheet specified + widths on horizontal rules. + +Mon Jun 9 22:42:26 1997 Istvan Marko <istvan@cmdmail.amd.com> + +* w3-hot.el (w3-hotlist-apropos): Let this work when reuse-buffers != no + +Mon Jun 9 22:35:04 1997 Dieter Maurer <dieter@hit.handshake.de> + +* mm.el (mm-decode-quoted-printable): Fix for some multipart attachments + showing up empty due to badness in mm-decode-quoted-printable and + 'ignore' not moving to the end of the region just decoded. + +Mon Jun 9 22:35:04 1997 William M. Perry <wmperry@aventail.com> + +* w3-parse.el (w3-parse-buffer): Call w3-do-setup to make sure our + hashtables and things are set up correctly or gnus can choke big time. + +Mon Jun 9 22:26:29 1997 Michael Ernst <mernst@cs.washington.edu> + +* url.el (url-get-url-filename-chars): Fixed problem with bad use of a + hyphen in the regexp. Would cause problems when invoking + url-get-url-at-point when point was in front of a hyphen. + +1997-05-28 William M. Perry <wmperry@aventail.com> + +* w3-cus.el: Use a :prefix on most of the groups to make the options look + nicer. + +Thu May 15 05:06:30 1997 William M. Perry <wmperry@aventail.com> + +* w3-sysdp.el: removed bogus definition of buffer-substring-no-properties + - will now use the more correct one that was already there. + +* w3-display.el (w3-pause): Now has its own mini-event loop to pass off + scrolling commands, etc. Keeps buffer position constant while doing + incremental display. + +Mon May 12 08:13:27 1997 William M. Perry <wmperry@aventail.com> + +* w3.el (w3-view-this-url): Check the parent widget for an href if you + don't find one right away. This means that all commands that act on the + URL at point will now work on image widgets, etc. that are hyperlinks. + +Sat May 10 14:37:25 1997 William M. Perry <wmperry@aventail.com> + +* css.el (css-parse): Deal better with newline-challenged stylesheets + (css-parse): Don't be so aggressive in finding block data for @xyzzy + directives. + +* mm.el (mm-viewer-passes-test): Always run the tests in the users home + directory. + +* w3-mouse.el: Use down-mouse-N in Emacs 19, to be more consistent with + how the XEmacs keybindings work. + +Fri May 9 11:32:46 1997 William M. Perry <wmperry@aventail.com> + +* w3.el (w3-document-information): some formatting changes + Thu May 8 14:06:40 1997 William M. Perry <wmperry@aventail.com> +* Emacs/W3 3.0.86 released + * mule-sysdp.el (mule-code-convert-region): Try to deal gracefully with the recent XEmacs 20.0 -> 20.2 renaming of the autodetect coding system to automatic-conversion
--- a/lisp/w3/clean-cache Mon Aug 13 09:43:39 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,62 +0,0 @@ -#!/bin/sh -# -# Copyright © 1995, William M. Perry <wmperry@spry.com> -# -# Author: William M. Perry <wmperry@spry.com> -# Maintainer: William M. Perry <wmperry@spry.com> -# Created: 95/04/18 10:44:15 -# Version: $Revision: 1.1.1.1 $ -# Modified: $Date: 1996/12/18 22:43:09 $ -# Keywords: cache clean -# -# This shell script will clean out your cache directory for emacs-w3 -# It is designed to be run from a cron (see crontab(5)) or at(1) -# -# This should probably only be run occasionally: like once a month, or -# when you determine that the cache size is too big. Something like: -# -# CACHEMAXSIZE=5000 -# SIZE=`du -s $CACHE_ROOT | awk '{print $1}' -# if [ $SIZE -gt 5000 ] ; then -# /run/the/real/clean-cache -# fi - -if [ -z "$CACHE_ROOT" ] ; then - CACHE_ROOT=/tmp/$USER # The root directory of the cache -fi - -if [ -z "$CONTROL_FILE" ] ; then - CONTROL_FILE="$CACHE_ROOT/.clean" -fi - -if [ -z "$CLEAN_PROTOCOLS" ] ; then - CLEAN_PROTOCOLS="http gopher file ftp wais news" -fi - -if [ -f "$CONTROL_FILE" ] ; then - echo "Starting to clean $CACHE_ROOT..." `date` - - for x in $CLEAN_PROTOCOLS - do - if [ -d "$x" ] ; then - echo " Cleaning $x files" - find $CACHE_ROOT/$x -depth -type f \( ! -anewer "$CONTROL_FILE" \) \ - -exec rm -f {} \; - find $CACHE_ROOT/$x -depth -type d -exec rmdir {} \; - fi - done - - touch "$CONTROL_FILE" - echo "Cache clean ended: "`date` -else - echo "The cleaning control file ($CONTROL_FILE) could not be found." - echo "To create it (and make all your cache files 'current' do:" - echo "" - echo "touch $CONTROL_FILE" - echo "find $CACHE_ROOT -exec touch {} \;" - echo "" - echo "PLEASE NOTE: This can damage your cache, by changing the times it" - echo "sends to the remote server to see if the file was modified." - echo "I recommend just touching the file, then rerunning this script to" - echo "wipe the cache clean and start over." -fi
--- a/lisp/w3/css.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/css.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,7 +1,7 @@ ;;; css.el -- Cascading Style Sheet parser ;; Author: wmperry -;; Created: 1997/04/21 14:00:12 -;; Version: 1.38 +;; Created: 1997/05/11 00:54:23 +;; Version: 1.39 ;; Keywords: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -902,7 +902,7 @@ (looking-at "--+>")) ; end (goto-char (match-end 0))) ;; C++ style comments - ((looking-at "//") + ((looking-at "[ \t]*//") (end-of-line)) ;; Pre-Processor directives ((looking-at "[ \t\r]*@\\([^ \t\r\n]\\)") @@ -915,7 +915,7 @@ (skip-chars-forward " \t\r") (setq save-pos (point)) (cond - ((looking-at ".*\\({\\)") + ((looking-at "[^{]*\\({\\)") (goto-char (match-beginning 1)) (forward-sexp 1) (setq data (buffer-substring save-pos (1- (point))))) @@ -954,7 +954,6 @@ (condition-case () (forward-sexp 1) (error (goto-char (point-max)))) - (end-of-line) (skip-chars-backward "\r}") (subst-char-in-region save-pos (point) ?\n ? ) (subst-char-in-region save-pos (point) ?\r ? )
--- a/lisp/w3/custom-check Mon Aug 13 09:43:39 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -#!/bin/sh -EMACS=${1:-emacs} - -if [ -n "$WIDGETDIR" ]; then - exit 0 -fi - -if [ -z "$HOME" ]; then - HOME=`(cd ; pwd)` -fi - -if [ -f "${HOME}/.emacs" ]; then - DOTEMACS="-l ${HOME}/.emacs" -fi - -WITH=` ${EMACS} -batch ${DOTEMACS} -eval '(princ (file-truename (locate-library "custom")))' 2> /dev/null` -WITHOUT=`${EMACS} -batch -q -no-site-file -eval '(princ (file-truename (locate-library "custom")))' 2>/dev/null` - -# For some reason XEmacs sometimes ends up with a newline at the beginning -# of the output... this will hopefully strip it out. -WITH=`echo $WITH | tr '\010\013' ' '` -WITHOUT=`echo $WITHOUT | tr '\013\010' ' '` - -if [ "${WITH}" = "${WITHOUT}" ]; then - exit 0 -else - DIRECTORY=`dirname ${WITH}` - - echo "WARNING -- WARNING -- WARNING" - echo "Found custom in different places with and without ${HOME}/.emacs" - echo - echo "This could cause potential problems. Please recompile with" - echo "the environment variable WIDGETDIR set correctly. Try this" - echo "command:" - echo "make WIDGETDIR=${DIRECTORY}" - exit 1 -fi
--- a/lisp/w3/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -69,7 +69,6 @@ (put 'browse-url 'custom-loads '()) (put 'w3-hooks 'custom-loads '("w3-cus")) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'w3 'custom-loads '("w3-cus" "w3-script")) (put 'url-file 'custom-loads '("url-cache" "url-vars"))
--- a/lisp/w3/docomp.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/docomp.el Mon Aug 13 09:44:42 2007 +0200 @@ -66,6 +66,7 @@ byte-optimize t ) +(require 'cl) (require 'w3-vars) (require 'url) (require 'mm)
--- a/lisp/w3/dsssl.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/dsssl.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,7 +1,7 @@ ;;; dsssl.el --- DSSSL parser ;; Author: wmperry -;; Created: 1997/04/18 15:44:22 -;; Version: 1.14 +;; Created: 1997/06/10 06:01:32 +;; Version: 1.15 ;; Keywords: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -43,7 +43,7 @@ string->number char\? char=\? char-property string\? string string-length string-ref string=\? substring string-append procedure\? apply external-procedure make time time->string quote - char-downcase indentity error let) + char-downcase identity error let) "A list of all the builtin DSSSL functions that we support.") (defsubst dsssl-check-args (args expected)
--- a/lisp/w3/images.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/images.el Mon Aug 13 09:44:42 2007 +0200 @@ -151,8 +151,7 @@ (while chain (cond ((stringp (car chain)) - (let ((coding-system-for-read 'no-conversion) - (coding-system-for-write 'no-conversion)) + (let ((file-coding-system mule-no-coding-system)) (call-process-region (point-min) (point-max) shell-file-name t
--- a/lisp/w3/mm.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/mm.el Mon Aug 13 09:44:42 2007 +0200 @@ -720,6 +720,7 @@ (let* ((test-info (assoc "test" viewer-info)) (test (cdr test-info)) (viewer (cdr (assoc "viewer" viewer-info))) + (default-directory (expand-file-name "~/")) status parsed-test ) @@ -1177,7 +1178,7 @@ (if (stringp cmd) (shell-command-on-region st nd cmd t) (funcall cmd st nd)) - (set-marker nd (point)))) + (or (eq cmd 'ignore) (set-marker nd (point))))) (write-region st nd fname nil 5) (delete-region st nd) (setq results (cons @@ -1247,7 +1248,8 @@ (* 16 (mm-hex-char-to-integer (char-after (1+ (match-beginning 0))))) (mm-hex-char-to-integer - (char-after (1- (match-end 0)))))))))))) + (char-after (1- (match-end 0)))))))))) + (goto-char (point-max)))) ;; Taken from hexl.el. (defun mm-hex-char-to-integer (character)
--- a/lisp/w3/mule-sysdp.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/mule-sysdp.el Mon Aug 13 09:44:42 2007 +0200 @@ -41,7 +41,7 @@ (2.3 *noconv*) (2.4 'no-conversion) (3.0 'no-conversion) - (xemacs 'binary) + (xemacs 'no-conversion) (otherwise nil)) "Coding system that means no coding system should be used.") @@ -81,7 +81,7 @@ (get-coding-system 'autodetect) (error (setq code 'automatic-conversion))))) (decode-coding-region (point-min) (point-max) code) - (set-buffer-file-coding-system code)) + (set-file-coding-system code)) (otherwise nil)))
--- a/lisp/w3/url-file.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/url-file.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-file.el --- File retrieval code ;; Author: wmperry -;; Created: 1997/05/09 04:39:15 -;; Version: 1.19 +;; Created: 1997/06/24 22:38:39 +;; Version: 1.21 ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -125,17 +125,9 @@ (defun url-format-directory (dir) ;; Format the files in DIR into hypertext - (if (and url-directory-index-file - (file-exists-p (expand-file-name url-directory-index-file dir)) - (file-readable-p (expand-file-name url-directory-index-file dir))) - (save-excursion - (set-buffer url-working-buffer) - (erase-buffer) - (insert-file-contents - (expand-file-name url-directory-index-file dir))) - (kill-buffer (current-buffer)) - (find-file dir) - (url-dired-minor-mode t))) + (kill-buffer (current-buffer)) + (find-file dir) + (url-dired-minor-mode t)) (defun url-host-is-local-p (host) "Return t iff HOST references our local machine." @@ -189,8 +181,11 @@ (dest (url-target urlobj)) (filename (if (or user (not (url-host-is-local-p site))) (concat "/" (or user "anonymous") "@" site ":" file) - file))) - + file)) + (viewer (mm-mime-info + (mm-extension-to-mime (url-file-extension file)))) + (pos-index (if url-directory-index-file + (expand-file-name url-directory-index-file filename)))) (url-clear-tmp-buffer) (and user pass (cond @@ -200,6 +195,12 @@ (efs-set-passwd site user pass)) (t nil))) + (if (and pos-index + (file-exists-p pos-index) + (file-readable-p pos-index)) + (setq filename pos-index)) + (setq url-current-mime-type (mm-extension-to-mime + (url-file-extension filename))) (cond ((file-directory-p filename) (if (not (string-match "/$" filename)) @@ -241,9 +242,7 @@ (url-file-build-continuation new) 0 nil))))) (t - (let ((viewer (mm-mime-info - (mm-extension-to-mime (url-file-extension file)))) - (errobj nil)) + (let ((errobj nil)) (if (or url-source ; Need it in a buffer (and (symbolp viewer) (not (eq viewer 'w3-default-local-file))) @@ -252,9 +251,7 @@ (url-insert-possibly-compressed-file filename t) (error (url-save-error errobj) - (url-retrieve (concat "www://error/nofile/" file)))))))) - (setq url-current-mime-type (mm-extension-to-mime - (url-file-extension file))))) + (url-retrieve (concat "www://error/nofile/" file)))))))))) (fset 'url-ftp 'url-file)
--- a/lisp/w3/url-vars.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/url-vars.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool ;; Author: wmperry -;; Created: 1997/05/09 06:21:56 -;; Version: 1.58 +;; Created: 1997/06/25 15:58:54 +;; Version: 1.69 ;; Keywords: comm, data, processes, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -38,7 +38,7 @@ (defmacro defcustom (var value doc &rest args) (` (defvar (, var) (, value) (, doc)))))) -(defconst url-version (let ((x "p3.0.86")) +(defconst url-version (let ((x "p3.0.92")) (if (string-match "State: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x))
--- a/lisp/w3/url.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/url.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,13 +1,13 @@ ;;; url.el --- Uniform Resource Locator retrieval tool ;; Author: wmperry -;; Created: 1997/05/08 22:17:40 -;; Version: 1.78 +;; Created: 1997/06/10 05:26:37 +;; Version: 1.79 ;; Keywords: comm, data, processes, hypermedia ;;; LCD Archive Entry: ;;; url|William M. Perry|wmperry@cs.indiana.edu| ;;; Functions for retrieving/manipulating URLs| -;;; 1997/05/08 22:17:40|1.78|Location Undetermined +;;; 1997/06/10 05:26:37|1.79|Location Undetermined ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1025,7 +1025,7 @@ (run-hooks 'url-load-hook) (setq url-setup-done t))) -(defvar url-get-url-filename-chars "%.?@a-zA-Z0-9---()_/:~=&" +(defvar url-get-url-filename-chars "-%.?@a-zA-Z0-9()_/:~=&" "Valid characters in a URL") ;;;###autoload
--- a/lisp/w3/w3-cus.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/w3-cus.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-cus.el --- Customization support for Emacs-W3 ;; Author: wmperry -;; Created: 1997/04/24 14:57:19 -;; Version: 1.8 +;; Created: 1997/05/28 13:51:24 +;; Version: 1.9 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -43,31 +43,38 @@ (defgroup w3-files nil "Emacs-W3 configuration files." - :group 'w3) + :group 'w3 + :prefix "w3-") (defgroup w3-images nil "Controlling image handling." - :group 'w3) + :group 'w3 + :prefix "w3-") (defgroup w3-printing nil "Various options for hardcopy from web pages." - :group 'w3) + :group 'w3 + :prefix "w3-") (defgroup w3-menus nil "The look of menus in Emacs-W3" - :group 'w3) + :group 'w3 + :prefix "w3-") (defgroup w3-parsing nil "Options relating to HTML parsing" - :group 'w3) + :group 'w3 + :prefix "w3-") (defgroup w3-display nil "Variables relating to how web pages are displayed." - :group 'w3) + :group 'w3 + :prefix "w3-") (defgroup w3-hooks nil "Hooks relating to Emacs-W3." - :group 'w3) + :group 'w3 + :prefix "w3-") ;;; File related variables (defcustom w3-configuration-directory "~/.w3/"
--- a/lisp/w3/w3-display.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/w3-display.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-display.el --- display engine v99999 ;; Author: wmperry -;; Created: 1997/04/24 16:51:06 -;; Version: 1.176 +;; Created: 1997/06/25 14:30:16 +;; Version: 1.189 ;; Keywords: faces, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -34,7 +34,8 @@ (require 'w3-widget) (require 'w3-imap) -(define-widget-keywords :emacspeak-help) +(define-widget-keywords :active-face :emacspeak-help :href + :name :target :title :src) (autoload 'sentence-ify "flame") (autoload 'string-ify "flame") (autoload '*flame "flame") @@ -70,7 +71,7 @@ (w3-d-s-var-def w3-face-text-decoration) (w3-d-s-var-def w3-face-face) (w3-d-s-var-def w3-face-descr) -(w3-d-s-var-def w3-face-pixmap) +(w3-d-s-var-def w3-face-background-image) (w3-d-s-var-def w3-display-css-properties) (w3-d-s-var-def w3-display-background-properties) @@ -107,7 +108,7 @@ (w3-get-face-info font-variant) (w3-get-face-info font-size) (w3-get-face-info text-decoration) - ;;(w3-get-face-info pixmap) + (w3-get-face-info background-image) (w3-get-face-info color color) (w3-get-face-info background-color bgcolor) (setq w3-face-font-spec (make-font @@ -124,7 +125,7 @@ (w3-pop-face-info font-size) (w3-pop-face-info font-style) (w3-pop-face-info text-decoration) - ;;(w3-pop-face-info pixmap) + (w3-pop-face-info background-image) (w3-pop-face-info color) (w3-pop-face-info background-color)))) @@ -153,16 +154,27 @@ (setq len (1+ len))) breaks-vector)) -(defun w3-pause () - (cond - (w3-running-FSF19 (sit-for 0)) - (w3-running-xemacs - (sit-for 0)) - ;; (if (and (not (sit-for 0)) (input-pending-p)) - ;; (condition-case () - ;; (dispatch-event (next-command-event)) - ;; (error nil))) - (t (sit-for 0)))) +(defsubst w3-pause () + (save-excursion + (goto-char (or (symbol-value 'cur-viewing-pos) (point-min))) + (cond + (w3-running-FSF19 + (if (and (not (sit-for 0)) (input-pending-p)) + (condition-case () + (progn + (set 'cur-viewing-pos + (lookup-key w3-mode-map (vector (read-event)))) + (case (symbol-value 'cur-viewing-pos) + ((w3-quit w3-leave-buffer) nil) + (otherwise (call-interactively (symbol-value 'cur-viewing-pos))))) + (error nil)))) + (w3-running-xemacs + (if (and (not (sit-for 0)) (input-pending-p)) + (condition-case () + (dispatch-event (next-command-event)) + (error nil)))) + (t (sit-for 0))) + (set 'cur-viewing-pos (point)))) (defmacro w3-get-pad-string (len) (` (cond @@ -261,10 +273,12 @@ (set-font-style-by-keywords w3-face-font-spec (car w3-face-font-style))) (setq w3-face-descr (list w3-face-font-spec + (car w3-face-background-image) (car w3-face-color) (car w3-face-background-color)) w3-face-face (cdr-safe (assoc w3-face-descr w3-face-cache))) (if (or w3-face-face (not (or (car w3-face-color) + (car w3-face-background-image) (car w3-face-background-color) w3-face-font-spec))) nil ; Do nothing, we got it already @@ -272,13 +286,15 @@ (w3-make-face (intern (format "w3-style-face-%05d" w3-face-index)) "An Emacs-W3 face... don't edit by hand." t) w3-face-index (1+ w3-face-index)) + (if (car w3-face-background-image) + (w3-maybe-start-background-image-download + (car w3-face-background-image) w3-face-face)) (if w3-face-font-spec (font-set-face-font w3-face-face w3-face-font-spec)) (if (car w3-face-color) (font-set-face-foreground w3-face-face (car w3-face-color))) (if (car w3-face-background-color) (font-set-face-background w3-face-face (car w3-face-background-color))) - ;;(set-face-background-pixmap w3-face-face w3-face-pixmap) (setq w3-face-cache (cons (cons w3-face-descr w3-face-face) w3-face-cache))) @@ -300,12 +316,16 @@ string) +(if (not (fboundp 'char-before)) + (fset 'char-before 'preceding-char)) + (defsubst w3-display-line-break (n) (if (or (memq (car w3-display-whitespace-stack) '(pre nowrap)) ; Been told (= w3-last-fill-pos (point)) (> w3-last-fill-pos (point-max))) - (if (/= (preceding-char) ?\n) (setq n (1+ n))) ; at least put one line in + (if (not (eq (char-before) ?\n)) + (setq n (1+ n))) ; at least put one line in (let ((fill-column (max (1+ (length fill-prefix)) fill-column)) width) (case (car w3-display-alignment-stack) @@ -401,13 +421,13 @@ (cookie fname st nd)))) (defun w3-widget-echo (widget &rest ignore) - (let ((url (widget-get widget 'href)) - (name (widget-get widget 'name)) - (text (buffer-substring (widget-get widget :from) - (widget-get widget :to))) - (title (widget-get widget 'title)) - (check w3-echo-link) - (msg nil)) + (let* ((url (widget-get widget :href)) + (name (widget-get widget :name)) + (text (buffer-substring (widget-get widget :from) + (widget-get widget :to))) + (title (widget-get widget :title)) + (check w3-echo-link) + (msg nil)) (if url (setq url (url-truncate-url-for-viewing url))) (if name @@ -423,9 +443,8 @@ (pop check))))) (defun w3-follow-hyperlink (widget &rest ignore) - (let* ((target (or (widget-get widget 'target) - w3-base-target)) - (href (widget-get widget 'href))) + (let* ((target (or (widget-get widget :target) w3-base-target)) + (href (widget-get widget :href))) (if target (setq target (intern (downcase target)))) (case target ((_blank external) @@ -438,7 +457,7 @@ (defun w3-balloon-help-callback (object &optional event) (let* ((widget (widget-at (extent-start-position object))) - (href (and widget (widget-get widget 'href)))) + (href (widget-get widget :href))) (if href (url-truncate-url-for-viewing href) nil))) @@ -637,7 +656,7 @@ ;; Image handling (defun w3-maybe-start-image-download (widget) - (let* ((src (widget-get widget 'src)) + (let* ((src (widget-get widget :src)) (cached-glyph (w3-image-cached-p src))) (cond ((and cached-glyph @@ -651,7 +670,7 @@ (eq (device-type) 'tty)) ; Why bother? (w3-add-delayed-graphic widget)) ((not (w3-image-loadable-p src nil)) ; Hey, we can't load it! - (message "Skipping image %s" (url-basepath src t)) + (mesage "Skipping image %s" (url-basepath src t)) (w3-add-delayed-graphic widget)) (t ; Grab the images (let ( @@ -675,17 +694,61 @@ w3-graphics-list)) (save-excursion (set-buffer (get-buffer-create url-working-buffer)) - (setq url-current-callback-data (list widget) + (setq url-current-callback-data (list src (widget-get widget 'buffer) + widget) url-be-asynchronous t url-current-callback-func 'w3-finalize-image-download) (url-retrieve src)) (setq-default url-be-asynchronous old-asynch)))))) -(defun w3-finalize-image-download (widget) +(defun w3-maybe-start-background-image-download (src face) + (let* ((cached-glyph (w3-image-cached-p src)) + (buf (current-buffer))) + (cond + ((and cached-glyph + (widget-glyphp cached-glyph) + (not (eq 'nothing + (image-instance-type + (glyph-image-instance cached-glyph))))) + (set-face-background-pixmap face + (glyph-image-instance cached-glyph) buf)) + ((or (not (fboundp 'valid-specifier-domain-p)) ; Can't do images + (eq (device-type) 'tty)) ; Why bother? + nil) + ((not (w3-image-loadable-p src nil)) ; Hey, we can't load it! + (mesage "Skipping image %s" (url-basepath src t)) + nil) + (t ; Grab the images + (let ( + (url-request-method "GET") + (old-asynch url-be-asynchronous) + (url-request-data nil) + (url-request-extra-headers nil) + (url-source t) + (url-mime-accept-string (substring + (mapconcat + (function + (lambda (x) + (if x + (concat (car x) ",") + ""))) + w3-allowed-image-types "") + 0 -1)) + (url-working-buffer (generate-new-buffer-name " *W3GRAPH*"))) + (setq-default url-be-asynchronous t) + (setq w3-graphics-list (cons (cons src (make-glyph)) + w3-graphics-list)) + (save-excursion + (set-buffer (get-buffer-create url-working-buffer)) + (setq url-current-callback-data (list src buf 'background face) + url-be-asynchronous t + url-current-callback-func 'w3-finalize-image-download) + (url-retrieve src)) + (setq-default url-be-asynchronous old-asynch)))))) + +(defun w3-finalize-image-download (url buffer &optional widget face) (let ((glyph nil) - (url (widget-get widget 'src)) - (node nil) - (buffer (widget-get widget 'buffer))) + (node nil)) (message "Enhancing image...") (setq glyph (image-normalize (cdr-safe (assoc url-current-mime-type w3-image-mappings)) @@ -719,14 +782,23 @@ (setq w3-graphics-list (cons (cons url glyph) w3-graphics-list))) (t nil)) - (if (and (buffer-name buffer) ; Dest. buffer exists - (widget-glyphp glyph)) ; got a valid glyph - (save-excursion - (set-buffer buffer) - (if (eq major-mode 'w3-mode) - (widget-value-set widget glyph) - (setq w3-image-widgets-waiting - (cons widget w3-image-widgets-waiting))))))) + (cond + ((or (not buffer) + (not (widget-glyphp glyph)) + (not (buffer-name buffer))) + nil) + ((and (eq widget 'background) + w3-running-xemacs) + (set-face-background-pixmap face + (glyph-image-instance glyph) + buffer)) + ((not (eq widget 'background)) + (save-excursion + (set-buffer buffer) + (if (eq major-mode 'w3-mode) + (widget-value-set widget glyph) + (setq w3-image-widgets-waiting + (cons widget w3-image-widgets-waiting)))))))) (defmacro w3-handle-image () (` @@ -744,8 +816,8 @@ (ismap (and (assq 'ismap args) 'ismap)) (usemap (w3-get-attribute 'usemap)) (base (w3-get-attribute 'base)) - (href (and hyperlink-info (widget-get (cadr hyperlink-info) 'href))) - (target (and hyperlink-info (widget-get (cadr hyperlink-info) 'target))) + (href (and hyperlink-info (widget-get (cadr hyperlink-info) :href))) + (target (and hyperlink-info (widget-get (cadr hyperlink-info) :target))) (widget nil) (align (or (w3-get-attribute 'align) (w3-get-style-info 'vertical-align node)))) @@ -755,12 +827,12 @@ (insert alt) (setq widget (widget-create 'image :value-face w3-active-faces - 'src src ; Where to load the image from + :src src ; Where to load the image from 'alt alt ; Textual replacement 'ismap ismap ; Is it a server-side map? 'usemap usemap ; Is it a client-side map? - 'href href ; Hyperlink destination - 'target target + :href href ; Hyperlink destination + :target target )) (widget-put widget 'buffer (current-buffer)) (w3-maybe-start-image-download widget) @@ -772,7 +844,8 @@ ;; The table handling -(if (and w3-running-xemacs (featurep 'mule)) +(if (and w3-running-xemacs (featurep 'mule) + (not (find-charset 'w3-dingbats))) (make-charset 'w3-dingbats "Dingbats character set for Emacs/W3" '(registry "" dimension 1 chars 96 final ?:))) @@ -782,7 +855,7 @@ oct)) (defvar w3-table-ascii-border-chars - [nil nil nil ?/ nil ?- ?\\ ?- nil ?\\ ?| ?| ?/ ?- ?| ?+] + [nil nil nil ?' nil ?- ?` ?- nil ?\\ ?| ?| ?/ ?- ?| ?+] "*Vector of ascii characters to use to draw table borders. This vector is used when terminal characters are unavailable") @@ -819,7 +892,7 @@ w3-table-glyph-border-chars, or w3-table-graphic-border-chars.") -(defsubst w3-table-lookup-char (l u r b) +(defsubst w3-table-lookup-char (l u r b &optional char) (aref w3-table-border-chars (logior (if l 1 0) (if u 2 0) (if r 4 0) @@ -840,7 +913,7 @@ (defsubst w3-horizontal-rule-char nil (or w3-horizontal-rule-char (w3-table-lookup-char t nil t nil))) -(defun w3-setup-terminal-chars nil +(defun w3-setup-terminal-chars () "Try to find the best set of characters to draw table borders with. On a console, this can trigger some Emacs display bugs. @@ -1612,6 +1685,27 @@ plist (plist-put plist 'maxlength maxlength)) plist)) +(defun w3-resurrect-hyperlinks () + (let ((st (point-min)) + (inhibit-read-only t) + info nd node face) + (while st + (if (setq info (get-text-property st 'w3-hyperlink-info)) + (progn + (setq nd (or (next-single-property-change st 'w3-hyperlink-info) + (point-max))) + (apply 'widget-convert-text 'link st nd st nd info))) + (setq st (next-single-property-change st 'w3-hyperlink-info))))) + +(defun w3-display-convert-arglist (args) + (let ((rval nil) + (newsym nil) + (cur nil)) + (while (setq cur (pop args)) + (setq newsym (intern (concat ":" (symbol-name (car cur)))) + rval (plist-put rval newsym (cdr cur)))) + rval)) + (defun w3-display-node (node &optional nofaces) (let ( (content-stack (list (list node))) @@ -1647,17 +1741,11 @@ nil (add-text-properties (car hyperlink-info) (point) (list - 'mouse-face 'highlight 'duplicable t 'start-open t 'end-open t 'rear-nonsticky t - 'help-echo 'w3-balloon-help-callback - 'balloon-help 'w3-balloon-help-callback)) - (fillin-text-property (car hyperlink-info) (point) - 'button 'button (cadr hyperlink-info)) - (widget-put (cadr hyperlink-info) :to (set-marker - (make-marker) (point)))) + 'w3-hyperlink-info (cadr hyperlink-info)))) (setq hyperlink-info nil)) ((ol ul dl dir menu) (pop w3-display-list-stack)) @@ -1709,10 +1797,6 @@ (nth 1 node) w3-current-stylesheet w3-display-open-element-stack)) - (if nofaces - nil - (push (w3-face-for-element node) w3-active-faces) - (push (w3-voice-for-element node) w3-active-voices)) (push (w3-get-style-info 'display node) break-style) (push (w3-get-style-info 'insert-after node) insert-after) (setq insert-before (w3-get-style-info 'insert-before node)) @@ -1724,6 +1808,10 @@ (setcar insert-after nil)) (if insert-before (w3-handle-string-content insert-before)) + (if nofaces + nil + (push (w3-face-for-element node) w3-active-faces) + (push (w3-voice-for-element node) w3-active-voices)) (setq insert-before nil) (if id (setq w3-id-positions (cons @@ -1743,21 +1831,37 @@ (after nil) (face nil) (voice nil) - (st nil)) + (st nil) + (old-props w3-display-css-properties) + (active-face nil) + (munged (copy-list args))) + (if (assq 'class munged) + (push ":active" (cdr (assq 'class munged))) + (setq munged (cons (cons 'class '(":active")) munged))) + (setq w3-display-css-properties (css-get + tag + munged + w3-current-stylesheet + w3-display-open-element-stack)) + (setq active-face (w3-face-for-element (list tag munged nil))) + (w3-pop-all-face-info) + (setq w3-display-css-properties old-props) (if (w3-get-attribute 'href) (setq st (point) hyperlink-info (list st - (append - (list 'link :args nil + (append + (list :args nil :value "" :tag "" :action 'w3-follow-hyperlink + :button-face '(nil) + :active-face active-face :from (set-marker (make-marker) st) :help-echo 'w3-widget-echo :emacspeak-help 'w3-widget-echo ) - (alist-to-plist args))))) + (w3-display-convert-arglist args))))) (w3-handle-content node) ) ) @@ -1827,8 +1931,10 @@ (w3-get-style-info 'width node) "100%")) (width nil)) - (setq perc (/ (min (string-to-int perc) 100) 100.0) - width (truncate (* fill-column perc))) + (if (stringp perc) + (setq perc (/ (min (string-to-int perc) 100) 100.0) + width (truncate (* fill-column perc))) + (setq width perc)) (w3-insert-terminal-char (w3-horizontal-rule-char) width) (w3-handle-empty-tag))) (map ; Client side imagemaps @@ -1913,6 +2019,7 @@ ((html body) (let ((fore (car (delq nil (copy-list w3-face-color)))) (back (car (delq nil (copy-list w3-face-background-color)))) + (pixm (car (delq nil (copy-list w3-face-background-image)))) (alink (w3-get-attribute 'alink)) (vlink (w3-get-attribute 'vlink)) (link (w3-get-attribute 'link)) @@ -1927,22 +2034,28 @@ (if alink (setq sheet (format "%sa:active { color: %s }\n" sheet (w3-fix-color alink)))) - (if (and (not w3-user-colors-take-precedence) - (/= (length sheet) 0)) - (w3-handle-style (list 'data sheet - 'notation "text/css"))) - (if (and (not w3-user-colors-take-precedence) - (w3-get-attribute 'text) - (not fore)) - (progn - (setq fore (w3-fix-color (w3-get-attribute 'text))) - (setf (car w3-face-color) fore))) - (if (not font-running-xemacs) - (setq w3-display-background-properties (cons fore back)) - (if fore - (font-set-face-foreground 'default fore (current-buffer))) - (if back - (font-set-face-background 'default back (current-buffer)))) + (if w3-user-colors-take-precedence + nil + (if (/= (length sheet) 0) + (w3-handle-style (list 'data sheet + 'notation "text/css"))) + (if (and (w3-get-attribute 'background) + (not pixm)) + (progn + (setq pixm (w3-get-attribute 'background)) + (setf (car w3-face-background-image) pixm))) + (if (and (w3-get-attribute 'text) (not fore)) + (progn + (setq fore (w3-fix-color (w3-get-attribute 'text))) + (setf (car w3-face-color) fore))) + (if (not font-running-xemacs) + (setq w3-display-background-properties (cons fore back)) + (if pixm + (w3-maybe-start-background-image-download pixm 'default)) + (if fore + (font-set-face-foreground 'default fore (current-buffer))) + (if back + (font-set-face-background 'default back (current-buffer))))) (w3-handle-content node))) (*document (let ((info (mapcar (lambda (x) (cons x (symbol-value x))) @@ -1967,6 +2080,7 @@ (set (make-local-variable 'filladapt-mode) nil) (set (make-local-variable 'adaptive-fill-mode) nil) (set (make-local-variable 'voice-lock-mode) t) + (set (make-local-variable 'cur-viewing-pos) (point-min)) (setq w3-current-stylesheet (css-copy-stylesheet w3-user-stylesheet) w3-last-fill-pos (point) @@ -2066,7 +2180,7 @@ tmp)) (nth 2 node)))) (if (not value) - (setq value (aref (car options) 0))) + (setq value (and options (aref (car options) 0)))) (setq plist (plist-put plist 'value value)) (if multiple (progn @@ -2170,6 +2284,7 @@ (w3-display-node (car tree)) (setq tree (cdr tree))) (w3-display-fix-widgets) + (w3-resurrect-hyperlinks) (w3-form-resurrect-widgets)) (defun time-display (&optional tree) @@ -2196,7 +2311,7 @@ (while w3-image-widgets-waiting (setq widget (car w3-image-widgets-waiting) w3-image-widgets-waiting (cdr w3-image-widgets-waiting) - url (widget-get widget 'src) + url (widget-get widget :src) glyph (cdr-safe (assoc url w3-graphics-list))) (condition-case nil (widget-value-set widget glyph)
--- a/lisp/w3/w3-e19.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/w3-e19.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-e19.el --- Emacs 19.xx specific functions for emacs-w3 ;; Author: wmperry -;; Created: 1997/04/24 04:44:57 -;; Version: 1.25 +;; Created: 1997/05/10 23:01:41 +;; Version: 1.26 ;; Keywords: faces, help, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -107,7 +107,7 @@ ;; Emacs 19 specific stuff for w3-mode (declare (special w3-face-index w3-display-background-properties)) (make-local-variable 'track-mouse) - (set (make-local-variable 'buffer-access-fontify-functions) 'w3-e19-no-read-only) + ;(set (make-local-variable 'buffer-access-fontify-functions) 'w3-e19-no-read-only) (if w3-track-mouse (setq track-mouse t)) (if w3-display-background-properties (let ((face (w3-make-face (intern
--- a/lisp/w3/w3-hot.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/w3-hot.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-hot.el --- Main functions for emacs-w3 on all platforms/versions ;; Author: wmperry -;; Created: 1997/05/09 04:30:54 -;; Version: 1.14 +;; Created: 1997/06/10 05:42:43 +;; Version: 1.15 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -157,7 +157,7 @@ (set-buffer save-buf) (rename-buffer (concat "Hotlist during " regexp)))) (unwind-protect - (progn + (let ((w3-reuse-buffers 'no)) (w3-show-hotlist) (rename-buffer (concat "Hotlist \"" regexp "\"")) (url-set-filename url-current-object (concat "hotlist/" regexp)))
--- a/lisp/w3/w3-menu.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/w3-menu.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-menu.el --- Menu functions for emacs-w3 ;; Author: wmperry -;; Created: 1997/04/17 15:50:07 -;; Version: 1.37 +;; Created: 1997/06/24 13:59:48 +;; Version: 1.40 ;; Keywords: menu, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -28,6 +28,18 @@ (require 'w3-vars) (require 'w3-mouse) +(require 'widget) + +(define-widget-keywords :href :src :title) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; InfoDock stuff +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(if (not (fboundp 'id-menubar-set)) + (fset 'id-menubar-set 'ignore)) + +(id-menubar-set 'w3-mode 'w3-menu-make-xemacs-menubar) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Spiffy new menus (for both Emacs and XEmacs) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -143,10 +155,10 @@ (while widgets (setq widget (car widgets) widgets (cdr widgets) - href (widget-get widget 'href) + href (widget-get widget :href) menu (cons (vector (w3-truncate-menu-item - (or (widget-get widget 'title) + (or (widget-get widget :title) (w3-fix-spaces (buffer-substring (widget-get widget :from) @@ -553,10 +565,12 @@ (defun w3-menu-install-menubar () (cond (w3-running-xemacs - (if (not (featurep 'menubar)) - nil ; No menus available + (cond + ((not (featurep 'menubar)) nil) ; No menus available + ((featurep 'infodock) nil) ; InfoDock does it automatically + (t (setq w3-menu-w3-menubar (w3-menu-make-xemacs-menubar)) - (set-buffer-menubar w3-menu-w3-menubar))) + (set-buffer-menubar w3-menu-w3-menubar)))) ((not (fboundp 'vm-menu-undo-menu)) (w3-menu-initialize-w3-mode-menu-map) (define-key w3-mode-map [menu-bar] @@ -707,10 +721,10 @@ (widget (or (and glyph (glyph-property glyph 'widget)) (widget-at (point)))) (parent (and widget (widget-get widget :parent))) - (href (or (and widget (widget-get widget 'href)) - (and parent (widget-get parent 'href)))) - (imag (or (and widget (widget-get widget 'src)) - (and parent (widget-get parent 'src)))) + (href (or (and widget (widget-get widget :href)) + (and parent (widget-get parent :href)))) + (imag (or (and widget (widget-get widget :src)) + (and parent (widget-get parent :src)))) (menu (copy-tree w3-popup-menu)) url val trunc-url) (if href
--- a/lisp/w3/w3-mouse.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/w3-mouse.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-menu.el --- Mouse specific functions for emacs-w3 ;; Author: wmperry -;; Created: 1997/03/23 03:08:58 -;; Version: 1.8 +;; Created: 1997/06/20 18:56:21 +;; Version: 1.12 ;; Keywords: mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -54,36 +54,39 @@ (w3-fetch (widget-get widget 'src))))) (defvar w3-mouse-button1 (cond + ((featurep 'infodock) nil) ((and w3-running-xemacs (featurep 'mouse)) 'button1) (w3-running-xemacs nil) - (t 'mouse-1))) + (t 'down-mouse-1))) (defvar w3-mouse-button2 (cond + ((featurep 'infodock) nil) ((and w3-running-xemacs (featurep 'mouse)) 'button2) (w3-running-xemacs nil) - (t 'mouse-2))) + (t 'down-mouse-2))) (defvar w3-mouse-button3 (cond + ((featurep 'infodock) nil) ((and w3-running-xemacs (featurep 'mouse)) 'button3) (w3-running-xemacs nil) - (t 'mouse-3))) + (t 'down-mouse-3))) -(if w3-mouse-button2 - (define-key w3-mode-map (vector w3-mouse-button2) 'w3-widget-button-click)) (if w3-mouse-button3 (define-key w3-mode-map (vector w3-mouse-button3) 'w3-popup-menu)) + +(if w3-mouse-button1 + (define-key w3-netscape-emulation-minor-mode-map + (vector w3-mouse-button1) 'w3-widget-button-click)) + (if w3-mouse-button2 - (define-key w3-mode-map (vector (list 'shift w3-mouse-button2)) - 'w3-follow-mouse-other-frame)) - -(define-key w3-netscape-emulation-minor-mode-map (vector w3-mouse-button1) - 'w3-widget-button-click) -(define-key w3-netscape-emulation-minor-mode-map (vector w3-mouse-button2) - 'w3-follow-mouse-other-frame) + (progn + (define-key w3-mode-map (vector (list 'meta w3-mouse-button2)) + 'w3-follow-mouse-other-frame) + (define-key w3-netscape-emulation-minor-mode-map + (vector w3-mouse-button2) 'w3-follow-mouse-other-frame))) (if w3-running-FSF19 (progn (define-key w3-mode-map [mouse-movement] 'w3-mouse-handler) (if w3-popup-menu-on-mouse-3 (define-key w3-mode-map [down-mouse-3] 'w3-popup-menu)))) - (provide 'w3-mouse)
--- a/lisp/w3/w3-parse.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/w3-parse.el Mon Aug 13 09:44:42 2007 +0200 @@ -1246,11 +1246,16 @@ nil ;; Push <P> before data characters. Non-SGML. (((%text) p) + ;; Some stupid sites put meta tags in the + ;; middle of their documents. Sigh. + ;; Allow it, but bitch and moan. + ((meta) *include *same "not allowed here") ;; Closing when seeing CREDIT is a stupidity ;; caused by BQ's sharing of BODYTEXT. BQ ;; should have its own BQTEXT. ((credit plaintext) *close)) - nil)]) + nil) + ]) (end-tag-omissible . t)) ((div banner center multicol) (content-model . [((%body.content) @@ -1949,12 +1954,14 @@ BUFF defaults to the value of url-working-buffer. Destructively alters contents of BUFF. Returns a data structure containing the parsed information." - + (if (not w3-setup-done) (w3-do-setup)) (set-buffer (or buff url-working-buffer)) (setq buff (current-buffer)) (set-syntax-table w3-sgml-md-syntax-table) (buffer-disable-undo (current-buffer)) (widen) ; sanity checking + (goto-char (point-max)) + (insert "\n") (goto-char (point-min)) (setq case-fold-search t) ; allows smaller regexp patterns
--- a/lisp/w3/w3-sysdp.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/w3-sysdp.el Mon Aug 13 09:44:42 2007 +0200 @@ -327,12 +327,6 @@ (if tail (setcdr tail new-parent)))) -(sysdep-defun buffer-substring-no-properties (st nd) - "Return the characters of part of the buffer, without the text properties. -The two arguments START and END are character positions; -they can be in either order." - (buffer-substring st nd)) - ;; Property list functions ;; (sysdep-defun plist-put (plist prop val)
--- a/lisp/w3/w3-toolbar.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/w3-toolbar.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-toolbar.el --- Toolbar functions for emacs-w3 ;; Author: wmperry -;; Created: 1997/03/26 00:01:47 -;; Version: 1.9 +;; Created: 1997/06/20 18:31:25 +;; Version: 1.10 ;; Keywords: mouse, toolbar ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -329,7 +329,8 @@ (popup-dialog-box descr))) (defun w3-add-toolbar-to-buffer () - (if (not (featurep 'toolbar)) + (if (or (not (featurep 'toolbar)) + (featurep 'infodock)) ; InfoDock uses different toolbars nil (let ((toolbar (w3-toolbar-from-orientation w3-toolbar-orientation))) (if toolbar
--- a/lisp/w3/w3-vars.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/w3-vars.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-vars.el,v --- All variable definitions for emacs-w3 ;; Author: wmperry -;; Created: 1997/05/09 06:21:55 -;; Version: 1.129 +;; Created: 1997/06/25 15:58:53 +;; Version: 1.143 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -31,9 +31,10 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'w3-cus) ; Grab everything that is customized +(require 'wid-edit) ; For `widget-keymap' (defconst w3-version-number - (let ((x "p3.0.86")) + (let ((x "p3.0.92")) (if (string-match "State:[ \t\n]+.\\([^ \t\n]+\\)" x) (setq x (substring x (match-beginning 1) (match-end 1))) (setq x (substring x 1))) @@ -41,7 +42,7 @@ (function (lambda (x) (if (= x ?-) "." (char-to-string x)))) x "")) "Version # of w3-mode.") -(defconst w3-version-date (let ((x "1997/05/09 06:21:55")) +(defconst w3-version-date (let ((x "1997/06/25 15:58:53")) (if (string-match "Date: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x)) @@ -76,11 +77,11 @@ ;;; Figure out what flavor of emacs we are running ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar w3-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version) - "*In XEmacs?.") + "*Got XEmacs?.") (defvar w3-running-FSF19 (and (string-match "^19" emacs-version) (not w3-running-xemacs)) - "*In FSF v19 emacs?") + "*Got Emacs 19?") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Store the database of HTML general entities. @@ -502,8 +503,9 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Keymap definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-mode-map (make-keymap) "Keymap to use in w3-mode.") +(defvar w3-mode-map (make-sparse-keymap) "Keymap to use in w3-mode.") (suppress-keymap w3-mode-map) +(set-keymap-parent w3-mode-map widget-keymap) (define-key w3-mode-map "h" (make-sparse-keymap)) (define-key w3-mode-map "H" (make-sparse-keymap)) @@ -547,8 +549,6 @@ (define-key w3-mode-map "\M-m" 'w3-mail-current-document) (define-key w3-mode-map "\M-s" 'w3-save-as) (define-key w3-mode-map "\M-\r" 'w3-follow-inlined-image) -(define-key w3-mode-map "\r" 'w3-widget-button-press) -(define-key w3-mode-map "\n" 'w3-widget-button-press) (define-key w3-mode-map "b" 'w3-widget-backward) (define-key w3-mode-map "c" 'w3-mail-document-author) (define-key w3-mode-map "d" 'w3-download-this-url) @@ -573,13 +573,17 @@ (define-key w3-mode-map [(control meta t)] 'url-list-processes) ;; Widget navigation -(define-key w3-mode-map [tab] 'w3-widget-forward) -(define-key w3-mode-map "\t" 'w3-widget-forward) -(define-key w3-mode-map "\M-\t" 'w3-widget-backward) -(define-key w3-mode-map [backtab] 'w3-widget-backward) -(define-key w3-mode-map [(shift tab)] 'w3-widget-backward) -(define-key w3-mode-map [(meta tab)] 'w3-widget-backward) - +(if t + nil + (define-key w3-mode-map "\r" 'w3-widget-button-press) + (define-key w3-mode-map "\n" 'w3-widget-button-press) + (define-key w3-mode-map [tab] 'w3-widget-forward) + (define-key w3-mode-map "\t" 'w3-widget-forward) + (define-key w3-mode-map "\M-\t" 'w3-widget-backward) + (define-key w3-mode-map [backtab] 'w3-widget-backward) + (define-key w3-mode-map [(shift tab)] 'w3-widget-backward) + (define-key w3-mode-map [(meta tab)] 'w3-widget-backward) + ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Keyword definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--- a/lisp/w3/w3.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/w3/w3.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions ;; Author: wmperry -;; Created: 1997/05/09 04:54:28 -;; Version: 1.119 +;; Created: 1997/06/24 22:38:28 +;; Version: 1.130 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -71,6 +71,7 @@ (require 'w3-sysdp) (require 'mule-sysdp) +(require 'widget) (or (featurep 'efs) (featurep 'efs-auto) @@ -641,7 +642,7 @@ hdrs) '>))) (fmtstring (format " <tr><td align=right>%%%ds:</td><td>%%s</td></tr>" maxlength))) - (insert " <tr><th>MetaInformation</th></tr>\n" + (insert " <tr><th colspan=2>MetaInformation</th></tr>\n" (mapconcat (function (lambda (x) @@ -667,7 +668,7 @@ info) '>))) (fmtstring (format " <tr><td>%%%ds:</td><td>%%s</td></tr>" maxlength))) - (insert " <tr><th>Miscellaneous Variables</th></tr>\n") + (insert " <tr><th colspan=2>Miscellaneous Variables</th></tr>\n") (while info (insert (format fmtstring (url-insert-entities-in-string @@ -1332,7 +1333,7 @@ (defun w3-load-flavors () - ;; Load the correct zone/font info for each flavor of emacs + ;; Load the correct emacsen specific stuff (cond ((and w3-running-xemacs (eq system-type 'ms-windows)) (error "WinEmacs no longer supported.")) @@ -1689,7 +1690,9 @@ "View the URL of the link under point" (interactive) (let* ((widget (widget-at (point))) - (href (and widget (widget-get widget 'href)))) + (parent (and widget (widget-get widget :parent))) + (href (or (and widget (widget-get widget 'href)) + (and parent (widget-get parent 'href))))) (cond ((and no-show href) href) @@ -1848,17 +1851,17 @@ BUFFER, the end of BUFFER, nil, and (current-buffer), respectively." (let ((cur (point-min)) (widget nil) - (parent nil)) - (while (setq cur (next-single-property-change cur 'button)) - (setq widget (widget-at cur) + (parent nil) + (overlays (overlay-lists))) + (setq overlays (append (car overlays) (cdr overlays))) + (while (setq cur (pop overlays)) + (setq widget (overlay-get cur 'button) parent (and widget (widget-get widget :parent))) - ;; Check to see if its a push widget, its got the correct callback, - ;; and actually has a URL. Remember the url as a side-effect of the - ;; test for later use. + ;; Check to see if its got a URL tacked on it somewhere (cond - ((and widget (widget-get widget 'href)) + ((and widget (widget-get widget :href)) (funcall function widget maparg)) - ((and parent (widget-get parent 'href)) + ((and parent (widget-get parent :href)) (funcall function parent maparg)) (t nil))))) @@ -1918,6 +1921,8 @@ (concat data-directory "w3/") (expand-file-name "../../w3" data-directory) (file-name-directory (locate-library "w3")) + (expand-file-name "../w3" (file-name-directory + (locate-library "w3"))) w3-configuration-directory)) (total-found 0) (possible (append @@ -1972,12 +1977,11 @@ (url-register-protocol 'www 'w3-internal-url 'w3-internal-expander) (w3-load-flavors) (w3-setup-version-specifics) + (setq w3-setup-done t) (setq w3-default-configuration-file (expand-file-name (or w3-default-configuration-file "profile") w3-configuration-directory)) - - (if (and init-file-user w3-default-configuration-file (file-exists-p w3-default-configuration-file)) @@ -2058,8 +2062,7 @@ ; Set up the entity definition for PGP and PEM authentication - (run-hooks 'w3-load-hook) - (setq w3-setup-done t)) + (run-hooks 'w3-load-hook)) (defun w3-mark-link-as-followed (ext dat) ;; Mark a link as followed @@ -2067,13 +2070,9 @@ (defun w3-only-links () (let* (result temp) - (if (widget-at (point-min)) - (setq result (list (widget-at (point-min))))) - (setq temp (w3-next-widget (point-min))) - (while temp - (if (widget-get temp 'href) - (setq result (cons temp result))) - (setq temp (w3-next-widget (widget-get temp :to)))) + (w3-map-links (function + (lambda (x y) + (setq result (cons x result))))) result)) (defun w3-download-callback (fname buff) @@ -2085,7 +2084,7 @@ (write-file-hooks nil) (write-contents-hooks nil) (enable-multibyte-characters t) ; mule 2.4 - (coding-system-for-write mule-no-coding-system) ; (X)Emacs/mule + (buffer-file-coding-system mule-no-coding-system) ; mule 2.4 (file-coding-system mule-no-coding-system) ; mule 2.3 (mc-flag t)) ; mule 2.3 (write-file fname) @@ -2163,7 +2162,6 @@ (t (w3-fetch href))))) -;;; FIXME! Need to rewrite these so that we can pass a predicate to (defun w3-widget-forward (arg) "Move point to the next field or button. With optional ARG, move across that many fields." @@ -2251,16 +2249,18 @@ ;; Oh gross, this kills buffer-local faces in XEmacs ;;(kill-all-local-variables) (use-local-map w3-mode-map) - (setq major-mode 'w3-mode) (setq mode-name "WWW") (mapcar (function (lambda (x) (set-variable (car x) (cdr x)))) tmp) + (setq major-mode 'w3-mode) (w3-mode-version-specifics) (w3-menu-install-menus) (setq url-current-passwd-count 0 - inhibit-read-only nil truncate-lines t mode-line-format w3-modeline-format) (run-hooks 'w3-mode-hook) + ;; Avoid calling the global bindings for RET and mouse-2. + (make-local-variable 'widget-global-map) + (setq widget-global-map (make-sparse-keymap)) (widget-setup) (if w3-current-isindex (setq mode-line-process "-Searchable")))))
--- a/lisp/x11/auto-autoloads.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/x11/auto-autoloads.el Mon Aug 13 09:44:42 2007 +0200 @@ -1,6 +1,9 @@ ;;; DO NOT MODIFY THIS FILE (if (not (featurep 'x11-autoloads)) (progn + +(provide 'x11-autoloads) +)) ;;;### (autoloads (font-menu-weight-constructor font-menu-size-constructor font-menu-family-constructor reset-device-font-menus) "x-font-menu" "x11/x-font-menu.el") @@ -28,6 +31,3 @@ (autoload 'font-menu-weight-constructor "x-font-menu" nil nil nil) ;;;*** - -(provide 'x11-autoloads) -))
--- a/lisp/x11/custom-load.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/x11/custom-load.el Mon Aug 13 09:44:42 2007 +0200 @@ -52,7 +52,6 @@ (put 'diary 'custom-loads '()) (put 'browse-url 'custom-loads '()) (put 'message-insertion 'custom-loads '()) -(put 'hyper-apropos 'custom-loads '()) (put 'vc 'custom-loads '()) (put 'alloc 'custom-loads '()) (put 'isearch 'custom-loads '())
--- a/lisp/x11/x-menubar.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/x11/x-menubar.el Mon Aug 13 09:44:42 2007 +0200 @@ -82,14 +82,16 @@ ["Replace (Regexp)..." query-replace-regexp t] "----" ("Bookmarks" - ["Jump to bookmark" bookmark-menu-jump t] + ("Jump to bookmark" + :filter bookmark-menu-filter) ["Set bookmark" bookmark-set t] "---" ["Insert contents" bookmark-menu-insert t] ["Insert location" bookmark-menu-locate t] "---" ["Rename bookmark" bookmark-menu-rename t] - ["Delete bookmark" bookmark-menu-delete t] + ("Delete bookmark" + :filter bookmark-delete-filter) ["Edit Bookmark List" bookmark-bmenu-list t] "---" ["Save bookmarks" bookmark-save t] @@ -106,11 +108,11 @@ ,@(if (featurep 'mule) '(("Mule" - ["Describe language support" - mule-describe-language-support-prefix nil] ; not implemented yet - ["Set language environment" - mule-set-language-environment-prefix nil] ; not implemented yet - "--" + ;; ["Describe language support" + ;; mule-describe-language-support-prefix nil] + ;; ["Set language environment" + ;; mule-set-language-environment-prefix nil] + ;; "--" ["Toggle input method" toggle-input-method t] ["Select input method" select-input-method t] ["Describe input method" describe-input-method t] @@ -836,6 +838,24 @@ result)) +;;; The Bookmarks menu + +(defun bookmark-menu-filter (menu-items) + "*Build the bookmark jump submenu dynamically from all defined bookmarks." + (if (bookmark-all-names) + (mapcar + #'(lambda (bmk) + (vector bmk `(bookmark-jump ',bmk) t)) (bookmark-all-names)) + (list "No Bookmarks Set"))) + +(defun bookmark-delete-filter (menu-items) + "*Build the bookmark delete submenu dynamically from all defined bookmarks." + (if (bookmark-all-names) + (mapcar + #'(lambda (bmk) + (vector bmk `(bookmark-delete ',bmk) t)) (bookmark-all-names)) + (list "No Bookmarks Set"))) + ;;; The Buffers menu (defvar buffers-menu-max-size 25
--- a/lisp/x11/x-toolbar.el Mon Aug 13 09:43:39 2007 +0200 +++ b/lisp/x11/x-toolbar.el Mon Aug 13 09:44:42 2007 +0200 @@ -160,8 +160,7 @@ (elm . (toolbar-external "xterm" "-e" "elm")) (mutt . (toolbar-external "xterm" "-e" "mutt")) (exmh . (toolbar-external "exmh")) - ;; How to turn on netscape mail, command-line?? - (netscape . (toolbar-external "netscape"))) + (netscape . (toolbar-external "netscape" "mailbox:"))) "*Alist of mail readers and their commands. The car of each alist element is the mail reader, and the cdr is the form used to start it."
--- a/lwlib/lwlib-Xaw.c Mon Aug 13 09:43:39 2007 +0200 +++ b/lwlib/lwlib-Xaw.c Mon Aug 13 09:44:42 2007 +0200 @@ -70,25 +70,19 @@ scrollbar_values *data = val->scrollbar_data; float widget_shown, widget_topOfThumb; float new_shown, new_topOfThumb; + Arg al [10]; - /* - * First size and position the scrollbar widget. - */ - XtVaSetValues (widget, - XtNx, data->scrollbar_x, - XtNy, data->scrollbar_y, - XtNwidth, data->scrollbar_width, - XtNheight, data->scrollbar_height, - NULL); + /* First size and position the scrollbar widget. */ + XtSetArg (al [0], XtNx, data->scrollbar_x); + XtSetArg (al [1], XtNy, data->scrollbar_y); + XtSetArg (al [2], XtNwidth, data->scrollbar_width); + XtSetArg (al [3], XtNheight, data->scrollbar_height); + XtSetValues (widget, al, 4); - /* - * Now the size the scrollbar's slider. - */ - - XtVaGetValues (widget, - XtNtopOfThumb, &widget_topOfThumb, - XtNshown, &widget_shown, - NULL); + /* Now size the scrollbar's slider. */ + XtSetArg (al [0], XtNtopOfThumb, &widget_topOfThumb); + XtSetArg (al [1], XtNshown, &widget_shown); + XtGetValues (widget, al, 2); new_shown = (double) data->slider_size / (double) (data->maximum - data->minimum); @@ -98,12 +92,12 @@ if (new_shown > 1.0) new_shown = 1.0; - if (new_shown < 0) + else if (new_shown < 0) new_shown = 0; if (new_topOfThumb > 1.0) new_topOfThumb = 1.0; - if (new_topOfThumb < 0) + else if (new_topOfThumb < 0) new_topOfThumb = 0; if (new_shown != widget_shown || new_topOfThumb != widget_topOfThumb) @@ -127,12 +121,16 @@ #ifdef DIALOGS_ATHENA else if (XtIsSubclass (widget, dialogWidgetClass)) { - XtVaSetValues (widget, XtNlabel, val->contents->value, NULL); + Arg al [1]; + XtSetArg (al [0], XtNlabel, val->contents->value); + XtSetValues (widget, al, 1); } else if (XtIsSubclass (widget, commandWidgetClass)) { Dimension bw = 0; - XtVaGetValues (widget, XtNborderWidth, &bw, NULL); + Arg al [3]; + XtSetArg (al [0], XtNborderWidth, &bw); + XtGetValues (widget, al, 1); #ifndef LWLIB_DIALOGS_ATHENA3D if (bw == 0) @@ -142,15 +140,17 @@ that I don't feel like opening right now. Making Athena widgets not look like shit is just entirely too much work. */ - XtVaSetValues (widget, XtNborderWidth, 1, NULL); + { + XtSetArg (al [0], XtNborderWidth, 1); + XtSetValues (widget, al, 1); + } #endif - XtVaSetValues (widget, - XtNlabel, val->value, - XtNsensitive, val->enabled, - /* Force centered button text. Se above. */ - XtNjustify, XtJustifyCenter, - NULL); + XtSetArg (al [0], XtNlabel, val->value); + XtSetArg (al [1], XtNsensitive, val->enabled); + /* Force centered button text. See above. */ + XtSetArg (al [2], XtNjustify, XtJustifyCenter); + XtSetValues (widget, al, 3); XtRemoveAllCallbacks (widget, XtNcallback); XtAddCallback (widget, XtNcallback, xaw_generic_callback, instance); @@ -452,7 +452,11 @@ #if 0 user_data = NULL; - XtVaGetValues (widget, XtNuserData, &user_data, NULL); + { + Arg al [1]; + XtSetArg (al [0], XtNuserData, &user_data); + XtGetValues (widget, al, 1); + } #else /* Damn! Athena doesn't give us a way to hang our own data on the buttons, so we have to go find it... I guess this assumes that @@ -483,9 +487,11 @@ LWLIB_ID id; Widget *kids = 0; Widget widget; + Arg al [1]; if (! XtIsSubclass (shell, shellWidgetClass)) abort (); - XtVaGetValues (shell, XtNchildren, &kids, NULL); + XtSetArg (al [0], XtNchildren, &kids); + XtGetValues (shell, al, 1); if (!kids || !*kids) abort (); widget = kids [0];
--- a/lwlib/lwlib-Xlw.c Mon Aug 13 09:43:39 2007 +0200 +++ b/lwlib/lwlib-Xlw.c Mon Aug 13 09:44:42 2007 +0200 @@ -106,11 +106,12 @@ static Widget xlw_create_menubar (widget_instance* instance) { - Widget widget = - XtVaCreateWidget (instance->info->name, xlwMenuWidgetClass, - instance->parent, - XtNmenu, instance->info->val, - NULL); + Arg al [1]; + Widget widget; + + XtSetArg (al [0], XtNmenu, instance->info->val); + widget = XtCreateWidget (instance->info->name, xlwMenuWidgetClass, + instance->parent, al, 1); XtAddCallback (widget, XtNopen, pre_hook, (XtPointer)instance); XtAddCallback (widget, XtNselect, pick_hook, (XtPointer)instance); return widget; @@ -119,17 +120,16 @@ static Widget xlw_create_popup_menu (widget_instance* instance) { - Widget popup_shell = - XtCreatePopupShell (instance->info->name, overrideShellWidgetClass, - instance->parent, NULL, 0); + Arg al [2]; + Widget popup_shell, widget; - Widget widget = - XtVaCreateManagedWidget ("popup", xlwMenuWidgetClass, - popup_shell, - XtNmenu, instance->info->val, - XtNhorizontal, False, - NULL); - + popup_shell = XtCreatePopupShell (instance->info->name, + overrideShellWidgetClass, + instance->parent, NULL, 0); + XtSetArg (al [0], XtNmenu, instance->info->val); + XtSetArg (al [1], XtNhorizontal, False); + widget = XtCreateManagedWidget ("popup", xlwMenuWidgetClass, + popup_shell, al, 2); XtAddCallback (widget, XtNselect, pick_hook, (XtPointer)instance); return popup_shell; @@ -262,20 +262,19 @@ int widget_sliderSize, widget_val; int new_sliderSize, new_value; double percent; + Arg al [4]; /* First size and position the scrollbar widget. */ - XtVaSetValues (widget, - XtNx, data->scrollbar_x, - XtNy, data->scrollbar_y, - XtNwidth, data->scrollbar_width, - XtNheight, data->scrollbar_height, - NULL); + XtSetArg (al [0], XtNx, data->scrollbar_x); + XtSetArg (al [1], XtNy, data->scrollbar_y); + XtSetArg (al [2], XtNwidth, data->scrollbar_width); + XtSetArg (al [3], XtNheight, data->scrollbar_height); + XtSetValues (widget, al, 4); /* Now size the scrollbar's slider. */ - XtVaGetValues (widget, - XmNsliderSize, &widget_sliderSize, - XmNvalue, &widget_val, - NULL); + XtSetArg (al [0], XmNsliderSize, &widget_sliderSize); + XtSetArg (al [1], XmNvalue, &widget_val); + XtGetValues (widget, al, 2); percent = (double) data->slider_size / (double) (data->maximum - data->minimum); @@ -288,14 +287,14 @@ new_value = (int) ((double) (INT_MAX - 1) * percent); if (new_sliderSize > INT_MAX - 1) - new_sliderSize = INT_MAX - 1; - if (new_sliderSize < 1) - new_sliderSize = 1; + new_sliderSize = INT_MAX - 1; + else if (new_sliderSize < 1) + new_sliderSize = 1; if (new_value > (INT_MAX - new_sliderSize)) - new_value = INT_MAX - new_sliderSize; + new_value = INT_MAX - new_sliderSize; else if (new_value < 1) - new_value = 1; + new_value = 1; if (new_sliderSize != widget_sliderSize || new_value != widget_val) XlwScrollBarSetValues (widget, new_value, new_sliderSize, 1, 1, False); @@ -353,11 +352,13 @@ else if (class == xlwMenuWidgetClass) { XlwMenuWidget mw; + Arg al [1]; if (XtIsShell (widget)) mw = (XlwMenuWidget)((CompositeWidget)widget)->composite.children [0]; else mw = (XlwMenuWidget)widget; - XtVaSetValues (widget, XtNmenu, val, NULL); + XtSetArg (al [0], XtNmenu, val); + XtSetValues (widget, al, 1); } #endif #ifdef SCROLLBARS_LUCID
--- a/lwlib/lwlib-Xm.c Mon Aug 13 09:43:39 2007 +0200 +++ b/lwlib/lwlib-Xm.c Mon Aug 13 09:44:42 2007 +0200 @@ -227,14 +227,12 @@ static void xm_update_label (widget_instance* instance, Widget widget, widget_value* val) { - XmString built_string = 0; - XmString key_string = 0; - XmString val_string = 0; - XmString name_string = 0; - Arg al [256]; - int ac; - - ac = 0; + XmString built_string = NULL; + XmString key_string = NULL; + XmString val_string = NULL; + XmString name_string = NULL; + Arg al [20]; + int ac = 0; if (val->value) { @@ -258,7 +256,7 @@ XmStringCreateLtoR (value_name, XmSTRING_DEFAULT_CHARSET); } else -#endif +#endif /* DIALOGS_MOTIF */ { char *value_name = NULL; char *res_name = NULL; @@ -335,7 +333,9 @@ xm_update_pushbutton (widget_instance* instance, Widget widget, widget_value* val) { - XtVaSetValues (widget, XmNalignment, XmALIGNMENT_CENTER, NULL); + Arg al [1]; + XtSetArg (al [0], XmNalignment, XmALIGNMENT_CENTER); + XtSetValues (widget, al, 1); XtRemoveAllCallbacks (widget, XmNactivateCallback); XtAddCallback (widget, XmNactivateCallback, xm_generic_callback, instance); } @@ -374,16 +374,18 @@ static void xm_update_toggle (widget_instance* instance, Widget widget, widget_value* val) { + Arg al [2]; XtRemoveAllCallbacks (widget, XmNvalueChangedCallback); #ifndef ENERGIZE XtAddCallback (widget, XmNvalueChangedCallback, xm_generic_callback, instance); #else - XtAddCallback (widget, XmNvalueChangedCallback, - xm_internal_update_other_instances, instance); -#endif - XtVaSetValues (widget, XmNset, val->selected, - XmNalignment, XmALIGNMENT_BEGINNING, NULL); + XtAddCallback (widget, XmNvalueChangedCallback, + xm_internal_update_other_instances, instance); +#endif + XtSetArg (al [0], XmNset, val->selected); + XtSetArg (al [1], XmNalignment, XmALIGNMENT_BEGINNING); + XtSetValues (widget, al, 2); } static void @@ -408,11 +410,10 @@ toggle = XtNameToWidget (widget, cur->value); if (toggle) { - XtVaSetValues (toggle, XmNsensitive, cur->enabled, NULL); - if (!val->value && cur->selected) - XtVaSetValues (toggle, XmNset, cur->selected, NULL); - if (val->value && strcmp (val->value, cur->value)) - XtVaSetValues (toggle, XmNset, False, NULL); + Arg al [2]; + XtSetArg (al [0], XmNsensitive, cur->enabled); + XtSetArg (al [1], XmNset, (!val->value && cur->selected ? cur->selected : False)); + XtSetValues (toggle, al, 2); } } @@ -421,7 +422,11 @@ { toggle = XtNameToWidget (widget, val->value); if (toggle) - XtVaSetValues (toggle, XmNset, True, NULL); + { + Arg al [1]; + XtSetArg (al [0], XmNset, True); + XtSetValues (toggle, al, 1); + } } } @@ -440,15 +445,15 @@ Widget menu; Arg al [256]; int ac; - Boolean menubar_p; + Boolean menubar_p = False; /* Allocate the children array */ for (num_children = 0, cur = val; cur; num_children++, cur = cur->next); children = (Widget*)XtMalloc (num_children * sizeof (Widget)); /* tricky way to know if this RowColumn is a menubar or a pulldown... */ - menubar_p = False; - XtVaGetValues (widget, XmNisHomogeneous, &menubar_p, NULL); + XtSetArg (al [0], XmNisHomogeneous, &menubar_p); + XtGetValues (widget, al, 1); /* add the unmap callback for popups and pulldowns */ /*** this sounds bogus ***/ @@ -503,15 +508,9 @@ button = XmCreateLabel (widget, cur->name, al, ac); else if (cur->type == TOGGLE_TYPE || cur->type == RADIO_TYPE) { - if (cur->type == TOGGLE_TYPE) - { - XtSetArg (al [ac], XmNindicatorType, XmN_OF_MANY); ac++; - } - else - { - XtSetArg (al [ac], XmNindicatorType, XmONE_OF_MANY); ac++; - } - + XtSetArg (al [ac], XmNindicatorType, + (cur->type == TOGGLE_TYPE ? + XmN_OF_MANY : XmONE_OF_MANY)); ac++; XtSetArg (al [ac], XmNvisibleWhenOff, True); ac++; button = XmCreateToggleButtonGadget (widget, cur->name, al, ac); } @@ -555,8 +554,7 @@ update_one_menu_entry (widget_instance* instance, Widget widget, widget_value* val, Boolean deep_p) { - Arg al [256]; - int ac; + Arg al [2]; Widget menu; widget_value* contents; @@ -565,10 +563,9 @@ /* update the sensitivity and userdata */ /* Common to all widget types */ - XtVaSetValues (widget, - XmNsensitive, val->enabled, - XmNuserData, val->call_data, - NULL); + XtSetArg (al [0], XmNsensitive, val->enabled); + XtSetArg (al [1], XmNuserData, val->call_data); + XtSetValues (widget, al, 2); /* update the menu button as a label. */ if (val->change >= VISIBLE_CHANGE) @@ -584,7 +581,8 @@ /* update the pulldown/pullaside as needed */ menu = NULL; - XtVaGetValues (widget, XmNsubMenuId, &menu, NULL); + XtSetArg (al [0], XmNsubMenuId, &menu); + XtGetValues (widget, al, 1); contents = val->contents; @@ -713,25 +711,19 @@ int new_sliderSize, new_value; double percent; double h_water, l_water; + Arg al [4]; - /* - * First size and position the scrollbar widget. - */ - XtVaSetValues (widget, - XtNx, data->scrollbar_x, - XtNy, data->scrollbar_y, - XtNwidth, data->scrollbar_width, - XtNheight, data->scrollbar_height, - NULL); + /* First size and position the scrollbar widget. */ + XtSetArg (al [0], XtNx, data->scrollbar_x); + XtSetArg (al [1], XtNy, data->scrollbar_y); + XtSetArg (al [2], XtNwidth, data->scrollbar_width); + XtSetArg (al [3], XtNheight, data->scrollbar_height); + XtSetValues (widget, al, 4); - /* - * Now the size the scrollbar's slider. - */ - - XtVaGetValues (widget, - XmNsliderSize, &widget_sliderSize, - XmNvalue, &widget_val, - NULL); + /* Now size the scrollbar's slider. */ + XtSetArg (al [0], XmNsliderSize, &widget_sliderSize); + XtSetArg (al [1], XmNvalue, &widget_val); + XtGetValues (widget, al, 2); percent = (double) data->slider_size / (double) (data->maximum - data->minimum); @@ -743,7 +735,7 @@ if (new_sliderSize > (INT_MAX - 1)) new_sliderSize = INT_MAX - 1; - if (new_sliderSize < 1) + else if (new_sliderSize < 1) new_sliderSize = 1; if (new_value > (INT_MAX - new_sliderSize)) @@ -782,15 +774,15 @@ widget_value* val, Boolean deep_p) { WidgetClass class; + Arg al [2]; /* Mark as not edited */ val->edited = False; /* Common to all widget types */ - XtVaSetValues (widget, - XmNsensitive, val->enabled, - XmNuserData, val->call_data, - NULL); + XtSetArg (al [0], XmNsensitive, val->enabled); + XtSetArg (al [1], XmNuserData, val->call_data); + XtSetValues (widget, al, 2); #if defined (DIALOGS_MOTIF) || defined (MENUBARS_MOTIF) /* Common to all label like widgets */ @@ -819,8 +811,9 @@ else if (class == xmRowColumnWidgetClass) { Boolean radiobox = 0; - - XtVaGetValues (widget, XmNradioBehavior, &radiobox, NULL); + + XtSetArg (al [0], XmNradioBehavior, &radiobox); + XtGetValues (widget, al, 1); if (radiobox) xm_update_radiobox (instance, widget, val); @@ -869,7 +862,9 @@ if (class == xmToggleButtonWidgetClass || class == xmToggleButtonGadgetClass) { - XtVaGetValues (widget, XmNset, &val->selected, NULL); + Arg al [1]; + XtSetArg (al [0], XmNset, &val->selected); + XtGetValues (widget, al, 1); val->edited = True; } #ifdef DIALOGS_MOTIF @@ -891,8 +886,10 @@ else if (class == xmRowColumnWidgetClass) { Boolean radiobox = 0; + Arg al [1]; - XtVaGetValues (widget, XmNradioBehavior, &radiobox, NULL); + XtSetArg (al [0], XmNradioBehavior, &radiobox); + XtGetValues (widget, al, 1); if (radiobox) { @@ -902,8 +899,10 @@ { int set = False; Widget toggle = radio->composite.children [i]; - - XtVaGetValues (toggle, XmNset, &set, NULL); + Arg al [1]; + + XtSetArg (al [0], XmNset, &set); + XtGetValues (toggle, al, 1); if (set) { if (val->value) @@ -1347,13 +1346,18 @@ Dimension child_height = 0; Position x; Position y; + Arg al [2]; - XtVaGetValues (widget, XtNwidth, &child_width, XtNheight, &child_height, NULL); - XtVaGetValues (parent, XtNwidth, &parent_width, XtNheight, &parent_height, - NULL); + XtSetArg (al [0], XtNwidth, &child_width); + XtSetArg (al [1], XtNheight, &child_height); + XtGetValues (widget, al, 2); - x = (((Position)parent_width) - ((Position)child_width)) / 2; - y = (((Position)parent_height) - ((Position)child_height)) / 2; + XtSetArg (al [0], XtNwidth, &parent_width); + XtSetArg (al [1], XtNheight, &parent_height); + XtGetValues (parent, al, 2); + + x = (Position) ((parent_width - child_width) / 2); + y = (Position) ((parent_height - child_height) / 2); XtTranslateCoords (parent, x, y, &x, &y); @@ -1367,7 +1371,9 @@ if (y < 0) y = 0; - XtVaSetValues (widget, XtNx, x, XtNy, y, NULL); + XtSetArg (al [0], XtNx, x); + XtSetArg (al [1], XtNy, y); + XtSetValues (widget, al, 2); } static Widget @@ -1397,7 +1403,12 @@ /* shrink the separator label back to their original size */ separator = XtNameToWidget (widget, "*separator_button"); if (separator) - XtVaSetValues (separator, XtNwidth, 5, XtNheight, 5, NULL); + { + Arg al [2]; + XtSetArg (al [0], XtNwidth, 5); + XtSetArg (al [1], XtNheight, 5); + XtSetValues (separator, al, 2); + } /* Center the dialog in its parent */ recenter_widget (widget); @@ -1749,7 +1760,12 @@ else if (event->xbutton.state & Button3Mask) trans = "<Btn3Down>"; else if (event->xbutton.state & Button2Mask) trans = "<Btn2Down>"; else if (event->xbutton.state & Button1Mask) trans = "<Btn1Down>"; - if (trans) XtVaSetValues (widget, XmNmenuPost, trans, NULL); + if (trans) + { + Arg al [1]; + XtSetArg (al [0], XmNmenuPost, trans); + XtSetValues (widget, al, 1); + } XmMenuPosition (widget, (XButtonPressedEvent *) event); } XtManageChild (widget); @@ -1764,8 +1780,15 @@ { short width; short height; - XtVaGetValues (w, XmNwidth, &width, XmNheight, &height, NULL); - XtVaSetValues (w, XmNminWidth, width, XmNminHeight, height, NULL); + Arg al [2]; + + XtSetArg (al [0], XmNwidth, &width); + XtSetArg (al [1], XmNheight, &height); + XtGetValues (w, al, 2); + + XtSetArg (al [0], XmNminWidth, width); + XtSetArg (al [1], XmNminHeight, height); + XtSetValues (w, al, 2); } #endif @@ -1810,6 +1833,7 @@ widget_instance* instance = (widget_instance*)closure; Widget instance_widget; LWLIB_ID id; + Arg al [1]; if (!instance) return; @@ -1822,7 +1846,8 @@ id = instance->info->id; user_data = NULL; - XtVaGetValues (widget, XmNuserData, &user_data, NULL); + XtSetArg(al [0], XmNuserData, &user_data); + XtGetValues (widget, al, 1); switch (type) { case pre_activate: @@ -1874,8 +1899,13 @@ || XtClass (widget) == xmToggleButtonGadgetClass) { Boolean check; - XtVaGetValues (widget, XmNset, &check, NULL); - XtVaSetValues (widget, XmNset, !check, NULL); + Arg al [1]; + + XtSetArg (al [0], XmNset, &check); + XtGetValues (widget, al, 1); + + XtSetArg (al [0], XmNset, !check); + XtSetValues (widget, al, 1); } #endif lw_internal_update_other_instances (widget, closure, call_data);
--- a/lwlib/lwlib-utils.c Mon Aug 13 09:43:39 2007 +0200 +++ b/lwlib/lwlib-utils.c Mon Aug 13 09:44:42 2007 +0200 @@ -36,17 +36,18 @@ XtNoClearRefreshWidget (Widget widget) { XEvent event; + XExposeEvent* ev = &event.xexpose; - event.type = Expose; - event.xexpose.serial = 0; - event.xexpose.send_event = 0; - event.xexpose.display = XtDisplay (widget); - event.xexpose.window = XtWindow (widget); - event.xexpose.x = 0; - event.xexpose.y = 0; - event.xexpose.width = widget->core.width; - event.xexpose.height = widget->core.height; - event.xexpose.count = 0; + ev->type = Expose; + ev->serial = 0; + ev->send_event = 0; + ev->display = XtDisplay (widget); + ev->window = XtWindow (widget); + ev->x = 0; + ev->y = 0; + ev->width = widget->core.width; + ev->height = widget->core.height; + ev->count = 0; (*widget->core.widget_class->core_class.expose) (widget, &event, (Region)NULL); @@ -63,8 +64,7 @@ { CompositeWidget cw = (CompositeWidget) w; /* We have to copy the children list before mapping over it, because - the procedure might add/delete elements, which would lose badly. - */ + the procedure might add/delete elements, which would lose badly. */ int nkids = cw->composite.num_children; Widget *kids = (Widget *) malloc (sizeof (Widget) * nkids); int i;
--- a/lwlib/lwlib.c Mon Aug 13 09:43:39 2007 +0200 +++ b/lwlib/lwlib.c Mon Aug 13 09:44:42 2007 +0200 @@ -1253,17 +1253,18 @@ Pixel foreground = 0; Pixel background = 1; Widget widget_to_invert = XtNameToWidget (w, "*sheet"); + Arg al [2]; + if (!widget_to_invert) widget_to_invert = w; - - XtVaGetValues (widget_to_invert, - XtNforeground, &foreground, - XtNbackground, &background, - NULL); - XtVaSetValues (widget_to_invert, - XtNforeground, background, - XtNbackground, foreground, - NULL); + + XtSetArg (al [0], XtNforeground, &foreground); + XtSetArg (al [1], XtNbackground, &background); + XtGetValues (widget_to_invert, al, 2); + + XtSetArg (al [0], XtNforeground, background); + XtSetArg (al [1], XtNbackground, foreground); + XtSetValues (widget_to_invert, al, 2); } void
--- a/man/cc-mode.texi Mon Aug 13 09:43:39 2007 +0200 +++ b/man/cc-mode.texi Mon Aug 13 09:44:42 2007 +0200 @@ -5,7 +5,7 @@ @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @setfilename cc-mode.info -@settitle CC MODE Version 4 Documentation +@settitle CC MODE Version 5 Documentation @footnotestyle end @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -16,13 +16,11 @@ @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @comment -@comment texinfo manual for @file{cc-mode.el} version 4 -@comment manual version: 2.66 -@comment generated from the original README file by Krishna Padmasola +@comment TeXinfo manual for CC Mode +@comment Generated from the original README file by Krishna Padmasola @comment <krishna@earth-gw.njit.edu> @comment -@comment Barry A. Warsaw <bwarsaw@cnri.reston.va.us> -@comment Last modification: 1997/03/07 23:36:14 +@comment Maintained by Barry A. Warsaw <cc-mode-help@python.org> @comment @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -48,10 +46,9 @@ @comment The title is printed in a large font. @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -@center @titlefont{CC Mode Version 4} +@center @titlefont{CC Mode 5.11} @sp 2 -@center A GNU Emacs mode for editing C, C++, Objective-C, and Java code. -@center (manual revision: 2.66) +@center @subtitlefont{A GNU Emacs mode for editing C, C++, Objective-C, and Java code} @sp 2 @center Barry A. Warsaw @@ -112,17 +109,17 @@ @end macro @cindex BOCM -Welcome to @ccmode{}, version 4. This is a GNU Emacs mode for -editing files containing C, C++, Objective-C, and Java code. -This incarnation of the mode is descendant from @file{c-mode.el} (also -called "Boring Old C Mode" or BOCM @code{:-)}, and @file{c++-mode.el} -version 2, which I have been maintaining since 1992. @ccmode{} -represents a significant milestone in the mode's life. It has been -fully merged back with Emacs 19's @file{c-mode.el}. Also a new, more -intuitive and flexible mechanism for controlling indentation has been -developed. - -@ccmode{} version 4 supports the editing of K&R and ANSI C, @dfn{ARM} + +Welcome to @ccmode{}. This is a GNU Emacs mode for editing files +containing C, C++, Objective-C, and Java code. This incarnation of the +mode is descendant from @file{c-mode.el} (also called "Boring Old C +Mode" or BOCM @code{:-)}, and @file{c++-mode.el} version 2, which I have +been maintaining since 1992. @ccmode{} represents a significant +milestone in the mode's life. It has been fully merged back with Emacs +19's @file{c-mode.el}. Also a new, more intuitive and flexible mechanism +for controlling indentation has been developed. + +@ccmode{} supports the editing of K&R and ANSI C, @dfn{ARM} @footnote{``The Annotated C++ Reference Manual'', by Ellis and Stroustrup.} C++, Objective-C, and Java files. In this way, you can easily set up consistent coding styles for use in editing all C, C++, @@ -154,16 +151,6 @@ provided. This file is intended to be a replacement for @file{c-mode.el} and @file{c++-mode.el}. -@findex c-version -The major version number was incremented to 4 with the addition of -@code{objc-mode}. To find the minor revision number of this release, use -@kbd{M-x c-version RET}. - -As of this writing (27-Feb-1997), Emacs 19.34, XEmacs 19.14, and XEmacs -20.0 are all distributed with @ccmode{}, but they may not have the -latest releases. You may therefore, want to upgrade your copy of -@ccmode{}. See @ref{Getting the latest CC Mode release}. - @cindex @file{cc-compat.el} file This distribution also contains a file called @file{cc-compat.el} which should ease your transition from BOCM to @ccmode{}. It currently @@ -186,167 +173,79 @@ @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -@file{cc-mode.el} works well with the three main branches of Emacs: -XEmacs 19 and XEmacs 20, both maintained by @code{xemacs.org}, and Emacs -19 maintained by the Free Software Foundation. Emacs users will want to -use version 19.21 or better, XEmacs users will want 19.6 or better. -Earlier versions of these Emacsen have deficiencies and/or bugs which -will adversely affect the performance and usability of @ccmode{}. You -are better off just getting the latest version of Emacs or XEmacs. +If you got this version of @ccmode{} with Emacs, it should work just +fine right out of the box, and you can safely skip to the next chapter. +Note however that you may not have the latest @ccmode{} release and may +want to upgrade your copy. See the @file{README} file, or the @ccmode{} +Web pages latest information on Emacs version compatibility, +@ref{Getting the latest CC Mode release}. @cindex @file{cc-mode-18.el} file -@file{cc-mode.el} will work with Emacs 18 if you use the -@file{cc-mode-18.el} compatibility file, but only moderately well. A -word of warning though, @emph{Emacs 18 lacks some fundamental -functionality and ultimately, using Emacs 18 is a losing -battle}. Hence @ccmode{} under Emacs 18 is no longer supported and -it is highly recommended that you upgrade to Emacs 19. If you use -@ccmode{} under Emacs 18, you're on your own. With @ccmode{} -version 5, Emacs 18 support will be dropped altogether. - -Note that as of XEmacs 19.13 and Emacs 19.30, your Emacs already comes -with @ccmode{} version 4 preconfigured for your use. You should be -able to safely skip the rest of the setup information in this chapter, -unless you want to install the latest version of @ccmode{} into one -of these Emacsen. +@emph{@ccmode{} no longer works with Emacs 18!} The +@file{cc-mode-18.el} file is no longer distributed with @ccmode{}. If +you haven't upgraded from Emacs 18 by now, you are out of luck. The +rest of these installation instructions assume you are using one of the +new Emacs or XEmacs releases, that already come with @ccmode{}. These +instructions explain how to upgrade to use the latest @ccmode{} +release. @cindex .emacs file -The first thing you will want to do is put @file{cc-mode.el} somewhere -on your @code{load-path} so Emacs can find it. Do a @kbd{C-h v -load-path RET} to see all the directories Emacs looks at when loading a -file. If none of these directories are appropriate, create a new -directory and add it to your @code{load-path}: - -@noindent -@emph{[in the shell]} + +The first thing you will want to do is put the @ccmode{} source files in +a subdirectory somewhere on your @code{load-path} so Emacs can find it. +The distribution tarball unpacks into its own subdirectory tagged with +the version number of the release. E.g. @ccmode{} release 5.00 will +unpack into the @file{cc-mode-5.00} directory. Assuming you unpacked +the distribution in your home directory, you should add the following to +your @file{.emacs} file in order to pick up the latest version of +@ccmode{} over the one distributed with your Emacs: + @example -@group - -% cd -% mkdir mylisp -% mv cc-mode.el mylisp -% cd mylisp - -@end group -@end example - -@noindent -@emph{[in your .emacs file add]} -@example - -(setq load-path (cons "~/mylisp" load-path)) + +(setq load-path (cons "~/cc-mode-5.00" load-path)) @end example @cindex byte compile -Next you want to @dfn{byte compile} @file{cc-mode.el}. The mode uses a -lot of macros so if you don't byte compile it, things will be unbearably -slow. @emph{You can ignore all byte-compiler warnings!} They are the -result of the supporting different versions of Emacs, and none of the -warnings have any effect on operation. Let me say this again: -@strong{You really can ignore all byte-compiler warnings!} - -Here's what to do to byte-compile the file [in emacs]: + +Next you want to @dfn{byte compile} all the @ccmode{} source files. +@ccmode{} uses a lot of macros so if you don't byte compile it, +things will be unbearably slow. @emph{You can ignore all byte-compiler +warnings!} They are the result of the supporting different versions of +Emacs, and none of the warnings have any effect on operation. Let me say +this again: @strong{You really can ignore all byte-compiler warnings!} + +To byte-compile the source files, be sure you have access to the +@code{make(1)} program. In a shell, execute the following commands +(again, assuming you unpacked @ccmode{} version 5.00 in your home +directory@footnote{Of course, the version numbers will probably be +different.}): + @example -M-x byte-compile-file RET ~/mylisp/cc-mode.el RET - -@end example - -If you are running a version of Emacs or XEmacs that comes with -@ccmode{} by default, you can simply add the following to your -@file{.emacs} file in order to upgrade to the latest version of -@ccmode{}: -@example - -(load "cc-mode") +% cd ~/cc-mode-5.00 +% make @end example -Users of even older versions of Emacs 19, Emacs 18, or of the older -Lucid Emacs will probably be running an Emacs that has BOCM -@file{c-mode.el} and possible @file{c++-mode.el} pre-dumped. If your -Emacs is dumped with either of these files you first need to make Emacs -``forget'' about those older modes. - -If you can do a @kbd{C-h v c-mode-map RET} without getting an error, you -need to add these lines at the top of your @file{.emacs} file: +By default, the @file{Makefile} assumes you are using XEmacs. If you +are using Emacs, execute this instead: + @example -@group - -(fmakunbound 'c-mode) -(makunbound 'c-mode-map) -(fmakunbound 'c++-mode) -(makunbound 'c++-mode-map) -(makunbound 'c-style-alist) - -@end group -@end example - -After those lines you will want to add the following autoloads to your -@file{.emacs} file so that @ccmode{} gets loaded at the right time: -@example -@group - -(autoload 'c++-mode "cc-mode" "C++ Editing Mode" t) -(autoload 'c-mode "cc-mode" "C Editing Mode" t) -(autoload 'objc-mode "cc-mode" "Objective-C Editing Mode" t) -(autoload 'java-mode "cc-mode" "Java Editing Mode" t) - -@end group -@end example - -Alternatively, if you want to make sure @ccmode{} is loaded when -Emacs starts up, you could use this line instead of the autoloads -above: -@example - -(require 'cc-mode) + +% make EMACS=emacs @end example -Next, you will want to set up Emacs so that it edits C files in -@code{c-mode}, C++ files in @code{c++-mode}, Objective-C files in -@code{objc-mode}, and Java files in @code{java-mode}. You should -add the following to your @file{.emacs} file, which assumes -you'll be editing @code{.h} and @code{.c} files as C, @code{.hh}, -@code{.cc}, @code{.H}, and @code{.C} files as C++, @code{.m} files as -Objective-C, and @code{.java} files as Java code. YMMV: +Next time you start up Emacs you should be using the latest @ccmode{}. +You can test this by visiting a C file and hitting @kbd{M-x c-version +RET}; you should see this message in the echo area: @example -@group - -(setq auto-mode-alist - (append - '(("\\.C$" . c++-mode) - ("\\.H$" . c++-mode) - ("\\.cc$" . c++-mode) - ("\\.hh$" . c++-mode) - ("\\.c$" . c-mode) - ("\\.h$" . c-mode) - ("\\.m$" . objc-mode) - ("\\.java$" . java-mode) - ) auto-mode-alist)) - -@end group -@end example - -You may already have some or all of these settings on your -@code{auto-mode-alist}, but it won't hurt to put them on there again. - -That's all you need --- I know, I know, it sounds like a lot @code{:-)}, -but after you've done all this, you should only need to quit and restart -Emacs. The next time you visit a C, C++, Objective-C, or Java file you -should be using @ccmode{}. You can check this easily by hitting -@kbd{M-x c-version RET}; you should see this message in the echo area: -@example - -Using CC Mode version 4.@var{xxx} + +Using CC Mode version 5.00 @end example -@noindent -where @var{xxx} is the latest minor release number. - @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @node New Indentation Engine, Minor Modes, Getting Connected, Top @@ -1144,26 +1043,63 @@ hungry-delete in @strong{all} your editing modes! @kindex DEL -In a nutshell, when hungry-delete mode is enabled, hitting the @kbd{DEL} -character will consume all preceding whitespace, including newlines and -tabs. This can really cut down on the number of @kbd{DEL}'s you have to -type if, for example you made a mistake on the preceding line. +@kindex Backspace +In a nutshell, when hungry-delete mode is enabled, hitting the +@kbd{Backspace} key@footnote{I say ``hit the @kbd{Backspace} key'' but +what I really mean is ``when Emacs receives the @code{BackSpace} keysym +event''. The difference usually isn't significant to most users, but +advanced users will realize that under window systems such as X, any +physical key (keycap) on the keyboard can be configured to generate any +keysym. Also, the use of Emacs on TTYs will affect which keycap +generates which keysym. From a pedantic point of view, here we are only +concerned with the keysym event that Emacs receives.} will consume all +preceding whitespace, including newlines and tabs. This can really cut +down on the number of @kbd{Backspace}'s you have to type if, for example +you made a mistake on the preceding line. + +@findex c-electric-backspace +@findex electric-backspace (c-) +@vindex c-backspace-function +@vindex backspace-function (c-) @findex c-electric-delete @findex electric-delete (c-) @vindex c-delete-function @vindex delete-function (c-) @cindex literal -By default, @ccmode{} actually runs the command -@code{c-electric-delete} when you hit @kbd{DEL}. When this command is -used to delete a single character (i.e. when it is called interactively -with no numeric argument), it really runs the function contained in the -variable @code{c-delete-function}. This function is called with a -single argument, which is the number of characters to delete. -@code{c-delete-function} is also called when the @kbd{DEL} key is typed -inside a literal (see @ref{Auto-newline insertion}. Inside a literal, -@code{c-electric-delete} is not electric, which is typical of all the -so-called electric commands. + +@findex backward-delete-char-untabify + +By default, when you hit the @kbd{Backspace} key +@ccmode{} runs the command @code{c-electric-backspace}, which deletes +text in the backwards direction. When deleting a single character, or +when @kbd{Backspace} is hit in a literal +(see @ref{Auto-newline insertion}), +or when hungry-delete mode is disabled, the function +contained in the @code{c-backspace-function} variable is called with one +argument (the number of characters to delete). This variable is set to +@code{backward-delete-char-untabify} by default. + +@vindex delete-key-deletes-forward +@findex delete-char + +Similarly, hitting the @kbd{DEL} key runs the command +@code{c-electric-delete}. Some versions of Emacs@footnote{As of this +writing, 20-Jun-1997, only XEmacs 20 supports this.} support separation +of the @kbd{Backspace} and @kbd{DEL} keys, so that @kbd{DEL} will delete +in the forward direction when @code{delete-key-deletes-forward} is +non-@code{nil}. If your Emacs supports this, and +@code{delete-key-deletes-forward} is non-@code{nil}, and hungry-delete +mode is enabled, then @kbd{DEL} will consume all whitespace following +point. When deleting a single character, or when @kbd{DEL} is hit in a +literal, or when hungry-delete mode is disabled, the function contained +in the @code{c-delete-function} variable is called with one argument +(the number of characters to delete). This variable is set to +@code{delete-char} by default. + +However, if @code{delete-key-deletes-forward} is @code{nil}, or your +Emacs does not support separation of @kbd{Backspace} and @kbd{DEL}, then +@code{c-electric-delete} simply calls @code{c-electric-backspace}. @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -1476,17 +1412,10 @@ terms of @code{+}, @code{-}, and @code{0}, if you like the general indentation style, but you use 4 spaces instead of 2 spaces per level, you can probably achieve your style just by changing -@code{c-basic-offset} like so (in your @file{.emacs} file)@footnote{The -reason you need to use @code{setq-default} instead of @code{setq} is -that @code{c-basic-offset} is a buffer local variable, as are most -configuration variables. If you were to put this code in, e.g. your -@code{c-mode-common-hook} function, you could use @code{setq}. -Alternatively, you can keep these variables global by setting -@code{c-style-variables-are-local-p} to @code{nil}, but you must do this -before @code{cc-mode.el} is loaded into your Emacs session.}: +@code{c-basic-offset} like so (in your @file{.emacs} file): @example -(setq-default c-basic-offset 4) +(setq c-basic-offset 4) @end example @@ -1654,8 +1583,30 @@ @vindex objc-mode-hook @vindex java-mode-hook @cindex hooks -To make this change permanent, you need to add some lisp code to your -@file{.emacs} file. @ccmode{} provides several hooks that you can +To make your changes permanent, you need to add some lisp code to your +@file{.emacs} file, but first you need to decide whether your styles +should be global in every buffer, or local to each specific buffer. + +If you edit primarily one style of C (or C++, Objective-C, Java) code, +you may want to make the @ccmode{} style variables have global values so +that every buffer will share the style settings. This will allow you to +set the @ccmode{} variables at the top level of your @file{.emacs} +file. This is the default way @ccmode{} works. + +@vindex c-mode-common-hook +@vindex mode-common-hook (c-) +@vindex c-style-variables-are-local-p +@vindex style-variables-are-local-p (c-) +If you edit many different styles of C (or C++, Objective-C, Java) at +the same time, you probably want to make the @ccmode{} style variables +have buffer local values. If you do this, then you will need to set any +@ccmode{} style variables in a hook function (e.g. off of +@code{c-mode-common-hook} instead of at the top level of your +@file{.emacs} file. The recommended way to do this is to set the +variable @code{c-style-variables-are-local-p} to @code{t} +@strong{before} @ccmode{} is loaded into your Emacs session. + +@ccmode{} provides several hooks that you can use to customize the mode according to your coding style. Each language mode has its own hook, adhering to standard Emacs major mode conventions. There is also one general hook: @@ -1692,9 +1643,6 @@ (@ref{Interactive Customization}) more permanent. See the Emacs manuals for more information on customizing Emacs via hooks. @xref{Sample .emacs File} for a more complete sample @file{.emacs} file. -@footnote{The use of @code{add-hook} in this example only works for -Emacs 19 and beyond. Workarounds are available if you are using Emacs -18.} @example @group @@ -1965,13 +1913,11 @@ When @code{c-style-variables-are-local-p} is non-nil, then the style variables will have a different settable value for each buffer, -otherwise all buffers will share the same values. This variable only -takes effect when @ccmode{} is loaded into your Emacs session. By -default (for backwards compatibility reasons), its value is @code{t}. -Note that once the variables are made buffer local, they will retain -this property for the remainder of the current Emacs session. To change -this behavior, set @code{c-style-variables-are-local-p} to @code{nil} -@emph{before} you load @file{cc-mode.el}. +otherwise all buffers will share the same values. By default, its value +is @code{nil} (i.e. global values). You @strong{must} set this variable +before @ccmode{} is loaded into your Emacs session, and once the +variables are made buffer local, they cannot be made global again +(unless you restart Emacs of course!) @menu * Custom Indentation Functions:: @@ -2390,10 +2336,11 @@ @item @code{inline-close} --- brace that closes an in-class inline method @item -@code{func-decl-cont} --- the nether region between a function -declaration's argument list and the defun opening brace. In C++ and -Java, this can include the @code{throws} clauses of a method -declaration. +@code{func-decl-cont} --- the region between a function definition's +argument list and the function opening brace (excluding K&R argument +declarations). In C, you cannot put anything but whitespace and comments +between them; in C++ and Java, @code{throws} declarations and other +things can appear in this context. @item @code{knr-argdecl-intro} --- first line of a K&R C argument declaration @item @@ -2679,7 +2626,7 @@ Returning to the previous example, line 16 is given @code{inline-close} syntax, while line 12 is given @code{defun-block-open} syntax, and lines 13 through 15 are all given @code{statement} syntax. Line 17 is -interesting in that it's syntactic analysis list contains three +interesting in that its syntactic analysis list contains three elements: @example @@ -3020,7 +2967,7 @@ @cindex Performance Issues @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -C and it's derivative languages are highly complex creatures. Often, +C and its derivative languages are highly complex creatures. Often, ambiguous code situations arise that require @ccmode{} to scan large portions of the buffer to determine syntactic context. Such pathological code@footnote{such as the output of @code{lex(1)}!} @@ -3084,7 +3031,8 @@ @cindex @file{cc-lobotomy.el} file @vindex cc-lobotomy-pith-list You might want to investigate the speed-ups contained in the -file @file{cc-lobotomy.el}, which is part of the @ccmode{} distribution. +file @file{cc-lobotomy.el}, which comes as part of the @ccmode{} +distribution, but is completely unsupported. As mentioned previous, @ccmode{} always trades accuracy for speed, however it is recognized that sometimes you need speed and can sacrifice some accuracy in indentation. The file @file{cc-lobotomy.el} contains @@ -3110,7 +3058,7 @@ @kindex ESC C-q @kindex ESC C-u @kindex RET -@kindex LFD +@kindex C-j @findex newline-and-indent @quotation @@ -3138,7 +3086,7 @@ where the new text should go after inserting the newline?} @strong{A.} Emacs' convention is that @key{RET} just adds a newline, -and that @key{LFD} adds a newline and indents it. You can make +and that @key{C-j} adds a newline and indents it. You can make @key{RET} do this too by adding this to your @code{c-mode-common-hook} (see the sample @file{.emacs} file @ref{Sample .emacs File}): @@ -3178,22 +3126,6 @@ @strong{A.} ``Syntax Colorization'' is an Emacs 19 feature, controlled by @code{font-lock-mode}. It is not part of @ccmode{}. -@sp 1 -@strong{Q.} @emph{I @code{setq} @code{c-basic-offset} to 4 in my -@file{.emacs} file, but why does everything still get indented with only -2 spaces?} - -@vindex c-style-variables-are-local-p -@vindex style-variables-are-local-p -@strong{A.} It's because @code{c-basic-offset} is, by default, a -``buffer local variable'', meaning its value is unique to each buffer. -The prefered way to customize this is to change its value in a ``mode -hook'' (most likely @code{c-mode-common-hook}). Alternatively you can -use @code{setq-default} to change its value globally. Better yet, -before you load @file{cc-mode.el}, set the variable -@code{c-style-variables-are-local-p} to @code{nil}. @xref{Advanced -Customizations}. - @end quotation @@ -3307,8 +3239,6 @@ (define-key c-mode-map "\C-m" 'newline-and-indent) ) -;; the following only works in Emacs 19 -;; Emacs 18ers can use (setq c-mode-common-hook 'my-c-mode-common-hook) (add-hook 'c-mode-common-hook 'my-c-mode-common-hook) @end example @@ -3328,10 +3258,6 @@ Re-indenting large regions or expressions can be slow. @item -Use with Emacs 18 can be slow and annoying. You should seriously -consider upgrading to Emacs 19. - -@item Add-on fill packages may not work as well as @ccmode{}'s built-in filling routines. I no longer recommend you use @code{filladapt} to fill comments. @@ -3375,6 +3301,18 @@ @code{help-gnu-emacs@@prep.ai.mit.edu} which is mirrored on newsgroup @code{gnu.emacs.help}. +There are two mailing lists for @ccmode{}. One is a general discussion +list and the other is an announce-only list. You do not need to +subscribe to either list, but if you want to, only subscribe to one of +these. Announcements of new releases get sent to both lists. To join +the general discussion list, send a message with the word +@emph{subscribe} in the body of the message to +@code{cc-mode-victims-request@@python.org}. To join just the +announce-only list, send a message with the word @emph{subscribe} in the +body of the message to @code{cc-mode-announce-request@@python.org}. +Both mailing lists are managed by Majordomo, and if you are successfully +subscribed, you will receive an email message with more information on +using the list. @c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @node Concept Index, Command Index, Mailing Lists and Submitting Bug Reports, Top
--- a/man/w3.texi Mon Aug 13 09:43:39 2007 +0200 +++ b/man/w3.texi Mon Aug 13 09:44:42 2007 +0200 @@ -1,3605 +0,0 @@ -\input texinfo -@c -@c Please note that this file uses some constructs not supported by earlier -@c versions of TeX-info. You must be running one of the newer TeX-info -@c releases (I currently use version 3.9 from ftp://prep.ai.mit.edu/pub/gnu/) -@c -@c Please do not send in bug reports about not being able to format the -@c document with 'makeinfo' or 'tex', just upgrade your installation. -@c -@c Info formatted files are provided in the distribution, and you can -@c retrieve dvi, postscript, and PDF versions from the web site or FTP -@c site: http://www.cs.indiana.edu/elisp/w3/docs.html -@c -@setfilename w3.info -@settitle Emacs/W3 User's Manual -@iftex -@finalout -@end iftex -@c @setchapternewpage odd -@c @smallbook -@tex -\overfullrule=0pt -%\global\baselineskip 30pt % for printing in double space -@end tex -@synindex cp fn -@synindex vr fn -@dircategory World Wide Web -@dircategory GNU Emacs Lisp -@direntry -* W3: (w3). Emacs/W3 World Wide Web browser. -@end direntry -@ifinfo -This file documents the Emacs/W3 World Wide Web browser. - -Copyright (C) 1993, 1994, 1995, 1996 William M. Perry -Copyright (C) 1996, 1997 Free Software Foundation - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -@ignore -Permission is granted to process this file through Tex and print the -results, provided the printed document carries copying permission -notice identical to this one except for the removal of this paragraph -(this paragraph not being relevant to the printed manual). - -@end ignore -@end ifinfo -@c -@titlepage -@sp 6 -@center @titlefont{Emacs/W3} -@center @titlefont{User's Manual} -@sp 4 -@center Third Edition, Emacs/W3 Version 3.0 -@sp 1 -@center March 1997 -@sp 5 -@center William M. Perry -@center @i{wmperry@@cs.indiana.edu} -@page -@vskip 0pt plus 1filll -Copyright @copyright{} 1993, 1994, 1995 William M. Perry@* -Copyright @copyright{} 1996, 1997 Free Software Foundation - -Permission is granted to make and distribute verbatim copies of@* -this manual provided the copyright notice and this permission notice@* -are preserved on all copies. - -@end titlepage -@page -@ifinfo -@node Top, Getting Started, (dir), (dir) -@top W3 - -Users can browse the World Wide Web from within Emacs by using Emacs/W3. -All of the widely used (and even some not very widely used) @sc{url} -schemes are supported, and it is very easy to add new methods as the -need arises. - -Emacs/W3 provides some core functionality that can be readily re-used -from any program in Emacs. Users and other package writers are -encouraged to @i{Web-enable} their applications and daily work routines -with the library. - -Emacs/W3 is completely customizable, both from Emacs-Lisp and from -stylesheets @xref{Stylesheets} If there is any aspect of Emacs/W3 that -cannot be modified to your satisfaction, please send mail to the -@t{w3-beta@@indiana.edu} mailing list with any suggestions. -@xref{Reporting Bugs} - -@menu -* Getting Started:: Getting up and running with Emacs/W3 -* Basic Usage:: Basic movement and usage of Emacs/W3. -* Compatibility:: Explanation of compatibility with - other browsers. -* Stylesheets:: How to control the look of web pages -* Supported URLs:: What @sc{URL} schemes are supported. -* MIME Support:: Support for @sc{mime} -* Security:: Various security methods supported -* Non-Unix Operating Systems:: Special considerations necessary to get - up and running correctly under non-unix - OS's. -* Speech Integration:: Outputting to a speech synthesizer. -* Advanced Features:: Some of the more arcane features. -* More Help:: How to get more help---mailing lists, - newsgroups, etc. -* Future Directions:: Plans for future revisions - -Appendices: -* Reporting Bugs:: How to report a bug in Emacs/W3. -* Dealing with Firewalls:: How to get around your firewall. -* Proxy Gateways:: Using a proxy gateway with Emacs/W3. -* Installing SSL:: Turning on @sc{ssl} support. -* Mailcap Files:: An explanation of Mailcap files. -* Down with DoubleClick:: Annoyed by advertisements? Read this! - -Indices: -* General Index:: General Index. -* Key Index:: Menus of command keys and their references. -@end menu -@end ifinfo - -@node Getting Started, Basic Usage, Top, Top -@chapter Getting Started -@cindex Clueless in Seattle -@cindex Getting Started -@kindex M-x w3 -@vindex w3-default-homepage -@findex w3 -If installed correctly, starting Emacs/W3 is quite painless. Just type -@kbd{M-x w3} in a running Emacs session. This will retrieve the default -page that has been configured (@pxref{Preferences Panel}) - by default the -documentation for Emacs/W3 at Indiana University. - -If the default page is not retrieved correctly at startup, you will have -to do some customization (@pxref{Preferences Panel}). - -Once started, you can use the mouse and the menu or use the following -key commands (for more commands and more detail, @pxref{Basic Usage, , -Basic Usage}). - -@table @asis -@item move forward -press the space bar, - -@item move backwards -press the backspace key, - -@item move to the next HTML reference on the page -press the @kbd{TAB} key, - -@item move to the previous HTML reference on the page -press the @kbd{SHIFT} and @kbd{TAB} keys at the same time. If this does -not work (some text terminals cannot distinguish between @kbd{TAB} and -@kbd{SHIFT-TAB}, pressing the @kbd{ALT} and @kbd{TAB} keys should also -work. - -@item follow a link -put the cursor over it -and press the @kbd{RETURN} key, or @* -click the left mouse button on it, - -@item fetch a @sc{url} -press the @kbd{Control} and @kbd{o} keys at the same time,@* -type the @sc{url}, and then press the @kbd{RETURN} key, - -@item return to the last URL you were at -press the @kbd{l} key, - -@item quit W3 mode -press the @kbd{q} key. -@end table - -@menu -* Downloading:: Where to download Emacs/W3. -* Building and Installing:: Compiling and installing from source. -* Startup Files:: What is where, and why. -* Preferences Panel:: Quick configuration of common options. -@end menu - -@node Downloading, Building and Installing, Getting Started, Getting Started -@section Downloading - -:: WORK :: What you need, and why@* -:: WORK :: Where to download Emacs, XEmacs, various platforms@* -:: WORK :: Where to download Emacs/W3@* -:: WORK :: Where to download related utilities (netpbm, xv, gimp, etc.) - -@node Building and Installing, Startup Files, Downloading, Getting Started -@section Building and Installing - -:: WORK :: Document makefile variables@* -:: WORK :: Document what gets installed where, why - -@node Startup Files, Preferences Panel, Building and Installing, Getting Started -@section Startup Files -@cindex Startup files -@cindex Default stylesheet - -:: WORK :: startup files@* -This section should document where Emacs/W3 looks for its startup files, -and what each one does. 'profile' 'stylesheet' 'hotlist' 'history' etc. - -@node Preferences Panel, , Startup Files, Getting Started -@section Preferences Panel -@cindex Preferences -@kindex M-x w3-preferences-edit - -:: WORK :: pref panel@* -This should document the quick preferences panel. M-x w3-preferences-edit - -@node Basic Usage, Compatibility, Getting Started, Top -@chapter Basic Usage -@cindex Basic Usage -@kindex space -@kindex backspace -@kindex return -@kindex tab -@kindex M-tab -Emacs/W3 is similar to the Info package all Emacs users hold near and -dear to their hearts (@xref{Top,,Info,info, The Info Manual}, for a -description of Info). Basically, @kbd{space} and @kbd{backspace} -control scrolling, and @kbd{return} or the middle mouse button follows a -hypertext link. The @kbd{tab} and @kbd{Meta-tab} keys maneuver around the -various links on the page. - -@b{NOTE:} Starting with Emacs/W3 3.0, form entry areas in a page can be -typed directly into. This is one of the main differences in navigation -from version 2.0. If you are used to using the @kbd{f} and @kbd{b} keys -to navigate around a buffer, I suggest training yourself to always use -@kbd{tab} and @kbd{M-tab} - it will save time and frustration on pages -with lots of form fields. - -By default, hypertext links are surrounded by '[[' and ']]' on -non-graphic terminals (VT100, DOS window, etc.). On a graphics -terminal, the links are in shown in different colors. -@xref{Stylesheets} for information on how to change this. - -There are approximately 50 keys bound to special Emacs/W3 functions. -The basic rule of thumb regarding keybindings in Emacs/W3 is that a -lowercase key takes an action on the @b{current document}, and an -uppercase key takes an action on the document pointed to by the -hypertext link @b{under the cursor}. - -There are several areas that the keybindings fall into: movement, -information, action, and miscellaneous. - -@menu -* Movement:: Moving around in the buffer. -* Information:: Getting information about a document. -* Action:: Following links, printing, etc. -* Miscellaneous:: Everything else. -@end menu - -@node Movement, Information, Basic Usage, Basic Usage -@section Movement - -All the standard Emacs bindings for movement are still in effect, with a -few additions for convenience. - -@table @kbd -@findex w3-scroll-up -@kindex space -@item space -Scroll downward in the buffer. With prefix arg, scroll down that many -screenfuls. -@kindex backspace -@findex scroll-down -@item backspace -Scroll upward in the buffer. With prefix arg, scroll up that many -screenfuls. -@kindex < -@findex w3-start-of-document -@item < -Goes to the start of document -@kindex > -@findex w3-end-of-document -@item > -Goes to the end of document -@kindex b -@kindex Meta-tab -@findex w3-widget-backward -@item Meta-tab, Shift-tab, b -Attempts to move backward one link area in the current document. -Signals an error if no previous links are found. -@kindex f -@kindex tab -@kindex n -@findex w3-widget-forward -@item tab, f, n -Attempts to move forward one link area in the current document. Signals -an error if no more links are found. -@kindex B -@findex w3-backward-in-history -@item B -Move backwards in the history stack. -@kindex F -@findex w3-forward-in-history -@item F -Move forwards in the history stack. -@kindex l -@findex w3-goto-last-buffer -@item l -Return to the last buffer shown before this buffer. -@kindex q -@findex w3-quit -@item q -Kill this buffer. -@kindex Q, u -@findex w3-leave-buffer -@item Q, u -Bury this buffer, but don't kill it -@end table - -@node Information, Action, Movement, Basic Usage -@section Information - -These functions relate information about one or more links on the -current document. - -@table @kbd -@kindex v -@findex url-view-url -@item v -This shows the @sc{url} of the current document in the minibuffer. -@kindex V -@findex w3-view-this-url -@item V -This shows the @sc{url} of the hypertext link under point in the -minibuffer. -@kindex i -@findex w3-document-information -@item i -Shows miscellaneous information about the currently displayed document. -This includes the @sc{url}, the last modified date, @sc{mime} headers, -the @sc{http} response code, and any relationships to other documents. -Any security information is also displayed. -@kindex I -@findex w3-document-information-this-url -@item I -Shows information about the @sc{url} at point. -@kindex s -@findex w3-source-document -@item s -This shows the @sc{html} source of the current document in a separate buffer. -The buffer's name is based on the document's @sc{url}. -@kindex S -@findex w3-source-document-at-point -@item S -Shows the @sc{html} source of the hypertext link under point in a separate -buffer. The buffer's name is based on the document's @sc{url}. -@kindex k -@findex w3-save-url -@item k -This stores the current document's @sc{url} in the kill ring, and also in the -current window-system's clipboard, if possible. -@kindex K -@findex w3-save-this-url -@item K -Stores the @sc{url} of the document under point in the kill ring, and also in -the current window-system's clipboard, if possible. -@end table - -@node Action, Miscellaneous, Information, Basic Usage -@section Action - -First, here are the keys and functions that bring up a new hypertext -page, usually creating a new buffer. -@table @kbd -@kindex m -@findex w3-complete-link -@item m -Choose a link from the current buffer and follow it. A completing-read -is done on all the links, so @kbd{space} and @kbd{TAB} can be used for -completion. -@kindex return -@findex w3-follow-link -@item return -Pressing return when over a hyperlink attempts to follow the link -under the cursor. With a prefix argument (@kbd{C-u}), this forces the -file to be saved to disk instead of being passed off to other viewers -or being parsed as @sc{html}. - -Pressing return when over a form input field can cause auto-submission -of the form. This is for Mosaic and Netscape compatibility. If there -is only one item in the form other than submit or reset buttons, then - -minibuffer for the data to insert into the input field. Type checking -is done, and the data is only entered into the form when data of the -correct type is entered (ie: cannot enter 44 for 'date' field, etc). - -@kindex Middle Mouse Button -@findex w3-follow-mouse -@item Middle Mouse Button -Attempt to follow a hypertext link under the mouse cursor. Clicking on -a form input field will prompt in the minibuffer for the data to insert -into the input field. Type checking is done, and the data is only -entered into the form when data of the correct type is entered (ie: -cannot enter 44 for 'date' field, etc). - -@kindex Control Middle Mouse Button -@kindex Meta return -@findex w3-follow-inlined-image -@item Control Middle Mouse Button, Meta return -Tries to retrieve the inlined image that is under point. It ignores any -form entry areas or hyperlinks, and blindly follows any inlined image. -Useful for seeing images that are meant to be used as hyperlinks when -not on a terminal capable of displaying graphics. - -@kindex p -@findex w3-print-this-url -@item p -Prints out the current buffer in a variety of formats, including -PostScript, @sc{html} source, or formatted text. -@kindex P -@findex w3-print-url-under-point -@item P -Prints out the @sc{url} under point in a variety of formats, including -PostScript, @sc{html} source, or formatted text. -@kindex m -@findex w3-complete-link -@item m -Selects a destination from a list of all the hyperlinks in the current -buffer. Use @kbd{space} and @kbd{tab} to complete on the links. - -@kindex r -@kindex g -@findex w3-reload-document -@item r, g -Reloads the current document. The position within the buffer remains -the same (unless the document has changed since it was last retrieved, -in which case it should be relatively close). This causes an -unconditional reload from the remote server - the locally cached copy is -not consulted. -@kindex C-o -@findex w3-fetch -@item C-o -Prompts for a @sc{url} in the minibuffer, and attempts to fetch -it. If there are any errors, or Emacs/W3 cannot understand the type of link -requested, the errors are displayed in a hypertext buffer. -@kindex o -@findex w3-open-local -@vindex url-use-hypertext-dired -@item o -Opens a local file, interactively. This prompts for a local file name -to open. The file must exist, and may be a directory. If the requested -file is a directory and @code{url-use-hypertext-dired} is @code{nil}, -then a dired-mode buffer is displayed. If non@code{nil}, then Emacs/W3 -automatically generates a hypertext listing of the directory. The -hypertext mode is the default, so that all the keys and functions remain -the same. - -@kindex M-s -@findex w3-save-as -@item M-s -Save a document to the local disk as HTML Source, Formatted Text, LaTeX -Source, or Binary. - -@kindex Hv -@findex w3-show-history-list -@vindex w3-keep-history -@item Hv -If @code{url-keep-history} is non-@code{nil}, then Emacs/W3 keeps track -of all the @sc{url}s visited in an Emacs session. This function takes all -the links that are in that internal list, and formats them as hypertext -links in a list. -@end table - -@cindex Buffer movement -And here are the commands to move around between Emacs/W3 buffers: - -@table @kbd -@kindex l -@findex w3-goto-last-buffer -@item l -Goes to the last WWW buffer seen. -@kindex q -@findex w3-quit -@item q -Quits WWW mode. This kills the current buffer and goes to the most -recently visited buffer. -@kindex Q -@findex w3-leave-buffer -@item u -This is similar to w3-quit, but the buffer is not killed, it is moved to -the bottom of the buffer list (so it is the least likely to show up as -the default with switch-to-buffer). This is different from -@code{w3-goto-last-buffer} in that it does not return to the last WWW -page visited - it is the same as using @code{switch-to-buffer} - the -buffer left in the window is fairly random. -@kindex HB -@kindex B -@findex w3-backward-in-history -@item HB, B -Takes one step back along the path in the current history. Has no -effect if at the beginning of the session history. -@kindex HF -@kindex F -@findex w3-forward-in-history -@item HF, F -Takes one step forward along the path in the current history. Has no -effect if at the end of the session history. -@end table - -@node Miscellaneous, , Action, Basic Usage -@section Miscellaneous - -@table @kbd -@kindex M-m -@findex w3-mail-current-document -@item M-m -Mails the current document to someone. Choose from several different -formats to mail: formatted text, @sc{html} source, PostScript, or LaTeX source. -When the @sc{html} source is mailed, then an appropriate <base> tag is inserted -at the beginning of the document so that relative links may be followed -correctly by whoever receives the mail. -@kindex M-M -@findex w3-mail-document-under-point -@item M-M -Mails the document pointed to by the hypertext link under point to someone. -Choose from several different formats to mail: formatted text, @sc{html} source, -PostScript, or LaTeX source. When the @sc{html} source is mailed, then an -appropriate <base> tag is inserted at the beginning of the document so that -relative links may be followed correctly by whoever receives the -mail. -@kindex p -@findex w3-print-this-url -@item p -Prints the current document. Choose from several different formats to -print: formatted text, @sc{html} source, PostScript (with ps-print), or by using -LaTeX and dvips). - -@findex lpr-buffer -@vindex lpr-command -@vindex lpr-switches -When the formatted text is printed, the normal @code{lpr-buffer} function -is called, and the variables @code{lpr-command} and @code{lpr-switches} -control how the document is printed. - -When the @sc{html} source is printed, then an appropriate <base> tag is -inserted at the beginning of the document. -@vindex w3-print-commnad -@vindex w3-latex-docstyle -When postscript is printed, then the @sc{html} source of the document is -converted into LaTeX source. There are several variables controlling -what the final LaTeX document looks like. - -:: WORK :: Document the new LaTeX backend - -@table @code -@item w3-latex-use-latex2e -@vindex w3-latex-use-latex2e -If non-@code{nil}, configures the LaTeX engine to use the LaTeX2e -syntax. A @code{nil} value indicates that LaTeX 2.0.9 compabibility -will be used instead. -@item w3-latex-docstyle -@vindex w3-latex-docstyle -The document style to use when printing or mailing converted @sc{html} files -in LaTeX. Good defaults are: @{article@}, [psfig,twocolumn]@{article@}, -etc. -@item w3-latex-packages -@vindex w3-latex-packages -List of LaTeX packages to include. Currently this is only used if -@code{w3-latex-use-latex2e} is non-@code{nil}. -@item w3-latex-use-maketitle -@vindex w3-latex-use-maketitle -If non-@code{nil}, the LaTeX engine will use real LaTeX title pages for -document titles. -@item w3-latex-print-links -@vindex w3-latex-print-links -If non-@code{nil}, prints the @sc{url}s of hypertext links as endnotes at the -end of the document. If set to @code{footnote}, prints the @sc{url}'s as -footnotes on each page. -@end table - -@kindex P -@findex w3-print-url-under-point -@item P -Prints the document pointed to by the hypertext link under point. -Please see the previous item for more information. -@kindex M-x w3-insert-formatted-url -@findex w3-insert-formatted-url -@item M-x w3-insert-formatted-url -Insert a fully formatted @sc{html} link into another buffer. This gets the -name and @sc{url} of either the current buffer, or, with a prefix arg, of the -link under point, and construct the appropriate <a...>...</a> markup and -insert it into the desired buffer. -@kindex M-tab -@findex w3-insert-this-url -@item M-tab -Inserts the @sc{url} of the current document into another buffer. Buffer is -prompted for in the minibuffer. With prefix arg, uses the @sc{url} of the -link under point. -@kindex U -@findex w3-use-links -@item U -Selects one of the <LINK> tags from this document and fetch it. Links -are attributes of a specific document, and can tell such things as who -made the document, where a table of contents is located, etc. - -Link tags specify relationships between documents in two ways. Normal -(forward) relationships (where the link has a REL="xxx" attribute), and -reverse relationships (where the link has a REV="xxx" attribute). This -first asks what type of link to follow (Normal or Reverse), then does -a @code{completing-read} on only the links that have that type of -relationship. -@end table - -@node Compatibility, Stylesheets, Basic Usage, Top -@chapter Compatibility with other Browsers -Due to the popularity of several other browsers, Emacs/W3 offers an easy -transition to its much better way of life. This ranges from being able -to share the same preferences files and disk cache to actually emulating -the keybindings used in other browsers. - -@menu -* Emulation:: Emacs/W3 can emulate the keybindings and - other behaviours of other browsers. -* Hotlist Handling:: A hotlist is an easy way to keep track of - interesting Web pages without having to - remember the exact path to get there. -* Session History:: Keeping a history of documents visited - in one Emacs sessions allows the use of - 'forward' and 'back' buttons easily. -* Global History:: Keeping a history of all the places ever - visited on the web. -@end menu - -@node Emulation, Hotlist Handling, Compatibility, Compatibility -@section Emulation -@cindex Browser emulation -@cindex Emulation of other browsers -@cindex Netscape emulation -@cindex Lynx emulation -@findex turn-on-netscape-emulation -@findex turn-on-lynx-emulation -@findex w3-netscape-emulation-minor-mode -@findex w3-lynx-emulation-minor-mode -@vindex w3-mode-hook - -:: WORK :: Document lynx emulation@* -@table @kbd -@item Down arrow -Highlight next topic -@item Up arrow -Highlight previous topic -@item Right arrow, Return, Enter -Jump to highlighted topic -@item Left arrow -Return to previous topic -@item + -Scroll down to next page (Page-Down) -@item - -Scroll up to previous page (Page-Up) -@item SPACE -Scroll down to next page (Page-Down) -@item b -Scroll up to previous page (Page-Up) -@item C-A -Go to first page of the current document (Home) -@item C-E -Go to last page of the current document (End) -@item C-B -Scroll up to previous page (Page-Up) -@item C-F -Scroll down to next page (Page-Down) -@item C-N -Go forward two lines in the current document -@item C-P -Go back two lines in the current document -@item ) -Go forward half a page in the current document -@item ( -Go back half a page in the current document -@item # -Go to Toolbar or Banner in the current document -@item ?, h -Help (this screen) -@item a -Add the current link to a bookmark file -@item c -Send a comment to the document owner -@item d -Download the current link -@item e -Edit the current file -@item g -Goto a user specified @sc{url} or file -@item i -Show an index of documents -@item j -Execute a jump operation -@item k -Show a list of key mappings -@item l -List references (links) in current document -@item m -Return to main screen -@item o -Set your options -@item p -Print the current document -@item q -Quit -@item / -Search for a string within the current document -@item s -Enter a search string for an external search -@item n -Go to the next search string -@item v -View a bookmark file -@item V -Go to the Visited Links Page -@item x -Force submission of form or link with no-cache -@item z -Cancel transfer in progress -@item [backspace] -Go to the history Page -@item = -Show file and link info -@item \ -Toggle document source/rendered view -@item ! -Spawn your default shell -@item * -Toggle image_links mode on and off -@item [ -Toggle pseudo_inlines mode on and off -@item ] -Send an @sc{http} @sc{head} request for the current doc or link -@item C-R -Reload current file and refresh the screen -@item C-W -Refresh the screen -@item C-U -Erase input line -@item C-G -Cancel input or transfer -@item C-T -Toggle trace mode on and off -@item C-K -Invoke the Cookie Jar Page -@end table - -:: WORK :: Document netscape emulation@* -Uh, turn this into pretty tables about what keys are emulated. - -@example -(define-key w3-netscape-emulation-minor-mode-map "\M-s" 'w3-save-as) -(define-key w3-netscape-emulation-minor-mode-map "\M-m" 'w3-mailto) -(define-key w3-netscape-emulation-minor-mode-map "\M-n" 'make-frame) -(define-key w3-netscape-emulation-minor-mode-map "\M-l" 'w3-fetch) -(define-key w3-netscape-emulation-minor-mode-map "\M-o" 'w3-open-local) -(define-key w3-netscape-emulation-minor-mode-map "\M-p" 'w3-print-this-url) -(define-key w3-netscape-emulation-minor-mode-map "\M-q" 'w3-quit) -(define-key w3-netscape-emulation-minor-mode-map "\M-f" 'w3-search-forward) -(define-key w3-netscape-emulation-minor-mode-map "\M-g" 'w3-search-again) -(define-key w3-netscape-emulation-minor-mode-map "\M-r" 'w3-reload-document) -(define-key w3-netscape-emulation-minor-mode-map "\M-i" 'w3-load-delayed-images) -(define-key w3-netscape-emulation-minor-mode-map "\M-a" 'w3-hotlist-add-document) -(define-key w3-netscape-emulation-minor-mode-map "\M-b" 'w3-show-hotlist) -(define-key w3-netscape-emulation-minor-mode-map "\M-h" 'w3-show-history-list) - -@end example - -@node Hotlist Handling, Session History, Emulation, Compatibility -@section Hotlist Handling - -:: WORK :: Document that it supports different types of hotlist formats@* -:: WORK :: Make sure everything hotlist related can be accessed via 'h'@* -In order to avoid having to traverse many documents to get to the same -document over and over, Emacs/W3 supports a ``hotlist'' like Mosaic. This is -a file that contains @sc{url}s and aliases. Hotlists allow quick access to any -document in the Web, providing it has been visited and added to the hotlist. -The variable @code{w3-hotlist-file} determines where this information -is saved. The structure of the file is compatible with Mosaic's -hotlist file, so this defaults to @file{~/.mosaic-hotlist-default}. - -Hotlist commands are: -@table @kbd -@kindex hi -@findex w3-hotlist-add-document -@vindex w3-hotlist-file -@item a -Adds the current document to the hotlist, with the buffer name as its -identifier. Modifies the file specified by @code{w3-hotlist-file}. If -this is given a prefix-argument (via @kbd{C-u}), the title is prompted -for instead of automatically defaulting to the document title. - -@findex w3-hotlist-refresh -@vindex w3-hotlist-file -@kindex hR -@item hR -This rereads the default hostlist file specified by -@code{w3-hotlist-file}. -@findex w3-hotlist-delete -@vindex w3-hotlist-file -@kindex hd -@item d -Prompts for the alias of the entry to kill. Pressing the spacebar or -tab will list out partial completions. The internal representation of -the hotlist and the file specified by @code{w3-hotlist-file} are -updated. -@item hr -@kindex hr -@findex w3-hotlist-rename-entry -@vindex w3-hotlist-file -Some hotlist item names can be very unwieldy (`Mosaic for X level 2 fill -out form support'), or uninformative (`Index of /'). Prompts for the -item to rename in the minibuffer---use the spacebar or tab key for -completion. After having chosen an item to rename, prompts for a new -title until a unique title is entered. Modifies the file specified by -@code{w3-hotlist-file}. - -@item hu -@kindex hu -@findex w3-use-hotlist -Prompts for the alias to jump to. Pressing the @key{spacebar} or -@key{tab} key shows partial completions. - -@item hv -@kindex hv -@findex w3-show-hotlist -Converts the hotlist into @sc{html} and displays it. -@item ha -@kindex ha -@findex w3-hotlist-apropos -Shows the hotlist entries matching a regular expression. -@item hA -@kindex hA -@findex w3-hotlist-append -Appends another hotlist file to the one currently in memory. -@end table -@node Session History, Global History, Hotlist Handling, Compatibility -@section History -@cindex History Lists - -Almost all web browsers keep track of the @sc{url}s followed from a page, so -that it can provide @b{forward} and @b{back} buttons to keep a @i{path} -of @sc{url}s that can be traversed easily. - -@vindex url-keep-history -If the variable @code{url-keep-history} is @code{t}, then Emacs/W3 -keeps a list of all the @sc{url}s visited in a session. - -@findex w3-show-history -To view a listing of the history for this session of Emacs/W3, use -@code{M-x w3-show-history} from any buffer, and Emacs/W3 generates an -@sc{html} document showing every @sc{url} visited since Emacs started (or -cleared the history list), and then format it. Any of the links can -be chosen and followed to the original document. To clear the history -list, choose 'Clear History' from the 'Options' menu. - -@findex w3-forward-in-history -@findex w3-backward-in-history -@findex w3-fetch -Another twist on the history list mechanism is the fact that all -Emacs/W3 buffers remember what @sc{url}, buffer, and buffer position of the -last document, and also keeps track of the next location jumped @b{to} -from that buffer. This means that the user can go forwards and -backwards very easily along the path taken to reach a particular -document. To go forward, use the function @code{w3-forward-in-history}, -to go backward, use the function @code{w3-backward-in-history}. - -@node Global History, , Session History, Compatibility -@section Global History - -:: WORK :: Document that the global history can have diff. formats@* -Most web browsers also support the idea of a ``history'' of @sc{url}s the -user has visited, and it displays them in a different style than normal -@sc{url}s. - -@vindex url-keep-history -@vindex url-global-history-file -If the variable @code{url-keep-history} is @code{t}, then Emacs/W3 -keeps a list of all the @sc{url}s visited in a session. The file is -automatically written to disk when exiting emacs. The list is added to -those already in the file specified by @code{url-global-history-file}, -which defaults to @file{~/.mosaic-global-history}. - -If any @sc{url} in the list is found in the file, it is not saved, but new -ones are added at the end of the file. - -The function that saves the global history list is smart enough to -notice what style of history list is being used (Netscape, Emacs/W3, or -XMosaic), and writes out the new additions appropriately. - -@cindex Completion of URLs -@cindex Usefulness of global history -One of the nice things about keeping a global history files is that Emacs/W3 -can use it as a completion table. When doing @kbd{M-x w3-fetch}, pressing -the @kbd{tab} or @kbd{space} key will show all completions for a -partial @sc{url}. This is very useful, especially for very long @sc{url}s that -are not in a hotlist, or for seeing all the pages from a particular web -site before choosing which to retrieve. - -@node Stylesheets, Supported URLs, Compatibility, Top -@chapter Stylesheets -The way in which Emacs/W3 formats a document is very customizable. All -formatting is now controlled by a default stylesheet set by the user -with the @code{w3-default-stylesheet} variable. Emacs/W3 currently -supports the @sc{W3C} recommendation for Cascading Style Sheets, Level 1 -(commonly known as @sc{CSS1}) with a few experimental items from other -W3C proposals. Wherever Emacs/W3 diverges from the specification, it -will be clearly documented, and will be changed once a full standard is -available. - -Support for @sc{DSSSL} is progressing, but spare time is at an all-time -low. If anyone would like to help, please contact the author. - -The following sections closely parallel the @sc{CSS1} specification so -it should be very easy to look up what Emacs/W3 supports when browsing -through the @sc{CSS1} specification. Please note that a lot of the text -in the following sections comes directly from the specification as -well. - -@menu -* Terminology:: Terms used in the rest of this chapter. -* Basic Concepts:: Why are stylesheets useful? Getting started. -* Pseudo-Classes/Elements:: Special classes for elements. -* The Cascade:: How stylesheets are combined. -* Properties:: What properties you can set on elements. -* Units:: What you can set them to. -@end menu - -@node Terminology, Basic Concepts, Stylesheets, Stylesheets -@section Terminology - -@table @dfn -@item attribute -HTML attribute, ie: @samp{align=center} - align is the attribute. -@item author -The author of an HTML document. -@item block-level element -An element which has a line break before and after (e.g. 'H1' in @sc{HTML}). -@item canvas -The part of the UA's drawing surface onto which documents are rendered. -@item child element -A subelement in @sc{sgml} terminology. -@item contextual selector -A selector that matches elements based on their position in the document -structure. A contextual selector consists of several simple -selectors. E.g., the contextual selector 'H1.initial B' consists of two -simple selectors, 'H1.initial' and 'B'. -@item @sc{css} -Cascading Style Sheets. -@item declaration -A property (e.g. 'font-size') and a corresponding value (e.g. '12pt'). -@item designer -The designer of a style sheet. -@item document -@sc{html} document. -@item element -@sc{html} element. -@item element type -A generic identifier in @sc{sgml} terminology. -@item fictional tag sequence -A tool for describing the behavior of pseudo-classes and pseudo-elements. -@item font size -The size for which a font is designed. Typically, the size of a font is -approximately equal to the distance from the bottom of the lowest letter -with a descender to the top of the tallest letter with an ascender and -(optionally) with a diacritical mark. -@item @sc{html} extension -Markup introduced by UA vendors, most often to support certain visual -effects. The @sc{font}, @sc{center} and @sc{blink} elements are examples -of HTML extensions, as is the @sc{bgcolor} attribute. One of the goals -of @sc{css} is to provide an alternative to @sc{html} extensions. -@item inline element -An element which does not have a line break before and after -(e.g. '@sc{strong}' in @sc{html}) -@item intrinsic dimensions -The width and height as defined by the element itself, not imposed by -the surroundings. In this specification it is assumed that all replaced -elements -- and only replaced elements -- come with intrinsic -dimensions. -@item parent element -The containing element in @sc{sgml} terminology. -@item pseudo-element -Pseudo-elements are used in @sc{css} selectors to address typographical -items (e.g. the first line of an element) rather than structural -elements. -@item pseudo-class -Pseudo-classes are used in @sc{css} selectors to allow information -external to the @sc{html} source (e.g. the fact that an anchor has been -visited or not) to classify elements. -@item property -A stylistic parameter that can be influenced through @sc{css}. -@item reader -The person for whom the document is rendered. -@item replaced element -An element that the @sc{css} formatter only knows the intrinsic -dimensions of. In @sc{html}, @sc{img}, @sc{input}, @sc{textarea}, -@sc{select} and @sc{object} elements can be examples of replaced -elements. E.g., the content of the @sc{img} element is often replaced by -the image that the @sc{src} attribute points to. @sc{css1} does not -define how the intrinsic dimensions are found. -@item rule -A declaration (e.g. 'font-family: helvetica') and its selector -(e.g. @sc{'H1'}). -@item selector -A string that identifies what elements the corresponding rule applies -to. A selector can either be a simple selector (e.g. 'H1') or a -contextual selector (e.g. @sc{'h1 b'}) which consists of several simple -selectors. -@item @sc{sgml} -Standard Generalized Markup Language, of which @sc{html} is an -application. -@item simple selector -A selector that matches elements based on the element type and/or -attributes, and not the element's position in the document -structure. E.g., 'H1.initial' is a simple selector. -@item style sheet -A collection of rules. -@item @sc{ua} -User Agent, often a web browser or web client. -@item user -Synonymous with reader. -@item weight -The priority of a rule. -@end table - -@node Basic Concepts, Pseudo-Classes/Elements, Terminology, Stylesheets -@section Basic Concepts - -Designing simple style sheets is easy. One needs only to know a little -HTML and some basic desktop publishing terminology. E.g., to set the -text color of 'H1' elements to blue, one can say: - -@example - H1 @{ color: blue @} -@end example - -The example above is a simple CSS rule. A rule consists of two main -parts: selector ('H1') and declaration ('color: blue'). The declaration -has two parts: property ('color') and value ('blue'). While the example -above tries to influence only one of the properties needed for rendering -an HTML document, it qualifies as a style sheet on its own. Combined -with other style sheets (one fundamental feature of CSS is that style -sheets are combined) it will determine the final presentation of the -document. - -The selector is the link between the HTML document and the style sheet, and -all HTML element types are possible selectors. - -@node Pseudo-Classes/Elements, The Cascade, Basic Concepts, Stylesheets -@section Pseudo-Classes/Elements - -In @sc{css1}, style is normally attached to an element based on its -position in the document structure. This simple model is sufficient for -a wide variety of styles, but doesn't cover some common effects. The -concept of pseudo-classes and pseudo-elements extend addressing in -@sc{css1} to allow external information to influence the formatting -process. - -Pseudo-classes and pseudo-elements can be used in @sc{css} selectors, -but do not exist in the @sc{html} source. Rather, they are "inserted" by -the @sc{ua} under certain conditions to be used for addressing in style -sheets. They are referred to as "classes" and "elements" since this is a -convenient way of describing their behavior. More specifically, their -behavior is defined by a fictional tag sequence. - -Pseudo-elements are used to address sub-parts of elements, while -pseudo-classes allow style sheets to differentiate between different -element types. - -The only support pseudo-classes in Emacs/W3 are on the anchor tag -(<a>...</a>). - -User agents commonly display newly visited anchors differently from -older ones. In @sc{css1}, this is handled through pseudo-classes on the -'A' element: - -@example - A:link @{ color: red @} /* unvisited link */ - A:visited @{ color: blue @} /* visited links */ - A:active @{ color: lime @} /* active links */ -@end example - -All 'A' elements with an 'HREF' attribute will be put into one and only -one of these groups (i.e. target anchors are not affected). UAs may -choose to move an element from 'visited' to 'link' after a certain -time. An 'active' link is one that is currently being selected (e.g. by -a mouse button press) by the reader. - -The formatting of an anchor pseudo-class is as if the class had been -inserted manually. A @sc{ua} is not required to reformat a currently -displayed document due to anchor pseudo-class transitions. E.g., a style -sheet can legally specify that the 'font-size' of an 'active' link -should be larger that a 'visited' link, but the UA is not required to -dynamically reformat the document when the reader selects the 'visited' -link. - -Pseudo-class selectors do not match normal classes, and vice versa. The -style rule in the example below will therefore not have any influence: - -@example - A:link @{ color: red @} - - <A CLASS=link NAME=target5> ... </A> -@end example - -In @sc{css1}, anchor pseudo-classes have no effect on elements other -than 'A'. Therefore, the element type can be omitted from the selector: - -@example - A:link @{ color: red @} - :link @{ color: red @} -@end example - -The two selectors above will select the same elements in CSS1. - -Pseudo-class names are case-insensitive. - -Pseudo-classes can be used in contextual selectors: - -@example - A:link IMG @{ border: solid blue @} -@end example - -Also, pseudo-classes can be combined with normal classes: - -@example - A.external:visited @{ color: blue @} - - <A CLASS=external HREF="http://out.side/">external link</A> -@end example - -If the link in the above example has been visited, it will be rendered -in blue. Note that normal class names precede pseudo-classes in the -selector. - -@node The Cascade, Properties, Pseudo-Classes/Elements, Stylesheets -@section The Cascade - -In @sc{css}, more than one style sheet can influence the presentation -simultaneously. There are two main reasons for this feature: modularity -and author/reader balance. - -@table @i -@item modularity -A style sheet designer can combine several (partial) style sheets to -reduce redundancy: - -@example - @@import url(http://www.style.org/pastoral); - @@import url(http://www.style.org/marine); - - H1 @{ color: red @} /* override imported sheets */ -@end example -@item author/reader balance -Both readers and authors can influence the presentation through style -sheets. To do so, they use the same style sheet language thus reflecting -a fundamental feature of the web: everyone can become a publisher. The -@sc{ua} is free to choose the mechanism for referencing personal style -sheets. -@end table - -Sometimes conflicts will arise between the style sheets that influence -the presentation. Conflict resolution is based on each style rule having -a weight. By default, the weights of the reader's rules are less than -the weights of rules in the author's documents. I.e., if there are -conflicts between the style sheets of an incoming document and the -reader's personal sheets, the author's rules will be used. Both reader -and author rules override the @sc{ua}'s default values. - -The imported style sheets also cascade with each other, in the order -they are imported, according to the cascading rules defined below. Any -rules specified in the style sheet itself override rules in imported -style sheets. That is, imported style sheets are lower in the cascading -order than rules in the style sheet itself. Imported style sheets can -themselves import and override other style sheets, recursively. - -In @sc{css1}, all '@@import' statements must occur at the start of a -style sheet, before any declarations. This makes it easy to see that -rules in the style sheet itself override rules in the imported style -sheets. - -NOTE: The use of !important in @sc{css} stylesheets is unsupported at -this time. - -Conflicting rules are intrinsic to the CSS mechanism. To find the value -for an element/property combination, the following algorithm must be -followed: - -@enumerate -@item -Find all declarations that apply to the element/property in -question. Declarations apply if the selector matches the element in -question. If no declarations apply, the inherited value is used. If -there is no inherited value (this is the case for the 'HTML' element and -for properties that do not inherit), the initial value is used. -@item -Sort the declarations by explicit weight: declarations marked -'!important' carry more weight than unmarked (normal) declarations. -@item -Sort by origin: the author's style sheets override the reader's style -sheet which override the UA's default values. An imported style sheet -has the same origin as the style sheet from which it is imported. -@item -Sort by specificity of selector: more specific selectors will override -more general ones. To find the specificity, count the number of ID -attributes in the selector (a), the number of CLASS attributes in the -selector (b), and the number of tag names in the selector -(c). Concatenating the three numbers (in a number system with a large -base) gives the specificity. Some examples: -@example - LI @{...@} /* a=0 b=0 c=1 -> specificity = 1 */ - UL LI @{...@} /* a=0 b=0 c=2 -> specificity = 2 */ - UL OL LI @{...@} /* a=0 b=0 c=3 -> specificity = 3 */ - LI.red @{...@} /* a=0 b=1 c=1 -> specificity = 11 */ - UL OL LI.red @{...@} /* a=0 b=1 c=3 -> specificity = 13 */ - #x34y @{...@} /* a=1 b=0 c=0 -> specificity = 100 */ -@end example -Pseudo-elements and pseudo-classes are counted as normal elements and -classes, respectively. -@item -Sort by order specified: if two rules have the same weight, the latter -specified wins. Rules in imported style sheets are considered to be -before any rules in the style sheet itself. -@end enumerate - -The search for the property value can be terminated whenever one rule -has a higher weight than the other rules that apply to the same -element/property combination. - -This strategy gives author's style sheets considerably higher weight -than those of the reader. It is therefore important that the reader has -the ability to turn off the influence of a certain style sheet, -e.g. through a pull-down menu. - -A declaration in the 'STYLE' attribute of an element has the same weight -as a declaration with an ID-based selector that is specified at the end -of the style sheet: - -@example -<STYLE TYPE="text/css"> - #x97z @{ color: blue @} -</STYLE> - -<P ID=x97z STYLE="color: red"> -@end example - -In the above example, the color of the 'P' element would be -red. Although the specificity is the same for both declarations, the -declaration in the 'STYLE' attribute will override the one in the -'STYLE' element because of cascading rule number 5. - -The @sc{ua} may choose to honor other stylistic @sc{html} attributes, -for example 'ALIGN'. If so, these attributes are translated to the -corresponding @sc{css} rules with specificity equal to 1. The rules are -assumed to be at the start of the author style sheet and may be -overridden by subsequent style sheet rules. In a transition phase, this -policy will make it easier for stylistic attributes to coexist with -style sheets. - -@node Properties, Units, The Cascade, Stylesheets -@section Properties - -In the text below, the allowed values for each property are listed -with a syntax like the following: - -@example - Value: N | NW | NE - Value: [ <length> | thick | thin ]@{1,4@} - Value: <uri>? <color> [ / <color> ]? - Value: <uri> || <color> -@end example - -The words between < and > give a type of value. The most common types -are <length>, <percentage>, <url>, <number>and <color> these are -described in the section on [[units]]. The more specialized types -(e.g. <font-family>and <border-style>) are described under the property -where they appear. - -Other words are keywords that must appear literally, without quotes. The -slash (/) and the comma (,) must also appear literally. - -Several things juxtaposed mean that all of them must occur, in the given -order. A bar (|) separates alternatives: one of them must occur. A -double bar (A || B) means that either A or B or both must occur, in any -order. Brackets ([]) are for grouping. Juxtaposition is stronger than -the double bar, and the double bar is stronger than the bar. Thus "a b | -c || d e" is equivalent to "[ a b ] | [ c || [ d e ]]". - -Every type, keyword, or bracketed group may be followed by one of the -following modifiers: - -@itemize @bullet -@item -An asterisk (*) indicates that the preceding type, word or group is -repeated zero or more times. -@item -A plus (+) indicates that the preceding type, word or group is repeated -one or more times. -@item -A question mark (?) indicates that the preceding type, word or group is -optional. -@item -A pair of numbers in curly braces (@{A,B@}) indicates that the preceding -type, word or group is repeated at least A and at most B times. -@end itemize - -Other than the value the following information is also shown. - -@multitable @columnfractions .20 .8 -@item Supported Values: @tab If this is present, it lists the parts of -the specification that Emacs/W3 currently supports. -@item Unsupported Values: @tab If this is present, it represents the -parts of the specifcation that Emacs/W3 does not support. -@item Initial: @tab The default value for the property, unless -explicitly set in a stylesheet. -@item Applies to: @tab What type of elements this property can be attached to. -@item Inherited: @tab Yes or no -@item Percentage values: @tab What a percentage value applies to when given. -@end multitable - -@menu -* Font Properties:: Selecting fonts, styles, and sizes. -* Colors and Backgrounds:: Controlling colors, front and back. -* Text Properties:: Alignment, decoration, and more! -* Box Properties:: Borders, padding, and margins, oh my! -* Classification:: Changing whitespace and display policies. -* Media Selection:: Conditionalize stylesheets on media-type. -* Speech Properties:: Speech output controlled by stylesheets. -@end menu - -@node Font Properties, Colors and Backgrounds, Properties, Properties -@subsection Font Properties - -Setting font properties will be among the most common uses of style -sheets. Unfortunately, there exists no well-defined and universally -accepted taxonomy for classifying fonts, and terms that apply to one -font family may not be appropriate for others. E.g. 'italic' is commonly -used to label slanted text, but slanted text may also be labeled as -being @b{Oblique}, @b{Slanted}, @b{Incline}, @b{Cursive} or -@b{Kursiv}. Therefore it is not a simple problem to map typical font -selection properties to a specific font. - -The properties defined by CSS1 are described in the following sections. -@menu -* font-family:: Groups of fonts. -* font-style:: Normal, italic, or oblique? -* font-variant:: Small-caps, etc. -* font-weight:: How bold can you go? -* font-size:: How big is yours? -* font:: Shorthand for all of the above. -@end menu - -@node font-family, font-style, Font Properties, Font Properties -@subsubsection font-family - -@multitable @columnfractions .20 .8 -@item Supported Values: @tab [[<family-name> | <generic-family>],]* [<family-name> | <generic-family>] -@item Initial: @tab User specific -@item Applies to: @tab all elements -@item Inherited: @tab yes -@item Percentage values: @tab N/A -@end multitable -The value is a prioritized list of font family names and/or generic -family names. Unlike most other CSS1 properties, values are separated -by a comma to indicate that they are alternatives: - -@example - BODY @{ font-family: gill, helvetica, sans-serif @} -@end example - -There are two types of list values: - -@table @b -@item <family-name> -The name of a font family of choice. In the last example, "gill" and -"helvetica" are font families. -@item <generic-family> -In the example above, the last value is a generic family name. The -following generic families are defined: -@itemize @bullet -@item -'serif' (e.g. Times) -@item -'sans-serif' (e.g. Helvetica) -@item -'cursive' (e.g. Zapf-Chancery) -@item -'fantasy' (e.g. Western) -@item -'monospace' (e.g. Courier) -@end itemize -@end table - -Style sheet designers are encouraged to offer a generic font family as a -last alternative. - -Font names containing whitespace should be quoted: - -@example - BODY @{ font-family: "new century schoolbook", serif @} - - <BODY STYLE="font-family: 'My own font', fantasy"> -@end example - -If quoting is omitted, any whitespace characters before and after the -font name are ignored and any sequence of whitespace characters inside -the font name is converted to a single space. - -@node font-style, font-variant, font-family, Font Properties -@subsubsection font-style - -@multitable @columnfractions .2 .8 -@item Supported Values: @tab normal | italic | oblique -@item Initial: @tab normal -@item Applies to: @tab all elements -@item Inherited: @tab yes -@item Percentage values: @tab N/A -@end multitable - -The 'font-style' property selects between normal (sometimes referred to -as "roman" or "upright"), italic and oblique faces within a font family. - -A value of 'normal' selects a font that is classified as 'normal' in the -UA's font database, while 'oblique' selects a font that is labeled -'oblique'. A value of 'italic' selects a font that is labeled 'italic', -or, if that is not available, one labeled 'oblique'. - -The font that is labeled 'oblique' in the UA's font database may -actually have been generated by electronically slanting a normal font. - -Fonts with Oblique, Slanted or Incline in their names will typically be -labeled 'oblique' in the UA's font database. Fonts with Italic, Cursive -or Kursiv in their names will typically be labeled 'italic'. - -@example - H1, H2, H3 @{ font-style: italic @} - H1 EM @{ font-style: normal @} -@end example - -In the example above, emphasized text within 'H1' will appear in a -normal face. - -@node font-variant, font-weight, font-style, Font Properties -@subsubsection font-variant - -@multitable @columnfractions .2 .8 -@item Value: @tab normal | small-caps -@item Initial: @tab normal -@item Applies to: @tab all elements -@item Inherited: @tab yes -@item Percentage values: @tab N/A -@end multitable - -Another type of variation within a font family is the small-caps. In a -small-caps font the lower case letters look similar to the uppercase -ones, but in a smaller size and with slightly different proportions. The -'font-variant' property selects that font. - -A value of 'normal' selects a font that is not a small-caps font, -'small-caps' selects a small-caps font. It is acceptable (but not -required) in CSS1 if the small-caps font is a created by taking a normal -font and replacing the lower case letters by scaled uppercase -characters. As a last resort, uppercase letters will be used as -replacement for a small-caps font. - -The following example results in an 'H3' element in small-caps, with -emphasized words in oblique small-caps: - -@example - H3 @{ font-variant: small-caps @} - EM @{ font-style: oblique @} -@end example - -There may be other variants in the font family as well, such as fonts -with old-style numerals, small-caps numerals, condensed or expanded -letters, etc. CSS1 has no properties that select those. - -@node font-weight, font-size, font-variant, Font Properties -@subsubsection font-weight - -@multitable @columnfractions .2 .8 -@item Supported Values: @tab normal | bold | 100 | 200 | 300 | 400 | 500 | 600 | 700 | 800 | 900 -@item Unsupported Values: @tab bolder | lighter -@item Initial: @tab normal -@item Applies to: @tab all elements -@item Inherited: @tab yes -@item Percentage values: @tab N/A -@end multitable - -The 'font-weight' property selects the weight of the font. The values -'100' to '900' form an ordered sequence, where each number indicates a -weight that is at least as dark as its predecessor. The keyword 'normal' -is synonymous with '400', and 'bold' is synonymous with '700'. Keywords -other than 'normal' and 'bold' have been shown to be often confused with -font names and a numerical scale was therefore chosen for the 9-value -list. - -@example - P @{ font-weight: normal @} /* 400 */ - H1 @{ font-weight: 700 @} /* bold */ -@end example - -The 'bolder' and 'lighter' values select font weights that are relative -to the weight inherited from the parent: - -@example - STRONG @{ font-weight: bolder @} -@end example - -There is no guarantee that there will be a darker face for each of the -'font-weight' values; for example, some fonts may have only a normal and -a bold face, others may have eight different face weights. There is no -guarantee on how a UA will map font faces within a family to weight -values. The only guarantee is that a face of a given value will be no -less dark than the faces of lighter values. - -@node font-size, font, font-weight, Font Properties -@subsubsection font-size - -@multitable @columnfractions .2 .8 -@item Supported Values: @tab <absolute-size> | <length> -@item Unsupported Values: @tab <percentage> | <relative-size> -@item Initial: @tab medium -@item Applies to: @tab all elements -@item Inherited: @tab yes -@item Percentage values: @tab relative to parent element's font size -@end multitable - -@table @b -@item <absolute-size> -An <absolute-size> keyword is an index to a table of font sizes computed -and kept by the UA. Possible values are: -@itemize @bullet -@item -xx-small -@item -x-small -@item -small -@item -medium -@item -large -@item -x-large -@item -xx-large -@end itemize - -On a computer screen a scaling factor of 1.5 is suggested between -adjacent indexes; if the 'medium' font is 10pt, the 'large' font could -be 15pt. Different media may need different scaling factors. Also, the -UA should take the quality and availability of fonts into account when -computing the table. The table may be different from one font family to -another. -@item <relative-size> -A <relative-size> keyword is interpreted relative to the table of font -sizes and the font size of the parent element. Possible values are -@b{larger} or @b{smaller}. For example, if the parent element has a font -size of 'medium', a value of 'larger' will make the font size of the -current element be 'large'. If the parent element's size is not close to -a table entry, the UA is free to interpolate between table entries or -round off to the closest one. The UA may have to extrapolate table -values if the numerical value goes beyond the keywords. -@end table - -Length and percentage values should not take the font size table into -account when calculating the font size of the element. - -Negative values are not allowed. - -On all other properties, 'em' and 'ex' length values refer to the font -size of the current element. On the 'font-size' property, these length -units refer to the font size of the parent element. - -Note that an application may reinterpret an explicit size, depending on -the context. E.g., inside a VR scene a font may get a different size -because of perspective distortion. - -Examples: - -@example - P @{ font-size: 12pt; @} - BLOCKQUOTE @{ font-size: larger @} - EM @{ font-size: 150% @} - EM @{ font-size: 1.5em @} -@end example - -If the suggested scaling factor of 1.5 is used, the last three -declarations are identical. - -@node font, , font-size, Font Properties -@subsubsection font - -@multitable @columnfractions .2 .8 -@item Value: @tab [ <font-style> || <font-variant> || <font-weight> ]? <font-size> [ / <line-height> ]? <font-family> -@item Initial: @tab not defined for shorthand properties -@item Applies to: @tab all elements -@item Inherited: @tab yes -@item Percentage values: @tab allowed on <font-size> and <line-height> -@end multitable -The 'font' property is a shorthand property for setting 'font-style' -'font-variant' 'font-weight' 'font-size', 'line-height' and -'font-family' at the same place in the style sheet. The syntax of this -property is based on a traditional typographical shorthand notation to -set multiple properties related to fonts. - -For a definition of allowed and initial values, see the previously -defined properties. Properties for which no values are given are set to -their initial value. - -@example - P @{ font: 12pt/14pt sans-serif @} - P @{ font: 80% sans-serif @} - P @{ font: x-large/110% "new century schoolbook", serif @} - P @{ font: bold italic large Palatino, serif @} - P @{ font: normal small-caps 120%/120% fantasy @} -@end example - -In the second rule, the font size percentage value ('80%') refers to the -font size of the parent element. In the third rule, the line height -percentage refers to the font size of the element itself. - -In the first three rules above, the 'font-style', 'font-variant' and -'font-weight' are not explicitly mentioned, which means they are all -three set to their initial value ('normal'). The fourth rule sets the -'font-weight' to 'bold', the 'font-style' to 'italic' and implicitly -sets 'font-variant' to 'normal'. - -The fifth rule sets the 'font-variant' ('small-caps'), the 'font-size' -(120% of the parent's font), the 'line-height' (120% times the font -size) and the 'font-family' ('fantasy'). It follows that the keyword -'normal' applies to the two remaining properties: 'font-style' and -'font-weight'. - -@node Colors and Backgrounds, Text Properties, Font Properties, Properties -@subsection Colors and Backgrounds - -These properties describe the color (often called foreground color) and -background of an element (i.e. the surface onto which the content is -rendered). One can set a background color and/or a background image. The -position of the image, if/how it is repeated, and whether it is fixed or -scrolled relative to the canvas can also be set. - -The 'color' property inherits normally. The background properties do not -inherit, but the parent element's background will shine through by -default because of the initial 'transparent' value on -'background-color'. - -NOTE: Currently, Emacs/W3 can only show background images under XEmacs. -Emacs 19 doesn't have the support in its display code yet. - -@menu -* color:: Foreground colors. -* background-color:: Background colors. -* background-image:: Background images. -* background-repeat:: Controlling repeating of background images. -* background-attachment:: Where background images are drawn. -* background-position:: Where background images are drawn. -* background:: Shorthand for all background properties. -@end menu - -@node color, background-color, Colors and Backgrounds, Colors and Backgrounds -@subsubsection color - -@multitable @columnfractions .2 .8 -@item Value: @tab <color> -@item Initial: @tab User specific -@item Applies to: @tab all elements -@item Inherited: @tab yes -@item Percentage values: @tab N/A -@end multitable - -This property describes the text color of an element (often referred to -as the foreground color). There are different ways to specify red: - -@example - EM @{ color: red @} /* natural language */ - EM @{ color: rgb(255,0,0) @} /* RGB range 0-255 */ -@end example - -See @ref{Color Units} for a description of possible color values. - -@node background-color, background-image, color, Colors and Backgrounds -@subsubsection background-color - -@multitable @columnfractions .2 .8 -@item Value: @tab <color> | transparent -@item Initial: @tab transparent -@item Applies to: @tab all elements -@item Inherited: @tab no -@item Percentage values: @tab N/A -@end multitable - -This property sets the background color of an element. - -@example - H1 @{ background-color: #F00 @} -@end example - -@node background-image, background-repeat, background-color, Colors and Backgrounds -@subsubsection background-image - -@multitable @columnfractions .2 .8 -@item Value: @tab <url> | none -@item Initial: @tab none -@item Applies to: @tab all elements -@item Inherited: @tab no -@item Percentage values: @tab N/A -@end multitable - -This property sets the background image of an element. When setting a -background image, one should also set a background color that will be -used when the image is unavailable. When the image is available, it is -overlaid on top of the background color. - -@example - BODY @{ background-image: url(marble.png) @} - P @{ background-image: none @} -@end example - -@node background-repeat, background-attachment, background-image, Colors and Backgrounds -@subsubsection background-repeat - -This property is not supported at all under Emacs/W3. - -@node background-attachment, background-position, background-repeat, Colors and Backgrounds -@subsubsection background-attachment - -This property is not supported at all under Emacs/W3. - -@node background-position, background, background-attachment, Colors and Backgrounds -@subsubsection background-position - -This property is not supported at all under Emacs/W3. - -@node background, , background-position, Colors and Backgrounds -@subsubsection background - -@multitable @columnfractions .2 .8 -@item Value: @tab <background-color> || <background-image> || <background-repeat> || <background-attachment> || <background-position> -@item Initial: @tab not defined for shorthand properties -@item Applies to: @tab all elements -@item Inherited: @tab no -@item Percentage values: @tab allowed on <background-position> -@end multitable - -The 'background' property is a shorthand property for setting the -individual background properties (i.e., 'background-color', -'background-image', 'background-repeat', 'background-attachment' and -'background-position') at the same place in the style sheet. - -Possible values on the 'background' properties are the set of all -possible values on the individual properties. - -@example - BODY @{ background: red @} - P @{ background: url(chess.png) gray 50% repeat fixed @} -@end example - -The 'background' property always sets all the individual background -properties. In the first rule of the above example, only a value for -'background-color' has been given and the other individual properties -are set to their initial value. In the second rule, all individual -properties have been specified. - -@node Text Properties, Box Properties, Colors and Backgrounds, Properties -@subsection Text Properties - -@menu -* word-spacing:: -* letter-spacing:: -* text-decoration:: -* vertical-align:: -* text-transform:: -* text-align:: -* text-indent:: -* line-height:: -@end menu - -@node word-spacing, letter-spacing, Text Properties, Text Properties -@subsubsection word-spacing - -@multitable @columnfractions .2 .8 -@item Supported Values: @tab normal -@item Unsupported Values: @tab <length> -@item Initial: @tab normal -@item Applies to: @tab all elements -@item Inherited: @tab yes -@item Percentage values: @tab N/A -@end multitable - -The length unit indicates an addition to the default space between -words. Values can be negative, but there may be implementation-specific -limits. The UA is free to select the exact spacing algorithm. The word -spacing may also be influenced by justification (which is a value of the -'align' property). - -@example - H1 @{ word-spacing: 0.4em @} -@end example - -Here, the word-spacing between each word in 'H1' elements would be -increased by '1em'. - -NOTE: Emacs/W3 cannot currently support this, due to limitations in -Emacs. It may be implemented in the future. - -@node letter-spacing, text-decoration, word-spacing, Text Properties -@subsubsection letter-spacing - -@multitable @columnfractions .2 .8 -@item Supported Values: @tab normal -@item Unsupported Values: @tab <length> -@item Initial: @tab normal -@item Applies to: @tab all elements -@item Inherited: @tab yes -@item Percentage values: @tab N/A -@end multitable - -The length unit indicates an addition to the default space between -characters. Values can be negative, but there may be -implementation-specific limits. The UA is free to select the exact -spacing algorithm. The letter spacing may also be influenced by -justification (which is a value of the 'align' property). - -@example - BLOCKQUOTE @{ letter-spacing: 0.1em @} -@end example - -Here, the letter-spacing between each character in 'BLOCKQUOTE' elements -would be increased by '0.1em'. - -NOTE: Emacs/W3 cannot currently support this, due to limitations in -Emacs. It may be implemented in the future. - -@node text-decoration, vertical-align, letter-spacing, Text Properties -@subsubsection text-decoration - -@multitable @columnfractions .2 .8 -@item Supported Values: @tab none | underline | line-through | blink -@item Unsupported Values: @tab overline -@item Initial: @tab none -@item Applies to: @tab all elements -@item Inherited: @tab no, but see clarification below -@item Percentage values: @tab N/A -@end multitable - -This property describes decorations that are added to the text of an -element. If the element has no text (e.g. the 'IMG' element in HTML) or -is an empty element (e.g. '<EM></EM>'), this property has no effect. A -value of 'blink' causes the text to blink. - -The color(s) required for the text decoration should be derived from the -'color' property value. - -This property is not inherited, but elements should match their -parent. E.g., if an element is underlined, the line should span the -child elements. The color of the underlining will remain the same even -if descendant elements have different 'color' values. - -@example - A:link, A:visited, A:active @{ text-decoration: underline @} -@end example - -The example above would underline the text of all links (i.e., all 'A' -elements with a 'HREF' attribute). - -NOTE: The 'line-through' property is only supported under XEmacs -currently. A patch has been sent to the Emacs maintainers to add -support for this, but it has not made it into the main distribution -yet. - -@node vertical-align, text-transform, text-decoration, Text Properties -@subsubsection vertical-align - -This is currently unsupported in Emacs/W3. - -@node text-transform, text-align, vertical-align, Text Properties -@subsubsection text-transform - -@multitable @columnfractions .2 .8 -@item Supported Values: @tab none -@item Unsupported Values: @tab capitalize | uppercase | lowercase -@item Initial: @tab none -@item Applies to: @tab all elements -@item Inherited: @tab yes -@item Percentage values: @tab N/A -@end multitable - -@table @b -@item 'capitalize' -Uppercases the first character of each word. -@item 'uppercase' -Uppercases all letters of the element. -@item 'lowercase' -Lowercases all letters of the element. -@item 'none' -Neutralizes inherited value. -@end table - -The actual transformation in each case is human language dependent. - -@example - H1 @{ text-transform: uppercase @} -@end example - -The example above would put 'H1' elements in uppercase text. - -NOTE: This capability was in the previous version of Emacs/W3, but has -not been reimplemented in the new display code yet. Please feel free to -send me patches. - -@node text-align, text-indent, text-transform, Text Properties -@subsubsection text-align - -@multitable @columnfractions .2 .8 -@item Value: @tab left | right | center | justify -@item Initial: @tab User specific -@item Applies to: @tab block-level elements -@item Inherited: @tab yes -@item Percentage values: @tab N/A -@end multitable - -This property describes how text is aligned within the element. The -actual justification algorithm used is UA and human language dependent. - -Example: -@example - DIV.center @{ text-align: center @} -@end example - -Since 'text-align' inherits, all block-level elements inside the 'DIV' -element with 'CLASS=center' will be centered. Note that alignments are -relative to the width of the element, not the canvas. - -@node text-indent, line-height, text-align, Text Properties -@subsubsection text-indent - -Not currently implemented in Emacs/W3. - -@node line-height, , text-indent, Text Properties -@subsubsection line-height - -Not currently implemented in Emacs/W3. - -@node Box Properties, Classification, Text Properties, Properties -@subsection Box Properties - -@multitable @columnfractions .2 .8 -@end multitable - -@node Classification, Media Selection, Box Properties, Properties -@subsection Classification - -These properties classify elements into categories more than they set -specific visual parameters. - -The list-style properties describe how list items (i.e. elements with a -'display' value of 'list-item') are formatted. The list-style properties -can be set on any element, and it will inherit normally down the -tree. However, they will only be have effect on elements with a -'display' value of 'list-item'. In HTML this is typically the case for -the 'LI' element. - -@menu -* display:: -* white-space:: -* list-style-type:: -* list-style-image:: -* list-style-position:: -* list-style:: -@end menu - -@node display, white-space, Classification, Classification -@subsubsection display - -@multitable @columnfractions .2 .8 -@item Value: @tab block | inline | list-item | none -@item Extensions: @tab line -@item Initial: @tab inline -@item Applies to: @tab all elements -@item Inherited: @tab no -@item Percentage values: @tab N/A -@end multitable - -This property describes how/if an element is displayed on the canvas -(which may be on a printed page, a computer display etc.). - -An element with a 'display' value of 'block' opens whitespace suitable -for a paragraph break. Typically, elements like 'H1' and 'P' are of -type 'block'. A value of 'list-item' is similar to 'block' except that a -list-item marker is added. In HTML, 'LI' will typically have this value. - -An element with a 'display' value of 'inline' results in a new inline -box on the same line as the previous content. - -A value of 'none' turns off the display of the element, including -children elements and the surrounding box. - -@example - P @{ display: block @} - EM @{ display: inline @} - LI @{ display: list-item @} - IMG @{ display: none @} -@end example - -The last rule turns off the display of images. - -A value of 'line' results in a single line break. Emacs/W3 needs this -extension to be able to fully specify the behaviour of @sc{br} and -@sc{hr} elements within a stylesheet. - -NOTE: Emacs/W3 defaults to using 'inline' for this property, which is a -slight deviation from the specification. - -@node white-space, list-style-type, display, Classification -@subsubsection white-space - -@multitable @columnfractions .2 .8 -@item Value: @tab normal | pre | nowrap -@item Initial: @tab normal -@item Applies to: @tab block-level elements -@item Inherited: @tab yes -@item Percentage values: @tab N/A -@end multitable - -This property declares how whitespace inside the element is handled: the -'normal' way (where whitespace is collapsed), as 'pre' (which behaves -like the 'PRE' element in HTML) or as 'nowrap' (where wrapping is done -only through BR elements): - -@example - PRE @{ white-space: pre @} - P @{ white-space: normal @} -@end example - -@node list-style-type, list-style-image, white-space, Classification -@subsubsection list-style-type - -@multitable @columnfractions .2 .8 -@item Value: @tab disc | circle | square | decimal | lower-roman | upper-roman | lower-alpha | upper-alpha | none -@item Initial: @tab disc -@item Applies to: @tab elements with 'display' value 'list-item' -@item Inherited: @tab yes -@item Percentage values: @tab N/A -@end multitable - -This property is used to determine the appearance of the list-item -marker if 'list-style-image' is 'none' or if the image pointed to by the -URL cannot be displayed. - -Fo example: -@example - OL @{ list-style-type: decimal @} /* 1 2 3 4 5 etc. */ - OL @{ list-style-type: lower-alpha @} /* a b c d e etc. */ - OL @{ list-style-type: lower-roman @} /* i ii iii iv v etc. */ -@end example - -@node list-style-image, list-style-position, list-style-type, Classification -@subsubsection list-style-image - -@multitable @columnfractions .2 .8 -@item Value: @tab <url> | none -@item Initial: @tab none -@item Applies to: @tab elements with 'display' value 'list-item' -@item Inherited: @tab yes -@item Percentage values: @tab N/A -@end multitable - -This property sets the image that will be used as the list-item -marker. When the image is available it will replace the marker set with -the 'list-style-type' marker. - -NOTE: This is currently unimplemented in Emacs/W3. - -@example - UL @{ list-style-image: url(http://png.com/ellipse.png) @} -@end example - -@node list-style-position, list-style, list-style-image, Classification -@subsubsection list-style-position - -@multitable @columnfractions .2 .8 -@item Supported Values: @tab outside -@item Unsupported Values: @tab inside -@item Initial: @tab outside -@item Applies to: @tab elements with 'display' value 'list-item' -@item Inherited: @tab yes -@item Percentage values: @tab N/A -@end multitable - -The value of 'list-style-position' determines how the list-item marker -is drawn with regard to the content. For a formatting example see -section 4.1.3. - -@node list-style, , list-style-position, Classification -@subsubsection list-style - -@multitable @columnfractions .2 .8 -@item Value: @tab <keyword> || <position> || <url> -@item Initial: @tab not defined for shorthand properties -@item Applies to: @tab elements with 'display' value 'list-item' -@item Inherited: @tab yes -@item Percentage values: @tab N/A -@end multitable - -The 'list-style' property is a shorthand notation for setting the three -properties 'list-style-type', 'list-style-image' and -'list-style-position' at the same place in the style sheet. - -@example - UL @{ list-style: upper-roman inside @} - UL UL @{ list-style: circle outside @} - LI.square @{ list-style: square @} -@end example - -Setting 'list-style' directly on 'LI' elements can have unexpected -results. Consider: - -@example - <STYLE TYPE="text/css"> - OL.alpha LI @{ list-style: lower-alpha @} - UL LI @{ list-style: disc @} - </STYLE> - <BODY> - <OL CLASS=alpha> - <LI>level 1 - <UL> - <LI>level 2 - </UL> - </OL> - </BODY> -@end example - -Since the specificity (as defined in the cascading order) is higher for -the first rule in the style sheet in the example above, it will override -the second rule on all 'LI' elements and only 'lower-alpha' list styles -will be used. It is therefore recommended to set 'list-style' only on -the list type elements: - -@example - OL.alpha @{ list-style: lower-alpha @} - UL @{ list-style: disc @} -@end example - -In the above example, inheritance will transfer the 'list-style' values -from 'OL' and 'UL' elements to 'LI' elements. - -A URL value can be combined with any other value: - -@example - UL @{ list-style: url(http://png.com/ellipse.png) disc @} -@end example - -In the example above, the 'disc' will be used when the image is -unavailable. - -@node Media Selection, Speech Properties, Classification, Properties -@subsection Media Selection - -To specify that a stylesheet declaration should only apply when using a -certain media type (ie: different font families preferred when printing -versus on-screen presentation), the declarations should be wrapped in -the proposed @b{@@media} directive. - -The @@media directive takes two arguments, the media type, and a block -of style declarations. - -@example - @@media print @{ - BODY @{ font-size: 10pt @} - H1 @{ font-size: 14pt @} - @} -@end example -The '@@media' construct also allows to put include style sheet rules -for various media in the same style sheet: - -@example - @@media print @{ - BODY @{ font-size: 10pt @} - @} - @@media screen @{ - BODY @{ font-size: 12pt @} - @} -@end example - -Currently, the following media types are defined. -@table @b -@item Print -Output for paged opaque material, and for documents viewed on screen in -print preview mode. -@item Screen -A continuous presentation for computer screens. -@item Projector -Paged presentation for projected presentations. -@item Braille -For braille tactile feedback devices. -@item Speech -Aural presentation. -@item Light -The stylesheet will only be applied if the user is using a light background. -@item Dark -The stylesheet will only be applied if the user is using a dark background. -@item Emacs -The stylesheet will only be applied if the user is running in Emacs 19. -@item XEmacs -The stylesheet will only be applied if the user is running in XEmacs 19. -@item All -The default value, the style sheet applies to all output devices. -@end table - -@node Speech Properties, , Media Selection, Properties -@subsection Speech Properties - -Those of us who are sighted are accustomed to visual presentation of -@sc{html} documents, frequently on a bitmapped display. This is not the -only possible presentation method, however. Aural presentation, using a -combination of speech synthesis and 'audio icons', provides an -alternative presentation. This form of presentation is in current use by -the blind and print-impaired communities. - -Often such aural presentation occurs by converting the document to plain -text and feeding this to a 'screen reader' -- software or hardware that -simply reads all the characters on the screen. This results in less -effective presentation than would be the case if the document structure -were retained. - -There are other large markets for aural presentation, including in-car -and home entertainment use; aurual or mixed aural/visual presentation is -thus likely to increase in importance over the next few years. Realizing -that that the aural rendering is essentially independent of the visual -rendering: - -@itemize @bullet -@item -Allows orthogonal aural and visual views. -@item -Allows browsers to optionally implement both aural and visual views to -produce truly multimodal documents. -@end itemize - -@menu -* volume:: -* pause-before:: -* pause-after:: -* pause:: -* cue-before:: -* cue-after:: -* cue:: -* play-during:: -* speed:: -* voice-family:: -* pitch:: -* pitch-range:: -* stress:: -* richness:: -* speak-punctuation:: -* speak-date:: -* speak-numeral:: -* speak-time:: -@end menu - -@node volume, pause-before, Speech Properties, Speech Properties -@subsubsection volume - -@multitable @columnfractions .2 .8 -@item Value: @tab <percentage> | mute | x-soft | soft | medium | loud | x-loud -@item Initial: @tab medium -@item Applies to: @tab all elements -@item Inherited: @tab yes -@item Percentage values: @tab relative to user-specified mapping -@end multitable - -The legal range of percentage values is 0% to 100%. There is a fixed -mapping between keyword values and percentages: - -@itemize @bullet -@item -'x-soft' = '0%' -@item -'soft' = '25%' -@item -'medium' = '50%' -@item -'loud' = '75%' -@item -'x-loud' = '100%' -@end itemize - -Volume refers to the median volume of the waveform. In other words, a -highly inflected voice at a volume of 50 might peak well above -that. Note that '0%' does not mean the same as "mute". 0% represents the -minimum audible volume level and 100% corresponds to the maximum -comfortable level. The UA should allow the values corresponding to 0% -and 100% to be set by the user. Suitable values depend on the equipment -in use (speakers, headphones), the environment (in car, home theater, -library) and personal preferences. Some examples: - -@itemize @bullet -@item -A browser for in-car use has a setting for when there is lots of -background noise . 0% would map to a fairly high level and 100% to a -quite high level. The overall values are likely to be human adjustable -for comfort, for example with a physical volume control: what this -proposal does is adjust the dynamic range. -@item -Another speech browser is being used in the home, late at night, (don't -annoy the neighbors) or in a shared study room. 0% is set to very quiet -and 100% to a fairly quiet level, too. As with the first example, there -is a low slope; the dynamic range is reduced. The actual volumes are low -here, wheras they were high in the first example. -@item -In a quiet and isolated house, an expensive hifi home theatre setup. 0% -is set fairly low and 100% to quite high; there is wide dynamic range. -@end itemize - -The same authors stylesheet could be used in all cases, simply by -mapping the 0 and 100 points suitably at the client side. - -@node pause-before, pause-after, volume, Speech Properties -@subsubsection pause-before - -@multitable @columnfractions .2 .8 -@item Value: @tab <time> | <percentage> -@item Initial: @tab UA specific -@item Applies to: @tab all elements -@item Inherited: @tab no -@item Percentage values: @tab speed -@end multitable - -This property specifies the pause before elements. It may be given in an -absolute units (seconds, milliseconds) or as a relative value in which -case it is relative to the reciprocal of the 'speed' property: if speed -is 120 words per minute (ie a word takes half a second -- 500 -milliseconds) then a pause-before of 100% means a pause of 500 ms and a -pause-before of 20% means 100ms. - -Using relative units gives more robust stylesheets in the face of large -changes in speed. - -@node pause-after, pause, pause-before, Speech Properties -@subsubsection pause-after - -@multitable @columnfractions .2 .8 -@item Value: @tab <time> | <percentage> -@item Applies to: @tab all elements -@item Inherited: @tab no -@item Percentage values: @tab speed -@end multitable - -This property specifies the pause after elements. Values are specified -the same way as 'pause-before'. - -@node pause, cue-before, pause-after, Speech Properties -@subsubsection pause - -@multitable @columnfractions .2 .8 -@item Value: @tab [<time> | <percentage> ]@{1,2@}; -@item Applies to: @tab all elements -@item Inherited: @tab no -@item Percentage values: @tab speed -@end multitable - -The 'pause' property is a shorthand for setting 'pause-before' and -'pause-after'. The first value is pause-before and the second is -pause-after. If only one value is given, it applies to both properties. - -Examples: - -@example - H1 @{ pause: 20ms @} /* pause-before: 20ms; pause-after: 20ms */ - H2 @{ pause: 30ms 40ms @} /* pause-before: 30ms; pause-after: 40ms */ - H3 @{ pause-after: 10ms @} /* pause-before: ?; pause-after: 10ms */ -@end example - -@node cue-before, cue-after, pause, Speech Properties -@subsubsection cue-before - -@multitable @columnfractions .2 .8 -@item Value: @tab <url> | none -@item Initial: @tab none -@item Applies to: @tab all elements -@item Inherited: @tab no -@end multitable -Auditory icons are another way to distinguish semantic elements. Sounds -may be played before, and/or after the element to delimit it. The same -sound can be used both before and after, using the cue property. - -Examples: - -@example - A @{ cue-before: url(bell.aiff); cue-after: url(dong.wav) @} - H1 @{ cue-before: url(pop.au); cue-after: url(pop.au) @} - H1 @{ cue: url(pop.au) @} /* same as previous */ -@end example - -@node cue-after, cue, cue-before, Speech Properties -@subsubsection cue-after - -@xref{cue-before} - -@node cue, play-during, cue-after, Speech Properties -@subsubsection cue - -@xref{cue-before} - -@node play-during, speed, cue, Speech Properties -@subsubsection cue-during - -@multitable @columnfractions .2 .8 -@item Value: @tab <url> | mix | none -@item Initial: @tab mix -@item Applies to: @tab all elements -@item Inherited: @tab no -@end multitable -Similar to the cue-before and cue-after properties, this indicates sound -to be played during an element as a background (ie the sound is mixed in -with the speech). - -Examples: - -@example - BLOCKQUOTE.sad @{ cue-during: url(violins.aiff) @} -@end example - -@node speed, voice-family, play-during, Speech Properties -@subsubsection speed - -@multitable @columnfractions .2 .8 -@item Value: @tab <words-per-minute> | x-slow | slow | medium | fast | x-fast | faster | slower -@item Initial: @tab medium -@item Applies to: @tab all elements -@item Inherited: @tab yes -@end multitable - -Specifies the speaking rate. Note that both absolute and relative -keyword values are allowed (compare with @ref{font-weight}). - -@node voice-family, pitch, speed, Speech Properties -@subsubsection voice-family - -@multitable @columnfractions .2 .8 -@item Value: @tab [[<specific-voice> | <generic-voice>],]* [<specific-voice> | <generic-voice>] -@item Initial: @tab device-specific -@item Applies to: @tab all elements -@item Inherited: @tab yes -@end multitable - -The value is a prioritized list of voice family names. Generic families -are male, female, and child. - -Examples of specific voice families are: comedian, paul, lisa - -Examples - -@example - H1 @{ voice-family: announcer, male @} - P.part.romeo @{ voice-family: romeo, male @} - P.part.juliet @{ voice-family: juliet, female @} -@end example - -@node pitch, pitch-range, voice-family, Speech Properties -@subsubsection pitch - -@multitable @columnfractions .2 .8 -@end multitable - -@node pitch-range, stress, pitch, Speech Properties -@subsubsection pitch-range - -@multitable @columnfractions .2 .8 -@end multitable - -@node stress, richness, pitch-range, Speech Properties -@subsubsection stress - -@multitable @columnfractions .2 .8 -@item Value: @tab <percentage> -@item Initial: @tab medium -@item Applies to: @tab all elements -@item Inherited: @tab yes -@end multitable - -Specifies the level of stress (assertiveness or emphasis) of the -speaking voice. English is a stressed language, and different parts of a -sentence are assigned primary, secondary or tertiary stress. The value -of property 'stress' controls the amount of inflection that results from -these stress markers. - -Increasing the value of this property results in the speech being more -strongly inflected. It is in a sense dual to property 'pitch-range' and -is provided to allow developers to exploit higher-end auditory displays. - -@node richness, speak-punctuation, stress, Speech Properties -@subsubsection richness - -@multitable @columnfractions .2 .8 -@item Value: @tab <percentage> -@item Initial: @tab medium (50%) -@item Applies to: @tab all elements -@item Inherited: @tab yes -@end multitable - -Specifies the richness (brightness) of the speaking voice. Different -speech devices may require the setting of one or more device-specific -parameters to achieve this effect. - -The effect of increasing richness is to produce a voice that carries -- -reducing richness produces a soft, mellifluous voice. - -@node speak-punctuation, speak-date, richness, Speech Properties -@subsubsection speak-punctuation - -@multitable @columnfractions .2 .8 -@item Value: @tab code | none -@item Initial: @tab none -@item Applies to: @tab all elements -@item Inherited: @tab yes -@end multitable - -'code' indicates that punctuation such as semicolons, braces, and so on -are to be spoken literally. The default value of 'none' means that -punctuation is not spoken but instead is rendered naturally as various -pauses. - -@node speak-date, speak-numeral, speak-punctuation, Speech Properties -@subsubsection speak-date - -@multitable @columnfractions .2 .8 -@item Value: @tab myd | dmy | ymd | none -@item Initial: @tab none -@item Applies to: @tab all elements -@item Inherited: @tab no -@end multitable - -This is a hint that the element contains a date and also how that date -should be spoken. month-day-year is common in the USA, while -day-month-year is common in Europe and year-month-day is also used. - -This should really be an HTML tag not a stylesheet property, since it -gives semantic information about the content. - -@node speak-numeral, speak-time, speak-date, Speech Properties -@subsubsection speak-numeral - -@multitable @columnfractions .2 .8 -@item Value: @tab digits | continous -@item Initial: @tab none -@item Applies to: @tab all elements -@item Inherited: @tab yes -@end multitable - -@node speak-time, , speak-numeral, Speech Properties -@subsubsection speak-time - -@multitable @columnfractions .2 .8 -@item Value: @tab 24 | 12 | none -@item Initial: @tab none -@item Applies to: @tab all elements -@item Inherited: @tab yes -@end multitable - -@node Units, , Properties, Stylesheets -@section Units - -@menu -* Length Units:: -* Percentage Units:: -* Color Units:: -* URLs:: -* Angle Units:: -* Time Units:: -@end menu - -@node Length Units, Percentage Units, Units, Units -@subsection Length Units - -@node Percentage Units, Color Units, Length Units, Units -@subsection Percentage Units - -@node Color Units, URLs, Percentage Units, Units -@subsection color Units - -@node URLs, Angle Units, Color Units, Units -@subsection URLs - -@node Angle Units, Time Units, URLs, Units -@subsection Angle Units - -These are the legal angle units: -@itemize @bullet -@item -deg: degrees -@item -grad -@item -rad: radians -@end itemize - -@node Time Units, , Angle Units, Units -@subsection Time Units - -These are the legal time units: - -@itemize @bullet -@item -ms: milliseconds -@item -s: seconds -@end itemize - -@node Supported URLs, MIME Support, Stylesheets, Top -@chapter Supported URLs - -::WORK:: List supported URL types, specific RFCs, etc. - -@menu -* file:: Local file access. -* ftp:: Remote file access via ftp. -* nfs:: Remote file access via NFS. -* info:: Access to the Emacs Info system. -* http/https:: @sc{http/1.0} support. -* mailto:: Sending simple electronic mail. -* news/nntp/snews:: Reading and sending Usenet news. -* rlogin/telnet/tn3270:: Legacy host connections. -* irc:: Internet Relay Chat. -* data:: Embedding the data within the URL itself. -* mailserver:: Slightly more complicated electronic mail. -* gopher:: Gopher and Gopher+. -* finger:: The old favorite. -@end menu - -@node file, ftp, Supported URLs, Supported URLs -@section file - -@node ftp, nfs, file, Supported URLs -@section ftp - -@node nfs, info, ftp, Supported URLs -@section nfs - -@node info, http/https, nfs, Supported URLs -@section info - -@node http/https, mailto, info, Supported URLs -@section http/https - -@node mailto, news/nntp/snews, http/https, Supported URLs -@section mailto - -@node news/nntp/snews, rlogin/telnet/tn3270, mailto, Supported URLs -@section news/nntp/snews - -@node rlogin/telnet/tn3270, irc, news/nntp/snews, Supported URLs -@section rlogin/telnet/tn3270 - -@node irc, data, rlogin/telnet/tn3270, Supported URLs -@section irc - -@node data, mailserver, irc, Supported URLs -@section data - -@node mailserver, gopher, data, Supported URLs -@section mailserver - -@node gopher, finger, mailserver, Supported URLs -@section gopher - -@node finger, , gopher, Supported URLs -@section finger - -@node MIME Support, Security, Supported URLs, Top -@chapter MIME Support -@sc{mime} is an emerging standard for multimedia mail. It offers a very -flexible typing mechanism. The type of a file or message is specified -in two parts, separated by a '/'. The first part is the general -category of the data (text, application, image, etc.). The second part -is the specific type of data (postscript, png, jpeg, etc.). So -@samp{text/html} specifies an @sc{html} document, whereas -@samp{image/x-xwindowdump} specifies an image of an Xwindow taken with -the @file{xwd} program. - - -This typing allows much more flexibility in naming files. @sc{http}/1.0 -servers can now send back content-type headers in response to a request, -and not have the client second-guess it based on file extensions. @sc{html} -files can now be named @file{something.png} (not a great idea, but -possible). - -@menu -* Adding MIME types based on file extensions:: How to map file - extensions onto MIME - types (e.g., @samp{.png -> - image/png)}. -* Specifying Viewers:: How to specify external and internal viewers - for files that Emacs/W3 cannot handle natively. -@end menu - -@node Adding MIME types based on file extensions, Specifying Viewers, MIME Support, MIME Support -@section Adding MIME types based on file extensions - -@vindex mm-mime-extensions -For some protocols however, it is still necessary to guess the content -of a file based on the file extension. This type of guess-work should -only be needed when accessing files via @sc{ftp}, local file access, or old -@sc{http}/0.9 servers. - -Instead of specifying how to view things twice, once based on -content-type and once based on the file extension, it is easier to map -file extensions to MIME content-types. The variable that controls this -is @code{mm-mime-extensions}. - -This variable is an assoc list of file extensions and the corresponding -MIME content-type. A sample entry looks like: @samp{(".movie" -. "video/x-sgi-movie")} This makes all files that end in @file{.movie} -(@file{foo.movie} and @file{bar.movie}) be interpreted as SGI animation -files. If a content-type is defined for the document, then this is -over-ridden. Regular expressions can @b{NOT} be used. - -@cindex mime-types file -@findex mm-parse-mimetypes -Both Mosaic and the NCSA @sc{http} daemon rely on a separate file for mapping -file extensions to MIME types. Instead of having the users of Emacs/W3 -duplicate this in lisp, this file can be parsed using the -@code{url-parse-mimetypes} function. This function is called each time -w3 is loaded. It tries to locate mimetype files in several places. If -the environment variable @code{MIMETYPES} is nonempty, then this is -assumed to specify a UNIX-like path of mimetype files (this is a colon -separated string of pathnames). If the @code{MIMETYPES} environment -variable is empty, then Emacs/W3 looks for these files: - -@enumerate -@item -@file{~/.mime-types} -@item -@file{/etc/mime-types} -@item -@file{/usr/etc/mime-types} -@item -@file{/usr/local/etc/mime-types} -@item -@file{/usr/local/www/conf/mime-types} -@end enumerate - -Each line contains information for one @sc{http} type. These types resemble -MIME types. To add new ones, use subtypes beginning with x-, such as -application/x-myprogram. Lines beginning with # are comment lines, and -suitably ignored. Each line consists of: - -type/subtype ext1 ext2 ... ext@var{n} - -type/subtype is the MIME-like type of the document. ext* is any number -of space-separated filename extensions which correspond to the MIME -type. - -@node Specifying Viewers, , Adding MIME types based on file extensions, MIME Support -@section Specifying Viewers - -Not all files look as they should when parsed as an @sc{html} document -(whitespace is stripped, paragraphs are reformatted, and lots of little -changes that make the document look unrecognizable). Files may be -passed to external programs or Emacs Lisp functions to be viewed. - -Not all files can be viewed accurately from within an Emacs session (PNG -files for example, or audio files). For this reason, the user can -specify file "viewers" based on MIME content-types. This is done with -a standard mailcap file. @xref{Mailcap Files} - -@findex mm-add-mailcap-entry -As an alternative, the function @code{mm-add-mailcap-entry} can also be -used from an appropriate hook.@xref{Hooks} This functions takes three -arguments, the major type ("@i{image}"), the minor type ("@i{png}"), and -an assoc list of information about the viewer. Please see the @sc{url} -documentation for more specific information on what this assoc list -should look like. - -@node Security, Non-Unix Operating Systems, MIME Support, Top -@chapter Security -@cindex Security -@cindex Paranoia -There are an increasing number of ways to authenticate a user to a web -service. Emacs/W3 tries to support as many as possible. Emacs/W3 -currently supports: - -@table @b -@item Basic Authentication -@cindex Security, Basic -@cindex HTTP/1.0 Authentication -@cindex Authentication, Basic -The weakest authentication available, not recommended if serious -security is necessary. This is simply a string that looks like -@samp{user:password} that has been Base64 encoded, as defined in RFC -1421. -@item Digest Authentication -@cindex Security, Digest -@cindex HTTP/1.0 Authentication -@cindex Authentication, Digest -Jeffery L. Hostetler, John Franks, Philip Hallam-Baker, Ari Luotonen, -Eric W. Sink, and Lawrence C. Stewart have an internet draft for a new -authentication mechanism. For the complete specification, please see -draft-ietf-http-digest-aa-01.txt in the nearest internet drafts -archive@footnote{One is ftp://ds.internic.net/internet-drafts}. -@item SSL Encryption -@cindex HTTP/1.0 Authentication -@cindex Secure Sockets Layer -@cindex SSL -@cindex Gag Puke Retch -@cindex Exportability -@cindex Export Restrictions -SSL is the @code{Secure Sockets Layer} interface developed by Netscape -Communications @footnote{http://www.netscape.com/}. Emacs/W3 supports -@sc{http} transfers over an SSL encrypted channel, if the appropriate files -have been installed.@xref{Installing SSL} -@end table - -@node Non-Unix Operating Systems, Speech Integration, Security, Top -@chapter Non-Unix Operating Systems -@cindex Non-Unix Operating Systems - -@menu -* VMS:: The wonderful world of VAX|AXP-VMS! -* OS/2:: The next-best thing to Unix. -* MS-DOS:: The wonderful world of MS-DOG! -* Windows:: Windows NT, Chicago/Windows 95. -@end menu - -@node VMS, OS/2, Non-Unix Operating Systems, Non-Unix Operating Systems -@section VMS -@cindex VAX-VMS -@cindex AXP-VMS -@cindex Digital VMS -@cindex VMS - -:: WORK :: VMS Specific instriuctions - -@node OS/2, MS-DOS, VMS, Non-Unix Operating Systems -@section OS/2 -@cindex OS/2 -@cindex Warp - -:: WORK :: OS/2 Specific instructions - -@node MS-DOS, Windows, OS/2, Non-Unix Operating Systems -@section MS-DOS -@cindex MS-DOS -@cindex Microsloth -@cindex DOS -@cindex MS-DOG - -:: WORK :: DOS Specific instructions - -@node Windows, , MS-DOS, Non-Unix Operating Systems -@section Windows -@cindex Windows (32-Bit) -@cindex 32-Bit Windows -@cindex Microsloth -@cindex Windows '95 - -:: WORK :: 32bit Windows Specific instructions - -@node Speech Integration, Advanced Features, Non-Unix Operating Systems, Top -@chapter Speech Integration - -:: WORK :: Emacspeak integration - -@node Advanced Features, More Help, Speech Integration, Top -@chapter Advanced Features - -@menu -* Disk Caching:: Improving performance by using a local disk cache -* Interfacing to Mail/News:: How to make VM understand hypertext links -* Debugging HTML:: How to make Emacs/W3 display warnings about invalid - @sc{html}/@sc{html}+ constructs. -* Hooks:: Various hooks to use throughout Emacs/W3 -* Other Variables:: Miscellaneous variables that control the real - guts of Emacs/W3. -@end menu - -@node Disk Caching, Interfacing to Mail/News, Advanced Features, Advanced Features -@section Disk Caching -@cindex Caching -@cindex Persistent Cache -@cindex Disk Cache - -A cache stores the information on a page on the local machine. When -requesting a page that is in the cache, Emacs/W3 can retrieve the page -from the cache more quickly than retrieving the page again from its -location out on the network. With a well-populated cache, browsing the -web is dramatically faster. - -The first time a page is requested, Emacs/W3 retrieves the page from the -network. When requesting a page that is in the cache, Emacs/W3 checks -to see if the page has changed since it was last retrieved from the -remote machine. If it has not changed, the local copy is used, saving -the transmission of the file over the network. - -@vindex url-automatic-caching -@cindex Turning on caching -@cindex Cleaning the cache -@cindex Clearing the cache -@cindex Cache cleaning -@cindex Limiting the size of the cache -To turn on disk caching, set the variable @code{url-automatic-caching} -to non-@code{nil}, or choose the 'Caching' menu item (under `Options'). -That is all there is to it. Running the @code{clean-cache} shell script -fist is recommended, to allow for future cleaning of the cache. This -shell script will remove all files that have not been accessed since it -was last run. To keep the cache pared down, it is recommended that this -script be run from @i{at} or @i{cron} (see the manual pages for -crontab(5) or at(1) for more information) - - -@cindex Relying on cache -@cindex Cache only mode -@cindex Standalone mode -@cindex Browsing with no network connection -@cindex Netless browsing -@vindex url-standalone-mode -With a large cache of documents on the local disk, it can be very handy -when traveling, or any other time the network connection is not active -(a laptop with a dial-on-demand PPP connection, etc). Emacs/W3 can rely -solely on its cache, and avoid checking to see if the page has changed -on the remote server. In the case of a dial-on-demand PPP connection, -this will keep the phone line free as long as possible, only bringing up -the PPP connection when asking for a page that is not located in the -cache. This is very useful for demonstrations as well. To turn this -feature on, set the variable @code{url-standalone-mode} to -non-@code{nil}, or choose the `Use Cache Only' menu item (under -`Options') - -@node Interfacing to Mail/News, Debugging HTML, Disk Caching, Advanced Features -@section Interfacing to Mail/News -@cindex Interfacing to Mail/News -@cindex VM -@cindex Using Emacs/W3 with VM -@cindex GNUS -@cindex Using Emacs/W3 with Gnus -@cindex RMAIL -@cindex Using Emacs/W3 with RMAIL - -More and more people are including @sc{url}s in their signatures, and within -the body of mail messages. It can get quite tedious to type these into -the minibuffer to follow one. - -@vindex browse-url-browser-function -With the latest versions of VM (the 5.9x series of betas) and Gnus -(5.x), @sc{url}s are automatically highlighted, and can be followed with the -mouse or the return key. How the @sc{url}s are viewed is determined by the -variable @code{browse-url-browser-function}, and it should be set to the -symbol @code{browse-url-w3}. - -To access @sc{url}s from within RMAIL, the following hook should do the -trick. -@example -(add-hook 'rmail-mode-hook - (function - (lambda () - (define-key rmail-mode-map [mouse-2] 'w3-maybe-follow-link-mouse) - (define-key rmail-mode-map "\r" 'w3-maybe-follow-link)))) -@end example - -@node Debugging HTML, Hooks, Interfacing to Mail/News, Advanced Features -@section Debugging HTML -@cindex Debugging -@cindex Invalid HTML -@cindex Bad HTML -@vindex w3-debug-buffer -@vindex w3-debug-html - -For those people that are adventurous, or are just as anal as I am about -people writing valid @sc{html}, set the variable @code{w3-debug-html} to -@code{t} and see what happens. - - -If a Emacs/W3 thinks it has encountered invalid @sc{html}, then a debugging -message is displayed. - -:: WORK :: Need to list the different values w3-debug-html can have, and@* -:: WORK :: what they do :: - -@node Hooks, Other Variables, Debugging HTML, Advanced Features -@section Hooks -@cindex Hooks - -These are the various hooks that can be used to customize some of -Emacs/W3's behavior. They are arranged in the order in which they would -happen when retrieving a document. These are all 'normal hooks' in -standard Emacs-terminology, meaning they are functions (or lists of -functions) that are called consecutively. - -@table @code -@vindex w3-load-hook -@item w3-load-hook -These hooks are run the first time a @sc{url} is fetched. All the -Emacs/W3 variables are initialized before this hook is run. -@item w3-mode-hook -These hooks are run after a buffer has been parsed and displayed, but -before any inlined images are downloaded and converted. -@item w3-source-file-hook -These hooks are run after displaying a document's source. -@end table - -@node Other Variables, , Hooks, Advanced Features -@section Miscellaneous variables - -There are lots of variables that control the real nitty-gritty of Emacs/W3 -that the beginning user probably shouldn't mess with. Here they are. - -@table @code -@item url-bad-port-list -@vindex url-bad-port-list -List of ports to warn the user about connecting to. Defaults to just -the mail and @sc{nntp} ports so a malicious @sc{html} author cannot spoof mail or -news to other people. -@item url-confirmation-func -@vindex url-confirmation-func -What function to use for asking yes or no functions. Possible values -are @code{'yes-or-no-p} or @code{'y-or-n-p}, or any function that takes -a single argument (the prompt), and returns @code{t} only if a positive -answer is gotten. Defaults to @code{'yes-or-no-p}. -@item w3-default-action -@vindex w3-default-action -A lisp symbol specifying what action to take for files with extensions -that are not in the @code{mm-mime-extensions} assoc list. This is -useful in case Emacs/W3 ever run across files with weird extensions -(.foo, .README, .READMEFIRST, etc.). In most circumstances, this should -not be required anymore. - -Possible values: any lisp symbol. Should be a function that takes no -arguments. The return value does not matter, it is ignored. Some examples -are @code{'w3-prepare-buffer} or @code{'indented-text-mode}. -@ignore -@item w3-icon-directory-list -@vindex w3-icon-directory-list -A list of directorys to look in for the w3 standard icons... must end -in a /! If the directory @code{data-directory}/w3 exists, then this is -automatically added to the default value of -http://cs.indiana.edu/elisp/w3/icons/. -@end ignore -@item w3-keep-old-buffers -@vindex w3-keep-old-buffers -Whether to keep old buffers around when following links. To avoid lots -of buffers in one Emacs session, set this variable to @code{nil}. I -recommend setting it to @code{t}, so that backtracking from one link to -another is faster. - -@item url-passwd-entry-func -@vindex url-passwd-entry-func -This is a symbol indicating which function to call to read in a -password. If this variable is @code{nil} at startup, it is initialized -depending on whether @dfn{EFS} or @dfn{ange-ftp} is being used. This -function should accept the prompt string as its first argument, and the -default value as its second argument. - -@item w3-reuse-buffers -@vindex w3-reuse-buffers -Determines what happens when @code{w3-fetch} is called on a document -that has already been loaded into another buffer. Possible values are: -@code{nil}, @code{yes}, and @code{no}. @code{nil} will ask the user if -Emacs/W3 should reuse the buffer (this is the default value). A value of -@code{yes} means assume the user wants to always reuse the buffer. A -value of @code{no} means assume the user always wants to re-fetch the -document. -@item w3-show-headers -@vindex w3-show-headers -This is a list of @sc{http}/1.0 headers to show at the end of a buffer. All -the headers should be in lowercase. They are inserted at the end of the -buffer in a <UL> list. Alternatively, if this is simply @code{t}, then -all the @sc{http}/1.0 headers are shown. The default value is -@code{nil}. -@item w3-show-status, url-show-status -@vindex url-show-status -@vindex w3-show-status -Whether to show progress messages in the minibuffer. -@code{w3-show-status} controls if messages about the parsing are -displayed, and @code{url-show-status} controls if a running total of the -number of bytes transferred is displayed. These Can cause a large -performance hit if using a remote X display over a slow link, or a -terminal with a slow modem. -@item mm-content-transfer-encodings -@vindex mm-content-transfer-encodings -An assoc list of @var{Content-Transfer-Encodings} or -@var{Content-Encodings} and the appropriate decoding algorithms for each. -If the @code{cdr} of a node is a list, then this specifies the decoder is -an external program, with the program as the first item in the list, and -the rest of the list specifying arguments to be passed on the command line. -If using an external decoder, it must accept its input from @code{stdin} -and send its output to @code{stdout}. - -If the @code{cdr} of a node is a symbol whose function definition is -non-@code{nil}, then that encoding can be handled internally. The function -is called with 2 arguments, buffer positions bounding the region to be -decoded. The function should completely replace that region with the -unencoded information. - -Currently supported transfer encodings are: base64, x-gzip, 7bit, 8bit, -binary, x-compress, x-hqx, and quoted-printable. -@item url-uncompressor-alist -@vindex url-uncompressor-alist -An assoc list of file extensions and the appropriate uncompression -programs for each. This is used to build the Accept-encoding header for -@sc{http}/1.0 requests. -@end table - -@node More Help, Future Directions, Advanced Features, Top -@chapter More Help -@cindex Relevant Newsgroups -@cindex Newsgroups -@cindex Support -For more help on Emacs/W3, please send me mail -(@i{wmperry@@cs.indiana.edu}). Several discussion lists have also been -created for Emacs/W3. To subscribe, send mail to -@i{majordomo@@indiana.edu}, with the body of the message 'subscribe -@var{listname} @var{<email addres>}'. All other mail should go to -@i{<listname>@@indiana.edu}. - - -@itemize @bullet -@item -w3-announce -- this list is for anyone interested in Emacs/W3, and -should in general only be used by me. The gnu.emacs.sources newsgroup -and a few other mailing lists are included on this. Please only use -this list for major package releases related to Emacs/W3. -(@i{www-announce@@w3.org} is included on this list). -@item -w3-beta -- this list is for beta testers of Emacs/W3. These brave souls test -out not-quite stable code. -@item -w3-dev -- a list consisting of myself and a few other people who are -interested in the internals of Emacs/W3, and doing active development work. -Pretty dead right now, but I hope it will grow. -@end itemize - -For more help on the World Wide Web in general, please refer to the -comp.infosystems.www.* newsgroups. There are also several discussion -lists concerning the Web. Send mail to @i{<listname>-request@@w3.org} -with a subject line of 'subscribe <listname>'. All mail should go to -@i{<listname>@@w3.org}. Administrative mail should go to -@i{www-admin@@w3.org}. The lists are: - - -@itemize @bullet -@item -www-talk -- for general discussion of the World Wide Web, where its -going, new features, etc. All the major developers are subscribed to -this list. -@item -www-announce -- for announcements concerning the World Wide Web. Server -changes, new servers, new software, etc. -@end itemize - -As a last resort, mail me. I'll try to answer as quickly as I can. - -@node Future Directions, Reporting Bugs, More Help, Top -@chapter Future Directions -Changes are constantly being made to the Emacs browser (hopefully all -for the better). This is a list of the things that are being worked on -right now. - -:: WORK :: Revamp the todo list - -@node Reporting Bugs, Dealing with Firewalls, Future Directions, Top -@appendix Reporting Bugs -@cindex Reporting Bugs -@cindex Bugs -@cindex Contacting the author - -If any bugs are discovered in Emacs/W3, please report them to the -mailing list @t{w3-beta@@indiana.edu} - this is where the brave souls -who beta test the latest versions of Emacs/W3 reside, and are generally -very responsive to bug reports. - -@kindex w -Please make sure to use the bug submission feature of Emacs/W3, so that -all relevant information will be sent along with your bug report. By -default this is bound to the `@key{w}' key when in an Emacs/W3 buffer, -or you can use @key{M-x w3-submit-bug} from anywhere within Emacs. - -For problems that are causing emacs to signal and error, please send a -backtrace. You can get a backtrace by @kbd{M-x setvariable RET -debug-on-error RET t RET}, and then reproduce the error. - -If the problem is visual, please capture a copy of the output and mail -it along with the bug report (preferably as a MIME attachment, but -anything will do). You can use the @code{xwd} program under X-windows -for this, or @key{Alt-PrintScreen} under Windows 95/NT. Sorry, but I -don't remember what the magic incarnation is for doing a screen dump -under NeXTstep or OS/2. - -If the problem is actually causing Emacs to crash, then you will need to -also mail the maintainers of the various Emacs distributions with the -bug. Please use the @t{gnu.emacs.bug} newgroup for reporting bugs with -GNU Emacs 19, and @t{comp.emacs.xemacs} for reporting bugs with XEmacs -19 or XEmacs 20. I am actively involved with the beta testing of the -latest versions of both branches of Emacs, and if I can reproduce the -problem, I will do my best to see it gets fixed in the next release. - -It is also important to always maintain as much context as possible in -your responses. I get so much email from my various Emacs-activities -and work, that I cannot remember everything. If you send a bug report, -and I send you a reply, and you reply with 'no that didn't work', then -odds are I will have no clue what didn't work, much less what that was -trying to fix in the first place. It will be much quicker and less -painful if I don't have to waste a round-trip email exchange saying -'what are you talking about'. - -@node Dealing with Firewalls, Proxy Gateways, Reporting Bugs, Top -@appendix Dealing with Firewalls -By default, Emacs can support standard @sc{tcp}/@sc{ip} network -connections on almost all the platforms it runs on (Unix, @sc{vms}, -Windows, etc). However, there are several situations where it is not -sufficient. - -@table @b -@cindex Firewalls -@item Firewalls -It is becoming more and more common to be behind a firewall or some -other system that restricts your outbound network activity, especially -if you are like me and away from the wonderful world of academia. -Emacs/W3 has several different methods to get around firewalls (not to -worry though - none of them should get you in trouble with the local -@sc{mis} department.) - -@item Emacs cannot resolve hostnames. -@cindex Faulty hostname resolvers -@cindex Broken SunOS libc -@cindex Hostname resolution -This happens quite often on SunOS workstations and some ULTRIX machines. -Some C libraries do not include the hostname resolver routines in their -static libraries. If Emacs was linked statically, and was not linked -with the resolver libraries, it wil not be able to get to any machines -off the local network. This is characterized by being able to reach -someplace with a raw ip number, but not its hostname -(@url{http://129.79.254.191/} works, but -@url{http://www.cs.indiana.edu/} doesn't). - -The best solution for this problem is to recompile Emacs, making sure to -either link dynamically (if available on your operating system), or -include the @file{-lresolv}. - -@cindex url-gateway-broken-resolution -If you do not have the disk space or the appropriate permissions to -recompile Emacs, another alternative is using the @file{nslookup} -program to do hostname resolution. To turn this on, set the variable -@code{url-gateway-broken-resolution} in your @file{~/.emacs} file. This -runs the program specified by @code{url-gateway-nslookup-program} (by -default "@code{nslookup}" to do hostname resolution. This program should -expect a single argument on the command line - the hostname to resolve, -and should produce output similar to the standard Unix @file{nslookup} -program: - -@example -Name: www.cs.indiana.ed -Address: 129.79.254.191 -@end example - -@cindex @sc{term} -@item Using @sc{term} (or @sc{term}-like) Networking Software -@sc{term} @footnote{@sc{term} is a user-level protocol for emulating -@sc{ip} over a serial line. More information is available at -@url{ftp://sunsite.unc.edu/pub/Linux/apps/comm/term}} for slip-like -access to the internet. - -@sc{note}: XEmacs and Emacs 19.22 or later have patches to enable native -@sc{term} networking. To enable it, @code{#define TERM} in the -appropriate s/*.h file for the operating system, then change the -@code{SYSTEM_LIBS} definition to include the @file{termnet} library that -comes with the latest versions of @sc{term}. - -If you run into any problems with the native @sc{term} networking -support in Emacs or XEmacs, please let @t{wmperry@@cs.indiana.edu} know, -as he is responsible for the original support. -@end table - -@vindex url-gateway-local-host-regexp -Emacs/W3 has support for using the gateway mechanism for certain -domains, and directly connecting to others. The variable -@code{url-gateway-local-host-regexp} controls this behaviour. This is a -regular expression @footnote{Please see the full Emacs distribution for -a description of regular expressions} that matches local hosts that do -not require the use of a gateway. If @code{nil}, then all connections -are made through the gateway. - -@vindex url-gateway-method -Emacs/W3 supports several methods of getting around gateways. The -variable @code{url-gateway-method} controls which of these methods is -used. This variable can have several values (use these as symbol names, -not strings), ie: @samp{(setq url-gateway-method 'telnet)}. Possible -values are: - -@table @dfn -@item telnet -Use this method if you must first telnet and log into a gateway host, -and then run telnet from that host to connect to outside machines. - -:: WORK :: document telnet gw variables@* -This section needs more information, specifically documenting the -following variables. For now, please do @key{C-h v} on the variable for -more information. - -@table @code -@item url-gateway-telnet-host -@item url-gateway-telnet-parameters -@item url-gateway-telnet-password-prompt -@item url-gateway-telnet-puser-name -@item url-gateway-prompt-pattern -@end table - -@item rlogin -This method is identical to the @code{telnet} method, but uses -@file{rlogin} to log into the remote machine without having to send the -username and password over the wire every time. - -:: WORK :: document rlogin gw variables@* -This section needs more information, specifically documenting the -following variables. For now, please do @key{C-h v} on the variable for -more information. - -@table @code -@item url-gateway-rlogin-host -@item url-gateway-rlogin-parameters -@item url-gateway-rlogin-user-name -@item url-gateway-prompt-pattern -@end table - -@item tcp -Masanobu UMEDA (@i{umerin@@mse.kyutech.ac.jp}) has written a very small -application that you can run in a subprocess to do the network -connections. - -@item @sc{socks} -Use if the firewall has a @sc{socks} gateway running on it. - -:: WORK :: document socks variables@* -This section needs more information, specifically documenting the -following variables. For now, please do @key{C-h v} on the variable for -more information. - -@table @code -@item socks-host -@item socks-password -@item socks-username -@item socks-port -@item socks-timeout -@end table - -@c @item ssl -@c This probably shouldn't be documented - -@item native -This means that Emacs/W3 should use the builtin networking code of -Emacs. This should be used only if there is no firewall, or the Emacs -source has already been hacked to get around the firewall. -@end table - -Emacs/W3 should now be able to get outside the local network. If none -of this makes sense, its probably my fault. Please check with the -network administrators to see if they have a program that does most of -this already, since somebody somewhere at the company has probably been -through something similar to this before, and would be much more -helpful/knowledgeable about the local setup than I would be. But feel -free to mail me as a last resort. - -@node Proxy Gateways, Installing SSL, Dealing with Firewalls, Top -@appendix Proxy Gateways -@vindex url-proxy-services -@cindex Proxy Servers -@cindex Proxies -@cindex Proxies, environment variables -@cindex HTTP Proxy - -In late January 1993, Kevin Altis and Lou Montulli proposed and -implemented a new proxy service. This service requires the use of -environment variables to specify a gateway server/port # to send -protocol requests to. Each protocol (@sc{http}, @sc{wais}, gopher, -@sc{ftp}, etc.) can have a different gateway server. The environment -variables are @code{PROTOCOL}_proxy, where @code{PROTOCOL} is one of the -supported network protocols (gopher, file, @sc{http}, @sc{ftp}, etc.) - -@cindex No Proxy -@cindex Proxies, exclusion lists -@vindex NO_PROXY -For companies with internal intranets, it will usually be helpful to -define a list of hosts that should be contacted directly, @b{not} sent -through the proxy. The @code{NO_PROXY} environment variable controls -what hosts are able to be contacted directly. This should be a comma -separated list of hostnames, domain names, or a mixture of both. -Asterisks can be used as a wildcard. For example: - -@example -NO_PROXY=*.aventail.com,home.com,*.seanet.com -@end example - -tells Emacs/W3 to contact all machines in the @b{aventail.com} and -@b{seanet.com} domains directly, as well as the machine named -@b{home.com}. - -@vindex url-proxy-services -@cindex Proxies, setting from lisp -For those adventurous souls who enjoy writing regular expressions, all -the proxy settings can be manipulated from Emacs-Lisp. The variable -@code{url-proxy-services} controls this. This is an assoc list, keyed -on the protocol type (@sc{http}, gopher, etc) in all lowercase. The -@code{cdr} of each entry should be the fully-specified @sc{url} of the proxy -server to contact, or, in the case of the special "no_proxy" entry, a -regular expression that matches any hostnames that should be contacted -directly. - -@example -(setq url-proxy-services '(("http" . "http://proxy.aventail.com/") - ("no_proxy" . "^.*\\(aventail\\|seanet\\)\.com"))) -@end example - -@node Installing SSL, Mailcap Files, Proxy Gateways, Top -@appendix Installing SSL -@cindex HTTP/1.0 Authentication -@cindex Secure Sockets Layer -@cindex SSL -@cindex Gag Puke Retch -@cindex Exportability -@cindex Export Restrictions -In order to use SSL in Emacs/W3, an implementation of SSL is necessary. -Emacs/W3 is configued to work out of the box with SSLeay 0.6.6 or later. -For best results, you should apply a patch that makes the SSLeay client -much quieter about what it reports. - -You can download SSLeay from -@url{ftp://ftp.psy.uq.oz.au/pub/Crypto/SSL/} - -The following variables control how the external program is invoked. - -@table @code -@item ssl-program-name -@vindex ssl-program-name -The name of the program to run, as a string. - -@example -(setq ssl-program-name "s_client") -@end example - -@item ssl-program-arguments -@vindex ssl-program-arguments -This should be used if your SSL program needs command line switches to -specify any behaviour (certificate file locations, etc). This is a list -of strings and symbols. - -The special symbols 'host and 'port may be used in the list of arguments -and will be replaced with the hostname and service/port that will be -connected to. - -@example -(setq ssl-program-arguments '("-host" host "-port" service "-verify" "4" - "-CApath /usr/local/ssl/certs")) -@end example -@end table - -@node Mailcap Files, Down with DoubleClick, Installing SSL, Top -@appendix Mailcap Files -NCSA Mosaic and almost all other WWW browsers rely on a separate file -for mapping MIME types to external viewing programs. This takes some of -the burden off of browser developers, so each browser does not have to -support all image formats, or postscript, etc. Instead of having the -users of Emacs/W3 duplicate this in lisp, this file can be parsed using -the @code{mm-parse-mailcaps} function. This function is called each -time Emacs/W3 is loaded. It tries to locate mimetype files in several -places. If the environment variable @code{MAILCAPS} is nonempty, then -this is assumed to specify a UNIX-like path of mimetype files (this is a -colon separated string of pathnames). If the @code{MAILCAPS} -environment variable is empty, then Emacs/W3 looks for these -files: - -@enumerate -@item -@file{~/.mailcap} -@item -@file{/etc/mailcap} -@item -@file{/usr/etc/mailcap} -@item -@file{/usr/local/etc/mailcap} -@end enumerate - -This format of this file is specified in RFC 1343, but a brief synopsis -follows (this is taken verbatim from sections of RFC 1343). - -Each mailcap file consists of a set of entries that describe the proper -handling of one media type at the local site. For example, one line -might tell how to display a message in Group III fax format. A mailcap -file consists of a sequence of such individual entries, separated by -newlines (according to the operating system's newline -conventions). Blank lines and lines that start with the "#" character -(ASCII 35) are considered comments, and are ignored. Long entries may -be continued on multiple lines if each non-terminal line ends with a -backslash character ('\', ASCII 92), in which case the multiple lines -are to be treated as a single mailcap entry. Note that for such -"continued" lines, the backslash must be the last character on the line -to be continued. - -Each mailcap entry consists of a number of fields, separated by -semi-colons. The first two fields are required, and must occur in the -specified order. The remaining fields are optional, and may appear in -any order. - -The first field is the content-type, which indicates the type of data -this mailcap entry describes how to handle. It is to be matched against -the type/subtype specification in the "Content-Type" header field of an -Internet mail message. If the subtype is specified as "*", it is -intended to match all subtypes of the named content-type. - -The second field, view-command, is a specification of how the message or -body part can be viewed at the local site. Although the syntax of this -field is fully specified, the semantics of program execution are -necessarily somewhat operating system dependent. - -The optional fields, which may be given in any order, are as follows: -@itemize @bullet -@item -The "compose" field may be used to specify a program that can be used to -compose a new body or body part in the given format. Its intended use -is to support mail composing agents that support the composition of -multiple types of mail using external composing agents. As with the -view- command, the semantics of program execution are operating system -dependent. The result of the composing program may be data that is not -yet suitable for mail transport---that is, a Content-Transfer-Encoding -may need to be applied to the data. -@item -The "composetyped" field is similar to the "compose" field, but is to be -used when the composing program needs to specify the Content-type header -field to be applied to the composed data. The "compose" field is -simpler, and is preferred for use with existing (non-mail-oriented) -programs for composing data in a given format. The "composetyped" field -is necessary when the Content-type information must include auxilliary -parameters, and the composition program must then know enough about mail -formats to produce output that includes the mail type -information. -@item -The "edit" field may be used to specify a program that can be used to -edit a body or body part in the given format. In many cases, it may be -identical in content to the "compose" field, and shares the -operating-system dependent semantics for program execution. -@item -The "print" field may be used to specify a program that can be used to -print a message or body part in the given format. As with the -view-command, the semantics of program execution are operating system -dependent. -@item -The "test" field may be used to test some external condition (e.g. the -machine architecture, or the window system in use) to determine whether -or not the mailcap line applies. It specifies a program to be run to -test some condition. The semantics of execution and of the value -returned by the test program are operating system dependent. If the -test fails, a subsequent mailcap entry should be sought. Multiple test -fields are not permitted---since a test can call a program, it can -already be arbitrarily complex. -@item -The "needsterminal" field indicates that the view-command must be run on -an interactive terminal. This is needed to inform window-oriented user -agents that an interactive terminal is needed. (The decision is not -left exclusively to the view-command because in some circumstances it -may not be possible for such programs to tell whether or not they are on -interactive terminals.) The needsterminal command should be assumed to -apply to the compose and edit commands, too, if they exist. Note that -this is NOT a test---it is a requirement for the environment in which -the program will be executed, and should typically cause the creation of -a terminal window when not executed on either a real terminal or a -terminal window. -@item -The "copiousoutput" field indicates that the output from the -view-command will be an extended stream of output, and is to be -interpreted as advice to the UA (User Agent mail- reading program) that -the output should be either paged or made scrollable. Note that it is -probably a mistake if needsterminal and copiousoutput are both -specified. -@item -The "description" field simply provides a textual description, -optionally quoted, that describes the type of data, to be used -optionally by mail readers that wish to describe the data before -offering to display it. -@item -The "x11-bitmap" field names a file, in X11 bitmap (xbm) format, which -points to an appropriate icon to be used to visually denote the presence -of this kind of data. -@item -Any other fields beginning with "x-" may be included for local or -mailer-specific extensions of this format. Implementations should -simply ignore all such unrecognized fields to permit such extensions, -some of which might be standardized in a future version of this -document. -@end itemize - -@node Down with DoubleClick, General Index, Mailcap Files, Top -@appendix Down with DoubleClick -:: WORK :: Document why doubleclick is evil@* -:: WORK :: Document how you can never see another ad from them again - -@node General Index, Key Index, Down with DoubleClick, Top -@appendix General Index -@printindex fn -@node Key Index, , General Index, Top -@appendix Key Index -@printindex ky -@contents -@bye
--- a/src/ChangeLog Mon Aug 13 09:43:39 2007 +0200 +++ b/src/ChangeLog Mon Aug 13 09:44:42 2007 +0200 @@ -1,3 +1,29 @@ +1997-06-25 Steven L Baur <steve@altair.xemacs.org> + + * alloc.c (Flist): Optimize. + From Hrvoje Niksic. + +1997-06-23 Steven L Baur <steve@altair.xemacs.org> + + * lisp.h: Get uintptr_t stuffs because it is needed for including + emacsfns.h. + + * sysdep.h: Removed uintptr_t stuffs. + +1997-06-22 Steven L Baur <steve@altair.xemacs.org> + + * fns.c (concat): Replace Fcar/Fcdr with XCAR/XCDR. + (Fnreverse): Ditto. + (internal_equal): Ditto. + (internal_old_equal): Ditto. + (Fnconc): Ditto. + (Freverse): Saner implementation. + From Hrvoje Niksic <hniksic@srce.hr> + + * s/linux.h: getpgrp with glibc is now properly detected by + configure. + Suggested by Andreas Jaeger <aj@arthur.rhein-neckar.de> + 1997-06-20 Steven L Baur <steve@altair.xemacs.org> * events.c: Remove declaration of Qempty.
--- a/src/EmacsFrame.c Mon Aug 13 09:43:39 2007 +0200 +++ b/src/EmacsFrame.c Mon Aug 13 09:44:42 2007 +0200 @@ -590,6 +590,7 @@ EmacsFrame ew = (EmacsFrame) widget; int pixel_width, pixel_height; struct frame *f = ew->emacs_frame.frame; + Arg al [2]; if (columns < 3) columns = 3; /* no way buddy */ @@ -601,8 +602,7 @@ if (FRAME_X_TOP_LEVEL_FRAME_P (f)) x_wm_set_variable_size (FRAME_X_SHELL_WIDGET (f), columns, rows); - XtVaSetValues ((Widget) ew, - XtNwidth, (Dimension) pixel_width, - XtNheight, (Dimension) pixel_height, - NULL); + XtSetArg (al [0], XtNwidth, (Dimension) pixel_width); + XtSetArg (al [1], XtNheight, (Dimension) pixel_height); + XtSetValues ((Widget) ew, al, 2); }
--- a/src/EmacsShell-sub.c Mon Aug 13 09:43:39 2007 +0200 +++ b/src/EmacsShell-sub.c Mon Aug 13 09:44:42 2007 +0200 @@ -232,6 +232,7 @@ { int base_width, base_height; int cell_width, cell_height; + Arg al [10]; /* time to update them thar size hints */ cell_width = w->wm.size_hints.width_inc; @@ -250,14 +251,13 @@ printf (" base size set to: %d %d\n", base_width, base_height); fflush (stdout); #endif - XtVaSetValues ((Widget) w, - XtNbaseWidth, base_width, - XtNbaseHeight, base_height, - XtNminWidth, base_width + - cell_width * w->emacs_shell.min_width_cells, - XtNminHeight, base_height + - cell_height * w->emacs_shell.min_height_cells, - NULL); + XtSetArg(al [0], XtNbaseWidth, base_width); + XtSetArg(al [1], XtNbaseHeight, base_height); + XtSetArg(al [2], XtNminWidth, base_width + + cell_width * w->emacs_shell.min_width_cells); + XtSetArg(al [3], XtNminHeight, base_height + + cell_height * w->emacs_shell.min_height_cells); + XtSetValues ((Widget) w, al, 4); } static XtGeometryResult
--- a/src/Makefile.in.in Mon Aug 13 09:43:39 2007 +0200 +++ b/src/Makefile.in.in Mon Aug 13 09:44:42 2007 +0200 @@ -254,6 +254,8 @@ ${motif_other_files}\ libextcli_Xt.a libextcli_Xlib.a\ ${shared_other_files} + +all: ${other_files} # endif /* EXTERNAL_WIDGET */ X11_objs = EmacsFrame.o EmacsShell.o TopLevelEmacsShell.o TransientEmacsShell.o EmacsManager.o $(external_widget_objs) @@ -263,21 +265,7 @@ ## should not be told about. otherobjs = $(BTL_objs) lastfile.o $(mallocobjs) $(rallocobjs) $(X11_objs) - -LIBES = $(lwlib_libs) $(quantify_libs) $(ld_libs_all) $(GNULIB_VAR) - -## Enable recompilation of certain other files depending on system type. - -## Enable inclusion of object files in temacs depending on system type. -#ifndef OBJECTS_SYSTEM -#define OBJECTS_SYSTEM -#endif - -#ifndef OBJECTS_MACHINE -#define OBJECTS_MACHINE -#endif - -all: xemacs ${other_files} +LIBES = $(lwlib_libs) $(quantify_libs) $(ld_libs_all) $(lib_gcc) #ifdef I18N3 mo_dir = ${etcdir} @@ -342,9 +330,7 @@ dump-elcs: temacs @touch SATISFIED -${DUMPENV} ./temacs -batch -l ../prim/update-elc.el - @if [ ! -f SATISFIED ]; then \ - $(MAKE) dump-elcs; \ - fi + @if test ! -f SATISFIED; then $(MAKE) $@; fi @$(RM) SATISFIED all-elc all-elcs:
--- a/src/alloc.c Mon Aug 13 09:43:39 2007 +0200 +++ b/src/alloc.c Mon Aug 13 09:44:42 2007 +0200 @@ -39,6 +39,7 @@ #include <config.h> #include "lisp.h" +#include "sysdep.h" #ifndef standalone #include "backtrace.h" @@ -179,10 +180,10 @@ static long pureptr; #define PURIFIED(ptr) \ - ((PNTR_COMPARISON_TYPE) (ptr) < \ - (PNTR_COMPARISON_TYPE) (PUREBEG + PURESIZE) && \ - (PNTR_COMPARISON_TYPE) (ptr) >= \ - (PNTR_COMPARISON_TYPE) PUREBEG) + ((uintptr_t) (ptr) < \ + (uintptr_t) (PUREBEG + PURESIZE) && \ + (uintptr_t) (ptr) >= \ + (uintptr_t) PUREBEG) /* Non-zero if pureptr > PURESIZE; accounts for excess purespace needs. */ static long pure_lossage; @@ -1025,16 +1026,11 @@ */ (int nargs, Lisp_Object *args)) { - Lisp_Object len, val, val_tail; - - len = make_int (nargs); - val = Fmake_list (len, Qnil); - val_tail = val; - while (!NILP (val_tail)) - { - XCAR (val_tail) = *args++; - val_tail = XCDR (val_tail); - } + Lisp_Object val = Qnil; + Lisp_Object *argp = args + nargs; + + while (nargs-- > 0) + val = Fcons (*--argp, val); return val; }
--- a/src/device-x.c Mon Aug 13 09:43:39 2007 +0200 +++ b/src/device-x.c Mon Aug 13 09:44:42 2007 +0200 @@ -31,7 +31,7 @@ #include "xintrinsicp.h" /* CoreP.h needs this */ #include <X11/CoreP.h> /* Numerous places access the fields of a core widget directly. We could - use XtVaGetValues(), but ... */ + use XtGetValues(), but ... */ #include "xgccache.h" #include <X11/Shell.h> #include "xmu.h"
--- a/src/emacs.c Mon Aug 13 09:43:39 2007 +0200 +++ b/src/emacs.c Mon Aug 13 09:44:42 2007 +0200 @@ -84,6 +84,12 @@ /* Variable whose value is string giving configuration built for. */ Lisp_Object Vsystem_configuration; +/* Version numbers and strings */ +Lisp_Object Vemacs_major_version; +Lisp_Object Vemacs_minor_version; +Lisp_Object Vemacs_beta_version; +Lisp_Object Vxemacs_codename; + /* The name under which XEmacs was invoked, with any leading directory names discarded. */ Lisp_Object Vinvocation_name; @@ -126,7 +132,7 @@ /* If nonzero, this is the place to put the end of the writable segment at startup. */ -unsigned int bss_end = 0; +uintptr_t bss_end = 0; #endif /* Number of bytes of writable memory we can expect to be able to get */ @@ -2116,7 +2122,7 @@ conversion is applied everywhere. Don't worry about memory leakage because this call only happens once. */ unexec ((char *) intoname_ext, (char *) symname_ext, - (unsigned int) &my_edata, + (uintptr_t) &my_edata, 0, 0); } #endif /* not MSDOS and EMX */ @@ -2299,22 +2305,39 @@ */ ); Vsystem_configuration = Fpurecopy (build_string (EMACS_CONFIGURATION)); - DEFVAR_INT ("emacs-beta-version", &emacs_beta_version /* + DEFVAR_LISP ("emacs-major-version", &Vemacs_major_version /* +Major version number of this version of Emacs, as an integer. +Warning: this variable did not exist in Emacs versions earlier than: + FSF Emacs: 19.23 + XEmacs: 19.10 +*/ ); + Vemacs_major_version = make_int (EMACS_MAJOR_VERSION); + + DEFVAR_LISP ("emacs-minor-version", &Vemacs_minor_version /* +Minor version number of this version of Emacs, as an integer. +Warning: this variable did not exist in Emacs versions earlier than: + FSF Emacs: 19.23 + XEmacs: 19.10 +*/ ); + Vemacs_minor_version = make_int (EMACS_MINOR_VERSION); + + DEFVAR_LISP ("emacs-beta-version", &Vemacs_beta_version /* Beta number of this version of Emacs, as an integer. The value is nil if this is an officially released version of XEmacs. Warning: this variable does not exist in FSF Emacs or in XEmacs versions earlier than 20.3. */ ); -#ifndef EMACS_BETA_VERSION -#define EMACS_BETA_VERSION Qnil +#ifdef EMACS_BETA_VERSION + Vemacs_beta_version = make_int (EMACS_BETA_VERSION); +#else + Vemacs_beta_version = Qnil; #endif - emacs_beta_version = EMACS_BETA_VERSION; DEFVAR_LISP ("xemacs-codename", &Vxemacs_codename /* Codename of this version of Emacs (a string). */ ); #ifndef XEMACS_CODENAME -#define XEMACS_CODENAME Qnil +#define XEMACS_CODENAME "Noname" #endif Vxemacs_codename = Fpurecopy (build_string (XEMACS_CODENAME));
--- a/src/emacsfns.h Mon Aug 13 09:43:39 2007 +0200 +++ b/src/emacsfns.h Mon Aug 13 09:44:42 2007 +0200 @@ -1789,9 +1789,9 @@ /* Defined in unex*.c */ int unexec (char *new_name, char *a_name, - unsigned int data_start, - unsigned int bss_start, - unsigned int entry_address); + uintptr_t data_start, + uintptr_t bss_start, + uintptr_t entry_address); #ifdef RUN_TIME_REMAP int run_time_remap (char *); #endif
--- a/src/eval.c Mon Aug 13 09:43:39 2007 +0200 +++ b/src/eval.c Mon Aug 13 09:44:42 2007 +0200 @@ -477,7 +477,7 @@ and described by SIGNAL-DATA, should skip the debugger according to debugger-ignore-errors. */ -extern Lisp_Object Frunning_temacs_p(); +extern Lisp_Object Frunning_temacs_p(), Ferror_message_string(Lisp_Object obj); static int skip_debugger (Lisp_Object conditions, Lisp_Object data) @@ -485,11 +485,47 @@ Lisp_Object tail; int first_string = 1; Lisp_Object error_message; - - if (!NILP(Frunning_temacs_p()) || NILP(Vdebug_ignored_errors)) +#if 0 + struct gcpro gcpro1; +#endif + + /* Comment by Hrvoje Niksic: + For some reason, Ferror_message_string loses in temacs. This + should require some more consideration than this knee-jerk + solution, but it will do for now. For those interested in + debugging, here is what happens: + + In temacs, a condition-cased file-error occurs. Now, we enter + signal_call_debugger, which is supposed to decide whether we + should call debugger (for example, if `debug-on-signal' requires + it). signal_call_debugger calls skip_debugger, which calls + Ferror_message_string. Ferror_message_string in turn calls + print_error_message. For some unfathomable reason, the + expression + + errname = Fcar (data); + + fails with a `wrong-type-argument' error, which should not + happen, as the DATA argument is the very same Lisp_Object + skip_debugger was called with (which is in signal_call_debugger, + and the DATA argument is Fcons (FOO, BAR)). + + Of course, since an error is signaled, signal_call_debugger gets + called again, which calls skip_debugger, and we end up with a + beautiful endless recursion. + + The only explanation I can think of is that DATA should be + gc-protected during the way; I cannot test this, as I cannot + repeat all of this. The crash info comes from Steve. */ +#if 0 + if (!NILP(Frunning_temacs_p())) { - return 1; + return 0; } +#endif +#if 0 + GCPRO1(data); +#endif for (tail = Vdebug_ignored_errors; CONSP (tail); tail = XCDR (tail)) { @@ -497,23 +533,34 @@ { if (first_string) { -/* error_message = Ferror_message_string (data);*/ - error_message = build_string("Tell_Hrvoje"); + error_message = Ferror_message_string (data); +/* error_message = build_string("Tell_Hrvoje"); */ first_string = 0; } - if (fast_lisp_string_match (XCAR (tail), error_message) >= 0) + if (fast_lisp_string_match (XCAR (tail), error_message) >= 0) { +#if 0 + UNGCPRO; +#endif return 1; + } } else { Lisp_Object contail; for (contail = conditions; CONSP (contail); contail = XCDR (contail)) - if (EQ (XCAR (tail), XCAR (contail))) + if (EQ (XCAR (tail), XCAR (contail))) { +#if 0 + UNGCPRO; +#endif return 1; + } } } +#if 0 + UNGCPRO; +#endif return 0; }
--- a/src/event-Xt.c Mon Aug 13 09:43:39 2007 +0200 +++ b/src/event-Xt.c Mon Aug 13 09:44:42 2007 +0200 @@ -46,7 +46,7 @@ #include "xintrinsicp.h" /* CoreP.h needs this */ #include <X11/CoreP.h> /* Numerous places access the fields of a core widget directly. We could - use XtVaGetValues(), but ... */ + use XtGetValues(), but ... */ #ifdef HAVE_XIM #ifdef XIM_MOTIF #include <Xm/Xm.h>
--- a/src/fns.c Mon Aug 13 09:43:39 2007 +0200 +++ b/src/fns.c Mon Aug 13 09:44:42 2007 +0200 @@ -719,8 +719,8 @@ /* Fetch next element of `seq' arg into `elt' */ if (CONSP (seq)) { - elt = Fcar (seq); - seq = Fcdr (seq); + elt = XCAR (seq); + seq = XCDR (seq); } else { @@ -1733,8 +1733,9 @@ while (!NILP (tail)) { QUIT; - next = Fcdr (tail); - Fsetcdr (tail, prev); + CHECK_CONS (tail); + next = XCDR (tail); + XCDR (tail) = prev; prev = tail; tail = next; } @@ -1748,17 +1749,13 @@ */ (list)) { - Lisp_Object length; - Lisp_Object *vec; - Lisp_Object tail; - REGISTER int i; - - length = Flength (list); - vec = (Lisp_Object *) alloca (XINT (length) * sizeof (Lisp_Object)); - for (i = XINT (length) - 1, tail = list; i >= 0; i--, tail = Fcdr (tail)) - vec[i] = Fcar (tail); - - return Flist (XINT (length), vec); + Lisp_Object new; + + for (new = Qnil; CONSP (list); list = XCDR (list)) + new = Fcons (XCAR (list), new); + if (!NILP (list)) + list = wrong_type_argument (Qconsp, list); + return new; } static Lisp_Object list_merge (Lisp_Object org_l1, Lisp_Object org_l2, @@ -2887,10 +2884,10 @@ return 0; else if (CONSP (o1)) { - if (!internal_equal (Fcar (o1), Fcar (o2), depth + 1)) + if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1)) return 0; - o1 = Fcdr (o1); - o2 = Fcdr (o2); + o1 = XCDR (o1); + o2 = XCDR (o2); goto do_cdr; } @@ -2957,10 +2954,10 @@ return 0; else if (CONSP (o1)) { - if (!internal_old_equal (Fcar (o1), Fcar (o2), depth + 1)) + if (!internal_old_equal (XCAR (o1), XCAR (o2), depth + 1)) return 0; - o1 = Fcdr (o1); - o2 = Fcdr (o2); + o1 = XCDR (o1); + o2 = XCDR (o2); goto do_cdr; } @@ -3135,7 +3132,7 @@ while (CONSP (tem)) { tail = tem; - tem = Fcdr (tail); + tem = XCDR (tail); QUIT; }
--- a/src/frame-x.c Mon Aug 13 09:43:39 2007 +0200 +++ b/src/frame-x.c Mon Aug 13 09:44:42 2007 +0200 @@ -30,7 +30,7 @@ #include "xintrinsicp.h" /* CoreP.h needs this */ #include <X11/CoreP.h> /* Numerous places access the fields of a core widget directly. We could - use XtVaGetValues(), but ... */ + use XtGetValues(), but ... */ #include <X11/Shell.h> #include <X11/ShellP.h> #include "xmu.h" @@ -196,12 +196,14 @@ void x_wm_set_shell_iconic_p (Widget shell, int iconic_p) { + Arg al [1]; if (! XtIsWMShell (shell)) abort (); /* Because of questionable logic in Shell.c, this sequence can't work: w = XtCreatePopupShell (...); - XtVaSetValues (w, XtNiconic, True, NULL); + XtSetArg (al, XtNiconic, True); + XtSetValues (w, al, 1); XtRealizeWidget (w); The iconic resource is only consulted at initialization time (when @@ -216,27 +218,31 @@ realization. This is true of MIT X11R5 patch level 25, at least. (Apparently some other versions of Xt don't have this bug?) */ - XtVaSetValues (shell, XtNiconic, iconic_p, NULL); + XtSetArg(al [0], XtNiconic, iconic_p); + XtSetValues (shell, al, 1); EmacsShellSmashIconicHint (shell, iconic_p); } void x_wm_set_cell_size (Widget wmshell, int cw, int ch) { + Arg al [2]; + if (!XtIsWMShell (wmshell)) abort (); if (cw <= 0 || ch <= 0) abort (); - XtVaSetValues (wmshell, - XtNwidthInc, cw, - XtNheightInc, ch, - NULL); + XtSetArg (al [0], XtNwidthInc, cw); + XtSetArg (al [1], XtNheightInc, ch); + XtSetValues (wmshell, al, 2); } void x_wm_set_variable_size (Widget wmshell, int width, int height) { + Arg al [2]; + if (!XtIsWMShell (wmshell)) abort (); #ifdef DEBUG_GEOMETRY_MANAGEMENT @@ -244,10 +250,10 @@ printf ("x_wm_set_variable_size: %d %d\n", width, height); fflush (stdout); #endif - XtVaSetValues (wmshell, - XtNwidthCells, width, - XtNheightCells, height, - NULL); + + XtSetArg (al [0], XtNwidthCells, width); + XtSetArg (al [1], XtNheightCells, height); + XtSetValues (wmshell, al, 2); } /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS @@ -569,7 +575,7 @@ || EQ (property, Qbottom_toolbar_shadow_color) || EQ (property, Qbackground_toolbar_color) || EQ (property, Qtoolbar_shadow_thickness) -#endif +#endif /* HAVE_TOOLBARS */ || EQ (property, Qinter_line_space) || EQ (property, Qwindow_id) || STRINGP (property); @@ -639,7 +645,7 @@ Atom encoding = XA_STRING; String new_XtValue = (String) value; String old_XtValue = NULL; - Arg av[2]; + Arg al[2]; #ifdef MULE Bufbyte *ptr; @@ -656,13 +662,13 @@ #endif /* MULE */ /* ### Caching is device-independent - belongs in update_frame_title. */ - XtSetArg (av[0], Xt_resource_name, &old_XtValue); - XtGetValues (FRAME_X_SHELL_WIDGET (f), av, 1); + XtSetArg (al[0], Xt_resource_name, &old_XtValue); + XtGetValues (FRAME_X_SHELL_WIDGET (f), al, 1); if (!old_XtValue || strcmp (new_XtValue, old_XtValue)) { - XtSetArg (av[0], Xt_resource_name, new_XtValue); - XtSetArg (av[1], Xt_resource_encoding_name, encoding); - XtSetValues (FRAME_X_SHELL_WIDGET (f), av, 2); + XtSetArg (al[0], Xt_resource_name, new_XtValue); + XtSetArg (al[1], Xt_resource_encoding_name, encoding); + XtSetValues (FRAME_X_SHELL_WIDGET (f), al, 2); } } @@ -695,6 +701,7 @@ char uspos = !!(flags & (XValue | YValue)); char ussize = !!(flags & (WidthValue | HeightValue)); char *temp; + Arg al [1]; /* assign the correct size to the EmacsFrame widget ... */ EmacsFrameSetCharSize (FRAME_X_TEXT_WIDGET (f), w, h); @@ -718,7 +725,9 @@ } else temp = NULL; - XtVaSetValues (FRAME_X_SHELL_WIDGET (f), XtNgeometry, temp, NULL); + + XtSetArg (al [0], XtNgeometry, temp); + XtSetValues (FRAME_X_SHELL_WIDGET (f), al, 1); } /* Report to X that a frame property of frame S is being set or changed. @@ -737,6 +746,7 @@ Bool internal_border_width_specified = False; Lisp_Object tail; Widget w = FRAME_X_TEXT_WIDGET (f); + Arg al [10]; for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail))) { @@ -758,13 +768,13 @@ GET_STRING_CTEXT_DATA_ALLOCA (val, extval, extvallen); XtVaSetValues (w, XtVaTypedArg, extprop, - XtRString, extval, extvallen + 1, NULL); + XtRString, extval, extvallen + 1, + (XtArgVal) NULL); } else - XtVaSetValues (w, XtVaTypedArg, - extprop, XtRInt, XINT (val), - sizeof (int), - NULL); + XtVaSetValues (w, XtVaTypedArg, extprop, XtRInt, + XINT (val), sizeof (int), + (XtArgVal) NULL); } else if (SYMBOLP (prop)) { @@ -837,21 +847,19 @@ if (int_p) { CHECK_INT (val); - XtVaSetValues (w, (char *) XSTRING_DATA (str), - XINT (val), NULL); + XtSetArg (al [0], (char *) XSTRING_DATA (str), XINT (val)); + XtSetValues (w, al, 1); } else if (EQ (val, Qt)) - XtVaSetValues (w, - /* XtN... */ - (char *) XSTRING_DATA (str), - True, - NULL); + { + XtSetArg (al [0], (char *) XSTRING_DATA (str), True); /* XtN...*/ + XtSetValues (w, al, 1); + } else if (EQ (val, Qnil)) - XtVaSetValues (w, - /* XtN... */ - (char *) XSTRING_DATA (str), - False, - NULL); + { + XtSetArg (al [0], (char *) XSTRING_DATA (str), False); /* XtN...*/ + XtSetValues (w, al, 1); + } else { CHECK_STRING (val); @@ -861,7 +869,7 @@ XtRString, XSTRING_DATA (val), XSTRING_LENGTH (val) + 1, - NULL); + (XtArgVal) NULL); } #ifdef HAVE_SCROLLBARS @@ -1300,6 +1308,7 @@ char *geom = 0, *ew_geom = 0; Boolean iconic_p = False, ew_iconic_p = False; + Arg al [2]; Widget wmshell = FRAME_X_SHELL_WIDGET (f); /* #### This may not be an ApplicationShell any more, with the 'popup @@ -1354,14 +1363,17 @@ if (!FRAME_X_TOP_LEVEL_FRAME_P (f)) { - XtVaGetValues (ew, XtNgeometry, &ew_geom, NULL); + XtSetArg (al [0], XtNgeometry, &ew_geom); + XtGetValues (ew, al, 1); if (ew_geom) - frame_flags = XParseGeometry (ew_geom, &frame_x, &frame_y, - &frame_w, &frame_h); + frame_flags = XParseGeometry (ew_geom, + &frame_x, &frame_y, + &frame_w, &frame_h); if (! (frame_flags & (WidthValue | HeightValue))) { - XtVaGetValues (ew, XtNwidth, &frame_w, - XtNheight, &frame_h, NULL); + XtSetArg (al [0], XtNwidth, &frame_w); + XtSetArg (al [1], XtNheight, &frame_h); + XtGetValues (ew, al, 2); if (!frame_w && !frame_h) { frame_w = 64; @@ -1373,13 +1385,18 @@ EmacsFrameSetCharSize (ew, frame_w, frame_h); if (frame_flags & (XValue | YValue)) { - XtVaGetValues (ew, XtNwidth, &frame_w, - XtNheight, &frame_h, NULL); + XtSetArg (al [0], XtNwidth, &frame_w); + XtSetArg (al [1], XtNheight, &frame_h); + XtGetValues (ew, al, 2); + if (frame_flags & XNegative) frame_x += frame_w; if (frame_flags & YNegative) frame_y += frame_h; - XtVaSetValues (ew, XtNx, frame_x, XtNy, frame_y, NULL); + + XtSetArg (al [0], XtNx, frame_x); + XtSetArg (al [1], XtNy, frame_y); + XtSetValues (ew, al, 2); } return; } @@ -1391,40 +1408,48 @@ abort (); /* If the EmacsFrame doesn't have a geometry but the shell does, - treat that as the geometry of the frame. (Is this bogus? - I'm not sure.) */ + treat that as the geometry of the frame. + (Is this bogus? I'm not sure.) */ - XtVaGetValues (ew, XtNgeometry, &ew_geom, NULL); + XtSetArg (al [0], XtNgeometry, &ew_geom); + XtGetValues (ew, al, 1); if (!ew_geom) { - XtVaGetValues (wmshell, XtNgeometry, &geom, NULL); + XtSetArg (al [0], XtNgeometry, &geom); + XtGetValues (wmshell, al, 1); if (geom) { ew_geom = geom; - XtVaSetValues (ew, XtNgeometry, ew_geom, NULL); + XtSetArg (al [0], XtNgeometry, ew_geom); + XtSetValues (ew, al, 1); } } - /* If the Shell is iconic, then the EmacsFrame is iconic. (Is - this bogus? I'm not sure.) */ - XtVaGetValues (ew, XtNiconic, &ew_iconic_p, NULL); + /* If the Shell is iconic, then the EmacsFrame is iconic. + (Is this bogus? I'm not sure.) */ + XtSetArg (al [0], XtNiconic, &ew_iconic_p); + XtGetValues (ew, al, 1); if (!ew_iconic_p) { - XtVaGetValues (wmshell, XtNiconic, &iconic_p, NULL); + XtSetArg (al [0], XtNiconic, &iconic_p); + XtGetValues (wmshell, al, 1); if (iconic_p) { ew_iconic_p = iconic_p; - XtVaSetValues (ew, XtNiconic, iconic_p, NULL); + XtSetArg (al [0], XtNiconic, iconic_p); + XtSetValues (ew, al, 1); } } - - XtVaGetValues (app_shell, XtNgeometry, &geom, NULL); + + XtSetArg (al [0], XtNgeometry, &geom); + XtGetValues (app_shell, al, 1); if (geom) app_flags = XParseGeometry (geom, &app_x, &app_y, &app_w, &app_h); if (ew_geom) - frame_flags = XParseGeometry (ew_geom, &frame_x, &frame_y, - &frame_w, &frame_h); + frame_flags = XParseGeometry (ew_geom, + &frame_x, &frame_y, + &frame_w, &frame_h); if (first_x_frame_p (f)) { @@ -1467,11 +1492,13 @@ /* If the AppShell is iconic, then the EmacsFrame is iconic. */ if (!ew_iconic_p) { - XtVaGetValues (app_shell, XtNiconic, &iconic_p, NULL); + XtSetArg (al [0], XtNiconic, &iconic_p); + XtGetValues (app_shell, al, 1); if (iconic_p) { ew_iconic_p = iconic_p; - XtVaSetValues (ew, XtNiconic, iconic_p, NULL); + XtSetArg (al [0], XtNiconic, iconic_p); + XtSetValues (ew, al, 1); } } } @@ -1561,7 +1588,10 @@ /* The scrollbar positioning is completely handled by redisplay. We just need to know which sides they are supposed to go on. */ unsigned char scrollbar_placement; - XtVaGetValues (text, XtNscrollBarPlacement, &scrollbar_placement, NULL); + Arg al [1]; + + XtSetArg (al [0], XtNscrollBarPlacement, &scrollbar_placement); + XtGetValues (text, al, 1); f->scrollbar_on_left = (scrollbar_placement == XtTOP_LEFT || scrollbar_placement == XtBOTTOM_LEFT); f->scrollbar_on_top = (scrollbar_placement == XtTOP_LEFT || @@ -1621,7 +1651,7 @@ Window window_id = 0; #endif CONST char *name; - Arg av [25]; + Arg al [25]; int ac = 0; Widget text, container, shell; Widget parentwid = 0; @@ -1681,31 +1711,31 @@ FRAME_X_TOP_LEVEL_FRAME_P (f) = 1; ac = 0; - XtSetArg (av[ac], XtNallowShellResize, True); ac++; + XtSetArg (al[ac], XtNallowShellResize, True); ac++; #ifdef LWLIB_USES_MOTIF /* Motif sucks beans. Without this in here, it will delete the window out from under us when it receives a WM_DESTROY_WINDOW message from the WM. */ - XtSetArg (av[ac], XmNdeleteResponse, XmDO_NOTHING); ac++; + XtSetArg (al[ac], XmNdeleteResponse, XmDO_NOTHING); ac++; #endif #ifdef EXTERNAL_WIDGET if (window_id) { - XtSetArg (av[ac], XtNwindow, window_id); ac++; + XtSetArg (al[ac], XtNwindow, window_id); ac++; } else #endif /* EXTERNAL_WIDGET */ { - XtSetArg (av[ac], XtNinput, True); ac++; - XtSetArg (av[ac], (String) XtNminWidthCells, 10); ac++; - XtSetArg (av[ac], (String) XtNminHeightCells, 1); ac++; + XtSetArg (al[ac], XtNinput, True); ac++; + XtSetArg (al[ac], XtNminWidthCells, 10); ac++; + XtSetArg (al[ac], XtNminHeightCells, 1); ac++; } if (!NILP (parent)) { parentwid = FRAME_X_SHELL_WIDGET (XFRAME (parent)); - XtSetArg (av[ac], XtNtransientFor, parentwid); ac++; + XtSetArg (al[ac], XtNtransientFor, parentwid); ac++; } shell = XtCreatePopupShell ("shell", @@ -1718,14 +1748,13 @@ ), parentwid ? parentwid : DEVICE_XT_APP_SHELL (d), - av, ac); + al, ac); FRAME_X_SHELL_WIDGET (f) = shell; maybe_set_frame_title_format (shell); /* Create the manager widget */ - container = XtVaCreateWidget ("container", - emacsManagerWidgetClass, - shell, NULL); + container = XtCreateWidget ("container", + emacsManagerWidgetClass, shell, NULL, 0); FRAME_X_CONTAINER_WIDGET (f) = container; XtAddCallback (container, XtNresizeCallback, x_layout_widgets, (XtPointer) f); @@ -1733,12 +1762,9 @@ (XtPointer) f); /* Create the text area */ - ac = 0; - XtSetArg (av[ac], XtNborderWidth, 0); ac++; /* should this be settable? */ - XtSetArg (av[ac], (String) XtNemacsFrame, f); ac++; - text = XtCreateWidget (name, - emacsFrameClass, - container, av, ac); + XtSetArg (al [0], XtNborderWidth, 0); /* should this be settable? */ + XtSetArg (al [1], XtNemacsFrame, f); + text = XtCreateWidget (name, emacsFrameClass, container, al, 2); FRAME_X_TEXT_WIDGET (f) = text; #ifdef HAVE_MENUBARS @@ -1773,6 +1799,7 @@ { ShellWidget shell_widget = (ShellWidget) widget; XtGrabKind call_data = XtGrabNone; + Arg al [1]; XtCallCallbacks (widget, XtNpopupCallback, (XtPointer)&call_data); @@ -1783,11 +1810,13 @@ if (shell_widget->shell.create_popup_child_proc != NULL) (*(shell_widget->shell.create_popup_child_proc))(widget); - /* The XtVaSetValues below are not in XtPopup menu. We just want to + /* The XtSetValues below are not in XtPopup menu. We just want to make absolutely sure... */ - XtVaSetValues (widget, XtNmappedWhenManaged, False, NULL); + XtSetArg (al [0], XtNmappedWhenManaged, False); + XtSetValues (widget, al, 1); XtRealizeWidget (widget); - XtVaSetValues (widget, XtNmappedWhenManaged, True, NULL); + XtSetArg (al [0], XtNmappedWhenManaged, True); + XtSetValues (widget, al, 1); } #ifdef HAVE_CDE @@ -1995,11 +2024,10 @@ /* Store the X data into the widget. */ { - Arg av [10]; - int ac = 0; - XtSetArg (av [ac], XtNiconPixmap, x_pixmap); ac++; - XtSetArg (av [ac], XtNiconMask, x_mask); ac++; - XtSetValues (FRAME_X_SHELL_WIDGET (f), av, ac); + Arg al [2]; + XtSetArg (al [0], XtNiconPixmap, x_pixmap); + XtSetArg (al [1], XtNiconMask, x_mask); + XtSetValues (FRAME_X_SHELL_WIDGET (f), al, 2); } } @@ -2016,10 +2044,10 @@ x_get_frame_parent (struct frame *f) { Widget parentwid = 0; - Arg av[1]; + Arg al[1]; - XtSetArg (av[0], XtNtransientFor, &parentwid); - XtGetValues (FRAME_X_SHELL_WIDGET (f), av, 1); + XtSetArg (al[0], XtNtransientFor, &parentwid); + XtGetValues (FRAME_X_SHELL_WIDGET (f), al, 1); /* find the frame whose wid is parentwid */ if (parentwid) { @@ -2063,12 +2091,12 @@ Dimension frame_h = DisplayHeight (dpy, DefaultScreen (dpy)); Dimension shell_w, shell_h, shell_bord; int win_gravity; + Arg al [3]; - XtVaGetValues (w, - XtNwidth, &shell_w, - XtNheight, &shell_h, - XtNborderWidth, &shell_bord, - NULL); + XtSetArg (al [0], XtNwidth, &shell_w); + XtSetArg (al [1], XtNheight, &shell_h); + XtSetArg (al [2], XtNborderWidth, &shell_bord); + XtGetValues (w, al, 3); win_gravity = xoff >= 0 && yoff >= 0 ? NorthWestGravity : @@ -2084,11 +2112,10 @@ come back at the right place. We can't look at s->visible to determine whether it is iconified because it might not be up-to-date yet (the queue might not be processed). */ - XtVaSetValues (w, - XtNwinGravity, win_gravity, - XtNx, xoff, - XtNy, yoff, - NULL); + XtSetArg (al [0], XtNwinGravity, win_gravity); + XtSetArg (al [1], XtNx, xoff); + XtSetArg (al [2], XtNy, yoff); + XtSetValues (w, al, 3); /* Sometimes you will find that
--- a/src/frame.c Mon Aug 13 09:43:39 2007 +0200 +++ b/src/frame.c Mon Aug 13 09:44:42 2007 +0200 @@ -1403,12 +1403,39 @@ called_from_delete_device); if (NILP (next) || EQ (next, frame)) next = next_frame_internal (frame, Qt, Qt, called_from_delete_device); + + /* if we haven't found another frame at this point + then there aren't any. */ if (NILP (next) || EQ (next, frame)) ; - else if (EQ (frame, Fselected_frame (Qnil))) - Fselect_frame (next); else - set_device_selected_frame (d, next); + { + int did_select = 0; + /* if this is the global selected frame, select another one. */ + if (EQ (frame, Fselected_frame (Qnil))) + { + Fselect_frame (next); + did_select = 1; + } + /* + * If the new frame we just selected is on a different + * device then we still need to change DEVICE_SELECTED_FRAME(d) + * to a live frame, if there are any left on this device. + */ + if (!EQ (device, FRAME_DEVICE(XFRAME(next)))) + { + Lisp_Object next_f = + next_frame_internal (frame, Qt, device, + called_from_delete_device); + if (NILP (next_f) || EQ (next_f, frame)) + ; + else + set_device_selected_frame (d, next_f); + } + else if (! did_select) + set_device_selected_frame (d, next); + + } } /* Don't allow minibuf_window to remain on a deleted frame. */
--- a/src/lisp.h Mon Aug 13 09:43:39 2007 +0200 +++ b/src/lisp.h Mon Aug 13 09:44:42 2007 +0200 @@ -674,11 +674,6 @@ # define EMACS_UINT unsigned int #endif -/* Cast pointers to this type to compare them. Some machines want int. */ -#ifndef PNTR_COMPARISON_TYPE -# define PNTR_COMPARISON_TYPE unsigned int -#endif - /* Overridden by m/next.h */ #ifndef ASSERT_VALID_POINTER # define ASSERT_VALID_POINTER(pnt) (assert ((((EMACS_UINT) pnt) & 3) == 0)) @@ -1855,6 +1850,23 @@ #define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_)) #endif +#ifdef HAVE_INTTYPES_H +#include <inttypes.h> +#elif SIZEOF_VOID_P == SIZEOF_INT +typedef int intptr_t; +typedef unsigned int uintptr_t; +#elif SIZEOF_VOID_P == SIZEOF_LONG +typedef long intptr_t; +typedef unsigned long uintptr_t; +#elif defined(SIZEOF_LONG_LONG) && SIZEOF_VOID_P == SIZEOF_LONG_LONG +typedef long long intptr_t; +typedef unsigned long long uintptr_t; +#else +/* Just pray. May break, may not. */ +typedef char *intptr_t; +typedef char *uintptr_t; +#endif + #include "emacsfns.h" #endif /* _XEMACS_LISP_H_ */
--- a/src/m/alpha.h Mon Aug 13 09:43:39 2007 +0200 +++ b/src/m/alpha.h Mon Aug 13 09:44:42 2007 +0200 @@ -186,8 +186,6 @@ #define UNEXEC "unexalpha.o" -#define PNTR_COMPARISON_TYPE unsigned long - #if 0 /* XEmacs -- removed code to define XINT, etc. This gets
--- a/src/m/aviion.h Mon Aug 13 09:43:39 2007 +0200 +++ b/src/m/aviion.h Mon Aug 13 09:44:42 2007 +0200 @@ -100,10 +100,6 @@ #define ADDR_CORRECT(ADDR) ((int)ADDR) -/* Cast pointers to this type to compare them. */ - -#define PNTR_COMPARISON_TYPE void * - /* Some machines that use COFF executables require that each section start on a certain boundary *in the COFF file*. Such machines should define SECTION_ALIGNMENT to a mask of the low-order bits that must be
--- a/src/m/gould.h Mon Aug 13 09:43:39 2007 +0200 +++ b/src/m/gould.h Mon Aug 13 09:44:42 2007 +0200 @@ -160,10 +160,6 @@ #define C_DEBUG_SWITCH -/* Comparing pointers as unsigned ints tickles a bug in older compilers. */ - -#define PNTR_COMPARISON_TYPE int - /* The GOULD machine counts the a.out file header as part of the text. */ #define A_TEXT_OFFSET(HDR) sizeof (HDR)
--- a/src/menubar-x.c Mon Aug 13 09:43:39 2007 +0200 +++ b/src/menubar-x.c Mon Aug 13 09:44:42 2007 +0200 @@ -627,14 +627,19 @@ { Position shellx, shelly, framex, framey; Widget shell = XtParent (daddy); + Arg al [2]; btn->time = eev->timestamp; btn->button = eev->event.button.button; btn->root = RootWindowOfScreen (XtScreen (daddy)); btn->subwindow = (Window) NULL; btn->x = eev->event.button.x; btn->y = eev->event.button.y; - XtVaGetValues (shell, XtNx, &shellx, XtNy, &shelly, NULL); - XtVaGetValues (daddy, XtNx, &framex, XtNy, &framey, NULL); + XtSetArg (al [0], XtNx, &shellx); + XtSetArg (al [1], XtNy, &shelly); + XtGetValues (shell, al, 2); + XtSetArg (al [0], XtNx, &framex); + XtSetArg (al [1], XtNy, &framey); + XtGetValues (daddy, al, 2); btn->x_root = shellx + framex + btn->x; btn->y_root = shelly + framey + btn->y;; btn->state = ButtonPressMask; /* all buttons pressed */ @@ -785,24 +790,21 @@ FRAME_X_NUM_TOP_WIDGETS (f) = new_num_top_widgets; { /* We want to end up as close in size as possible to what we - were before. So, ask the EmacsManager what size it wants - to be (suggesting the current size), and resize it to that - size. It in turn will call our query-geometry callback, - which will round the size to something that exactly fits - the text widget. */ + were before. So, ask the EmacsManager what size it wants to be + (suggesting the current size), and resize it to that size. It + in turn will call our query-geometry callback, which will round + the size to something that exactly fits the text widget. */ XtWidgetGeometry req, repl; + Arg al [2]; req.request_mode = CWWidth | CWHeight; - XtVaGetValues (container, - XtNwidth, &req.width, - XtNheight, &req.height, - NULL); + XtSetArg (al [0], XtNwidth, &req.width); + XtSetArg (al [1], XtNheight, &req.height); + XtGetValues (container, al, 2); XtQueryGeometry (container, &req, &repl); - EmacsManagerChangeSize (container, repl.width, - repl.height); + EmacsManagerChangeSize (container, repl.width, repl.height); /* The window size might not have changed but the text size - did; thus, the base size might be incorrect. So update - it. */ + did; thus, the base size might be incorrect. So update it. */ EmacsShellUpdateSizeHints (FRAME_X_SHELL_WIDGET (f)); }
--- a/src/redisplay-x.c Mon Aug 13 09:43:39 2007 +0200 +++ b/src/redisplay-x.c Mon Aug 13 09:44:42 2007 +0200 @@ -2214,8 +2214,12 @@ struct frame *f = device_selected_frame (d); Widget shell = FRAME_X_SHELL_WIDGET (f); Dimension width, height; + Arg al [2]; - XtVaGetValues (shell, XtNwidth, &width, XtNheight, &height, NULL); + XtSetArg (al [0], XtNwidth, &width); + XtSetArg (al [1], XtNheight, &height); + XtGetValues (shell, al, 2); + XSETFRAME (frame, f); tmp_pixel = FACE_FOREGROUND (Vdefault_face, frame);
--- a/src/s/linux.h Mon Aug 13 09:43:39 2007 +0200 +++ b/src/s/linux.h Mon Aug 13 09:44:42 2007 +0200 @@ -211,8 +211,3 @@ /* XEmacs: removed setpgrp() definition because we use setpgid() when it's available, and autodetect it. */ - -/* glibc fuckage */ -#if defined __GLIBC__ && ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 1) || __GLIBC__ > 2) -# define GETPGRP_NEEDS_ARG -#endif
--- a/src/s/sunos4-0.h Mon Aug 13 09:43:39 2007 +0200 +++ b/src/s/sunos4-0.h Mon Aug 13 09:44:42 2007 +0200 @@ -71,15 +71,19 @@ extern int getpagesize (void); #ifndef __SUNPRO_C +/* Suppress zillions of warnings from outdated SunOS4 prototypes */ /* Bother! Sun can't even get the arg types right. */ -#include <string.h> /* But we need to include this first because - *sometimes* (i.e. when using SparcWorks) the - correct prototypes are provided. */ -#define memset(ptr, val, size) memset ((char *) ptr, val, size) -#define memcpy(dest, src, size) \ - memcpy ((char *) dest, (CONST char *) src, size) -#define memcmp(src1, src2, size) \ - memcmp ((CONST char *) src1, (CONST char *) src2, size) +#include <memory.h> +#include <string.h> +#define memset(a,b,c) memset((char*) (a), b, c) +#define memcpy(a,b,c) memcpy((char*) (a), (char*) (b), c) +#define memcmp(a,b,c) memcmp((char*) (a), (char*) (b), c) +#define memchr(a,b,c) memchr((char*) (a), b, c) +void * __builtin_alloca(int); +#ifdef HAVE_X_WINDOWS +#include <X11/Xlib.h> +#define XFree(p) XFree((char*)(p)) +#endif /* X Windows */ #endif /* !__SUNPRO_C */ #endif /* __STDC__ */ @@ -98,6 +102,6 @@ int mkdir (const char *dpath, unsigned short dmode) # endif /* __GNUC__ */ -#endif /* !NOT_C_CODE */ +#endif /* C_CODE */ #endif /* _S_SUNOS4_H_ */
--- a/src/s/sunos4-1.h Mon Aug 13 09:43:39 2007 +0200 +++ b/src/s/sunos4-1.h Mon Aug 13 09:44:42 2007 +0200 @@ -54,20 +54,3 @@ /* This appears to be broken on SunOS4.1.[123] */ #define BROKEN_SIGIO - -/* Suppress zillions of warnings from outdated SunOS4 prototypes */ -#ifndef NOT_C_CODE -#ifdef __SUNPRO_C -#include <memory.h> -#include <string.h> -#define memset(a,b,c) memset((char*) (a), b, c) -#define memcpy(a,b,c) memcpy((char*) (a), (char*) (b), c) -#define memcmp(a,b,c) memcmp((char*) (a), (char*) (b), c) -#define memchr(a,b,c) memchr((char*) (a), b, c) -void * __builtin_alloca(int); -#ifdef HAVE_X_WINDOWS -#include <X11/Xlib.h> -#define XFree(p) XFree((char*)(p)) -#endif /* X Windows */ -#endif /* __SUNPRO_C */ -#endif /* C code */
--- a/src/scrollbar-x.c Mon Aug 13 09:43:39 2007 +0200 +++ b/src/scrollbar-x.c Mon Aug 13 09:44:42 2007 +0200 @@ -187,9 +187,10 @@ update_one_scrollbar_bs (struct frame *f, Widget sb_widget) { Boolean use_backing_store; + Arg al [1]; - XtVaGetValues (FRAME_X_TEXT_WIDGET (f), - XtNuseBackingStore, &use_backing_store, NULL); + XtSetArg (al [0], XtNuseBackingStore, &use_backing_store); + XtGetValues (FRAME_X_TEXT_WIDGET (f), al, 1); if (use_backing_store && sb_widget) { @@ -308,8 +309,11 @@ /* mirror the value in the frame resources, unless it was already done. */ if (!in_resource_setting) - XtVaSetValues (FRAME_X_TEXT_WIDGET (f), XtNscrollBarWidth, - XINT (newval), NULL); + { + Arg al [1]; + XtSetArg (al [0], XtNscrollBarWidth, XINT (newval)); + XtSetValues (FRAME_X_TEXT_WIDGET (f), al, 1); + } if (XtIsRealized (FRAME_X_CONTAINER_WIDGET (f))) { @@ -350,8 +354,11 @@ did, we wouldn't want to overwrite the resource information (which might specify a user preference). */ if (!in_resource_setting) - XtVaSetValues (FRAME_X_TEXT_WIDGET (f), XtNscrollBarHeight, - XINT (newval), NULL); + { + Arg al [1]; + XtSetArg (al [0], XtNscrollBarHeight, XINT (newval)); + XtSetValues (FRAME_X_TEXT_WIDGET (f), al, 1); + } if (XtIsRealized (FRAME_X_CONTAINER_WIDGET (f))) {
--- a/src/toolbar-x.c Mon Aug 13 09:43:39 2007 +0200 +++ b/src/toolbar-x.c Mon Aug 13 09:44:42 2007 +0200 @@ -604,14 +604,17 @@ in_specifier_change_function++; if (!in_resource_setting) - /* mirror the value in the frame resources, unless it was already - done. */ - XtVaSetValues (FRAME_X_TEXT_WIDGET (f), - pos == TOP_TOOLBAR ? XtNtopToolBarHeight : - pos == BOTTOM_TOOLBAR ? XtNbottomToolBarHeight : - pos == LEFT_TOOLBAR ? XtNleftToolBarWidth : - XtNrightToolBarWidth, - newval, 0); + /* mirror the value in the frame resources, unless already done. */ + { + Arg al [1]; + XtSetArg (al [0], + pos == TOP_TOOLBAR ? XtNtopToolBarHeight : + pos == BOTTOM_TOOLBAR ? XtNbottomToolBarHeight : + pos == LEFT_TOOLBAR ? XtNleftToolBarWidth : + XtNrightToolBarWidth, + newval); + XtSetValues (FRAME_X_TEXT_WIDGET (f), al, 1); + } if (XtIsRealized (FRAME_X_CONTAINER_WIDGET (f))) { int change = newval - oldval; @@ -744,10 +747,10 @@ XtReleaseGC (ew, FRAME_X_TOOLBAR_BOTTOM_SHADOW_GC (f)); /* Seg fault if we try and use these again. */ - FRAME_X_TOOLBAR_BLANK_BACKGROUND_GC (f) = (GC) -1; - FRAME_X_TOOLBAR_PIXMAP_BACKGROUND_GC (f) = (GC) -1; - FRAME_X_TOOLBAR_TOP_SHADOW_GC (f) = (GC) -1; - FRAME_X_TOOLBAR_BOTTOM_SHADOW_GC (f) = (GC) -1; + FRAME_X_TOOLBAR_BLANK_BACKGROUND_GC (f) = (GC) - 1; + FRAME_X_TOOLBAR_PIXMAP_BACKGROUND_GC (f) = (GC) - 1; + FRAME_X_TOOLBAR_TOP_SHADOW_GC (f) = (GC) - 1; + FRAME_X_TOOLBAR_BOTTOM_SHADOW_GC (f) = (GC) - 1; } static void @@ -757,8 +760,9 @@ if (ef->emacs_frame.toolbar_shadow_thickness < MINIMUM_SHADOW_THICKNESS) { - XtVaSetValues (FRAME_X_TEXT_WIDGET (f), XtNtoolBarShadowThickness, - MINIMUM_SHADOW_THICKNESS, 0); + Arg al [1]; + XtSetArg (al [0], XtNtoolBarShadowThickness, MINIMUM_SHADOW_THICKNESS); + XtSetValues (FRAME_X_TEXT_WIDGET (f), al, 1); } x_initialize_frame_toolbar_gcs (f);
--- a/src/unexelfsgi.c Mon Aug 13 09:43:39 2007 +0200 +++ b/src/unexelfsgi.c Mon Aug 13 09:44:42 2007 +0200 @@ -497,6 +497,8 @@ #include <elf.h> #include <sym.h> /* for HDRR declaration */ #include <sys/mman.h> +#include <config.h> +#include "sysdep.h" /* in 64bits mode, use 64bits elf */ #ifdef _ABI64 @@ -606,9 +608,9 @@ void unexec (new_name, old_name, data_start, bss_start, entry_address) char *new_name, *old_name; - unsigned data_start, bss_start, entry_address; + uintptr_t data_start, bss_start, entry_address; { - extern unsigned int bss_end; + extern uintptr_t bss_end; int new_file, old_file, new_file_size; /* Pointers to the base of the image of the two files. */ @@ -680,7 +682,7 @@ old_bss_addr = OLD_SECTION_H (old_bss_index).sh_addr; old_bss_size = OLD_SECTION_H (old_bss_index).sh_size; #if defined(emacs) || !defined(DEBUG) - bss_end = (unsigned int) sbrk (0); + bss_end = (uintptr_t) sbrk (0); new_bss_addr = (l_Elf_Addr) bss_end; #else new_bss_addr = old_bss_addr + old_bss_size + 0x1234;