# HG changeset patch # User cvs # Date 1186992082 -7200 # Node ID eb54708826479b710c948480d71ba5fe45027944 # Parent f0deb0c0e6be2fdff03e9218536c043ed3ce79e5 Import from CVS: tag r20-3b27 diff -r f0deb0c0e6be -r eb5470882647 CHANGES-beta --- a/CHANGES-beta Mon Aug 13 10:00:35 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 10:01:22 2007 +0200 @@ -1,5 +1,9 @@ -*- indented-text -*- to 20.3 beta26 "Riga" +-- register declarations nuked by default +-- Miscellaneous patches from Martin Buchholz, Karl Hegbloom and Hrvoje Niksic +-- VC is now an XEmacs package +-- W3 is now an XEmacs package -- Miscellaneous bug fixes to 20.3 beta25 "Prague" diff -r f0deb0c0e6be -r eb5470882647 ChangeLog --- a/ChangeLog Mon Aug 13 10:00:35 2007 +0200 +++ b/ChangeLog Mon Aug 13 10:01:22 2007 +0200 @@ -1,3 +1,24 @@ +1997-10-04 SL Baur + + * XEmacs 20.3-beta27 is released. + +1997-10-03 Damon Lipparelli + + * Makefile.in (install-arch-indep): When --prefix != + --exec-prefix, symlink the system-independent bits into the + system-dependent directory structure (rather than the other way + around). + +1997-10-03 Martin Buchholz + + * lib-src/etags.c: etags 12.28 + prototypization + * INSTALL: Better document --site-runtime-libraries + * src/scrollbar-x.c (x_update_scrollbar_instance_status): + FIX: M-x scroll-left; horizontal scrollbar appears; drag it + left; scrollbar disappears; keyboard inoperative. + * configure.in: Remove left-over references to *_switch_x_* + - NAS libaudio is part of $libs_x, not $LIBS + 1997-10-02 SL Baur * XEmacs 20.3-beta26 is released. diff -r f0deb0c0e6be -r eb5470882647 INSTALL --- a/INSTALL Mon Aug 13 10:00:35 2007 +0200 +++ b/INSTALL Mon Aug 13 10:01:22 2007 +0200 @@ -58,7 +58,10 @@ libraries are statically linked. Use the --site-includes and --site-libraries options when building -XEmacs to allow configure to find the external software packages. +XEmacs to allow configure to find the external software packages. +If you link with dynamic (``.so'') external package libraries, which +is not recommended, you will also need to add the library directories +to the --site-runtime-libraries option. 3) In the top level directory of the XEmacs distribution, run the @@ -94,12 +97,33 @@ use with XEmacs (e.g. xpm, wnn, ...) described later should have their include and library directories defined using these options. -The `--site-runtime-libraries=DIR' option specifies additional -directories to search for shared libraries at run time. This may be -necessary on some systems, or if you expect some of the libraries used -to build XEmacs to be in a different directory at run time than at -build time. Usually this will add a `-R' to each directory specified -and use that when linking XEmacs. +The `--site-runtime-libraries=DIR' option specifies directories to +search for shared libraries at run time. This may be necessary if you +link with dynamic libraries that are installed in non-standard +directories, or if you expect some of the libraries used to build +XEmacs to be in a different directory at run time than at build time. +Usually this will add a `-R' to each directory specified and use that +when linking XEmacs. If you use this option, you must specify ALL of +the directories containing shared libraries at run time, including +system directories. + +Rationale: Some people think that directories in --site-libraries +should be automatically used to update --site-runtime-libraries. +Here's a real-life scenario that explains why this is not done: You +build binaries for your company using static libs in +/net/toy/hack/lib. XEmacs adds /net/toy/hack/lib to the runpath of +the executable you've built. Since there are only static libs there, +the system runtime loader will look in this dir, and ignore it, +causing only a .01 second delay in starting XEmacs. You leave the +company for a job at a small Silicon Valley startup. Time passes. +The next guy who inherits your machine objects to working on a machine +named `toy', and gets the sysadmin to rename the machine `godzilla'. +The SA forgets to remove the old entry for `toy' from the hosts file. +Now the system loader will still try to access /net/toy/, and the +automounter will hang trying to access /net/toy. XEmacs suddenly +takes 30 seconds longer to start up, no one can figure out why, and +everyone at your old company curses your name, thinking that you've +put a time bomb into XEmacs. And they're right! The `--with-gcc' option specifies that the build process should compile XEmacs using GCC. The `--compiler' option allows you to diff -r f0deb0c0e6be -r eb5470882647 Makefile.in --- a/Makefile.in Mon Aug 13 10:00:35 2007 +0200 +++ b/Makefile.in Mon Aug 13 10:01:22 2007 +0200 @@ -427,12 +427,18 @@ ${INSTALL_DATA} ${srcdir}/etc/$${page}.1 ${mandir}/$${page}${manext} ; \ chmod 0644 ${mandir}/$${page}${manext} ; \ done - if test "${prefix}" != "${exec_prefix}"; then : extreme bogosity follows; \ - test ! -d ${prefix}/bin && \ - $(LN_S) ${exec_prefix}/bin ${prefix}/bin; \ - test ! -d ${prefix}/lib/xemacs-${version}/${configuration} && \ - ${LN_S} ${exec_prefix}/lib/xemacs-${version}/${configuration} \ - ${prefix}/lib/xemacs-${version}/${configuration}; \ + if test "${prefix}" != "${exec_prefix}"; then \ + test ! -d ${exec_prefix}/lib/xemacs && \ + $(LN_S) ${prefix}/lib/xemacs ${exec_prefix}/lib/xemacs; \ + test ! -d ${exec_prefix}/lib/xemacs-${version}/etc && \ + $(LN_S) ${prefix}/lib/xemacs-${version}/etc \ + ${exec_prefix}/lib/xemacs-${version}/etc; \ + test ! -d ${exec_prefix}/lib/xemacs-${version}/info && \ + $(LN_S) ${prefix}/lib/xemacs-${version}/info \ + ${exec_prefix}/lib/xemacs-${version}/info; \ + test ! -d ${exec_prefix}/lib/xemacs-${version}/lisp && \ + $(LN_S) ${prefix}/lib/xemacs-${version}/lisp \ + ${exec_prefix}/lib/xemacs-${version}/lisp; \ fi @echo "If you would like to save approximately 15M of disk space, do" @echo "make gzip-el" diff -r f0deb0c0e6be -r eb5470882647 configure --- a/configure Mon Aug 13 10:00:35 2007 +0200 +++ b/configure Mon Aug 13 10:01:22 2007 +0200 @@ -2146,11 +2146,6 @@ #endif configure___ c_switch_system=C_SWITCH_SYSTEM -#ifndef C_SWITCH_X_SYSTEM -#define C_SWITCH_X_SYSTEM -#endif -configure___ c_switch_x_system=C_SWITCH_X_SYSTEM - #ifndef LD_SWITCH_MACHINE #define LD_SWITCH_MACHINE @@ -2162,11 +2157,6 @@ #endif configure___ ld_switch_system=LD_SWITCH_SYSTEM -#ifndef LD_SWITCH_X_SYSTEM -#define LD_SWITCH_X_SYSTEM -#endif -configure___ ld_switch_x_system=LD_SWITCH_X_SYSTEM - #ifndef UNEXEC #define UNEXEC "unexec.o" @@ -2292,7 +2282,7 @@ rm $tempcname test "$extra_verbose" = "yes" && \ - for var in libs_machine libs_system libs_termcap libs_standard objects_machine objects_system c_switch_machine c_switch_system c_switch_x_system ld_switch_machine ld_switch_system ld_switch_x_system unexec ld_switch_shared ld lib_gcc ld_text_start_addr start_files ordinary_link have_terminfo mail_use_flock mail_use_lockf; do eval "echo \"$var = '\$$var'\""; done && echo "" + for var in libs_machine libs_system libs_termcap libs_standard objects_machine objects_system c_switch_machine c_switch_system ld_switch_machine ld_switch_system unexec ld_switch_shared ld lib_gcc ld_text_start_addr start_files ordinary_link have_terminfo mail_use_flock mail_use_lockf; do eval "echo \"$var = '\$$var'\""; done && echo "" test "$ordinary_link" = "no" -a -z "$libs_standard" && libs_standard="-lc" @@ -2357,7 +2347,7 @@ fi echo $ac_n "checking for dynodump""... $ac_c" 1>&6 -echo "configure:2361: checking for dynodump" >&5 +echo "configure:2351: checking for dynodump" >&5 if test "$unexec" != "unexsol2.o"; then echo "$ac_t""no" 1>&6 else @@ -2428,19 +2418,19 @@ if test "$add_runtime_path" = "yes"; then echo $ac_n "checking "for runtime libraries flag"""... $ac_c" 1>&6 -echo "configure:2432: checking "for runtime libraries flag"" >&5 +echo "configure:2422: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2434: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* dash_r="$try_dash_r" else @@ -2538,7 +2528,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:2542: checking for $ac_word" >&5 +echo "configure:2532: checking for $ac_word" >&5 if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. @@ -2591,7 +2581,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:2595: checking for a BSD compatible install" >&5 +echo "configure:2585: checking for a BSD compatible install" >&5 if test -z "$INSTALL"; then IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS="${IFS}:" @@ -2642,7 +2632,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:2646: checking for $ac_word" >&5 +echo "configure:2636: checking for $ac_word" >&5 if test -n "$YACC"; then ac_cv_prog_YACC="$YACC" # Let the user override the test. @@ -2673,15 +2663,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2677: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2685: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2675: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2714,15 +2704,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2718: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2726: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2716: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2755,15 +2745,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2759: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2767: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2757: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2793,10 +2783,10 @@ done echo $ac_n "checking for sys/wait.h that is POSIX.1 compatible""... $ac_c" 1>&6 -echo "configure:2797: checking for sys/wait.h that is POSIX.1 compatible" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -2812,7 +2802,7 @@ s = WIFEXITED (s) ? WEXITSTATUS (s) : 1; ; return 0; } EOF -if { (eval echo configure:2816: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2806: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_sys_wait_h=yes else @@ -2836,10 +2826,10 @@ fi echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 -echo "configure:2840: checking for ANSI C header files" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -2847,7 +2837,7 @@ #include EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2851: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2841: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2864,7 +2854,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 @@ -2882,7 +2872,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 @@ -2900,7 +2890,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 < #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') @@ -2911,7 +2901,7 @@ exit (0); } EOF -if { (eval echo configure:2915: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:2905: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then : else @@ -2936,10 +2926,10 @@ fi echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6 -echo "configure:2940: checking whether time.h and sys/time.h may both be included" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -2948,7 +2938,7 @@ struct tm *tp; ; return 0; } EOF -if { (eval echo configure:2952: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2942: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_time=yes else @@ -2972,10 +2962,10 @@ fi echo $ac_n "checking for sys_siglist declaration in signal.h or unistd.h""... $ac_c" 1>&6 -echo "configure:2976: checking for sys_siglist declaration in signal.h or unistd.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -2987,7 +2977,7 @@ char *msg = *(sys_siglist + 1); ; return 0; } EOF -if { (eval echo configure:2991: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2981: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_decl_sys_siglist=yes else @@ -3012,9 +3002,9 @@ echo $ac_n "checking for struct utimbuf""... $ac_c" 1>&6 -echo "configure:3016: checking for struct utimbuf" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext < @@ -3033,7 +3023,7 @@ static struct utimbuf x; x.actime = x.modtime; ; return 0; } EOF -if { (eval echo configure:3037: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3027: \"$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 @@ -3053,10 +3043,10 @@ rm -f conftest* echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 -echo "configure:3057: checking return type of signal handlers" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -3073,7 +3063,7 @@ int i; ; return 0; } EOF -if { (eval echo configure:3077: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3067: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_type_signal=void else @@ -3095,10 +3085,10 @@ echo $ac_n "checking for size_t""... $ac_c" 1>&6 -echo "configure:3099: checking for size_t" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #if STDC_HEADERS @@ -3129,10 +3119,10 @@ fi echo $ac_n "checking for pid_t""... $ac_c" 1>&6 -echo "configure:3133: checking for pid_t" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #if STDC_HEADERS @@ -3163,10 +3153,10 @@ fi echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6 -echo "configure:3167: checking for uid_t in sys/types.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF @@ -3202,10 +3192,10 @@ fi echo $ac_n "checking for mode_t""... $ac_c" 1>&6 -echo "configure:3206: checking for mode_t" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #if STDC_HEADERS @@ -3236,10 +3226,10 @@ fi echo $ac_n "checking for off_t""... $ac_c" 1>&6 -echo "configure:3240: checking for off_t" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #if STDC_HEADERS @@ -3271,9 +3261,9 @@ echo $ac_n "checking for struct timeval""... $ac_c" 1>&6 -echo "configure:3275: checking for struct timeval" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext < @@ -3289,7 +3279,7 @@ static struct timeval x; x.tv_sec = x.tv_usec; ; return 0; } EOF -if { (eval echo configure:3293: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3283: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 HAVE_TIMEVAL=yes @@ -3311,10 +3301,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:3315: checking whether struct tm is in sys/time.h or time.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -3322,7 +3312,7 @@ struct tm *tp; tp->tm_sec; ; return 0; } EOF -if { (eval echo configure:3326: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3316: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm=time.h else @@ -3346,10 +3336,10 @@ fi echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6 -echo "configure:3350: checking for tm_zone in struct tm" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include <$ac_cv_struct_tm> @@ -3357,7 +3347,7 @@ struct tm tm; tm.tm_zone; ; return 0; } EOF -if { (eval echo configure:3361: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3351: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm_zone=yes else @@ -3380,10 +3370,10 @@ else echo $ac_n "checking for tzname""... $ac_c" 1>&6 -echo "configure:3384: checking for tzname" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #ifndef tzname /* For SGI. */ @@ -3393,7 +3383,7 @@ atoi(*tzname); ; return 0; } EOF -if { (eval echo configure:3397: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3387: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_cv_var_tzname=yes else @@ -3419,10 +3409,10 @@ echo $ac_n "checking for working const""... $ac_c" 1>&6 -echo "configure:3423: checking for working const" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3465: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes else @@ -3496,7 +3486,7 @@ echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 -echo "configure:3500: checking whether ${MAKE-make} sets \${MAKE}" >&5 +echo "configure:3490: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` cat > conftestmake <<\EOF @@ -3521,12 +3511,12 @@ echo $ac_n "checking whether byte ordering is bigendian""... $ac_c" 1>&6 -echo "configure:3525: checking whether byte ordering is bigendian" >&5 +echo "configure:3515: 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 < #include @@ -3537,11 +3527,11 @@ #endif ; return 0; } EOF -if { (eval echo configure:3541: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3531: \"$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 < #include @@ -3552,7 +3542,7 @@ #endif ; return 0; } EOF -if { (eval echo configure:3556: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3546: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_bigendian=yes else @@ -3569,7 +3559,7 @@ rm -f conftest* if test $ac_cv_c_bigendian = unknown; then cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3576: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_c_bigendian=no else @@ -3608,10 +3598,10 @@ echo $ac_n "checking size of short""... $ac_c" 1>&6 -echo "configure:3612: checking size of short" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main() @@ -3622,7 +3612,7 @@ exit(0); } EOF -if { (eval echo configure:3626: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3616: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_short=`cat conftestval` else @@ -3649,10 +3639,10 @@ exit 1 fi echo $ac_n "checking size of int""... $ac_c" 1>&6 -echo "configure:3653: checking size of int" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main() @@ -3663,7 +3653,7 @@ exit(0); } EOF -if { (eval echo configure:3667: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3657: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_int=`cat conftestval` else @@ -3684,10 +3674,10 @@ echo $ac_n "checking size of long""... $ac_c" 1>&6 -echo "configure:3688: checking size of long" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main() @@ -3698,7 +3688,7 @@ exit(0); } EOF -if { (eval echo configure:3702: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3692: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_long=`cat conftestval` else @@ -3719,10 +3709,10 @@ echo $ac_n "checking size of long long""... $ac_c" 1>&6 -echo "configure:3723: checking size of long long" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main() @@ -3733,7 +3723,7 @@ exit(0); } EOF -if { (eval echo configure:3737: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3727: \"$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 @@ -3754,10 +3744,10 @@ echo $ac_n "checking size of void *""... $ac_c" 1>&6 -echo "configure:3758: checking size of void *" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main() @@ -3768,7 +3758,7 @@ exit(0); } EOF -if { (eval echo configure:3772: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3762: \"$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 @@ -3790,7 +3780,7 @@ echo $ac_n "checking for long file names""... $ac_c" 1>&6 -echo "configure:3794: checking for long file names" >&5 +echo "configure:3784: 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: @@ -3837,12 +3827,12 @@ echo $ac_n "checking for sqrt in -lm""... $ac_c" 1>&6 -echo "configure:3841: checking for sqrt in -lm" >&5 +echo "configure:3831: checking for sqrt in -lm" >&5 ac_lib_var=`echo m'_'sqrt | sed 'y%./+-%__p_%'` xe_check_libs=" -lm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3847: \"$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 @@ -3895,7 +3885,7 @@ echo "checking type of mail spool file locking" 1>&6 -echo "configure:3899: checking type of mail spool file locking" >&5 +echo "configure:3889: 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 @@ -3919,12 +3909,12 @@ echo $ac_n "checking for kstat_open in -lkstat""... $ac_c" 1>&6 -echo "configure:3923: checking for kstat_open in -lkstat" >&5 +echo "configure:3913: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3929: \"$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 @@ -3969,12 +3959,12 @@ echo $ac_n "checking for kvm_read in -lkvm""... $ac_c" 1>&6 -echo "configure:3973: checking for kvm_read in -lkvm" >&5 +echo "configure:3963: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3979: \"$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 @@ -4019,12 +4009,12 @@ echo $ac_n "checking for cma_open in -lpthreads""... $ac_c" 1>&6 -echo "configure:4023: checking for cma_open in -lpthreads" >&5 +echo "configure:4013: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4029: \"$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 @@ -4071,7 +4061,7 @@ fi echo $ac_n "checking whether the -xildoff compiler flag is required""... $ac_c" 1>&6 -echo "configure:4075: checking whether the -xildoff compiler flag is required" >&5 +echo "configure:4065: 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; @@ -4082,7 +4072,7 @@ 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:4086: checking for \"-z ignore\" linker flag" >&5 +echo "configure:4076: 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 ;; @@ -4092,7 +4082,7 @@ echo "checking "for specified window system"" 1>&6 -echo "configure:4096: checking "for specified window system"" >&5 +echo "configure:4086: checking "for specified window system"" >&5 if test "$with_x11" != "no"; then test "$x_includes $x_libraries" != "NONE NONE" && \ @@ -4122,7 +4112,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:4126: checking for X" >&5 +echo "configure:4116: checking for X" >&5 # Check whether --with-x or --without-x was given. if test "${with_x+set}" = set; then @@ -4182,12 +4172,12 @@ # First, try using that file with no special directory specified. cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4191: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:4181: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -4256,14 +4246,14 @@ ac_save_LIBS="$LIBS" LIBS="-l$x_direct_test_library $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4257: \"$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. @@ -4372,17 +4362,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:4376: checking whether -R must be followed by a space" >&5 +echo "configure:4366: checking whether -R must be followed by a space" >&5 ac_xsave_LIBS="$LIBS"; LIBS="$LIBS -R$x_libraries" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4376: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_R_nospace=yes else @@ -4398,14 +4388,14 @@ else LIBS="$ac_xsave_LIBS -R $x_libraries" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4399: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_R_space=yes else @@ -4441,12 +4431,12 @@ else echo $ac_n "checking for dnet_ntoa in -ldnet""... $ac_c" 1>&6 -echo "configure:4445: checking for dnet_ntoa in -ldnet" >&5 +echo "configure:4435: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4451: \"$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 @@ -4481,12 +4471,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:4485: checking for dnet_ntoa in -ldnet_stub" >&5 +echo "configure:4475: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4491: \"$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 @@ -4526,10 +4516,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:4530: checking for gethostbyname" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4546: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_gethostbyname=yes" else @@ -4573,12 +4563,12 @@ if test $ac_cv_func_gethostbyname = no; then echo $ac_n "checking for gethostbyname in -lnsl""... $ac_c" 1>&6 -echo "configure:4577: checking for gethostbyname in -lnsl" >&5 +echo "configure:4567: checking for gethostbyname in -lnsl" >&5 ac_lib_var=`echo nsl'_'gethostbyname | sed 'y%./+-%__p_%'` xe_check_libs=" -lnsl " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4583: \"$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 @@ -4619,10 +4609,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:4623: checking for connect" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4639: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_connect=yes" else @@ -4668,12 +4658,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:4672: checking "$xe_msg_checking"" >&5 +echo "configure:4662: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4678: \"$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 @@ -4708,10 +4698,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:4712: checking for remove" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4728: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_remove=yes" else @@ -4755,12 +4745,12 @@ if test $ac_cv_func_remove = no; then echo $ac_n "checking for remove in -lposix""... $ac_c" 1>&6 -echo "configure:4759: checking for remove in -lposix" >&5 +echo "configure:4749: checking for remove in -lposix" >&5 ac_lib_var=`echo posix'_'remove | sed 'y%./+-%__p_%'` xe_check_libs=" -lposix " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4765: \"$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 @@ -4795,10 +4785,10 @@ # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay. echo $ac_n "checking for shmat""... $ac_c" 1>&6 -echo "configure:4799: checking for shmat" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4815: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_shmat=yes" else @@ -4842,12 +4832,12 @@ if test $ac_cv_func_shmat = no; then echo $ac_n "checking for shmat in -lipc""... $ac_c" 1>&6 -echo "configure:4846: checking for shmat in -lipc" >&5 +echo "configure:4836: checking for shmat in -lipc" >&5 ac_lib_var=`echo ipc'_'shmat | sed 'y%./+-%__p_%'` xe_check_libs=" -lipc " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4852: \"$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 @@ -4892,12 +4882,12 @@ # --interran@uluru.Stanford.EDU, kb@cs.umb.edu. echo $ac_n "checking for IceConnectionNumber in -lICE""... $ac_c" 1>&6 -echo "configure:4896: checking for IceConnectionNumber in -lICE" >&5 +echo "configure:4886: checking for IceConnectionNumber in -lICE" >&5 ac_lib_var=`echo ICE'_'IceConnectionNumber | sed 'y%./+-%__p_%'` xe_check_libs=" -lICE " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4902: \"$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 @@ -5041,7 +5031,7 @@ fi echo "checking for X defines extracted by xmkmf" 1>&6 -echo "configure:5045: checking for X defines extracted by xmkmf" >&5 +echo "configure:5035: checking for X defines extracted by xmkmf" >&5 rm -fr conftestdir if mkdir conftestdir; then cd conftestdir @@ -5073,15 +5063,15 @@ ac_safe=`echo "X11/Intrinsic.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for X11/Intrinsic.h""... $ac_c" 1>&6 -echo "configure:5077: checking for X11/Intrinsic.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5085: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5075: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5105,12 +5095,12 @@ echo $ac_n "checking for XOpenDisplay in -lX11""... $ac_c" 1>&6 -echo "configure:5109: checking for XOpenDisplay in -lX11" >&5 +echo "configure:5099: checking for XOpenDisplay in -lX11" >&5 ac_lib_var=`echo X11'_'XOpenDisplay | sed 'y%./+-%__p_%'` xe_check_libs=" -lX11 " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5115: \"$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 @@ -5146,12 +5136,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:5150: checking "$xe_msg_checking"" >&5 +echo "configure:5140: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5156: \"$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 @@ -5189,12 +5179,12 @@ echo $ac_n "checking for XShapeSelectInput in -lXext""... $ac_c" 1>&6 -echo "configure:5193: checking for XShapeSelectInput in -lXext" >&5 +echo "configure:5183: checking for XShapeSelectInput in -lXext" >&5 ac_lib_var=`echo Xext'_'XShapeSelectInput | sed 'y%./+-%__p_%'` xe_check_libs=" -lXext " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5199: \"$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,12 +5218,12 @@ echo $ac_n "checking for XtOpenDisplay in -lXt""... $ac_c" 1>&6 -echo "configure:5232: checking for XtOpenDisplay in -lXt" >&5 +echo "configure:5222: checking for XtOpenDisplay in -lXt" >&5 ac_lib_var=`echo Xt'_'XtOpenDisplay | sed 'y%./+-%__p_%'` xe_check_libs=" -lXt " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5238: \"$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 @@ -5267,14 +5257,14 @@ echo $ac_n "checking the version of X11 being used""... $ac_c" 1>&6 -echo "configure:5271: checking the version of X11 being used" >&5 +echo "configure:5261: checking the version of X11 being used" >&5 cat > conftest.$ac_ext < main(int c, char* v[]) { return c>1 ? XlibSpecificationRelease : 0; } EOF -if { (eval echo configure:5278: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:5268: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ./conftest foobar; x11_release=$? else @@ -5298,15 +5288,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:5302: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5310: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5300: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5337,7 +5327,7 @@ echo $ac_n "checking for XFree86""... $ac_c" 1>&6 -echo "configure:5341: checking for XFree86" >&5 +echo "configure:5331: checking for XFree86" >&5 if test -d "/usr/X386/include" -o \ -f "/etc/XF86Config" -o \ -f "/etc/X11/XF86Config" -o \ @@ -5357,12 +5347,12 @@ test -z "$with_xmu" && { echo $ac_n "checking for XmuReadBitmapDataFromFile in -lXmu""... $ac_c" 1>&6 -echo "configure:5361: checking for XmuReadBitmapDataFromFile in -lXmu" >&5 +echo "configure:5351: checking for XmuReadBitmapDataFromFile in -lXmu" >&5 ac_lib_var=`echo Xmu'_'XmuReadBitmapDataFromFile | sed 'y%./+-%__p_%'` xe_check_libs=" -lXmu " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5367: \"$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 @@ -5412,19 +5402,19 @@ echo $ac_n "checking for main in -lXbsd""... $ac_c" 1>&6 -echo "configure:5416: checking for main in -lXbsd" >&5 +echo "configure:5406: checking for main in -lXbsd" >&5 ac_lib_var=`echo Xbsd'_'main | sed 'y%./+-%__p_%'` xe_check_libs=" -lXbsd " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5418: \"$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 @@ -5478,7 +5468,7 @@ esac echo "checking for session-management option" 1>&6 -echo "configure:5482: checking for session-management option" >&5; +echo "configure:5472: checking for session-management option" >&5; if test "$with_session" != "no"; then { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_SESSION @@ -5493,15 +5483,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:5497: checking for X11/Xauth.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5505: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5495: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5524,12 +5514,12 @@ } test -z "$with_xauth" && { echo $ac_n "checking for XauGetAuthByAddr in -lXau""... $ac_c" 1>&6 -echo "configure:5528: checking for XauGetAuthByAddr in -lXau" >&5 +echo "configure:5518: checking for XauGetAuthByAddr in -lXau" >&5 ac_lib_var=`echo Xau'_'XauGetAuthByAddr | sed 'y%./+-%__p_%'` xe_check_libs=" -lXau " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5534: \"$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 @@ -5582,15 +5572,15 @@ OFFIX_O="" 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:5586: checking for OffiX/DragAndDrop.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5594: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5584: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5613,12 +5603,12 @@ } test -z "$with_offix" && { echo $ac_n "checking for DndInitialize in -lDnd""... $ac_c" 1>&6 -echo "configure:5617: checking for DndInitialize in -lDnd" >&5 +echo "configure:5607: checking for DndInitialize in -lDnd" >&5 ac_lib_var=`echo Dnd'_'DndInitialize | sed 'y%./+-%__p_%'` xe_check_libs=" -lDnd " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5623: \"$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 @@ -5669,15 +5659,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:5673: checking for ${dir}tt_c.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5681: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5671: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5706,12 +5696,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:5710: checking "$xe_msg_checking"" >&5 +echo "configure:5700: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5716: \"$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 @@ -5771,15 +5761,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:5775: checking for Dt/Dt.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5783: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5773: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5802,12 +5792,12 @@ } test -z "$with_cde" && { echo $ac_n "checking for DtDndDragStart in -lDtSvc""... $ac_c" 1>&6 -echo "configure:5806: checking for DtDndDragStart in -lDtSvc" >&5 +echo "configure:5796: checking for DtDndDragStart in -lDtSvc" >&5 ac_lib_var=`echo DtSvc'_'DtDndDragStart | sed 'y%./+-%__p_%'` xe_check_libs=" -lDtSvc " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5812: \"$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 @@ -5865,19 +5855,19 @@ echo $ac_n "checking for main in -lenergize""... $ac_c" 1>&6 -echo "configure:5869: checking for main in -lenergize" >&5 +echo "configure:5859: checking for main in -lenergize" >&5 ac_lib_var=`echo energize'_'main | sed 'y%./+-%__p_%'` xe_check_libs=" -lenergize " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5871: \"$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 @@ -5909,19 +5899,19 @@ if test -z "$energize_version"; then echo $ac_n "checking for main in -lconn""... $ac_c" 1>&6 -echo "configure:5913: checking for main in -lconn" >&5 +echo "configure:5903: checking for main in -lconn" >&5 ac_lib_var=`echo conn'_'main | sed 'y%./+-%__p_%'` xe_check_libs=" -lconn " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5915: \"$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 @@ -5954,15 +5944,15 @@ fi ac_safe=`echo "editorconn.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for editorconn.h""... $ac_c" 1>&6 -echo "configure:5958: checking for editorconn.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5966: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5956: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6006,7 +5996,7 @@ if test "$with_x11" = "yes"; then echo "checking for X11 graphics libraries" 1>&6 -echo "configure:6010: checking for X11 graphics libraries" >&5 +echo "configure:6000: checking for X11 graphics libraries" >&5 test -z "$with_gif" && with_gif=yes; if test "$with_gif" = "yes"; then { test "$extra_verbose" = "yes" && cat << \EOF @@ -6023,10 +6013,10 @@ fi echo $ac_n "checking for Xpm - no older than 3.4f""... $ac_c" 1>&6 -echo "configure:6027: checking for Xpm - no older than 3.4f" >&5 +echo "configure:6017: checking for Xpm - no older than 3.4f" >&5 xe_check_libs=-lXpm test -z "$with_xpm" && { cat > conftest.$ac_ext < int main(int c, char **v) { @@ -6036,7 +6026,7 @@ 0 ; } EOF -if { (eval echo configure:6040: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:6030: \"$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; @@ -6074,15 +6064,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:6078: checking for compface.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6086: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6076: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6105,12 +6095,12 @@ } test -z "$with_xface" && { echo $ac_n "checking for UnGenFace in -lcompface""... $ac_c" 1>&6 -echo "configure:6109: checking for UnGenFace in -lcompface" >&5 +echo "configure:6099: checking for UnGenFace in -lcompface" >&5 ac_lib_var=`echo compface'_'UnGenFace | sed 'y%./+-%__p_%'` xe_check_libs=" -lcompface " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6115: \"$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 @@ -6157,15 +6147,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:6161: checking for jpeglib.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6169: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6159: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6188,12 +6178,12 @@ } test -z "$with_jpeg" && { echo $ac_n "checking for jpeg_destroy_decompress in -ljpeg""... $ac_c" 1>&6 -echo "configure:6192: checking for jpeg_destroy_decompress in -ljpeg" >&5 +echo "configure:6182: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6198: \"$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 @@ -6240,15 +6230,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:6244: checking for png.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6252: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6242: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6270,10 +6260,10 @@ fi } test -z "$with_png" && { echo $ac_n "checking for pow""... $ac_c" 1>&6 -echo "configure:6274: checking for pow" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6290: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_pow=yes" else @@ -6321,12 +6311,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:6325: checking "$xe_msg_checking"" >&5 +echo "configure:6315: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6331: \"$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 @@ -6379,12 +6369,12 @@ xe_msg_checking="for TIFFReadScanline in -ltiff" 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:6383: checking "$xe_msg_checking"" >&5 +echo "configure:6373: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo tiff'_'TIFFReadScanline | sed 'y%./+-%__p_%'` xe_check_libs=" -ltiff $extra_libs" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6389: \"$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 @@ -6428,17 +6418,17 @@ EOF } - libs_x="-ltiff $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-ltiff\" to \$libs_x"; fi + libs_x="$tiff_libs $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"$tiff_libs\" to \$libs_x"; fi fi echo $ac_n "checking for XawScrollbarSetThumb in -lXaw""... $ac_c" 1>&6 -echo "configure:6437: checking for XawScrollbarSetThumb in -lXaw" >&5 +echo "configure:6427: checking for XawScrollbarSetThumb in -lXaw" >&5 ac_lib_var=`echo Xaw'_'XawScrollbarSetThumb | sed 'y%./+-%__p_%'` xe_check_libs=" -lXaw " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6443: \"$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 @@ -6473,15 +6463,15 @@ if test "$have_xaw" = "yes"; then ac_safe=`echo "X11/Xaw/Reports.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for X11/Xaw/Reports.h""... $ac_c" 1>&6 -echo "configure:6477: checking for X11/Xaw/Reports.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6485: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6475: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6507,15 +6497,15 @@ ac_safe=`echo "Xm/Xm.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for Xm/Xm.h""... $ac_c" 1>&6 -echo "configure:6511: checking for Xm/Xm.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6519: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6509: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6532,12 +6522,12 @@ echo "$ac_t""yes" 1>&6 echo $ac_n "checking for XmStringFree in -lXm""... $ac_c" 1>&6 -echo "configure:6536: checking for XmStringFree in -lXm" >&5 +echo "configure:6526: checking for XmStringFree in -lXm" >&5 ac_lib_var=`echo Xm'_'XmStringFree | sed 'y%./+-%__p_%'` xe_check_libs=" -lXm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6542: \"$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 @@ -6797,7 +6787,7 @@ if test "$with_mule" = "yes" ; then echo "checking for Mule-related features" 1>&6 -echo "configure:6801: checking for Mule-related features" >&5 +echo "configure:6791: checking for Mule-related features" >&5 { test "$extra_verbose" = "yes" && cat << \EOF Defining MULE EOF @@ -6814,15 +6804,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:6818: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6826: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6816: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6853,12 +6843,12 @@ echo $ac_n "checking for strerror in -lintl""... $ac_c" 1>&6 -echo "configure:6857: checking for strerror in -lintl" >&5 +echo "configure:6847: checking for strerror in -lintl" >&5 ac_lib_var=`echo intl'_'strerror | sed 'y%./+-%__p_%'` xe_check_libs=" -lintl " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6863: \"$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 @@ -6902,19 +6892,19 @@ echo "checking for Mule input methods" 1>&6 -echo "configure:6906: checking for Mule input methods" >&5 +echo "configure:6896: 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:6910: checking for XIM" >&5 +echo "configure:6900: checking for XIM" >&5 echo $ac_n "checking for XmImMbLookupString in -lXm""... $ac_c" 1>&6 -echo "configure:6913: checking for XmImMbLookupString in -lXm" >&5 +echo "configure:6903: checking for XmImMbLookupString in -lXm" >&5 ac_lib_var=`echo Xm'_'XmImMbLookupString | sed 'y%./+-%__p_%'` xe_check_libs=" -lXm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6919: \"$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 @@ -6988,15 +6978,15 @@ fi else case "$with_xfs" in "yes" ) echo "checking for XFontSet" 1>&6 -echo "configure:6992: checking for XFontSet" >&5 +echo "configure:6982: checking for XFontSet" >&5 echo $ac_n "checking for XmbDrawString in -lX11""... $ac_c" 1>&6 -echo "configure:6995: checking for XmbDrawString in -lX11" >&5 +echo "configure:6985: checking for XmbDrawString in -lX11" >&5 ac_lib_var=`echo X11'_'XmbDrawString | sed 'y%./+-%__p_%'` xe_check_libs=" -lX11 " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7001: \"$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 @@ -7046,15 +7036,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:7050: checking for wnn/jllib.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7058: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:7048: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -7079,10 +7069,10 @@ for ac_func in crypt do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:7083: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7099: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -7134,12 +7124,12 @@ test "$ac_cv_func_crypt" != "yes" && { echo $ac_n "checking for crypt in -lcrypt""... $ac_c" 1>&6 -echo "configure:7138: checking for crypt in -lcrypt" >&5 +echo "configure:7128: checking for crypt in -lcrypt" >&5 ac_lib_var=`echo crypt'_'crypt | sed 'y%./+-%__p_%'` xe_check_libs=" -lcrypt " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7144: \"$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 @@ -7184,12 +7174,12 @@ fi test -z "$with_wnn" && { echo $ac_n "checking for jl_dic_list_e in -lwnn""... $ac_c" 1>&6 -echo "configure:7188: checking for jl_dic_list_e in -lwnn" >&5 +echo "configure:7178: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7194: \"$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 @@ -7237,12 +7227,12 @@ fi echo $ac_n "checking for jl_fi_dic_list in -lwnn""... $ac_c" 1>&6 -echo "configure:7241: checking for jl_fi_dic_list in -lwnn" >&5 +echo "configure:7231: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7247: \"$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 @@ -7285,15 +7275,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:7289: checking for canna/RK.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7297: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:7287: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -7316,12 +7306,12 @@ } test -z "$with_canna" && { echo $ac_n "checking for RkBgnBun in -lRKC""... $ac_c" 1>&6 -echo "configure:7320: checking for RkBgnBun in -lRKC" >&5 +echo "configure:7310: checking for RkBgnBun in -lRKC" >&5 ac_lib_var=`echo RKC'_'RkBgnBun | sed 'y%./+-%__p_%'` xe_check_libs=" -lRKC " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7326: \"$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 @@ -7355,12 +7345,12 @@ } test -z "$with_canna" && { echo $ac_n "checking for jrKanjiControl in -lcanna""... $ac_c" 1>&6 -echo "configure:7359: checking for jrKanjiControl in -lcanna" >&5 +echo "configure:7349: checking for jrKanjiControl in -lcanna" >&5 ac_lib_var=`echo canna'_'jrKanjiControl | sed 'y%./+-%__p_%'` xe_check_libs=" -lcanna " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7365: \"$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 @@ -7471,10 +7461,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 ulimit usleep utimes waitpid do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:7475: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7491: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -7534,10 +7524,10 @@ for ac_func in realpath do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:7538: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7554: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -7593,16 +7583,16 @@ esac echo $ac_n "checking whether netdb declares h_errno""... $ac_c" 1>&6 -echo "configure:7597: checking whether netdb declares h_errno" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext < int main() { return h_errno; ; return 0; } EOF -if { (eval echo configure:7606: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7596: \"$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 @@ -7622,16 +7612,16 @@ rm -f conftest* echo $ac_n "checking for sigsetjmp""... $ac_c" 1>&6 -echo "configure:7626: checking for sigsetjmp" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext < int main() { sigjmp_buf bar; sigsetjmp (bar, 0); ; return 0; } EOF -if { (eval echo configure:7635: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:7625: \"$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 @@ -7651,11 +7641,11 @@ rm -f conftest* echo $ac_n "checking whether localtime caches TZ""... $ac_c" 1>&6 -echo "configure:7655: checking whether localtime caches TZ" >&5 +echo "configure:7645: checking whether localtime caches TZ" >&5 if test "$ac_cv_func_tzset" = "yes"; then cat > conftest.$ac_ext < #if STDC_HEADERS @@ -7690,7 +7680,7 @@ exit (0); } EOF -if { (eval echo configure:7694: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:7684: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then emacs_cv_localtime_cache=no else @@ -7719,9 +7709,9 @@ if test "$HAVE_TIMEVAL" = "yes"; then echo $ac_n "checking whether gettimeofday cannot accept two arguments""... $ac_c" 1>&6 -echo "configure:7723: checking whether gettimeofday cannot accept two arguments" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7737: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* echo "$ac_t""no" 1>&6 else @@ -7765,19 +7755,19 @@ echo $ac_n "checking for inline""... $ac_c" 1>&6 -echo "configure:7769: checking for inline" >&5 +echo "configure:7759: checking for inline" >&5 ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:7771: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_inline=$ac_kw; break else @@ -7827,17 +7817,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:7831: checking for working alloca.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < int main() { char *p = alloca(2 * sizeof(int)); ; return 0; } EOF -if { (eval echo configure:7841: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7831: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_cv_header_alloca_h=yes else @@ -7861,10 +7851,10 @@ fi echo $ac_n "checking for alloca""... $ac_c" 1>&6 -echo "configure:7865: checking for alloca" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7881: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_cv_func_alloca_works=yes else @@ -7926,10 +7916,10 @@ echo $ac_n "checking whether alloca needs Cray hooks""... $ac_c" 1>&6 -echo "configure:7930: checking whether alloca needs Cray hooks" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&6 -echo "configure:7957: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7973: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -8009,10 +7999,10 @@ fi echo $ac_n "checking stack direction for C alloca""... $ac_c" 1>&6 -echo "configure:8013: checking stack direction for C alloca" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:8025: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_c_stack_direction=1 else @@ -8059,15 +8049,15 @@ ac_safe=`echo "vfork.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for vfork.h""... $ac_c" 1>&6 -echo "configure:8063: checking for vfork.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8071: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8061: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8095,10 +8085,10 @@ fi echo $ac_n "checking for working vfork""... $ac_c" 1>&6 -echo "configure:8099: checking for working vfork" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < @@ -8193,7 +8183,7 @@ } } EOF -if { (eval echo configure:8197: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:8187: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_func_vfork_works=yes else @@ -8218,10 +8208,10 @@ echo $ac_n "checking for working strcoll""... $ac_c" 1>&6 -echo "configure:8222: checking for working strcoll" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main () @@ -8231,7 +8221,7 @@ strcoll ("123", "456") >= 0); } EOF -if { (eval echo configure:8235: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:8225: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_func_strcoll_works=yes else @@ -8258,10 +8248,10 @@ for ac_func in getpgrp do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:8262: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8278: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -8312,10 +8302,10 @@ done echo $ac_n "checking whether getpgrp takes no argument""... $ac_c" 1>&6 -echo "configure:8316: checking whether getpgrp takes no argument" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:8364: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_func_getpgrp_void=yes else @@ -8396,10 +8386,10 @@ echo $ac_n "checking for working mmap""... $ac_c" 1>&6 -echo "configure:8400: checking for working mmap" >&5 +echo "configure:8390: checking for working mmap" >&5 case "$opsys" in ultrix* ) have_mmap=no ;; *) cat > conftest.$ac_ext < #include @@ -8432,7 +8422,7 @@ return 1; } EOF -if { (eval echo configure:8436: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:8426: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then have_mmap=yes else @@ -8466,15 +8456,15 @@ ac_safe=`echo "termios.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for termios.h""... $ac_c" 1>&6 -echo "configure:8470: checking for termios.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8478: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8468: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8517,15 +8507,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:8521: checking for termio.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8529: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8519: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8557,10 +8547,10 @@ echo $ac_n "checking for socket""... $ac_c" 1>&6 -echo "configure:8561: checking for socket" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8577: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_socket=yes" else @@ -8598,15 +8588,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:8602: checking for netinet/in.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8610: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8600: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8623,15 +8613,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:8627: checking for arpa/inet.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8635: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8625: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8656,9 +8646,9 @@ } echo $ac_n "checking "for sun_len member in struct sockaddr_un"""... $ac_c" 1>&6 -echo "configure:8660: checking "for sun_len member in struct sockaddr_un"" >&5 +echo "configure:8650: checking "for sun_len member in struct sockaddr_un"" >&5 cat > conftest.$ac_ext < @@ -8669,7 +8659,7 @@ static struct sockaddr_un x; x.sun_len = 1; ; return 0; } EOF -if { (eval echo configure:8673: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8663: \"$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 @@ -8700,10 +8690,10 @@ echo $ac_n "checking for msgget""... $ac_c" 1>&6 -echo "configure:8704: checking for msgget" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:8720: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_msgget=yes" else @@ -8741,15 +8731,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:8745: checking for sys/ipc.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8753: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8743: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8766,15 +8756,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:8770: checking for sys/msg.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8778: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8768: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8812,15 +8802,15 @@ ac_safe=`echo "dirent.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for dirent.h""... $ac_c" 1>&6 -echo "configure:8816: checking for dirent.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8824: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8814: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8847,15 +8837,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:8851: checking for sys/dir.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8859: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8849: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8888,15 +8878,15 @@ ac_safe=`echo "nlist.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for nlist.h""... $ac_c" 1>&6 -echo "configure:8892: checking for nlist.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8900: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8890: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -8937,7 +8927,7 @@ echo "checking "for sound support"" 1>&6 -echo "configure:8941: checking "for sound support"" >&5 +echo "configure:8931: checking "for sound support"" >&5 case "$with_sound" in native | both ) with_native_sound=yes;; nas | no ) with_native_sound=no;; @@ -8948,15 +8938,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:8952: checking for multimedia/audio_device.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8960: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:8950: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9004,12 +8994,12 @@ if test -z "$native_sound_lib"; then echo $ac_n "checking for ALopenport in -laudio""... $ac_c" 1>&6 -echo "configure:9008: checking for ALopenport in -laudio" >&5 +echo "configure:8998: checking for ALopenport in -laudio" >&5 ac_lib_var=`echo audio'_'ALopenport | sed 'y%./+-%__p_%'` xe_check_libs=" -laudio " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9014: \"$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 @@ -9051,12 +9041,12 @@ if test -z "$native_sound_lib"; then echo $ac_n "checking for AOpenAudio in -lAlib""... $ac_c" 1>&6 -echo "configure:9055: checking for AOpenAudio in -lAlib" >&5 +echo "configure:9045: checking for AOpenAudio in -lAlib" >&5 ac_lib_var=`echo Alib'_'AOpenAudio | sed 'y%./+-%__p_%'` xe_check_libs=" -lAlib " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9061: \"$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 @@ -9105,15 +9095,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:9109: checking for ${dir}/soundcard.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9117: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9107: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9181,9 +9171,9 @@ extra_objs="$extra_objs nas.o" && if test "$extra_verbose" = "yes"; then echo " xemacs will be linked with \"nas.o\"" fi - LIBS="-laudio $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-laudio\" to \$LIBS"; fi + libs_x="-laudio $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-laudio\" to \$libs_x"; fi cat > conftest.$ac_ext < EOF @@ -9210,7 +9200,7 @@ if test "$with_tty" = "yes" ; then echo "checking for TTY-related features" 1>&6 -echo "configure:9214: checking for TTY-related features" >&5 +echo "configure:9204: checking for TTY-related features" >&5 { test "$extra_verbose" = "yes" && cat << \EOF Defining HAVE_TTY EOF @@ -9226,12 +9216,12 @@ if test -z "$with_ncurses"; then echo $ac_n "checking for tgetent in -lncurses""... $ac_c" 1>&6 -echo "configure:9230: checking for tgetent in -lncurses" >&5 +echo "configure:9220: checking for tgetent in -lncurses" >&5 ac_lib_var=`echo ncurses'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -lncurses " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9236: \"$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 @@ -9275,15 +9265,15 @@ ac_safe=`echo "ncurses/curses.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ncurses/curses.h""... $ac_c" 1>&6 -echo "configure:9279: checking for ncurses/curses.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9287: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9277: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9305,15 +9295,15 @@ ac_safe=`echo "ncurses/term.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ncurses/term.h""... $ac_c" 1>&6 -echo "configure:9309: checking for ncurses/term.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9317: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9307: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9343,15 +9333,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:9347: checking for ncurses/curses.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9355: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9345: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9386,12 +9376,12 @@ for lib in curses termlib termcap; do echo $ac_n "checking for tgetent in -l$lib""... $ac_c" 1>&6 -echo "configure:9390: checking for tgetent in -l$lib" >&5 +echo "configure:9380: 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 <&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 @@ -9433,12 +9423,12 @@ else echo $ac_n "checking for tgetent in -lcurses""... $ac_c" 1>&6 -echo "configure:9437: checking for tgetent in -lcurses" >&5 +echo "configure:9427: checking for tgetent in -lcurses" >&5 ac_lib_var=`echo curses'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -lcurses " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9443: \"$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 @@ -9467,12 +9457,12 @@ else echo "$ac_t""no" 1>&6 echo $ac_n "checking for tgetent in -ltermcap""... $ac_c" 1>&6 -echo "configure:9471: checking for tgetent in -ltermcap" >&5 +echo "configure:9461: checking for tgetent in -ltermcap" >&5 ac_lib_var=`echo termcap'_'tgetent | sed 'y%./+-%__p_%'` xe_check_libs=" -ltermcap " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9477: \"$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 @@ -9531,15 +9521,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:9535: checking for gpm.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9543: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:9533: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -9562,12 +9552,12 @@ } test -z "$with_gpm" && { echo $ac_n "checking for Gpm_Open in -lgpm""... $ac_c" 1>&6 -echo "configure:9566: checking for Gpm_Open in -lgpm" >&5 +echo "configure:9556: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9572: \"$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 @@ -9627,17 +9617,17 @@ echo "checking for database support" 1>&6 -echo "configure:9631: checking for database support" >&5 +echo "configure:9621: 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:9636: checking for dbm_open in -lgdbm" >&5 +echo "configure:9626: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9642: \"$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 @@ -9670,10 +9660,10 @@ if test "$with_database_gnudbm" != "yes"; then echo $ac_n "checking for dbm_open""... $ac_c" 1>&6 -echo "configure:9674: checking for dbm_open" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9690: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_dbm_open=yes" else @@ -9732,10 +9722,10 @@ if test "$with_database_dbm" != "no"; then echo $ac_n "checking for dbm_open""... $ac_c" 1>&6 -echo "configure:9736: checking for dbm_open" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9752: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_dbm_open=yes" else @@ -9779,12 +9769,12 @@ if test "$need_libdbm" != "no"; then echo $ac_n "checking for dbm_open in -ldbm""... $ac_c" 1>&6 -echo "configure:9783: checking for dbm_open in -ldbm" >&5 +echo "configure:9773: 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 <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9789: \"$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 @@ -9832,10 +9822,10 @@ if test "$with_database_berkdb" != "no"; then echo $ac_n "checking for dbopen""... $ac_c" 1>&6 -echo "configure:9836: checking for dbopen" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9852: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_dbopen=yes" else @@ -9879,12 +9869,12 @@ if test "$need_libdb" != "no"; then echo $ac_n "checking for dbopen in -ldb""... $ac_c" 1>&6 -echo "configure:9883: checking for dbopen in -ldb" >&5 +echo "configure:9873: checking for dbopen in -ldb" >&5 ac_lib_var=`echo db'_'dbopen | sed 'y%./+-%__p_%'` xe_check_libs=" -ldb " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:9889: \"$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 @@ -9919,7 +9909,7 @@ if test "$with_database_berkdb" = "yes"; then for path in "db/db.h" "db.h"; do cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:9936: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* db_h_path="$path"; break else @@ -9994,12 +9984,12 @@ if test "$with_socks" = "yes"; then echo $ac_n "checking for SOCKSinit in -lsocks""... $ac_c" 1>&6 -echo "configure:9998: checking for SOCKSinit in -lsocks" >&5 +echo "configure:9988: checking for SOCKSinit in -lsocks" >&5 ac_lib_var=`echo socks'_'SOCKSinit | sed 'y%./+-%__p_%'` xe_check_libs=" -lsocks " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:10004: \"$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 diff -r f0deb0c0e6be -r eb5470882647 configure.in --- a/configure.in Mon Aug 13 10:00:35 2007 +0200 +++ b/configure.in Mon Aug 13 10:01:22 2007 +0200 @@ -194,8 +194,6 @@ dnl ac_cpp='$CPP $CPPFLAGS' dnl ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&AC_FD_CC' dnl ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&AC_FD_CC' -dnl # $c_switch_x_machine $c_switch_x_system -dnl # $ld_switch_x_machine $ld_switch_x_system xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' xe_ldflags='$LDFLAGS $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_x_site $ld_switch_run' xe_libs='$ld_call_shared $xe_check_libs $X_EXTRA_LIBS $libs_x $X_PRE_LIBS $LIBS $libs_machine $libs_system $libs_standard' @@ -1743,11 +1741,9 @@ CPP_to_sh(C_SWITCH_MACHINE, c_switch_machine) CPP_to_sh(C_SWITCH_SYSTEM, c_switch_system) -CPP_to_sh(C_SWITCH_X_SYSTEM, c_switch_x_system) CPP_to_sh(LD_SWITCH_MACHINE, ld_switch_machine) CPP_to_sh(LD_SWITCH_SYSTEM, ld_switch_system) -CPP_to_sh(LD_SWITCH_X_SYSTEM, ld_switch_x_system) CPP_to_sh(UNEXEC, unexec, unexec.o) @@ -1838,8 +1834,7 @@ test "$extra_verbose" = "yes" && \ PRINT_VAR(libs_machine libs_system libs_termcap libs_standard objects_machine objects_system c_switch_machine c_switch_system - c_switch_x_system ld_switch_machine ld_switch_system - ld_switch_x_system unexec ld_switch_shared + ld_switch_machine ld_switch_system unexec ld_switch_shared ld lib_gcc ld_text_start_addr start_files ordinary_link have_terminfo mail_use_flock mail_use_lockf) && echo "" @@ -2593,7 +2588,7 @@ test -z "$with_tiff" && with_tiff=no if test "$with_tiff" = "yes"; then AC_DEFINE(HAVE_TIFF) - XE_PREPEND(-ltiff, libs_x) + XE_PREPEND($tiff_libs, libs_x) fi dnl Autodetect -lXaw @@ -3082,7 +3077,7 @@ case "$with_sound" in both | nas ) AC_DEFINE(HAVE_NAS_SOUND) XE_ADD_OBJS(nas.o) - XE_PREPEND(-laudio, LIBS) + XE_PREPEND(-laudio, libs_x) dnl If the nas library does not contain the error jump point, dnl then we force safer behaviour. AC_EGREP_HEADER(AuXtErrorJump,audio/Xtutil.h,,[AC_DEFINE(NAS_NO_ERROR_JUMP)]) diff -r f0deb0c0e6be -r eb5470882647 etc/w3/archive.xbm --- a/etc/w3/archive.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,9 +0,0 @@ -#define tar_width 20 -#define tar_height 23 -static char tar_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x3f, 0x00, 0x01, 0x60, 0x00, - 0x01, 0xa0, 0x00, 0x01, 0x20, 0x01, 0x01, 0x20, 0x02, 0x01, 0xe0, 0x07, - 0x01, 0xc0, 0x0f, 0x01, 0x00, 0x0c, 0xbd, 0xf3, 0x0c, 0xbd, 0xf3, 0x0d, - 0xd9, 0xb6, 0x0d, 0xd9, 0xb6, 0x0d, 0xd9, 0xf7, 0x0c, 0xd9, 0xf7, 0x0d, - 0xd9, 0xb6, 0x0d, 0xd9, 0xb6, 0x0d, 0x01, 0x00, 0x0c, 0xff, 0xff, 0x0f, - 0xfe, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/audio.xbm --- a/etc/w3/audio.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -#define audio_width 20 -#define audio_height 23 -static char audio_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0x07,0x01,0x00,0x0c,0x01,0x40,0x0c, - 0x01,0x91,0x0c,0x81,0x21,0x0d,0x41,0x49,0x0d,0x3d,0x51,0x0d,0x05,0x55,0x0d, - 0x05,0x55,0x0d,0x05,0x55,0x0d,0x3d,0x55,0x0d,0x7d,0x51,0x0d,0xc1,0x49,0x0d, - 0x81,0x21,0x0d,0x01,0x91,0x0c,0x01,0x40,0x0c,0x01,0x00,0x0c,0xff,0xff,0x0f, - 0xfe,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/back-cap-dn.xbm --- a/etc/w3/back-cap-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xef,0xff, - 0xff,0xff,0xe7,0xff,0xff,0xff,0xeb,0xff,0xff,0xff,0x0d,0x8c,0xff,0xff,0xfe, - 0x75,0xff,0x7f,0xff,0x75,0xff,0xff,0xfe,0x75,0xff,0xff,0x0d,0x8c,0xff,0xff, - 0xeb,0xff,0xff,0xff,0xe7,0xff,0xff,0xff,0xef,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x3f,0xfc,0xbf,0xff,0xbf,0xfb,0xbf,0xff,0xbf,0x9b, - 0xb3,0xfd,0x3f,0x6c,0xad,0xfe,0xbf,0x1b,0x3d,0xff,0xbf,0x6b,0xad,0xfe,0x3f, - 0x9c,0xb2,0xfd,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/back-cap-dn.xpm --- a/etc/w3/back-cap-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,45 +0,0 @@ -/* XPM */ -static char *back-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 8 1", -/* colors */ -". c #000000", -"# c #330099", -"a c #888888", -"b c #aaaaaa", -"c c #b2b2b2 s backgroundToolBarColor", -"d c #cccccc", -"e c #eeeeee", -"f c #ffffff", -/* pixels */ -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccc#ccccccccccccccccccc", -"ccccccccccc##ccccccccccccccccccc", -"cccccccccc#f#ccccccccccccccccccc", -"ccccccccc#fe######cb###bcccccccc", -"cccccccc#fedeeeee#c#aea#abcccccc", -"ccccccc#feddddddd#b#eed#abcccccc", -"cccccccc#eddddddd#a#ada#abcccccc", -"cccccccba#ed######ab###abbcccccc", -"ccccccccba#e#aaaaaacaaabbbcccccc", -"cccccccccba##acccccccccccccccccc", -"ccccccccccba#acccccccccccccccccc", -"cccccccccccbaacccccccccccccccccc", -"ccccccccccccbacccccccccccccccccc", -"cccccccccccccbcccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccc....cccccccccccc.ccccccccc", -"cccccc.ccc.ccccccccccc.ccccccccc", -"cccccc.ccc.cc..ccc..cc.cc.cccccc", -"cccccc....cc.cc.c.cc.c.c.ccccccc", -"cccccc.ccc.cc...c.cccc..cccccccc", -"cccccc.ccc.c.cc.c.cc.c.c.ccccccc", -"cccccc....ccc..c.c..cc.cc.cccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/back-cap-no.xbm --- a/etc/w3/back-cap-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x14,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01, - 0x8a,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0x8a,0x00,0x00,0x00,0x00,0x00,0x00, - 0x14,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x40,0x04,0x40,0x00,0x00,0x00, - 0x00,0x00,0xc0,0x93,0x52,0x01,0x00,0x00,0x00,0x00,0x40,0x94,0x52,0x01,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/back-cap-no.xpm --- a/etc/w3/back-cap-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,45 +0,0 @@ -/* XPM */ -static char *back-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 8 1", -/* colors */ -". c #000000", -"# c #330099", -"a c #888888", -"b c #aaaaaa", -"c c #b2b2b2 s backgroundToolBarColor", -"d c #cccccc", -"e c #eeeeee", -"f c #ffffff", -/* pixels */ -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccc#ccccccccccccccccccc", -"ccccccccccc##ccccccccccccccccccc", -"cccccccccc#f#ccccccccccccccccccc", -"ccccccccc#fe######cb###bcccccccc", -"cccccccc#fedeeeee#c#aea#abcccccc", -"ccccccc#feddddddd#b#eed#abcccccc", -"cccccccc#eddddddd#a#ada#abcccccc", -"cccccccba#ed######ab###abbcccccc", -"ccccccccba#e#aaaaaacaaabbbcccccc", -"cccccccccba##acccccccccccccccccc", -"ccccccccccba#acccccccccccccccccc", -"cccccccccccbaacccccccccccccccccc", -"ccccccccccccbacccccccccccccccccc", -"cccccccccccccbcccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccc....cccccccccccc.ccccccccc", -"cccccc.ccc.ccccccccccc.ccccccccc", -"cccccc.ccc.cc..ccc..cc.cc.cccccc", -"cccccc....cc.cc.c.cc.c.c.ccccccc", -"cccccc.ccc.cc...c.cccc..cccccccc", -"cccccc.ccc.c.cc.c.cc.c.c.ccccccc", -"cccccc....ccc..c.c..cc.cc.cccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/back-cap-up.xbm --- a/etc/w3/back-cap-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x00, - 0x00,0x00,0x18,0x00,0x00,0x00,0x14,0x00,0x00,0x00,0xf2,0x73,0x00,0x00,0x01, - 0x8a,0x00,0x80,0x00,0x8a,0x00,0x00,0x01,0x8a,0x00,0x00,0xf2,0x73,0x00,0x00, - 0x14,0x00,0x00,0x00,0x18,0x00,0x00,0x00,0x10,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0xc0,0x03,0x40,0x00,0x40,0x04,0x40,0x00,0x40,0x64, - 0x4c,0x02,0xc0,0x93,0x52,0x01,0x40,0xe4,0xc2,0x00,0x40,0x94,0x52,0x01,0xc0, - 0x63,0x4d,0x02,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/back-cap-up.xpm --- a/etc/w3/back-cap-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,45 +0,0 @@ -/* XPM */ -static char *back-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 8 1", -/* colors */ -". c #000000", -"# c #330099", -"a c #888888", -"b c #aaaaaa", -"c c #b2b2b2 s backgroundToolBarColor", -"d c #cccccc", -"e c #eeeeee", -"f c #ffffff", -/* pixels */ -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccc#ccccccccccccccccccc", -"ccccccccccc##ccccccccccccccccccc", -"cccccccccc#f#ccccccccccccccccccc", -"ccccccccc#fe######cb###bcccccccc", -"cccccccc#fedeeeee#c#aea#abcccccc", -"ccccccc#feddddddd#b#eed#abcccccc", -"cccccccc#eddddddd#a#ada#abcccccc", -"cccccccba#ed######ab###abbcccccc", -"ccccccccba#e#aaaaaacaaabbbcccccc", -"cccccccccba##acccccccccccccccccc", -"ccccccccccba#acccccccccccccccccc", -"cccccccccccbaacccccccccccccccccc", -"ccccccccccccbacccccccccccccccccc", -"cccccccccccccbcccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccc....cccccccccccc.ccccccccc", -"cccccc.ccc.ccccccccccc.ccccccccc", -"cccccc.ccc.cc..ccc..cc.cc.cccccc", -"cccccc....cc.cc.c.cc.c.c.ccccccc", -"cccccc.ccc.cc...c.cccc..cccccccc", -"cccccc.ccc.c.cc.c.cc.c.c.ccccccc", -"cccccc....ccc..c.c..cc.cc.cccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/back-dn.xbm --- a/etc/w3/back-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xef,0xff, - 0xff,0xff,0xe7,0xff,0xff,0xff,0xeb,0xff,0xff,0xff,0x0d,0x8c,0xff,0xff,0xfe, - 0x75,0xff,0x7f,0xff,0x75,0xff,0xff,0xfe,0x75,0xff,0xff,0x0d,0x8c,0xff,0xff, - 0xeb,0xff,0xff,0xff,0xe7,0xff,0xff,0xff,0xef,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/back-dn.xpm --- a/etc/w3/back-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,45 +0,0 @@ -/* XPM */ -static char *back-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 8 1", -/* colors */ -". c #000000", -"# c #330099", -"a c #888888", -"b c #aaaaaa", -"c c #b2b2b2 s backgroundToolBarColor", -"d c #cccccc", -"e c #eeeeee", -"f c #ffffff", -/* pixels */ -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccc#ccccccccccccccccccc", -"ccccccccccc##ccccccccccccccccccc", -"cccccccccc#f#ccccccccccccccccccc", -"ccccccccc#fe######cb###bcccccccc", -"cccccccc#fedeeeee#c#aea#abcccccc", -"ccccccc#feddddddd#b#eed#abcccccc", -"cccccccc#eddddddd#a#ada#abcccccc", -"cccccccba#ed######ab###abbcccccc", -"ccccccccba#e#aaaaaacaaabbbcccccc", -"cccccccccba##acccccccccccccccccc", -"ccccccccccba#acccccccccccccccccc", -"cccccccccccbaacccccccccccccccccc", -"ccccccccccccbacccccccccccccccccc", -"cccccccccccccbcccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/back-no.xbm --- a/etc/w3/back-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x14,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01, - 0x8a,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0x8a,0x00,0x00,0x00,0x00,0x00,0x00, - 0x14,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/back-no.xpm --- a/etc/w3/back-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,45 +0,0 @@ -/* XPM */ -static char *back-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 8 1", -/* colors */ -". c #000000", -"# c #330099", -"a c #888888", -"b c #aaaaaa", -"c c #b2b2b2 s backgroundToolBarColor", -"d c #cccccc", -"e c #eeeeee", -"f c #ffffff", -/* pixels */ -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccc#ccccccccccccccccccc", -"ccccccccccc##ccccccccccccccccccc", -"cccccccccc#f#ccccccccccccccccccc", -"ccccccccc#fe######cb###bcccccccc", -"cccccccc#fedeeeee#c#aea#abcccccc", -"ccccccc#feddddddd#b#eed#abcccccc", -"cccccccc#eddddddd#a#ada#abcccccc", -"cccccccba#ed######ab###abbcccccc", -"ccccccccba#e#aaaaaacaaabbbcccccc", -"cccccccccba##acccccccccccccccccc", -"ccccccccccba#acccccccccccccccccc", -"cccccccccccbaacccccccccccccccccc", -"ccccccccccccbacccccccccccccccccc", -"cccccccccccccbcccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/back-up.xbm --- a/etc/w3/back-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x00, - 0x00,0x00,0x18,0x00,0x00,0x00,0x14,0x00,0x00,0x00,0xf2,0x73,0x00,0x00,0x01, - 0x8a,0x00,0x80,0x00,0x8a,0x00,0x00,0x01,0x8a,0x00,0x00,0xf2,0x73,0x00,0x00, - 0x14,0x00,0x00,0x00,0x18,0x00,0x00,0x00,0x10,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/back-up.xpm --- a/etc/w3/back-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,45 +0,0 @@ -/* XPM */ -static char *back-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 8 1", -/* colors */ -". c #000000", -"# c #330099", -"a c #888888", -"b c #aaaaaa", -"c c #b2b2b2 s backgroundToolBarColor", -"d c #cccccc", -"e c #eeeeee", -"f c #ffffff", -/* pixels */ -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccc#ccccccccccccccccccc", -"ccccccccccc##ccccccccccccccccccc", -"cccccccccc#f#ccccccccccccccccccc", -"ccccccccc#fe######cb###bcccccccc", -"cccccccc#fedeeeee#c#aea#abcccccc", -"ccccccc#feddddddd#b#eed#abcccccc", -"cccccccc#eddddddd#a#ada#abcccccc", -"cccccccba#ed######ab###abbcccccc", -"ccccccccba#e#aaaaaacaaabbbcccccc", -"cccccccccba##acccccccccccccccccc", -"ccccccccccba#acccccccccccccccccc", -"cccccccccccbaacccccccccccccccccc", -"ccccccccccccbacccccccccccccccccc", -"cccccccccccccbcccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccc" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/binary.document.xbm --- a/etc/w3/binary.document.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -#define binary_width 20 -#define binary_height 23 -static char binary_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0x3f,0x00,0x01,0x60,0x00,0x01,0xa0,0x00, - 0x71,0x26,0x01,0xd9,0x26,0x02,0xd9,0xe6,0x07,0xd9,0xc6,0x0f,0xd9,0x06,0x0c, - 0x71,0x06,0x0c,0x01,0x00,0x0c,0x99,0x03,0x0c,0xd9,0x06,0x0c,0xd9,0x06,0x0c, - 0xd9,0x06,0x0c,0xd9,0x06,0x0c,0x99,0x03,0x0c,0x01,0x00,0x0c,0xff,0xff,0x0f, - 0xfe,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/binhex.document.xbm --- a/etc/w3/binhex.document.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -#define binhex_width 20 -#define binhex_height 23 -static char binhex_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0x3f,0x00,0x01,0x60,0x00,0x01,0xa0,0x00, - 0x01,0x20,0x01,0x01,0x20,0x02,0x01,0xe0,0x07,0x01,0xc0,0x0f,0x01,0x00,0x0c, - 0x6d,0xb7,0x0d,0x6d,0xb7,0x0d,0x6d,0xb3,0x0d,0x7d,0xf7,0x0d,0x7d,0xe7,0x0c, - 0x6d,0xb3,0x0d,0x6d,0xb7,0x0d,0x6d,0xb7,0x0d,0x01,0x00,0x0c,0xff,0xff,0x0f, - 0xfe,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/caution.xbm --- a/etc/w3/caution.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define caution_width 32 -#define caution_height 32 -static char caution_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0x00,0x00,0x00,0x10,0x01, - 0x00,0x00,0x08,0x07,0x00,0x00,0x08,0x0e,0x00,0x00,0x04,0x0e,0x00,0x00,0x04, - 0x1c,0x00,0x00,0x02,0x1c,0x00,0x00,0xe2,0x38,0x00,0x00,0xf1,0x39,0x00,0x00, - 0xf1,0x71,0x00,0x80,0xf0,0x71,0x00,0x80,0xf0,0xe1,0x00,0x40,0xf0,0xe1,0x00, - 0x40,0xf0,0xc1,0x01,0x20,0xf0,0xc1,0x01,0x20,0xf0,0x81,0x03,0x10,0xe0,0x80, - 0x03,0x10,0xe0,0x00,0x07,0x08,0xe0,0x00,0x07,0x08,0xe0,0x00,0x0e,0x04,0x00, - 0x00,0x0e,0x04,0xe0,0x00,0x1c,0x02,0xf0,0x01,0x1c,0x02,0xf0,0x01,0x38,0x01, - 0xe0,0x00,0x38,0x01,0x00,0x00,0x70,0x01,0x00,0x00,0x70,0xff,0xff,0xff,0x7f, - 0xf8,0xff,0xff,0x3f,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/clock.xbm --- a/etc/w3/clock.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define clock.bm_width 32 -#define clock.bm_height 32 -static char clock.bm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x0f, 0x00, - 0x00, 0x0c, 0x30, 0x00, 0x00, 0x83, 0xc1, 0x00, 0x80, 0x80, 0x01, 0x01, - 0x40, 0x80, 0x01, 0x02, 0x20, 0x80, 0x01, 0x04, 0x10, 0x80, 0x01, 0x08, - 0x10, 0x80, 0x01, 0x08, 0x08, 0x80, 0x01, 0x10, 0x08, 0x80, 0x01, 0x10, - 0x04, 0x80, 0x01, 0x20, 0x04, 0x80, 0x01, 0x20, 0x04, 0xc0, 0x03, 0x20, - 0x84, 0xff, 0x03, 0x20, 0x84, 0xff, 0x03, 0x20, 0x04, 0xc0, 0x03, 0x20, - 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x10, - 0x08, 0x00, 0x00, 0x10, 0x10, 0x00, 0x00, 0x08, 0x10, 0x00, 0x00, 0x08, - 0x20, 0x00, 0x00, 0x04, 0x40, 0x00, 0x00, 0x02, 0x80, 0x00, 0x00, 0x01, - 0x00, 0x03, 0xc0, 0x00, 0x00, 0x0c, 0x30, 0x00, 0x00, 0xf0, 0x0f, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/compressed.document.xbm --- a/etc/w3/compressed.document.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -#define compressed_width 20 -#define compressed_height 23 -static char compressed_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0x07,0x00,0x20,0x0c,0x00,0x20,0x14,0x00, - 0x20,0x24,0x00,0x20,0x7c,0x00,0x20,0x78,0x00,0x20,0x60,0x00,0x21,0x60,0x08, - 0x23,0x60,0x0c,0x27,0x60,0x0e,0x2f,0x60,0x0f,0x27,0x60,0x0e,0x23,0x60,0x0c, - 0x21,0x60,0x08,0x20,0x60,0x00,0x20,0x60,0x00,0x20,0x60,0x00,0xe0,0x7f,0x00, - 0xc0,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/disk.drive.xbm --- a/etc/w3/disk.drive.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define disk_width 32 -#define disk_height 32 -static char disk_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0x3f,0x04,0x00,0x00,0x20,0x04, - 0x00,0x00,0x20,0xe4,0x00,0x00,0x20,0x04,0x00,0x00,0x20,0x04,0x00,0x00,0x20, - 0x04,0xf0,0x0f,0x20,0xe4,0xff,0xff,0x27,0x04,0xf0,0x0f,0x20,0x04,0x00,0x00, - 0x20,0x04,0x00,0x00,0x20,0x04,0x00,0x00,0x20,0x04,0x00,0x00,0x20,0xfc,0xff, - 0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/diskette.xbm --- a/etc/w3/diskette.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define diskette.bm_width 32 -#define diskette.bm_height 32 -static char diskette.bm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x02, 0x20, 0x02, - 0x10, 0x02, 0x27, 0x04, 0x10, 0x02, 0x27, 0x04, 0x10, 0x02, 0x27, 0x04, - 0x10, 0x02, 0x27, 0x04, 0x10, 0x02, 0x27, 0x04, 0x10, 0x02, 0x20, 0x04, - 0x10, 0xfe, 0x3f, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, - 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, - 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, - 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, - 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0xf0, 0xff, 0xff, 0x07, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/display.xbm --- a/etc/w3/display.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define display.bm_width 32 -#define display.bm_height 32 -static char display.bm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xf0, 0xff, 0xff, 0x0f, 0x10, 0x00, 0x00, 0x08, 0x10, 0x00, 0x00, 0x08, - 0x10, 0xf8, 0x1f, 0x08, 0x10, 0x06, 0x60, 0x08, 0x10, 0x01, 0x80, 0x08, - 0x10, 0x01, 0x80, 0x08, 0x90, 0x00, 0x00, 0x09, 0x90, 0x00, 0x00, 0x09, - 0x90, 0x00, 0x00, 0x09, 0x90, 0x00, 0x00, 0x09, 0x90, 0x00, 0x00, 0x09, - 0x90, 0x00, 0x00, 0x09, 0x10, 0x01, 0x80, 0x08, 0x10, 0x01, 0x80, 0x08, - 0x10, 0x06, 0x60, 0x08, 0x10, 0xf8, 0x1f, 0x08, 0x10, 0x00, 0x00, 0x08, - 0x10, 0x00, 0x00, 0x08, 0xf0, 0xff, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/fax.xbm --- a/etc/w3/fax.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define facsimile.bm_width 32 -#define facsimile.bm_height 32 -static char facsimile.bm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x80, 0xff, 0x03, 0x00, 0x80, 0x00, 0x06, 0x00, 0x80, 0x00, 0x0a, 0x00, - 0x80, 0x00, 0x12, 0x00, 0x80, 0x00, 0x22, 0x00, 0x80, 0x00, 0x42, 0x00, - 0x80, 0x00, 0x82, 0x00, 0x80, 0x00, 0xfe, 0x01, 0x80, 0x00, 0x00, 0x01, - 0x80, 0x00, 0x00, 0x01, 0x80, 0x00, 0x00, 0x01, 0x80, 0x00, 0x00, 0x01, - 0xfc, 0x00, 0x00, 0x3f, 0x84, 0x00, 0x00, 0x21, 0x84, 0x00, 0x00, 0x21, - 0x84, 0x00, 0x00, 0x21, 0xe4, 0xff, 0xff, 0x27, 0x04, 0x00, 0x00, 0x20, - 0x04, 0xf8, 0x1f, 0x20, 0x04, 0x06, 0x60, 0x20, 0x04, 0x01, 0x80, 0x20, - 0x84, 0xf8, 0x1f, 0x21, 0x84, 0x10, 0x08, 0x21, 0x84, 0x1f, 0xf8, 0x21, - 0x04, 0x00, 0x00, 0x20, 0xfc, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/file_server.xbm --- a/etc/w3/file_server.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define file_server_width 32 -#define file_server_height 32 -static char file_server_bits[] = { - 0x00,0x80,0x00,0x00,0x00,0x40,0xf9,0x07,0x00,0x20,0x0a,0x0c,0x00,0x10,0x0c, - 0x14,0x00,0x08,0x08,0x3c,0xe0,0x05,0x10,0x20,0x18,0xfe,0x21,0x20,0x08,0x00, - 0x41,0x20,0x08,0x00,0x81,0x20,0x08,0x00,0x41,0x20,0x08,0x00,0x21,0x20,0x08, - 0x00,0x11,0x20,0x08,0x00,0x09,0x20,0x08,0x00,0x0d,0x20,0x08,0x00,0x0b,0x20, - 0xff,0xff,0xff,0xff,0x02,0x00,0x00,0x40,0xfc,0xff,0xff,0x3f,0x80,0x54,0xa0, - 0x00,0x00,0x55,0xa0,0x00,0x00,0xd5,0xa0,0x00,0x00,0xa6,0xbb,0x00,0x00,0x44, - 0xec,0x00,0x00,0x98,0x90,0x00,0x00,0x30,0xa0,0x00,0x00,0xc0,0xc0,0x00,0x00, - 0x00,0x83,0x00,0x00,0x00,0x84,0x00,0x00,0x00,0x84,0x00,0x00,0x00,0xfe,0x01, - 0x00,0x00,0xfe,0x01,0x00,0x00,0xfe,0x01}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/filing.cabinet.xbm --- a/etc/w3/filing.cabinet.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define filing_cabinet.bm_width 32 -#define filing_cabinet.bm_height 32 -static char filing_cabinet.bm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0x01, - 0x80, 0x00, 0x00, 0x01, 0x80, 0xfe, 0x7f, 0x01, 0x80, 0x02, 0x40, 0x01, - 0x80, 0x02, 0x40, 0x01, 0x80, 0x02, 0x40, 0x01, 0x80, 0x22, 0x44, 0x01, - 0x80, 0x22, 0x44, 0x01, 0x80, 0xe2, 0x47, 0x01, 0x80, 0x02, 0x40, 0x01, - 0x80, 0x02, 0x40, 0x01, 0x80, 0x02, 0x40, 0x01, 0x80, 0xfe, 0x7f, 0x01, - 0x80, 0x00, 0x00, 0x01, 0x80, 0xfe, 0x7f, 0x01, 0x80, 0x02, 0x40, 0x01, - 0x80, 0x02, 0x40, 0x01, 0x80, 0x02, 0x40, 0x01, 0x80, 0x22, 0x44, 0x01, - 0x80, 0x22, 0x44, 0x01, 0x80, 0xe2, 0x47, 0x01, 0x80, 0x02, 0x40, 0x01, - 0x80, 0x02, 0x40, 0x01, 0x80, 0x02, 0x40, 0x01, 0x80, 0x02, 0x40, 0x01, - 0x80, 0xfe, 0x7f, 0x01, 0x80, 0x00, 0x00, 0x01, 0x80, 0xff, 0xff, 0x01, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/film.xbm --- a/etc/w3/film.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,9 +0,0 @@ -#define movie_width 20 -#define movie_height 23 -static char movie_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff, 0x07, 0xf9, 0xff, 0x0c, - 0x19, 0xe0, 0x0c, 0x1f, 0xc0, 0x0f, 0x19, 0xe0, 0x0c, 0x19, 0xc0, 0x0c, - 0x1f, 0xe0, 0x0f, 0x59, 0xd5, 0x0c, 0xf9, 0xff, 0x0c, 0xff, 0xff, 0x0f, - 0x19, 0xe0, 0x0c, 0x19, 0xc0, 0x0c, 0x1f, 0xe0, 0x0f, 0x19, 0xc0, 0x0c, - 0x19, 0xe0, 0x0c, 0x5f, 0xd5, 0x0f, 0xf9, 0xff, 0x0c, 0xff, 0xff, 0x0f, - 0xfe, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/find-cap-dn.xbm --- a/etc/w3/find-cap-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xcf,0xf3,0xff,0xff,0xcf,0xf3, - 0xff,0xff,0xc7,0xf1,0xff,0xff,0x7f,0xfe,0xff,0xff,0x01,0xc0,0xff,0xff,0x5e, - 0xbc,0xff,0xff,0xde,0xbc,0xff,0xff,0x1e,0xbc,0xff,0xff,0xc6,0xb0,0xff,0xff, - 0x6e,0xba,0xff,0xff,0xee,0xbb,0xff,0xff,0xee,0xbb,0xff,0xff,0xe0,0x83,0xff, - 0xff,0xe6,0x9b,0xff,0xff,0xe0,0x83,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xe8,0xbf,0xff,0x7f,0xff, - 0xbf,0xff,0x7f,0xaf,0x8e,0xff,0x7f,0x28,0xb5,0xff,0x7f,0xaf,0xb5,0xff,0x7f, - 0xaf,0xb5,0xff,0x7f,0xaf,0x8d,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/find-cap-dn.xpm --- a/etc/w3/find-cap-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *srch-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkicakkkicakkkkkkkkkkkk", -"kkkkkkkkkkkod.gjkod.gjkkkkkkkkkk", -"kkkkkkkkkkkdaagjkdaagjkkkkkkkkkk", -"kkkkkkkkkkkkjomdammgggjkkkkkkkkk", -"kkkkkkkkkdaaaadadaaaadgjkkkkkkkk", -"kkkkkkkkdmoomdmfadmpojdgjkkkkkkk", -"kkkkkkkkapommdpladmpmmagjkkkkkkk", -"kkkkkkkkapopmdaa.dmpmmagjkkkkkkk", -"kkkkkkkkamgaaapldaaagjagjkkkkkkk", -"kkkkkkkkapjgagjaamagmjagjkkkkkkk", -"kkkkkkkkapmjagjgggaomjagjkkkkkkk", -"kkkkkkkkapmjagjjjjapmjagjkkkkkkk", -"kkkkkkkkaaaaagjkkkaaaaagjkkkkkkk", -"kkkkkkkkapidagjkkkapidagjkkkkkkk", -"kkkkkkkkaaaaagjkkkaaaaagjkkkkkkk", -"kkkkkkkkkgggggjkkkkgggggjkkkkkkk", -"kkkkkkkkkjjjjjjkkkkjjjjjjkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkk....k.kkkkkkkkk.kkkkkkkkk", -"kkkkkkk.kkkkkkkkkkkkkk.kkkkkkkkk", -"kkkkkkk.kkkk.k.k.kkk...kkkkkkkkk", -"kkkkkkk....k.k..k.k.kk.kkkkkkkkk", -"kkkkkkk.kkkk.k.kk.k.kk.kkkkkkkkk", -"kkkkkkk.kkkk.k.kk.k.kk.kkkkkkkkk", -"kkkkkkk.kkkk.k.kk.kk...kkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/find-cap-no.xbm --- a/etc/w3/find-cap-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x30,0x0c, - 0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0xa1, - 0x43,0x00,0x00,0x00,0x00,0x00,0x00,0xe1,0x43,0x00,0x00,0x00,0x00,0x00,0x00, - 0x91,0x45,0x00,0x00,0x00,0x00,0x00,0x00,0x11,0x44,0x00,0x00,0x00,0x00,0x00, - 0x00,0x19,0x64,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x17,0x40,0x00,0x00,0x00, - 0x00,0x00,0x80,0x50,0x71,0x00,0x00,0x00,0x00,0x00,0x80,0x50,0x4a,0x00,0x00, - 0x00,0x00,0x00,0x80,0x50,0x72,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/find-cap-no.xpm --- a/etc/w3/find-cap-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *srch-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkicakkkicakkkkkkkkkkkk", -"kkkkkkkkkkkod.gjkod.gjkkkkkkkkkk", -"kkkkkkkkkkkdaagjkdaagjkkkkkkkkkk", -"kkkkkkkkkkkkjomdammgggjkkkkkkkkk", -"kkkkkkkkkdaaaadadaaaadgjkkkkkkkk", -"kkkkkkkkdmoomdmfadmpojdgjkkkkkkk", -"kkkkkkkkapommdpladmpmmagjkkkkkkk", -"kkkkkkkkapopmdaa.dmpmmagjkkkkkkk", -"kkkkkkkkamgaaapldaaagjagjkkkkkkk", -"kkkkkkkkapjgagjaamagmjagjkkkkkkk", -"kkkkkkkkapmjagjgggaomjagjkkkkkkk", -"kkkkkkkkapmjagjjjjapmjagjkkkkkkk", -"kkkkkkkkaaaaagjkkkaaaaagjkkkkkkk", -"kkkkkkkkapidagjkkkapidagjkkkkkkk", -"kkkkkkkkaaaaagjkkkaaaaagjkkkkkkk", -"kkkkkkkkkgggggjkkkkgggggjkkkkkkk", -"kkkkkkkkkjjjjjjkkkkjjjjjjkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkk....k.kkkkkkkkk.kkkkkkkkk", -"kkkkkkk.kkkkkkkkkkkkkk.kkkkkkkkk", -"kkkkkkk.kkkk.k.k.kkk...kkkkkkkkk", -"kkkkkkk....k.k..k.k.kk.kkkkkkkkk", -"kkkkkkk.kkkk.k.kk.k.kk.kkkkkkkkk", -"kkkkkkk.kkkk.k.kk.k.kk.kkkkkkkkk", -"kkkkkkk.kkkk.k.kk.kk...kkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/find-cap-up.xbm --- a/etc/w3/find-cap-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x30,0x0c,0x00,0x00,0x30,0x0c, - 0x00,0x00,0x38,0x0e,0x00,0x00,0x80,0x01,0x00,0x00,0xfe,0x3f,0x00,0x00,0xa1, - 0x43,0x00,0x00,0x21,0x43,0x00,0x00,0xe1,0x43,0x00,0x00,0x39,0x4f,0x00,0x00, - 0x91,0x45,0x00,0x00,0x11,0x44,0x00,0x00,0x11,0x44,0x00,0x00,0x1f,0x7c,0x00, - 0x00,0x19,0x64,0x00,0x00,0x1f,0x7c,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x17,0x40,0x00,0x80,0x00, - 0x40,0x00,0x80,0x50,0x71,0x00,0x80,0xd7,0x4a,0x00,0x80,0x50,0x4a,0x00,0x80, - 0x50,0x4a,0x00,0x80,0x50,0x72,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/find-cap-up.xpm --- a/etc/w3/find-cap-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *srch-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkicakkkicakkkkkkkkkkkk", -"kkkkkkkkkkkod.gjkod.gjkkkkkkkkkk", -"kkkkkkkkkkkdaagjkdaagjkkkkkkkkkk", -"kkkkkkkkkkkkjomdammgggjkkkkkkkkk", -"kkkkkkkkkdaaaadadaaaadgjkkkkkkkk", -"kkkkkkkkdmoomdmfadmpojdgjkkkkkkk", -"kkkkkkkkapommdpladmpmmagjkkkkkkk", -"kkkkkkkkapopmdaa.dmpmmagjkkkkkkk", -"kkkkkkkkamgaaapldaaagjagjkkkkkkk", -"kkkkkkkkapjgagjaamagmjagjkkkkkkk", -"kkkkkkkkapmjagjgggaomjagjkkkkkkk", -"kkkkkkkkapmjagjjjjapmjagjkkkkkkk", -"kkkkkkkkaaaaagjkkkaaaaagjkkkkkkk", -"kkkkkkkkapidagjkkkapidagjkkkkkkk", -"kkkkkkkkaaaaagjkkkaaaaagjkkkkkkk", -"kkkkkkkkkgggggjkkkkgggggjkkkkkkk", -"kkkkkkkkkjjjjjjkkkkjjjjjjkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkk....k.kkkkkkkkk.kkkkkkkkk", -"kkkkkkk.kkkkkkkkkkkkkk.kkkkkkkkk", -"kkkkkkk.kkkk.k.k.kkk...kkkkkkkkk", -"kkkkkkk....k.k..k.k.kk.kkkkkkkkk", -"kkkkkkk.kkkk.k.kk.k.kk.kkkkkkkkk", -"kkkkkkk.kkkk.k.kk.k.kk.kkkkkkkkk", -"kkkkkkk.kkkk.k.kk.kk...kkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/find-dn.xbm --- a/etc/w3/find-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xcf,0xf3,0xff,0xff,0xcf,0xf3, - 0xff,0xff,0xc7,0xf1,0xff,0xff,0x7f,0xfe,0xff,0xff,0x01,0xc0,0xff,0xff,0x5e, - 0xbc,0xff,0xff,0xde,0xbc,0xff,0xff,0x1e,0xbc,0xff,0xff,0xc6,0xb0,0xff,0xff, - 0x6e,0xba,0xff,0xff,0xee,0xbb,0xff,0xff,0xee,0xbb,0xff,0xff,0xe0,0x83,0xff, - 0xff,0xe6,0x9b,0xff,0xff,0xe0,0x83,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/find-dn.xpm --- a/etc/w3/find-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *srch-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkicakkkicakkkkkkkkkkkk", -"kkkkkkkkkkkod.gjkod.gjkkkkkkkkkk", -"kkkkkkkkkkkdaagjkdaagjkkkkkkkkkk", -"kkkkkkkkkkkkjomdammgggjkkkkkkkkk", -"kkkkkkkkkdaaaadadaaaadgjkkkkkkkk", -"kkkkkkkkdmoomdmfadmpojdgjkkkkkkk", -"kkkkkkkkapommdpladmpmmagjkkkkkkk", -"kkkkkkkkapopmdaa.dmpmmagjkkkkkkk", -"kkkkkkkkamgaaapldaaagjagjkkkkkkk", -"kkkkkkkkapjgagjaamagmjagjkkkkkkk", -"kkkkkkkkapmjagjgggaomjagjkkkkkkk", -"kkkkkkkkapmjagjjjjapmjagjkkkkkkk", -"kkkkkkkkaaaaagjkkkaaaaagjkkkkkkk", -"kkkkkkkkapidagjkkkapidagjkkkkkkk", -"kkkkkkkkaaaaagjkkkaaaaagjkkkkkkk", -"kkkkkkkkkgggggjkkkkgggggjkkkkkkk", -"kkkkkkkkkjjjjjjkkkkjjjjjjkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/find-no.xbm --- a/etc/w3/find-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x30,0x0c, - 0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0xa1, - 0x43,0x00,0x00,0x00,0x00,0x00,0x00,0xe1,0x43,0x00,0x00,0x00,0x00,0x00,0x00, - 0x91,0x45,0x00,0x00,0x00,0x00,0x00,0x00,0x11,0x44,0x00,0x00,0x00,0x00,0x00, - 0x00,0x19,0x64,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/find-no.xpm --- a/etc/w3/find-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *srch-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkicakkkicakkkkkkkkkkkk", -"kkkkkkkkkkkod.gjkod.gjkkkkkkkkkk", -"kkkkkkkkkkkdaagjkdaagjkkkkkkkkkk", -"kkkkkkkkkkkkjomdammgggjkkkkkkkkk", -"kkkkkkkkkdaaaadadaaaadgjkkkkkkkk", -"kkkkkkkkdmoomdmfadmpojdgjkkkkkkk", -"kkkkkkkkapommdpladmpmmagjkkkkkkk", -"kkkkkkkkapopmdaa.dmpmmagjkkkkkkk", -"kkkkkkkkamgaaapldaaagjagjkkkkkkk", -"kkkkkkkkapjgagjaamagmjagjkkkkkkk", -"kkkkkkkkapmjagjgggaomjagjkkkkkkk", -"kkkkkkkkapmjagjjjjapmjagjkkkkkkk", -"kkkkkkkkaaaaagjkkkaaaaagjkkkkkkk", -"kkkkkkkkapidagjkkkapidagjkkkkkkk", -"kkkkkkkkaaaaagjkkkaaaaagjkkkkkkk", -"kkkkkkkkkgggggjkkkkgggggjkkkkkkk", -"kkkkkkkkkjjjjjjkkkkjjjjjjkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/find-up.xbm --- a/etc/w3/find-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x30,0x0c,0x00,0x00,0x30,0x0c, - 0x00,0x00,0x38,0x0e,0x00,0x00,0x80,0x01,0x00,0x00,0xfe,0x3f,0x00,0x00,0xa1, - 0x43,0x00,0x00,0x21,0x43,0x00,0x00,0xe1,0x43,0x00,0x00,0x39,0x4f,0x00,0x00, - 0x91,0x45,0x00,0x00,0x11,0x44,0x00,0x00,0x11,0x44,0x00,0x00,0x1f,0x7c,0x00, - 0x00,0x19,0x64,0x00,0x00,0x1f,0x7c,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/find-up.xpm --- a/etc/w3/find-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *srch-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkicakkkicakkkkkkkkkkkk", -"kkkkkkkkkkkod.gjkod.gjkkkkkkkkkk", -"kkkkkkkkkkkdaagjkdaagjkkkkkkkkkk", -"kkkkkkkkkkkkjomdammgggjkkkkkkkkk", -"kkkkkkkkkdaaaadadaaaadgjkkkkkkkk", -"kkkkkkkkdmoomdmfadmpojdgjkkkkkkk", -"kkkkkkkkapommdpladmpmmagjkkkkkkk", -"kkkkkkkkapopmdaa.dmpmmagjkkkkkkk", -"kkkkkkkkamgaaapldaaagjagjkkkkkkk", -"kkkkkkkkapjgagjaamagmjagjkkkkkkk", -"kkkkkkkkapmjagjgggaomjagjkkkkkkk", -"kkkkkkkkapmjagjjjjapmjagjkkkkkkk", -"kkkkkkkkaaaaagjkkkaaaaagjkkkkkkk", -"kkkkkkkkapidagjkkkapidagjkkkkkkk", -"kkkkkkkkaaaaagjkkkaaaaagjkkkkkkk", -"kkkkkkkkkgggggjkkkkgggggjkkkkkkk", -"kkkkkkkkkjjjjjjkkkkjjjjjjkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/fixed.disk.xbm --- a/etc/w3/fixed.disk.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define fixed_storage_device.bm_width 32 -#define fixed_storage_device.bm_height 32 -static char fixed_storage_device.bm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x3f, - 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, 0xe4, 0xfc, 0xff, 0x27, - 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, 0x04, 0xfc, 0xff, 0x27, - 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, 0x04, 0xfc, 0xff, 0x27, - 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, 0x04, 0xfc, 0xff, 0x27, - 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, 0xfc, 0xff, 0xff, 0x3f, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/folder.xbm --- a/etc/w3/folder.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -#define folder_width 20 -#define folder_height 23 -static char folder_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0x01,0x00,0x04,0x02,0x00,0x02,0x04,0x00, - 0x01,0xf8,0x01,0x01,0x00,0x02,0x01,0x00,0x04,0x01,0x00,0x0e,0x01,0x00,0x0d, - 0x01,0x00,0x0e,0x01,0x00,0x0d,0x01,0x00,0x0e,0x01,0x00,0x0d,0x01,0x00,0x0e, - 0x01,0x00,0x0d,0x01,0x00,0x0e,0x55,0x55,0x0d,0xaa,0xaa,0x0e,0xfc,0xff,0x07, - 0xf8,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/form.xbm --- a/etc/w3/form.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define form_width 32 -#define form_height 32 -static char form_bits[] = { - 0xff,0xff,0x3f,0xe0,0x01,0x00,0x20,0xf0,0xfd,0x01,0x20,0x78,0x05,0x01,0x20, - 0xbc,0x05,0x01,0x20,0xde,0x05,0x01,0x20,0xef,0x05,0x01,0xa0,0xf7,0x05,0x79, - 0xe0,0x7b,0xfd,0x3d,0xe0,0xbd,0x01,0x1e,0xf0,0xde,0x01,0x0e,0x78,0xef,0xfd, - 0x07,0xbc,0x77,0x1d,0x03,0xde,0x3b,0x9d,0x03,0xec,0x1d,0xfd,0x01,0xf2,0x0e, - 0xf5,0x01,0x75,0x07,0x75,0x01,0xaa,0x03,0xfd,0x01,0xd5,0x01,0x21,0x80,0xaa, - 0x00,0x01,0x80,0x55,0x00,0xfd,0xc1,0x2b,0x00,0x05,0xc1,0x27,0x00,0x05,0xc1, - 0x21,0x00,0x05,0x01,0x20,0x00,0x05,0x01,0x20,0x00,0x05,0x01,0x20,0x00,0xfd, - 0x01,0x20,0x00,0x01,0x00,0x20,0x00,0x01,0x00,0x20,0x00,0xff,0xff,0x3f,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/forw-cap-dn.xbm --- a/etc/w3/forw-cap-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -#define noname_width 34 -#define noname_height 30 -static char noname_bits[] = { - 0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03, - 0xff,0xff,0xef,0xff,0x03,0xff,0xff,0xcf,0xff,0x03,0xff,0xff,0xaf,0xff,0x03, - 0xff,0x63,0x60,0xff,0x03,0xff,0x5d,0xff,0xfe,0x03,0xff,0x5d,0xff,0xfd,0x03, - 0xff,0x5d,0xff,0xfe,0x03,0xff,0x63,0x60,0xff,0x03,0xff,0xff,0xaf,0xff,0x03, - 0xff,0xff,0xcf,0xff,0x03,0xff,0xff,0xef,0xff,0x03,0xff,0xff,0xff,0xff,0x03, - 0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03, - 0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03,0xe1,0xff,0xff,0x7f,0x03, - 0xfd,0xff,0xff,0x7f,0x03,0x7d,0x96,0x9a,0x15,0x03,0xa1,0xa5,0x6a,0x69,0x03, - 0xbd,0xb5,0x1a,0x6d,0x03,0xbd,0x75,0x6d,0x6d,0x03,0x7d,0x76,0x9d,0x1c,0x03, - 0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/forw-cap-dn.xpm --- a/etc/w3/forw-cap-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *forw-up[] = { -/* width height num_colors chars_per_pixel */ -" 34 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkakkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaakkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaoakkkkkkkkkkk", -"kkkkkkkkkjaaajkaaaaaaooakkkkkkkkkk", -"kkkkkkkkkagogakaooooomooakkkkkkkkk", -"kkkkkkkkkaoomagaommmmmmooakkkkkkkk", -"kkkkkkkkkagmgagaommmmmmoagjkkkkkkk", -"kkkkkkkkkjaaagjaaaaaamoagjkkkkkkkk", -"kkkkkkkkkkjggjjkggggaoagjkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaagjkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkagjkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkjkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"k....kkkkkkkkkkkkkkkkkkkkkkkkkk.kk", -"k.kkkkkkkkkkkkkkkkkkkkkkkkkkkkk.kk", -"k.kkkkk..kk.k..k.k.kk..kk.k.k...kk", -"k....k.kk.k..k.k.k.k.kk.k..k.kk.kk", -"k.kkkk.kk.k.kk.k.k.kk...k.kk.kk.kk", -"k.kkkk.kk.k.kkk.k.kk.kk.k.kk.kk.kk", -"k.kkkkk..kk.kkk.k.kkk..k..kkk...kk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/forw-cap-no.xbm --- a/etc/w3/forw-cap-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -#define noname_width 34 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x10,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x50,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0xa2,0x00,0x01,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0xa2,0x00,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x50,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x02,0x00,0x00,0x80,0x00,0x00,0x00,0x00,0x00,0x00,0x5e,0x5a,0x95,0x96,0x00, - 0x00,0x00,0x00,0x00,0x00,0x42,0x8a,0x92,0x92,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/forw-cap-no.xpm --- a/etc/w3/forw-cap-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *forw-up[] = { -/* width height num_colors chars_per_pixel */ -" 34 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkakkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaakkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaoakkkkkkkkkkk", -"kkkkkkkkkjaaajkaaaaaaooakkkkkkkkkk", -"kkkkkkkkkagogakaooooomooakkkkkkkkk", -"kkkkkkkkkaoomagaommmmmmooakkkkkkkk", -"kkkkkkkkkagmgagaommmmmmoagjkkkkkkk", -"kkkkkkkkkjaaagjaaaaaamoagjkkkkkkkk", -"kkkkkkkkkkjggjjkggggaoagjkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaagjkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkagjkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkjkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"k....kkkkkkkkkkkkkkkkkkkkkkkkkk.kk", -"k.kkkkkkkkkkkkkkkkkkkkkkkkkkkkk.kk", -"k.kkkkk..kk.k..k.k.kk..kk.k.k...kk", -"k....k.kk.k..k.k.k.k.kk.k..k.kk.kk", -"k.kkkk.kk.k.kk.k.k.kk...k.kk.kk.kk", -"k.kkkk.kk.k.kkk.k.kk.kk.k.kk.kk.kk", -"k.kkkkk..kk.kkk.k.kkk..k..kkk...kk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/forw-cap-up.xbm --- a/etc/w3/forw-cap-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -#define noname_width 34 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x10,0x00,0x00,0x00,0x00,0x30,0x00,0x00,0x00,0x00,0x50,0x00,0x00, - 0x00,0x9c,0x9f,0x00,0x00,0x00,0xa2,0x00,0x01,0x00,0x00,0xa2,0x00,0x02,0x00, - 0x00,0xa2,0x00,0x01,0x00,0x00,0x9c,0x9f,0x00,0x00,0x00,0x00,0x50,0x00,0x00, - 0x00,0x00,0x30,0x00,0x00,0x00,0x00,0x10,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x1e,0x00,0x00,0x80,0x00, - 0x02,0x00,0x00,0x80,0x00,0x82,0x69,0x65,0xea,0x00,0x5e,0x5a,0x95,0x96,0x00, - 0x42,0x4a,0xe5,0x92,0x00,0x42,0x8a,0x92,0x92,0x00,0x82,0x89,0x62,0xe3,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/forw-cap-up.xpm --- a/etc/w3/forw-cap-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *forw-up[] = { -/* width height num_colors chars_per_pixel */ -" 34 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkakkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaakkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaoakkkkkkkkkkk", -"kkkkkkkkkjaaajkaaaaaaooakkkkkkkkkk", -"kkkkkkkkkagogakaooooomooakkkkkkkkk", -"kkkkkkkkkaoomagaommmmmmooakkkkkkkk", -"kkkkkkkkkagmgagaommmmmmoagjkkkkkkk", -"kkkkkkkkkjaaagjaaaaaamoagjkkkkkkkk", -"kkkkkkkkkkjggjjkggggaoagjkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaagjkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkagjkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkjkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"k....kkkkkkkkkkkkkkkkkkkkkkkkkk.kk", -"k.kkkkkkkkkkkkkkkkkkkkkkkkkkkkk.kk", -"k.kkkkk..kk.k..k.k.kk..kk.k.k...kk", -"k....k.kk.k..k.k.k.k.kk.k..k.kk.kk", -"k.kkkk.kk.k.kk.k.k.kk...k.kk.kk.kk", -"k.kkkk.kk.k.kkk.k.kk.kk.k.kk.kk.kk", -"k.kkkkk..kk.kkk.k.kkk..k..kkk...kk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/forw-dn.xbm --- a/etc/w3/forw-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -#define noname_width 34 -#define noname_height 30 -static char noname_bits[] = { - 0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03, - 0xff,0xff,0xef,0xff,0x03,0xff,0xff,0xcf,0xff,0x03,0xff,0xff,0xaf,0xff,0x03, - 0xff,0x63,0x60,0xff,0x03,0xff,0x5d,0xff,0xfe,0x03,0xff,0x5d,0xff,0xfd,0x03, - 0xff,0x5d,0xff,0xfe,0x03,0xff,0x63,0x60,0xff,0x03,0xff,0xff,0xaf,0xff,0x03, - 0xff,0xff,0xcf,0xff,0x03,0xff,0xff,0xef,0xff,0x03,0xff,0xff,0xff,0xff,0x03, - 0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03, - 0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03, - 0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03, - 0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03, - 0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03,0xff,0xff,0xff,0xff,0x03}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/forw-dn.xpm --- a/etc/w3/forw-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *forw-up[] = { -/* width height num_colors chars_per_pixel */ -" 34 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkakkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaakkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaoakkkkkkkkkkk", -"kkkkkkkkkjaaajkaaaaaaooakkkkkkkkkk", -"kkkkkkkkkagogakaooooomooakkkkkkkkk", -"kkkkkkkkkaoomagaommmmmmooakkkkkkkk", -"kkkkkkkkkagmgagaommmmmmoagjkkkkkkk", -"kkkkkkkkkjaaagjaaaaaamoagjkkkkkkkk", -"kkkkkkkkkkjggjjkggggaoagjkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaagjkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkagjkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkjkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/forw-no.xbm --- a/etc/w3/forw-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -#define noname_width 34 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x10,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x50,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0xa2,0x00,0x01,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0xa2,0x00,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x50,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/forw-no.xpm --- a/etc/w3/forw-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *forw-up[] = { -/* width height num_colors chars_per_pixel */ -" 34 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkakkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaakkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaoakkkkkkkkkkk", -"kkkkkkkkkjaaajkaaaaaaooakkkkkkkkkk", -"kkkkkkkkkagogakaooooomooakkkkkkkkk", -"kkkkkkkkkaoomagaommmmmmooakkkkkkkk", -"kkkkkkkkkagmgagaommmmmmoagjkkkkkkk", -"kkkkkkkkkjaaagjaaaaaamoagjkkkkkkkk", -"kkkkkkkkkkjggjjkggggaoagjkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaagjkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkagjkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkjkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/forw-up.xbm --- a/etc/w3/forw-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -#define noname_width 34 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x10,0x00,0x00,0x00,0x00,0x30,0x00,0x00,0x00,0x00,0x50,0x00,0x00, - 0x00,0x9c,0x9f,0x00,0x00,0x00,0xa2,0x00,0x01,0x00,0x00,0xa2,0x00,0x02,0x00, - 0x00,0xa2,0x00,0x01,0x00,0x00,0x9c,0x9f,0x00,0x00,0x00,0x00,0x50,0x00,0x00, - 0x00,0x00,0x30,0x00,0x00,0x00,0x00,0x10,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/forw-up.xpm --- a/etc/w3/forw-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *forw-up[] = { -/* width height num_colors chars_per_pixel */ -" 34 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkakkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaakkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaoakkkkkkkkkkk", -"kkkkkkkkkjaaajkaaaaaaooakkkkkkkkkk", -"kkkkkkkkkagogakaooooomooakkkkkkkkk", -"kkkkkkkkkaoomagaommmmmmooakkkkkkkk", -"kkkkkkkkkagmgagaommmmmmoagjkkkkkkk", -"kkkkkkkkkjaaagjaaaaaamoagjkkkkkkkk", -"kkkkkkkkkkjggjjkggggaoagjkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkaagjkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkagjkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkjkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/ftp.xbm --- a/etc/w3/ftp.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,9 +0,0 @@ -#define ftp_width 20 -#define ftp_height 23 -static char ftp_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0x07, 0x02, 0x00, 0x0c, - 0x7a, 0xef, 0x0d, 0x7a, 0xef, 0x0f, 0x1a, 0x66, 0x0f, 0x7a, 0x66, 0x0f, - 0x7a, 0xe6, 0x0f, 0x1a, 0xe6, 0x0d, 0x1a, 0x66, 0x0c, 0x1a, 0x66, 0x0c, - 0x02, 0x00, 0x0c, 0xfe, 0xff, 0x0f, 0xfc, 0xff, 0x0f, 0x00, 0x00, 0x00, - 0x04, 0x00, 0x02, 0xfe, 0xff, 0x07, 0xff, 0xff, 0x0f, 0xfe, 0xff, 0x07, - 0x04, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/glossary.xbm --- a/etc/w3/glossary.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define glossary_width 32 -#define glossary_height 32 -static char glossary_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0x00,0x40,0x00,0x80, - 0x03,0x40,0x00,0x80,0x02,0xf0,0x01,0x80,0x02,0x40,0x00,0x80,0x07,0x40,0x00, - 0x80,0x08,0x40,0x00,0x80,0x08,0xf0,0x01,0x80,0x08,0x40,0x00,0x80,0x08,0x40, - 0x00,0x80,0x04,0x40,0x00,0x80,0x07,0xf0,0x01,0x80,0x04,0x40,0x00,0x80,0x08, - 0x40,0x00,0x80,0x08,0x40,0x00,0x80,0x08,0xf0,0x01,0x80,0x08,0x40,0x00,0x80, - 0x04,0x40,0x00,0x80,0x07,0x40,0x00,0x80,0x04,0xf0,0x01,0x80,0x08,0x40,0x00, - 0x80,0x08,0x40,0x00,0x80,0x08,0x40,0x00,0x80,0x08,0xf0,0x01,0x80,0x07,0x40, - 0x00,0x80,0x02,0xc0,0xff,0xff,0x02,0x00,0x01,0x00,0x02,0x00,0xff,0xff,0x03, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/help-cap-dn.xbm --- a/etc/w3/help-cap-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 28 -#define noname_height 28 -static char noname_bits[] = { - 0xff,0xff,0xff,0x0f,0xff,0xff,0xff,0x0f,0xff,0xff,0xff,0x0f,0xff,0xff,0xff, - 0x0f,0xff,0x00,0xfc,0x0f,0x7f,0xaa,0xfa,0x0f,0x3f,0x55,0xf5,0x0f,0x9f,0x02, - 0xea,0x0f,0x5f,0x01,0xd4,0x0f,0x9f,0x00,0xe8,0x0f,0x5f,0x51,0xd4,0x0f,0x9f, - 0x20,0xa8,0x0f,0x5f,0x51,0x54,0x0f,0x9f,0x2a,0xa8,0x0e,0x5f,0x15,0x14,0x0e, - 0x9f,0x0a,0xea,0x0f,0x3f,0x05,0xd5,0x0f,0x7f,0x8a,0xea,0x0f,0xff,0x04,0xf5, - 0x0f,0xff,0xa9,0xea,0x0f,0xff,0x55,0xf5,0x0f,0xff,0x89,0xfe,0x0f,0xff,0x05, - 0xfd,0x0f,0xff,0x89,0xfe,0x0f,0xff,0x54,0xfd,0x0f,0xff,0xaa,0xfa,0x0f,0xff, - 0xff,0xff,0x0f,0xff,0xff,0xff,0x0f}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/help-cap-dn.xpm --- a/etc/w3/help-cap-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -/* XPM */ -static char *help-up[] = { -/* width height num_colors chars_per_pixel */ -" 28 28 2 1", -/* colors */ -". c #b2b2b2 s backgroundToolBarColor", -"# c #000000", -/* pixels */ -"............................", -"............................", -"............................", -"............................", -"........##########..........", -".......##.#.#.#.#.#.........", -"......##.#.#.#.#.#.#........", -".....##.#.#######.#.#.......", -".....#.#.#########.#.#......", -".....##.###########.#.......", -".....#.#.###.#.###.#.#......", -".....##.#####.#####.#.#.....", -".....#.#.###.#.###.#.#.#....", -".....##.#.#.#.#####.#.#.#...", -".....#.#.#.#.#####.#.####...", -".....##.#.#.#####.#.#.......", -"......##.#.#####.#.#.#......", -".......##.#.###.#.#.#.......", -"........##.#####.#.#........", -".........##.#.#.#.#.#.......", -".........#.#.#.#.#.#........", -".........##.###.#...........", -".........#.#####.#..........", -".........##.###.#...........", -"........##.#.#.#.#..........", -"........#.#.#.#.#.#.........", -"............................", -"............................" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/help-cap-no.xbm --- a/etc/w3/help-cap-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 28 -#define noname_height 28 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x80,0x55,0x05,0x00,0x00,0x00,0x00,0x00,0x60,0xfd, - 0x15,0x00,0x00,0x00,0x00,0x00,0x60,0xff,0x17,0x00,0x00,0x00,0x00,0x00,0x60, - 0xdf,0x57,0x00,0x00,0x00,0x00,0x00,0x60,0xd5,0x57,0x01,0x00,0x00,0x00,0x00, - 0x60,0xf5,0x15,0x00,0x00,0x00,0x00,0x00,0x80,0x75,0x15,0x00,0x00,0x00,0x00, - 0x00,0x00,0x56,0x15,0x00,0x00,0x00,0x00,0x00,0x00,0x76,0x01,0x00,0x00,0x00, - 0x00,0x00,0x00,0x76,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x55,0x05,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/help-cap-no.xpm --- a/etc/w3/help-cap-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -/* XPM */ -static char *help-up[] = { -/* width height num_colors chars_per_pixel */ -" 28 28 2 1", -/* colors */ -". c #b2b2b2 s backgroundToolBarColor", -"# c #000000", -/* pixels */ -"............................", -"............................", -"............................", -"............................", -"........##########..........", -".......##.#.#.#.#.#.........", -"......##.#.#.#.#.#.#........", -".....##.#.#######.#.#.......", -".....#.#.#########.#.#......", -".....##.###########.#.......", -".....#.#.###.#.###.#.#......", -".....##.#####.#####.#.#.....", -".....#.#.###.#.###.#.#.#....", -".....##.#.#.#.#####.#.#.#...", -".....#.#.#.#.#####.#.####...", -".....##.#.#.#####.#.#.......", -"......##.#.#####.#.#.#......", -".......##.#.###.#.#.#.......", -"........##.#####.#.#........", -".........##.#.#.#.#.#.......", -".........#.#.#.#.#.#........", -".........##.###.#...........", -".........#.#####.#..........", -".........##.###.#...........", -"........##.#.#.#.#..........", -"........#.#.#.#.#.#.........", -"............................", -"............................" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/help-cap-up.xbm --- a/etc/w3/help-cap-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 28 -#define noname_height 28 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0xff,0x03,0x00,0x80,0x55,0x05,0x00,0xc0,0xaa,0x0a,0x00,0x60,0xfd, - 0x15,0x00,0xa0,0xfe,0x2b,0x00,0x60,0xff,0x17,0x00,0xa0,0xae,0x2b,0x00,0x60, - 0xdf,0x57,0x00,0xa0,0xae,0xab,0x00,0x60,0xd5,0x57,0x01,0xa0,0xea,0xeb,0x01, - 0x60,0xf5,0x15,0x00,0xc0,0xfa,0x2a,0x00,0x80,0x75,0x15,0x00,0x00,0xfb,0x0a, - 0x00,0x00,0x56,0x15,0x00,0x00,0xaa,0x0a,0x00,0x00,0x76,0x01,0x00,0x00,0xfa, - 0x02,0x00,0x00,0x76,0x01,0x00,0x00,0xab,0x02,0x00,0x00,0x55,0x05,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/help-cap-up.xpm --- a/etc/w3/help-cap-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -/* XPM */ -static char *help-up[] = { -/* width height num_colors chars_per_pixel */ -" 28 28 2 1", -/* colors */ -". c #b2b2b2 s backgroundToolBarColor", -"# c #000000", -/* pixels */ -"............................", -"............................", -"............................", -"............................", -"........##########..........", -".......##.#.#.#.#.#.........", -"......##.#.#.#.#.#.#........", -".....##.#.#######.#.#.......", -".....#.#.#########.#.#......", -".....##.###########.#.......", -".....#.#.###.#.###.#.#......", -".....##.#####.#####.#.#.....", -".....#.#.###.#.###.#.#.#....", -".....##.#.#.#.#####.#.#.#...", -".....#.#.#.#.#####.#.####...", -".....##.#.#.#####.#.#.......", -"......##.#.#####.#.#.#......", -".......##.#.###.#.#.#.......", -"........##.#####.#.#........", -".........##.#.#.#.#.#.......", -".........#.#.#.#.#.#........", -".........##.###.#...........", -".........#.#####.#..........", -".........##.###.#...........", -"........##.#.#.#.#..........", -"........#.#.#.#.#.#.........", -"............................", -"............................" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/help-dn.xbm --- a/etc/w3/help-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 28 -#define noname_height 28 -static char noname_bits[] = { - 0xff,0xff,0xff,0x0f,0xff,0xff,0xff,0x0f,0xff,0xff,0xff,0x0f,0xff,0xff,0xff, - 0x0f,0xff,0x00,0xfc,0x0f,0x7f,0xaa,0xfa,0x0f,0x3f,0x55,0xf5,0x0f,0x9f,0x02, - 0xea,0x0f,0x5f,0x01,0xd4,0x0f,0x9f,0x00,0xe8,0x0f,0x5f,0x51,0xd4,0x0f,0x9f, - 0x20,0xa8,0x0f,0x5f,0x51,0x54,0x0f,0x9f,0x2a,0xa8,0x0e,0x5f,0x15,0x14,0x0e, - 0x9f,0x0a,0xea,0x0f,0x3f,0x05,0xd5,0x0f,0x7f,0x8a,0xea,0x0f,0xff,0x04,0xf5, - 0x0f,0xff,0xa9,0xea,0x0f,0xff,0x55,0xf5,0x0f,0xff,0x89,0xfe,0x0f,0xff,0x05, - 0xfd,0x0f,0xff,0x89,0xfe,0x0f,0xff,0x54,0xfd,0x0f,0xff,0xaa,0xfa,0x0f,0xff, - 0xff,0xff,0x0f,0xff,0xff,0xff,0x0f}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/help-dn.xpm --- a/etc/w3/help-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -/* XPM */ -static char *help-up[] = { -/* width height num_colors chars_per_pixel */ -" 28 28 2 1", -/* colors */ -". c #b2b2b2 s backgroundToolBarColor", -"# c #000000", -/* pixels */ -"............................", -"............................", -"............................", -"............................", -"........##########..........", -".......##.#.#.#.#.#.........", -"......##.#.#.#.#.#.#........", -".....##.#.#######.#.#.......", -".....#.#.#########.#.#......", -".....##.###########.#.......", -".....#.#.###.#.###.#.#......", -".....##.#####.#####.#.#.....", -".....#.#.###.#.###.#.#.#....", -".....##.#.#.#.#####.#.#.#...", -".....#.#.#.#.#####.#.####...", -".....##.#.#.#####.#.#.......", -"......##.#.#####.#.#.#......", -".......##.#.###.#.#.#.......", -"........##.#####.#.#........", -".........##.#.#.#.#.#.......", -".........#.#.#.#.#.#........", -".........##.###.#...........", -".........#.#####.#..........", -".........##.###.#...........", -"........##.#.#.#.#..........", -"........#.#.#.#.#.#.........", -"............................", -"............................" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/help-icon.xbm --- a/etc/w3/help-icon.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define help-icon_width 32 -#define help-icon_height 32 -static char help-icon_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xfe, 0x07, 0x00, 0x00, 0xab, 0x0a, 0x00, 0x80, 0x55, 0x15, 0x00, - 0xc0, 0xfa, 0x2b, 0x00, 0x40, 0xfd, 0x57, 0x00, 0xc0, 0xfe, 0x2f, 0x00, - 0x40, 0x5d, 0x57, 0x00, 0xc0, 0xbe, 0xaf, 0x00, 0x40, 0x5d, 0x57, 0x01, - 0xc0, 0xaa, 0xaf, 0x02, 0x40, 0xd5, 0xd7, 0x03, 0xc0, 0xea, 0x2b, 0x00, - 0x80, 0xf5, 0x55, 0x00, 0x00, 0xeb, 0x2a, 0x00, 0x00, 0xf6, 0x15, 0x00, - 0x00, 0xac, 0x2a, 0x00, 0x00, 0x54, 0x15, 0x00, 0x00, 0xec, 0x02, 0x00, - 0x00, 0xf4, 0x05, 0x00, 0x00, 0xec, 0x02, 0x00, 0x00, 0x56, 0x05, 0x00, - 0x00, 0xaa, 0x0a, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/help-no.xbm --- a/etc/w3/help-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 28 -#define noname_height 28 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x80,0x55,0x05,0x00,0x00,0x00,0x00,0x00,0x60,0xfd, - 0x15,0x00,0x00,0x00,0x00,0x00,0x60,0xff,0x17,0x00,0x00,0x00,0x00,0x00,0x60, - 0xdf,0x57,0x00,0x00,0x00,0x00,0x00,0x60,0xd5,0x57,0x01,0x00,0x00,0x00,0x00, - 0x60,0xf5,0x15,0x00,0x00,0x00,0x00,0x00,0x80,0x75,0x15,0x00,0x00,0x00,0x00, - 0x00,0x00,0x56,0x15,0x00,0x00,0x00,0x00,0x00,0x00,0x76,0x01,0x00,0x00,0x00, - 0x00,0x00,0x00,0x76,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x55,0x05,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/help-no.xpm --- a/etc/w3/help-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -/* XPM */ -static char *help-up[] = { -/* width height num_colors chars_per_pixel */ -" 28 28 2 1", -/* colors */ -". c #b2b2b2 s backgroundToolBarColor", -"# c #000000", -/* pixels */ -"............................", -"............................", -"............................", -"............................", -"........##########..........", -".......##.#.#.#.#.#.........", -"......##.#.#.#.#.#.#........", -".....##.#.#######.#.#.......", -".....#.#.#########.#.#......", -".....##.###########.#.......", -".....#.#.###.#.###.#.#......", -".....##.#####.#####.#.#.....", -".....#.#.###.#.###.#.#.#....", -".....##.#.#.#.#####.#.#.#...", -".....#.#.#.#.#####.#.####...", -".....##.#.#.#####.#.#.......", -"......##.#.#####.#.#.#......", -".......##.#.###.#.#.#.......", -"........##.#####.#.#........", -".........##.#.#.#.#.#.......", -".........#.#.#.#.#.#........", -".........##.###.#...........", -".........#.#####.#..........", -".........##.###.#...........", -"........##.#.#.#.#..........", -"........#.#.#.#.#.#.........", -"............................", -"............................" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/help-up.xbm --- a/etc/w3/help-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 28 -#define noname_height 28 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0xff,0x03,0x00,0x80,0x55,0x05,0x00,0xc0,0xaa,0x0a,0x00,0x60,0xfd, - 0x15,0x00,0xa0,0xfe,0x2b,0x00,0x60,0xff,0x17,0x00,0xa0,0xae,0x2b,0x00,0x60, - 0xdf,0x57,0x00,0xa0,0xae,0xab,0x00,0x60,0xd5,0x57,0x01,0xa0,0xea,0xeb,0x01, - 0x60,0xf5,0x15,0x00,0xc0,0xfa,0x2a,0x00,0x80,0x75,0x15,0x00,0x00,0xfb,0x0a, - 0x00,0x00,0x56,0x15,0x00,0x00,0xaa,0x0a,0x00,0x00,0x76,0x01,0x00,0x00,0xfa, - 0x02,0x00,0x00,0x76,0x01,0x00,0x00,0xab,0x02,0x00,0x00,0x55,0x05,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/help-up.xpm --- a/etc/w3/help-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -/* XPM */ -static char *help-up[] = { -/* width height num_colors chars_per_pixel */ -" 28 28 2 1", -/* colors */ -". c #b2b2b2 s backgroundToolBarColor", -"# c #000000", -/* pixels */ -"............................", -"............................", -"............................", -"............................", -"........##########..........", -".......##.#.#.#.#.#.........", -"......##.#.#.#.#.#.#........", -".....##.#.#######.#.#.......", -".....#.#.#########.#.#......", -".....##.###########.#.......", -".....#.#.###.#.###.#.#......", -".....##.#####.#####.#.#.....", -".....#.#.###.#.###.#.#.#....", -".....##.#.#.#.#####.#.#.#...", -".....#.#.#.#.#####.#.####...", -".....##.#.#.#####.#.#.......", -"......##.#.#####.#.#.#......", -".......##.#.###.#.#.#.......", -"........##.#####.#.#........", -".........##.#.#.#.#.#.......", -".........#.#.#.#.#.#........", -".........##.###.#...........", -".........#.#####.#..........", -".........##.###.#...........", -"........##.#.#.#.#..........", -"........#.#.#.#.#.#.........", -"............................", -"............................" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/help.xbm --- a/etc/w3/help.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define help_width 32 -#define help_height 32 -static char help_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0xbe,0x79,0x00,0x00,0xc3,0xc7,0x03,0xc0,0xf1,0x1f, - 0x0e,0x60,0x8c,0x35,0x18,0x30,0x83,0xc3,0x30,0x98,0xa0,0x81,0x61,0x4c,0xd4, - 0xa3,0x43,0x26,0xfa,0x07,0x47,0x22,0xbd,0x9d,0x86,0x92,0x0e,0x30,0x8d,0x12, - 0xc7,0x23,0xca,0x8a,0x62,0x47,0x5c,0x4e,0x63,0x46,0x3a,0x8c,0x01,0x86,0x3c, - 0xfe,0x03,0xc7,0x7f,0xfe,0x83,0xc3,0x7f,0x50,0x81,0x81,0x3d,0xac,0x02,0x40, - 0x3a,0x0e,0x84,0x21,0x7c,0x12,0x84,0x21,0x4e,0x12,0x08,0x18,0x4d,0xa2,0xb0, - 0x85,0x66,0x66,0xc1,0x43,0x27,0xcc,0x8a,0xa3,0x23,0x98,0xd5,0xd5,0x31,0x30, - 0xab,0xeb,0x18,0x60,0xdc,0x37,0x0e,0xc0,0xf9,0x8f,0x03,0x00,0xe3,0xef,0x00, - 0x00,0xbe,0x39,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/home-cap-dn.xbm --- a/etc/w3/home-cap-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x63,0xff,0xff,0xff,0xab,0xfe, - 0xff,0xff,0xcb,0xfd,0xff,0xff,0x6b,0xfb,0xff,0xff,0xbb,0xf6,0xff,0xff,0xdb, - 0xed,0xff,0xff,0xed,0xdb,0xff,0xff,0xf6,0xb7,0xff,0x7f,0xf8,0x4f,0xff,0xff, - 0x3d,0xde,0xff,0xff,0xbd,0xdf,0xff,0xff,0xbd,0xdf,0xff,0xff,0xbd,0xdf,0xff, - 0xff,0xbd,0xdf,0xff,0xff,0x81,0xc1,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xdf,0xfd,0xff,0xff,0xdf,0xfd, - 0xff,0xff,0xdf,0xcd,0xe4,0xfc,0x1f,0xb4,0x5a,0xfb,0xdf,0xb5,0x5a,0xf8,0xdf, - 0xb5,0x5a,0xff,0xdf,0xcd,0xda,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/home-cap-dn.xpm --- a/etc/w3/home-cap-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *home-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkaaakkakkkkkkkkkkkkkkkk", -"kkkkkkkkkkapakapakkkkkkkkkkkkkkk", -"kkkkkkkkkkapaapmmakkkkkkkkkkkkkk", -"kkkkkkkkkkapapmammakkkkkkkkkkkkk", -"kkkkkkkkkkapmmamammakkkkkkkkkkkk", -"kkkkkkkkkkapmammmammakkkkkkkkkkk", -"kkkkkkkkkapmammmmmammakkkkkkkkkk", -"kkkkkkkkapmammmmmmmammakkkkkkkkk", -"kkkkkkkaaaammmmmmmmmaagakkkkkkkk", -"kkkkkkkkkapmmmaaapmmmaggkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjgkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkaaaaaagjaaaaagjkkkkkkkk", -"kkkkkkkkkkkgggggjkkjgggjkkkkkkkk", -"kkkkkkkkkkkjjjjjjkkjjjjjkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkk.kkk.kkkkkkkkkkkkkkkkkkkkkk", -"kkkkk.kkk.kkkkkkkkkkkkkkkkkkkkkk", -"kkkkk.kkk.kk..kk..k..kkk..kkkkkk", -"kkkkk.....k.kk.k.k.kk.k.kk.kkkkk", -"kkkkk.kkk.k.kk.k.k.kk.k....kkkkk", -"kkkkk.kkk.k.kk.k.k.kk.k.kkkkkkkk", -"kkkkk.kkk.kk..kk.k.kk.kk...kkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/home-cap-no.xbm --- a/etc/w3/home-cap-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x54,0x01, - 0x00,0x00,0x00,0x00,0x00,0x00,0x94,0x04,0x00,0x00,0x00,0x00,0x00,0x00,0x24, - 0x12,0x00,0x00,0x00,0x00,0x00,0x00,0x09,0x48,0x00,0x00,0x00,0x00,0x00,0x00, - 0xc2,0x21,0x00,0x00,0x00,0x00,0x00,0x00,0x42,0x20,0x00,0x00,0x00,0x00,0x00, - 0x00,0x42,0x20,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x20,0x02,0x00,0x00,0x00,0x00, - 0x00,0x00,0x20,0x32,0x1b,0x03,0x00,0x00,0x00,0x00,0x20,0x4a,0xa5,0x07,0x00, - 0x00,0x00,0x00,0x20,0x32,0x25,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/home-cap-no.xpm --- a/etc/w3/home-cap-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *home-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkaaakkakkkkkkkkkkkkkkkk", -"kkkkkkkkkkapakapakkkkkkkkkkkkkkk", -"kkkkkkkkkkapaapmmakkkkkkkkkkkkkk", -"kkkkkkkkkkapapmammakkkkkkkkkkkkk", -"kkkkkkkkkkapmmamammakkkkkkkkkkkk", -"kkkkkkkkkkapmammmammakkkkkkkkkkk", -"kkkkkkkkkapmammmmmammakkkkkkkkkk", -"kkkkkkkkapmammmmmmmammakkkkkkkkk", -"kkkkkkkaaaammmmmmmmmaagakkkkkkkk", -"kkkkkkkkkapmmmaaapmmmaggkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjgkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkaaaaaagjaaaaagjkkkkkkkk", -"kkkkkkkkkkkgggggjkkjgggjkkkkkkkk", -"kkkkkkkkkkkjjjjjjkkjjjjjkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkk.kkk.kkkkkkkkkkkkkkkkkkkkkk", -"kkkkk.kkk.kkkkkkkkkkkkkkkkkkkkkk", -"kkkkk.kkk.kk..kk..k..kkk..kkkkkk", -"kkkkk.....k.kk.k.k.kk.k.kk.kkkkk", -"kkkkk.kkk.k.kk.k.k.kk.k....kkkkk", -"kkkkk.kkk.k.kk.k.k.kk.k.kkkkkkkk", -"kkkkk.kkk.kk..kk.k.kk.kk...kkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/home-cap-up.xbm --- a/etc/w3/home-cap-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x9c,0x00,0x00,0x00,0x54,0x01, - 0x00,0x00,0x34,0x02,0x00,0x00,0x94,0x04,0x00,0x00,0x44,0x09,0x00,0x00,0x24, - 0x12,0x00,0x00,0x12,0x24,0x00,0x00,0x09,0x48,0x00,0x80,0x07,0xb0,0x00,0x00, - 0xc2,0x21,0x00,0x00,0x42,0x20,0x00,0x00,0x42,0x20,0x00,0x00,0x42,0x20,0x00, - 0x00,0x42,0x20,0x00,0x00,0x7e,0x3e,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x20,0x02,0x00,0x00,0x20,0x02, - 0x00,0x00,0x20,0x32,0x1b,0x03,0xe0,0x4b,0xa5,0x04,0x20,0x4a,0xa5,0x07,0x20, - 0x4a,0xa5,0x00,0x20,0x32,0x25,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/home-cap-up.xpm --- a/etc/w3/home-cap-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *home-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkaaakkakkkkkkkkkkkkkkkk", -"kkkkkkkkkkapakapakkkkkkkkkkkkkkk", -"kkkkkkkkkkapaapmmakkkkkkkkkkkkkk", -"kkkkkkkkkkapapmammakkkkkkkkkkkkk", -"kkkkkkkkkkapmmamammakkkkkkkkkkkk", -"kkkkkkkkkkapmammmammakkkkkkkkkkk", -"kkkkkkkkkapmammmmmammakkkkkkkkkk", -"kkkkkkkkapmammmmmmmammakkkkkkkkk", -"kkkkkkkaaaammmmmmmmmaagakkkkkkkk", -"kkkkkkkkkapmmmaaapmmmaggkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjgkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkaaaaaagjaaaaagjkkkkkkkk", -"kkkkkkkkkkkgggggjkkjgggjkkkkkkkk", -"kkkkkkkkkkkjjjjjjkkjjjjjkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkk.kkk.kkkkkkkkkkkkkkkkkkkkkk", -"kkkkk.kkk.kkkkkkkkkkkkkkkkkkkkkk", -"kkkkk.kkk.kk..kk..k..kkk..kkkkkk", -"kkkkk.....k.kk.k.k.kk.k.kk.kkkkk", -"kkkkk.kkk.k.kk.k.k.kk.k....kkkkk", -"kkkkk.kkk.k.kk.k.k.kk.k.kkkkkkkk", -"kkkkk.kkk.kk..kk.k.kk.kk...kkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/home-dn.xbm --- a/etc/w3/home-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x63,0xff,0xff,0xff,0xab,0xfe, - 0xff,0xff,0xcb,0xfd,0xff,0xff,0x6b,0xfb,0xff,0xff,0xbb,0xf6,0xff,0xff,0xdb, - 0xed,0xff,0xff,0xed,0xdb,0xff,0xff,0xf6,0xb7,0xff,0x7f,0xf8,0x4f,0xff,0xff, - 0x3d,0xde,0xff,0xff,0xbd,0xdf,0xff,0xff,0xbd,0xdf,0xff,0xff,0xbd,0xdf,0xff, - 0xff,0xbd,0xdf,0xff,0xff,0x81,0xc1,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/home-dn.xpm --- a/etc/w3/home-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *home-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkaaakkakkkkkkkkkkkkkkkk", -"kkkkkkkkkkapakapakkkkkkkkkkkkkkk", -"kkkkkkkkkkapaapmmakkkkkkkkkkkkkk", -"kkkkkkkkkkapapmammakkkkkkkkkkkkk", -"kkkkkkkkkkapmmamammakkkkkkkkkkkk", -"kkkkkkkkkkapmammmammakkkkkkkkkkk", -"kkkkkkkkkapmammmmmammakkkkkkkkkk", -"kkkkkkkkapmammmmmmmammakkkkkkkkk", -"kkkkkkkaaaammmmmmmmmaagakkkkkkkk", -"kkkkkkkkkapmmmaaapmmmaggkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjgkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkaaaaaagjaaaaagjkkkkkkkk", -"kkkkkkkkkkkgggggjkkjgggjkkkkkkkk", -"kkkkkkkkkkkjjjjjjkkjjjjjkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/home-no.xbm --- a/etc/w3/home-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x54,0x01, - 0x00,0x00,0x00,0x00,0x00,0x00,0x94,0x04,0x00,0x00,0x00,0x00,0x00,0x00,0x24, - 0x12,0x00,0x00,0x00,0x00,0x00,0x00,0x09,0x48,0x00,0x00,0x00,0x00,0x00,0x00, - 0xc2,0x21,0x00,0x00,0x00,0x00,0x00,0x00,0x42,0x20,0x00,0x00,0x00,0x00,0x00, - 0x00,0x42,0x20,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/home-no.xpm --- a/etc/w3/home-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *home-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkaaakkakkkkkkkkkkkkkkkk", -"kkkkkkkkkkapakapakkkkkkkkkkkkkkk", -"kkkkkkkkkkapaapmmakkkkkkkkkkkkkk", -"kkkkkkkkkkapapmammakkkkkkkkkkkkk", -"kkkkkkkkkkapmmamammakkkkkkkkkkkk", -"kkkkkkkkkkapmammmammakkkkkkkkkkk", -"kkkkkkkkkapmammmmmammakkkkkkkkkk", -"kkkkkkkkapmammmmmmmammakkkkkkkkk", -"kkkkkkkaaaammmmmmmmmaagakkkkkkkk", -"kkkkkkkkkapmmmaaapmmmaggkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjgkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkaaaaaagjaaaaagjkkkkkkkk", -"kkkkkkkkkkkgggggjkkjgggjkkkkkkkk", -"kkkkkkkkkkkjjjjjjkkjjjjjkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/home-up.xbm --- a/etc/w3/home-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x9c,0x00,0x00,0x00,0x54,0x01, - 0x00,0x00,0x34,0x02,0x00,0x00,0x94,0x04,0x00,0x00,0x44,0x09,0x00,0x00,0x24, - 0x12,0x00,0x00,0x12,0x24,0x00,0x00,0x09,0x48,0x00,0x80,0x07,0xb0,0x00,0x00, - 0xc2,0x21,0x00,0x00,0x42,0x20,0x00,0x00,0x42,0x20,0x00,0x00,0x42,0x20,0x00, - 0x00,0x42,0x20,0x00,0x00,0x7e,0x3e,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/home-up.xpm --- a/etc/w3/home-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *home-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkaaakkakkkkkkkkkkkkkkkk", -"kkkkkkkkkkapakapakkkkkkkkkkkkkkk", -"kkkkkkkkkkapaapmmakkkkkkkkkkkkkk", -"kkkkkkkkkkapapmammakkkkkkkkkkkkk", -"kkkkkkkkkkapmmamammakkkkkkkkkkkk", -"kkkkkkkkkkapmammmammakkkkkkkkkkk", -"kkkkkkkkkapmammmmmammakkkkkkkkkk", -"kkkkkkkkapmammmmmmmammakkkkkkkkk", -"kkkkkkkaaaammmmmmmmmaagakkkkkkkk", -"kkkkkkkkkapmmmaaapmmmaggkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjgkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkapmmmagjpmmmagjkkkkkkkk", -"kkkkkkkkkaaaaaagjaaaaagjkkkkkkkk", -"kkkkkkkkkkkgggggjkkjgggjkkkkkkkk", -"kkkkkkkkkkkjjjjjjkkjjjjjkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/home.xbm --- a/etc/w3/home.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -#define home_width 26 -#define home_height 18 -static char home_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x0c,0x00,0x00,0xc0,0xf3,0x0f,0x00,0xe0,0xf3,0x1f, - 0x00,0x50,0xff,0x3f,0x00,0x28,0xfe,0x7f,0x00,0x14,0xfc,0xff,0x00,0x0a,0xf8, - 0xff,0x01,0x06,0x10,0x80,0x00,0x34,0xd3,0xb6,0x00,0x34,0xd3,0xb6,0x00,0x04, - 0x10,0x80,0x00,0x04,0x10,0x80,0x00,0x34,0xd3,0xb6,0x00,0x34,0xd3,0xb6,0x00, - 0x04,0x10,0x86,0x00,0xfc,0xff,0xff,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/hotl-cap-dn.xbm --- a/etc/w3/hotl-cap-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0xff,0xff,0xff,0xff,0xff,0xef,0xf7,0xff,0xff,0x44,0x22,0xff,0x7f,0x00,0x00, - 0xfe,0xbf,0x01,0x00,0xfc,0x5f,0x01,0x00,0xf8,0xef,0x88,0x44,0xf2,0xe7,0x9d, - 0x4c,0xe6,0x07,0xbe,0xdd,0xee,0x0f,0xdf,0x6e,0xf7,0x9f,0xef,0xf7,0xfb,0x3f, - 0x77,0xbb,0xfd,0x7f,0x32,0x99,0xfe,0xff,0x44,0x22,0xff,0xff,0xef,0xf7,0xff, - 0xff,0xff,0x01,0xc0,0x0f,0x00,0x00,0xe0,0xff,0x57,0xdf,0xff,0xff,0x55,0xdf, - 0xff,0xff,0xd5,0xdf,0xff,0xff,0xb3,0xc5,0xff,0xff,0x77,0x13,0xff,0xff,0x9f, - 0x5f,0xff,0xff,0x7f,0x3f,0xff,0xff,0xff,0x7c,0xff,0xff,0xff,0xfb,0xff,0xff, - 0xff,0xfb,0xff,0xff,0xff,0x01,0xff,0xff,0xff,0x01,0xff,0xff,0xff,0xff,0xff}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/hotl-cap-dn.xpm --- a/etc/w3/hotl-cap-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *hotl-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #b2b2b2 s backgroundToolBarColor", -"# c #0000ef", -"a c #000044", -"b c #444444", -"c c #0000ab", -"d c #aaaaaa", -"e c #ffffff", -"f c #bbbbbb", -"g c #888888", -"h c #000000", -"i c #dddddd", -"j c #555555", -"k c #222222", -"l c #111111", -"m c #9a6633", -"n c #cc9966", -"o c #ffcc66", -"p c #663300", -/* pixels */ -"................................", -"............#......#............", -"........#a.##a.#a.##a.#a........", -".......b##ac##ac#ac##ac#a.......", -"......bdd##ac##a##ac##a##a......", -".....bdcd###ac##c##ac##c##a.....", -"....bdddc##e#acfacf#acfacf#a....", -"...##dddd#eee#ag#agf#ag#agf#a...", -"...a#####eeeeeagfagffagfagffa...", -"....a###eeeeeagfagffagfagffa....", -".....a#eeeeeagffgffagffgffa.....", -"......a#eeeagffaffagffaffa......", -".......a#eacffacfacffacfa.......", -"........aa.h#a.ha.h#a.ha........", -"............a......a............", -"...giiifffddddgggjjjjjbbkkkllh..", -"....hhhhhhhhhhhhhhhhhhhhhhhhh...", -".........nomomom.....mo.........", -".........momomom.....mo.........", -".........pnmomoo.....mo.........", -"..........mmoomoom.mmmo.........", -"...........pnoomoommommm........", -".............pmnooooopnm........", -"...............pnnoooomm........", -"................pmnoooom........", -"..................mnooo.........", -"..................pnooo.........", -".................bkllhhh........", -".................bkllhhh........", -"................................" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/hotl-cap-no.xbm --- a/etc/w3/hotl-cap-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x10,0x08,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff, - 0x01,0x00,0x00,0x00,0x00,0xa0,0xfe,0xff,0x07,0x00,0x00,0x00,0x00,0x18,0x62, - 0xb3,0x19,0x00,0x00,0x00,0x00,0xf0,0x20,0x91,0x08,0x00,0x00,0x00,0x00,0xc0, - 0x88,0x44,0x02,0x00,0x00,0x00,0x00,0x00,0xbb,0xdd,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0xfe,0x3f,0x00,0x00,0x00,0x00,0x00,0xa8,0x20,0x00,0x00,0x00,0x00, - 0x00,0x00,0x2a,0x20,0x00,0x00,0x00,0x00,0x00,0x00,0x88,0xec,0x00,0x00,0x00, - 0x00,0x00,0x00,0x80,0xc0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x04,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0xfe,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/hotl-cap-no.xpm --- a/etc/w3/hotl-cap-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *hotl-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #b2b2b2 s backgroundToolBarColor", -"# c #0000ef", -"a c #000044", -"b c #444444", -"c c #0000ab", -"d c #aaaaaa", -"e c #ffffff", -"f c #bbbbbb", -"g c #888888", -"h c #000000", -"i c #dddddd", -"j c #555555", -"k c #222222", -"l c #111111", -"m c #9a6633", -"n c #cc9966", -"o c #ffcc66", -"p c #663300", -/* pixels */ -"................................", -"............#......#............", -"........#a.##a.#a.##a.#a........", -".......b##ac##ac#ac##ac#a.......", -"......bdd##ac##a##ac##a##a......", -".....bdcd###ac##c##ac##c##a.....", -"....bdddc##e#acfacf#acfacf#a....", -"...##dddd#eee#ag#agf#ag#agf#a...", -"...a#####eeeeeagfagffagfagffa...", -"....a###eeeeeagfagffagfagffa....", -".....a#eeeeeagffgffagffgffa.....", -"......a#eeeagffaffagffaffa......", -".......a#eacffacfacffacfa.......", -"........aa.h#a.ha.h#a.ha........", -"............a......a............", -"...giiifffddddgggjjjjjbbkkkllh..", -"....hhhhhhhhhhhhhhhhhhhhhhhhh...", -".........nomomom.....mo.........", -".........momomom.....mo.........", -".........pnmomoo.....mo.........", -"..........mmoomoom.mmmo.........", -"...........pnoomoommommm........", -".............pmnooooopnm........", -"...............pnnoooomm........", -"................pmnoooom........", -"..................mnooo.........", -"..................pnooo.........", -".................bkllhhh........", -".................bkllhhh........", -"................................" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/hotl-cap-up.xbm --- a/etc/w3/hotl-cap-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x10,0x08,0x00,0x00,0xbb,0xdd,0x00,0x80,0xff,0xff, - 0x01,0x40,0xfe,0xff,0x03,0xa0,0xfe,0xff,0x07,0x10,0x77,0xbb,0x0d,0x18,0x62, - 0xb3,0x19,0xf8,0x41,0x22,0x11,0xf0,0x20,0x91,0x08,0x60,0x10,0x08,0x04,0xc0, - 0x88,0x44,0x02,0x80,0xcd,0x66,0x01,0x00,0xbb,0xdd,0x00,0x00,0x10,0x08,0x00, - 0x00,0x00,0xfe,0x3f,0xf0,0xff,0xff,0x1f,0x00,0xa8,0x20,0x00,0x00,0xaa,0x20, - 0x00,0x00,0x2a,0x20,0x00,0x00,0x4c,0x3a,0x00,0x00,0x88,0xec,0x00,0x00,0x60, - 0xa0,0x00,0x00,0x80,0xc0,0x00,0x00,0x00,0x83,0x00,0x00,0x00,0x04,0x00,0x00, - 0x00,0x04,0x00,0x00,0x00,0xfe,0x00,0x00,0x00,0xfe,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/hotl-cap-up.xpm --- a/etc/w3/hotl-cap-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *hotl-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #b2b2b2 s backgroundToolBarColor", -"# c #0000ef", -"a c #000044", -"b c #444444", -"c c #0000ab", -"d c #aaaaaa", -"e c #ffffff", -"f c #bbbbbb", -"g c #888888", -"h c #000000", -"i c #dddddd", -"j c #555555", -"k c #222222", -"l c #111111", -"m c #9a6633", -"n c #cc9966", -"o c #ffcc66", -"p c #663300", -/* pixels */ -"................................", -"............#......#............", -"........#a.##a.#a.##a.#a........", -".......b##ac##ac#ac##ac#a.......", -"......bdd##ac##a##ac##a##a......", -".....bdcd###ac##c##ac##c##a.....", -"....bdddc##e#acfacf#acfacf#a....", -"...##dddd#eee#ag#agf#ag#agf#a...", -"...a#####eeeeeagfagffagfagffa...", -"....a###eeeeeagfagffagfagffa....", -".....a#eeeeeagffgffagffgffa.....", -"......a#eeeagffaffagffaffa......", -".......a#eacffacfacffacfa.......", -"........aa.h#a.ha.h#a.ha........", -"............a......a............", -"...giiifffddddgggjjjjjbbkkkllh..", -"....hhhhhhhhhhhhhhhhhhhhhhhhh...", -".........nomomom.....mo.........", -".........momomom.....mo.........", -".........pnmomoo.....mo.........", -"..........mmoomoom.mmmo.........", -"...........pnoomoommommm........", -".............pmnooooopnm........", -"...............pnnoooomm........", -"................pmnoooom........", -"..................mnooo.........", -"..................pnooo.........", -".................bkllhhh........", -".................bkllhhh........", -"................................" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/hotl-dn.xbm --- a/etc/w3/hotl-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0xff,0xff,0xff,0xff,0xff,0xef,0xf7,0xff,0xff,0x44,0x22,0xff,0x7f,0x00,0x00, - 0xfe,0xbf,0x01,0x00,0xfc,0x5f,0x01,0x00,0xf8,0xef,0x88,0x44,0xf2,0xe7,0x9d, - 0x4c,0xe6,0x07,0xbe,0xdd,0xee,0x0f,0xdf,0x6e,0xf7,0x9f,0xef,0xf7,0xfb,0x3f, - 0x77,0xbb,0xfd,0x7f,0x32,0x99,0xfe,0xff,0x44,0x22,0xff,0xff,0xef,0xf7,0xff, - 0xff,0xff,0x01,0xc0,0x0f,0x00,0x00,0xe0,0xff,0x57,0xdf,0xff,0xff,0x55,0xdf, - 0xff,0xff,0xd5,0xdf,0xff,0xff,0xb3,0xc5,0xff,0xff,0x77,0x13,0xff,0xff,0x9f, - 0x5f,0xff,0xff,0x7f,0x3f,0xff,0xff,0xff,0x7c,0xff,0xff,0xff,0xfb,0xff,0xff, - 0xff,0xfb,0xff,0xff,0xff,0x01,0xff,0xff,0xff,0x01,0xff,0xff,0xff,0xff,0xff}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/hotl-dn.xpm --- a/etc/w3/hotl-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *hotl-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #b2b2b2 s backgroundToolBarColor", -"# c #0000ef", -"a c #000044", -"b c #444444", -"c c #0000ab", -"d c #aaaaaa", -"e c #ffffff", -"f c #bbbbbb", -"g c #888888", -"h c #000000", -"i c #dddddd", -"j c #555555", -"k c #222222", -"l c #111111", -"m c #9a6633", -"n c #cc9966", -"o c #ffcc66", -"p c #663300", -/* pixels */ -"................................", -"............#......#............", -"........#a.##a.#a.##a.#a........", -".......b##ac##ac#ac##ac#a.......", -"......bdd##ac##a##ac##a##a......", -".....bdcd###ac##c##ac##c##a.....", -"....bdddc##e#acfacf#acfacf#a....", -"...##dddd#eee#ag#agf#ag#agf#a...", -"...a#####eeeeeagfagffagfagffa...", -"....a###eeeeeagfagffagfagffa....", -".....a#eeeeeagffgffagffgffa.....", -"......a#eeeagffaffagffaffa......", -".......a#eacffacfacffacfa.......", -"........aa.h#a.ha.h#a.ha........", -"............a......a............", -"...giiifffddddgggjjjjjbbkkkllh..", -"....hhhhhhhhhhhhhhhhhhhhhhhhh...", -".........nomomom.....mo.........", -".........momomom.....mo.........", -".........pnmomoo.....mo.........", -"..........mmoomoom.mmmo.........", -"...........pnoomoommommm........", -".............pmnooooopnm........", -"...............pnnoooomm........", -"................pmnoooom........", -"..................mnooo.........", -"..................pnooo.........", -".................bkllhhh........", -".................bkllhhh........", -"................................" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/hotl-no.xbm --- a/etc/w3/hotl-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x10,0x08,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff, - 0x01,0x00,0x00,0x00,0x00,0xa0,0xfe,0xff,0x07,0x00,0x00,0x00,0x00,0x18,0x62, - 0xb3,0x19,0x00,0x00,0x00,0x00,0xf0,0x20,0x91,0x08,0x00,0x00,0x00,0x00,0xc0, - 0x88,0x44,0x02,0x00,0x00,0x00,0x00,0x00,0xbb,0xdd,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0xfe,0x3f,0x00,0x00,0x00,0x00,0x00,0xa8,0x20,0x00,0x00,0x00,0x00, - 0x00,0x00,0x2a,0x20,0x00,0x00,0x00,0x00,0x00,0x00,0x88,0xec,0x00,0x00,0x00, - 0x00,0x00,0x00,0x80,0xc0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x04,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0xfe,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/hotl-no.xpm --- a/etc/w3/hotl-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *hotl-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #b2b2b2 s backgroundToolBarColor", -"# c #0000ef", -"a c #000044", -"b c #444444", -"c c #0000ab", -"d c #aaaaaa", -"e c #ffffff", -"f c #bbbbbb", -"g c #888888", -"h c #000000", -"i c #dddddd", -"j c #555555", -"k c #222222", -"l c #111111", -"m c #9a6633", -"n c #cc9966", -"o c #ffcc66", -"p c #663300", -/* pixels */ -"................................", -"............#......#............", -"........#a.##a.#a.##a.#a........", -".......b##ac##ac#ac##ac#a.......", -"......bdd##ac##a##ac##a##a......", -".....bdcd###ac##c##ac##c##a.....", -"....bdddc##e#acfacf#acfacf#a....", -"...##dddd#eee#ag#agf#ag#agf#a...", -"...a#####eeeeeagfagffagfagffa...", -"....a###eeeeeagfagffagfagffa....", -".....a#eeeeeagffgffagffgffa.....", -"......a#eeeagffaffagffaffa......", -".......a#eacffacfacffacfa.......", -"........aa.h#a.ha.h#a.ha........", -"............a......a............", -"...giiifffddddgggjjjjjbbkkkllh..", -"....hhhhhhhhhhhhhhhhhhhhhhhhh...", -".........nomomom.....mo.........", -".........momomom.....mo.........", -".........pnmomoo.....mo.........", -"..........mmoomoom.mmmo.........", -"...........pnoomoommommm........", -".............pmnooooopnm........", -"...............pnnoooomm........", -"................pmnoooom........", -"..................mnooo.........", -"..................pnooo.........", -".................bkllhhh........", -".................bkllhhh........", -"................................" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/hotl-up.xbm --- a/etc/w3/hotl-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x10,0x08,0x00,0x00,0xbb,0xdd,0x00,0x80,0xff,0xff, - 0x01,0x40,0xfe,0xff,0x03,0xa0,0xfe,0xff,0x07,0x10,0x77,0xbb,0x0d,0x18,0x62, - 0xb3,0x19,0xf8,0x41,0x22,0x11,0xf0,0x20,0x91,0x08,0x60,0x10,0x08,0x04,0xc0, - 0x88,0x44,0x02,0x80,0xcd,0x66,0x01,0x00,0xbb,0xdd,0x00,0x00,0x10,0x08,0x00, - 0x00,0x00,0xfe,0x3f,0xf0,0xff,0xff,0x1f,0x00,0xa8,0x20,0x00,0x00,0xaa,0x20, - 0x00,0x00,0x2a,0x20,0x00,0x00,0x4c,0x3a,0x00,0x00,0x88,0xec,0x00,0x00,0x60, - 0xa0,0x00,0x00,0x80,0xc0,0x00,0x00,0x00,0x83,0x00,0x00,0x00,0x04,0x00,0x00, - 0x00,0x04,0x00,0x00,0x00,0xfe,0x00,0x00,0x00,0xfe,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/hotl-up.xpm --- a/etc/w3/hotl-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *hotl-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #b2b2b2 s backgroundToolBarColor", -"# c #0000ef", -"a c #000044", -"b c #444444", -"c c #0000ab", -"d c #aaaaaa", -"e c #ffffff", -"f c #bbbbbb", -"g c #888888", -"h c #000000", -"i c #dddddd", -"j c #555555", -"k c #222222", -"l c #111111", -"m c #9a6633", -"n c #cc9966", -"o c #ffcc66", -"p c #663300", -/* pixels */ -"................................", -"............#......#............", -"........#a.##a.#a.##a.#a........", -".......b##ac##ac#ac##ac#a.......", -"......bdd##ac##a##ac##a##a......", -".....bdcd###ac##c##ac##c##a.....", -"....bdddc##e#acfacf#acfacf#a....", -"...##dddd#eee#ag#agf#ag#agf#a...", -"...a#####eeeeeagfagffagfagffa...", -"....a###eeeeeagfagffagfagffa....", -".....a#eeeeeagffgffagffgffa.....", -"......a#eeeagffaffagffaffa......", -".......a#eacffacfacffacfa.......", -"........aa.h#a.ha.h#a.ha........", -"............a......a............", -"...giiifffddddgggjjjjjbbkkkllh..", -"....hhhhhhhhhhhhhhhhhhhhhhhhh...", -".........nomomom.....mo.........", -".........momomom.....mo.........", -".........pnmomoo.....mo.........", -"..........mmoomoom.mmmo.........", -"...........pnoomoommommm........", -".............pmnooooopnm........", -"...............pnnoooomm........", -"................pmnoooom........", -"..................mnooo.........", -"..................pnooo.........", -".................bkllhhh........", -".................bkllhhh........", -"................................" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/imag-cap-dn.xbm --- a/etc/w3/imag-cap-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0xff,0xfd,0xff,0xff,0xff,0xfa,0xff,0xff,0x7f,0x77,0xff,0xff,0xbf,0x2f,0xe1, - 0xff,0x7f,0x5f,0xdf,0xff,0xff,0x7e,0xbf,0xff,0xff,0x7d,0x73,0xff,0xff,0x7b, - 0x03,0xff,0xff,0x7d,0x63,0xff,0xff,0x00,0x7f,0xff,0xff,0xfb,0x7f,0xff,0xff, - 0xbb,0x63,0xff,0xff,0xbb,0x63,0xff,0xff,0x1b,0x63,0xff,0xff,0xfb,0x7f,0xff, - 0xff,0xfb,0x7f,0xff,0xff,0x03,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xfb,0xff,0xff,0xff,0xfb,0xff,0xff,0xff,0x4b,0xce, - 0x31,0xc7,0xab,0xb5,0xd6,0xfa,0xab,0x8d,0x16,0xe6,0xab,0xb5,0xd6,0xdf,0xab, - 0x4d,0x31,0xe2,0xff,0xff,0xf6,0xff,0xff,0xff,0xf9,0xff,0xff,0xff,0xff,0xff}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/imag-cap-dn.xpm --- a/etc/w3/imag-cap-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,52 +0,0 @@ -/* XPM */ -static char *imag-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 15 1", -/* colors */ -". c #000000", -"# c #0000dd", -"a c #00bb00", -"b c #330099", -"c c #336666", -"d c #555555", -"e c #6666cc", -"f c #888888", -"g c #990066", -"h c #aaaaaa", -"i c #b2b2b2 s backgroundToolBarColor", -"j c #cccccc", -"k c #eeeeee", -"l c #ff66cc", -"m c #ffffff", -/* pixels */ -"iiiiiiiiibiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiibmbiiiiiiiiiiiiiiiiiiiii", -"iiiiiiibmkjbiiibiiiiiiiiiiiiiiii", -"iiiiiibmkjjjbibbibbbbhiiiiiiiiii", -"iiiiiiibmkjjjbmbimjhmbhiiiiiiiii", -"iiiiiiifbmkjjjjbhjmjmmbhiiiiiiii", -"iiiiiiihfbmkjjjbhmaammmbiiiiiiii", -"iiiiiiiihfbmkjjbhjaacbdbhiiiiiii", -"iiiiiiiiibmkjjjbhmaaaffbhiiiiiii", -"iiiiiiiibbbbbbbbhjmjmjmbhiiiiiii", -"iiiiiiiiii.hhhfhhmjmjmjbhiiiiiii", -"iiiiiiiiifbjmjgjmj#e#jmbhiiiiiii", -"iiiiiiiihhbmjfgfjme#emjbhiiiiiii", -"iiiiiiiiiibjlggglj#e#jmbhiiiiiii", -"iiiiiiiiiibmjmjmjmjmjmjbhiiiiiii", -"iiiiiiiiiibjmjmjmjmjmjmbhiiiiiii", -"iiiiiiiiiibbbbbbbbbbbbbbhiiiiiii", -"iiiiiiiiiiiiihhhhhhhhhhhhiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"ii.iiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"ii.iiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"ii.i..i..iii..iii...ii..iii...ii", -"ii.i.i.ii.i.ii.i.ii.i.ii.i.iiiii", -"ii.i.i.ii.ii...i.ii.i....ii..iii", -"ii.i.i.ii.i.ii.i.ii.i.iiiiiii.ii", -"ii.i.i.ii.ii..i.i...ii...i...iii", -"iiiiiiiiiiiiiiii.ii.iiiiiiiiiiii", -"iiiiiiiiiiiiiiiii..iiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/imag-cap-no.xbm --- a/etc/w3/imag-cap-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/imag-cap-no.xpm --- a/etc/w3/imag-cap-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *imag-no[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkgkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkgmgkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkgmpmgkkkgkkkkkkkkkkkkkkkkk", -"kkkkkgmpmmmgkggpggggkkkkkkkkkkkk", -"kkkkkkgmmmmmgmgpmpppgkkkkkkkkkkk", -"kkkkkkggmmmmmpggmmmmmgkkkkkkkkkk", -"kkkkkkkggmmmmmggpggmmmgkkkkkkkkk", -"kkkkkkkkggmmmmggpggggggpkkkkkkkk", -"kkkkkkkkgppmmmggpggggggpkkkkkkkk", -"kkkkkkkgggggggggpmppppgpkkkkkkkk", -"kkkkkkkkggggggggpmmmmmgpkkkkkkkk", -"kkkkkkkkggpppgpppgggmmgpkkkkkkkk", -"kkkkkkkkkgpmgggmmgggpmgpkkkkkkkk", -"kkkkkkkkkgpmgggpmgggpmgpkkkkkkkk", -"kkkkkkkkkgpmmpppmmpppmgpkkkkkkkk", -"kkkkkkkkkgpmmmmmmmmmmmgpkkkkkkkk", -"kkkkkkkkkggggggggggggggpkkkkkkkk", -"kkkkkkkkkkppppppppppppppkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kgkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kgpkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kgpggkggkkkggkkkgggkkggkkkgggkkk", -"kgpgpgmpgkgmpgkgmpgpgmpgkgmpppkk", -"kgpgpgpkgpmgggpgpmgpggggpmggkkkk", -"kgpgpgpkgpgmpgpgpmgpgppppmmpgkkk", -"kgpgpgpkgpkggmgmgggpkgggmgggmpkk", -"kkpkpkpkkpkkppkgmpgpkkpppkpppkkk", -"kkkkkkkkkkkkkkkkggmpkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkppkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/imag-cap-up.xbm --- a/etc/w3/imag-cap-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x02,0x00,0x00,0x00,0x05,0x00,0x00,0x80,0x88,0x00,0x00,0x40,0xd0,0x1e, - 0x00,0x80,0xa0,0x20,0x00,0x00,0x81,0x40,0x00,0x00,0x82,0x8c,0x00,0x00,0x84, - 0xfc,0x00,0x00,0x82,0x9c,0x00,0x00,0xff,0x80,0x00,0x00,0x04,0x80,0x00,0x00, - 0x44,0x9c,0x00,0x00,0x44,0x9c,0x00,0x00,0xe4,0x9c,0x00,0x00,0x04,0x80,0x00, - 0x00,0x04,0x80,0x00,0x00,0xfc,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x04,0x00,0x00,0x00,0x04,0x00,0x00,0x00,0xb4,0x31, - 0xce,0x38,0x54,0x4a,0x29,0x05,0x54,0x72,0xe9,0x19,0x54,0x4a,0x29,0x20,0x54, - 0xb2,0xce,0x1d,0x00,0x00,0x09,0x00,0x00,0x00,0x06,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/imag-cap-up.xpm --- a/etc/w3/imag-cap-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,52 +0,0 @@ -/* XPM */ -static char *imag-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 15 1", -/* colors */ -". c #000000", -"# c #0000dd", -"a c #00bb00", -"b c #330099", -"c c #336666", -"d c #555555", -"e c #6666cc", -"f c #888888", -"g c #990066", -"h c #aaaaaa", -"i c #b2b2b2 s backgroundToolBarColor", -"j c #cccccc", -"k c #eeeeee", -"l c #ff66cc", -"m c #ffffff", -/* pixels */ -"iiiiiiiiibiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiibmbiiiiiiiiiiiiiiiiiiiii", -"iiiiiiibmkjbiiibiiiiiiiiiiiiiiii", -"iiiiiibmkjjjbibbibbbbhiiiiiiiiii", -"iiiiiiibmkjjjbmbimjhmbhiiiiiiiii", -"iiiiiiifbmkjjjjbhjmjmmbhiiiiiiii", -"iiiiiiihfbmkjjjbhmaammmbiiiiiiii", -"iiiiiiiihfbmkjjbhjaacbdbhiiiiiii", -"iiiiiiiiibmkjjjbhmaaaffbhiiiiiii", -"iiiiiiiibbbbbbbbhjmjmjmbhiiiiiii", -"iiiiiiiiii.hhhfhhmjmjmjbhiiiiiii", -"iiiiiiiiifbjmjgjmj#e#jmbhiiiiiii", -"iiiiiiiihhbmjfgfjme#emjbhiiiiiii", -"iiiiiiiiiibjlggglj#e#jmbhiiiiiii", -"iiiiiiiiiibmjmjmjmjmjmjbhiiiiiii", -"iiiiiiiiiibjmjmjmjmjmjmbhiiiiiii", -"iiiiiiiiiibbbbbbbbbbbbbbhiiiiiii", -"iiiiiiiiiiiiihhhhhhhhhhhhiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"ii.iiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"ii.iiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"ii.i..i..iii..iii...ii..iii...ii", -"ii.i.i.ii.i.ii.i.ii.i.ii.i.iiiii", -"ii.i.i.ii.ii...i.ii.i....ii..iii", -"ii.i.i.ii.i.ii.i.ii.i.iiiiiii.ii", -"ii.i.i.ii.ii..i.i...ii...i...iii", -"iiiiiiiiiiiiiiii.ii.iiiiiiiiiiii", -"iiiiiiiiiiiiiiiii..iiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/imag-dn.xbm --- a/etc/w3/imag-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0xff,0xfd,0xff,0xff,0xff,0xfa,0xff,0xff,0x7f,0x77,0xff,0xff,0xbf,0x2f,0xe1, - 0xff,0x7f,0x5f,0xdf,0xff,0xff,0x7e,0xbf,0xff,0xff,0x7d,0x73,0xff,0xff,0x7b, - 0x03,0xff,0xff,0x7d,0x63,0xff,0xff,0x00,0x7f,0xff,0xff,0xfb,0x7f,0xff,0xff, - 0xbb,0x63,0xff,0xff,0xbb,0x63,0xff,0xff,0x1b,0x63,0xff,0xff,0xfb,0x7f,0xff, - 0xff,0xfb,0x7f,0xff,0xff,0x03,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/imag-dn.xpm --- a/etc/w3/imag-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,52 +0,0 @@ -/* XPM */ -static char *imag-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 15 1", -/* colors */ -". c #000000", -"# c #0000dd", -"a c #00bb00", -"b c #330099", -"c c #336666", -"d c #555555", -"e c #6666cc", -"f c #888888", -"g c #990066", -"h c #aaaaaa", -"i c #b2b2b2 s backgroundToolBarColor", -"j c #cccccc", -"k c #eeeeee", -"l c #ff66cc", -"m c #ffffff", -/* pixels */ -"iiiiiiiiibiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiibmbiiiiiiiiiiiiiiiiiiiii", -"iiiiiiibmkjbiiibiiiiiiiiiiiiiiii", -"iiiiiibmkjjjbibbibbbbhiiiiiiiiii", -"iiiiiiibmkjjjbmbimjhmbhiiiiiiiii", -"iiiiiiifbmkjjjjbhjmjmmbhiiiiiiii", -"iiiiiiihfbmkjjjbhmaammmbiiiiiiii", -"iiiiiiiihfbmkjjbhjaacbdbhiiiiiii", -"iiiiiiiiibmkjjjbhmaaaffbhiiiiiii", -"iiiiiiiibbbbbbbbhjmjmjmbhiiiiiii", -"iiiiiiiiii.hhhfhhmjmjmjbhiiiiiii", -"iiiiiiiiifbjmjgjmj#e#jmbhiiiiiii", -"iiiiiiiihhbmjfgfjme#emjbhiiiiiii", -"iiiiiiiiiibjlggglj#e#jmbhiiiiiii", -"iiiiiiiiiibmjmjmjmjmjmjbhiiiiiii", -"iiiiiiiiiibjmjmjmjmjmjmbhiiiiiii", -"iiiiiiiiiibbbbbbbbbbbbbbhiiiiiii", -"iiiiiiiiiiiiihhhhhhhhhhhhiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/imag-no.xbm --- a/etc/w3/imag-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/imag-no.xpm --- a/etc/w3/imag-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *imag-no[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkgkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkgmgkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkgmpmgkkkgkkkkkkkkkkkkkkkkk", -"kkkkkgmpmmmgkggpggggkkkkkkkkkkkk", -"kkkkkkgmmmmmgmgpmpppgkkkkkkkkkkk", -"kkkkkkggmmmmmpggmmmmmgkkkkkkkkkk", -"kkkkkkkggmmmmmggpggmmmgkkkkkkkkk", -"kkkkkkkkggmmmmggpggggggpkkkkkkkk", -"kkkkkkkkgppmmmggpggggggpkkkkkkkk", -"kkkkkkkgggggggggpmppppgpkkkkkkkk", -"kkkkkkkkggggggggpmmmmmgpkkkkkkkk", -"kkkkkkkkggpppgpppgggmmgpkkkkkkkk", -"kkkkkkkkkgpmgggmmgggpmgpkkkkkkkk", -"kkkkkkkkkgpmgggpmgggpmgpkkkkkkkk", -"kkkkkkkkkgpmmpppmmpppmgpkkkkkkkk", -"kkkkkkkkkgpmmmmmmmmmmmgpkkkkkkkk", -"kkkkkkkkkggggggggggggggpkkkkkkkk", -"kkkkkkkkkkppppppppppppppkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/imag-up.xbm --- a/etc/w3/imag-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x02,0x00,0x00,0x00,0x05,0x00,0x00,0x80,0x88,0x00,0x00,0x40,0xd0,0x1e, - 0x00,0x80,0xa0,0x20,0x00,0x00,0x81,0x40,0x00,0x00,0x82,0x8c,0x00,0x00,0x84, - 0xfc,0x00,0x00,0x82,0x9c,0x00,0x00,0xff,0x80,0x00,0x00,0x04,0x80,0x00,0x00, - 0x44,0x9c,0x00,0x00,0x44,0x9c,0x00,0x00,0xe4,0x9c,0x00,0x00,0x04,0x80,0x00, - 0x00,0x04,0x80,0x00,0x00,0xfc,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/imag-up.xpm --- a/etc/w3/imag-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,52 +0,0 @@ -/* XPM */ -static char *imag-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 15 1", -/* colors */ -". c #000000", -"# c #0000dd", -"a c #00bb00", -"b c #330099", -"c c #336666", -"d c #555555", -"e c #6666cc", -"f c #888888", -"g c #990066", -"h c #aaaaaa", -"i c #b2b2b2 s backgroundToolBarColor", -"j c #cccccc", -"k c #eeeeee", -"l c #ff66cc", -"m c #ffffff", -/* pixels */ -"iiiiiiiiibiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiibmbiiiiiiiiiiiiiiiiiiiii", -"iiiiiiibmkjbiiibiiiiiiiiiiiiiiii", -"iiiiiibmkjjjbibbibbbbhiiiiiiiiii", -"iiiiiiibmkjjjbmbimjhmbhiiiiiiiii", -"iiiiiiifbmkjjjjbhjmjmmbhiiiiiiii", -"iiiiiiihfbmkjjjbhmaammmbiiiiiiii", -"iiiiiiiihfbmkjjbhjaacbdbhiiiiiii", -"iiiiiiiiibmkjjjbhmaaaffbhiiiiiii", -"iiiiiiiibbbbbbbbhjmjmjmbhiiiiiii", -"iiiiiiiiii.hhhfhhmjmjmjbhiiiiiii", -"iiiiiiiiifbjmjgjmj#e#jmbhiiiiiii", -"iiiiiiiihhbmjfgfjme#emjbhiiiiiii", -"iiiiiiiiiibjlggglj#e#jmbhiiiiiii", -"iiiiiiiiiibmjmjmjmjmjmjbhiiiiiii", -"iiiiiiiiiibjmjmjmjmjmjmbhiiiiiii", -"iiiiiiiiiibbbbbbbbbbbbbbhiiiiiii", -"iiiiiiiiiiiiihhhhhhhhhhhhiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii", -"iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/image.xbm --- a/etc/w3/image.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -#define image_width 20 -#define image_height 23 -static char image_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0x07,0x01,0x00,0x0c,0x01,0x1c,0x0c, - 0x01,0x22,0x0c,0x01,0x26,0x0c,0x01,0x29,0x0c,0x01,0x19,0x0c,0x81,0x10,0x0c, - 0x81,0x0c,0x0c,0x41,0x08,0x0c,0x41,0x06,0x0c,0xc1,0x04,0x0c,0xc1,0x03,0x0c, - 0xc1,0x01,0x0c,0xc1,0x00,0x0c,0x41,0x00,0x0c,0x01,0x00,0x0c,0xff,0xff,0x0f, - 0xfe,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/index.xbm --- a/etc/w3/index.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -#define index_width 20 -#define index_height 23 -static char index_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0x07,0x01,0x00,0x0c,0x81,0x0f,0x0c, - 0x41,0x18,0x0c,0x21,0x33,0x0c,0xa1,0x25,0x0c,0xc1,0x24,0x0c,0x01,0x32,0x0c, - 0x01,0x19,0x0c,0x81,0x0c,0x0c,0x81,0x06,0x0c,0x01,0x07,0x0c,0x01,0x07,0x0c, - 0x81,0x0c,0x0c,0x81,0x0e,0x0c,0x01,0x07,0x0c,0x01,0x00,0x0c,0xff,0xff,0x0f, - 0xfe,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/info.xbm --- a/etc/w3/info.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define info_width 32 -#define info_height 32 -static char info_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xe0, 0x07, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0x7c, 0x3e, 0x00, - 0x00, 0x3e, 0x7c, 0x00, 0x00, 0x3f, 0xfc, 0x00, 0x00, 0x7f, 0xfe, 0x00, - 0x80, 0xff, 0xff, 0x01, 0x80, 0x1f, 0xfc, 0x01, 0x80, 0x3f, 0xfc, 0x01, - 0x80, 0x3f, 0xfc, 0x01, 0x80, 0x3f, 0xfc, 0x01, 0x80, 0x3f, 0xfc, 0x01, - 0x00, 0x3f, 0xfc, 0x00, 0x00, 0x1f, 0xf8, 0x00, 0x00, 0xfe, 0x7f, 0x00, - 0x00, 0xfc, 0x3f, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0xe0, 0x07, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/keyboard.xbm --- a/etc/w3/keyboard.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define keyboard_width 32 -#define keyboard_height 32 -static char keyboard_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x04,0x00,0x00,0x00,0x0a,0x00,0x00,0x00,0x0c,0x00,0x00,0x00,0x10,0xa0,0xaa, - 0xaa,0x12,0x50,0x55,0x55,0x0d,0x08,0x00,0x00,0x00,0x08,0x00,0x00,0x00,0xfe, - 0xff,0xff,0x3f,0x01,0x00,0x00,0x40,0xfd,0xf7,0xdf,0x5f,0x55,0x55,0x55,0x55, - 0xfd,0xf7,0xdf,0x5f,0x01,0x00,0x00,0x40,0xfd,0xff,0x7f,0x5f,0x55,0x55,0x45, - 0x55,0xfd,0xff,0x7f,0x5f,0xa5,0xaa,0x4a,0x55,0xfd,0xff,0x7f,0x5f,0x55,0x55, - 0x55,0x55,0xfd,0xff,0x7f,0x5f,0x45,0x00,0x44,0x51,0xfd,0xff,0x7f,0x5f,0x01, - 0x00,0x00,0x40,0xfe,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/mail.in.xbm --- a/etc/w3/mail.in.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define mail_in_tray.bm_width 32 -#define mail_in_tray.bm_height 32 -static char mail_in_tray.bm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, - 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, - 0x00, 0x80, 0x01, 0x00, 0x00, 0x82, 0x41, 0x00, 0x00, 0x86, 0x61, 0x00, - 0x00, 0x8e, 0x71, 0x00, 0x00, 0x9c, 0x39, 0x00, 0x00, 0xb8, 0x1d, 0x00, - 0x00, 0xf0, 0x0f, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xc0, 0x03, 0x00, - 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7c, 0x00, 0x00, 0x3e, - 0x84, 0x00, 0x00, 0x21, 0x04, 0xff, 0xff, 0x20, 0x04, 0x00, 0x00, 0x20, - 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, - 0xfc, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/mail.out.xbm --- a/etc/w3/mail.out.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define mail_out_tray.bm_width 32 -#define mail_out_tray.bm_height 32 -static char mail_out_tray.bm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00, - 0x00, 0xe0, 0x07, 0x00, 0x00, 0xf0, 0x0f, 0x00, 0x00, 0xb8, 0x1d, 0x00, - 0x00, 0x9c, 0x39, 0x00, 0x00, 0x8e, 0x71, 0x00, 0x00, 0x86, 0x61, 0x00, - 0x00, 0x82, 0x41, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, - 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, - 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7c, 0x00, 0x00, 0x3e, - 0x84, 0x00, 0x00, 0x21, 0x04, 0xff, 0xff, 0x20, 0x04, 0x00, 0x00, 0x20, - 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, - 0xfc, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/mail.xbm --- a/etc/w3/mail.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define mail.bm_width 32 -#define mail.bm_height 32 -static char mail.bm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x0f, 0x30, 0x00, 0x00, 0x0c, - 0x50, 0x00, 0x00, 0x0a, 0x90, 0x00, 0x00, 0x09, 0x10, 0x01, 0x80, 0x08, - 0x10, 0x02, 0x40, 0x08, 0x10, 0x04, 0x20, 0x08, 0x10, 0x08, 0x10, 0x08, - 0x10, 0x10, 0x08, 0x08, 0x10, 0x20, 0x04, 0x08, 0x10, 0x40, 0x02, 0x08, - 0x10, 0x80, 0x01, 0x08, 0x10, 0x00, 0x00, 0x08, 0x10, 0x00, 0x00, 0x08, - 0x10, 0x00, 0x00, 0x08, 0x10, 0x00, 0x00, 0x08, 0x10, 0x00, 0x00, 0x08, - 0xf0, 0xff, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/map.xbm --- a/etc/w3/map.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define map_width 32 -#define map_height 32 -static char map_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x0d,0x00,0x00,0xf0,0x3a,0xb8,0xff,0x0d, - 0x42,0x88,0x00,0x02,0x20,0x48,0x00,0x00,0x11,0x08,0xfc,0x80,0x61,0x08,0x02, - 0x41,0x41,0x10,0x39,0x82,0x41,0x90,0x46,0x02,0x43,0x48,0x91,0x04,0x41,0x48, - 0x59,0x04,0x41,0x48,0x41,0xc2,0x47,0x58,0x3a,0x01,0x41,0x98,0x04,0x01,0x21, - 0x28,0x81,0x00,0x40,0x48,0x7e,0x00,0x40,0x88,0x00,0x10,0x40,0x10,0x01,0x40, - 0x41,0x08,0x02,0x04,0x2c,0x08,0x06,0xe2,0x23,0x08,0x9a,0x01,0x20,0x08,0x62, - 0x80,0x22,0x10,0x04,0x18,0x20,0x08,0x04,0x3c,0x2e,0x08,0x08,0x16,0x1e,0x04, - 0x00,0x0a,0x3e,0x04,0x01,0x00,0x1f,0x04,0x01,0x80,0x0f,0x84,0xfe,0xc7,0x07, - 0xf6,0x02,0xf8,0x03,0x1e,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/mouse.xbm --- a/etc/w3/mouse.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define mouse.bm_width 32 -#define mouse.bm_height 32 -static char mouse.bm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x80, 0xff, 0xff, 0x01, 0x80, 0x00, 0x01, 0x01, 0x80, 0x00, 0x01, 0x01, - 0x80, 0x00, 0x01, 0x01, 0x80, 0x00, 0x01, 0x01, 0x80, 0x00, 0x01, 0x01, - 0x80, 0x00, 0x01, 0x01, 0x80, 0xff, 0xff, 0x01, 0x80, 0x00, 0x00, 0x01, - 0x80, 0x00, 0x00, 0x01, 0x80, 0x00, 0x00, 0x01, 0x80, 0x00, 0x00, 0x01, - 0x80, 0x00, 0x00, 0x01, 0x80, 0x00, 0x00, 0x01, 0x80, 0x00, 0x00, 0x01, - 0x80, 0x00, 0x00, 0x01, 0x00, 0x01, 0x80, 0x00, 0x00, 0x01, 0x80, 0x00, - 0x00, 0x06, 0x60, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/network.xbm --- a/etc/w3/network.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define network.bm_width 32 -#define network.bm_height 32 -static char network.bm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0x08, 0x08, 0x00, - 0x00, 0x08, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00, - 0x00, 0x08, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0xf8, 0x0f, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x1f, 0x00, 0x00, 0x04, 0x10, 0x00, - 0x00, 0xfc, 0x1f, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, - 0xfe, 0xff, 0xff, 0x7f, 0x00, 0x01, 0x80, 0x00, 0x00, 0x01, 0x80, 0x00, - 0xf0, 0x1f, 0xf8, 0x0f, 0x10, 0x10, 0x08, 0x08, 0x10, 0x10, 0x08, 0x08, - 0x10, 0x10, 0x08, 0x08, 0x10, 0x10, 0x08, 0x08, 0x10, 0x10, 0x08, 0x08, - 0x10, 0x10, 0x08, 0x08, 0xf0, 0x1f, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00, - 0xf8, 0x3f, 0xfc, 0x1f, 0x08, 0x20, 0x04, 0x10, 0xf8, 0x3f, 0xfc, 0x1f, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/next.xbm --- a/etc/w3/next.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -#define next_width 48 -#define next_height 24 -static char next_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0, - 0x00,0x00,0x00,0xff,0x1f,0x0e,0xff,0xff,0x01,0x3f,0x10,0x01,0x04,0x00,0x02, - 0x3f,0xd0,0x00,0x04,0x00,0x04,0x3f,0x72,0x00,0x08,0x00,0x02,0x3f,0x30,0x80, - 0xd8,0xff,0x01,0x3f,0x12,0xc0,0xf1,0x03,0x00,0x3f,0x11,0xe0,0x23,0x04,0x00, - 0x3f,0x12,0xf0,0x23,0x08,0x00,0x3f,0x11,0xf8,0x23,0x04,0x00,0xbf,0x12,0xdc, - 0xff,0x03,0x00,0x3f,0x15,0x8c,0x00,0x02,0x00,0xbf,0x12,0x80,0x01,0x01,0x00, - 0xbf,0x37,0x80,0xff,0x00,0x00,0xbf,0x74,0x80,0x00,0x01,0x00,0xbf,0x5c,0xc0, - 0x81,0x00,0x00,0xbf,0x9f,0x01,0x67,0x00,0x00,0x3f,0x17,0xfe,0x1d,0x00,0x00, - 0x3f,0x10,0x00,0x00,0x00,0x00,0xff,0x1f,0x00,0x00,0x00,0x00,0x3f,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/notebook.xbm --- a/etc/w3/notebook.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define notebook.xbm_width 32 -#define notebook.xbm_height 32 -static char notebook.xbm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x49, 0x02, 0x00, 0x00, 0x49, 0x02, 0x00, 0xc0, 0xff, 0x07, 0x00, - 0x40, 0x49, 0x06, 0x00, 0x40, 0x49, 0x06, 0x00, 0x40, 0x00, 0x1c, 0x00, - 0x40, 0x00, 0x14, 0x00, 0x40, 0x00, 0x14, 0x00, 0x40, 0x00, 0x14, 0x00, - 0x40, 0x00, 0x14, 0x00, 0x40, 0x00, 0x14, 0x00, 0x40, 0x00, 0x14, 0x00, - 0x40, 0x00, 0x14, 0x00, 0x40, 0x00, 0x14, 0x00, 0x40, 0x00, 0x14, 0x00, - 0x40, 0x00, 0x14, 0x00, 0x40, 0x00, 0x14, 0x00, 0x40, 0x00, 0x14, 0x00, - 0x40, 0x00, 0x14, 0x00, 0x40, 0x00, 0x14, 0x00, 0x40, 0x00, 0x14, 0x00, - 0x40, 0x00, 0x14, 0x00, 0xc0, 0xff, 0x17, 0x00, 0x80, 0x00, 0x10, 0x00, - 0x80, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/open-cap-up.xbm --- a/etc/w3/open-cap-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x20,0x00,0x00,0x00,0x60,0x00,0x00,0x00,0xbf,0x30, - 0x00,0x00,0x01,0x49,0x00,0x00,0x01,0x49,0x00,0x00,0xbf,0x30,0x00,0x00,0x60, - 0x00,0x00,0x00,0x20,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80, - 0x6d,0xdb,0x00,0x00,0x00,0x00,0x00,0x00,0xdb,0xb6,0x00,0x00,0x00,0x00,0x00, - 0x80,0x6d,0xdb,0x00,0x00,0x00,0x00,0x00,0x80,0xfb,0xef,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x01,0x00,0x00,0x40,0x02, - 0x00,0x00,0x20,0x74,0x4c,0x01,0x20,0x94,0xd2,0x02,0x20,0x94,0x5e,0x02,0x40, - 0x92,0x42,0x02,0x80,0x71,0x5c,0x02,0x00,0x10,0x00,0x00,0x00,0x10,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/open-cap-up.xpm --- a/etc/w3/open-cap-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *open-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkakkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkaakkkkkkkkkkkkkkkkk", -"kkkkkkkkaaaaaapakkkjaajkkkkkkkkk", -"kkkkkkkkaooooompakkaooajkkkkkkkk", -"kkkkkkkkammmmmmmagkaojajkkkkkkkk", -"kkkkkkkkaaaaaamagjkjaajjkkkkkkkk", -"kkkkkkkkkggggaagjkkkjjjkkkkkkkkk", -"kkkkkkkkkjjjjagjkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkgjkkkkkkkkkkkkkkkkk", -"kkkkkkkpgkpgkpgkpgkpgkpgkkkkkkkk", -"kkkkkkkaakaakaakaakaakaakkkkkkkk", -"kkkkkkkkpgmpgmpgmpgmpgmpkkkkkkkk", -"kkkkkkkkaamaamaamaamaamakkkkkkkk", -"kkkkkkkpgmpgmpgmpgmpgmpgkkkkkkkk", -"kkkkkkkaamaamaamaamaamaakkkkkkkk", -"kkkkkkkoogkoooooooogkoogkkkkkkkk", -"kkkkkkkaaakaaaaaaaaakaaakkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkk..kkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkk.kk.kkkkkkkkkkkkkkkkkkkkkk", -"kkkkk.kkkk.k...kkk..kk.k.kkkkkkk", -"kkkkk.kkkk.k.kk.k.kk.k..k.kkkkkk", -"kkkkk.kkkk.k.kk.k....k.kk.kkkkkk", -"kkkkkk.kk.kk.kk.k.kkkk.kk.kkkkkk", -"kkkkkkk..kkk...kkk...k.kk.kkkkkk", -"kkkkkkkkkkkk.kkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkk.kkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/open-up.xbm --- a/etc/w3/open-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x20,0x00,0x00,0x00,0x60,0x00,0x00,0x00,0xbf,0x30, - 0x00,0x00,0x01,0x49,0x00,0x00,0x01,0x49,0x00,0x00,0xbf,0x30,0x00,0x00,0x60, - 0x00,0x00,0x00,0x20,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80, - 0x6d,0xdb,0x00,0x00,0x00,0x00,0x00,0x00,0xdb,0xb6,0x00,0x00,0x00,0x00,0x00, - 0x80,0x6d,0xdb,0x00,0x00,0x00,0x00,0x00,0x80,0xfb,0xef,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/open-up.xpm --- a/etc/w3/open-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *open-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkakkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkaakkkkkkkkkkkkkkkkk", -"kkkkkkkkaaaaaapakkkjaajkkkkkkkkk", -"kkkkkkkkaooooompakkaooajkkkkkkkk", -"kkkkkkkkammmmmmmagkaojajkkkkkkkk", -"kkkkkkkkaaaaaamagjkjaajjkkkkkkkk", -"kkkkkkkkkggggaagjkkkjjjkkkkkkkkk", -"kkkkkkkkkjjjjagjkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkgjkkkkkkkkkkkkkkkkk", -"kkkkkkkpgkpgkpgkpgkpgkpgkkkkkkkk", -"kkkkkkkaakaakaakaakaakaakkkkkkkk", -"kkkkkkkkpgmpgmpgmpgmpgmpkkkkkkkk", -"kkkkkkkkaamaamaamaamaamakkkkkkkk", -"kkkkkkkpgmpgmpgmpgmpgmpgkkkkkkkk", -"kkkkkkkaamaamaamaamaamaakkkkkkkk", -"kkkkkkkoogkoooooooogkoogkkkkkkkk", -"kkkkkkkaaakaaaaaaaaakaaakkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/postscript.xbm --- a/etc/w3/postscript.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define postscript_width 32 -#define postscript_height 32 -static char postscript_bits[] = { - 0xf0,0xff,0x3f,0x00,0x10,0x00,0x60,0x00,0x10,0x04,0xa0,0x00,0x10,0x04,0x20, - 0x01,0x10,0x00,0x20,0x02,0x10,0x04,0x20,0x04,0xd0,0xea,0x27,0x08,0x10,0x04, - 0xe0,0x1f,0x10,0x00,0x00,0x18,0x10,0x04,0x00,0x18,0x10,0x04,0x00,0x18,0x10, - 0x00,0x00,0x18,0x10,0xfe,0x7c,0x18,0x10,0xcc,0xe7,0x18,0x10,0x8c,0xc3,0x18, - 0x10,0x8c,0x03,0x18,0x10,0xcc,0x07,0x18,0x10,0x7c,0x7e,0x18,0x10,0x0c,0xe0, - 0x18,0x10,0x0c,0xc0,0x18,0x10,0x0c,0xc3,0x18,0x10,0x0c,0xe7,0x18,0x10,0x1e, - 0x3e,0x18,0x10,0x00,0x00,0x18,0xd0,0xff,0xff,0x1b,0x10,0x00,0x00,0x18,0x10, - 0x04,0x00,0x18,0x10,0x04,0x00,0x18,0x10,0x04,0x00,0x18,0x10,0x00,0x00,0x18, - 0xf0,0xff,0xff,0x1f,0xe0,0xff,0xff,0x1f}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/print-cap-up.xbm --- a/etc/w3/print-cap-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0x0f,0x00,0x00,0x08,0x08, - 0x00,0x00,0xa8,0x08,0x00,0x00,0x08,0x08,0x00,0x00,0xa8,0x0a,0x00,0x00,0x08, - 0x08,0x00,0x00,0xe8,0x0a,0x00,0x00,0x08,0x08,0x00,0x00,0xff,0x7f,0x00,0x00, - 0x01,0x40,0x00,0x00,0x01,0x40,0x00,0x00,0x01,0x40,0x00,0x00,0x01,0x40,0x00, - 0x00,0xff,0x7f,0x00,0x00,0x02,0x20,0x00,0x00,0xfe,0x3f,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x83,0x00,0x00,0x80,0x04, - 0x40,0x00,0x80,0xd4,0xca,0x00,0x80,0xb3,0x56,0x00,0x80,0x90,0x52,0x00,0x80, - 0x90,0x52,0x00,0x80,0x90,0x92,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/print-cap-up.xpm --- a/etc/w3/print-cap-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *print-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkaaaaaaaaakkkkkkkkkkkk", -"kkkkkkkkkkkapppppppakkkkkkkkkkkk", -"kkkkkkkkkkkapfmfoooakkkkkkkkkkkk", -"kkkkkkkkkkkapooooooakkkkkkkkkkkk", -"kkkkkkkkkkkapfmfmfoakkkkkkkkkkkk", -"kkkkkkkkkkkapooooooakkkkkkkkkkkk", -"kkkkkkkkkkkapfffmfoakkkkkkkkkkkk", -"kkkkkkkkkkkapooooooakkkkkkkkkkkk", -"kkkkkkkkaaaaaaaaaaaaaaakkkkkkkkk", -"kkkkkkkkapppppppppppppajkkkkkkkk", -"kkkkkkkkapkkmmmmmmmmmmagjkkkkkkk", -"kkkkkkkkapmmmmmmmmmmmmagjkkkkkkk", -"kkkkkkkkapmmmmmmmmmmmmagjkkkkkkk", -"kkkkkkkkaaaaaaaaaaaaaaagjkkkkkkk", -"kkkkkkkkkamgmgmgmgmgmaggjkkkkkkk", -"kkkkkkkkkaaaaaaaaaaaaagjjkkkkkkk", -"kkkkkkkkkkjggggggggggggjkkkkkkkk", -"kkkkkkkkkkkjjjjjjjjjjjjjkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkk...kkkkk.kkkkkkkkkkkkkkkk", -"kkkkkkk.kk.kkkkkkkkkkk.kkkkkkkkk", -"kkkkkkk.kk.k.k..k.k.kk..kkkkkkkk", -"kkkkkkk...kk..k.k..k.k.kkkkkkkkk", -"kkkkkkk.kkkk.kk.k.kk.k.kkkkkkkkk", -"kkkkkkk.kkkk.kk.k.kk.k.kkkkkkkkk", -"kkkkkkk.kkkk.kk.k.kk.kk.kkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/print-up.xbm --- a/etc/w3/print-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0x0f,0x00,0x00,0x08,0x08, - 0x00,0x00,0xa8,0x08,0x00,0x00,0x08,0x08,0x00,0x00,0xa8,0x0a,0x00,0x00,0x08, - 0x08,0x00,0x00,0xe8,0x0a,0x00,0x00,0x08,0x08,0x00,0x00,0xff,0x7f,0x00,0x00, - 0x01,0x40,0x00,0x00,0x01,0x40,0x00,0x00,0x01,0x40,0x00,0x00,0x01,0x40,0x00, - 0x00,0xff,0x7f,0x00,0x00,0x02,0x20,0x00,0x00,0xfe,0x3f,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/print-up.xpm --- a/etc/w3/print-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *print-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkaaaaaaaaakkkkkkkkkkkk", -"kkkkkkkkkkkapppppppakkkkkkkkkkkk", -"kkkkkkkkkkkapfmfoooakkkkkkkkkkkk", -"kkkkkkkkkkkapooooooakkkkkkkkkkkk", -"kkkkkkkkkkkapfmfmfoakkkkkkkkkkkk", -"kkkkkkkkkkkapooooooakkkkkkkkkkkk", -"kkkkkkkkkkkapfffmfoakkkkkkkkkkkk", -"kkkkkkkkkkkapooooooakkkkkkkkkkkk", -"kkkkkkkkaaaaaaaaaaaaaaakkkkkkkkk", -"kkkkkkkkapppppppppppppajkkkkkkkk", -"kkkkkkkkapkkmmmmmmmmmmagjkkkkkkk", -"kkkkkkkkapmmmmmmmmmmmmagjkkkkkkk", -"kkkkkkkkapmmmmmmmmmmmmagjkkkkkkk", -"kkkkkkkkaaaaaaaaaaaaaaagjkkkkkkk", -"kkkkkkkkkamgmgmgmgmgmaggjkkkkkkk", -"kkkkkkkkkaaaaaaaaaaaaagjjkkkkkkk", -"kkkkkkkkkkjggggggggggggjkkkkkkkk", -"kkkkkkkkkkkjjjjjjjjjjjjjkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/printer.xbm --- a/etc/w3/printer.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define printer.bm_width 32 -#define printer.bm_height 32 -static char printer.bm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x80, 0xff, 0x03, 0x00, 0x80, 0x00, 0x06, 0x00, 0x80, 0x00, 0x0a, 0x00, - 0x80, 0x00, 0x12, 0x00, 0x80, 0x00, 0x22, 0x00, 0x80, 0x00, 0x42, 0x00, - 0x80, 0x00, 0x82, 0x00, 0x80, 0x00, 0xfe, 0x01, 0x80, 0x00, 0x00, 0x01, - 0x80, 0x00, 0x00, 0x01, 0x80, 0x00, 0x00, 0x01, 0x80, 0x00, 0x00, 0x01, - 0xfc, 0x00, 0x00, 0x3f, 0x84, 0x00, 0x00, 0x21, 0x84, 0x00, 0x00, 0x21, - 0x84, 0x00, 0x00, 0x21, 0xe4, 0xff, 0xff, 0x27, 0x04, 0x00, 0x00, 0x20, - 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, - 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, - 0x04, 0x00, 0x00, 0x20, 0xfc, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/reld-cap-dn.xbm --- a/etc/w3/reld-cap-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0xff,0xff,0xff,0xff,0xff,0x1f,0xfc,0xff,0xff,0x8f,0xf8,0xff,0xff,0xf3,0xe7, - 0xff,0xff,0x1b,0xec,0xff,0xff,0xcd,0xd9,0xff,0xff,0xe4,0x93,0xff,0xff,0xe4, - 0x7c,0xfe,0xff,0xf6,0x39,0xff,0xff,0xe6,0x93,0xff,0xff,0xe4,0xc7,0xff,0xff, - 0xcc,0xef,0xff,0xff,0x1d,0xc7,0xff,0xff,0x7b,0xba,0xff,0xff,0x73,0xba,0xff, - 0xff,0x0f,0xbb,0xff,0xff,0x9f,0xc7,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xc3,0xdf,0xff,0xef,0xbb,0xdf, - 0xff,0xef,0xbb,0xd9,0x9c,0xe3,0xc3,0x56,0x6b,0xed,0xbb,0x50,0x1b,0xed,0xbb, - 0x5e,0x6b,0xed,0xbb,0xd1,0x9c,0xe2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/reld-cap-dn.xpm --- a/etc/w3/reld-cap-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *reld-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkjfdadfjkkkkkkkkkkkkk", -"kkkkkkkkkkkgadfjfdagkkkkkkkkkkkk", -"kkkkkkkkkkdajoommmjadkkkkkkkkkkk", -"kkkkkkkkkgapofdadfmmagkkkkkkkkkk", -"kkkkkkkkjajofajjjadmjajkkkkkkkkk", -"kkkkkkkkfdpfajjjjjafmafkkkkkkkkk", -"kkkkkkkkdfpafjkkadjommgdakkkkkkk", -"kkkkkkkkajpajkkkkadmmmdajjkkkkkk", -"kkkkkkkkajpafkkkkkadmdajjkkkkkkk", -"kkkkkkkkdfpdfjkkkkkadajjkkkkkkkk", -"kkkkkkkkfdmmafjkkkkkdjjkkkkkkkkk", -"kkkkkkkkjajmmaffkkjaaajkkkkkkkkk", -"kkkkkkkkjgammmjdakamogakkkkkkkkk", -"kkkkkkkkkjdajmmadkaoomajkkkkkkkk", -"kkkkkkkkkkjgadfajkagmgagkkkkkkkk", -"kkkkkkkkkkkjjfdjjkjaaaggkkkkkkkk", -"kkkkkkkkkkkkjjjjkkkjgggjkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kk....kkkkkkk.kkkkkkkkkkkkkk.kkk", -"kk.kkk.kkkkkk.kkkkkkkkkkkkkk.kkk", -"kk.kkk.kk..kk.kk..kkk..kkk...kkk", -"kk....kk.kk.k.k.kk.k.kk.k.kk.kkk", -"kk.kkk.k....k.k.kk.kk...k.kk.kkk", -"kk.kkk.k.kkkk.k.kk.k.kk.k.kk.kkk", -"kk.kkk.kk...k.kk..kkk..k.k...kkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/reld-cap-no.xbm --- a/etc/w3/reld-cap-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0xe0,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x0c,0x18, - 0x00,0x00,0x00,0x00,0x00,0x00,0x32,0x26,0x00,0x00,0x00,0x00,0x00,0x00,0x1b, - 0x83,0x01,0x00,0x00,0x00,0x00,0x00,0x19,0x6c,0x00,0x00,0x00,0x00,0x00,0x00, - 0x33,0x10,0x00,0x00,0x00,0x00,0x00,0x00,0x84,0x45,0x00,0x00,0x00,0x00,0x00, - 0x00,0xf0,0x44,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x3c,0x20,0x00,0x10,0x00,0x00, - 0x00,0x00,0x44,0x26,0x63,0x1c,0x00,0x00,0x00,0x00,0x44,0xaf,0xe4,0x12,0x00, - 0x00,0x00,0x00,0x44,0x2e,0x63,0x1d,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/reld-cap-no.xpm --- a/etc/w3/reld-cap-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *reld-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkjfdadfjkkkkkkkkkkkkk", -"kkkkkkkkkkkgadfjfdagkkkkkkkkkkkk", -"kkkkkkkkkkdajoommmjadkkkkkkkkkkk", -"kkkkkkkkkgapofdadfmmagkkkkkkkkkk", -"kkkkkkkkjajofajjjadmjajkkkkkkkkk", -"kkkkkkkkfdpfajjjjjafmafkkkkkkkkk", -"kkkkkkkkdfpafjkkadjommgdakkkkkkk", -"kkkkkkkkajpajkkkkadmmmdajjkkkkkk", -"kkkkkkkkajpafkkkkkadmdajjkkkkkkk", -"kkkkkkkkdfpdfjkkkkkadajjkkkkkkkk", -"kkkkkkkkfdmmafjkkkkkdjjkkkkkkkkk", -"kkkkkkkkjajmmaffkkjaaajkkkkkkkkk", -"kkkkkkkkjgammmjdakamogakkkkkkkkk", -"kkkkkkkkkjdajmmadkaoomajkkkkkkkk", -"kkkkkkkkkkjgadfajkagmgagkkkkkkkk", -"kkkkkkkkkkkjjfdjjkjaaaggkkkkkkkk", -"kkkkkkkkkkkkjjjjkkkjgggjkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kk....kkkkkkk.kkkkkkkkkkkkkk.kkk", -"kk.kkk.kkkkkk.kkkkkkkkkkkkkk.kkk", -"kk.kkk.kk..kk.kk..kkk..kkk...kkk", -"kk....kk.kk.k.k.kk.k.kk.k.kk.kkk", -"kk.kkk.k....k.k.kk.kk...k.kk.kkk", -"kk.kkk.k.kkkk.k.kk.k.kk.k.kk.kkk", -"kk.kkk.kk...k.kk..kkk..k.k...kkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/reld-cap-up.xbm --- a/etc/w3/reld-cap-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0xe0,0x03,0x00,0x00,0x70,0x07,0x00,0x00,0x0c,0x18, - 0x00,0x00,0xe4,0x13,0x00,0x00,0x32,0x26,0x00,0x00,0x1b,0x6c,0x00,0x00,0x1b, - 0x83,0x01,0x00,0x09,0xc6,0x00,0x00,0x19,0x6c,0x00,0x00,0x1b,0x38,0x00,0x00, - 0x33,0x10,0x00,0x00,0xe2,0x38,0x00,0x00,0x84,0x45,0x00,0x00,0x8c,0x45,0x00, - 0x00,0xf0,0x44,0x00,0x00,0x60,0x38,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x3c,0x20,0x00,0x10,0x44,0x20, - 0x00,0x10,0x44,0x26,0x63,0x1c,0x3c,0xa9,0x94,0x12,0x44,0xaf,0xe4,0x12,0x44, - 0xa1,0x94,0x12,0x44,0x2e,0x63,0x1d,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/reld-cap-up.xpm --- a/etc/w3/reld-cap-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *reld-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkjfdadfjkkkkkkkkkkkkk", -"kkkkkkkkkkkgadfjfdagkkkkkkkkkkkk", -"kkkkkkkkkkdajoommmjadkkkkkkkkkkk", -"kkkkkkkkkgapofdadfmmagkkkkkkkkkk", -"kkkkkkkkjajofajjjadmjajkkkkkkkkk", -"kkkkkkkkfdpfajjjjjafmafkkkkkkkkk", -"kkkkkkkkdfpafjkkadjommgdakkkkkkk", -"kkkkkkkkajpajkkkkadmmmdajjkkkkkk", -"kkkkkkkkajpafkkkkkadmdajjkkkkkkk", -"kkkkkkkkdfpdfjkkkkkadajjkkkkkkkk", -"kkkkkkkkfdmmafjkkkkkdjjkkkkkkkkk", -"kkkkkkkkjajmmaffkkjaaajkkkkkkkkk", -"kkkkkkkkjgammmjdakamogakkkkkkkkk", -"kkkkkkkkkjdajmmadkaoomajkkkkkkkk", -"kkkkkkkkkkjgadfajkagmgagkkkkkkkk", -"kkkkkkkkkkkjjfdjjkjaaaggkkkkkkkk", -"kkkkkkkkkkkkjjjjkkkjgggjkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kk....kkkkkkk.kkkkkkkkkkkkkk.kkk", -"kk.kkk.kkkkkk.kkkkkkkkkkkkkk.kkk", -"kk.kkk.kk..kk.kk..kkk..kkk...kkk", -"kk....kk.kk.k.k.kk.k.kk.k.kk.kkk", -"kk.kkk.k....k.k.kk.kk...k.kk.kkk", -"kk.kkk.k.kkkk.k.kk.k.kk.k.kk.kkk", -"kk.kkk.kk...k.kk..kkk..k.k...kkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/reld-dn.xbm --- a/etc/w3/reld-dn.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0xff,0xff,0xff,0xff,0xff,0x1f,0xfc,0xff,0xff,0x8f,0xf8,0xff,0xff,0xf3,0xe7, - 0xff,0xff,0x1b,0xec,0xff,0xff,0xcd,0xd9,0xff,0xff,0xe4,0x93,0xff,0xff,0xe4, - 0x7c,0xfe,0xff,0xf6,0x39,0xff,0xff,0xe6,0x93,0xff,0xff,0xe4,0xc7,0xff,0xff, - 0xcc,0xef,0xff,0xff,0x1d,0xc7,0xff,0xff,0x7b,0xba,0xff,0xff,0x73,0xba,0xff, - 0xff,0x0f,0xbb,0xff,0xff,0x9f,0xc7,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/reld-dn.xpm --- a/etc/w3/reld-dn.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *reld-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkjfdadfjkkkkkkkkkkkkk", -"kkkkkkkkkkkgadfjfdagkkkkkkkkkkkk", -"kkkkkkkkkkdajoommmjadkkkkkkkkkkk", -"kkkkkkkkkgapofdadfmmagkkkkkkkkkk", -"kkkkkkkkjajofajjjadmjajkkkkkkkkk", -"kkkkkkkkfdpfajjjjjafmafkkkkkkkkk", -"kkkkkkkkdfpafjkkadjommgdakkkkkkk", -"kkkkkkkkajpajkkkkadmmmdajjkkkkkk", -"kkkkkkkkajpafkkkkkadmdajjkkkkkkk", -"kkkkkkkkdfpdfjkkkkkadajjkkkkkkkk", -"kkkkkkkkfdmmafjkkkkkdjjkkkkkkkkk", -"kkkkkkkkjajmmaffkkjaaajkkkkkkkkk", -"kkkkkkkkjgammmjdakamogakkkkkkkkk", -"kkkkkkkkkjdajmmadkaoomajkkkkkkkk", -"kkkkkkkkkkjgadfajkagmgagkkkkkkkk", -"kkkkkkkkkkkjjfdjjkjaaaggkkkkkkkk", -"kkkkkkkkkkkkjjjjkkkjgggjkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/reld-no.xbm --- a/etc/w3/reld-no.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0xe0,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x0c,0x18, - 0x00,0x00,0x00,0x00,0x00,0x00,0x32,0x26,0x00,0x00,0x00,0x00,0x00,0x00,0x1b, - 0x83,0x01,0x00,0x00,0x00,0x00,0x00,0x19,0x6c,0x00,0x00,0x00,0x00,0x00,0x00, - 0x33,0x10,0x00,0x00,0x00,0x00,0x00,0x00,0x84,0x45,0x00,0x00,0x00,0x00,0x00, - 0x00,0xf0,0x44,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/reld-no.xpm --- a/etc/w3/reld-no.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *reld-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkjfdadfjkkkkkkkkkkkkk", -"kkkkkkkkkkkgadfjfdagkkkkkkkkkkkk", -"kkkkkkkkkkdajoommmjadkkkkkkkkkkk", -"kkkkkkkkkgapofdadfmmagkkkkkkkkkk", -"kkkkkkkkjajofajjjadmjajkkkkkkkkk", -"kkkkkkkkfdpfajjjjjafmafkkkkkkkkk", -"kkkkkkkkdfpafjkkadjommgdakkkkkkk", -"kkkkkkkkajpajkkkkadmmmdajjkkkkkk", -"kkkkkkkkajpafkkkkkadmdajjkkkkkkk", -"kkkkkkkkdfpdfjkkkkkadajjkkkkkkkk", -"kkkkkkkkfdmmafjkkkkkdjjkkkkkkkkk", -"kkkkkkkkjajmmaffkkjaaajkkkkkkkkk", -"kkkkkkkkjgammmjdakamogakkkkkkkkk", -"kkkkkkkkkjdajmmadkaoomajkkkkkkkk", -"kkkkkkkkkkjgadfajkagmgagkkkkkkkk", -"kkkkkkkkkkkjjfdjjkjaaaggkkkkkkkk", -"kkkkkkkkkkkkjjjjkkkjgggjkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/reld-up.xbm --- a/etc/w3/reld-up.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -#define noname_width 32 -#define noname_height 30 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0xe0,0x03,0x00,0x00,0x70,0x07,0x00,0x00,0x0c,0x18, - 0x00,0x00,0xe4,0x13,0x00,0x00,0x32,0x26,0x00,0x00,0x1b,0x6c,0x00,0x00,0x1b, - 0x83,0x01,0x00,0x09,0xc6,0x00,0x00,0x19,0x6c,0x00,0x00,0x1b,0x38,0x00,0x00, - 0x33,0x10,0x00,0x00,0xe2,0x38,0x00,0x00,0x84,0x45,0x00,0x00,0x8c,0x45,0x00, - 0x00,0xf0,0x44,0x00,0x00,0x60,0x38,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/reld-up.xpm --- a/etc/w3/reld-up.xpm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -/* XPM */ -static char *reld-up[] = { -/* width height num_colors chars_per_pixel */ -" 32 30 18 1", -/* colors */ -". c #000000", -"# c #252525", -"a c #330099", -"b c #4c4c4c", -"c c #555555", -"d c #6666cc", -"e c #737373", -"f c #777777", -"g c #888888", -"h c #999999", -"i c #9999ff", -"j c #aaaaaa", -"k c #b2b2b2 s backgroundToolBarColor", -"l c #bbbbbb", -"m c #cccccc", -"n c #e1e1e1", -"o c #eeeeee", -"p c #ffffff", -/* pixels */ -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkjfdadfjkkkkkkkkkkkkk", -"kkkkkkkkkkkgadfjfdagkkkkkkkkkkkk", -"kkkkkkkkkkdajoommmjadkkkkkkkkkkk", -"kkkkkkkkkgapofdadfmmagkkkkkkkkkk", -"kkkkkkkkjajofajjjadmjajkkkkkkkkk", -"kkkkkkkkfdpfajjjjjafmafkkkkkkkkk", -"kkkkkkkkdfpafjkkadjommgdakkkkkkk", -"kkkkkkkkajpajkkkkadmmmdajjkkkkkk", -"kkkkkkkkajpafkkkkkadmdajjkkkkkkk", -"kkkkkkkkdfpdfjkkkkkadajjkkkkkkkk", -"kkkkkkkkfdmmafjkkkkkdjjkkkkkkkkk", -"kkkkkkkkjajmmaffkkjaaajkkkkkkkkk", -"kkkkkkkkjgammmjdakamogakkkkkkkkk", -"kkkkkkkkkjdajmmadkaoomajkkkkkkkk", -"kkkkkkkkkkjgadfajkagmgagkkkkkkkk", -"kkkkkkkkkkkjjfdjjkjaaaggkkkkkkkk", -"kkkkkkkkkkkkjjjjkkkjgggjkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk", -"kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk" -}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/scheduler.xbm --- a/etc/w3/scheduler.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define scheduler.bm_width 32 -#define scheduler.bm_height 32 -static char scheduler.bm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x92, 0x24, 0x00, - 0x00, 0x92, 0x24, 0x00, 0xc0, 0xff, 0xff, 0x03, 0x40, 0x92, 0x24, 0x02, - 0x40, 0x92, 0x24, 0x02, 0x40, 0x00, 0x00, 0x02, 0x40, 0x00, 0x00, 0x02, - 0x40, 0x00, 0x00, 0x02, 0x40, 0x00, 0x00, 0x02, 0x40, 0xf0, 0x0f, 0x02, - 0x40, 0xf0, 0x0f, 0x02, 0x40, 0xf0, 0x0f, 0x02, 0x40, 0x00, 0x00, 0x02, - 0x40, 0x00, 0x00, 0x02, 0x40, 0x80, 0x6d, 0x02, 0x40, 0x80, 0x6d, 0x02, - 0x40, 0x00, 0x00, 0x02, 0x40, 0xb6, 0x6d, 0x02, 0x40, 0xb6, 0x6d, 0x02, - 0x40, 0x00, 0x00, 0x02, 0x40, 0xb6, 0x6d, 0x02, 0x40, 0xb6, 0x6d, 0x02, - 0x40, 0x00, 0x00, 0x02, 0x40, 0xb6, 0x01, 0x02, 0x40, 0xb6, 0x01, 0x02, - 0x40, 0x00, 0x00, 0x02, 0x40, 0x00, 0x00, 0x02, 0xc0, 0xff, 0xff, 0x03, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/stop.xbm --- a/etc/w3/stop.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -#define stop_width 20 -#define stop_height 20 -static char stop_bits[] = { - 0xc0, 0x3f, 0x00, 0x20, 0x40, 0x00, 0x10, 0x80, 0x00, 0x08, 0x00, 0x01, - 0x04, 0x00, 0x02, 0x02, 0x00, 0x04, 0x01, 0x00, 0x08, 0xb9, 0x9b, 0x09, - 0x05, 0xa5, 0x0a, 0x05, 0xa5, 0x0a, 0x19, 0xa5, 0x09, 0x21, 0xa5, 0x08, - 0x21, 0xa5, 0x08, 0x1d, 0x99, 0x08, 0x02, 0x00, 0x04, 0x04, 0x00, 0x02, - 0xc8, 0x3f, 0x01, 0x10, 0x80, 0x00, 0x20, 0x40, 0x00, 0xc0, 0x3f, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/stylesheet --- a/etc/w3/stylesheet Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,297 +0,0 @@ -/****************************************************************************** -** File: default.css -** Purpose: Default Stylesheet for Emacs-W3 -** Info: Copyright (c) 1995-1996 William M. Perry -** Copyright (c) 1997 Free Software Foundation, Inc. -** Created: William M. Perry , Aug-31-1995 -** Maintainer: William M. Perry -** -** This contains the top level fallback default styles for Emacs-w3 -** -******************************************************************************* -** -** To specify device-dependent styles, you must mark a section with -** @media devicetype { ... } -** If you are not using 'devicetype', then anything within the { ... } -** is ignored. -** -** These sections are currently defined by -** http://www.w3.org/pub/WWW/Style/Group/WD-PRINT-961220 -** -** print - output for paged opaque material, and for documents viewed -** on screen in print preview mode -** screen - a continuous presentation of computer screens -** projector - paged presentation for projected presentations -** braille - for braille tactile feedback devices -** speech - aural presentation -** all - the default value, applies to all output devices -** -** There are a few special Emacs-W3 sections -** -** emacs - only include this chunk if you are using Emacs 19 -** xemacs - only include this chunk if you are using XEmacs -** light - only include this chunk if you are using a light background -** dark - only include this chunk if you are using a dark background -** tty - only include this chunk if you are using a TTY -** ansi-tty - " include this chunk if you are using an ANSI-capable TTY -******************************************************************************* -** -** There are some things this stylesheet cannot really specify, that we -** must rely on the browser to explicitly handle correctly: -** -** o table formatting -** o actually creating a hyperlink from an tag and its attributes -** o specifying which tags open lists -** o inlined images -** o frames (perhaps with positioning) -** o applet/script/embed/object -** o horizontal rules -******************************************************************************/ - -/* Headers */ - -h1,h2,h3, -h4,h5,h6 { - display: block; - font-family : serif; - font-weight : bold; - } - -@media xemacs { - h1 { font-size : +12pt } - h2 { font-size : +6pt } - h3 { font-size : +4pt } - h5 { font-size : -2pt } - h6 { font-size : -4pt } -} - -/* This causes problems with Emacs 19 */ -@media xemacs { - pre,xmp, - plaintext { font-family: monospace } -key,code,tt { font-family: monospace } -} - -/* -** Best we can do under Emacs-19 is use the default font and try to make -** the headers stand out somehow. -*/ - -@media emacs { -h1,h2,h3, -h4,h5,h6 { text-decoration: underline; } - h1 { color: rgb(0,255,255); } // cyan - h2 { color: rgb(70,130,180); } // steelblue - h3 { color: rgb(106,90,205); } // slateblue - h4 { color: rgb(135,206,235); } // skyblue - h5 { color: rgb(0,0,128); } // navy - h6 { color: rgb(173,216,230); } // lightblue - -strong,em { color: red } - dfn { font-style: italic } - s,strike { color: green } - -} // @media emacs - - p { display: block } - pre,xmp { display: block; white-space: pre; } -blockquote{ display: block; margin-left: 5em; margin-right: 5em; } - -/* -** How to draw form elements. -** This is an extension in Emacs-W3 (and perhaps soon E-Scape) -** Since there are so many different types of input fields, you should be -** able to control formatting based on that. Enter pseudo-classes. -** -** This functionality will be removed as soon as the W3C comes up with -** the standard way to do this, perhaps in CSS level 2. -*/ -input:text, -input:int, -input:float, -input:url, -input:password, -input:text { text-decoration: underline; } -input:submit { color: green; text-decoration: none; } -input:reset { color: red; text-decoration: none; } -input:button { color: yellow; text-decoration: none; } -input:image { text-decoration: none; } - -/* -** List formatting instructions -*/ - - ul { display: block; } - ol { display: block; } - dl { display: block; } - dir { display: block; } - menu { display: block; } - dt { font-weight: bold; display: line } - dd { display: line; margin-left: 5em; } - li { display: list-item; margin-left: 5em; } - ol { list-style: decimal; } - ul { list-style: circle; } - -/* These are to make nested list items look better */ -ul ul,ol ul,ol ol,ul ol { display: line; } - -/* -** All logical emphasis tags, the way god intended -*/ - - div { display: line; } - strong,em { font-weight: bold } - dfn { font-style: italic } - s,strike { text-decoration: line-through } - sub { text-position: sub } - sup { text-position: sup } - secret { text-transform: rot13 } - -/* -** Physical emphasis - spawn of evil -*/ - b { font-weight: bold } - i { font-style: italic } - u { text-decoration: underline } - blink { text-decoration: blink } - center { display: line; text-align: center; } -/* -** Various and sundry -*/ - br { display: line } - hr { display: line; text-align: center; } - - -/* -** Hypertext link coloring -*/ - -a:link { color: #FF0000 } -a:visited { color: #B22222 } -a:active { color: #FF0000 } - -/* -** Table formatting -*/ -table { display: block; } - th { display: block; font-weight: bold; text-align: center; } - td { display: block; text-align: left; } -caption { display: block; text-align: center; } - -/* -** Various other character-level formatting issues -*/ - - address { text-align: right; display: line; } -abstract { font-style: bold & italic ; text-align : indent } - quote { font-style: italic ; text-align : indent } - -/* -** Now for monochrome defaults -*/ -@media mono { - a:link { color: black; text-decoration: underline } -a:visited { color: black; text-decoration: underline } - a:active { color: white } -} // @media mono -/* -** All the TTY specific formatting -*/ - -@media tty { -/* -** First, handle some stuff for generic TTYs to emulate our old -** behaviour with w3-delimit-links and a subset of w3-delimit-emphasis -*/ - -h1,h2,h3, -h4,h5,h6 { - insert-before: *; - insert-after: * - } - -a:visited{ - insert-before: "{{"; - insert-after: "}}" - } - -a:link { - insert-before: "[["; - insert-after: "]]" - } - -input:text, -input:int, -input:float, -input:url, -input:file, -input:password, -input:text { insert-before: "[{"; insert-after: "}]"; } -select { insert-before: "[{"; insert-after: "}]"; } - -} // @media tty - - -@media ansi-tty { -/* -** Now comes the cool TTY stuff. You will need to be using XEmacs 19.14 -** or later (or Emacs 19.30 under DOS) in order to get any benefit from -** these whatsoever. But if you are using one of these, wow, cool, eh? -** -** ANSI specifies these colors, and most (all?) TTYs that support color -** will generally have 2 versions. One normal and one bright or 'standout' -** version. -** -** Color R G B -** -------------------------- -** white - 1.0 , 1.0 , 1.0 -** cyan - 0.0 , 1.0 , 1.0 -** magenta - 1.0 , 0.0 , 1.0 -** blue - 0.0 , 0.0 , 1.0 -** yellow - 1.0 , 1.0 , 0.0 -** green - 0.0 , 1.0 , 0.0 -** red - 1.0 , 0.0 , 0.0 -** black - 0.0 , 0.0 , 0.0 -*/ - -h1,h2,h3, -h4,h5,h6 { color : cyan } -a:visited { color : magenta } - a:link { color : red } - a:active { color : yellow } -} // @media ansi-tty - -/* -** Secial styles for the Emacspeak subsystem of emacs - an incredibly cool -** speech synthesizer. This was contributed by T.V. Raman (raman@adobe.com) -*/ -@media speech { -h1,h2,h3, -h4,h5,h6 { voice-family: paul; stress: 2; richness: 9; } - h1 { pitch: 1; pitch-range: 9; } - h2 { pitch: 2; pitch-range: 8; } - h3 { pitch: 3; pitch-range: 7; } - h4 { pitch: 4; pitch-range: 6; } - h5 { pitch: 5; pitch-range: 5; } - h6 { pitch: 6; pitch-range: 4; } - -li,dt,dd { pitch: 6; richness: 6; } - dt { stress: 8; } - -pre,xmp,plaintext,key,code,tt { pitch: 5; - pitch-range: 0; - stress: 0; - richness: 8; - } - em { pitch: 6; pitch-range: 6; stress: 6; richness: 5; } - strong { pitch: 6; pitch-range: 6; stress: 9; richness: 9; } - dfn { pitch: 7; pitch-range: 6; stress: 6; } -s,strike { richness: 0; } - i { pitch: 6; pitch-range: 6; stress: 6; richness: 5 } - b { pitch: 6; pitch-range: 6; stress: 9; richness: 9; } - u { richness: 0; } - a:link { voice-family: harry; } -a:visited { voice-family: betty;} - a:active { voice-family: betty; pitch-range: 8; pitch: 8 } - -} // @media speech diff -r f0deb0c0e6be -r eb5470882647 etc/w3/symlink.xbm --- a/etc/w3/symlink.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,9 +0,0 @@ -#define symlink_width 20 -#define symlink_height 23 -static char symlink_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xff, 0xff, 0x07, 0x01, 0x00, 0x0c, 0x01, 0x00, 0x0c, 0x01, 0x00, 0x0c, - 0x01, 0x00, 0x0c, 0x01, 0x00, 0x0c, 0x0f, 0x3f, 0x0e, 0x91, 0x40, 0x0e, - 0x67, 0x9e, 0x0d, 0xfd, 0x63, 0x0e, 0x03, 0x14, 0x0d, 0x03, 0x14, 0x0d, - 0xfd, 0x63, 0x0e, 0x67, 0x9e, 0x0f, 0x91, 0x40, 0x0e, 0x0f, 0x3f, 0x0c, - 0x01, 0x00, 0x0c, 0xff, 0xff, 0x0f, 0xfe, 0xff, 0x0f}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/telephone.xbm --- a/etc/w3/telephone.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define telephone.bm_width 32 -#define telephone.bm_height 32 -static char telephone.bm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, - 0x40, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, - 0x10, 0x04, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, - 0x08, 0x10, 0x00, 0x00, 0x08, 0x10, 0x00, 0x00, 0x10, 0x0e, 0x00, 0x00, - 0x10, 0x01, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, - 0x40, 0x08, 0x00, 0x00, 0x40, 0x10, 0x00, 0x00, 0x80, 0x20, 0x00, 0x00, - 0x00, 0x41, 0x00, 0x00, 0x00, 0x82, 0x60, 0x00, 0x00, 0x04, 0x91, 0x01, - 0x00, 0x08, 0x12, 0x06, 0x00, 0x10, 0x14, 0x18, 0x00, 0x20, 0x08, 0x20, - 0x00, 0x40, 0x00, 0x20, 0x00, 0x80, 0x01, 0x10, 0x00, 0x00, 0x06, 0x0c, - 0x00, 0x00, 0x18, 0x03, 0x00, 0x00, 0xe0, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/telnet.xbm --- a/etc/w3/telnet.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -#define telnet_width 20 -#define telnet_height 23 -static char telnet_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0x07,0x02,0x00,0x0c,0x7a,0x37,0x0c, - 0x7a,0x37,0x0c,0x32,0x33,0x0c,0x32,0x37,0x0c,0x32,0x37,0x0c,0x32,0x33,0x0c, - 0x32,0xf7,0x0c,0x32,0xf7,0x0c,0x02,0x00,0x0c,0xfe,0xff,0x0f,0xfc,0xff,0x0f, - 0x00,0x00,0x00,0x04,0x00,0x02,0xfe,0xff,0x07,0xff,0xff,0x0f,0xfe,0xff,0x07, - 0x04,0x00,0x02,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/text.document.xbm --- a/etc/w3/text.document.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -#define text_width 20 -#define text_height 23 -static char text_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0x3f,0x00,0x01,0x60,0x00,0x01,0xa0,0x00, - 0xf9,0x27,0x01,0x01,0x20,0x02,0xf1,0xe7,0x07,0x01,0xc0,0x0f,0xf9,0x07,0x0c, - 0x01,0x00,0x0c,0xe1,0x07,0x0c,0x01,0x00,0x0c,0xf9,0x07,0x0c,0x01,0x00,0x0c, - 0xe1,0x07,0x0c,0x01,0x00,0x0c,0xf9,0x07,0x0c,0x01,0x00,0x0c,0xff,0xff,0x0f, - 0xfe,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/tn3270.xbm --- a/etc/w3/tn3270.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,9 +0,0 @@ -#define tn3270_width 20 -#define tn3270_height 23 -static char tn3270_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0x07, 0x02, 0x00, 0x0c, - 0xfa, 0x86, 0x0d, 0xfa, 0x8e, 0x0d, 0x22, 0x9e, 0x0d, 0x22, 0xb6, 0x0d, - 0x22, 0xe6, 0x0d, 0x22, 0xc6, 0x0d, 0x22, 0x86, 0x0d, 0x22, 0x86, 0x0d, - 0x02, 0x00, 0x0c, 0xfe, 0xff, 0x0f, 0xfc, 0xff, 0x0f, 0x00, 0x00, 0x00, - 0x04, 0x00, 0x02, 0xfe, 0xff, 0x07, 0xff, 0xff, 0x0f, 0xfe, 0xff, 0x07, - 0x04, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/trash.xbm --- a/etc/w3/trash.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6 +0,0 @@ -#define trash_width 16 -#define trash_height 16 -static char trash_bits[] = { - 0x00, 0x01, 0xe0, 0x0f, 0x10, 0x10, 0xf8, 0x3f, 0x10, 0x10, 0x50, 0x15, - 0x50, 0x15, 0x50, 0x15, 0x50, 0x15, 0x50, 0x15, 0x50, 0x15, 0x50, 0x15, - 0x50, 0x15, 0x10, 0x10, 0xe0, 0x0f, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/unknown.document.xbm --- a/etc/w3/unknown.document.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -#define unknown_width 20 -#define unknown_height 23 -static char unknown_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0x3f,0x00,0x01,0x60,0x00,0x01,0xa0,0x00, - 0x01,0x20,0x01,0x01,0x20,0x02,0x01,0xe0,0x07,0x01,0xc0,0x0f,0x01,0x00,0x0c, - 0x01,0x00,0x0c,0x01,0x00,0x0c,0x01,0x00,0x0c,0x01,0x00,0x0c,0x01,0x00,0x0c, - 0x01,0x00,0x0c,0x01,0x00,0x0c,0x01,0x00,0x0c,0x01,0x00,0x0c,0xff,0xff,0x0f, - 0xfe,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/uuencoded.document.xbm --- a/etc/w3/uuencoded.document.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -#define uuencoded_width 20 -#define uuencoded_height 23 -static char uuencoded_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0x3f,0x00,0x01,0x60,0x00,0x01,0xa0,0x00, - 0x01,0x20,0x01,0x01,0x20,0x02,0x01,0xe0,0x07,0x01,0xc0,0x0f,0x01,0x00,0x0c, - 0xb1,0x6d,0x0c,0xb1,0x6d,0x0c,0xb1,0x6d,0x0c,0xb1,0x6d,0x0c,0xb1,0x6d,0x0c, - 0xb1,0x6d,0x0c,0xf1,0x7d,0x0c,0xe1,0x38,0x0c,0x01,0x00,0x0c,0xff,0xff,0x0f, - 0xfe,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00}; diff -r f0deb0c0e6be -r eb5470882647 etc/w3/workstation.xbm --- a/etc/w3/workstation.xbm Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -#define workstation.bm_width 32 -#define workstation.bm_height 32 -static char workstation.bm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0x07, - 0x20, 0x00, 0x00, 0x04, 0x20, 0xf0, 0x0f, 0x04, 0x20, 0x0c, 0x30, 0x04, - 0x20, 0x02, 0x40, 0x04, 0x20, 0x02, 0x40, 0x04, 0x20, 0x01, 0x80, 0x04, - 0x20, 0x01, 0x80, 0x04, 0x20, 0x01, 0x80, 0x04, 0x20, 0x01, 0x80, 0x04, - 0x20, 0x01, 0x80, 0x04, 0x20, 0x01, 0x80, 0x04, 0x20, 0x02, 0x40, 0x04, - 0x20, 0x02, 0x40, 0x04, 0x20, 0x0c, 0x30, 0x04, 0x20, 0xf0, 0x0f, 0x04, - 0x20, 0x00, 0x00, 0x04, 0xe0, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0x00, - 0xfc, 0xff, 0xff, 0x3f, 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, - 0xe4, 0x00, 0x70, 0x20, 0x04, 0x00, 0xff, 0x27, 0x04, 0x00, 0x70, 0x20, - 0x04, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00, 0x20, 0xfc, 0xff, 0xff, 0x3f, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff -r f0deb0c0e6be -r eb5470882647 info/dir --- a/info/dir Mon Aug 13 10:00:35 2007 +0200 +++ b/info/dir Mon Aug 13 10:01:22 2007 +0200 @@ -78,7 +78,6 @@ * Viper:: A VI Plan for Emacs Rescue and a venomous VI PERil. * Vhdl-mode:: A major mode for editing VHDL files. * VM:: View Mail, a replacement for Rmail. -* W3:: A browser for the World Wide Web global hypertext system. * Widget:: An Emacs Lisp widget library * tm-en:: Tools for Mime (English version) * tm-mh-e-en:: Tools for Mime for MH-E (English version) @@ -89,3 +88,4 @@ * tm-mh-e-ja:: Tools for Mime for MH-E (Japanese version) * gnus-mime-ja:: Tools for Mime for Gnus (Japanese version) +* Locals: diff -r f0deb0c0e6be -r eb5470882647 lib-src/ChangeLog --- a/lib-src/ChangeLog Mon Aug 13 10:00:35 2007 +0200 +++ b/lib-src/ChangeLog Mon Aug 13 10:01:22 2007 +0200 @@ -1,3 +1,7 @@ +1997-10-04 SL Baur + + * update-autoloads.sh (mule_p): W3 is a package now. + 1997-09-30 SL Baur * update-elc.sh (ignore_pattern): Don't attempt bytecompiling diff -r f0deb0c0e6be -r eb5470882647 lib-src/etags.c --- a/lib-src/etags.c Mon Aug 13 10:00:35 2007 +0200 +++ b/lib-src/etags.c Mon Aug 13 10:01:22 2007 +0200 @@ -31,7 +31,7 @@ * Francesco Potorti` (F.Potorti@cnuce.cnr.it) is the current maintainer. */ -char pot_etags_version[] = "@(#) pot revision number is 12.19"; +char pot_etags_version[] = "@(#) pot revision number is 12.28"; #define TRUE 1 #define FALSE 0 @@ -73,6 +73,22 @@ # define LONG_OPTIONS /* accept long options */ #endif /* HAVE_CONFIG_H */ +/* Prototyping magic snarfed from gmalloc.c */ +#if defined (__cplusplus) || (defined (__STDC__) && __STDC__) || defined (__SUNPRO_C) +#undef PP +#define PP(args) args +#undef __ptr_t +#define __ptr_t void * +#else /* Not C++ or ANSI C. */ +#undef PP +#define PP(args) () +#undef const +#define const +#undef __ptr_t +#define __ptr_t char * +#endif /* C++ or ANSI C. */ + + #if !defined (WINDOWSNT) && defined (STDC_HEADERS) #include #include @@ -144,37 +160,44 @@ #define lowcase(c) tolower ((char)c) #define CHARS 256 /* 2^sizeof(char) */ -#define CHAR(x) ((int)x & (CHARS - 1)) +#define CHAR(x) ((unsigned int)x & (CHARS - 1)) #define iswhite(c) (_wht[CHAR(c)]) /* c is white */ #define notinname(c) (_nin[CHAR(c)]) /* c is not in a name */ #define begtoken(c) (_btk[CHAR(c)]) /* c can start token */ #define intoken(c) (_itk[CHAR(c)]) /* c can be in token */ #define endtoken(c) (_etk[CHAR(c)]) /* c ends tokens */ -#ifdef DOS_NT -# define absolutefn(fn) (fn[0] == '/' \ - || (fn[1] == ':' && fn[2] == '/')) -#else -# define absolutefn(fn) (fn[0] == '/') -#endif - /* - * xnew -- allocate storage + * xnew, xrnew -- allocate, reallocate storage * * SYNOPSIS: Type *xnew (int n, Type); + * Type *xrnew (OldPointer, int n, Type); */ #ifdef chkmalloc # include "chkmalloc.h" -# define xnew(n,Type) ((Type *) trace_xmalloc (__FILE__, __LINE__, \ - (n) * sizeof (Type))) +# define xnew(n,Type) ((Type *) trace_malloc (__FILE__, __LINE__, \ + (n) * sizeof (Type))) +# define xrnew(op,n,Type) ((Type *) trace_realloc (__FILE__, __LINE__, \ + (op), (n) * sizeof (Type))) #else -# define xnew(n,Type) ((Type *) xmalloc ((n) * sizeof (Type))) +# define xnew(n,Type) ((Type *) xmalloc ((n) * sizeof (Type))) +# define xrnew(op,n,Type) ((Type *) xrealloc ((op), (n) * sizeof (Type))) #endif typedef int bool; -typedef struct nd_st +typedef void Lang_function (); + +typedef struct +{ + char *name; + Lang_function *function; + char **suffixes; + char **interpreters; +} language; + +typedef struct node_st { /* sorting structure */ char *name; /* function or type name */ char *file; /* file name */ @@ -183,103 +206,121 @@ int lno; /* line number tag is on */ long cno; /* character number line starts on */ char *pat; /* search pattern */ - struct nd_st *left, *right; /* left and right sons */ -} NODE; - -extern char *getenv (); - -char *concat (); -char *savenstr (), *savestr (); -char *etags_strchr (), *etags_strrchr (); -char *etags_getcwd (); -char *relative_filename (), *absolute_filename (), *absolute_dirname (); -void grow_linebuffer (); -long *xmalloc (), *xrealloc (); - -typedef void Lang_function (); + struct node_st *left, *right; /* left and right sons */ +} node; + +/* + * A `linebuffer' is a structure which holds a line of text. + * `readline_internal' reads a line from a stream into a linebuffer + * and works regardless of the length of the line. + * SIZE is the size of BUFFER, LEN is the length of the string in + * BUFFER after readline reads it. + */ +typedef struct +{ + long size; + int len; + char *buffer; +} linebuffer; + +extern char *getenv PP ((const char *envvar)); + /* Many compilers barf on this: Lang_function Asm_labels; so let's write it this way */ -void Asm_labels (); -void C_entries (); -void default_C_entries (); -void plain_C_entries (); -void Cjava_entries (); -void Cobol_paragraphs (); -void Cplusplus_entries (); -void Cstar_entries (); -void Erlang_functions (); -void Fortran_functions (); -void Yacc_entries (); -void Lisp_functions (); -void Pascal_functions (); -void Perl_functions (); -void Postscript_functions (); -void Prolog_functions (); -void Scheme_functions (); -void TeX_functions (); -void just_read_file (); - -Lang_function *get_language_from_name (); -Lang_function *get_language_from_interpreter (); -Lang_function *get_language_from_suffix (); -int total_size_of_entries (); -long readline (); -long readline_internal (); +void Asm_labels PP ((FILE *inf)); +void C_entries PP ((int c_ext, FILE *inf)); +void default_C_entries PP ((FILE *inf)); +void plain_C_entries PP ((FILE *inf)); +void Cjava_entries PP ((FILE *inf)); +void Cplusplus_entries PP ((FILE *inf)); +void Yacc_entries PP ((FILE *inf)); +void Cobol_paragraphs PP ((FILE *inf)); +void Cstar_entries PP ((FILE *inf)); +void Erlang_functions PP ((FILE *inf)); +void Fortran_functions PP ((FILE *inf)); +void Lisp_functions PP ((FILE *inf)); +void Pascal_functions PP ((FILE *inf)); +void Perl_functions PP ((FILE *inf)); +void Postscript_functions PP ((FILE *inf)); +void Prolog_functions PP ((FILE *inf)); +void Python_functions PP ((FILE *inf)); +void Scheme_functions PP ((FILE *inf)); +void TeX_functions PP ((FILE *inf)); +void just_read_file PP ((FILE *inf)); + +void print_language_names PP ((void)); +void print_version PP ((void)); +void print_help PP ((void)); + +language *get_language_from_name PP ((char *name)); +language *get_language_from_interpreter PP ((char *interpreter)); +language *get_language_from_suffix PP ((char *suffix)); +int total_size_of_entries PP ((node *np)); +long readline PP ((linebuffer *lbp, FILE *stream)); +long readline_internal PP ((linebuffer *lbp, FILE *stream)); #ifdef ETAGS_REGEXPS -void analyse_regex (); -void add_regex (); +void analyse_regex PP ((char *regex_arg)); +void add_regex PP ((char *regexp_pattern, language *lang)); +void free_patterns PP ((void)); #endif /* ETAGS_REGEXPS */ -void add_node (); -void error (); -void suggest_asking_for_help (); -void fatal (), pfatal (); -void find_entries (); -void free_tree (); -void getit (); -void init (); -void initbuffer (); -void pfnote (), new_pfnote (); -void process_file (); -void put_entries (); -void takeprec (); +void error PP ((const char *s1, const char *s2)); +void suggest_asking_for_help PP ((void)); +void fatal PP ((char *s1, char *s2)); +void pfatal PP ((char *s1)); +void add_node PP ((node *np, node **cur_node_p)); + +void init PP ((void)); +void initbuffer PP ((linebuffer *lbp)); +void find_entries PP ((char *file, FILE *inf)); +void free_tree PP ((node *np)); +void pfnote PP ((char *name, bool is_func, char *linestart, int linelen, int lno, long cno)); +void new_pfnote PP ((char *name, int namelen, bool is_func, char *linestart, int linelen, int lno, long cno)); +void process_file PP ((char *file)); +void put_entries PP ((node *np)); +void takeprec PP ((void)); + +char *concat PP ((char *s1, char *s2, char *s3)); +char *skip_spaces PP ((char *cp)); +char *skip_non_spaces PP ((char *cp)); +char *savenstr PP ((char *cp, int len)); +char *savestr PP ((char *cp)); +char *etags_strchr PP ((char *sp, int c)); +char *etags_strrchr PP ((char *sp, int c)); +char *etags_getcwd PP ((void)); +char *relative_filename PP ((char *file, char *dir)); +char *absolute_filename PP ((char *file, char *dir)); +char *absolute_dirname PP ((char *file, char *dir)); +bool filename_is_absolute PP ((char *fn)); +void canonicalize_filename PP ((char *fn)); +void grow_linebuffer PP ((linebuffer *lbp, int toksize)); +long *xmalloc PP ((unsigned int size)); +long *xrealloc PP ((char *ptr, unsigned int size)); char searchar = '/'; /* use /.../ searches */ -int lineno; /* line number of current line */ -long charno; /* current character number */ -long linecharno; /* charno of start of line */ - -char *curfile; /* current input file name */ char *tagfile; /* output file */ char *progname; /* name this program was invoked with */ char *cwd; /* current working directory */ char *tagfiledir; /* directory of tagfile */ - FILE *tagf; /* ioptr for tags file */ -NODE *head; /* the head of the binary tree of tags */ - -/* - * A `struct linebuffer' is a structure which holds a line of text. - * `readline' reads a line from a stream into a linebuffer and works - * regardless of the length of the line. - * SIZE is the size of BUFFER, LEN is the length of the string in - * BUFFER after readline reads it. - */ -struct linebuffer -{ - long size; - int len; - char *buffer; -}; - -struct linebuffer lb; /* the current line */ -struct linebuffer token_name; /* used by C_entries as a temporary area */ + +char *curfile; /* current input file name */ +language *curlang; /* current language */ + +int lineno; /* line number of current line */ +long charno; /* current character number */ +long linecharno; /* charno of start of current line */ +char *dbp; /* pointer to start of current tag */ +node *head; /* the head of the binary tree of tags */ + +linebuffer lb; /* the current line */ +linebuffer token_name; /* used by C_entries as a temporary area */ struct { long linepos; - struct linebuffer lb; /* used by C_entries instead of lb */ + linebuffer lb; /* used by C_entries instead of lb */ } lbs[2]; /* boolean "functions" (see init) */ @@ -288,7 +329,7 @@ /* white chars */ *white = " \f\t\n\r", /* not in a name */ - *nonam =" \f\t\n\r(=,[;", + *nonam = " \f\t\n\r(=,[;", /* token ending chars */ *endtk = " \t\n\r\"'#()[]{}=-+%*/&|^~!<>;,.:?", /* token starting chars */ @@ -305,7 +346,7 @@ bool constantypedefs; /* -d: create tags for C #define, enum */ /* constants and variables. */ /* -D: opposite of -d. Default under ctags. */ -bool globals; /* create tags for C global variables */ +bool globals; /* create tags for global variables */ bool members; /* create tags for C member variables */ bool update; /* -u: update tags */ bool vgrind_style; /* -v: create vgrind style index output */ @@ -350,19 +391,19 @@ #ifdef ETAGS_REGEXPS /* Structure defining a regular expression. Elements are the compiled pattern, and the name string. */ -struct pattern +typedef struct pattern { + struct pattern *p_next; + language *language; + char *regex; struct re_pattern_buffer *pattern; struct re_registers regs; char *name_pattern; bool error_signaled; -}; - -/* Number of regexps found. */ -int num_patterns = 0; +} pattern; /* Array of all regexps. */ -struct pattern *patterns = NULL; +pattern *p_head = NULL; #endif /* ETAGS_REGEXPS */ /* @@ -370,7 +411,7 @@ */ /* Non-NULL if language fixed. */ -Lang_function *lang_func = NULL; +language *forced_lang = NULL; /* Assembly code */ char *Asm_suffixes [] = { "a", /* Unix assembler */ @@ -432,9 +473,12 @@ char *Prolog_suffixes [] = { "prolog", NULL }; +char *Python_suffixes [] = + { "py", NULL }; + /* Can't do the `SCM' or `scm' prefix with a version number. */ char *Scheme_suffixes [] = - { "SCM", "SM", "oak", "sch", "scheme", "scm", "sm", "t", NULL }; + { "SCM", "SM", "oak", "sch", "scheme", "scm", "sm", "ss", "t", NULL }; char *TeX_suffixes [] = { "TeX", "bib", "clo", "cls", "ltx", "sty", "tex", NULL }; @@ -442,19 +486,14 @@ char *Yacc_suffixes [] = { "y", "ym", NULL }; /* .ym is Objective yacc file */ -/* Table of language names and corresponding functions, file suffixes - and interpreter names. - It is ok for a given function to be listed under more than one - name. I just didn't. */ -struct lang_entry -{ - char *name; - Lang_function *function; - char **suffixes; - char **interpreters; -}; - -struct lang_entry lang_names [] = +/* + * Table of languages. + * + * It is ok for a given function to be listed under more than one + * name. I just didn't. + */ + +language lang_names [] = { { "asm", Asm_labels, Asm_suffixes, NULL }, { "c", default_C_entries, default_C_suffixes, NULL }, @@ -470,6 +509,7 @@ { "postscript", Postscript_functions, Postscript_suffixes, NULL }, { "proc", plain_C_entries, plain_C_suffixes, NULL }, { "prolog", Prolog_functions, Prolog_suffixes, NULL }, + { "python", Python_functions, Python_suffixes, NULL }, { "scheme", Scheme_functions, Scheme_suffixes, NULL }, { "tex", TeX_functions, TeX_suffixes, NULL }, { "yacc", Yacc_entries, Yacc_suffixes, NULL }, @@ -482,7 +522,7 @@ void print_language_names () { - struct lang_entry *lang; + language *lang; char **ext; puts ("\nThese are the currently supported languages, along with the\n\ @@ -528,10 +568,10 @@ puts ("Long option names do not work with this executable, as it is not\n\ linked with GNU getopt."); #endif /* LONG_OPTIONS */ - puts ("A - as file name means read names from stdin."); + puts ("A - as file name means read names from stdin (one per line)."); if (!CTAGS) - printf (" Absolute names are stored in the output file as they\n\ -are. Relative ones are stored relative to the output file's directory."); + printf (" Absolute names are stored in the output file as they are.\n\ +Relative ones are stored relative to the output file's directory."); puts ("\n"); puts ("-a, --append\n\ @@ -566,11 +606,11 @@ if (CTAGS) puts ("--globals\n\ - Create tag entries for global variables in C and derived languages."); + Create tag entries for global variables in some languages."); else puts ("--no-globals\n\ - Do not create tag entries for global variables in C and\n\ - derived languages. This makes the tags file smaller."); + Do not create tag entries for global variables in some\n\ + languages. This makes the tags file smaller."); puts ("--members\n\ Create tag entries for member variables in C and derived languages."); @@ -647,7 +687,7 @@ { enum argument_type arg_type; char *what; - Lang_function *function; + language *lang; } argument; #ifdef VMS /* VMS specific functions */ @@ -786,7 +826,7 @@ char *this_file; argument *argbuffer; int current_arg, file_count; - struct linebuffer filename_lb; + linebuffer filename_lb; #ifdef VMS bool got_err; #endif @@ -865,7 +905,10 @@ case 'o': if (tagfile) { - error ("-%c option may only be given once.", opt); + /* convert char to string, to call error with */ + char buf[2]; + sprintf (buf, "%c", opt); + error ("-%s option may only be given once.", buf); suggest_asking_for_help (); } tagfile = optarg; @@ -875,9 +918,15 @@ noindentypedefs = TRUE; break; case 'l': - argbuffer[current_arg].function = get_language_from_name (optarg); - argbuffer[current_arg].arg_type = at_language; - ++current_arg; + { + language *lang = get_language_from_name (optarg); + if (lang != NULL) + { + argbuffer[current_arg].lang = lang; + argbuffer[current_arg].arg_type = at_language; + ++current_arg; + } + } break; #ifdef ETAGS_REGEXPS case 'r': @@ -984,7 +1033,7 @@ switch (argbuffer[i].arg_type) { case at_language: - lang_func = argbuffer[i].function; + forced_lang = argbuffer[i].lang; break; #ifdef ETAGS_REGEXPS case at_regexp: @@ -1008,7 +1057,7 @@ this_file = argbuffer[i].what; #endif /* Input file named "-" means read file names from stdin - and use them. */ + (one per line) and use them. */ if (streq (this_file, "-")) while (readline_internal (&filename_lb, stdin) > 0) process_file (filename_lb.buffer); @@ -1021,6 +1070,10 @@ } } +#ifdef ETAGS_REGEXPS + free_patterns (); +#endif /* ETAGS_REGEXPS */ + if (!CTAGS) { while (nincluded_files-- > 0) @@ -1071,40 +1124,36 @@ /* - * Return a Lang_function given the name. + * Return a language given the name. */ -Lang_function * +language * get_language_from_name (name) char *name; { - struct lang_entry *lang; - - if (name != NULL) - for (lang = lang_names; lang->name != NULL; lang++) - { + language *lang; + + if (name == NULL) + error ("empty language name", (char *)NULL); + else + { + for (lang = lang_names; lang->name != NULL; lang++) if (streq (name, lang->name)) - return lang->function; - } - - error ("language \"%s\" not recognized.", optarg); - suggest_asking_for_help (); - - /* This point should never be reached. The function should either - return a function pointer or never return. Note that a NULL - pointer cannot be considered as an error, as it means that the - language has not been explicitely imposed by the user ("auto"). */ - return NULL; /* avoid warnings from compiler */ + return lang; + error ("unknown language \"%s\"", name); + } + + return NULL; } /* - * Return a Lang_function given the interpreter name. + * Return a language given the interpreter name. */ -Lang_function * +language * get_language_from_interpreter (interpreter) char *interpreter; { - struct lang_entry *lang; + language *lang; char **iname; if (interpreter == NULL) @@ -1113,7 +1162,7 @@ if (lang->interpreters != NULL) for (iname = lang->interpreters; *iname != NULL; iname++) if (streq (*iname, interpreter)) - return lang->function; + return lang; return NULL; } @@ -1121,13 +1170,13 @@ /* - * Return a Lang_function given the file suffix. + * Return a language given the file suffix. */ -Lang_function * +language * get_language_from_suffix (suffix) char *suffix; { - struct lang_entry *lang; + language *lang; char **ext; if (suffix == NULL) @@ -1136,7 +1185,7 @@ if (lang->suffixes != NULL) for (ext = lang->suffixes; *ext != NULL; ext++) if (streq (*ext, suffix)) - return lang->function; + return lang; return NULL; } @@ -1151,14 +1200,8 @@ { struct stat stat_buf; FILE *inf; -#ifdef DOS_NT - char *p; - - for (p = file; *p != '\0'; p++) - if (*p == '\\') - *p = '/'; -#endif - + + canonicalize_filename (file); if (stat (file, &stat_buf) == 0 && !S_ISREG (stat_buf.st_mode)) { error ("skipping %s: it is not a regular file.", file); @@ -1182,7 +1225,7 @@ { char *filename; - if (absolutefn (file)) + if (filename_is_absolute (file)) { /* file is an absolute file name. Canonicalise it. */ filename = absolute_filename (file, cwd); @@ -1203,7 +1246,7 @@ /* * This routine sets up the boolean pseudo-functions which work - * by setting boolean flags dependent upon the corresponding character + * by setting boolean flags dependent upon the corresponding character. * Every char which is NOT in that string is not a white char. Therefore, * all of the array "_wht" is set to FALSE, and then the elements * subscripted by the chars in "white" are set to TRUE. Thus "_wht" @@ -1216,39 +1259,43 @@ register int i; for (i = 0; i < CHARS; i++) - _wht[i] = _nin[i] = _etk[i] = _itk[i] = _btk[i] = FALSE; - for (sp = white; *sp; sp++) _wht[(int)*sp] = TRUE; _wht[0] = _wht['\n']; - for (sp = nonam; *sp; sp++) _nin[(int)*sp] = TRUE; _nin[0] = _nin['\n']; - for (sp = endtk; *sp; sp++) _etk[(int)*sp] = TRUE; _etk[0] = _etk['\n']; - for (sp = midtk; *sp; sp++) _itk[(int)*sp] = TRUE; _btk[0] = _btk['\n']; - for (sp = begtk; *sp; sp++) _btk[(int)*sp] = TRUE; _itk[0] = _itk['\n']; + iswhite(i) = notinname(i) = begtoken(i) = intoken(i) = endtoken(i) = FALSE; + for (sp = white; *sp != '\0'; sp++) iswhite (*sp) = TRUE; + for (sp = nonam; *sp != '\0'; sp++) notinname (*sp) = TRUE; + for (sp = begtk; *sp != '\0'; sp++) begtoken (*sp) = TRUE; + for (sp = midtk; *sp != '\0'; sp++) intoken (*sp) = TRUE; + for (sp = endtk; *sp != '\0'; sp++) endtoken (*sp) = TRUE; + iswhite('\0') = iswhite('\n'); + notinname('\0') = notinname('\n'); + begtoken('\0') = begtoken('\n'); + intoken('\0') = intoken('\n'); + endtoken('\0') = endtoken('\n'); } /* * This routine opens the specified file and calls the function * which finds the function and type definitions. */ +node *last_node = NULL; + void find_entries (file, inf) char *file; FILE *inf; { char *cp; - Lang_function *function; - NODE *old_last_node; - extern NODE *last_node; - - - /* Memory leakage here: the memory block pointed by curfile is never - released. The amount of memory leaked here is the sum of the - lengths of the input file names. */ + language *lang; + node *old_last_node; + curfile = savestr (file); /* If user specified a language, use it. */ - function = lang_func; - if (function != NULL) + lang = forced_lang; + if (lang != NULL && lang->function != NULL) { - function (inf); + curlang = lang; + lang->function (inf); + free (curfile); fclose (inf); return; } @@ -1257,17 +1304,19 @@ if (cp != NULL) { cp += 1; - function = get_language_from_suffix (cp); - if (function != NULL) + lang = get_language_from_suffix (cp); + if (lang != NULL && lang->function != NULL) { - function (inf); + curlang = lang; + lang->function (inf); + free (curfile); fclose (inf); return; } } /* Look for sharp-bang as the first two characters. */ - if (readline_internal (&lb, inf) + if (readline_internal (&lb, inf) > 0 && lb.len >= 2 && lb.buffer[0] == '#' && lb.buffer[1] == '!') @@ -1281,19 +1330,19 @@ if (lp != NULL) lp += 1; else - for (lp = lb.buffer+2; *lp != '\0' && isspace (*lp); lp++) - continue; - for (cp = lp; *cp != '\0' && !isspace (*cp); cp++) - continue; + lp = skip_spaces (lb.buffer + 2); + cp = skip_non_spaces (lp); *cp = '\0'; if (strlen (lp) > 0) { - function = get_language_from_interpreter (lp); - if (function != NULL) + lang = get_language_from_interpreter (lp); + if (lang != NULL && lang->function != NULL) { - function (inf); + curlang = lang; + lang->function (inf); fclose (inf); + free (curfile); return; } } @@ -1302,14 +1351,17 @@ /* Try Fortran. */ old_last_node = last_node; + curlang = get_language_from_name ("fortran"); Fortran_functions (inf); /* No Fortran entries found. Try C. */ if (old_last_node == last_node) { rewind (inf); + curlang = get_language_from_name (cplusplus ? "c++" : "c"); default_C_entries (inf); } + free (curfile); fclose (inf); return; } @@ -1324,12 +1376,12 @@ int lno; /* line number */ long cno; /* character number */ { - register NODE *np; + register node *np; if (CTAGS && name == NULL) return; - np = xnew (1, NODE); + np = xnew (1, node); /* If ctags mode, change name "main" to M. */ if (CTAGS && !cxref_style && streq (name, "main")) @@ -1366,19 +1418,23 @@ add_node (np, &head); } -/* Date: Wed, 22 Jan 1997 02:56:31 -0500 - * From: Sam Kendall +/* Date: Wed, 22 Jan 1997 02:56:31 -0500 [last amended 18 Sep 1997] + * From: Sam Kendall * Subject: Proposal for firming up the TAGS format specification * To: F.Potorti@cnuce.cnr.it * * pfnote should emit the optimized form [unnamed tag] only if: - * 1. name does not contain any of the characters " \t\r\n()"; + * 1. name does not contain any of the characters " \t\r\n(),;"; * 2. linestart contains name as either a rightmost, or rightmost but * one character, substring; * 3. the character, if any, immediately before name in linestart must - * be one of the characters " \t()"; + * be one of the characters " \t(),;"; * 4. the character, if any, immediately after name in linestart must - * also be one of the characters " \t()". + * also be one of the characters " \t(),;". + * + * The real implementation uses the notinname() macro, which recognises + * characters slightly different form " \t\r\n(),;". See the variable + * `nonam'. */ #define traditional_tag_style TRUE void @@ -1424,18 +1480,18 @@ * recurse on left children, iterate on right children. */ void -free_tree (node) - register NODE *node; +free_tree (np) + register node *np; { - while (node) + while (np) { - register NODE *node_right = node->right; - free_tree (node->left); - if (node->name != NULL) - free (node->name); - free (node->pat); - free ((char *) node); - node = node_right; + register node *node_right = np->right; + free_tree (np->left); + if (np->name != NULL) + free (np->name); + free (np->pat); + free (np); + np = node_right; } } @@ -1448,18 +1504,17 @@ * add_node is the only function allowed to add nodes, so it can * maintain state. */ -NODE *last_node = NULL; void -add_node (node, cur_node_p) - NODE *node, **cur_node_p; +add_node (np, cur_node_p) + node *np, **cur_node_p; { register int dif; - register NODE *cur_node = *cur_node_p; + register node *cur_node = *cur_node_p; if (cur_node == NULL) { - *cur_node_p = node; - last_node = node; + *cur_node_p = np; + last_node = np; return; } @@ -1468,13 +1523,13 @@ /* Etags Mode */ if (last_node == NULL) fatal ("internal error in add_node", (char *)NULL); - last_node->right = node; - last_node = node; + last_node->right = np; + last_node = np; } else { /* Ctags Mode */ - dif = strcmp (node->name, cur_node->name); + dif = strcmp (np->name, cur_node->name); /* * If this tag name matches an existing one, then @@ -1482,12 +1537,12 @@ */ if (!dif) { - if (streq (node->file, cur_node->file)) + if (streq (np->file, cur_node->file)) { if (!no_warnings) { fprintf (stderr, "Duplicate entry in file %s, line %d: %s\n", - node->file, lineno, node->name); + np->file, lineno, np->name); fprintf (stderr, "Second entry ignored\n"); } } @@ -1496,64 +1551,64 @@ fprintf (stderr, "Duplicate entry in files %s and %s: %s (Warning only)\n", - node->file, cur_node->file, node->name); + np->file, cur_node->file, np->name); cur_node->been_warned = TRUE; } return; } /* Actually add the node */ - add_node (node, dif < 0 ? &cur_node->left : &cur_node->right); + add_node (np, dif < 0 ? &cur_node->left : &cur_node->right); } } void -put_entries (node) - register NODE *node; +put_entries (np) + register node *np; { register char *sp; - if (node == NULL) + if (np == NULL) return; /* Output subentries that precede this one */ - put_entries (node->left); + put_entries (np->left); /* Output this entry */ if (!CTAGS) { - if (node->name != NULL) + if (np->name != NULL) fprintf (tagf, "%s\177%s\001%d,%ld\n", - node->pat, node->name, node->lno, node->cno); + np->pat, np->name, np->lno, np->cno); else fprintf (tagf, "%s\177%d,%ld\n", - node->pat, node->lno, node->cno); + np->pat, np->lno, np->cno); } else { - if (node->name == NULL) + if (np->name == NULL) error ("internal error: NULL name in ctags mode.", (char *)NULL); if (cxref_style) { if (vgrind_style) fprintf (stdout, "%s %s %d\n", - node->name, node->file, (node->lno + 63) / 64); + np->name, np->file, (np->lno + 63) / 64); else fprintf (stdout, "%-16s %3d %-16s %s\n", - node->name, node->lno, node->file, node->pat); + np->name, np->lno, np->file, np->pat); } else { - fprintf (tagf, "%s\t%s\t", node->name, node->file); - - if (node->is_func) + fprintf (tagf, "%s\t%s\t", np->name, np->file); + + if (np->is_func) { /* a function */ putc (searchar, tagf); putc ('^', tagf); - for (sp = node->pat; *sp; sp++) + for (sp = np->pat; *sp; sp++) { if (*sp == '\\' || *sp == searchar) putc ('\\', tagf); @@ -1563,26 +1618,25 @@ } else { /* a typedef; text pattern inadequate */ - fprintf (tagf, "%d", node->lno); + fprintf (tagf, "%d", np->lno); } putc ('\n', tagf); } } /* Output subentries that follow this one */ - put_entries (node->right); + put_entries (np->right); } /* Length of a number's decimal representation. */ +int number_len PP ((long num)); int number_len (num) long num; { - int len = 0; - if (!num) - return 1; - for (; num; num /= 10) - ++len; + int len = 1; + while ((num /= 10) > 0) + len += 1; return len; } @@ -1594,25 +1648,24 @@ * backward compatibility. */ int -total_size_of_entries (node) - register NODE *node; +total_size_of_entries (np) + register node *np; { register int total; - if (node == NULL) + if (np == NULL) return 0; - total = 0; - for (; node; node = node->right) + for (total = 0; np != NULL; np = np->right) { /* Count left subentries. */ - total += total_size_of_entries (node->left); + total += total_size_of_entries (np->left); /* Count this entry */ - total += strlen (node->pat) + 1; - total += number_len ((long) node->lno) + 1 + number_len (node->cno) + 1; - if (node->name != NULL) - total += 1 + strlen (node->name); /* \001name */ + total += strlen (np->pat) + 1; + total += number_len ((long) np->lno) + 1 + number_len (np->cno) + 1; + if (np->name != NULL) + total += 1 + strlen (np->name); /* \001name */ } return total; @@ -1703,7 +1756,7 @@ static int hash (str, len) register char *str; - register unsigned int len; + register unsigned int len; { static unsigned char hash_table[] = { @@ -1719,11 +1772,12 @@ 117, 117, 117, 117, 117, 117, 117, 24, 19, 43, 2, 35, 3, 10, 117, 26, 117, 117, 9, 20, 35, 9, 61, 117, 40, 52, 10, 57, 3, 117, - 117, 117, 117, 117, 117, 117, 117, 117, + 117, 117, 117, 117, 117, 117, 117, 117 }; - return len + hash_table[(int)(str[2])] + hash_table[(int)(str[0])]; + return len + hash_table[(int) str[2]] + hash_table[(int) str[0]]; } +struct C_stab_entry * in_word_set PP ((char *str, unsigned int len)); struct C_stab_entry * in_word_set (str, len) register char *str; @@ -1814,6 +1868,7 @@ /* ending time is 10:15:52 */ /*%>*/ +enum sym_type C_symtype PP ((char *str, int len, int c_ext)); enum sym_type C_symtype (str, len, c_ext) char *str; @@ -1929,9 +1984,9 @@ int lineno; long linepos; char *buffer; -} TOKEN; -TOKEN tok; /* latest token read */ - +} token; + +token tok; /* latest token read */ /* * Set this to TRUE, and the next token considered is called a function. @@ -1971,12 +2026,13 @@ * objdef IN OUT * next_token_is_func IN OUT */ - +bool consider_token PP ((char *str, int len, int c, int c_ext, + int cblev, int parlev, bool *is_func_or_var)); bool consider_token (str, len, c, c_ext, cblev, parlev, is_func_or_var) register char *str; /* IN: token pointer */ register int len; /* IN: token length */ - register char c; /* IN: first char after the token */ + register int c; /* IN: first char after the token */ int c_ext; /* IN: C extensions mask */ int cblev; /* IN: curly brace level */ int parlev; /* IN: parenthesis level */ @@ -2242,7 +2298,7 @@ #define othlinepos (lbs[1-curndx].linepos) #define newlinepos (lbs[newndx].linepos) -#define CNL_SAVE_DEFINEDEF \ +#define CNL_SAVE_DEFINEDEF() \ do { \ curlinepos = charno; \ lineno++; \ @@ -2253,9 +2309,9 @@ newndx = curndx; \ } while (0) -#define CNL \ +#define CNL() \ do { \ - CNL_SAVE_DEFINEDEF; \ + CNL_SAVE_DEFINEDEF(); \ if (savetok.valid) \ { \ tok = savetok; \ @@ -2265,6 +2321,7 @@ } while (0) +void make_C_tag PP ((bool isfun)); void make_C_tag (isfun) bool isfun; @@ -2310,9 +2367,10 @@ int parlev; /* current parenthesis level */ bool incomm, inquote, inchar, quotednl, midtoken; bool cplpl, cjava; - TOKEN savetok; /* token saved during preprocessor handling */ - - + token savetok; /* token saved during preprocessor handling */ + + + tokoff = toklen = 0; /* keep compiler quiet */ curndx = newndx = 0; lineno = 0; charno = 0; @@ -2363,7 +2421,7 @@ case '\0': /* Newlines inside comments do not end macro definitions in traditional cpp. */ - CNL_SAVE_DEFINEDEF; + CNL_SAVE_DEFINEDEF (); break; } continue; @@ -2379,7 +2437,7 @@ /* Newlines inside strings do not end macro definitions in traditional cpp, even though compilers don't usually accept them. */ - CNL_SAVE_DEFINEDEF; + CNL_SAVE_DEFINEDEF (); break; } continue; @@ -2390,7 +2448,7 @@ { case '\0': /* Hmmm, something went wrong. */ - CNL; + CNL (); /* FALLTHRU */ case '\'': inchar = FALSE; @@ -2903,9 +2961,9 @@ } /* If a macro spans multiple lines don't reset its state. */ if (quotednl) - CNL_SAVE_DEFINEDEF; + CNL_SAVE_DEFINEDEF (); else - CNL; + CNL (); break; } /* switch (c) */ @@ -2963,10 +3021,35 @@ C_entries (YACC, inf); } +/* A useful macro. */ +#define LOOP_ON_INPUT_LINES(file_pointer, line_buffer, char_pointer) \ + for (lineno = charno = 0; /* loop initialization */ \ + !feof (file_pointer) /* loop test */ \ + && (lineno++, /* instructions at start of loop */ \ + linecharno = charno, \ + charno += readline (&line_buffer, file_pointer), \ + char_pointer = lb.buffer, \ + TRUE); \ + ) + + +/* + * Read a file, but do no processing. This is used to do regexp + * matching on files that have no language defined. + */ +void +just_read_file (inf) + FILE *inf; +{ + register char *dummy; + + LOOP_ON_INPUT_LINES (inf, lb, dummy) + continue; +} + /* Fortran parsing */ -char *dbp; - +bool tail PP ((char *cp)); bool tail (cp) char *cp; @@ -2986,13 +3069,11 @@ void takeprec () { - while (isspace (*dbp)) - dbp++; + dbp = skip_spaces (dbp); if (*dbp != '*') return; dbp++; - while (isspace (*dbp)) - dbp++; + dbp = skip_spaces (dbp); if (strneq (dbp, "(*)", 3)) { dbp += 3; @@ -3008,14 +3089,14 @@ while (isdigit (*dbp)); } +void getit PP ((FILE *inf)); void getit (inf) FILE *inf; { register char *cp; - while (isspace (*dbp)) - dbp++; + dbp = skip_spaces (dbp); if (*dbp == '\0') { lineno++; @@ -3025,39 +3106,28 @@ if (dbp[5] != '&') return; dbp += 6; - while (isspace (*dbp)) - dbp++; + dbp = skip_spaces (dbp); } if (!isalpha (*dbp) && *dbp != '_' && *dbp != '$') return; - for (cp = dbp + 1; - (*cp - && (isalpha (*cp) || isdigit (*cp) || (*cp == '_') || (*cp == '$'))); - cp++) + for (cp = dbp + 1; *cp && intoken (*cp); cp++) continue; pfnote ((CTAGS) ? savenstr (dbp, cp-dbp) : NULL, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); } + void Fortran_functions (inf) FILE *inf; { - lineno = 0; - charno = 0; - - while (!feof (inf)) + LOOP_ON_INPUT_LINES (inf, lb, dbp) { - lineno++; - linecharno = charno; - charno += readline (&lb, inf); - dbp = lb.buffer; if (*dbp == '%') dbp++; /* Ratfor escape to fortran */ - while (isspace (*dbp)) - dbp++; + dbp = skip_spaces (dbp); if (*dbp == '\0') continue; switch (lowcase (*dbp)) @@ -3081,8 +3151,7 @@ case 'd': if (tail ("double")) { - while (isspace (*dbp)) - dbp++; + dbp = skip_spaces (dbp); if (*dbp == '\0') continue; if (tail ("precision")) @@ -3091,8 +3160,7 @@ } break; } - while (isspace (*dbp)) - dbp++; + dbp = skip_spaces (dbp); if (*dbp == '\0') continue; switch (lowcase (*dbp)) @@ -3133,16 +3201,8 @@ { register char *cp; - lineno = 0; - charno = 0; - - while (!feof (inf)) + LOOP_ON_INPUT_LINES (inf, lb, cp) { - lineno++; - linecharno = charno; - charno += readline (&lb, inf); - cp = lb.buffer; - /* If first char is alphabetic or one of [_.$], test for colon following identifier. */ if (isalpha (*cp) || *cp == '_' || *cp == '.' || *cp == '$') @@ -3163,7 +3223,9 @@ /* * Perl support by Bart Robinson + * enhanced by Michael Ernst * Perl sub names: look for /^sub[ \t\n]+[^ \t\n{]+/ + * Perl variable names: /^(my|local).../ */ void Perl_functions (inf) @@ -3171,23 +3233,95 @@ { register char *cp; - lineno = 0; - charno = 0; - - while (!feof (inf)) + LOOP_ON_INPUT_LINES (inf, lb, cp) { - lineno++; - linecharno = charno; - charno += readline (&lb, inf); + if (*cp++ == 's' + && *cp++ == 'u' + && *cp++ == 'b' && isspace (*cp++)) + { + cp = skip_spaces (cp); + if (*cp != '\0') + { + while (*cp != '\0' + && !isspace (*cp) && *cp != '{' && *cp != '(') + cp++; + pfnote ((CTAGS) ? savenstr(lb.buffer, cp-lb.buffer) : NULL, TRUE, + lb.buffer, cp - lb.buffer + 1, lineno, linecharno); + } + } + else if (globals /* only if tagging global vars is enabled */ + && ((cp = lb.buffer, + *cp++ == 'm' + && *cp++ == 'y') + || (cp = lb.buffer, + *cp++ == 'l' + && *cp++ == 'o' + && *cp++ == 'c' + && *cp++ == 'a' + && *cp++ == 'l')) + && (*cp == '(' || isspace (*cp))) + { + /* After "my" or "local", but before any following paren or space. */ + char *varname = NULL; + + cp = skip_spaces (cp); + if (*cp == '$' || *cp == '@' || *cp == '%') + { + char* varstart = ++cp; + while (isalnum (*cp) || *cp == '_') + cp++; + varname = savenstr (varstart, cp-varstart); + } + else + { + /* Should be examining a variable list at this point; + could insist on seeing an open parenthesis. */ + while (*cp != '\0' && *cp != ';' && *cp != '=' && *cp != ')') + cp++; + } + + /* Perhaps I should back cp up one character, so the TAGS table + doesn't mention (and so depend upon) the following char. */ + pfnote ((CTAGS) ? savenstr (lb.buffer, cp-lb.buffer) : varname, + FALSE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); + } + } +} + +/* + * Python support by Eric S. Raymond + * Look for /^def[ \t\n]+[^ \t\n(:]+/ or /^class[ \t\n]+[^ \t\n(:]+/ + */ +void +Python_functions (inf) + FILE *inf; +{ + register char *cp; + + LOOP_ON_INPUT_LINES (inf, lb, cp) + { + if (*cp++ == 'd' + && *cp++ == 'e' + && *cp++ == 'f' && isspace (*cp++)) + { + cp = skip_spaces (cp); + while (*cp != '\0' && !isspace (*cp) && *cp != '(' && *cp != ':') + cp++; + pfnote ((char *) NULL, TRUE, + lb.buffer, cp - lb.buffer + 1, lineno, linecharno); + } + cp = lb.buffer; - - if (*cp++ == 's' && *cp++ == 'u' && *cp++ == 'b' && isspace (*cp++)) + if (*cp++ == 'c' + && *cp++ == 'l' + && *cp++ == 'a' + && *cp++ == 's' + && *cp++ == 's' && isspace (*cp++)) { - while (*cp && isspace (*cp)) + cp = skip_spaces (cp); + while (*cp != '\0' && !isspace (*cp) && *cp != '(' && *cp != ':') cp++; - while (*cp && ! isspace (*cp) && *cp != '{') - cp++; - pfnote ((CTAGS) ? savenstr (lb.buffer, cp-lb.buffer) : NULL, TRUE, + pfnote ((char *) NULL, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); } } @@ -3202,30 +3336,23 @@ Cobol_paragraphs (inf) FILE *inf; { - register char *cp; - - lineno = 0; - charno = 0; - - while (!feof (inf)) + register char *bp, *ep; + + LOOP_ON_INPUT_LINES (inf, lb, bp) { - lineno++; - linecharno = charno; - charno += readline (&lb, inf); - if (lb.len < 9) continue; - dbp = lb.buffer + 8; + bp += 8; /* If eoln, compiler option or comment ignore whole line. */ - if (dbp[-1] != ' ' || !isalnum (dbp[0])) + if (bp[-1] != ' ' || !isalnum (bp[0])) continue; - for (cp = dbp; isalnum (*cp) || *cp == '-'; cp++) + for (ep = bp; isalnum (*ep) || *ep == '-'; ep++) continue; - if (*cp++ == '.') - pfnote ((CTAGS) ? savenstr (dbp, cp-dbp) : NULL, TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); + if (*ep++ == '.') + pfnote ((CTAGS) ? savenstr (bp, ep-bp) : NULL, TRUE, + lb.buffer, ep - lb.buffer + 1, lineno, linecharno); } } @@ -3242,7 +3369,7 @@ Pascal_functions (inf) FILE *inf; { - struct linebuffer tline; /* mostly copied from C_entries */ + linebuffer tline; /* mostly copied from C_entries */ long save_lcno; int save_lineno, save_len; char c, *cp, *namebuf; @@ -3259,11 +3386,12 @@ is a FORWARD/EXTERN to be ignored, or whether it is a real tag */ + save_lcno = save_lineno = save_len = 0; /* keep compiler quiet */ + namebuf = NULL; /* keep compiler quiet */ lineno = 0; charno = 0; dbp = lb.buffer; *dbp = '\0'; - save_len = 0; initbuffer (&tline); incomment = inquote = FALSE; @@ -3272,8 +3400,8 @@ inparms = FALSE; /* found '(' after "proc" */ verify_tag = FALSE; /* check if "extern" is ahead */ - /* long main loop to get next char */ - while (!feof (inf)) + + while (!feof (inf)) /* long main loop to get next char */ { c = *dbp++; if (c == '\0') /* if end of line */ @@ -3284,8 +3412,8 @@ dbp = lb.buffer; if (*dbp == '\0') continue; - if (!((found_tag && verify_tag) || - get_tagname)) + if (!((found_tag && verify_tag) + || get_tagname)) c = *dbp++; /* only if don't need *dbp pointing to the beginning of the name of the procedure or function */ @@ -3414,6 +3542,7 @@ * lisp tag functions * look for (def or (DEF, quote or QUOTE */ +int L_isdef PP ((char *strp)); int L_isdef (strp) register char *strp; @@ -3422,19 +3551,20 @@ && (strp[2] == 'e' || strp[2] == 'E') && (strp[3] == 'f' || strp[3] == 'F')); } - +int L_isquote PP ((char *strp)); int L_isquote (strp) register char *strp; { - return ((*(++strp) == 'q' || *strp == 'Q') - && (*(++strp) == 'u' || *strp == 'U') - && (*(++strp) == 'o' || *strp == 'O') - && (*(++strp) == 't' || *strp == 'T') - && (*(++strp) == 'e' || *strp == 'E') - && isspace (*(++strp))); + return ((*++strp == 'q' || *strp == 'Q') + && (*++strp == 'u' || *strp == 'U') + && (*++strp == 'o' || *strp == 'O') + && (*++strp == 't' || *strp == 'T') + && (*++strp == 'e' || *strp == 'E') + && isspace (*++strp)); } +void L_getit PP ((void)); void L_getit () { @@ -3442,12 +3572,15 @@ if (*dbp == '\'') /* Skip prefix quote */ dbp++; - else if (*dbp == '(' && L_isquote (dbp)) /* Skip "(quote " */ + else if (*dbp == '(') { - dbp += 7; - while (isspace (*dbp)) - dbp++; + if (L_isquote (dbp)) + dbp += 7; /* Skip "(quote " */ + else + dbp += 1; /* Skip "(" before name in (defstruct (foo)) */ + dbp = skip_spaces (dbp); } + for (cp = dbp /*+1*/; *cp != '\0' && *cp != '(' && *cp != ' ' && *cp != ')'; cp++) @@ -3463,23 +3596,14 @@ Lisp_functions (inf) FILE *inf; { - lineno = 0; - charno = 0; - - while (!feof (inf)) + LOOP_ON_INPUT_LINES (inf, lb, dbp) { - lineno++; - linecharno = charno; - charno += readline (&lb, inf); - dbp = lb.buffer; if (dbp[0] == '(') { if (L_isdef (dbp)) { - while (!isspace (*dbp)) - dbp++; - while (isspace (*dbp)) - dbp++; + dbp = skip_non_spaces (dbp); + dbp = skip_spaces (dbp); L_getit (); } else @@ -3487,7 +3611,7 @@ /* Check for (foo::defmumble name-defined ... */ do dbp++; - while (*dbp && !isspace (*dbp) + while (*dbp != '\0' && !isspace (*dbp) && *dbp != ':' && *dbp != '(' && *dbp != ')'); if (*dbp == ':') { @@ -3497,10 +3621,8 @@ if (L_isdef (dbp - 1)) { - while (!isspace (*dbp)) - dbp++; - while (isspace (*dbp)) - dbp++; + dbp = skip_non_spaces (dbp); + dbp = skip_spaces (dbp); L_getit (); } } @@ -3518,24 +3640,18 @@ Postscript_functions (inf) FILE *inf; { - lineno = 0; - charno = 0; - - while (!feof (inf)) + register char *bp, *ep; + + LOOP_ON_INPUT_LINES (inf, lb, bp) { - lineno++; - linecharno = charno; - charno += readline (&lb, inf); - dbp = lb.buffer; - if (dbp[0] == '/') + if (bp[0] == '/') { - register char *cp; - for (cp = dbp+1; - *cp != '\0' && *cp != ' ' && *cp != '{'; - cp++) + for (ep = bp+1; + *ep != '\0' && *ep != ' ' && *ep != '{'; + ep++) continue; - pfnote ((CTAGS) ? savenstr (dbp, cp-dbp) : NULL, TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); + pfnote ((CTAGS) ? savenstr (bp, ep-bp) : NULL, TRUE, + lb.buffer, ep - lb.buffer + 1, lineno, linecharno); } } } @@ -3549,45 +3665,34 @@ * look for (set! xyzzy */ -void get_scheme (); +void get_scheme PP ((void)); void Scheme_functions (inf) FILE *inf; { - lineno = 0; - charno = 0; - - while (!feof (inf)) + LOOP_ON_INPUT_LINES (inf, lb, dbp) { - lineno++; - linecharno = charno; - charno += readline (&lb, inf); - dbp = lb.buffer; - if (dbp[0] == '(' && - (dbp[1] == 'D' || dbp[1] == 'd') && - (dbp[2] == 'E' || dbp[2] == 'e') && - (dbp[3] == 'F' || dbp[3] == 'f')) + if (dbp[0] == '(' + && (dbp[1] == 'D' || dbp[1] == 'd') + && (dbp[2] == 'E' || dbp[2] == 'e') + && (dbp[3] == 'F' || dbp[3] == 'f')) { - while (!isspace (*dbp)) - dbp++; + dbp = skip_non_spaces (dbp); /* Skip over open parens and white space */ - while (*dbp && (isspace (*dbp) || *dbp == '(')) + while (isspace (*dbp) || *dbp == '(') dbp++; get_scheme (); } - if (dbp[0] == '(' && - (dbp[1] == 'S' || dbp[1] == 's') && - (dbp[2] == 'E' || dbp[2] == 'e') && - (dbp[3] == 'T' || dbp[3] == 't') && - (dbp[4] == '!' || dbp[4] == '!') && - (isspace (dbp[5]))) + if (dbp[0] == '(' + && (dbp[1] == 'S' || dbp[1] == 's') + && (dbp[2] == 'E' || dbp[2] == 'e') + && (dbp[3] == 'T' || dbp[3] == 't') + && (dbp[4] == '!' || dbp[4] == '!') + && (isspace (dbp[5]))) { - while (!isspace (*dbp)) - dbp++; - /* Skip over white space */ - while (isspace (*dbp)) - dbp++; + dbp = skip_non_spaces (dbp); + dbp = skip_spaces (dbp); get_scheme (); } } @@ -3602,7 +3707,7 @@ return; /* Go till you get to white space or a syntactic break */ for (cp = dbp + 1; - *cp && *cp != '(' && *cp != ')' && !isspace (*cp); + *cp != '\0' && *cp != '(' && *cp != ')' && !isspace (*cp); cp++) continue; pfnote ((CTAGS) ? savenstr (dbp, cp-dbp) : NULL, TRUE, @@ -3629,9 +3734,9 @@ :chapter:section:subsection:subsubsection:eqno:label:ref:cite:bibitem\ :part:appendix:entry:index"; -void TEX_mode (); -struct TEX_tabent *TEX_decode_env (); -int TEX_Token (); +void TEX_mode PP ((FILE *inf)); +struct TEX_tabent *TEX_decode_env PP ((char *evarname, char *defenv)); +int TEX_Token PP ((char *cp)); char TEX_esc = '\\'; char TEX_opgrp = '{'; @@ -3644,12 +3749,9 @@ TeX_functions (inf) FILE *inf; { - char *lasthit; + char *cp, *lasthit; register int i; - lineno = 0; - charno = 0; - /* Select either \ or ! as escape character. */ TEX_mode (inf); @@ -3657,19 +3759,16 @@ if (!TEX_toktab) TEX_toktab = TEX_decode_env ("TEXTAGS", TEX_defenv); - while (!feof (inf)) - { /* Scan each line in file */ - lineno++; - linecharno = charno; - charno += readline (&lb, inf); - dbp = lb.buffer; - lasthit = dbp; - while (dbp = etags_strchr (dbp, TEX_esc)) /* Look at each esc in line */ + LOOP_ON_INPUT_LINES (inf, lb, cp) + { + lasthit = cp; + /* Look at each esc in line. */ + while ((cp = etags_strchr (cp, TEX_esc)) != NULL) { - if (!*(++dbp)) + if (*++cp == '\0') break; - linecharno += dbp - lasthit; - lasthit = dbp; + linecharno += cp - lasthit; + lasthit = cp; i = TEX_Token (lasthit); if (i >= 0) { @@ -3749,7 +3848,7 @@ /* Allocate a token table */ for (size = 1, p = env; p;) - if ((p = etags_strchr (p, ':')) && *(++p)) + if ((p = etags_strchr (p, ':')) && *++p != '\0') size++; /* Add 1 to leave room for null terminator. */ tab = xnew (size + 1, struct TEX_tabent); @@ -3782,7 +3881,7 @@ /* If the text at CP matches one of the tag-defining TeX command names, return the pointer to the first occurrence of that command in TEX_toktab. Otherwise return -1. - Keep the capital `T' in `Token' for dumb truncating compilers + Keep the capital `T' in `token' for dumb truncating compilers (this distinguishes it from `TEX_toktab' */ int TEX_Token (cp) @@ -3802,16 +3901,15 @@ * Assumes that the predicate starts at column 0. * Only the first clause of a predicate is added. */ -int prolog_pred (); -void prolog_skip_comment (); -int prolog_atom (); -int eat_white (); +int prolog_pred PP ((char *s, char *last)); +void prolog_skip_comment PP ((linebuffer *plb, FILE *inf)); +int prolog_atom PP ((char *s, int pos)); void Prolog_functions (inf) FILE *inf; { - char * last; + char *cp, *last; int len; int allocated; @@ -3819,32 +3917,24 @@ len = 0; last = NULL; - lineno = 0; - linecharno = 0; - charno = 0; - - while (!feof (inf)) + LOOP_ON_INPUT_LINES (inf, lb, cp) { - lineno++; - linecharno += charno; - charno = readline (&lb, inf); - dbp = lb.buffer; - if (dbp[0] == '\0') /* Empty line */ + if (cp[0] == '\0') /* Empty line */ + continue; + else if (isspace (cp[0])) /* Not a predicate */ continue; - else if (isspace (dbp[0])) /* Not a predicate */ - continue; - else if (dbp[0] == '/' && dbp[1] == '*') /* comment. */ + else if (cp[0] == '/' && cp[1] == '*') /* comment. */ prolog_skip_comment (&lb, inf); - else if (len = prolog_pred (dbp, last)) + else if ((len = prolog_pred (cp, last)) > 0) { /* Predicate. Store the function name so that we only generate a tag for the first clause. */ if (last == NULL) last = xnew(len + 1, char); else if (len + 1 > allocated) - last = (char *) xrealloc(last, len + 1); + last = xrnew (last, len + 1, char); allocated = len + 1; - strncpy (last, dbp, len); + strncpy (last, cp, len); last[len] = '\0'; } } @@ -3853,7 +3943,7 @@ void prolog_skip_comment (plb, inf) - struct linebuffer *plb; + linebuffer *plb; FILE *inf; { char *cp; @@ -3892,7 +3982,7 @@ return 0; len = pos; - pos += eat_white (s, pos); + pos = skip_spaces (s + pos) - s; if ((s[pos] == '(') || (s[pos] == '.')) { @@ -3970,22 +4060,6 @@ else return -1; } - -/* Consume whitespace. Return the number of bytes eaten. */ -int -eat_white (s, pos) - char *s; - int pos; -{ - int origpos = pos; - - origpos = pos; - - while (isspace (s[pos])) - pos++; - - return pos - origpos; -} /* * Support for Erlang -- Anders Lindgren, Feb 1996. @@ -3994,15 +4068,15 @@ * * Assumes that Erlang functions start at column 0. */ -int erlang_func (); -void erlang_attribute (); -int erlang_atom (); +int erlang_func PP ((char *s, char *last)); +void erlang_attribute PP ((char *s)); +int erlang_atom PP ((char *s, int pos)); void Erlang_functions (inf) FILE *inf; { - char * last; + char *cp, *last; int len; int allocated; @@ -4010,30 +4084,22 @@ len = 0; last = NULL; - lineno = 0; - linecharno = 0; - charno = 0; - - while (!feof (inf)) + LOOP_ON_INPUT_LINES (inf, lb, cp) { - lineno++; - linecharno += charno; - charno = readline (&lb, inf); - dbp = lb.buffer; - if (dbp[0] == '\0') /* Empty line */ + if (cp[0] == '\0') /* Empty line */ continue; - else if (isspace (dbp[0])) /* Not function nor attribute */ + else if (isspace (cp[0])) /* Not function nor attribute */ + continue; + else if (cp[0] == '%') /* comment */ continue; - else if (dbp[0] == '%') /* comment */ - continue; - else if (dbp[0] == '"') /* Sometimes, strings start in column one */ + else if (cp[0] == '"') /* Sometimes, strings start in column one */ continue; - else if (dbp[0] == '-') /* attribute, e.g. "-define" */ + else if (cp[0] == '-') /* attribute, e.g. "-define" */ { - erlang_attribute (dbp); + erlang_attribute (cp); last = NULL; } - else if (len = erlang_func (dbp, last)) + else if ((len = erlang_func (cp, last)) > 0) { /* * Function. Store the function name so that we only @@ -4042,9 +4108,9 @@ if (last == NULL) last = xnew (len + 1, char); else if (len + 1 > allocated) - last = (char *) xrealloc (last, len + 1); + last = xrnew (last, len + 1, char); allocated = len + 1; - strncpy (last, dbp, len); + strncpy (last, cp, len); last[len] = '\0'; } } @@ -4074,7 +4140,7 @@ return 0; len = pos; - pos += eat_white (s, pos); + pos = skip_spaces (s + pos) - s; /* Save only the first clause. */ if (s[pos++] == '(' @@ -4109,13 +4175,14 @@ if (strneq (s, "-define", 7) || strneq (s, "-record", 7)) { - pos = 7 + eat_white (s, pos); + pos = skip_spaces (s + 7) - s; if (s[pos++] == '(') { - pos += eat_white (s, pos); - if (len = erlang_atom (s, pos)) - pfnote ((CTAGS) ? savenstr (& s[pos], len) : NULL, TRUE, - s, pos + len, lineno, linecharno); + pos = skip_spaces (s + pos) - s; + len = erlang_atom (s, pos); + if (len != 0) + pfnote ((CTAGS) ? savenstr (& s[pos], len) : NULL, TRUE, + s, pos + len, lineno, linecharno); } } return; @@ -4173,12 +4240,14 @@ } #ifdef ETAGS_REGEXPS + /* Take a string like "/blah/" and turn it into "blah", making sure that the first and last characters are the same, and handling quoted separator characters. Actually, stops on the occurrence of an unquoted separator. Also turns "\t" into a Tab character. Returns pointer to terminating separator. Works in place. Null terminates name string. */ +char * scan_separators PP ((char *name)); char * scan_separators (name) char *name; @@ -4217,60 +4286,85 @@ } /* Look at the argument of --regex or --no-regex and do the right - thing. */ + thing. Same for each line of a regexp file. */ void analyse_regex (regex_arg) char *regex_arg; { - struct stat stat_buf; - if (regex_arg == NULL) - { - /* Remove existing regexps. */ - num_patterns = 0; - patterns = NULL; - return; - } - if (regex_arg[0] == '\0') - { - error ("missing regexp", (char *)NULL); - return; - } - if (regex_arg[0] == '@' - && stat (regex_arg + 1, &stat_buf) == 0) + free_patterns (); /* --no-regex: remove existing regexps */ + + /* A real --regexp option or a line in a regexp file. */ + switch (regex_arg[0]) { - FILE *regexfp; - struct linebuffer regexbuf; - char *regexfile = regex_arg + 1; - - /* regexfile is a file containing regexps, one per line. */ - regexfp = fopen (regexfile, "r"); - if (regexfp == NULL) - { - perror (regexfile); + /* Comments in regexp file or null arg to --regex. */ + case '\0': + case ' ': + case '\t': + break; + + /* Read a regex file. This is recursive and may result in a + loop, which will stop when the file descriptors are exhausted. */ + case '@': + { + FILE *regexfp; + linebuffer regexbuf; + char *regexfile = regex_arg + 1; + + /* regexfile is a file containing regexps, one per line. */ + regexfp = fopen (regexfile, "r"); + if (regexfp == NULL) + { + pfatal (regexfile); + return; + } + initbuffer (®exbuf); + while (readline_internal (®exbuf, regexfp) > 0) + analyse_regex (regexbuf.buffer); + free (regexbuf.buffer); + fclose (regexfp); + } + break; + + /* Regexp to be used for a specific language only. */ + case '{': + { + language *lang; + char *lang_name = regex_arg + 1; + char *cp; + + for (cp = lang_name; *cp != '}'; cp++) + if (*cp == '\0') + { + error ("unterminated language name in regex: %s", regex_arg); + return; + } + *cp = '\0'; + lang = get_language_from_name (lang_name); + if (lang == NULL) return; - } - initbuffer (®exbuf); - while (readline_internal (®exbuf, regexfp)) - add_regex (regexbuf.buffer); - free (regexbuf.buffer); - fclose (regexfp); - } - else - { - add_regex (regex_arg); + add_regex (cp + 1, lang); + } + break; + + /* Regexp to be used for any language. */ + default: + add_regex (regex_arg, NULL); + break; } } /* Turn a name, which is an ed-style (but Emacs syntax) regular expression, into a real regular expression by compiling it. */ void -add_regex (regexp_pattern) +add_regex (regexp_pattern, lang) char *regexp_pattern; + language *lang; { char *name; const char *err; struct re_pattern_buffer *patbuf; + pattern *pp; if (regexp_pattern[strlen(regexp_pattern)-1] != regexp_pattern[0]) @@ -4299,22 +4393,21 @@ return; } - num_patterns += 1; - if (num_patterns == 1) - patterns = xnew (1, struct pattern); - else - patterns = ((struct pattern *) - xrealloc (patterns, - (num_patterns * sizeof (struct pattern)))); - patterns[num_patterns - 1].pattern = patbuf; - patterns[num_patterns - 1].name_pattern = savestr (name); - patterns[num_patterns - 1].error_signaled = FALSE; + pp = p_head; + p_head = xnew (1, pattern); + p_head->regex = savestr (regexp_pattern); + p_head->p_next = pp; + p_head->language = lang; + p_head->pattern = patbuf; + p_head->name_pattern = savestr (name); + p_head->error_signaled = FALSE; } /* * Do the substitutions indicated by the regular expression and * arguments. */ +char * substitute PP ((char *in, char *out, struct re_registers *regs)); char * substitute (in, out, regs) char *in, *out; @@ -4362,44 +4455,66 @@ return result; } + +/* Deallocate all patterns. */ +void +free_patterns () +{ + pattern *pp; + while (p_head != NULL) + { + pp = p_head->p_next; + free (p_head->regex); + free (p_head->name_pattern); + free (p_head); + p_head = pp; + } + return; +} #endif /* ETAGS_REGEXPS */ /* Initialize a linebuffer for use */ void -initbuffer (linebuffer) - struct linebuffer *linebuffer; +initbuffer (lbp) + linebuffer *lbp; { - linebuffer->size = 200; - linebuffer->buffer = xnew (200, char); + lbp->size = 200; + lbp->buffer = xnew (200, char); } /* - * Read a line of text from `stream' into `linebuffer'. - * Return the number of characters read from `stream', - * which is the length of the line including the newline, if any. + * Read a line of text from `stream' into `lbp', excluding the + * newline or CR-NL, if any. Return the number of characters read from + * `stream', which is the length of the line including the newline. + * + * On DOS or Windows we do not count the CR character, if any, before the + * NL, in the returned length; this mirrors the behavior of emacs on those + * platforms (for text files, it translates CR-NL to NL as it reads in the + * file). */ long -readline_internal (linebuffer, stream) - struct linebuffer *linebuffer; +readline_internal (lbp, stream) + linebuffer *lbp; register FILE *stream; { - char *buffer = linebuffer->buffer; - register char *p = linebuffer->buffer; + char *buffer = lbp->buffer; + register char *p = lbp->buffer; register char *pend; int chars_deleted; - pend = p + linebuffer->size; /* Separate to avoid 386/IX compiler bug. */ + pend = p + lbp->size; /* Separate to avoid 386/IX compiler bug. */ while (1) { register int c = getc (stream); if (p == pend) { - linebuffer->size *= 2; - buffer = (char *) xrealloc (buffer, linebuffer->size); - p += buffer - linebuffer->buffer; - pend = buffer + linebuffer->size; - linebuffer->buffer = buffer; + /* We're at the end of linebuffer: expand it. */ + lbp->size *= 2; + buffer = xrnew (buffer, lbp->size, char); + p += buffer - lbp->buffer; + pend = buffer + lbp->size; + lbp->buffer = buffer; } if (c == EOF) { @@ -4432,39 +4547,43 @@ } *p++ = c; } - linebuffer->len = p - buffer; - - return linebuffer->len + chars_deleted; + lbp->len = p - buffer; + + return lbp->len + chars_deleted; } /* * Like readline_internal, above, but in addition try to match the - * input line against any existing regular expressions. + * input line against relevant regular expressions. */ long -readline (linebuffer, stream) - struct linebuffer *linebuffer; +readline (lbp, stream) + linebuffer *lbp; FILE *stream; { /* Read new line. */ - long result = readline_internal (linebuffer, stream); + long result = readline_internal (lbp, stream); #ifdef ETAGS_REGEXPS - int i; - - /* Match against all listed patterns. */ - if (linebuffer->len > 0) - for (i = 0; i < num_patterns; ++i) + int match; + pattern *pp; + + /* Match against relevant patterns. */ + if (lbp->len > 0) + for (pp = p_head; pp != NULL; pp = pp->p_next) { - int match = re_match (patterns[i].pattern, linebuffer->buffer, - linebuffer->len, 0, &patterns[i].regs); + /* Only use generic regexps or those for the current language. */ + if (pp->language != NULL && pp->language != curlang) + continue; + + match = re_match (pp->pattern, lbp->buffer, lbp->len, 0, &pp->regs); switch (match) { case -2: /* Some error. */ - if (!patterns[i].error_signaled) + if (!pp->error_signaled) { - error ("error while matching pattern %d", i); - patterns[i].error_signaled = TRUE; + error ("error while matching \"%s\"", pp->regex); + pp->error_signaled = TRUE; } break; case -1: @@ -4472,21 +4591,19 @@ break; default: /* Match occurred. Construct a tag. */ - if (patterns[i].name_pattern[0] != '\0') + if (pp->name_pattern[0] != '\0') { /* Make a named tag. */ - char *name = substitute (linebuffer->buffer, - patterns[i].name_pattern, - &patterns[i].regs); + char *name = substitute (lbp->buffer, + pp->name_pattern, &pp->regs); if (name != NULL) - pfnote (name, TRUE, - linebuffer->buffer, match, lineno, linecharno); + pfnote (name, TRUE, lbp->buffer, match, lineno, linecharno); } else { /* Make an unnamed tag. */ pfnote ((char *)NULL, TRUE, - linebuffer->buffer, match, lineno, linecharno); + lbp->buffer, match, lineno, linecharno); } break; } @@ -4495,26 +4612,6 @@ return result; } - -/* - * Read a file, but do no processing. This is used to do regexp - * matching on files that have no language defined. - */ -void -just_read_file (inf) - FILE *inf; -{ - lineno = 0; - charno = 0; - - while (!feof (inf)) - { - ++lineno; - linecharno = charno; - charno += readline (&lb, inf); - } -} - /* * Return a pointer to a space of size strlen(cp)+1 allocated @@ -4552,7 +4649,8 @@ */ char * etags_strrchr (sp, c) - register char *sp, c; + register char *sp; + register int c; { register char *r; @@ -4574,7 +4672,8 @@ */ char * etags_strchr (sp, c) - register char *sp, c; + register char *sp; + register int c; { do { @@ -4584,6 +4683,26 @@ return NULL; } +/* Skip spaces, return new pointer. */ +char * +skip_spaces (cp) + char *cp; +{ + while (isspace (*cp)) /* isspace('\0')==FALSE */ + cp++; + return cp; +} + +/* Skip non spaces, return new pointer. */ +char * +skip_non_spaces (cp) + char *cp; +{ + while (!iswhite (*cp)) /* iswhite('\0')==TRUE */ + cp++; + return cp; +} + /* Print error message and exit. */ void fatal (s1, s2) @@ -4618,7 +4737,7 @@ /* Print error message. `s1' is printf control string, `s2' is arg for it. */ void error (s1, s2) - char *s1, *s2; + const char *s1, *s2; { fprintf (stderr, "%s: ", progname); fprintf (stderr, s1, s2); @@ -4660,16 +4779,7 @@ path = xnew (bufsize, char); } -#if WINDOWSNT - { - /* Convert backslashes to slashes. */ - char *p; - for (p = path; *p != '\0'; p++) - if (*p == '\\') - *p = '/'; - } -#endif - + canonicalize_filename (path); return path; #else /* not HAVE_GETCWD */ @@ -4686,7 +4796,7 @@ return strdup (path); #else /* not MSDOS */ - struct linebuffer path; + linebuffer path; FILE *pipe; initbuffer (&path); @@ -4700,19 +4810,18 @@ #endif /* not HAVE_GETCWD */ } -/* Return a newly allocated string containing the file name - of FILE relative to the absolute directory DIR (which - should end with a slash). */ +/* Return a newly allocated string containing the file name of FILE + relative to the absolute directory DIR (which should end with a slash). */ char * relative_filename (file, dir) char *file, *dir; { - char *fp, *dp, *abs, *res; + char *fp, *dp, *afn, *res; int i; /* Find the common root of file and dir (with a trailing slash). */ - abs = absolute_filename (file, cwd); - fp = abs; + afn = absolute_filename (file, cwd); + fp = afn; dp = dir; while (*fp++ == *dp++) continue; @@ -4732,21 +4841,20 @@ /* Add the file name relative to the common root of file and dir. */ strcat (res, fp + 1); - free (abs); + free (afn); return res; } -/* Return a newly allocated string containing the - absolute file name of FILE given CWD (which should - end with a slash). */ +/* Return a newly allocated string containing the absolute file name + of FILE given DIR (which should end with a slash). */ char * -absolute_filename (file, cwd) - char *file, *cwd; +absolute_filename (file, dir) + char *file, *dir; { char *slashp, *cp, *res; - if (absolutefn (file)) + if (filename_is_absolute (file)) res = savestr (file); #ifdef DOS_NT /* We don't support non-absolute file names with a drive @@ -4755,7 +4863,7 @@ fatal ("%s: relative file names with drive letters not supported", file); #endif else - res = concat (cwd, file, ""); + res = concat (dir, file, ""); /* Delete the "/dirname/.." and "/." substrings. */ slashp = etags_strchr (res, '/'); @@ -4769,7 +4877,7 @@ cp = slashp; do cp--; - while (cp >= res && !absolutefn (cp)); + while (cp >= res && !filename_is_absolute (cp)); if (cp < res) cp = slashp; /* the absolute name begins with "/.." */ #ifdef DOS_NT @@ -4800,42 +4908,63 @@ } /* Return a newly allocated string containing the absolute - file name of dir where FILE resides given CWD (which should + file name of dir where FILE resides given DIR (which should end with a slash). */ char * -absolute_dirname (file, cwd) - char *file, *cwd; +absolute_dirname (file, dir) + char *file, *dir; { char *slashp, *res; char save; -#ifdef DOS_NT - char *p; - - for (p = file; *p != '\0'; p++) - if (*p == '\\') - *p = '/'; -#endif - + + canonicalize_filename (file); slashp = etags_strrchr (file, '/'); if (slashp == NULL) - return savestr (cwd); + return savestr (dir); save = slashp[1]; slashp[1] = '\0'; - res = absolute_filename (file, cwd); + res = absolute_filename (file, dir); slashp[1] = save; return res; } +/* Whether the argument string is an absolute file name. The argument + string must have been canonicalized with canonicalize_filename. */ +bool +filename_is_absolute (fn) + char *fn; +{ + return (fn[0] == '/' +#ifdef DOS_NT + || (isalpha(fn[0]) && fn[1] == ':' && fn[2] == '/') +#endif + ); +} + +/* Translate backslashes into slashes. Works in place. */ +void +canonicalize_filename (fn) + register char *fn; +{ +#ifdef DOS_NT + for (; *fn != '\0'; fn++) + if (*fn == '\\') + *fn = '/'; +#else + /* No action. */ +#endif +} + /* Increase the size of a linebuffer. */ void -grow_linebuffer (bufp, toksize) - struct linebuffer *bufp; +grow_linebuffer (lbp, toksize) + linebuffer *lbp; int toksize; { - while (bufp->size < toksize) - bufp->size *= 2; - bufp->buffer = (char *) xrealloc (bufp->buffer, bufp->size); + while (lbp->size < toksize) + lbp->size *= 2; + lbp->buffer = xrnew (lbp->buffer, lbp->size, char); } /* Like malloc but get fatal error if memory is exhausted. */ diff -r f0deb0c0e6be -r eb5470882647 lib-src/update-autoloads.sh --- a/lib-src/update-autoloads.sh Mon Aug 13 10:00:35 2007 +0200 +++ b/lib-src/update-autoloads.sh Mon Aug 13 10:01:22 2007 +0200 @@ -96,7 +96,8 @@ make_special hyperbole autoloads # make_special ilisp autoloads make_special oobr HYPB_ELC='' autoloads -make_special w3 autoloads +## W3 is a package now +##make_special w3 autoloads dirs= for dir in lisp/*; do diff -r f0deb0c0e6be -r eb5470882647 lib-src/update-elc.sh --- a/lib-src/update-elc.sh Mon Aug 13 10:00:35 2007 +0200 +++ b/lib-src/update-elc.sh Mon Aug 13 10:01:22 2007 +0200 @@ -142,7 +142,8 @@ #make_special ilisp XEmacsELC=custom-load.elc elc make_special ilisp elc make_special oobr HYPB_ELC='' elc -make_special w3 xemacs-w3 +## W3 is a package now. +#make_special w3 xemacs-w3 for dir in $ignore_dirs ; do ignore_pattern="${ignore_pattern}/\\/$dir\\//d diff -r f0deb0c0e6be -r eb5470882647 lisp/ChangeLog --- a/lisp/ChangeLog Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 10:01:22 2007 +0200 @@ -1,3 +1,79 @@ +1997-09-29 Karl M. Hegbloom + + * prim/files.el (auto-mode-alist): make `.cl' a lisp-mode + extension for Franz Allegro CL. + +1997-10-05 Hrvoje Niksic + + * prim/simple.el: Minor docstring and comment changes. Customized + some more. + +1997-10-04 Hrvoje Niksic + + * utils/xemacs-build-report.el (xemacs-build-report): Placed to + maintenance group. + (xemacs-create-build-report): Added an autoload cookie. + + * prim/profile.el (profiling-results): Renamed from + `pretty-print-profiling-info'. + +1997-10-03 Karl M. Hegbloom > + + * custom/cus-edit.el (custom-save-all): Bind `auto-mode-alist' to + nil around the init file handling to prevent unnecessary automagic + processing. + +1997-10-03 Hrvoje Niksic + + * prim/faces.el (face-spec-set): Invoke `init-face-from-resources'. + + * custom/cus-face.el (custom-set-faces): Revert to using + `make-empty-face'. + (custom-declare-face): Ditto. + +1997-10-04 SL Baur + + * prim/modeline.el (modeline-modified-map): Call wrapper function + over `vc-toggle-read-only'. + (modeline-toggle-read-only): New function. + + * prim/files.el (basic-save-buffer): Put guard on call to + `vc-after-save' since someone may wish not to install the vc + package. + + * prim/fill.el (sentence-end-double-space): Fix docstring. + + * cl/cl-seq.el (remq): Reformat and add doc-string. + Suggested by: Karl M. Hegbloom + +1997-10-03 Karl M. Hegbloom + + * packages/func-menu.el: change the countups from message's to + display-message 'progress's so they don't dump in the lossage + buffer. + +1997-10-03 Karl M. Hegbloom + + * psgml/psgml.el (sgml-mode-map): Bind (meta backspace) to + 'backward-kill-word so it works as expected. "\e\C-h" will still + do 'sgml-mark-current-element. + +1997-08-13 Yves BLUSSEAU + + * efs/efs.el (efs-set-file-modes): Fix a bug that cause an error + when using the efs-set-file-modes function on a remote station with + a FTP daemon that don't support the QUOTE function. + +1997-10-02 Colin Rafferty + + * prim/frame.el (default-drag-and-drop-functions): Fixed a typo + that was calling `data' rather than looking at it. + +1997-10-04 SL Baur + + * cl/cl-seq.el (remove): Add docstring. + Suggested by Karl M Hegbloom + 1997-10-02 Colin Rafferty * prim/simple.el (set-fill-column): Used format to create the diff -r f0deb0c0e6be -r eb5470882647 lisp/README --- a/lisp/README Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/README Mon Aug 13 10:01:22 2007 +0200 @@ -71,7 +71,7 @@ x11 X Window System-specific code. - games Various ways to waste time. + games Various fun sorts of things. packages Random other utilities that are not primarily about editing text. For example, code for automatically @@ -80,7 +80,8 @@ Some packages are fairly large; those have been given their own directories: - auctex A package for editing TeX documents. + auctex A package for editing TeX documents. [Available as + installable package] bytecomp The XEmacs-lisp compiler. @@ -104,8 +105,6 @@ electric The "electric" commands; these implement temporary windows for help, list-buffers, etc. - energize An interface to the Lucid Energize system. - eos An interface to Sun's SparcWorks product. eterm A merge of the comint shell mode with an @@ -114,7 +113,8 @@ gnats Interface to XEmacs bug reporting system based on Cygnus GNATS. - gnus A network news and mail reader. + gnus A network news and mail reader. [Available as + installable package] hm--html-menus Menu interface to html-mode. @@ -125,7 +125,11 @@ iso ISO Latin language support. - its MULE Input Method. + its MULE Input Method. [Requires installing LEIM at + XEmacs build] + + language MULE non-English language support. [Requires + installing LEIM at XEmacs build] locale IE18N stuff. @@ -138,7 +142,8 @@ mu Message Utilities library (part of the Tools for MIME). - mule Multi-lingual extensions for XEmacs. + mule Multi-lingual extensions for XEmacs. [Requires + installing LEIM at XEmacs build] oobr An Object-Oriented class browser. @@ -147,7 +152,8 @@ psgml General purpose SGML editing support with extra support for editing HTML. - quail MULE Input Method. [NOT WORKING IN 20.1] + quail MULE Input Method. [Requires installing LEIM at + XEmacs build] rmail A BABYL-format mail reader. @@ -164,4 +170,5 @@ vm View Mail, an UNIX-format alternative to RMAIL. - w3 A World Wide Web interface. + w3 A World Wide Web interface. [Available as installable + package] diff -r f0deb0c0e6be -r eb5470882647 lisp/bytecomp/custom-load.el --- a/lisp/bytecomp/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -;;; custom-load.el --- automatically extracted custom dependencies - -;; Created by SL Baur on Thu Oct 2 17:05:27 1997 - -;;; Code: - - -;;; custom-load.el ends here diff -r f0deb0c0e6be -r eb5470882647 lisp/cc-mode/custom-load.el --- a/lisp/cc-mode/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/cc-mode/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:05:28 1997 +;; Created by SL Baur on Sat Oct 4 18:11:21 1997 ;;; Code: diff -r f0deb0c0e6be -r eb5470882647 lisp/cl/cl-seq.el --- a/lisp/cl/cl-seq.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/cl/cl-seq.el Mon Aug 13 10:01:22 2007 +0200 @@ -326,8 +326,22 @@ (or (and (fboundp 'delete) (subrp (symbol-function 'delete))) (defalias 'delete (function (lambda (x y) (delete* x y ':test 'equal))))) -(defun remove (x y) (remove* x y ':test 'equal)) -(defun remq (x y) (if (memq x y) (delq x (copy-list y)) y)) + +(defun remove (cl-item cl-seq) + "Remove all occurrences of ITEM in SEQ, testing with `equal' +This is a non-destructive function; it makes a copy of SEQ if necessary +to avoid corrupting the original SEQ. +Also see: `remove*', `delete', `delete*'" + (remove* cl-item cl-seq ':test 'equal)) + +(defun remq (cl-elt cl-list) + "Remove all occurances of ELT in LIST, comparing with `eq'. +This is a non-destructive function; it makes a copy of LIST to avoid +corrupting the original LIST. +Also see: `delq', `delete', `delete*', `remove', `remove*'." + (if (memq cl-elt cl-list) + (delq cl-elt (copy-list cl-list)) + cl-list)) (defun remove-duplicates (cl-seq &rest cl-keys) "Return a copy of SEQ with all duplicate elements removed. diff -r f0deb0c0e6be -r eb5470882647 lisp/comint/custom-load.el --- a/lisp/comint/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/comint/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:05:29 1997 +;; Created by SL Baur on Sat Oct 4 18:11:23 1997 ;;; Code: diff -r f0deb0c0e6be -r eb5470882647 lisp/custom/cus-edit.el --- a/lisp/custom/cus-edit.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/custom/cus-edit.el Mon Aug 13 10:01:22 2007 +0200 @@ -2930,7 +2930,8 @@ (defun custom-save-delete (symbol) "Delete the call to SYMBOL form `custom-file'. Leave point at the location of the call, or after the last expression." - (let ((find-file-hooks nil)) + (let ((find-file-hooks nil) + (auto-mode-alist nil)) (set-buffer (find-file-noselect custom-file))) (goto-char (point-min)) (catch 'found @@ -3037,7 +3038,8 @@ (let ((inhibit-read-only t)) (custom-save-variables) (custom-save-faces) - (let ((find-file-hooks nil)) + (let ((find-file-hooks nil) + (auto-mode-alist)) (with-current-buffer (find-file-noselect custom-file) (save-buffer))))) diff -r f0deb0c0e6be -r eb5470882647 lisp/custom/cus-face.el --- a/lisp/custom/cus-face.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/custom/cus-face.el Mon Aug 13 10:01:22 2007 +0200 @@ -38,13 +38,14 @@ (frames (relevant-custom-frames)) frame) ;; Create global face. - (make-face face) + (make-empty-face face) (face-display-set face value) ;; Create frame local faces (while frames (setq frame (car frames) frames (cdr frames)) - (face-display-set face value frame)))) + (face-display-set face value frame)) + (init-face-from-resources face))) (when (and doc (null (face-doc-string face))) (set-face-doc-string face doc)) (custom-handle-all-keywords face args 'custom-face) @@ -256,7 +257,7 @@ (put face 'force-face t)) (when (or now (find-face face)) (unless (find-face face) - (make-face face)) + (make-empty-face face)) (face-spec-set face spec)) (setq args (cdr args))) ;; Old format, a plist of FACE SPEC pairs. diff -r f0deb0c0e6be -r eb5470882647 lisp/custom/custom-load.el --- a/lisp/custom/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/custom/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:05:30 1997 +;; Created by SL Baur on Sat Oct 4 18:11:24 1997 ;;; Code: diff -r f0deb0c0e6be -r eb5470882647 lisp/ediff/custom-load.el --- a/lisp/ediff/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/ediff/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:05:32 1997 +;; Created by SL Baur on Sat Oct 4 18:11:25 1997 ;;; Code: diff -r f0deb0c0e6be -r eb5470882647 lisp/efs/custom-load.el --- a/lisp/efs/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/efs/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:05:35 1997 +;; Created by SL Baur on Sat Oct 4 18:11:28 1997 ;;; Code: diff -r f0deb0c0e6be -r eb5470882647 lisp/emulators/custom-load.el --- a/lisp/emulators/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/emulators/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:05:36 1997 +;; Created by SL Baur on Sat Oct 4 18:11:29 1997 ;;; Code: diff -r f0deb0c0e6be -r eb5470882647 lisp/eterm/custom-load.el --- a/lisp/eterm/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/eterm/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:05:36 1997 +;; Created by SL Baur on Sat Oct 4 18:11:31 1997 ;;; Code: diff -r f0deb0c0e6be -r eb5470882647 lisp/games/custom-load.el --- a/lisp/games/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/games/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:05:37 1997 +;; Created by SL Baur on Sat Oct 4 18:11:32 1997 ;;; Code: diff -r f0deb0c0e6be -r eb5470882647 lisp/modes/custom-load.el --- a/lisp/modes/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/modes/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:05:44 1997 +;; Created by SL Baur on Sat Oct 4 18:11:37 1997 ;;; Code: diff -r f0deb0c0e6be -r eb5470882647 lisp/mule/custom-load.el --- a/lisp/mule/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/mule/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:05:45 1997 +;; Created by SL Baur on Sat Oct 4 18:11:38 1997 ;;; Code: diff -r f0deb0c0e6be -r eb5470882647 lisp/packages/auto-autoloads.el --- a/lisp/packages/auto-autoloads.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/packages/auto-autoloads.el Mon Aug 13 10:01:22 2007 +0200 @@ -2194,139 +2194,6 @@ ;;;*** -;;;### (autoloads (vc-update-change-log vc-rename-file vc-cancel-version vc-revert-buffer vc-print-log vc-retrieve-snapshot vc-create-snapshot vc-directory vc-insert-headers vc-version-other-window vc-version-diff vc-diff vc-checkout vc-register vc-next-action vc-find-binary) "vc" "packages/vc.el") - -(defvar vc-before-checkin-hook nil "\ -*Normal hook (list of functions) run before a file gets checked in. -See `run-hooks'.") - -(defvar vc-checkin-hook nil "\ -*Normal hook (List of functions) run after a checkin is done. -See `run-hooks'.") - -(autoload 'vc-find-binary "vc" "\ -Look for a command anywhere on the subprocess-command search path." nil nil) - -(autoload 'vc-next-action "vc" "\ -Do the next logical checkin or checkout operation on the current file. - If you call this from within a VC dired buffer with no files marked, -it will operate on the file in the current line. - If you call this from within a VC dired buffer, and one or more -files are marked, it will accept a log message and then operate on -each one. The log message will be used as a comment for any register -or checkin operations, but ignored when doing checkouts. Attempted -lock steals will raise an error. - A prefix argument lets you specify the version number to use. - -For RCS and SCCS files: - If the file is not already registered, this registers it for version -control and then retrieves a writable, locked copy for editing. - If the file is registered and not locked by anyone, this checks out -a writable and locked file ready for editing. - If the file is checked out and locked by the calling user, this -first checks to see if the file has changed since checkout. If not, -it performs a revert. - If the file has been changed, this pops up a buffer for entry -of a log message; when the message has been entered, it checks in the -resulting changes along with the log message as change commentary. If -the variable `vc-keep-workfiles' is non-nil (which is its default), a -read-only copy of the changed file is left in place afterwards. - If the file is registered and locked by someone else, you are given -the option to steal the lock. - -For CVS files: - If the file is not already registered, this registers it for version -control. This does a \"cvs add\", but no \"cvs commit\". - If the file is added but not committed, it is committed. - If your working file is changed, but the repository file is -unchanged, this pops up a buffer for entry of a log message; when the -message has been entered, it checks in the resulting changes along -with the logmessage as change commentary. A writable file is retained. - If the repository file is changed, you are asked if you want to -merge in the changes into your working copy." t nil) - -(autoload 'vc-register "vc" "\ -Register the current file into your version-control system. -The default initial version number, taken to be `vc-default-init-version', -can be overridden by giving a prefix arg." t nil) - -(autoload 'vc-checkout "vc" "\ -Retrieve a copy of the latest version of the given file." nil nil) - -(autoload 'vc-diff "vc" "\ -Display diffs between file versions. -Normally this compares the current file and buffer with the most recent -checked in version of that file. This uses no arguments. -With a prefix argument, it reads the file name to use -and two version designators specifying which versions to compare." t nil) - -(autoload 'vc-version-diff "vc" "\ -For FILE, report diffs between two stored versions REL1 and REL2 of it. -If FILE is a directory, generate diffs between versions for all registered -files in or below it." t nil) - -(autoload 'vc-version-other-window "vc" "\ -Visit version REV of the current buffer in another window. -If the current buffer is named `F', the version is named `F.~REV~'. -If `F.~REV~' already exists, it is used instead of being re-created." t nil) - -(autoload 'vc-insert-headers "vc" "\ -Insert headers in a file for use with your version-control system. -Headers desired are inserted at the start of the buffer, and are pulled from -the variable `vc-header-alist'." t nil) - -(autoload 'vc-directory "vc" "\ -Show version-control status of the current directory and subdirectories. -Normally it creates a Dired buffer that lists only the locked files -in all these directories. With a prefix argument, it lists all files." t nil) - -(autoload 'vc-create-snapshot "vc" "\ -Make a snapshot called NAME. -The snapshot is made from all registered files at or below the current -directory. For each file, the version level of its latest -version becomes part of the named configuration." t nil) - -(autoload 'vc-retrieve-snapshot "vc" "\ -Retrieve the snapshot called NAME. -This function fails if any files are locked at or below the current directory -Otherwise, all registered files are checked out (unlocked) at their version -levels in the snapshot." t nil) - -(autoload 'vc-print-log "vc" "\ -List the change log of the current buffer in a window." t nil) - -(autoload 'vc-revert-buffer "vc" "\ -Revert the current buffer's file back to the latest checked-in version. -This asks for confirmation if the buffer contents are not identical -to that version. -If the back-end is CVS, this will give you the most recent revision of -the file on the branch you are editing." t nil) - -(autoload 'vc-cancel-version "vc" "\ -Get rid of most recently checked in version of this file. -A prefix argument means do not revert the buffer afterwards." t nil) - -(autoload 'vc-rename-file "vc" "\ -Rename file OLD to NEW, and rename its master file likewise." t nil) - -(autoload 'vc-update-change-log "vc" "\ -Find change log file and add entries from recent RCS/CVS logs. -Normally, find log entries for all registered files in the default -directory using `rcs2log', which finds CVS logs preferentially. -The mark is left at the end of the text prepended to the change log. - -With prefix arg of C-u, only find log entries for the current buffer's file. - -With any numeric prefix arg, find log entries for all currently visited -files that are under version control. This puts all the entries in the -log for the default directory, which may not be appropriate. - -From a program, any arguments are assumed to be filenames and are -passed to the `rcs2log' script after massaging to be relative to the -default directory." t nil) - -;;;*** - ;;;### (autoloads (webjump) "webjump" "packages/webjump.el") (autoload 'webjump "webjump" "\ diff -r f0deb0c0e6be -r eb5470882647 lisp/packages/custom-load.el --- a/lisp/packages/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/packages/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:05:51 1997 +;; Created by SL Baur on Sat Oct 4 18:11:45 1997 ;;; Code: diff -r f0deb0c0e6be -r eb5470882647 lisp/packages/func-menu.el --- a/lisp/packages/func-menu.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/packages/func-menu.el Mon Aug 13 10:01:22 2007 +0200 @@ -206,7 +206,6 @@ (eval-when-compile (byte-compiler-options (optimize t) - (new-bytecodes t) (warnings (- free-vars unresolved)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -227,7 +226,8 @@ (defun fume-about () (interactive) (sit-for 0) - (message "Func-Menu version %s, © 1996 %s" fume-version fume-developer)) + (display-message 'no-log + (format "Func-Menu version %s, © 1996 %s" fume-version fume-developer))) (defconst fume-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)) @@ -1888,9 +1888,9 @@ (save-excursion (goto-char (point-min)) (cond (fume-scanning-message - (message fume-scanning-message 0)) + (display-message 'progress (format fume-scanning-message 0))) (fume-rescanning-message - (message fume-rescanning-message))) + (display-message 'progress fume-rescanning-message))) (while (setq fnam (condition-case () (funcall find buffer-to-scan) @@ -1909,11 +1909,11 @@ (if fume-found-function-hook (save-excursion (run-hooks 'fume-found-function-hook))))) (if fume-scanning-message - (message fume-scanning-message (fume-relative-position)))) + (display-message 'progress (format fume-scanning-message (fume-relative-position))))) (cond (fume-scanning-message - (message "%s done" (format fume-scanning-message 100))) + (display-message 'progress (format "%s done" (format fume-scanning-message 100)))) (fume-rescanning-message - (message "%s done" fume-rescanning-message))) + (display-message 'progress (format "%s done" fume-rescanning-message)))) ;; make a copy of flst sorted by position in buffer (setq fume-modeline-funclist (nreverse @@ -2081,7 +2081,7 @@ fume-menubar-menu-location)) ((and fume-not-tty ; trap tty segmentation faults... - (not (popup-menu-up-p))) + (not (popup-up-p))) (or (fume-update-menubar-entry) (setq function-menu (cons @@ -2197,14 +2197,15 @@ (interactive) (fume-about) (sit-for 1) - (message "SPC=%s, p=%s, n=%s, o=%s, G=%s, RET=%s, q=%s" - "this" - "previous" - "next" - "other win" - "one win" - "this win" - "quit")) + (display-message 'prompt + (format "SPC=%s, p=%s, n=%s, o=%s, G=%s, RET=%s, q=%s" + "this" + "previous" + "next" + "other win" + "one win" + "this win" + "quit"))) (defun fume-list-functions-quit () (interactive) diff -r f0deb0c0e6be -r eb5470882647 lisp/packages/vc-hooks.el --- a/lisp/packages/vc-hooks.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1175 +0,0 @@ -;;; vc-hooks.el --- resident support for version-control - -;; Copyright (C) 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. - -;; Author: Eric S. Raymond -;; Maintainer: Andre Spiegel -;; Maintainer: (ClearCase) Rod Whitby -;; XEmacs conversion: Steve Baur - -;; 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 is the always-loaded portion of VC. -;; It takes care VC-related activities that are done when you visit a file, -;; so that vc.el itself is loaded only when you use a VC command. -;; See the commentary of vc.el. - -;; Rudimentary ClearCase support by Rod Whitby . -;; I (Rod Whitby) intend to maintain the rudimentary functionality that is -;; currently in this file. At some time in the future (don't hold your -;; breath), I intend to merge the functionality of the cc-vc package -;; (separately available from /rtfm.mit.edu:/pub/cc-vc/) into this file. -;; I am not the maintainer of cc-vc, nor am I the maintainer of the -;; non-ClearCase parts of this file. -;; - -;;; Code: - -;; Customization Variables (the rest is in vc.el) - -(defvar vc-default-back-end nil - "*Back-end actually used by this interface; may be SCCS or RCS. -The value is only computed when needed to avoid an expensive search.") - -(defvar vc-handle-cvs t - "*If non-nil, use VC for files managed with CVS. -If it is nil, don't use VC for those files.") - -(defvar vc-rcsdiff-knows-brief nil - "*Indicates whether rcsdiff understands the --brief option. -The value is either `yes', `no', or nil. If it is nil, VC tries -to use --brief and sets this variable to remember whether it worked.") - -(defvar vc-path - (if (file-directory-p "/usr/sccs") - '("/usr/sccs") - nil) - "*List of extra directories to search for version control commands.") - -(defvar vc-master-templates - '(("%sRCS/%s,v" . RCS) ("%s%s,v" . RCS) ("%sRCS/%s" . RCS) - ("%sSCCS/s.%s" . SCCS) ("%ss.%s". SCCS) - vc-find-cvs-master) - "*Where to look for version-control master files. -The first pair corresponding to a given back end is used as a template -when creating new masters.") - -(defvar vc-make-backup-files nil - "*If non-nil, backups of registered files are made as with other files. -If nil (the default), files covered by version control don't get backups.") - -(defvar vc-follow-symlinks 'ask - "*Indicates what to do if you visit a symbolic link to a file -that is under version control. Editing such a file through the -link bypasses the version control system, which is dangerous and -probably not what you want. - If this variable is t, VC follows the link and visits the real file, -telling you about it in the echo area. If it is `ask', VC asks for -confirmation whether it should follow the link. If nil, the link is -visited and a warning displayed.") - -(defvar vc-display-status t - "*If non-nil, display revision number and lock status in modeline. -Otherwise, not displayed.") - -(defvar vc-consult-headers t - "*If non-nil, identify work files by searching for version headers.") - -(defvar vc-keep-workfiles t - "*If non-nil, don't delete working files after registering changes. -If the back-end is CVS, workfiles are always kept, regardless of the -value of this flag.") - -(defvar vc-mistrust-permissions nil - "*If non-nil, don't assume that permissions and ownership track -version-control status. If nil, do rely on the permissions. -See also variable `vc-consult-headers'.") - -(defun vc-mistrust-permissions (file) - ;; Access function to the above. - (or (eq vc-mistrust-permissions 't) - (and vc-mistrust-permissions - (funcall vc-mistrust-permissions - (vc-backend-subdirectory-name file))))) - -;; Tell Emacs about this new kind of minor mode -;;(if (not (assoc 'vc-mode minor-mode-alist)) -;; (setq minor-mode-alist (cons '(vc-mode vc-mode) -;; minor-mode-alist))) - -;; XEmacs: -(add-minor-mode 'vc-mode 'vc-mode) - -(defvar vc-mode nil) ; used for modeline flag -;; End XEmacs addition. - -(make-variable-buffer-local 'vc-mode) -(put 'vc-mode 'permanent-local t) - -;; We need a notion of per-file properties because the version -;; control state of a file is expensive to derive --- we compute -;; them when the file is initially found, keep them up to date -;; during any subsequent VC operations, and forget them when -;; the buffer is killed. - -(defmacro vc-error-occurred (&rest body) - (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t))) - -(defvar vc-file-prop-obarray [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] - "Obarray for per-file properties.") - -(defvar vc-buffer-backend t) -(make-variable-buffer-local 'vc-buffer-backend) - -(defun vc-file-setprop (file property value) - ;; set per-file property - (put (intern file vc-file-prop-obarray) property value)) - -(defun vc-file-getprop (file property) - ;; get per-file property - (get (intern file vc-file-prop-obarray) property)) - -(defun vc-file-clearprops (file) - ;; clear all properties of a given file - (setplist (intern file vc-file-prop-obarray) nil)) - -;;; Functions that determine property values, by examining the -;;; working file, the master file, or log program output - -(defun vc-match-substring (bn) - (buffer-substring (match-beginning bn) (match-end bn))) - -(defun vc-lock-file (file) - ;; Generate lock file name corresponding to FILE - (let ((master (vc-name file))) - (and - master - (string-match "\\(.*/\\)s\\.\\(.*\\)" master) - (concat - (substring master (match-beginning 1) (match-end 1)) - "p." - (substring master (match-beginning 2) (match-end 2)))))) - -(defun vc-parse-buffer (patterns &optional file properties) - ;; Use PATTERNS to parse information out of the current buffer. - ;; Each element of PATTERNS is a list of 2 to 3 elements. The first element - ;; is the pattern to be matched, and the second (an integer) is the - ;; number of the subexpression that should be returned. If there's - ;; a third element (also the number of a subexpression), that - ;; subexpression is assumed to be a date field and we want the most - ;; recent entry matching the template. - ;; If FILE and PROPERTIES are given, the latter must be a list of - ;; properties of the same length as PATTERNS; each property is assigned - ;; the corresponding value. - (mapcar (function (lambda (p) - (goto-char (point-min)) - (cond - ((eq (length p) 2) ;; search for first entry - (let ((value nil)) - (if (re-search-forward (car p) nil t) - (setq value (vc-match-substring (elt p 1)))) - (if file - (progn (vc-file-setprop file (car properties) value) - (setq properties (cdr properties)))) - value)) - ((eq (length p) 3) ;; search for latest entry - (let ((latest-date "") (latest-val)) - (while (re-search-forward (car p) nil t) - (let ((date (vc-match-substring (elt p 2)))) - (if (string< latest-date date) - (progn - (setq latest-date date) - (setq latest-val - (vc-match-substring (elt p 1))))))) - (if file - (progn (vc-file-setprop file (car properties) latest-val) - (setq properties (cdr properties)))) - latest-val))))) - patterns) - ) - -(defun vc-insert-file (file &optional limit blocksize) - ;; Insert the contents of FILE into the current buffer. - ;; Optional argument LIMIT is a regexp. If present, - ;; the file is inserted in chunks of size BLOCKSIZE - ;; (default 8 kByte), until the first occurrence of - ;; LIMIT is found. The function returns nil if FILE - ;; doesn't exist. - (erase-buffer) - (cond ((file-exists-p file) - (cond (limit - (if (not blocksize) (setq blocksize 8192)) - (let (found s) - (while (not found) - (setq s (buffer-size)) - (goto-char (1+ s)) - (setq found - (or (zerop (car (cdr - (insert-file-contents file nil s - (+ s blocksize))))) - (progn (beginning-of-line) - (re-search-forward limit nil t))))))) - (t (insert-file-contents file))) - (set-buffer-modified-p nil) - (auto-save-mode nil) - t) - (t nil))) - -(defun vc-parse-locks (file locks) - ;; Parse RCS or SCCS locks. - ;; The result is a list of the form ((VERSION USER) (VERSION USER) ...), - ;; which is returned and stored into the property `vc-master-locks'. - (if (not locks) - (vc-file-setprop file 'vc-master-locks 'none) - (let ((found t) (index 0) master-locks version user) - (cond ((eq (vc-backend file) 'SCCS) - (while (string-match "^\\([0-9.]+\\) [0-9.]+ \\([^ ]+\\) .*\n?" - locks index) - (setq version (substring locks - (match-beginning 1) (match-end 1))) - (setq user (substring locks - (match-beginning 2) (match-end 2))) - (setq master-locks (append master-locks - (list (cons version user)))) - (setq index (match-end 0)))) - ((eq (vc-backend file) 'RCS) - (while (string-match "[ \t\n]*\\([^:]+\\):\\([0-9.]+\\)" - locks index) - (setq version (substring locks - (match-beginning 2) (match-end 2))) - (setq user (substring locks - (match-beginning 1) (match-end 1))) - (setq master-locks (append master-locks - (list (cons version user)))) - (setq index (match-end 0))) - (if (string-match ";[ \t\n]+strict;" locks index) - (vc-file-setprop file 'vc-checkout-model 'manual) - (vc-file-setprop file 'vc-checkout-model 'implicit)))) - (vc-file-setprop file 'vc-master-locks (or master-locks 'none))))) - -(defun vc-simple-command (okstatus command file &rest args) - ;; Simple version of vc-do-command, for use in vc-hooks only. - ;; Don't switch to the *vc-info* buffer before running the - ;; command, because that would change its default directory - (save-excursion (set-buffer (get-buffer-create "*vc-info*")) - (erase-buffer)) - (let ((exec-path (append vc-path exec-path)) exec-status - ;; Add vc-path to PATH for the execution of this command. - (process-environment - (cons (concat "PATH=" (getenv "PATH") - path-separator - (mapconcat 'identity vc-path path-separator)) - process-environment))) - (setq exec-status - (apply 'call-process command nil "*vc-info*" nil - (append args (list file)))) - (cond ((> exec-status okstatus) - (switch-to-buffer (get-file-buffer file)) - (shrink-window-if-larger-than-buffer - (display-buffer "*vc-info*")) - (error "Couldn't find version control information"))) - exec-status)) - -(defun vc-fetch-master-properties (file) - ;; Fetch those properties of FILE that are stored in the master file. - ;; For an RCS file, we don't get vc-latest-version vc-your-latest-version - ;; here because that is slow. - ;; That gets done if/when the functions vc-latest-version - ;; and vc-your-latest-version get called. - (save-excursion - (cond - ((eq (vc-backend file) 'SCCS) - (set-buffer (get-buffer-create "*vc-info*")) - (if (vc-insert-file (vc-lock-file file)) - (vc-parse-locks file (buffer-string)) - (vc-file-setprop file 'vc-master-locks 'none)) - (vc-insert-file (vc-name file) "^\001e") - (vc-parse-buffer - (list '("^\001d D \\([^ ]+\\)" 1) - (list (concat "^\001d D \\([^ ]+\\) .* " - (regexp-quote (vc-user-login-name)) " ") 1)) - file - '(vc-latest-version vc-your-latest-version))) - - ((eq (vc-backend file) 'RCS) - (set-buffer (get-buffer-create "*vc-info*")) - (vc-insert-file (vc-name file) "^[0-9]") - (vc-parse-buffer - (list '("^head[ \t\n]+\\([^;]+\\);" 1) - '("^branch[ \t\n]+\\([^;]+\\);" 1) - '("^locks[ \t\n]*\\([^;]*;\\([ \t\n]*strict;\\)?\\)" 1)) - file - '(vc-head-version - vc-default-branch - vc-master-locks)) - ;; determine vc-master-workfile-version: it is either the head - ;; of the trunk, the head of the default branch, or the - ;; "default branch" itself, if that is a full revision number. - (let ((default-branch (vc-file-getprop file 'vc-default-branch))) - (cond - ;; no default branch - ((or (not default-branch) (string= "" default-branch)) - (vc-file-setprop file 'vc-master-workfile-version - (vc-file-getprop file 'vc-head-version))) - ;; default branch is actually a revision - ((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$" - default-branch) - (vc-file-setprop file 'vc-master-workfile-version default-branch)) - ;; else, search for the head of the default branch - (t (vc-insert-file (vc-name file) "^desc") - (vc-parse-buffer (list (list - (concat "^\\(" - (regexp-quote default-branch) - "\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2)) - file '(vc-master-workfile-version))))) - ;; translate the locks - (vc-parse-locks file (vc-file-getprop file 'vc-master-locks))) - - ((eq (vc-backend file) 'CVS) - (save-excursion - ;; Call "cvs status" in the right directory, passing only the - ;; nondirectory part of the file name -- otherwise CVS might - ;; silently give a wrong result. - (let ((default-directory (file-name-directory file))) - (vc-simple-command 0 "cvs" (file-name-nondirectory file) "status")) - (set-buffer (get-buffer "*vc-info*")) - (vc-parse-buffer - ;; CVS 1.3 says "RCS Version:", other releases "RCS Revision:", - ;; and CVS 1.4a1 says "Repository revision:". - '(("\\(RCS Version\\|RCS Revision\\|Repository revision\\):[\t ]+\\([0-9.]+\\)" 2) - ("^File: [^ \t]+[ \t]+Status: \\(.*\\)" 1)) - file - '(vc-latest-version vc-cvs-status)) - ;; Translate those status values that we understand into symbols. - ;; Any other value is converted to nil. - (let ((status (vc-file-getprop file 'vc-cvs-status))) - (cond - ((string-match "Up-to-date" status) - (vc-file-setprop file 'vc-cvs-status 'up-to-date) - (vc-file-setprop file 'vc-checkout-time - (nth 5 (file-attributes file)))) - ((vc-file-setprop file 'vc-cvs-status - (cond - ((string-match "Locally Modified" status) 'locally-modified) - ((string-match "Needs Merge" status) 'needs-merge) - ((string-match "Needs \\(Checkout\\|Patch\\)" status) - 'needs-checkout) - ((string-match "Unresolved Conflict" status) 'unresolved-conflict) - ((string-match "Locally Added" status) 'locally-added) - (t 'unknown) - )))))))) - (if (get-buffer "*vc-info*") - (kill-buffer (get-buffer "*vc-info*"))))) - -;;; Functions that determine property values, by examining the -;;; working file, the master file, or log program output - -(defun vc-consult-rcs-headers (file) - ;; Search for RCS headers in FILE, and set properties - ;; accordingly. This function can be disabled by setting - ;; vc-consult-headers to nil. - ;; Returns: nil if no headers were found - ;; (or if the feature is disabled, - ;; or if there is currently no buffer - ;; visiting FILE) - ;; 'rev if a workfile revision was found - ;; 'rev-and-lock if revision and lock info was found - (cond - ((or (not vc-consult-headers) - (not (get-file-buffer file))) nil) - ((let (status version locking-user) - (save-excursion - (set-buffer (get-file-buffer file)) - (goto-char (point-min)) - (cond - ;; search for $Id or $Header - ;; ------------------------- - ((or (and (search-forward "$Id: " nil t) - (looking-at "[^ ]+ \\([0-9.]+\\) ")) - (and (progn (goto-char (point-min)) - (search-forward "$Header: " nil t)) - (looking-at "[^ ]+ \\([0-9.]+\\) "))) - (goto-char (match-end 0)) - ;; if found, store the revision number ... - (setq version (buffer-substring-no-properties (match-beginning 1) - (match-end 1))) - ;; ... and check for the locking state - (cond - ((looking-at - (concat "[0-9]+[/-][01][0-9][/-][0-3][0-9] " ; date - "[0-2][0-9]:[0-5][0-9]+:[0-6][0-9]+\\([+-][0-9:]+\\)? " ; time - "[^ ]+ [^ ]+ ")) ; author & state - (goto-char (match-end 0)) ; [0-6] in regexp handles leap seconds - (cond - ;; unlocked revision - ((looking-at "\\$") - (setq locking-user 'none) - (setq status 'rev-and-lock)) - ;; revision is locked by some user - ((looking-at "\\([^ ]+\\) \\$") - (setq locking-user - (buffer-substring-no-properties (match-beginning 1) - (match-end 1))) - (setq status 'rev-and-lock)) - ;; everything else: false - (nil))) - ;; unexpected information in - ;; keyword string --> quit - (nil))) - ;; search for $Revision - ;; -------------------- - ((re-search-forward (concat "\\$" - "Revision: \\([0-9.]+\\) \\$") - nil t) - ;; if found, store the revision number ... - (setq version (buffer-substring-no-properties (match-beginning 1) - (match-end 1))) - ;; and see if there's any lock information - (goto-char (point-min)) - (if (re-search-forward (concat "\\$" "Locker:") nil t) - (cond ((looking-at " \\([^ ]+\\) \\$") - (setq locking-user (buffer-substring-no-properties - (match-beginning 1) - (match-end 1))) - (setq status 'rev-and-lock)) - ((looking-at " *\\$") - (setq locking-user 'none) - (setq status 'rev-and-lock)) - (t - (setq locking-user 'none) - (setq status 'rev-and-lock))) - (setq status 'rev))) - ;; else: nothing found - ;; ------------------- - (t nil))) - (if status (vc-file-setprop file 'vc-workfile-version version)) - (and (eq status 'rev-and-lock) - (eq (vc-backend file) 'RCS) - (vc-file-setprop file 'vc-locking-user locking-user) - ;; If the file has headers, we don't want to query the master file, - ;; because that would eliminate all the performance gain the headers - ;; brought us. We therefore use a heuristic for the checkout model - ;; now: If we trust the file permissions, and the file is not - ;; locked, then if the file is read-only the checkout model is - ;; `manual', otherwise `implicit'. - (not (vc-mistrust-permissions file)) - (not (vc-locking-user file)) - (if (string-match ".r-..-..-." (nth 8 (file-attributes file))) - (vc-file-setprop file 'vc-checkout-model 'manual) - (vc-file-setprop file 'vc-checkout-model 'implicit))) - status)))) - -;;; Access functions to file properties -;;; (Properties should be _set_ using vc-file-setprop, but -;;; _retrieved_ only through these functions, which decide -;;; if the property is already known or not. A property should -;;; only be retrieved by vc-file-getprop if there is no -;;; access function.) - -;;; properties indicating the backend -;;; being used for FILE - -(defun vc-backend-subdirectory-name (&optional file) - ;; Where the master and lock files for the current directory are kept - (symbol-name - (or - (and file (vc-backend file)) - vc-default-back-end - (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS))))) - -(defun vc-name (file) - "Return the master name of a file, nil if it is not registered. -For CVS, the full name of CVS/Entries is returned." - (or (vc-file-getprop file 'vc-name) - (let ((name-and-type (vc-registered file))) - (if name-and-type - (progn - (vc-file-setprop file 'vc-backend (cdr name-and-type)) - (vc-file-setprop file 'vc-name (car name-and-type))))))) - -(defun vc-backend (file) - "Return the version-control type of a file, nil if it is not registered." - (and file - (or (vc-file-getprop file 'vc-backend) - (let ((name-and-type (vc-registered file))) - (if name-and-type - (progn - (vc-file-setprop file 'vc-name (car name-and-type)) - (vc-file-setprop file 'vc-backend (cdr name-and-type)))))))) - -(defun vc-checkout-model (file) - ;; Return `manual' if the user has to type C-x C-q to check out FILE. - ;; Return `implicit' if the file can be modified without locking it first. - (or - (vc-file-getprop file 'vc-checkout-model) - (cond - ((eq (vc-backend file) 'SCCS) - (vc-file-setprop file 'vc-checkout-model 'manual)) - ((eq (vc-backend file) 'RCS) - (vc-consult-rcs-headers file) - (or (vc-file-getprop file 'vc-checkout-model) - (progn (vc-fetch-master-properties file) - (vc-file-getprop file 'vc-checkout-model)))) - ((eq (vc-backend file) 'CVS) - (vc-file-setprop file 'vc-checkout-model - (if (getenv "CVSREAD") 'manual 'implicit)))))) - -;;; properties indicating the locking state - -(defun vc-cvs-status (file) - ;; Return the cvs status of FILE - ;; (Status field in output of "cvs status") - (cond ((vc-file-getprop file 'vc-cvs-status)) - (t (vc-fetch-master-properties file) - (vc-file-getprop file 'vc-cvs-status)))) - -(defun vc-master-locks (file) - ;; Return the lock entries in the master of FILE. - ;; Return 'none if there are no such entries, and a list - ;; of the form ((VERSION USER) (VERSION USER) ...) otherwise. - (cond ((vc-file-getprop file 'vc-master-locks)) - (t (vc-fetch-master-properties file) - (vc-file-getprop file 'vc-master-locks)))) - -(defun vc-master-locking-user (file) - ;; Return the master file's idea of who is locking - ;; the current workfile version of FILE. - ;; Return 'none if it is not locked. - (let ((master-locks (vc-master-locks file)) lock) - (if (eq master-locks 'none) 'none - ;; search for a lock on the current workfile version - (setq lock (assoc (vc-workfile-version file) master-locks)) - (cond (lock (cdr lock)) - ('none))))) - -(defun vc-lock-from-permissions (file) - ;; If the permissions can be trusted for this file, determine the - ;; locking state from them. Returns (user-login-name), `none', or nil. - ;; This implementation assumes that any file which is under version - ;; control and has -rw-r--r-- is locked by its owner. This is true - ;; for both RCS and SCCS, which keep unlocked files at -r--r--r--. - ;; We have to be careful not to exclude files with execute bits on; - ;; scripts can be under version control too. Also, we must ignore the - ;; group-read and other-read bits, since paranoid users turn them off. - ;; This hack wins because calls to the somewhat expensive - ;; `vc-fetch-master-properties' function only have to be made if - ;; (a) the file is locked by someone other than the current user, - ;; or (b) some untoward manipulation behind vc's back has changed - ;; the owner or the `group' or `other' write bits. - (let ((attributes (file-attributes file))) - (if (not (vc-mistrust-permissions file)) - (cond ((string-match ".r-..-..-." (nth 8 attributes)) - (vc-file-setprop file 'vc-locking-user 'none)) - ((and (= (nth 2 attributes) (user-uid)) - (string-match ".rw..-..-." (nth 8 attributes))) - (vc-file-setprop file 'vc-locking-user (vc-user-login-name))) - (nil))))) - -(defun vc-user-login-name (&optional uid) - ;; Return the name under which the user is logged in, as a string. - ;; (With optional argument UID, return the name of that user.) - ;; This function does the same as `user-login-name', but unlike - ;; that, it never returns nil. If a UID cannot be resolved, that - ;; UID is returned as a string. - (or (user-login-name uid) - (and uid (number-to-string uid)) - (number-to-string (user-uid)))) - -(defun vc-file-owner (file) - ;; Return who owns FILE (user name, as a string). - (vc-user-login-name (nth 2 (file-attributes file)))) - -(defun vc-rcs-lock-from-diff (file) - ;; Diff the file against the master version. If differences are found, - ;; mark the file locked. This is only used for RCS with non-strict - ;; locking. (If "rcsdiff" doesn't understand --brief, we do a double-take - ;; and remember the fact for the future.) - (let* ((version (concat "-r" (vc-workfile-version file))) - (status (if (eq vc-rcsdiff-knows-brief 'no) - (vc-simple-command 1 "rcsdiff" file version) - (vc-simple-command 2 "rcsdiff" file "--brief" version)))) - (if (eq status 2) - (if (not vc-rcsdiff-knows-brief) - (setq vc-rcsdiff-knows-brief 'no - status (vc-simple-command 1 "rcsdiff" file version)) - (error "rcsdiff failed.")) - (if (not vc-rcsdiff-knows-brief) (setq vc-rcsdiff-knows-brief 'yes))) - (if (zerop status) - (vc-file-setprop file 'vc-locking-user 'none) - (vc-file-setprop file 'vc-locking-user (vc-file-owner file))))) - -(defun vc-locking-user (file) - ;; Return the name of the person currently holding a lock on FILE. - ;; Return nil if there is no such person. - ;; Under CVS, a file is considered locked if it has been modified since - ;; it was checked out. - ;; The property is cached. It is only looked up if it is currently nil. - ;; Note that, for a file that is not locked, the actual property value - ;; is `none', to distinguish it from an unknown locking state. That value - ;; is converted to nil by this function, and returned to the caller. - (let ((locking-user (vc-file-getprop file 'vc-locking-user))) - (if locking-user - ;; if we already know the property, return it - (if (eq locking-user 'none) nil locking-user) - - ;; otherwise, infer the property... - (cond - ((eq (vc-backend file) 'CVS) - (or (and (eq (vc-checkout-model file) 'manual) - (vc-lock-from-permissions file)) - (and (equal (vc-file-getprop file 'vc-checkout-time) - (nth 5 (file-attributes file))) - (vc-file-setprop file 'vc-locking-user 'none)) - (vc-file-setprop file 'vc-locking-user (vc-file-owner file)))) - - ((eq (vc-backend file) 'RCS) - (let (p-lock) - - ;; Check for RCS headers first - (or (eq (vc-consult-rcs-headers file) 'rev-and-lock) - - ;; If there are no headers, try to learn it - ;; from the permissions. - (and (setq p-lock (vc-lock-from-permissions file)) - (if (eq p-lock 'none) - - ;; If the permissions say "not locked", we know - ;; that the checkout model must be `manual'. - (vc-file-setprop file 'vc-checkout-model 'manual) - - ;; If the permissions say "locked", we can only trust - ;; this *if* the checkout model is `manual'. - (eq (vc-checkout-model file) 'manual))) - - ;; Otherwise, use lock information from the master file. - (vc-file-setprop file 'vc-locking-user - (vc-master-locking-user file))) - - ;; Finally, if the file is not explicitly locked - ;; it might still be locked implicitly. - (and (eq (vc-file-getprop file 'vc-locking-user) 'none) - (eq (vc-checkout-model file) 'implicit) - (vc-rcs-lock-from-diff file)))) - - ((eq (vc-backend file) 'SCCS) - (or (vc-lock-from-permissions file) - (vc-file-setprop file 'vc-locking-user - (vc-master-locking-user file))))) - - ;; convert a possible 'none value - (setq locking-user (vc-file-getprop file 'vc-locking-user)) - (if (eq locking-user 'none) nil locking-user)))) - -;;; properties to store current and recent version numbers - -(defun vc-latest-version (file) - ;; Return version level of the latest version of FILE - (cond ((vc-file-getprop file 'vc-latest-version)) - (t (vc-fetch-properties file) - (vc-file-getprop file 'vc-latest-version)))) - -(defun vc-your-latest-version (file) - ;; Return version level of the latest version of FILE checked in by you - (cond ((vc-file-getprop file 'vc-your-latest-version)) - (t (vc-fetch-properties file) - (vc-file-getprop file 'vc-your-latest-version)))) - -(defun vc-master-workfile-version (file) - ;; Return the master file's idea of what is the current workfile version. - ;; This property is defined for RCS only. - (cond ((vc-file-getprop file 'vc-master-workfile-version)) - (t (vc-fetch-master-properties file) - (vc-file-getprop file 'vc-master-workfile-version)))) - -(defun vc-fetch-properties (file) - ;; Fetch vc-latest-version and vc-your-latest-version - ;; if that wasn't already done. - (cond - ((eq (vc-backend file) 'RCS) - (save-excursion - (set-buffer (get-buffer-create "*vc-info*")) - (vc-insert-file (vc-name file) "^desc") - (vc-parse-buffer - (list '("^\\([0-9]+\\.[0-9.]+\\)\ndate[ \t]+\\([0-9.]+\\);" 1 2) - (list (concat "^\\([0-9]+\\.[0-9.]+\\)\n" - "date[ \t]+\\([0-9.]+\\);[ \t]+" - "author[ \t]+" - (regexp-quote (vc-user-login-name)) ";") 1 2)) - file - '(vc-latest-version vc-your-latest-version)) - (if (get-buffer "*vc-info*") - (kill-buffer (get-buffer "*vc-info*"))))) - (t (vc-fetch-master-properties file)) - )) - -(defun vc-workfile-version (file) - ;; Return version level of the current workfile FILE - ;; This is attempted by first looking at the RCS keywords. - ;; If there are no keywords in the working file, - ;; vc-master-workfile-version is taken. - ;; Note that this property is cached, that is, it is only - ;; looked up if it is nil. - ;; For SCCS, this property is equivalent to vc-latest-version. - (cond ((vc-file-getprop file 'vc-workfile-version)) - ((eq (vc-backend file) 'SCCS) (vc-latest-version file)) - ((eq (vc-backend file) 'RCS) - (if (vc-consult-rcs-headers file) - (vc-file-getprop file 'vc-workfile-version) - (let ((rev (cond ((vc-master-workfile-version file)) - ((vc-latest-version file))))) - (vc-file-setprop file 'vc-workfile-version rev) - rev))) - ((eq (vc-backend file) 'CVS) - (if (vc-consult-rcs-headers file) ;; CVS - (vc-file-getprop file 'vc-workfile-version) - (catch 'found - (vc-find-cvs-master (file-name-directory file) - (file-name-nondirectory file))) - (vc-file-getprop file 'vc-workfile-version))))) - -;;; actual version-control code starts here - -(defun vc-registered (file) - (let (handler handlers) - (if (boundp 'file-name-handler-alist) - (setq handler (find-file-name-handler file 'vc-registered))) - (if handler - (funcall handler 'vc-registered file) - ;; Search for a master corresponding to the given file - (let ((dirname (or (file-name-directory file) "")) - (basename (file-name-nondirectory file))) - (catch 'found - (mapcar - (function (lambda (s) - (if (atom s) - (funcall s dirname basename) - (let ((trial (format (car s) dirname basename))) - (if (and (file-exists-p trial) - ;; Make sure the file we found with name - ;; TRIAL is not the source file itself. - ;; That can happen with RCS-style names - ;; if the file name is truncated - ;; (e.g. to 14 chars). See if either - ;; directory or attributes differ. - (or (not (string= dirname - (file-name-directory trial))) - (not (equal - (file-attributes file) - (file-attributes trial))))) - (throw 'found (cons trial (cdr s)))))))) - vc-master-templates) - nil))))) - -(defun vc-find-cvs-master (dirname basename) - ;; Check if DIRNAME/BASENAME is handled by CVS. - ;; If it is, do a (throw 'found (cons MASTER 'CVS)). - ;; Note: This function throws the name of CVS/Entries - ;; NOT that of the RCS master file (because we wouldn't be able - ;; to access it under remote CVS). - ;; The function returns nil if DIRNAME/BASENAME is not handled by CVS. - (if (and vc-handle-cvs - (file-directory-p (concat dirname "CVS/")) - (file-readable-p (concat dirname "CVS/Entries"))) - (let (buffer time (fold case-fold-search) - (file (concat dirname basename))) - (unwind-protect - (save-excursion - (setq buffer (set-buffer (get-buffer-create "*vc-info*"))) - (vc-insert-file (concat dirname "CVS/Entries")) - (goto-char (point-min)) - ;; make sure the file name is searched - ;; case-sensitively - (setq case-fold-search nil) - (cond - ;; normal entry - ((re-search-forward - (concat "^/" (regexp-quote basename) - "/\\([^/]*\\)/[^ /]* \\([A-Z][a-z][a-z]\\) *\\([0-9]*\\) \\([0-9]*\\):\\([0-9]*\\):\\([0-9]*\\) \\([0-9]*\\)") - nil t) - (setq case-fold-search fold) ;; restore the old value - ;; We found it. Store away version number now that we - ;; are anyhow so close to finding it. - (vc-file-setprop file - 'vc-workfile-version - (match-string 1)) - ;; If the file hasn't been modified since checkout, - ;; store the checkout-time. - (let ((mtime (nth 5 (file-attributes file))) - (second (string-to-number (match-string 6))) - (minute (string-to-number (match-string 5))) - (hour (string-to-number (match-string 4))) - (day (string-to-number (match-string 3))) - (year (string-to-number (match-string 7)))) - (if (equal mtime - (encode-time - second minute hour day - (/ (string-match - (match-string 2) - "xxxJanFebMarAprMayJunJulAugSepOctNovDec") - 3) - year 0)) - (vc-file-setprop file 'vc-checkout-time mtime) - (vc-file-setprop file 'vc-checkout-time 0))) - (throw 'found (cons (concat dirname "CVS/Entries") 'CVS))) - ;; entry for a "locally added" file (not yet committed) - ((re-search-forward - (concat "^/" (regexp-quote basename) "/0/Initial ") nil t) - (setq case-fold-search fold) ;; restore the old value - (vc-file-setprop file 'vc-checkout-time 0) - (vc-file-setprop file 'vc-workfile-version "0") - (throw 'found (cons (concat dirname "CVS/Entries") 'CVS))) - (t (setq case-fold-search fold) ;; restore the old value - nil))) - (kill-buffer buffer))))) - -(defun vc-buffer-backend () - "Return the version-control type of the visited file, or nil if none." - (if (eq vc-buffer-backend t) - (setq vc-buffer-backend (vc-backend (buffer-file-name))) - vc-buffer-backend)) - -(defun vc-toggle-read-only (&optional verbose) - "Change read-only status of current buffer, perhaps via version control. -If the buffer is visiting a file registered with version control, -then check the file in or out. Otherwise, just change the read-only flag -of the buffer. With prefix argument, ask for version number." - (interactive "P") - (if (vc-backend (buffer-file-name)) - (vc-next-action verbose) - (toggle-read-only))) -(define-key global-map "\C-x\C-q" 'vc-toggle-read-only) - -(defun vc-after-save () - ;; Function to be called by basic-save-buffer (in files.el). - ;; If the file in the current buffer is under version control, - ;; not locked, and the checkout model for it is `implicit', - ;; mark it "locked" and redisplay the mode line. - (let ((file (buffer-file-name))) - (and (vc-file-getprop file 'vc-backend) - ;; ...check the property directly, not through the function of the - ;; same name. Otherwise Emacs would check for a master file - ;; each time a non-version-controlled buffer is saved. - ;; The property is computed when the file is visited, so if it - ;; is `nil' now, it is certain that the file is NOT - ;; version-controlled. - (or (and (equal (vc-file-getprop file 'vc-checkout-time) - (nth 5 (file-attributes file))) - ;; File has been saved in the same second in which - ;; it was checked out. Clear the checkout-time - ;; to avoid confusion. - (vc-file-setprop file 'vc-checkout-time nil)) - t) - (not (vc-locking-user file)) - (eq (vc-checkout-model file) 'implicit) - (vc-file-setprop file 'vc-locking-user (vc-user-login-name)) - (or (and (eq (vc-backend file) 'CVS) - (vc-file-setprop file 'vc-cvs-status nil)) - t) - (vc-mode-line file)))) - -(defun vc-mode-line (file &optional label) - "Set `vc-mode' to display type of version control for FILE. -The value is set in the current buffer, which should be the buffer -visiting FILE. Second optional arg LABEL is put in place of version -control system name." - (interactive (list buffer-file-name nil)) - (let ((vc-type (vc-backend file))) - (setq vc-mode - (and vc-type - (concat " " (or label (symbol-name vc-type)) - (and vc-display-status (vc-status file))))) - ;; If the file is locked by some other user, make - ;; the buffer read-only. Like this, even root - ;; cannot modify a file that someone else has locked. - (and vc-type - (equal file (buffer-file-name)) - (vc-locking-user file) - (not (string= (vc-user-login-name) (vc-locking-user file))) - (setq buffer-read-only t)) - ;; If the user is root, and the file is not owner-writable, - ;; then pretend that we can't write it - ;; even though we can (because root can write anything). - ;; This way, even root cannot modify a file that isn't locked. - (and vc-type - (equal file (buffer-file-name)) - (not buffer-read-only) - (zerop (user-real-uid)) - (zerop (logand (file-modes (buffer-file-name)) 128)) - (setq buffer-read-only t)) - (force-mode-line-update) - ;;(set-buffer-modified-p (buffer-modified-p)) ;;use this if Emacs 18 - vc-type)) - -(defun vc-status (file) - ;; Return string for placement in modeline by `vc-mode-line'. - ;; Format: - ;; - ;; "-REV" if the revision is not locked - ;; ":REV" if the revision is locked by the user - ;; ":LOCKER:REV" if the revision is locked by somebody else - ;; " @@" for a CVS file that is added, but not yet committed - ;; - ;; In the CVS case, a "locked" working file is a - ;; working file that is modified with respect to the master. - ;; The file is "locked" from the moment when the user saves - ;; the modified buffer. - ;; - ;; This function assumes that the file is registered. - - (let ((locker (vc-locking-user file)) - (rev (vc-workfile-version file))) - (cond ((string= "0" rev) - " @@") - ((not locker) - (concat "-" rev)) - ((string= locker (vc-user-login-name)) - (concat ":" rev)) - (t - (concat ":" locker ":" rev))))) - -(defun vc-follow-link () - ;; If the current buffer visits a symbolic link, this function makes it - ;; visit the real file instead. If the real file is already visited in - ;; another buffer, make that buffer current, and kill the buffer - ;; that visits the link. - (let* ((truename (abbreviate-file-name (file-chase-links buffer-file-name))) - (true-buffer (find-buffer-visiting truename)) - (this-buffer (current-buffer))) - (if (eq true-buffer this-buffer) - (progn - (kill-buffer this-buffer) - ;; In principle, we could do something like set-visited-file-name. - ;; However, it can't be exactly the same as set-visited-file-name. - ;; I'm not going to work out the details right now. -- rms. - (set-buffer (find-file-noselect truename))) - (set-buffer true-buffer) - (kill-buffer this-buffer)))) - -;;; install a call to the above as a find-file hook -(defun vc-find-file-hook () - ;; Recompute whether file is version controlled, - ;; if user has killed the buffer and revisited. - (cond - (buffer-file-name - (vc-file-clearprops buffer-file-name) - (cond - ((vc-backend buffer-file-name) - (vc-mode-line buffer-file-name) - (cond ((not vc-make-backup-files) - ;; Use this variable, not make-backup-files, - ;; because this is for things that depend on the file name. - (make-local-variable 'backup-inhibited) - (setq backup-inhibited t)))) - ((let* ((link (file-symlink-p buffer-file-name)) - (link-type (and link (vc-backend (file-chase-links link))))) - (if link-type - (cond ((eq vc-follow-symlinks nil) - (message - "Warning: symbolic link to %s-controlled source file" link-type)) - ((or (not (eq vc-follow-symlinks 'ask)) - ;; If we already visited this file by following - ;; the link, don't ask again if we try to visit - ;; it again. GUD does that, and repeated questions - ;; are painful. - (get-file-buffer - (abbreviate-file-name (file-chase-links buffer-file-name)))) - - (vc-follow-link) - (message "Followed link to %s" buffer-file-name) - (vc-find-file-hook)) - (t - (if (yes-or-no-p (format - "Symbolic link to %s-controlled source file; follow link? " link-type)) - (progn (vc-follow-link) - (message "Followed link to %s" buffer-file-name) - (vc-find-file-hook)) - (message - "Warning: editing through the link bypasses version control") - )))))))))) - -(add-hook 'find-file-hooks 'vc-find-file-hook) - -;;; more hooks, this time for file-not-found -(defun vc-file-not-found-hook () - "When file is not found, try to check it out from RCS or SCCS. -Returns t if checkout was successful, nil otherwise." - (if (vc-backend buffer-file-name) - (save-excursion - (require 'vc) - (setq default-directory (file-name-directory (buffer-file-name))) - (not (vc-error-occurred (vc-checkout buffer-file-name)))))) - -(add-hook 'find-file-not-found-hooks 'vc-file-not-found-hook) - -;; Discard info about a file when we kill its buffer. -(defun vc-kill-buffer-hook () - (if (stringp (buffer-file-name)) - (progn - (vc-file-clearprops (buffer-file-name)) - (kill-local-variable 'vc-buffer-backend)))) - -;;;(add-hook 'kill-buffer-hook 'vc-kill-buffer-hook) - -;;; Now arrange for bindings and autoloading of the main package. -;;; Bindings for this have to go in the global map, as we'll often -;;; want to call them from random buffers. - -(setq vc-prefix-map (lookup-key global-map "\C-xv")) -(if (not (keymapp vc-prefix-map)) - (progn - (setq vc-prefix-map (make-sparse-keymap)) - (define-key global-map "\C-xv" vc-prefix-map) - (define-key vc-prefix-map "a" 'vc-update-change-log) - (define-key vc-prefix-map "c" 'vc-cancel-version) - (define-key vc-prefix-map "d" 'vc-directory) - (define-key vc-prefix-map "h" 'vc-insert-headers) - (define-key vc-prefix-map "i" 'vc-register) - (define-key vc-prefix-map "l" 'vc-print-log) - (define-key vc-prefix-map "r" 'vc-retrieve-snapshot) - (define-key vc-prefix-map "s" 'vc-create-snapshot) - (define-key vc-prefix-map "u" 'vc-revert-buffer) - (define-key vc-prefix-map "v" 'vc-next-action) - (define-key vc-prefix-map "=" 'vc-diff) - (define-key vc-prefix-map "~" 'vc-version-other-window))) - -;; Emacs menus -;(if (not (boundp 'vc-menu-map)) -; ;; Don't do the menu bindings if menu-bar.el wasn't loaded to defvar -; ;; vc-menu-map. -; () -; ;;(define-key vc-menu-map [show-files] -; ;; '("Show Files under VC" . (vc-directory t))) -; (define-key vc-menu-map [vc-directory] '("Show Locked Files" . vc-directory)) -; (define-key vc-menu-map [separator1] '("----")) -; (define-key vc-menu-map [vc-rename-file] '("Rename File" . vc-rename-file)) -; (define-key vc-menu-map [vc-version-other-window] -; '("Show Other Version" . vc-version-other-window)) -; (define-key vc-menu-map [vc-diff] '("Compare with Last Version" . vc-diff)) -; (define-key vc-menu-map [vc-update-change-log] -; '("Update ChangeLog" . vc-update-change-log)) -; (define-key vc-menu-map [vc-print-log] '("Show History" . vc-print-log)) -; (define-key vc-menu-map [separator2] '("----")) -; (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version)) -; (define-key vc-menu-map [vc-revert-buffer] -; '("Revert to Last Version" . vc-revert-buffer)) -; (define-key vc-menu-map [vc-insert-header] -; '("Insert Header" . vc-insert-headers)) -; (define-key vc-menu-map [vc-menu-check-in] '("Check In" . vc-next-action)) -; (define-key vc-menu-map [vc-check-out] '("Check Out" . vc-toggle-read-only)) -; (define-key vc-menu-map [vc-register] '("Register" . vc-register))) - -;(put 'vc-rename-file 'menu-enable 'vc-mode) -;(put 'vc-version-other-window 'menu-enable 'vc-mode) -;(put 'vc-diff 'menu-enable 'vc-mode) -;(put 'vc-update-change-log 'menu-enable -; '(eq (vc-buffer-backend) 'RCS)) -;(put 'vc-print-log 'menu-enable 'vc-mode) -;(put 'vc-cancel-version 'menu-enable 'vc-mode) -;(put 'vc-revert-buffer 'menu-enable 'vc-mode) -;(put 'vc-insert-headers 'menu-enable 'vc-mode) -;(put 'vc-next-action 'menu-enable 'vc-mode) -;(put 'vc-toggle-read-only 'menu-enable 'vc-mode) -;(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode))) - -(defconst vc-menu - '("VC" - :filter vc-menu-filter - ["" vc-next-action buffer-file-name nil] - ;;["Show Locked Files" vc-directory t] ;; needs new dired - "----" - ["Revert to Last Revision" vc-revert-buffer vc-mode nil] - ["Cancel Last Checkin" vc-cancel-version vc-mode] - ["Rename File" vc-rename-this-file vc-mode nil] - "----" - ["Diff Against Last Version" vc-diff vc-mode] - ["Diff Between Revisions..." vc-version-diff vc-mode] - ;;["Ediff Between Revisions..." ediff-revision vc-mode] - ["Visit Other Version..." vc-version-other-window vc-mode] - ["Show Edit History" vc-print-log vc-mode] - "----" - ;; The two commented out List functions simply don't work at the - ;; moment. - ;;["List Locked Files" (vc-directory '(16)) t] - ["List Locked Files Any User" vc-directory t] - ;;["List Registered Files" (vc-directory '(4)) t] - "----" - ["Create Snapshot" vc-create-snapshot t] - ["Retrieve Snapshot" vc-retrieve-snapshot t] - "----" - ["CVS Update Directory" cvs-update t] ; pcl-cvs - ;;["Show File Status" vc-cvs-file-status vc-mode] - ) - "Menubar entry for using the revision control system.") - -(defun vc-menu-filter (menu-items) - (let* ((result menu-items) ; modify in-place - (case-fold-search t) - (type (vc-backend buffer-file-name)) - (file (if buffer-file-name - (file-name-nondirectory buffer-file-name) - (buffer-name))) - op owner item status) - (setq op (cond ((null type) - "Register File") - ((eq type 'CVS) - (setq status - (vc-file-getprop buffer-file-name 'cvs-status)) - (if status - (cdr (assoc status - '(("Locally Modified" . "Commit") - ("Needs Merge" . "Merge with repository") - ("Up-to-date" . "Do nothing to") - ("Needs Checkout" . "Update")))) - ;; #### - we're not gonna call cvs status just to - ;; post a lousy menu...that's insane! - "Next action on" - )) - ;; these are all for RCS and SCCS - ((not (setq owner (vc-file-owner file))) - ;; #### - ugh! this is broken. - ;; vc-file-owner is not a suitable - ;; substitute for vc-locking-user. - "Check out File") - ((not (string-equal owner (user-login-name))) - "Steal File Lock") - (t "Check in File"))) - (while (setq item (pop menu-items)) - (and (vectorp item) - (cond ((eq 'vc-next-action (aref item 1)) - (aset item 0 op) - (aset item 3 file)) - ((eq 'vc-file-status (aref item 1)) - (aset item 2 (eq 'CVS type)) - (aset item 3 file)) - ((> (length item) 3) - (aset item 3 file))))) - result)) - -(and (featurep 'menubar) - current-menubar - (car (find-menu-item current-menubar '("Tools"))) - (add-submenu '("Tools") vc-menu "Compare") - (add-menu-button '("Tools") "---" "Compare")) - -;;; End XEmacs menus - -(provide 'vc-hooks) - -;;; vc-hooks.el ends here diff -r f0deb0c0e6be -r eb5470882647 lisp/packages/vc.el --- a/lisp/packages/vc.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2838 +0,0 @@ -;;; vc.el --- drive a version-control system from within Emacs - -;; Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. - -;; Author: Eric S. Raymond -;; Maintainer: Andre Spiegel -;; Maintainer: (ClearCase) Rod Whitby -;; XEmacs conversion: Steve Baur - -;; 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 mode is fully documented in the Emacs user's manual. -;; -;; This was designed and implemented by Eric Raymond . -;; Paul Eggert , Sebastian Kremer , -;; and Richard Stallman contributed valuable criticism, support, and testing. -;; CVS support was added by Per Cederqvist -;; in Jan-Feb 1994. Further enhancements came from ttn.netcom.com and -;; Andre Spiegel . -;; -;; Supported version-control systems presently include SCCS, RCS, and CVS. -;; -;; Some features will not work with old RCS versions. Where -;; appropriate, VC finds out which version you have, and allows or -;; disallows those features (stealing locks, for example, works only -;; from 5.6.2 onwards). -;; Even initial checkins will fail if your RCS version is so old that ci -;; doesn't understand -t-; this has been known to happen to people running -;; NExTSTEP 3.0. -;; -;; You can support the RCS -x option by adding pairs to the -;; vc-master-templates list. -;; -;; Proper function of the SCCS diff commands requires the shellscript vcdiff -;; to be installed somewhere on Emacs's path for executables. -;; -;; If your site uses the ChangeLog convention supported by Emacs, the -;; function vc-comment-to-change-log should prove a useful checkin hook. -;; -;; This code depends on call-process passing back the subprocess exit -;; status. Thus, you need Emacs 18.58 or later to run it. For the -;; vc-directory command to work properly as documented, you need 19. -;; You also need Emacs 19's ring.el. -;; -;; The vc code maintains some internal state in order to reduce expensive -;; version-control operations to a minimum. Some names are only computed -;; once. If you perform version control operations with RCS/SCCS/CVS while -;; vc's back is turned, or move/rename master files while vc is running, -;; vc may get seriously confused. Don't do these things! -;; -;; Developer's notes on some concurrency issues are included at the end of -;; the file. -;; -;; Rudimentary ClearCase support by Rod Whitby . -;; I (Rod Whitby) intend to maintain the rudimentary functionality that is -;; currently in this file. At some time in the future (don't hold your -;; breath), I intend to merge the functionality of the cc-vc package -;; (separately available from /rtfm.mit.edu:/pub/cc-vc/) into this file. -;; I am not the maintainer of cc-vc, nor am I the maintainer of the -;; non-ClearCase parts of this file. -;;; Code: - -(require 'vc-hooks) -(require 'ring) -(eval-when-compile (require 'dired)) ; for dired-map-over-marks macro - -(if (not (assoc 'vc-parent-buffer minor-mode-alist)) - (setq minor-mode-alist - (cons '(vc-parent-buffer vc-parent-buffer-name) - minor-mode-alist))) - -;; To implement support for a new version-control system, add another -;; branch to the vc-backend-dispatch macro and fill it in in each -;; call. The variable vc-master-templates in vc-hooks.el will also -;; have to change. - -(defmacro vc-backend-dispatch (f s r c) - "Execute FORM1, FORM2 or FORM3 for SCCS, RCS or CVS respectively. -If FORM3 is `RCS', use FORM2 for CVS as well as RCS. -\(CVS shares some code with RCS)." - (list 'let (list (list 'type (list 'vc-backend f))) - (list 'cond - (list (list 'eq 'type (quote 'SCCS)) s) ;; SCCS - (list (list 'eq 'type (quote 'RCS)) r) ;; RCS - (list (list 'eq 'type (quote 'CVS)) ;; CVS - (if (eq c 'RCS) r c)) - ))) - -;; General customization - -(defvar vc-suppress-confirm nil - "*If non-nil, treat user as expert; suppress yes-no prompts on some things.") -(defvar vc-initial-comment nil - "*If non-nil, prompt for initial comment when a file is registered.") -(defvar vc-command-messages nil - "*If non-nil, display run messages from back-end commands.") -(defvar vc-register-switches nil - "*A string or list of strings specifying extra switches passed -to the register program by \\[vc-register].") -(defvar vc-checkin-switches nil - "*A string or list of strings specifying extra switches passed -to the checkin program by \\[vc-checkin].") -(defvar vc-checkout-switches nil - "*A string or list of strings specifying extra switches passed -to the checkout program by \\[vc-checkout].") -(defvar vc-directory-exclusion-list '("SCCS" "RCS" "CVS") - "*A list of directory names ignored by functions that recursively -walk file trees.") -(defvar vc-default-init-version nil - "*A string giving the default version number for the function `vc-register'. -If `nil' (default), the choice of initial version is left to the -version control program. Can be overridden by giving a prefix -argument to `vc-register'.") - -(defconst vc-maximum-comment-ring-size 32 - "Maximum number of saved comments in the comment ring.") - -;;; This is duplicated in diff.el. -;;; XEmacs: remove -;;(defvar diff-switches "-c" -;; "*A string or list of strings specifying switches to be be passed to diff.") - -;;;###autoload -(defvar vc-before-checkin-hook nil - "*Normal hook (list of functions) run before a file gets checked in. -See `run-hooks'.") - -;;;###autoload -(defvar vc-checkin-hook nil - "*Normal hook (List of functions) run after a checkin is done. -See `run-hooks'.") - -;; Header-insertion hair - -(defvar vc-header-alist - '((SCCS "\%W\%") (RCS "\$Id\$") (CVS "\$Id\$")) - "*Header keywords to be inserted by `vc-insert-headers'. -Must be a list of two-element lists, the first element of each must -be `RCS', `CVS', or `SCCS'. The second element is the string to -be inserted for this particular backend.") -(defvar vc-static-header-alist - '(("\\.c$" . - "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n")) - "*Associate static header string templates with file types. A \%s in the -template is replaced with the first string associated with the file's -version-control type in `vc-header-alist'.") - -(defvar vc-comment-alist - '((nroff-mode ".\\\"" "")) - "*Special comment delimiters to be used in generating vc headers only. -Add an entry in this list if you need to override the normal comment-start -and comment-end variables. This will only be necessary if the mode language -is sensitive to blank lines.") - -;; Default is to be extra careful for super-user. -(defvar vc-checkout-carefully (= (user-uid) 0) - "*Non-nil means be extra-careful in checkout. -Verify that the file really is not locked -and that its contents match what the master file says.") - -(defvar vc-rcs-release nil - "*The release number of your RCS installation, as a string. -If nil, VC itself computes this value when it is first needed.") - -(defvar vc-sccs-release nil - "*The release number of your SCCS installation, as a string. -If nil, VC itself computes this value when it is first needed.") - -(defvar vc-cvs-release nil - "*The release number of your CVS installation, as a string. -If nil, VC itself computes this value when it is first needed.") - -;; Variables the user doesn't need to know about. -(defvar vc-log-entry-mode nil) -(defvar vc-log-operation nil) -(defvar vc-log-after-operation-hook nil) -(defvar vc-checkout-writable-buffer-hook 'vc-checkout-writable-buffer) -;; In a log entry buffer, this is a local variable -;; that points to the buffer for which it was made -;; (either a file, or a VC dired buffer). -(defvar vc-parent-buffer nil) -(defvar vc-parent-buffer-name nil) - -(defvar vc-log-file) -(defvar vc-log-version) - -(defconst vc-name-assoc-file "VC-names") - -(defvar vc-dired-mode nil) -(make-variable-buffer-local 'vc-dired-mode) - -(defvar vc-comment-ring (make-ring vc-maximum-comment-ring-size)) -(defvar vc-comment-ring-index nil) -(defvar vc-last-comment-match nil) - -;; Back-portability to Emacs 18 - -(defun file-executable-p-18 (f) - (let ((modes (file-modes f))) - (and modes (not (zerop (logand 292)))))) - -(defun file-regular-p-18 (f) - (let ((attributes (file-attributes f))) - (and attributes (not (car attributes))))) - -; Conditionally rebind some things for Emacs 18 compatibility -(if (not (boundp 'minor-mode-map-alist)) - (progn - (setq compilation-old-error-list nil) - (fset 'file-executable-p 'file-executable-p-18) - (fset 'shrink-window-if-larger-than-buffer 'beginning-of-buffer) - )) - -(if (not (fboundp 'file-regular-p)) - (fset 'file-regular-p 'file-regular-p-18)) - -;;; Find and compare backend releases - -(defun vc-backend-release (backend) - ;; Returns which backend release is installed on this system. - (cond - ((eq backend 'RCS) - (or vc-rcs-release - (and (zerop (vc-do-command nil nil "rcs" nil nil "-V")) - (save-excursion - (set-buffer (get-buffer "*vc*")) - (setq vc-rcs-release - (car (vc-parse-buffer - '(("^RCS version \\([0-9.]+ *.*\\)" 1))))))) - (setq vc-rcs-release 'unknown))) - ((eq backend 'CVS) - (or vc-cvs-release - (and (zerop (vc-do-command nil 1 "cvs" nil nil "-v")) - (save-excursion - (set-buffer (get-buffer "*vc*")) - (setq vc-cvs-release - (car (vc-parse-buffer - '(("^Concurrent Versions System (CVS) \\([0-9.]+\\)" - 1))))))) - (setq vc-cvs-release 'unknown))) - ((eq backend 'SCCS) - vc-sccs-release))) - -(defun vc-release-greater-or-equal (r1 r2) - ;; Compare release numbers, represented as strings. - ;; Release components are assumed cardinal numbers, not decimal - ;; fractions (5.10 is a higher release than 5.9). Omitted fields - ;; are considered lower (5.6.7 is earlier than 5.6.7.1). - ;; Comparison runs till the end of the string is found, or a - ;; non-numeric component shows up (5.6.7 is earlier than "5.6.7 beta", - ;; which is probably not what you want in some cases). - ;; This code is suitable for existing RCS release numbers. - ;; CVS releases are handled reasonably, too (1.3 < 1.4* < 1.5). - (let (v1 v2 i1 i2) - (catch 'done - (or (and (string-match "^\\.?\\([0-9]+\\)" r1) - (setq i1 (match-end 0)) - (setq v1 (string-to-number (match-string 1 r1))) - (or (and (string-match "^\\.?\\([0-9]+\\)" r2) - (setq i2 (match-end 0)) - (setq v2 (string-to-number (match-string 1 r2))) - (if (> v1 v2) (throw 'done t) - (if (< v1 v2) (throw 'done nil) - (throw 'done - (vc-release-greater-or-equal - (substring r1 i1) - (substring r2 i2))))))) - (throw 'done t))) - (or (and (string-match "^\\.?\\([0-9]+\\)" r2) - (throw 'done nil)) - (throw 'done t))))) - -(defun vc-backend-release-p (backend release) - ;; Return t if we have RELEASE of BACKEND or better - (let (i r (ri 0) (ii 0) is rs (installation (vc-backend-release backend))) - (if (not (eq installation 'unknown)) - (cond - ((or (eq backend 'RCS) (eq backend 'CVS)) - (vc-release-greater-or-equal installation release)))))) - -;;; functions that operate on RCS revision numbers - -(defun vc-trunk-p (rev) - ;; return t if REV is a revision on the trunk - (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev)))) - -(defun vc-branch-part (rev) - ;; return the branch part of a revision number REV - (substring rev 0 (string-match "\\.[0-9]+\\'" rev))) - -;; File property caching - -(defun vc-clear-context () - "Clear all cached file properties and the comment ring." - (interactive) - (fillarray vc-file-prop-obarray nil) - ;; Note: there is potential for minor lossage here if there is an open - ;; log buffer with a nonzero local value of vc-comment-ring-index. - (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size))) - -(defun vc-file-clear-masterprops (file) - ;; clear all properties of FILE that were retrieved - ;; from the master file - (vc-file-setprop file 'vc-latest-version nil) - (vc-file-setprop file 'vc-your-latest-version nil) - (vc-backend-dispatch file - (progn ;; SCCS - (vc-file-setprop file 'vc-master-locks nil)) - (progn ;; RCS - (vc-file-setprop file 'vc-default-branch nil) - (vc-file-setprop file 'vc-head-version nil) - (vc-file-setprop file 'vc-master-workfile-version nil) - (vc-file-setprop file 'vc-master-locks nil)) - (progn - (vc-file-setprop file 'vc-cvs-status nil)))) - -(defun vc-head-version (file) - ;; Return the RCS head version of FILE - (cond ((vc-file-getprop file 'vc-head-version)) - (t (vc-fetch-master-properties file) - (vc-file-getprop file 'vc-head-version)))) - -;; Random helper functions - -(defun vc-latest-on-branch-p (file) - ;; return t iff the current workfile version of FILE is - ;; the latest on its branch. - (vc-backend-dispatch file - ;; SCCS - (string= (vc-workfile-version file) (vc-latest-version file)) - ;; RCS - (let ((workfile-version (vc-workfile-version file)) tip-version) - (if (vc-trunk-p workfile-version) - (progn - ;; Re-fetch the head version number. This is to make - ;; sure that no-one has checked in a new version behind - ;; our back. - (vc-fetch-master-properties file) - (string= (vc-file-getprop file 'vc-head-version) - workfile-version)) - ;; If we are not on the trunk, we need to examine the - ;; whole current branch. (vc-master-workfile-version - ;; is not what we need.) - (save-excursion - (set-buffer (get-buffer-create "*vc-info*")) - (vc-insert-file (vc-name file) "^desc") - (setq tip-version (car (vc-parse-buffer (list (list - (concat "^\\(" (regexp-quote (vc-branch-part workfile-version)) - "\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2))))) - (if (get-buffer "*vc-info*") - (kill-buffer (get-buffer "*vc-info*"))) - (string= tip-version workfile-version)))) - ;; CVS - t)) - -(defun vc-registration-error (file) - (if file - (error "File %s is not under version control" file) - (error "Buffer %s is not associated with a file" (buffer-name)))) - -(defvar vc-binary-assoc nil) - -;; XEmacs: Function referred to in vc-hooks.el -;;;###autoload -(defun vc-find-binary (name) - "Look for a command anywhere on the subprocess-command search path." - (or (cdr (assoc name vc-binary-assoc)) - (catch 'found - (mapcar - (function - (lambda (s) - (if s - (let ((full (concat s "/" name))) - (if (file-executable-p full) - (progn - (setq vc-binary-assoc - (cons (cons name full) vc-binary-assoc)) - (throw 'found full))))))) - exec-path) - nil))) - -(defun vc-do-command (buffer okstatus command file last &rest flags) - "Execute a version-control command, notifying user and checking for errors. -Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil. -The command is successful if its exit status does not exceed OKSTATUS. - (If OKSTATUS is nil, that means to ignore errors.) -The last argument of the command is the master name of FILE if LAST is -`MASTER', or the workfile of FILE if LAST is `WORKFILE'; this is appended -to an optional list of FLAGS." - (and file (setq file (expand-file-name file))) - (if (not buffer) (setq buffer "*vc*")) - (if vc-command-messages - (message "Running %s on %s..." command file)) - (let ((obuf (current-buffer)) (camefrom (current-buffer)) - (squeezed nil) - (vc-file (and file (vc-name file))) - (olddir default-directory) - status) - (set-buffer (get-buffer-create buffer)) - (set (make-local-variable 'vc-parent-buffer) camefrom) - (set (make-local-variable 'vc-parent-buffer-name) - (concat " from " (buffer-name camefrom))) - (setq default-directory olddir) - - (erase-buffer) - - (mapcar - (function (lambda (s) (and s (setq squeezed (append squeezed (list s)))))) - flags) - (if (and vc-file (eq last 'MASTER)) - (setq squeezed (append squeezed (list vc-file)))) - (if (eq last 'WORKFILE) - (progn - (let* ((pwd (expand-file-name default-directory)) - (preflen (length pwd))) - (if (string= (substring file 0 preflen) pwd) - (setq file (substring file preflen)))) - (setq squeezed (append squeezed (list file))))) - (let ((exec-path (append vc-path exec-path)) - ;; Add vc-path to PATH for the execution of this command. - (process-environment - (cons (concat "PATH=" (getenv "PATH") - path-separator - (mapconcat 'identity vc-path path-separator)) - process-environment)) - (w32-quote-process-args t)) - (setq status (apply 'call-process command nil t nil squeezed))) - (goto-char (point-max)) - (set-buffer-modified-p nil) - (forward-line -1) - (if (or (not (integerp status)) (and okstatus (< okstatus status))) - (progn - (pop-to-buffer buffer) - (goto-char (point-min)) - (shrink-window-if-larger-than-buffer) - (error "Running %s...FAILED (%s)" command - (if (integerp status) - (format "status %d" status) - status)) - ) - (if vc-command-messages - (message "Running %s...OK" command)) - ) - (set-buffer obuf) - status) - ) - -;;; Save a bit of the text around POSN in the current buffer, to help -;;; us find the corresponding position again later. This works even -;;; if all markers are destroyed or corrupted. -;;; A lot of this was shamelessly lifted from Sebastian Kremer's rcs.el mode. -(defun vc-position-context (posn) - (list posn - (buffer-size) - (buffer-substring posn - (min (point-max) (+ posn 100))))) - -;;; Return the position of CONTEXT in the current buffer, or nil if we -;;; couldn't find it. -(defun vc-find-position-by-context (context) - (let ((context-string (nth 2 context))) - (if (equal "" context-string) - (point-max) - (save-excursion - (let ((diff (- (nth 1 context) (buffer-size)))) - (if (< diff 0) (setq diff (- diff))) - (goto-char (nth 0 context)) - (if (or (search-forward context-string nil t) - ;; Can't use search-backward since the match may continue - ;; after point. - (progn (goto-char (- (point) diff (length context-string))) - ;; goto-char doesn't signal an error at - ;; beginning of buffer like backward-char would - (search-forward context-string nil t))) - ;; to beginning of OSTRING - (- (point) (length context-string)))))))) - -(defun vc-buffer-context () - ;; Return a list '(point-context mark-context reparse); from which - ;; vc-restore-buffer-context can later restore the context. - (let ((point-context (vc-position-context (point))) - ;; Use mark-marker to avoid confusion in transient-mark-mode. - (mark-context (if (eq (marker-buffer (mark-marker #+xemacs t)) - (current-buffer)) - (vc-position-context (mark-marker #+xemacs t)))) - ;; Make the right thing happen in transient-mark-mode. - (mark-active nil) - ;; We may want to reparse the compilation buffer after revert - (reparse (and (boundp 'compilation-error-list) ;compile loaded - (let ((curbuf (current-buffer))) - ;; Construct a list; each elt is nil or a buffer - ;; iff that buffer is a compilation output buffer - ;; that contains markers into the current buffer. - (save-excursion - (mapcar (function - (lambda (buffer) - (set-buffer buffer) - (let ((errors (or - compilation-old-error-list - compilation-error-list)) - (buffer-error-marked-p nil)) - (while (and (consp errors) - (not buffer-error-marked-p)) - (and (markerp (cdr (car errors))) - (eq buffer - (marker-buffer - (cdr (car errors)))) - (setq buffer-error-marked-p t)) - (setq errors (cdr errors))) - (if buffer-error-marked-p buffer)))) - (buffer-list))))))) - (list point-context mark-context reparse))) - -(defun vc-restore-buffer-context (context) - ;; Restore point/mark, and reparse any affected compilation buffers. - ;; CONTEXT is that which vc-buffer-context returns. - (let ((point-context (nth 0 context)) - (mark-context (nth 1 context)) - (reparse (nth 2 context))) - ;; Reparse affected compilation buffers. - (while reparse - (if (car reparse) - (save-excursion - (set-buffer (car reparse)) - (let ((compilation-last-buffer (current-buffer)) ;select buffer - ;; Record the position in the compilation buffer of - ;; the last error next-error went to. - (error-pos (marker-position - (car (car-safe compilation-error-list))))) - ;; Reparse the error messages as far as they were parsed before. - (compile-reinitialize-errors '(4) compilation-parsing-end) - ;; Move the pointer up to find the error we were at before - ;; reparsing. Now next-error should properly go to the next one. - (while (and compilation-error-list - (/= error-pos (car (car compilation-error-list)))) - (setq compilation-error-list (cdr compilation-error-list)))))) - (setq reparse (cdr reparse))) - - ;; Restore point and mark - (let ((new-point (vc-find-position-by-context point-context))) - (if new-point (goto-char new-point))) - (if mark-context - (let ((new-mark (vc-find-position-by-context mark-context))) - (if new-mark (set-mark new-mark)))))) - -(defun vc-revert-buffer1 (&optional arg no-confirm) - ;; Revert buffer, try to keep point and mark where user expects them in spite - ;; of changes because of expanded version-control key words. - ;; This is quite important since otherwise typeahead won't work as expected. - (interactive "P") - (widen) - (let ((context (vc-buffer-context))) - ;; t means don't call normal-mode; that's to preserve various minor modes. - (revert-buffer arg no-confirm t) - (vc-restore-buffer-context context))) - - -(defun vc-buffer-sync (&optional not-urgent) - ;; Make sure the current buffer and its working file are in sync - ;; NOT-URGENT means it is ok to continue if the user says not to save. - (if (buffer-modified-p) - (if (or vc-suppress-confirm - (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name)))) - (save-buffer) - (if not-urgent - nil - (error "Aborted"))))) - - -(defun vc-workfile-unchanged-p (file &optional want-differences-if-changed) - ;; Has the given workfile changed since last checkout? - (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) - (lastmod (nth 5 (file-attributes file)))) - (or (equal checkout-time lastmod) - (and (or (not checkout-time) want-differences-if-changed) - (let ((unchanged (zerop (vc-backend-diff file nil nil - (not want-differences-if-changed))))) - ;; 0 stands for an unknown time; it can't match any mod time. - (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0)) - unchanged))))) - -(defun vc-next-action-on-file (file verbose &optional comment) - ;;; If comment is specified, it will be used as an admin or checkin comment. - (let ((vc-file (vc-name file)) - (vc-type (vc-backend file)) - owner version buffer) - (cond - - ;; if there is no master file corresponding, create one - ((not vc-file) - (vc-register verbose comment) - (if vc-initial-comment - (setq vc-log-after-operation-hook - 'vc-checkout-writable-buffer-hook) - (vc-checkout-writable-buffer file))) - - ;; CVS: changes to the master file need to be - ;; merged back into the working file - ((and (eq vc-type 'CVS) - (or (eq (vc-cvs-status file) 'needs-checkout) - (eq (vc-cvs-status file) 'needs-merge))) - (if (or vc-dired-mode - (yes-or-no-p - (format "%s is not up-to-date. Merge in changes now? " - (buffer-name)))) - (progn - (if vc-dired-mode - (and (setq buffer (get-file-buffer file)) - (buffer-modified-p buffer) - (switch-to-buffer-other-window buffer) - (vc-buffer-sync t)) - (setq buffer (current-buffer)) - (vc-buffer-sync t)) - (if (and buffer (buffer-modified-p buffer) - (not (yes-or-no-p - (format - "Buffer %s modified; merge file on disc anyhow? " - (buffer-name buffer))))) - (error "Merge aborted")) - (if (not (zerop (vc-backend-merge-news file))) - ;; Overlaps detected - what now? Should use some - ;; fancy RCS conflict resolving package, or maybe - ;; emerge, but for now, simply warn the user with a - ;; message. - (message "Conflicts detected!")) - (and buffer - (vc-resynch-buffer file t (not (buffer-modified-p buffer))))) - (error "%s needs update" (buffer-name)))) - - ;; If there is no lock on the file, assert one and get it. - ;; (With implicit checkout, make sure not to lose unsaved changes.) - ((progn (and (eq (vc-checkout-model file) 'implicit) - (buffer-modified-p buffer) - (vc-buffer-sync)) - (not (setq owner (vc-locking-user file)))) - (if (and vc-checkout-carefully - (not (vc-workfile-unchanged-p file t))) - (if (save-window-excursion - (pop-to-buffer "*vc-diff*") - (goto-char (point-min)) - (insert-string (format "Changes to %s since last lock:\n\n" - file)) - (not (beep)) - (yes-or-no-p - (concat "File has unlocked changes, " - "claim lock retaining changes? "))) - (progn (vc-backend-steal file) - (vc-mode-line file)) - (if (not (yes-or-no-p "Revert to checked-in version, instead? ")) - (error "Checkout aborted") - (vc-revert-buffer1 t t) - (vc-checkout-writable-buffer file)) - ) - (if verbose - (if (not (eq vc-type 'SCCS)) - (vc-checkout file nil - (read-string "Branch or version to move to: ")) - (error "Sorry, this is not implemented for SCCS")) - (if (vc-latest-on-branch-p file) - (vc-checkout-writable-buffer file) - (if (yes-or-no-p - "This is not the latest version. Really lock it? ") - (vc-checkout-writable-buffer file) - (if (yes-or-no-p "Lock the latest version instead? ") - (vc-checkout-writable-buffer file - (if (vc-trunk-p (vc-workfile-version file)) - "" ;; this means check out latest on trunk - (vc-branch-part (vc-workfile-version file))))))) - ))) - - ;; a checked-out version exists, but the user may not own the lock - ((and (not (eq vc-type 'CVS)) - (not (string-equal owner (vc-user-login-name)))) - (if comment - (error "Sorry, you can't steal the lock on %s this way" file)) - (and (eq vc-type 'RCS) - (not (vc-backend-release-p 'RCS "5.6.2")) - (error "File is locked by %s" owner)) - (vc-steal-lock - file - (if verbose (read-string "Version to steal: ") - (vc-workfile-version file)) - owner)) - - ;; OK, user owns the lock on the file - (t - (if vc-dired-mode - (find-file-other-window file) - (find-file file)) - - ;; give luser a chance to save before checking in. - (vc-buffer-sync) - - ;; Revert if file is unchanged and buffer is too. - ;; If buffer is modified, that means the user just said no - ;; to saving it; in that case, don't revert, - ;; because the user might intend to save - ;; after finishing the log entry. - (if (and (vc-workfile-unchanged-p file) - (not (buffer-modified-p))) - ;; DO NOT revert the file without asking the user! - (cond - ((yes-or-no-p "Revert to master version? ") - (vc-backend-revert file) - (vc-resynch-window file t t))) - - ;; user may want to set nonstandard parameters - (if verbose - (setq version (read-string "New version level: "))) - - ;; OK, let's do the checkin - (vc-checkin file version comment) - ))))) - -(defun vc-next-action-dired (file rev comment) - ;; Do a vc-next-action-on-file on all the marked files, possibly - ;; passing on the log comment we've just entered. - (let ((configuration (current-window-configuration)) - (dired-buffer (current-buffer)) - (dired-dir default-directory)) - (dired-map-over-marks - (let ((file (dired-get-filename)) p - (default-directory default-directory)) - (message "Processing %s..." file) - ;; Adjust the default directory so that checkouts - ;; go to the right place. - (setq default-directory (file-name-directory file)) - (vc-next-action-on-file file nil comment) - (set-buffer dired-buffer) - (setq default-directory dired-dir) - (vc-dired-update-line file) - (set-window-configuration configuration) - (message "Processing %s...done" file)) - nil t))) - -;; Here's the major entry point. - -;;;###autoload -(defun vc-next-action (verbose) - "Do the next logical checkin or checkout operation on the current file. - If you call this from within a VC dired buffer with no files marked, -it will operate on the file in the current line. - If you call this from within a VC dired buffer, and one or more -files are marked, it will accept a log message and then operate on -each one. The log message will be used as a comment for any register -or checkin operations, but ignored when doing checkouts. Attempted -lock steals will raise an error. - A prefix argument lets you specify the version number to use. - -For RCS and SCCS files: - If the file is not already registered, this registers it for version -control and then retrieves a writable, locked copy for editing. - If the file is registered and not locked by anyone, this checks out -a writable and locked file ready for editing. - If the file is checked out and locked by the calling user, this -first checks to see if the file has changed since checkout. If not, -it performs a revert. - If the file has been changed, this pops up a buffer for entry -of a log message; when the message has been entered, it checks in the -resulting changes along with the log message as change commentary. If -the variable `vc-keep-workfiles' is non-nil (which is its default), a -read-only copy of the changed file is left in place afterwards. - If the file is registered and locked by someone else, you are given -the option to steal the lock. - -For CVS files: - If the file is not already registered, this registers it for version -control. This does a \"cvs add\", but no \"cvs commit\". - If the file is added but not committed, it is committed. - If your working file is changed, but the repository file is -unchanged, this pops up a buffer for entry of a log message; when the -message has been entered, it checks in the resulting changes along -with the logmessage as change commentary. A writable file is retained. - If the repository file is changed, you are asked if you want to -merge in the changes into your working copy." - - (interactive "P") - (catch 'nogo - (if vc-dired-mode - (let ((files (dired-get-marked-files))) - (if (string= "" - (mapconcat - (function (lambda (f) - (if (eq (vc-backend f) 'CVS) - (if (or (eq (vc-cvs-status f) 'locally-modified) - (eq (vc-cvs-status f) 'locally-added)) - "@" "") - (if (vc-locking-user f) "@" "")))) - files "")) - (vc-next-action-dired nil nil "dummy") - (vc-start-entry nil nil nil - "Enter a change comment for the marked files." - 'vc-next-action-dired)) - (throw 'nogo nil))) - (while vc-parent-buffer - (pop-to-buffer vc-parent-buffer)) - (if buffer-file-name - (vc-next-action-on-file buffer-file-name verbose) - (vc-registration-error nil)))) - -;;; These functions help the vc-next-action entry point - -(defun vc-checkout-writable-buffer (&optional file rev) - "Retrieve a writable copy of the latest version of the current buffer's file." - (vc-checkout (or file (buffer-file-name)) t rev) - ) - -;;;###autoload -(defun vc-register (&optional override comment) - "Register the current file into your version-control system. -The default initial version number, taken to be `vc-default-init-version', -can be overridden by giving a prefix arg." - (interactive "P") - (or buffer-file-name - (error "No visited file")) - (let ((master (vc-name buffer-file-name))) - (and master (file-exists-p master) - (error "This file is already registered")) - (and master - (not (y-or-n-p "Previous master file has vanished. Make a new one? ")) - (error "This file is already registered"))) - ;; Watch out for new buffers of size 0: the corresponding file - ;; does not exist yet, even though buffer-modified-p is nil. - (if (and (not (buffer-modified-p)) - (zerop (buffer-size)) - (not (file-exists-p buffer-file-name))) - (set-buffer-modified-p t)) - (vc-buffer-sync) - (cond ((not vc-make-backup-files) - ;; inhibit backup for this buffer - (make-local-variable 'backup-inhibited) - (setq backup-inhibited t))) - (vc-admin - buffer-file-name - (or (and override - (read-string - (format "Initial version level for %s: " - buffer-file-name))) - vc-default-init-version) - comment)) - -(defun vc-resynch-window (file &optional keep noquery) - ;; If the given file is in the current buffer, - ;; either revert on it so we see expanded keywords, - ;; or unvisit it (depending on vc-keep-workfiles) - ;; NOQUERY if non-nil inhibits confirmation for reverting. - ;; NOQUERY should be t *only* if it is known the only difference - ;; between the buffer and the file is due to RCS rather than user editing! - (and (string= buffer-file-name file) - (if keep - (progn - ;; temporarily remove vc-find-file-hook, so that - ;; we don't lose the properties - (remove-hook 'find-file-hooks 'vc-find-file-hook) - (vc-revert-buffer1 t noquery) - (add-hook 'find-file-hooks 'vc-find-file-hook) - (vc-mode-line buffer-file-name)) - (kill-buffer (current-buffer))))) - -(defun vc-resynch-buffer (file &optional keep noquery) - ;; if FILE is currently visited, resynch its buffer - (let ((buffer (get-file-buffer file))) - (if buffer - (save-excursion - (set-buffer buffer) - (vc-resynch-window file keep noquery))))) - -(defun vc-start-entry (file rev comment msg action &optional after-hook) - ;; Accept a comment for an operation on FILE revision REV. If COMMENT - ;; is nil, pop up a VC-log buffer, emit MSG, and set the - ;; action on close to ACTION; otherwise, do action immediately. - ;; Remember the file's buffer in vc-parent-buffer (current one if no file). - ;; AFTER-HOOK specifies the local value for vc-log-operation-hook. - (let ((parent (if file (find-file-noselect file) (current-buffer)))) - (if vc-before-checkin-hook - (if file - (save-excursion - (set-buffer parent) - (run-hooks 'vc-before-checkin-hook)) - (run-hooks 'vc-before-checkin-hook))) - (if comment - (set-buffer (get-buffer-create "*VC-log*")) - (pop-to-buffer (get-buffer-create "*VC-log*"))) - (set (make-local-variable 'vc-parent-buffer) parent) - (set (make-local-variable 'vc-parent-buffer-name) - (concat " from " (buffer-name vc-parent-buffer))) - (if file (vc-mode-line file)) - (vc-log-mode file) - (make-local-variable 'vc-log-after-operation-hook) - (if after-hook - (setq vc-log-after-operation-hook after-hook)) - (setq vc-log-operation action) - (setq vc-log-version rev) - (if comment - (progn - (erase-buffer) - (if (eq comment t) - (vc-finish-logentry t) - (insert comment) - (vc-finish-logentry nil))) - (message "%s Type C-c C-c when done." msg)))) - -(defun vc-admin (file rev &optional comment) - "Check a file into your version-control system. -FILE is the unmodified name of the file. REV should be the base version -level to check it in under. COMMENT, if specified, is the checkin comment." - (vc-start-entry file rev - (or comment (not vc-initial-comment)) - "Enter initial comment." 'vc-backend-admin - nil)) - -;; XEmacs: Function referred to in vc-hooks.el. -;;;###autoload -(defun vc-checkout (file &optional writable rev) - "Retrieve a copy of the latest version of the given file." - ;; If ftp is on this system and the name matches the ange-ftp format - ;; for a remote file, the user is trying something that won't work. - (if (and (string-match "^/[^/:]+:" file) (vc-find-binary "ftp")) - (error "Sorry, you can't check out files over FTP")) - (vc-backend-checkout file writable rev) - (vc-resynch-buffer file t t)) - -(defun vc-steal-lock (file rev &optional owner) - "Steal the lock on the current workfile." - (let (file-description) - (if (not owner) - (setq owner (vc-locking-user file))) - (if rev - (setq file-description (format "%s:%s" file rev)) - (setq file-description file)) - (if (not (y-or-n-p (format "Take the lock on %s from %s? " - file-description owner))) - (error "Steal cancelled")) - (pop-to-buffer (get-buffer-create "*VC-mail*")) - (setq default-directory (expand-file-name "~/")) - (auto-save-mode auto-save-default) - (mail-mode) - (erase-buffer) - (mail-setup owner (format "Stolen lock on %s" file-description) nil nil nil - (list (list 'vc-finish-steal file rev))) - (goto-char (point-max)) - (insert - (format "I stole the lock on %s, " file-description) - (current-time-string) - ".\n") - (message "Please explain why you stole the lock. Type C-c C-c when done."))) - -;; This is called when the notification has been sent. -(defun vc-finish-steal (file version) - (vc-backend-steal file version) - (if (get-file-buffer file) - (save-excursion - (set-buffer (get-file-buffer file)) - (vc-resynch-window file t t)))) - -(defun vc-checkin (file &optional rev comment) - "Check in the file specified by FILE. -The optional argument REV may be a string specifying the new version level -\(if nil increment the current level). The file is either retained with write -permissions zeroed, or deleted (according to the value of `vc-keep-workfiles'). -If the back-end is CVS, a writable workfile is always kept. -COMMENT is a comment string; if omitted, a buffer is -popped up to accept a comment." - (vc-start-entry file rev comment - "Enter a change comment." 'vc-backend-checkin - 'vc-checkin-hook)) - -;;; Here is a checkin hook that may prove useful to sites using the -;;; ChangeLog facility supported by Emacs. -(defun vc-comment-to-change-log (&optional whoami file-name) - "Enter last VC comment into change log file for current buffer's file. -Optional arg (interactive prefix) non-nil means prompt for user name and site. -Second arg is file name of change log. \ -If nil, uses `change-log-default-name'." - (interactive (if current-prefix-arg - (list current-prefix-arg - (prompt-for-change-log-name)))) - ;; Make sure the defvar for add-log-current-defun-function has been executed - ;; before binding it. - (require 'add-log) - (let (;; Extract the comment first so we get any error before doing anything. - (comment (ring-ref vc-comment-ring 0)) - ;; Don't let add-change-log-entry insert a defun name. - (add-log-current-defun-function 'ignore) - end) - ;; Call add-log to do half the work. - (add-change-log-entry whoami file-name t t) - ;; Insert the VC comment, leaving point before it. - (setq end (save-excursion (insert comment) (point-marker))) - (if (looking-at "\\s *\\s(") - ;; It starts with an open-paren, as in "(foo): Frobbed." - ;; So remove the ": " add-log inserted. - (delete-char -2)) - ;; Canonicalize the white space between the file name and comment. - (just-one-space) - ;; Indent rest of the text the same way add-log indented the first line. - (let ((indentation (current-indentation))) - (save-excursion - (while (< (point) end) - (forward-line 1) - (indent-to indentation)) - (setq end (point)))) - ;; Fill the inserted text, preserving open-parens at bol. - (let ((paragraph-separate (concat paragraph-separate "\\|\\s *\\s(")) - (paragraph-start (concat paragraph-start "\\|\\s *\\s("))) - (beginning-of-line) - (fill-region (point) end)) - ;; Canonicalize the white space at the end of the entry so it is - ;; separated from the next entry by a single blank line. - (skip-syntax-forward " " end) - (delete-char (- (skip-syntax-backward " "))) - (or (eobp) (looking-at "\n\n") - (insert "\n")))) - - -(defun vc-finish-logentry (&optional nocomment) - "Complete the operation implied by the current log entry." - (interactive) - ;; Check and record the comment, if any. - (if (not nocomment) - (progn - (goto-char (point-max)) - (if (not (bolp)) - (newline)) - ;; Comment too long? - (vc-backend-logentry-check vc-log-file) - ;; Record the comment in the comment ring - (ring-insert vc-comment-ring (buffer-string)) - )) - ;; Sync parent buffer in case the user modified it while editing the comment. - ;; But not if it is a vc-dired buffer. - (save-excursion - (set-buffer vc-parent-buffer) - (or vc-dired-mode - (vc-buffer-sync))) - (if (not vc-log-operation) (error "No log operation is pending")) - ;; save the parameters held in buffer-local variables - (let ((log-operation vc-log-operation) - (log-file vc-log-file) - (log-version vc-log-version) - (log-entry (buffer-string)) - (after-hook vc-log-after-operation-hook)) - ;; Return to "parent" buffer of this checkin and remove checkin window - (pop-to-buffer vc-parent-buffer) - (let ((logbuf (get-buffer "*VC-log*"))) - (delete-windows-on logbuf) - (kill-buffer logbuf)) - ;; OK, do it to it - (save-excursion - (funcall log-operation - log-file - log-version - log-entry)) - ;; Now make sure we see the expanded headers - (if buffer-file-name - (vc-resynch-window buffer-file-name vc-keep-workfiles t)) - (run-hooks after-hook 'vc-finish-logentry-hook))) - -;; Code for access to the comment ring - -(defun vc-previous-comment (arg) - "Cycle backwards through comment history." - (interactive "*p") - (let ((len (ring-length vc-comment-ring))) - (cond ((<= len 0) - (message "Empty comment ring") - (ding)) - (t - (erase-buffer) - ;; Initialize the index on the first use of this command - ;; so that the first M-p gets index 0, and the first M-n gets - ;; index -1. - (if (null vc-comment-ring-index) - (setq vc-comment-ring-index - (if (> arg 0) -1 - (if (< arg 0) 1 0)))) - (setq vc-comment-ring-index - (mod (+ vc-comment-ring-index arg) len)) - (message "%d" (1+ vc-comment-ring-index)) - (insert (ring-ref vc-comment-ring vc-comment-ring-index)))))) - -(defun vc-next-comment (arg) - "Cycle forwards through comment history." - (interactive "*p") - (vc-previous-comment (- arg))) - -(defun vc-comment-search-reverse (str) - "Searches backwards through comment history for substring match." - (interactive "sComment substring: ") - (if (string= str "") - (setq str vc-last-comment-match) - (setq vc-last-comment-match str)) - (if (null vc-comment-ring-index) - (setq vc-comment-ring-index -1)) - (let ((str (regexp-quote str)) - (len (ring-length vc-comment-ring)) - (n (1+ vc-comment-ring-index))) - (while (and (< n len) (not (string-match str (ring-ref vc-comment-ring n)))) - (setq n (+ n 1))) - (cond ((< n len) - (vc-previous-comment (- n vc-comment-ring-index))) - (t (error "Not found"))))) - -(defun vc-comment-search-forward (str) - "Searches forwards through comment history for substring match." - (interactive "sComment substring: ") - (if (string= str "") - (setq str vc-last-comment-match) - (setq vc-last-comment-match str)) - (if (null vc-comment-ring-index) - (setq vc-comment-ring-index 0)) - (let ((str (regexp-quote str)) - (len (ring-length vc-comment-ring)) - (n vc-comment-ring-index)) - (while (and (>= n 0) (not (string-match str (ring-ref vc-comment-ring n)))) - (setq n (- n 1))) - (cond ((>= n 0) - (vc-next-comment (- n vc-comment-ring-index))) - (t (error "Not found"))))) - -;; Additional entry points for examining version histories - -;;;###autoload -(defun vc-diff (historic &optional not-urgent) - "Display diffs between file versions. -Normally this compares the current file and buffer with the most recent -checked in version of that file. This uses no arguments. -With a prefix argument, it reads the file name to use -and two version designators specifying which versions to compare." - (interactive (list current-prefix-arg t)) - (if vc-dired-mode - (set-buffer (find-file-noselect (dired-get-filename)))) - (while vc-parent-buffer - (pop-to-buffer vc-parent-buffer)) - (if historic - (call-interactively 'vc-version-diff) - (if (or (null buffer-file-name) (null (vc-name buffer-file-name))) - (error - "There is no version-control master associated with this buffer")) - (let ((file buffer-file-name) - unchanged) - (or (and file (vc-name file)) - (vc-registration-error file)) - (vc-buffer-sync not-urgent) - (setq unchanged (vc-workfile-unchanged-p buffer-file-name)) - (if unchanged - (message "No changes to %s since latest version" file) - (vc-backend-diff file) - ;; Ideally, we'd like at this point to parse the diff so that - ;; the buffer effectively goes into compilation mode and we - ;; can visit the old and new change locations via next-error. - ;; Unfortunately, this is just too painful to do. The basic - ;; problem is that the `old' file doesn't exist to be - ;; visited. This plays hell with numerous assumptions in - ;; the diff.el and compile.el machinery. - (set-buffer "*vc-diff*") - (setq default-directory (file-name-directory file)) - (if (= 0 (buffer-size)) - (progn - (setq unchanged t) - (message "No changes to %s since latest version" file)) - (pop-to-buffer "*vc-diff*") - (goto-char (point-min)) - (shrink-window-if-larger-than-buffer))) - (not unchanged)))) - -;;;###autoload -(defun vc-version-diff (file rel1 rel2) - "For FILE, report diffs between two stored versions REL1 and REL2 of it. -If FILE is a directory, generate diffs between versions for all registered -files in or below it." - (interactive "FFile or directory to diff: \nsOlder version: \nsNewer version: ") - (if (string-equal rel1 "") (setq rel1 nil)) - (if (string-equal rel2 "") (setq rel2 nil)) - (if (file-directory-p file) - (let ((camefrom (current-buffer))) - (set-buffer (get-buffer-create "*vc-status*")) - (set (make-local-variable 'vc-parent-buffer) camefrom) - (set (make-local-variable 'vc-parent-buffer-name) - (concat " from " (buffer-name camefrom))) - (erase-buffer) - (insert "Diffs between " - (or rel1 "last version checked in") - " and " - (or rel2 "current workfile(s)") - ":\n\n") - (set-buffer (get-buffer-create "*vc-diff*")) - (cd file) - (vc-file-tree-walk - default-directory - (function (lambda (f) - (message "Looking at %s" f) - (and - (not (file-directory-p f)) - (vc-registered f) - (vc-backend-diff f rel1 rel2) - (append-to-buffer "*vc-status*" (point-min) (point-max))) - ))) - (pop-to-buffer "*vc-status*") - (insert "\nEnd of diffs.\n") - (goto-char (point-min)) - (set-buffer-modified-p nil) - ) - (if (zerop (vc-backend-diff file rel1 rel2)) - (message "No changes to %s between %s and %s." file rel1 rel2) - (pop-to-buffer "*vc-diff*")))) - -;;;###autoload -(defun vc-version-other-window (rev) - "Visit version REV of the current buffer in another window. -If the current buffer is named `F', the version is named `F.~REV~'. -If `F.~REV~' already exists, it is used instead of being re-created." - (interactive "sVersion to visit (default is latest version): ") - (if vc-dired-mode - (set-buffer (find-file-noselect (dired-get-filename)))) - (while vc-parent-buffer - (pop-to-buffer vc-parent-buffer)) - (if (and buffer-file-name (vc-name buffer-file-name)) - (let* ((version (if (string-equal rev "") - (vc-latest-version buffer-file-name) - rev)) - (filename (concat buffer-file-name ".~" version "~"))) - (or (file-exists-p filename) - (vc-backend-checkout buffer-file-name nil version filename)) - (find-file-other-window filename)) - (vc-registration-error buffer-file-name))) - -;; Header-insertion code - -;;;###autoload -(defun vc-insert-headers () - "Insert headers in a file for use with your version-control system. -Headers desired are inserted at the start of the buffer, and are pulled from -the variable `vc-header-alist'." - (interactive) - (if vc-dired-mode - (find-file-other-window (dired-get-filename))) - (while vc-parent-buffer - (pop-to-buffer vc-parent-buffer)) - (save-excursion - (save-restriction - (widen) - (if (or (not (vc-check-headers)) - (y-or-n-p "Version headers already exist. Insert another set? ")) - (progn - (let* ((delims (cdr (assq major-mode vc-comment-alist))) - (comment-start-vc (or (car delims) comment-start "#")) - (comment-end-vc (or (car (cdr delims)) comment-end "")) - (hdstrings (cdr (assoc (vc-backend (buffer-file-name)) vc-header-alist)))) - (mapcar (function (lambda (s) - (insert comment-start-vc "\t" s "\t" - comment-end-vc "\n"))) - hdstrings) - (if vc-static-header-alist - (mapcar (function (lambda (f) - (if (string-match (car f) buffer-file-name) - (insert (format (cdr f) (car hdstrings)))))) - vc-static-header-alist)) - ) - ))))) - -(defun vc-clear-headers () - ;; Clear all version headers in the current buffer, i.e. reset them - ;; to the nonexpanded form. Only implemented for RCS, yet. - ;; Don't lose point and mark during this. - (let ((context (vc-buffer-context))) - (goto-char (point-min)) - (while (re-search-forward "\\$\\([A-Za-z]+\\): [^\\$]+\\$" nil t) - (replace-match "$\\1$")) - (vc-restore-buffer-context context))) - -;; The VC directory major mode. Coopt Dired for this. -;; All VC commands get mapped into logical equivalents. - -(define-derived-mode vc-dired-mode dired-mode "Dired under VC" - "The major mode used in VC directory buffers. It is derived from Dired. -All Dired commands operate normally. Users currently locking listed files -are listed in place of the file's owner and group. -Keystrokes bound to VC commands will execute as though they had been called -on a buffer attached to the file named in the current Dired buffer line." - (setq vc-dired-mode t)) - -(define-key vc-dired-mode-map "\C-xv" vc-prefix-map) -(define-key vc-dired-mode-map "g" 'vc-dired-update) -(define-key vc-dired-mode-map "=" 'vc-diff) - -(defun vc-dired-state-info (file) - ;; Return the string that indicates the version control status - ;; on a VC dired line. - (let ((cvs-state (and (eq (vc-backend file) 'CVS) - (vc-cvs-status file)))) - (if cvs-state - (cond ((eq cvs-state 'up-to-date) nil) - ((eq cvs-state 'needs-checkout) "patch") - ((eq cvs-state 'locally-modified) "modified") - ((eq cvs-state 'needs-merge) "merge") - ((eq cvs-state 'unresolved-conflict) "conflict") - ((eq cvs-state 'locally-added) "added")) - (vc-locking-user file)))) - -(defun vc-dired-reformat-line (x) - ;; Hack a directory-listing line, plugging in locking-user info in - ;; place of the user and group info. Should have the beneficial - ;; side-effect of shortening the listing line. Each call starts with - ;; point immediately following the dired mark area on the line to be - ;; hacked. - ;; - ;; Simplest possible one: - ;; (insert (concat x "\t"))) - ;; - ;; This code, like dired, assumes UNIX -l format. - (let ((pos (point)) limit perm owner date-and-file) - (end-of-line) - (setq limit (point)) - (goto-char pos) - (cond - ((or - (re-search-forward ;; owner and group -"\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[^ ]+ +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" - limit t) - (re-search-forward ;; only owner displayed -"\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" - limit t)) - (setq perm (match-string 1) - owner (match-string 2) - date-and-file (match-string 3))) - ((re-search-forward ;; OS/2 -l format, no links, owner, group -"\\([drwxlts-]+ \\) *[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" - limit t) - (setq perm (match-string 1) - date-and-file (match-string 2)))) - (if x (setq x (concat "(" x ")"))) - (let ((rep (substring (concat x " ") 0 10))) - (replace-match (concat perm rep date-and-file))))) - -(defun vc-dired-update-line (file) - ;; Update the vc-dired listing line of file -- it is assumed - ;; that point is already on this line. Don't use dired-do-redisplay - ;; for this, because it cannot handle the way vc-dired deals with - ;; subdirectories. - (beginning-of-line) - (forward-char 2) - (let ((start (point))) - (forward-line 1) - (beginning-of-line) - (delete-region start (point)) - (insert-directory file dired-listing-switches) - (forward-line -1) - (end-of-line) - (delete-char (- (length file))) - (insert (substring file (length (expand-file-name default-directory)))) - (goto-char start)) - (vc-dired-reformat-line (vc-dired-state-info file))) - -(defun vc-dired-update (verbose) - (interactive "P") - (vc-directory default-directory verbose)) - -;;; Note in Emacs 18 the following defun gets overridden -;;; with the symbol 'vc-directory-18. See below. -;;;###autoload -(defun vc-directory (dirname verbose) - "Show version-control status of the current directory and subdirectories. -Normally it creates a Dired buffer that lists only the locked files -in all these directories. With a prefix argument, it lists all files." - (interactive "DDired under VC (directory): \nP") - (require 'dired) - (setq dirname (expand-file-name dirname)) - ;; force a trailing slash - (if (not (eq (elt dirname (1- (length dirname))) ?/)) - (setq dirname (concat dirname "/"))) - (let (nonempty - (dl (if (featurep 'xemacs) - (+ 1 (length (directory-file-name (expand-file-name dirname)))) - (length dirname))) - (filelist nil) (statelist nil) - (old-dir default-directory) - dired-buf - dired-buf-mod-count) - (vc-file-tree-walk - dirname - (function - (lambda (f) - (if (vc-registered f) - (let ((state (vc-dired-state-info f))) - (and (or verbose state) - (setq filelist (cons (substring f dl) filelist)) - (setq statelist (cons state statelist)))))))) - (save-window-excursion - (save-excursion - ;; This uses a semi-documented feature of dired; giving a switch - ;; argument forces the buffer to refresh each time. - (setq dired-buf - (dired-internal-noselect - (cons dirname (nreverse filelist)) - dired-listing-switches 'vc-dired-mode)) - (setq nonempty (not (eq 0 (length filelist)))))) - (switch-to-buffer dired-buf) - ;; Make a few modifications to the header - (setq buffer-read-only nil) - (goto-char (point-min)) - (forward-line 1) ;; Skip header line - (let ((start (point))) ;; Erase (but don't remove) the - (end-of-line) ;; "wildcard" line. - (delete-region start (point))) - (beginning-of-line) - (if nonempty - (progn - ;; Plug the version information into the individual lines - (mapcar - (function - (lambda (x) - (forward-char 2) ;; skip dired's mark area - (vc-dired-reformat-line x) - (forward-line 1))) ;; go to next line - (nreverse statelist)) - (if (featurep 'xemacs) - (dired-insert-set-properties (point-min) (point-max))) - (setq buffer-read-only t) - (goto-char (point-min)) - (dired-next-line 2) - ) - (dired-next-line 1) - (insert " ") - (setq buffer-read-only t) - (message "No files are currently %s under %s" - (if verbose "registered" "locked") dirname)) - )) - -;; Emacs 18 version -(defun vc-directory-18 (verbose) - "Show version-control status of all files under the current directory." - (interactive "P") - (let (nonempty (dir default-directory)) - (save-excursion - (set-buffer (get-buffer-create "*vc-status*")) - (erase-buffer) - (cd dir) - (vc-file-tree-walk - default-directory - (function (lambda (f) - (if (vc-registered f) - (let ((user (vc-locking-user f))) - (if (or user verbose) - (insert (format - "%s %s\n" - (concat user) f)))))))) - (setq nonempty (not (zerop (buffer-size))))) - - (if nonempty - (progn - (pop-to-buffer "*vc-status*" t) - (goto-char (point-min)) - (shrink-window-if-larger-than-buffer))) - (message "No files are currently %s under %s" - (if verbose "registered" "locked") default-directory)) - ) - -(or (boundp 'minor-mode-map-alist) - (fset 'vc-directory 'vc-directory-18)) - -;; Named-configuration support for SCCS - -(defun vc-add-triple (name file rev) - (save-excursion - (find-file (expand-file-name - vc-name-assoc-file - (file-name-as-directory - (expand-file-name (vc-backend-subdirectory-name file) - (file-name-directory file))))) - (goto-char (point-max)) - (insert name "\t:\t" file "\t" rev "\n") - (basic-save-buffer) - (kill-buffer (current-buffer)) - )) - -(defun vc-record-rename (file newname) - (save-excursion - (find-file - (expand-file-name - vc-name-assoc-file - (file-name-as-directory - (expand-file-name (vc-backend-subdirectory-name file) - (file-name-directory file))))) - (goto-char (point-min)) - ;; (replace-regexp (concat ":" (regexp-quote file) "$") (concat ":" newname)) - (while (re-search-forward (concat ":" (regexp-quote file) "$") nil t) - (replace-match (concat ":" newname) nil nil)) - (basic-save-buffer) - (kill-buffer (current-buffer)) - )) - -(defun vc-lookup-triple (file name) - ;; Return the numeric version corresponding to a named snapshot of file - ;; If name is nil or a version number string it's just passed through - (cond ((null name) name) - ((let ((firstchar (aref name 0))) - (and (>= firstchar ?0) (<= firstchar ?9))) - name) - (t - (save-excursion - (set-buffer (get-buffer-create "*vc-info*")) - (vc-insert-file - (expand-file-name - vc-name-assoc-file - (file-name-as-directory - (expand-file-name (vc-backend-subdirectory-name file) - (file-name-directory file))))) - (prog1 - (car (vc-parse-buffer - (list (list (concat name "\t:\t" file "\t\\(.+\\)") 1)))) - (kill-buffer "*vc-info*")))) - )) - -;; Named-configuration entry points - -(defun vc-snapshot-precondition () - ;; Scan the tree below the current directory. - ;; If any files are locked, return the name of the first such file. - ;; (This means, neither snapshot creation nor retrieval is allowed.) - ;; If one or more of the files are currently visited, return `visited'. - ;; Otherwise, return nil. - (let ((status nil)) - (catch 'vc-locked-example - (vc-file-tree-walk - default-directory - (function (lambda (f) - (and (vc-registered f) - (if (vc-locking-user f) (throw 'vc-locked-example f) - (if (get-file-buffer f) (setq status 'visited))))))) - status))) - -;;;###autoload -(defun vc-create-snapshot (name) - "Make a snapshot called NAME. -The snapshot is made from all registered files at or below the current -directory. For each file, the version level of its latest -version becomes part of the named configuration." - (interactive "sNew snapshot name: ") - (let ((result (vc-snapshot-precondition))) - (if (stringp result) - (error "File %s is locked" result) - (vc-file-tree-walk - default-directory - (function (lambda (f) (and - (vc-name f) - (vc-backend-assign-name f name))))) - ))) - -;;;###autoload -(defun vc-retrieve-snapshot (name) - "Retrieve the snapshot called NAME. -This function fails if any files are locked at or below the current directory -Otherwise, all registered files are checked out (unlocked) at their version -levels in the snapshot." - (interactive "sSnapshot name to retrieve: ") - (let ((result (vc-snapshot-precondition)) - (update nil)) - (if (stringp result) - (error "File %s is locked" result) - (if (eq result 'visited) - (setq update (yes-or-no-p "Update the affected buffers? "))) - (vc-file-tree-walk - default-directory - (function (lambda (f) (and - (vc-name f) - (vc-error-occurred - (vc-backend-checkout f nil name) - (if update (vc-resynch-buffer f t t))))))) - ))) - -;; Miscellaneous other entry points - -;;;###autoload -(defun vc-print-log () - "List the change log of the current buffer in a window." - (interactive) - (if vc-dired-mode - (set-buffer (find-file-noselect (dired-get-filename)))) - (while vc-parent-buffer - (pop-to-buffer vc-parent-buffer)) - (if (and buffer-file-name (vc-name buffer-file-name)) - (let ((file buffer-file-name)) - (vc-backend-print-log file) - (pop-to-buffer (get-buffer-create "*vc*")) - (setq default-directory (file-name-directory file)) - (goto-char (point-max)) (forward-line -1) - (while (looking-at "=*\n") - (delete-char (- (match-end 0) (match-beginning 0))) - (forward-line -1)) - (goto-char (point-min)) - (if (looking-at "[\b\t\n\v\f\r ]+") - (delete-char (- (match-end 0) (match-beginning 0)))) - (shrink-window-if-larger-than-buffer) - ;; move point to the log entry for the current version - (and (not (eq (vc-backend file) 'SCCS)) - (re-search-forward - ;; also match some context, for safety - (concat "----\nrevision " (vc-workfile-version file) - "\\(\tlocked by:.*\n\\|\n\\)date: ") nil t) - ;; set the display window so that - ;; the whole log entry is displayed - (let (start end lines) - (beginning-of-line) (forward-line -1) (setq start (point)) - (if (not (re-search-forward "^----*\nrevision" nil t)) - (setq end (point-max)) - (beginning-of-line) (forward-line -1) (setq end (point))) - (setq lines (count-lines start end)) - (cond - ;; if the global information and this log entry fit - ;; into the window, display from the beginning - ((< (count-lines (point-min) end) (window-height)) - (goto-char (point-min)) - (recenter 0) - (goto-char start)) - ;; if the whole entry fits into the window, - ;; display it centered - ((< (1+ lines) (window-height)) - (goto-char start) - (recenter (1- (- (/ (window-height) 2) (/ lines 2))))) - ;; otherwise (the entry is too large for the window), - ;; display from the start - (t - (goto-char start) - (recenter 0))))) - ) - (vc-registration-error buffer-file-name) - ) - ) - -;;;###autoload -(defun vc-revert-buffer () - "Revert the current buffer's file back to the latest checked-in version. -This asks for confirmation if the buffer contents are not identical -to that version. -If the back-end is CVS, this will give you the most recent revision of -the file on the branch you are editing." - (interactive) - (if vc-dired-mode - (find-file-other-window (dired-get-filename))) - (while vc-parent-buffer - (pop-to-buffer vc-parent-buffer)) - (let ((file buffer-file-name) - ;; This operation should always ask for confirmation. - (vc-suppress-confirm nil) - (obuf (current-buffer)) (changed (vc-diff nil t))) - (if (and changed (not (yes-or-no-p "Discard changes? "))) - (progn - (if (and (window-dedicated-p (selected-window)) - (one-window-p t 'selected-frame)) - (make-frame-invisible (selected-frame)) - (delete-window)) - (error "Revert cancelled")) - (set-buffer obuf)) - (if changed - (if (and (window-dedicated-p (selected-window)) - (one-window-p t 'selected-frame)) - (make-frame-invisible (selected-frame)) - (delete-window))) - (vc-backend-revert file) - (vc-resynch-window file t t) - ) - ) - -;;;###autoload -(defun vc-cancel-version (norevert) - "Get rid of most recently checked in version of this file. -A prefix argument means do not revert the buffer afterwards." - (interactive "P") - (if vc-dired-mode - (find-file-other-window (dired-get-filename))) - (while vc-parent-buffer - (pop-to-buffer vc-parent-buffer)) - (cond - ((not (vc-registered (buffer-file-name))) - (vc-registration-error (buffer-file-name))) - ((eq (vc-backend (buffer-file-name)) 'CVS) - (error "Unchecking files under CVS is dangerous and not supported in VC")) - ((vc-locking-user (buffer-file-name)) - (error "This version is locked; use vc-revert-buffer to discard changes")) - ((not (vc-latest-on-branch-p (buffer-file-name))) - (error "This is not the latest version--VC cannot cancel it"))) - (let* ((target (vc-workfile-version (buffer-file-name))) - (recent (if (vc-trunk-p target) "" (vc-branch-part target))) - (config (current-window-configuration)) done) - (if (null (yes-or-no-p (format "Remove version %s from master? " target))) - nil - (setq norevert (or norevert (not - (yes-or-no-p "Revert buffer to most recent remaining version? ")))) - (vc-backend-uncheck (buffer-file-name) target) - ;; Check out the most recent remaining version. If it fails, because - ;; the whole branch got deleted, do a double-take and check out the - ;; version where the branch started. - (while (not done) - (condition-case err - (progn - (if norevert - ;; Check out locked, but only to disc, and keep - ;; modifications in the buffer. - (vc-backend-checkout (buffer-file-name) t recent) - ;; Check out unlocked, and revert buffer. - (vc-checkout (buffer-file-name) nil recent)) - (setq done t)) - ;; If the checkout fails, vc-do-command signals an error. - ;; We catch this error, check the reason, correct the - ;; version number, and try a second time. - (error (set-buffer "*vc*") - (goto-char (point-min)) - (if (search-forward "no side branches present for" nil t) - (progn (setq recent (vc-branch-part recent)) - ;; vc-do-command popped up a window with - ;; the error message. Get rid of it, by - ;; restoring the old window configuration. - (set-window-configuration config)) - ;; No, it was some other error: re-signal it. - (signal (car err) (cdr err)))))) - ;; If norevert, clear version headers and mark the buffer modified. - (if norevert - (progn - (set-visited-file-name (buffer-file-name)) - (if (not vc-make-backup-files) - ;; inhibit backup for this buffer - (progn (make-local-variable 'backup-inhibited) - (setq backup-inhibited t))) - (if (eq (vc-backend (buffer-file-name)) 'RCS) - (progn (setq buffer-read-only nil) - (vc-clear-headers))) - (vc-mode-line (buffer-file-name)))) - (message "Version %s has been removed from the master" target) - ))) - -;;;###autoload -(defun vc-rename-file (old new) - "Rename file OLD to NEW, and rename its master file likewise." - (interactive "fVC rename file: \nFRename to: ") - ;; There are several ways of renaming files under CVS 1.3, but they all - ;; have serious disadvantages. See the FAQ (available from think.com in - ;; pub/cvs/). I'd rather send the user an error, than do something he might - ;; consider to be wrong. When the famous, long-awaited rename database is - ;; implemented things might change for the better. This is unlikely to occur - ;; until CVS 2.0 is released. --ceder 1994-01-23 21:27:51 - (if (eq (vc-backend old) 'CVS) - (error "Renaming files under CVS is dangerous and not supported in VC")) - (let ((oldbuf (get-file-buffer old))) - (if (and oldbuf (buffer-modified-p oldbuf)) - (error "Please save files before moving them")) - (if (get-file-buffer new) - (error "Already editing new file name")) - (if (file-exists-p new) - (error "New file already exists")) - (let ((oldmaster (vc-name old))) - (if oldmaster - (progn - (if (vc-locking-user old) - (error "Please check in files before moving them")) - (if (or (file-symlink-p oldmaster) - ;; This had FILE, I changed it to OLD. -- rms. - (file-symlink-p (vc-backend-subdirectory-name old))) - (error "This is not a safe thing to do in the presence of symbolic links")) - (rename-file - oldmaster - (let ((backend (vc-backend old)) - (newdir (or (file-name-directory new) "")) - (newbase (file-name-nondirectory new))) - (catch 'found - (mapcar - (function - (lambda (s) - (if (eq backend (cdr s)) - (let* ((newmaster (format (car s) newdir newbase)) - (newmasterdir (file-name-directory newmaster))) - (if (or (not newmasterdir) - (file-directory-p newmasterdir)) - (throw 'found newmaster)))))) - vc-master-templates) - (error "New file lacks a version control directory")))))) - (if (or (not oldmaster) (file-exists-p old)) - (rename-file old new))) -; ?? Renaming a file might change its contents due to keyword expansion. -; We should really check out a new copy if the old copy was precisely equal -; to some checked in version. However, testing for this is tricky.... - (if oldbuf - (save-excursion - (set-buffer oldbuf) - (let ((buffer-read-only buffer-read-only)) - (set-visited-file-name new)) - (vc-backend new) - (vc-mode-line new) - (set-buffer-modified-p nil)))) - ;; This had FILE, I changed it to OLD. -- rms. - (vc-backend-dispatch old - (vc-record-rename old new) ;SCCS - nil ;RCS - nil ;CVS - ) - ) - -;;;###autoload -(defun vc-update-change-log (&rest args) - "Find change log file and add entries from recent RCS/CVS logs. -Normally, find log entries for all registered files in the default -directory using `rcs2log', which finds CVS logs preferentially. -The mark is left at the end of the text prepended to the change log. - -With prefix arg of C-u, only find log entries for the current buffer's file. - -With any numeric prefix arg, find log entries for all currently visited -files that are under version control. This puts all the entries in the -log for the default directory, which may not be appropriate. - -From a program, any arguments are assumed to be filenames and are -passed to the `rcs2log' script after massaging to be relative to the -default directory." - (interactive - (cond ((consp current-prefix-arg) ;C-u - (list buffer-file-name)) - (current-prefix-arg ;Numeric argument. - (let ((files nil) - (buffers (buffer-list)) - file) - (while buffers - (setq file (buffer-file-name (car buffers))) - (and file (vc-backend file) - (setq files (cons file files))) - (setq buffers (cdr buffers))) - files)) - (t - ;; `rcs2log' will find the relevant RCS or CVS files - ;; relative to the curent directory if none supplied. - nil))) - (require 'add-log) ; XEmacs change - (let ((odefault default-directory) - (full-name (or add-log-full-name - (user-full-name) - (user-login-name) - (format "uid%d" (number-to-string (user-uid))))) - (mailing-address (or add-log-mailing-address - user-mail-address))) - (find-file-other-window (find-change-log)) - (barf-if-buffer-read-only) - (vc-buffer-sync) - (undo-boundary) - (goto-char (point-min)) - (push-mark) - (message "Computing change log entries...") - (message "Computing change log entries... %s" - (if (eq 0 (apply 'call-process "rcs2log" nil '(t nil) nil - "-u" - (concat (vc-user-login-name) - "\t" - full-name - "\t" - mailing-address) - (mapcar (function - (lambda (f) - (file-relative-name - (if (file-name-absolute-p f) - f - (concat odefault f))))) - args))) - "done" "failed")))) - -;; Collect back-end-dependent stuff here - -(defun vc-backend-admin (file &optional rev comment) - ;; Register a file into the version-control system - ;; Automatically retrieves a read-only version of the file with - ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise - ;; it deletes the workfile. - (vc-file-clearprops file) - (or vc-default-back-end - (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS))) - (message "Registering %s..." file) - (let ((switches - (if (stringp vc-register-switches) - (list vc-register-switches) - vc-register-switches)) - (backend - (cond - ((file-exists-p (vc-backend-subdirectory-name)) vc-default-back-end) - ((file-exists-p "RCS") 'RCS) - ((file-exists-p "SCCS") 'SCCS) - ((file-exists-p "CVS") 'CVS) - (t vc-default-back-end)))) - (cond ((eq backend 'SCCS) - (apply 'vc-do-command nil 0 "admin" file 'MASTER ;; SCCS - (and rev (concat "-r" rev)) - "-fb" - (concat "-i" file) - (and comment (concat "-y" comment)) - (format - (car (rassq 'SCCS vc-master-templates)) - (or (file-name-directory file) "") - (file-name-nondirectory file)) - switches) - (delete-file file) - (if vc-keep-workfiles - (vc-do-command nil 0 "get" file 'MASTER))) - ((eq backend 'RCS) - (apply 'vc-do-command nil 0 "ci" file 'WORKFILE ;; RCS - ;; if available, use the secure registering option - (and (vc-backend-release-p 'RCS "5.6.4") "-i") - (concat (if vc-keep-workfiles "-u" "-r") rev) - (and comment (concat "-t-" comment)) - switches)) - ((eq backend 'CVS) - (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE ;; CVS - "add" - (and comment (string-match "[^\t\n ]" comment) - (concat "-m" comment)) - switches) - ))) - (message "Registering %s...done" file) - ) - -(defun vc-backend-checkout (file &optional writable rev workfile) - ;; Retrieve a copy of a saved version into a workfile - (let ((filename (or workfile file)) - (file-buffer (get-file-buffer file)) - switches) - (message "Checking out %s..." filename) - (save-excursion - ;; Change buffers to get local value of vc-checkout-switches. - (if file-buffer (set-buffer file-buffer)) - (setq switches (if (stringp vc-checkout-switches) - (list vc-checkout-switches) - vc-checkout-switches)) - ;; Save this buffer's default-directory - ;; and use save-excursion to make sure it is restored - ;; in the same buffer it was saved in. - (let ((default-directory default-directory)) - (save-excursion - ;; Adjust the default-directory so that the check-out creates - ;; the file in the right place. - (setq default-directory (file-name-directory filename)) - (vc-backend-dispatch file - (progn ;; SCCS - (and rev (string= rev "") (setq rev nil)) - (if workfile - ;; Some SCCS implementations allow checking out directly to a - ;; file using the -G option, but then some don't so use the - ;; least common denominator approach and use the -p option - ;; ala RCS. - (let ((vc-modes (logior (file-modes (vc-name file)) - (if writable 128 0))) - (failed t)) - (unwind-protect - (progn - (apply 'vc-do-command - nil 0 "/bin/sh" file 'MASTER "-c" - ;; Some shells make the "" dummy argument into $0 - ;; while others use the shell's name as $0 and - ;; use the "" as $1. The if-statement - ;; converts the latter case to the former. - (format "if [ x\"$1\" = x ]; then shift; fi; \ - umask %o; exec >\"$1\" || exit; \ - shift; umask %o; exec get \"$@\"" - (logand 511 (lognot vc-modes)) - (logand 511 (lognot (default-file-modes)))) - "" ; dummy argument for shell's $0 - filename - (if writable "-e") - "-p" - (and rev - (concat "-r" (vc-lookup-triple file rev))) - switches) - (setq failed nil)) - (and failed (file-exists-p filename) - (delete-file filename)))) - (apply 'vc-do-command nil 0 "get" file 'MASTER ;; SCCS - (if writable "-e") - (and rev (concat "-r" (vc-lookup-triple file rev))) - switches) - (vc-file-setprop file 'vc-workfile-version nil))) - (if workfile ;; RCS - ;; RCS doesn't let us check out into arbitrary file names directly. - ;; Use `co -p' and make stdout point to the correct file. - (let ((vc-modes (logior (file-modes (vc-name file)) - (if writable 128 0))) - (failed t)) - (unwind-protect - (progn - (apply 'vc-do-command - nil 0 "/bin/sh" file 'MASTER "-c" - ;; See the SCCS case, above, regarding the - ;; if-statement. - (format "if [ x\"$1\" = x ]; then shift; fi; \ - umask %o; exec >\"$1\" || exit; \ - shift; umask %o; exec co \"$@\"" - (logand 511 (lognot vc-modes)) - (logand 511 (lognot (default-file-modes)))) - "" ; dummy argument for shell's $0 - filename - (if writable "-l") - (concat "-p" rev) - switches) - (setq failed nil)) - (and failed (file-exists-p filename) (delete-file filename)))) - (let (new-version) - ;; if we should go to the head of the trunk, - ;; clear the default branch first - (and rev (string= rev "") - (vc-do-command nil 0 "rcs" file 'MASTER "-b")) - ;; now do the checkout - (apply 'vc-do-command - nil 0 "co" file 'MASTER - ;; If locking is not strict, force to overwrite - ;; the writable workfile. - (if (eq (vc-checkout-model file) 'implicit) "-f") - (if writable "-l") - (if rev (concat "-r" rev) - ;; if no explicit revision was specified, - ;; check out that of the working file - (let ((workrev (vc-workfile-version file))) - (if workrev (concat "-r" workrev) - nil))) - switches) - ;; determine the new workfile version - (save-excursion - (set-buffer "*vc*") - (goto-char (point-min)) - (setq new-version - (if (re-search-forward "^revision \\([0-9.]+\\).*\n" nil t) - (buffer-substring (match-beginning 1) (match-end 1))))) - (vc-file-setprop file 'vc-workfile-version new-version) - ;; if necessary, adjust the default branch - (and rev (not (string= rev "")) - (vc-do-command nil 0 "rcs" file 'MASTER - (concat "-b" (if (vc-latest-on-branch-p file) - (if (vc-trunk-p new-version) nil - (vc-branch-part new-version)) - new-version)))))) - (if workfile ;; CVS - ;; CVS is much like RCS - (let ((failed t)) - (unwind-protect - (progn - (apply 'vc-do-command - nil 0 "/bin/sh" file 'WORKFILE "-c" - "exec >\"$1\" || exit; shift; exec cvs update \"$@\"" - "" ; dummy argument for shell's $0 - workfile - (concat "-r" rev) - "-p" - switches) - (setq failed nil)) - (and failed (file-exists-p filename) (delete-file filename)))) - ;; default for verbose checkout: clear the sticky tag - ;; so that the actual update will get the head of the trunk - (and rev (string= rev "") - (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A")) - ;; If a revision was specified, check that out. - (if rev - (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE - (and writable (eq (vc-checkout-model file) 'manual) "-w") - "update" - (and rev (not (string= rev "")) - (concat "-r" rev)) - switches) - ;; If no revision was specified, simply make the file writable. - (and writable - (or (eq (vc-checkout-model file) 'manual) - (zerop (logand 128 (file-modes file)))) - (set-file-modes file (logior 128 (file-modes file))))) - (if rev (vc-file-setprop file 'vc-workfile-version nil)))) - (cond - ((not workfile) - (vc-file-clear-masterprops file) - (if writable - (vc-file-setprop file 'vc-locking-user (vc-user-login-name))) - (vc-file-setprop file - 'vc-checkout-time (nth 5 (file-attributes file))))) - (message "Checking out %s...done" filename)))))) - -(defun vc-backend-logentry-check (file) - (vc-backend-dispatch file - (if (>= (buffer-size) 512) ;; SCCS - (progn - (goto-char 512) - (error - "Log must be less than 512 characters; point is now at pos 512"))) - nil ;; RCS - nil) ;; CVS - ) - -(defun vc-backend-checkin (file rev comment) - ;; Register changes to FILE as level REV with explanatory COMMENT. - ;; Automatically retrieves a read-only version of the file with - ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise - ;; it deletes the workfile. - ;; Adaptation for RCS branch support: if this is an explicit checkin, - ;; or if the checkin creates a new branch, set the master file branch - ;; accordingly. - (message "Checking in %s..." file) - ;; "This log message intentionally left almost blank". - ;; RCS 5.7 gripes about white-space-only comments too. - (or (and comment (string-match "[^\t\n ]" comment)) - (setq comment "*** empty log message ***")) - (save-excursion - ;; Change buffers to get local value of vc-checkin-switches. - (set-buffer (or (get-file-buffer file) (current-buffer))) - (let ((switches - (if (stringp vc-checkin-switches) - (list vc-checkin-switches) - vc-checkin-switches))) - ;; Clear the master-properties. Do that here, not at the - ;; end, because if the check-in fails we want them to get - ;; re-computed before the next try. - (vc-file-clear-masterprops file) - (vc-backend-dispatch file - ;; SCCS - (progn - (apply 'vc-do-command nil 0 "delta" file 'MASTER - (if rev (concat "-r" rev)) - (concat "-y" comment) - switches) - (vc-file-setprop file 'vc-locking-user 'none) - (vc-file-setprop file 'vc-workfile-version nil) - (if vc-keep-workfiles - (vc-do-command nil 0 "get" file 'MASTER)) - ) - ;; RCS - (let ((old-version (vc-workfile-version file)) new-version) - (apply 'vc-do-command nil 0 "ci" file 'MASTER - ;; if available, use the secure check-in option - (and (vc-backend-release-p 'RCS "5.6.4") "-j") - (concat (if vc-keep-workfiles "-u" "-r") rev) - (concat "-m" comment) - switches) - (vc-file-setprop file 'vc-locking-user 'none) - (vc-file-setprop file 'vc-workfile-version nil) - - ;; determine the new workfile version - (set-buffer "*vc*") - (goto-char (point-min)) - (if (or (re-search-forward - "new revision: \\([0-9.]+\\);" nil t) - (re-search-forward - "reverting to previous revision \\([0-9.]+\\)" nil t)) - (progn (setq new-version (buffer-substring (match-beginning 1) - (match-end 1))) - (vc-file-setprop file 'vc-workfile-version new-version))) - - ;; if we got to a different branch, adjust the default - ;; branch accordingly - (cond - ((and old-version new-version - (not (string= (vc-branch-part old-version) - (vc-branch-part new-version)))) - (vc-do-command nil 0 "rcs" file 'MASTER - (if (vc-trunk-p new-version) "-b" - (concat "-b" (vc-branch-part new-version)))) - ;; If this is an old RCS release, we might have - ;; to remove a remaining lock. - (if (not (vc-backend-release-p 'RCS "5.6.2")) - ;; exit status of 1 is also accepted. - ;; It means that the lock was removed before. - (vc-do-command nil 1 "rcs" file 'MASTER - (concat "-u" old-version)))))) - ;; CVS - (progn - ;; explicit check-in to the trunk requires a - ;; double check-in (first unexplicit) (CVS-1.3) - (condition-case nil - (progn - (if (and rev (vc-trunk-p rev)) - (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE - "ci" "-m" "intermediate" - switches)) - (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE - "ci" (if rev (concat "-r" rev)) - (concat "-m" comment) - switches)) - (error (if (eq (vc-cvs-status file) 'needs-merge) - ;; The CVS output will be on top of this message. - (error "Type C-x 0 C-x C-q to merge in changes") - (error "Check-in failed")))) - ;; determine and store the new workfile version - (set-buffer "*vc*") - (goto-char (point-min)) - (if (re-search-forward - "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" nil t) - (vc-file-setprop file 'vc-workfile-version - (buffer-substring (match-beginning 2) - (match-end 2))) - (vc-file-setprop file 'vc-workfile-version nil)) - ;; if this was an explicit check-in, remove the sticky tag - (if rev - (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A")) - (vc-file-setprop file 'vc-locking-user 'none) - (vc-file-setprop file 'vc-checkout-time - (nth 5 (file-attributes file))))))) - (message "Checking in %s...done" file)) - -(defun vc-backend-revert (file) - ;; Revert file to latest checked-in version. - ;; (for RCS, to workfile version) - (message "Reverting %s..." file) - (vc-file-clear-masterprops file) - (vc-backend-dispatch - file - ;; SCCS - (progn - (vc-do-command nil 0 "unget" file 'MASTER nil) - (vc-do-command nil 0 "get" file 'MASTER nil)) - ;; RCS - (vc-do-command nil 0 "co" file 'MASTER - "-f" (concat "-u" (vc-workfile-version file))) - ;; CVS - (progn - (delete-file file) - (vc-do-command nil 0 "cvs" file 'WORKFILE "update"))) - (vc-file-setprop file 'vc-locking-user 'none) - (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))) - (message "Reverting %s...done" file) - ) - -(defun vc-backend-steal (file &optional rev) - ;; Steal the lock on the current workfile. Needs RCS 5.6.2 or later for -M. - (message "Stealing lock on %s..." file) - (vc-backend-dispatch file - (progn ;SCCS - (vc-do-command nil 0 "unget" file 'MASTER "-n" (if rev (concat "-r" rev))) - (vc-do-command nil 0 "get" file 'MASTER "-g" (if rev (concat "-r" rev))) - ) - (vc-do-command nil 0 "rcs" file 'MASTER ;RCS - "-M" (concat "-u" rev) (concat "-l" rev)) - (error "You cannot steal a CVS lock; there are no CVS locks to steal") ;CVS - ) - (vc-file-setprop file 'vc-locking-user (vc-user-login-name)) - (message "Stealing lock on %s...done" file) - ) - -(defun vc-backend-uncheck (file target) - ;; Undo the latest checkin. - (message "Removing last change from %s..." file) - (vc-backend-dispatch file - (vc-do-command nil 0 "rmdel" file 'MASTER (concat "-r" target)) - (vc-do-command nil 0 "rcs" file 'MASTER (concat "-o" target)) - nil ;; this is never reached under CVS - ) - (message "Removing last change from %s...done" file) - ) - -(defun vc-backend-print-log (file) - ;; Get change log associated with FILE. - (vc-backend-dispatch - file - (vc-do-command nil 0 "prs" file 'MASTER) - (vc-do-command nil 0 "rlog" file 'MASTER) - (vc-do-command nil 0 "cvs" file 'WORKFILE "log"))) - -(defun vc-backend-assign-name (file name) - ;; Assign to a FILE's latest version a given NAME. - (vc-backend-dispatch file - (vc-add-triple name file (vc-latest-version file)) ;; SCCS - (vc-do-command nil 0 "rcs" file 'MASTER (concat "-n" name ":")) ;; RCS - (vc-do-command nil 0 "cvs" file 'WORKFILE "tag" name) ;; CVS - ) - ) - -(defun vc-backend-diff (file &optional oldvers newvers cmp) - ;; Get a difference report between two versions of FILE. - ;; Get only a brief comparison report if CMP, a difference report otherwise. - (let ((backend (vc-backend file)) options status - (diff-switches-list (if (listp diff-switches) - diff-switches - (list diff-switches)))) - (cond - ((eq backend 'SCCS) - (setq oldvers (vc-lookup-triple file oldvers)) - (setq newvers (vc-lookup-triple file newvers)) - (setq options (append (list (and cmp "--brief") "-q" - (and oldvers (concat "-r" oldvers)) - (and newvers (concat "-r" newvers))) - (and (not cmp) diff-switches-list))) - (apply 'vc-do-command "*vc-diff*" 1 "vcdiff" file 'MASTER options)) - ((eq backend 'RCS) - (if (not oldvers) (setq oldvers (vc-workfile-version file))) - ;; If we know that --brief is not supported, don't try it. - (setq cmp (and cmp (not (eq vc-rcsdiff-knows-brief 'no)))) - (setq options (append (list (and cmp "--brief") "-q" - (concat "-r" oldvers) - (and newvers (concat "-r" newvers))) - (and (not cmp) diff-switches-list))) - (setq status (apply 'vc-do-command "*vc-diff*" 2 - "rcsdiff" file 'WORKFILE options)) - ;; If --brief didn't work, do a double-take and remember it - ;; for the future. - (if (eq status 2) - (prog1 - (apply 'vc-do-command "*vc-diff*" 1 "rcsdiff" file 'WORKFILE - (if cmp (cdr options) options)) - (if cmp (setq vc-rcsdiff-knows-brief 'no))) - ;; If --brief DID work, remember that, too. - (and cmp (not vc-rcsdiff-knows-brief) - (setq vc-rcsdiff-knows-brief 'yes)) - status)) - ;; CVS is different. - ((eq backend 'CVS) - (if (string= (vc-workfile-version file) "0") - ;; This file is added but not yet committed; there is no master file. - (if (or oldvers newvers) - (error "No revisions of %s exist" file) - (if cmp 1 ;; file is added but not committed, - ;; we regard this as "changed". - ;; diff it against /dev/null. - (apply 'vc-do-command - "*vc-diff*" 1 "diff" file 'WORKFILE - (append (if (listp diff-switches) - diff-switches - (list diff-switches)) '("/dev/null"))))) - ;; cmp is not yet implemented -- we always do a full diff. - (apply 'vc-do-command - "*vc-diff*" 1 "cvs" file 'WORKFILE "diff" - (and oldvers (concat "-r" oldvers)) - (and newvers (concat "-r" newvers)) - (if (listp diff-switches) - diff-switches - (list diff-switches))))) - (t - (vc-registration-error file))))) - -(defun vc-backend-merge-news (file) - ;; Merge in any new changes made to FILE. - (message "Merging changes into %s..." file) - (prog1 - (vc-backend-dispatch - file - (error "vc-backend-merge-news not meaningful for SCCS files") ;SCCS - (error "vc-backend-merge-news not meaningful for RCS files") ;RCS - (save-excursion ; CVS - (vc-file-clear-masterprops file) - (vc-file-setprop file 'vc-workfile-version nil) - (vc-file-setprop file 'vc-locking-user nil) - (vc-do-command nil 0 "cvs" file 'WORKFILE "update") - ;; CVS doesn't return an error code if conflicts are detected. - ;; Since we want to warn the user about it (and possibly start - ;; emerge later), scan the output and see if this occurred. - (set-buffer (get-buffer "*vc*")) - (goto-char (point-min)) - (if (re-search-forward "^cvs update: conflicts found in .*" nil t) - 1 ;; error code for caller - 0 ;; no conflict detected - ))) - (message "Merging changes into %s...done" file))) - -(defun vc-check-headers () - "Check if the current file has any headers in it." - (interactive) - (save-excursion - (goto-char (point-min)) - (vc-backend-dispatch buffer-file-name - (re-search-forward "%[MIRLBSDHTEGUYFPQCZWA]%" nil t) ;; SCCS - (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t) ;; RCS - 'RCS ;; CVS works like RCS in this regard. - ) - )) - -;; Back-end-dependent stuff ends here. - -;; Set up key bindings for use while editing log messages - -(defun vc-log-mode (&optional file) - "Minor mode for driving version-control tools. -These bindings are added to the global keymap when you enter this mode: -\\[vc-next-action] perform next logical version-control operation on current file -\\[vc-register] register current file -\\[vc-toggle-read-only] like next-action, but won't register files -\\[vc-insert-headers] insert version-control headers in current file -\\[vc-print-log] display change history of current file -\\[vc-revert-buffer] revert buffer to latest version -\\[vc-cancel-version] undo latest checkin -\\[vc-diff] show diffs between file versions -\\[vc-version-other-window] visit old version in another window -\\[vc-directory] show all files locked by any user in or below . -\\[vc-update-change-log] add change log entry from recent checkins - -While you are entering a change log message for a version, the following -additional bindings will be in effect. - -\\[vc-finish-logentry] proceed with check in, ending log message entry - -Whenever you do a checkin, your log comment is added to a ring of -saved comments. These can be recalled as follows: - -\\[vc-next-comment] replace region with next message in comment ring -\\[vc-previous-comment] replace region with previous message in comment ring -\\[vc-comment-search-reverse] search backward for regexp in the comment ring -\\[vc-comment-search-forward] search backward for regexp in the comment ring - -Entry to the change-log submode calls the value of text-mode-hook, then -the value of vc-log-mode-hook. - -Global user options: - vc-initial-comment If non-nil, require user to enter a change - comment upon first checkin of the file. - - vc-keep-workfiles Non-nil value prevents workfiles from being - deleted when changes are checked in - - vc-suppress-confirm Suppresses some confirmation prompts, - notably for reversions. - - vc-header-alist Which keywords to insert when adding headers - with \\[vc-insert-headers]. Defaults to - '(\"\%\W\%\") under SCCS, '(\"\$Id\$\") under - RCS and CVS. - - vc-static-header-alist By default, version headers inserted in C files - get stuffed in a static string area so that - ident(RCS/CVS) or what(SCCS) can see them in - the compiled object code. You can override - this by setting this variable to nil, or change - the header template by changing it. - - vc-command-messages if non-nil, display run messages from the - actual version-control utilities (this is - intended primarily for people hacking vc - itself). -" - (interactive) - (set-syntax-table text-mode-syntax-table) - (use-local-map vc-log-entry-mode) - (setq local-abbrev-table text-mode-abbrev-table) - (setq major-mode 'vc-log-mode) - (setq mode-name "VC-Log") - (make-local-variable 'vc-log-file) - (setq vc-log-file file) - (make-local-variable 'vc-log-version) - (make-local-variable 'vc-comment-ring-index) - (set-buffer-modified-p nil) - (setq buffer-file-name nil) - (run-hooks 'text-mode-hook 'vc-log-mode-hook) -) - -;; Initialization code, to be done just once at load-time -(if vc-log-entry-mode - nil - (setq vc-log-entry-mode (make-sparse-keymap)) - (define-key vc-log-entry-mode "\M-n" 'vc-next-comment) - (define-key vc-log-entry-mode "\M-p" 'vc-previous-comment) - (define-key vc-log-entry-mode "\M-r" 'vc-comment-search-reverse) - (define-key vc-log-entry-mode "\M-s" 'vc-comment-search-forward) - (define-key vc-log-entry-mode "\C-c\C-c" 'vc-finish-logentry) - ) - -;;; These things should probably be generally available - -(defun vc-file-tree-walk (dirname func &rest args) - "Walk recursively through DIRNAME. -Invoke FUNC f ARGS on each non-directory file f underneath it." - (vc-file-tree-walk-internal (expand-file-name dirname) func args) - (message "Traversing directory %s...done" dirname)) - -(defun vc-file-tree-walk-internal (file func args) - (if (not (file-directory-p file)) - (apply func file args) - (message "Traversing directory %s..." (abbreviate-file-name file)) - (let ((dir (file-name-as-directory file))) - (mapcar - (function - (lambda (f) (or - (string-equal f ".") - (string-equal f "..") - (member f vc-directory-exclusion-list) - (let ((dirf (concat dir f))) - (or - (file-symlink-p dirf) ;; Avoid possible loops - (vc-file-tree-walk-internal dirf func args)))))) - (directory-files dir))))) - -(provide 'vc) - -;;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE -;;; -;;; These may be useful to anyone who has to debug or extend the package. -;;; (Note that this information corresponds to versions 5.x. Some of it -;;; might have been invalidated by the additions to support branching -;;; and RCS keyword lookup. AS, 1995/03/24) -;;; -;;; A fundamental problem in VC is that there are time windows between -;;; vc-next-action's computations of the file's version-control state and -;;; the actions that change it. This is a window open to lossage in a -;;; multi-user environment; someone else could nip in and change the state -;;; of the master during it. -;;; -;;; The performance problem is that rlog/prs calls are very expensive; we want -;;; to avoid them as much as possible. -;;; -;;; ANALYSIS: -;;; -;;; The performance problem, it turns out, simplifies in practice to the -;;; problem of making vc-locking-user fast. The two other functions that call -;;; prs/rlog will not be so commonly used that the slowdown is a problem; one -;;; makes snapshots, the other deletes the calling user's last change in the -;;; master. -;;; -;;; The race condition implies that we have to either (a) lock the master -;;; during the entire execution of vc-next-action, or (b) detect and -;;; recover from errors resulting from dispatch on an out-of-date state. -;;; -;;; Alternative (a) appears to be infeasible. The problem is that we can't -;;; guarantee that the lock will ever be removed. Suppose a user starts a -;;; checkin, the change message buffer pops up, and the user, having wandered -;;; off to do something else, simply forgets about it? -;;; -;;; Alternative (b), on the other hand, works well with a cheap way to speed up -;;; vc-locking-user. Usually, if a file is registered, we can read its locked/ -;;; unlocked state and its current owner from its permissions. -;;; -;;; This shortcut will fail if someone has manually changed the workfile's -;;; permissions; also if developers are munging the workfile in several -;;; directories, with symlinks to a master (in this latter case, the -;;; permissions shortcut will fail to detect a lock asserted from another -;;; directory). -;;; -;;; Note that these cases correspond exactly to the errors which could happen -;;; because of a competing checkin/checkout race in between two instances of -;;; vc-next-action. -;;; -;;; For VC's purposes, a workfile/master pair may have the following states: -;;; -;;; A. Unregistered. There is a workfile, there is no master. -;;; -;;; B. Registered and not locked by anyone. -;;; -;;; C. Locked by calling user and unchanged. -;;; -;;; D. Locked by the calling user and changed. -;;; -;;; E. Locked by someone other than the calling user. -;;; -;;; This makes for 25 states and 20 error conditions. Here's the matrix: -;;; -;;; VC's idea of state -;;; | -;;; V Actual state RCS action SCCS action Effect -;;; A B C D E -;;; A . 1 2 3 4 ci -u -t- admin -fb -i initial admin -;;; B 5 . 6 7 8 co -l get -e checkout -;;; C 9 10 . 11 12 co -u unget; get revert -;;; D 13 14 15 . 16 ci -u -m delta -y; get checkin -;;; E 17 18 19 20 . rcs -u -M -l unget -n ; get -g steal lock -;;; -;;; All commands take the master file name as a last argument (not shown). -;;; -;;; In the discussion below, a "self-race" is a pathological situation in -;;; which VC operations are being attempted simultaneously by two or more -;;; Emacsen running under the same username. -;;; -;;; The vc-next-action code has the following windows: -;;; -;;; Window P: -;;; Between the check for existence of a master file and the call to -;;; admin/checkin in vc-buffer-admin (apparent state A). This window may -;;; never close if the initial-comment feature is on. -;;; -;;; Window Q: -;;; Between the call to vc-workfile-unchanged-p in and the immediately -;;; following revert (apparent state C). -;;; -;;; Window R: -;;; Between the call to vc-workfile-unchanged-p in and the following -;;; checkin (apparent state D). This window may never close. -;;; -;;; Window S: -;;; Between the unlock and the immediately following checkout during a -;;; revert operation (apparent state C). Included in window Q. -;;; -;;; Window T: -;;; Between vc-locking-user and the following checkout (apparent state B). -;;; -;;; Window U: -;;; Between vc-locking-user and the following revert (apparent state C). -;;; Includes windows Q and S. -;;; -;;; Window V: -;;; Between vc-locking-user and the following checkin (apparent state -;;; D). This window may never be closed if the user fails to complete the -;;; checkin message. Includes window R. -;;; -;;; Window W: -;;; Between vc-locking-user and the following steal-lock (apparent -;;; state E). This window may never close if the user fails to complete -;;; the steal-lock message. Includes window X. -;;; -;;; Window X: -;;; Between the unlock and the immediately following re-lock during a -;;; steal-lock operation (apparent state E). This window may never cloce -;;; if the user fails to complete the steal-lock message. -;;; -;;; Errors: -;;; -;;; Apparent state A --- -;;; -;;; 1. File looked unregistered but is actually registered and not locked. -;;; -;;; Potential cause: someone else's admin during window P, with -;;; caller's admin happening before their checkout. -;;; -;;; RCS: Prior to version 5.6.4, ci fails with message -;;; "no lock set by ". From 5.6.4 onwards, VC uses the new -;;; ci -i option and the message is ",v: already exists". -;;; SCCS: admin will fail with error (ad19). -;;; -;;; We can let these errors be passed up to the user. -;;; -;;; 2. File looked unregistered but is actually locked by caller, unchanged. -;;; -;;; Potential cause: self-race during window P. -;;; -;;; RCS: Prior to version 5.6.4, reverts the file to the last saved -;;; version and unlocks it. From 5.6.4 onwards, VC uses the new -;;; ci -i option, failing with message ",v: already exists". -;;; SCCS: will fail with error (ad19). -;;; -;;; Either of these consequences is acceptable. -;;; -;;; 3. File looked unregistered but is actually locked by caller, changed. -;;; -;;; Potential cause: self-race during window P. -;;; -;;; RCS: Prior to version 5.6.4, VC registers the caller's workfile as -;;; a delta with a null change comment (the -t- switch will be -;;; ignored). From 5.6.4 onwards, VC uses the new ci -i option, -;;; failing with message ",v: already exists". -;;; SCCS: will fail with error (ad19). -;;; -;;; 4. File looked unregistered but is locked by someone else. -;;; -;;; Potential cause: someone else's admin during window P, with -;;; caller's admin happening *after* their checkout. -;;; -;;; RCS: Prior to version 5.6.4, ci fails with a -;;; "no lock set by " message. From 5.6.4 onwards, -;;; VC uses the new ci -i option, failing with message -;;; ",v: already exists". -;;; SCCS: will fail with error (ad19). -;;; -;;; We can let these errors be passed up to the user. -;;; -;;; Apparent state B --- -;;; -;;; 5. File looked registered and not locked, but is actually unregistered. -;;; -;;; Potential cause: master file got nuked during window P. -;;; -;;; RCS: will fail with "RCS/: No such file or directory" -;;; SCCS: will fail with error ut4. -;;; -;;; We can let these errors be passed up to the user. -;;; -;;; 6. File looked registered and not locked, but is actually locked by the -;;; calling user and unchanged. -;;; -;;; Potential cause: self-race during window T. -;;; -;;; RCS: in the same directory as the previous workfile, co -l will fail -;;; with "co error: writable foo exists; checkout aborted". In any other -;;; directory, checkout will succeed. -;;; SCCS: will fail with ge17. -;;; -;;; Either of these consequences is acceptable. -;;; -;;; 7. File looked registered and not locked, but is actually locked by the -;;; calling user and changed. -;;; -;;; As case 6. -;;; -;;; 8. File looked registered and not locked, but is actually locked by another -;;; user. -;;; -;;; Potential cause: someone else checks it out during window T. -;;; -;;; RCS: co error: revision 1.3 already locked by -;;; SCCS: fails with ge4 (in directory) or ut7 (outside it). -;;; -;;; We can let these errors be passed up to the user. -;;; -;;; Apparent state C --- -;;; -;;; 9. File looks locked by calling user and unchanged, but is unregistered. -;;; -;;; As case 5. -;;; -;;; 10. File looks locked by calling user and unchanged, but is actually not -;;; locked. -;;; -;;; Potential cause: a self-race in window U, or by the revert's -;;; landing during window X of some other user's steal-lock or window S -;;; of another user's revert. -;;; -;;; RCS: succeeds, refreshing the file from the identical version in -;;; the master. -;;; SCCS: fails with error ut4 (p file nonexistent). -;;; -;;; Either of these consequences is acceptable. -;;; -;;; 11. File is locked by calling user. It looks unchanged, but is actually -;;; changed. -;;; -;;; Potential cause: the file would have to be touched by a self-race -;;; during window Q. -;;; -;;; The revert will succeed, removing whatever changes came with -;;; the touch. It is theoretically possible that work could be lost. -;;; -;;; 12. File looks like it's locked by the calling user and unchanged, but -;;; it's actually locked by someone else. -;;; -;;; Potential cause: a steal-lock in window V. -;;; -;;; RCS: co error: revision locked by ; use co -r or rcs -u -;;; SCCS: fails with error un2 -;;; -;;; We can pass these errors up to the user. -;;; -;;; Apparent state D --- -;;; -;;; 13. File looks like it's locked by the calling user and changed, but it's -;;; actually unregistered. -;;; -;;; Potential cause: master file got nuked during window P. -;;; -;;; RCS: Prior to version 5.6.4, checks in the user's version as an -;;; initial delta. From 5.6.4 onwards, VC uses the new ci -j -;;; option, failing with message "no such file or directory". -;;; SCCS: will fail with error ut4. -;;; -;;; This case is kind of nasty. Under RCS prior to version 5.6.4, -;;; VC may fail to detect the loss of previous version information. -;;; -;;; 14. File looks like it's locked by the calling user and changed, but it's -;;; actually unlocked. -;;; -;;; Potential cause: self-race in window V, or the checkin happening -;;; during the window X of someone else's steal-lock or window S of -;;; someone else's revert. -;;; -;;; RCS: ci will fail with "no lock set by ". -;;; SCCS: delta will fail with error ut4. -;;; -;;; 15. File looks like it's locked by the calling user and changed, but it's -;;; actually locked by the calling user and unchanged. -;;; -;;; Potential cause: another self-race --- a whole checkin/checkout -;;; sequence by the calling user would have to land in window R. -;;; -;;; SCCS: checks in a redundant delta and leaves the file unlocked as usual. -;;; RCS: reverts to the file state as of the second user's checkin, leaving -;;; the file unlocked. -;;; -;;; It is theoretically possible that work could be lost under RCS. -;;; -;;; 16. File looks like it's locked by the calling user and changed, but it's -;;; actually locked by a different user. -;;; -;;; RCS: ci error: no lock set by -;;; SCCS: unget will fail with error un2 -;;; -;;; We can pass these errors up to the user. -;;; -;;; Apparent state E --- -;;; -;;; 17. File looks like it's locked by some other user, but it's actually -;;; unregistered. -;;; -;;; As case 13. -;;; -;;; 18. File looks like it's locked by some other user, but it's actually -;;; unlocked. -;;; -;;; Potential cause: someone released a lock during window W. -;;; -;;; RCS: The calling user will get the lock on the file. -;;; SCCS: unget -n will fail with cm4. -;;; -;;; Either of these consequences will be OK. -;;; -;;; 19. File looks like it's locked by some other user, but it's actually -;;; locked by the calling user and unchanged. -;;; -;;; Potential cause: the other user relinquishing a lock followed by -;;; a self-race, both in window W. -;;; -;;; Under both RCS and SCCS, both unlock and lock will succeed, making -;;; the sequence a no-op. -;;; -;;; 20. File looks like it's locked by some other user, but it's actually -;;; locked by the calling user and changed. -;;; -;;; As case 19. -;;; -;;; PROBLEM CASES: -;;; -;;; In order of decreasing severity: -;;; -;;; Cases 11 and 15 are the only ones that potentially lose work. -;;; They would require a self-race for this to happen. -;;; -;;; Case 13 in RCS loses information about previous deltas, retaining -;;; only the information in the current workfile. This can only happen -;;; if the master file gets nuked in window P. -;;; -;;; Case 3 in RCS and case 15 under SCCS insert a redundant delta with -;;; no change comment in the master. This would require a self-race in -;;; window P or R respectively. -;;; -;;; Cases 2, 10, 19 and 20 do extra work, but make no changes. -;;; -;;; Unfortunately, it appears to me that no recovery is possible in these -;;; cases. They don't yield error messages, so there's no way to tell that -;;; a race condition has occurred. -;;; -;;; All other cases don't change either the workfile or the master, and -;;; trigger command errors which the user will see. -;;; -;;; Thus, there is no explicit recovery code. - -;;; vc.el ends here diff -r f0deb0c0e6be -r eb5470882647 lisp/prim/custom-load.el --- a/lisp/prim/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/prim/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,11 +1,12 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:05:53 1997 +;; Created by SL Baur on Sat Oct 4 18:11:48 1997 ;;; Code: (custom-put 'mouse 'custom-loads '("mouse")) -(custom-put 'minibuffer 'custom-loads '("minibuf")) +(custom-put 'minibuffer 'custom-loads '("minibuf" "simple")) +(custom-put 'log-message 'custom-loads '("simple")) (custom-put 'environment 'custom-loads '("frame" "minibuf" "modeline" "sound")) (custom-put 'sound 'custom-loads '("sound")) (custom-put 'auto-save 'custom-loads '("files")) @@ -15,6 +16,7 @@ (custom-put 'lisp 'custom-loads '("lisp")) (custom-put 'help 'custom-loads '("help")) (custom-put 'keyboard 'custom-loads '("cmdloop")) +(custom-put 'warnings 'custom-loads '("simple")) (custom-put 'backup 'custom-loads '("files")) (custom-put 'frames 'custom-loads '("frame" "window-xemacs" "gui")) (custom-put 'abbrev 'custom-loads '("files")) diff -r f0deb0c0e6be -r eb5470882647 lisp/prim/dumped-lisp.el --- a/lisp/prim/dumped-lisp.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/prim/dumped-lisp.el Mon Aug 13 10:01:22 2007 +0200 @@ -48,7 +48,6 @@ ;;(load-gc (if (featurep 'sparcworks) "eos/loaddefs-eos" "loaddefs")) "startup" ; For initialization of ; `emacs-user-extension-dir' - "loaddefs" ; <=== autoloads get loaded here "misc" ;; (load-gc "profile") "help" @@ -178,7 +177,7 @@ #+tooltalk "tooltalk/tooltalk-macros" #+tooltalk "tooltalk/tooltalk-util" #+tooltalk "tooltalk/tooltalk-init" - "vc-hooks" + ;; "vc-hooks" ; Packaged. Available in two versions. "ediff-hook" "fontl-hooks" "auto-show" @@ -198,4 +197,5 @@ ;; #+sparcworks "sun-eos-debugger" ;; #+sparcworks "sun-eos-debugger-extra" ;; #+sparcworks "sun-eos-menubar" + "loaddefs" ; <=== autoloads get loaded here )) diff -r f0deb0c0e6be -r eb5470882647 lisp/prim/faces.el --- a/lisp/prim/faces.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/prim/faces.el Mon Aug 13 10:01:22 2007 +0200 @@ -1158,13 +1158,15 @@ (if frame (progn (reset-face face frame) - (face-display-set face spec frame)) + (face-display-set face spec frame) + (init-face-from-resources face frame)) (let ((frames (relevant-custom-frames))) (reset-face face) (face-display-set face spec) (while frames (face-display-set face spec (car frames)) - (pop frames))))) + (pop frames)) + (init-face-from-resources face)))) (defun face-display-set (face spec &optional frame) "Set FACE to the attributes to the first matching entry in SPEC. diff -r f0deb0c0e6be -r eb5470882647 lisp/prim/files.el --- a/lisp/prim/files.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/prim/files.el Mon Aug 13 10:01:22 2007 +0200 @@ -1195,7 +1195,7 @@ ("\\.py\\'" . python-mode) ("\\.texi\\(nfo\\)?\\'" . texinfo-mode) ("\\.ad[abs]\\'" . ada-mode) - ("\\.l\\(i?sp\\)?\\'" . lisp-mode) + ("\\.c?l\\(i?sp\\)?\\'" . lisp-mode) ("\\.p\\(as\\)?\\'" . pascal-mode) ("\\.ltx\\'" . latex-mode) ("\\.[sS]\\'" . asm-mode) @@ -2200,7 +2200,8 @@ ;; delete it now. (delete-auto-save-file-if-necessary recent-save) ;; Support VC `implicit' locking. - (vc-after-save) + (when (fboundp 'vc-after-save) + (vc-after-save)) (run-hooks 'after-save-hook)) (display-message 'no-log "(No changes need to be saved)")))) diff -r f0deb0c0e6be -r eb5470882647 lisp/prim/fill.el --- a/lisp/prim/fill.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/prim/fill.el Mon Aug 13 10:01:22 2007 +0200 @@ -43,7 +43,9 @@ A value of nil means that any change in indentation starts a new paragraph.") (defconst sentence-end-double-space t - "*Non-nil means a single space does not end a sentence.") + "*Non-nil means a single space does not end a sentence. +This variable applies only to filling, not motion commands. To +change the behavior of motion commands, see `sentence-end'.") (defconst colon-double-space nil "*Non-nil means put two spaces after a colon when filling.") diff -r f0deb0c0e6be -r eb5470882647 lisp/prim/modeline.el --- a/lisp/prim/modeline.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/prim/modeline.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; modeline.el --- modeline hackery. -;; Copyright (C) 1988, 1992, 1993, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1988, 1992-1994, 1997 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996 Ben Wing. ;; This file is part of XEmacs. @@ -22,6 +22,10 @@ ;;; Synched up with: Not in FSF. +;;; Commentary: + +;;; Code: + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; General mouse modeline stuff ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -467,7 +471,7 @@ (defvar modeline-modified-map (make-sparse-keymap 'modeline-modified-map) "Keymap consulted for mouse-clicks on the modeline-modified string.") (define-key modeline-modified-map 'button2 - (make-modeline-command-wrapper 'vc-toggle-read-only)) + (make-modeline-command-wrapper 'modeline-toggle-read-only)) (defvar modeline-modified-extent (make-extent nil nil) "Extent covering the modeline-modified string.") @@ -509,3 +513,20 @@ (purecopy '(column-number-mode "C%c--")) (purecopy '(-3 . "%p")) (purecopy "-%-"))) + +;;; Added for XEmacs 20.3. Provide wrapper for vc since it may not always be +;;; present, and its symbols are not visible this early in the dump if it +;;; is. + +(defun modeline-toggle-read-only () + "Change whether this buffer is visiting its file read-only. +With arg, set read-only iff arg is positive. +This function is designed to be called when the read-only indicator on the +modeline is clicked. It will call `vc-toggle-read-only' if available, +otherwise it will call the usual `toggle-read-only'." + (interactive) + (if (fboundp 'vc-toggle-read-only) + (vc-toggle-read-only) + (toggle-read-only))) + +;;; modeline.el ends here diff -r f0deb0c0e6be -r eb5470882647 lisp/prim/profile.el --- a/lisp/prim/profile.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/prim/profile.el Mon Aug 13 10:01:22 2007 +0200 @@ -35,8 +35,8 @@ ;; and looking at the current Lisp function, at the time of each tick. ;; The output of this process is an alist with keys being the ;; functions, and values being the number of ticks per function. From -;; this, `pretty-print-profiling-info' easily extracts the total -;; number of ticks, and the percentage CPU time of each function. +;; this, `profiling-results' easily extracts the total number of +;; ticks, and the percentage CPU time of each function. ;; Unless stated otherwise, profiling info is being accumulated (the ;; current info is returned by `get-profiling-info'). Use @@ -51,7 +51,7 @@ ;; A typical profiling session consists of using `clear-profiling-info' ;; followed by `profile' or `profile-key-sequence', followed by -;; `pretty-print-profiling-info'. +;; `profiling-results'. ;; For instance, to see where Gnus spends time when generating Summary ;; buffer, go to the group buffer, and press `M-x clear-profiling-info' @@ -61,7 +61,7 @@ ;;; Code: ;;;###autoload -(defun pretty-print-profiling-info (&optional info stream) +(defun profiling-results (&optional info stream) "Print profiling info INFO to STREAM in a pretty format. If INFO is omitted, the current profiling info is retrieved using `get-profiling-info'. @@ -108,7 +108,10 @@ (interactive-p)) (goto-char (point-min)))) -;; Is it really necessary for this to be a macro? +;; Support the old name for a while. +(define-obsolete-function-alias 'pretty-print-profiling-info + 'profile-results) + ;;;###autoload (defmacro profile (&rest forms) "Turn on profiling, execute FORMS and restore profiling state. @@ -116,7 +119,7 @@ PROFILE was called, it will be turned off after FORMS are evaluated. Otherwise, profiling will be left running. -Returns the profiling info, printable by `pretty-print-profiling-info'." +Returns the profiling info, printable by `profiling-results'." `(progn (if (profiling-active-p) (progn diff -r f0deb0c0e6be -r eb5470882647 lisp/prim/simple.el --- a/lisp/prim/simple.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/prim/simple.el Mon Aug 13 10:01:22 2007 +0200 @@ -80,6 +80,14 @@ :prefix "paren-" :group 'matching) +(defgroup log-message nil + "Messages logging and display customizations." + :group 'minibuffer) + +(defgroup warnings nil + "Warnings customizations." + :group 'minibuffer) + (defun newline (&optional arg) "Insert a newline, and move to left margin of the new line if it's blank. @@ -876,25 +884,23 @@ ;; A subsequent C-u means to multiply the factor by 4 if we've typed ;; nothing but C-u's; otherwise it means to terminate the prefix arg. (defun universal-argument-more (arg) - (interactive "P") + (interactive "_P") ; XEmacs (if (consp arg) (setq prefix-arg (list (* 4 (car arg)))) (setq prefix-arg arg) (setq overriding-terminal-local-map nil)) - (setq zmacs-region-stays t) ; XEmacs (setq universal-argument-num-events (length (this-command-keys)))) (defun negative-argument (arg) "Begin a negative numeric argument for the next command. \\[universal-argument] following digits or minus sign ends the argument." - (interactive "P") + (interactive "_P") ; XEmacs (cond ((integerp arg) (setq prefix-arg (- arg))) ((eq arg '-) (setq prefix-arg nil)) (t (setq prefix-arg '-))) - (setq zmacs-region-stays t) ; XEmacs (setq universal-argument-num-events (length (this-command-keys))) (setq overriding-terminal-local-map universal-argument-map)) @@ -902,7 +908,7 @@ (defun digit-argument (arg) "Part of the numeric argument for the next command. \\[universal-argument] following digits or minus sign ends the argument." - (interactive "P") + (interactive "_P") ; XEmacs (let* ((event last-command-event) (key (and (key-press-event-p event) (event-key event))) @@ -918,7 +924,6 @@ (setq prefix-arg (if (zerop digit) '- (- digit)))) (t (setq prefix-arg digit))) - (setq zmacs-region-stays t) (setq universal-argument-num-events (length (this-command-keys))) (setq overriding-terminal-local-map universal-argument-map)))) @@ -933,9 +938,8 @@ ;; Anything else terminates the argument and is left in the queue to be ;; executed as a command. (defun universal-argument-other-key (arg) - (interactive "P") + (interactive "_P") ; XEmacs (setq prefix-arg arg) - (setq zmacs-region-stays t) ; XEmacs (let* ((key (this-command-keys)) ;; FSF calls silly function `listify-key-sequence' here. (keylist (append key nil))) @@ -946,7 +950,7 @@ (setq overriding-terminal-local-map nil)) -;; XEmacs -- shouldn't these functions keep the zmacs region active? +;; XEmacs -- keep zmacs-region active. (defun forward-to-indentation (arg) "Move forward ARG lines and position at first nonblank character." (interactive "_p") @@ -1012,40 +1016,7 @@ ;;; not the X selection. But if that were provided, it should be called (and ;;; behave as) yank-hooks instead. -- jwz -;(defvar interprogram-cut-function nil -; "Function to call to make a killed region available to other programs. -; -;Most window systems provide some sort of facility for cutting and -;pasting text between the windows of different programs. -;This variable holds a function that XEmacs calls whenever text -;is put in the kill ring, to make the new kill available to other -;programs. -; -;The function takes one or two arguments. -;The first argument, TEXT, is a string containing -;the text which should be made available. -;The second, PUSH, if non-nil means this is a \"new\" kill; -;nil means appending to an \"old\" kill.") -; -;(defvar interprogram-paste-function nil -; "Function to call to get text cut from other programs. -; -;Most window systems provide some sort of facility for cutting and -;pasting text between the windows of different programs. -;This variable holds a function that Emacs calls to obtain -;text that other programs have provided for pasting. -; -;The function should be called with no arguments. If the function -;returns nil, then no other program has provided such text, and the top -;of the Emacs kill ring should be used. If the function returns a -;string, that string should be put in the kill ring as the latest kill. -; -;Note that the function should return a string only if a program other -;than Emacs has provided a string for pasting; if Emacs provided the -;most recent string, the function should return nil. If it is -;difficult to tell whether Emacs or some other program provided the -;current string, it is probably good enough to return nil if the string -;is equal (according to `string=') to the last text Emacs provided.") +;; [... code snipped ...] (defcustom kill-hooks nil "*Functions run when something is added to the XEmacs kill ring. @@ -1118,14 +1089,12 @@ ;;;; Commands for manipulating the kill ring. -;;FSFmacs +;; In FSF killing read-only text just pastes it into kill-ring. Which +;; is a very bad idea -- see Jamie's comment below. + ;(defvar kill-read-only-ok nil ; "*Non-nil means don't signal an error for killing read-only text.") -;(put 'text-read-only 'error-conditions -; '(text-read-only buffer-read-only error)) -;(put 'text-read-only 'error-message "Text is read-only") - (defun kill-region (beg end &optional verbose) ; verbose is XEmacs addition "Kill between point and mark. The text is deleted but saved in the kill ring. @@ -1328,7 +1297,7 @@ ;; This is like exchange-point-and-mark, but doesn't activate the mark. ;; It is cleaner to avoid activation, even though the command ;; loop would deactivate the mark because we inserted text. - ;; (But doesn't work in XEmacs) + ;; (But it's an unnecessary kludge in XEmacs.) ;(goto-char (prog1 (mark t) ;(set-marker (mark-marker) (point) (current-buffer))))) (exchange-point-and-mark t)) @@ -1643,7 +1612,9 @@ ;;; After 8 years of waiting ... -sb (defcustom next-line-add-newlines nil ; XEmacs - "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error." + "*If non-nil, `next-line' inserts newline when the point is at end of buffer. +This behavior used to be the default, and is still default in FSF Emacs. +We think it is an unnecessary and unwanted side-effect." :type 'boolean :group 'editing-basics) @@ -1716,7 +1687,7 @@ (defcustom goal-column nil "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil." - :type '(choice integer (const nil)) + :type '(choice integer (const :tag "None" nil)) :group 'editing-basics) (make-variable-buffer-local 'goal-column) @@ -1817,7 +1788,8 @@ ;;; Many people have said they rarely use this feature, and often type ;;; it by accident. Maybe it shouldn't even be on a key. -(put 'set-goal-column 'disabled t) +;; It's not on a key, as of 20.2. So no need for this. +;(put 'set-goal-column 'disabled t) (defun set-goal-column (arg) "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line]. @@ -2549,7 +2521,7 @@ (setq give-up t)))) ;; Justify last line. (justify-current-line justify t t) - t))) + t))) (defvar normal-auto-fill-function 'do-auto-fill "The function to use for `auto-fill-function' if Auto Fill mode is turned on. @@ -3191,6 +3163,8 @@ ;;; calls the lisp level zmacs-update-region. It must remain since it ;;; must be called by core C code. ;;; +;;; Huh? Why couldn't "core C code" just use +;;; call0(Qzmacs_update_region)??? -hniksic (defvar zmacs-activate-region-hook nil "Function or functions called when the region becomes active; @@ -3374,8 +3348,10 @@ message is passed as the first argument, and the text of the message as the second argument.") -(defvar log-message-max-size 50000 - "Maximum size of the \" *Message-Log*\" buffer. See `log-message'.") +(defcustom log-message-max-size 50000 + "Maximum size of the \" *Message-Log*\" buffer. See `log-message'." + :type 'integer + :group 'log-message) (make-compatible-variable 'message-log-max 'log-message-max-size) ;; We used to reject quite a lot of stuff here, but it was a bad idea, @@ -3392,7 +3368,7 @@ ;; So, I left only a few of the really useless ones on this kill-list. ;; ;; --hniksic -(defvar log-message-ignore-regexps +(defcustom log-message-ignore-regexps '(;; Note: adding entries to this list slows down messaging ;; significantly. Wherever possible, use message lables. @@ -3421,12 +3397,16 @@ Ideally, packages which generate messages which might need to be ignored should label them with 'progress, 'prompt, or 'no-log, so they can be -filtered by the log-message-ignore-labels.") - -(defvar log-message-ignore-labels +filtered by the log-message-ignore-labels." + :type '(repeat regexp) + :group 'log-message) + +(defcustom log-message-ignore-labels '(help-echo command progress prompt no-log garbage-collecting auto-saving) "List of symbols indicating labels of messages which shouldn't be logged. -See `display-message' for some common labels. See also `log-message'.") +See `display-message' for some common labels. See also `log-message'." + :type '(repeat (symbol :tag "Label")) + :group 'log-message) ;;Subsumed by view-lossage ;; Not really, I'm adding it back by popular demand. -slb @@ -3606,9 +3586,7 @@ ;;; may eventually be frame-dependent (defun current-message-label (&optional frame) - (if message-stack - (car (car message-stack)) - nil)) + (car (car message-stack))) (defun message (fmt &rest args) "Print a one-line message at the bottom of the frame. @@ -3631,7 +3609,7 @@ ;;;;;; warning stuff ;;;;;; -(defvar log-warning-minimum-level 'info +(defcustom log-warning-minimum-level 'info "Minimum level of warnings that should be logged. The warnings in levels below this are completely ignored, as if they never happened. @@ -3644,9 +3622,13 @@ You can also control which warnings are displayed on a class-by-class basis. See `display-warning-suppressed-classes' and -`log-warning-suppressed-classes'.") - -(defvar display-warning-minimum-level 'info +`log-warning-suppressed-classes'." + :type '(choice (const emergency) (const alert) (const critical) + (const error) (const warning) (const notice) + (const info) (const debug)) + :group 'warnings) + +(defcustom display-warning-minimum-level 'info "Minimum level of warnings that should be displayed. The warnings in levels below this are completely ignored, as if they never happened. @@ -3659,7 +3641,11 @@ You can also control which warnings are displayed on a class-by-class basis. See `display-warning-suppressed-classes' and -`log-warning-suppressed-classes'.") +`log-warning-suppressed-classes'." + :type '(choice (const emergency) (const alert) (const critical) + (const error) (const warning) (const notice) + (const info) (const debug)) + :group 'warnings) (defvar log-warning-suppressed-classes nil "List of classes of warnings that shouldn't be logged or displayed. @@ -3673,7 +3659,7 @@ See also `log-warning-minimum-level' and `display-warning-minimum-level'.") -(defvar display-warning-suppressed-classes nil +(defcustom display-warning-suppressed-classes nil "List of classes of warnings that shouldn't be displayed. If any of the CLASS symbols associated with a warning is the same as any of the symbols listed here, the warning will not be displayed. @@ -3681,7 +3667,9 @@ contained in `log-warning-suppressed-classes'), but the buffer will not be automatically popped up. -See also `log-warning-minimum-level' and `display-warning-minimum-level'.") +See also `log-warning-minimum-level' and `display-warning-minimum-level'." + :type '(repeat symbol) + :group 'warnings) (defvar warning-count 0 "Count of the number of warning messages displayed so far.") @@ -3797,7 +3785,7 @@ (set-marker warning-marker (point-max buffer) buffer))) (defun emacs-name () - "Return the printable name of this instance of GNU Emacs." + "Return the printable name of this instance of Emacs." (cond ((featurep 'infodock) "InfoDock") ((featurep 'xemacs) "XEmacs") (t "Emacs"))) diff -r f0deb0c0e6be -r eb5470882647 lisp/psgml/custom-load.el --- a/lisp/psgml/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/psgml/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:05:55 1997 +;; Created by SL Baur on Sat Oct 4 18:11:50 1997 ;;; Code: diff -r f0deb0c0e6be -r eb5470882647 lisp/psgml/psgml.el --- a/lisp/psgml/psgml.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/psgml/psgml.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,5 +1,5 @@ ;;; psgml.el --- SGML-editing mode with parsing support -;; $Id: psgml.el,v 1.8 1997/09/03 02:55:43 steve Exp $ +;; $Id: psgml.el,v 1.9 1997/10/05 01:15:30 steve Exp $ ;; Copyright (C) 1993, 1994, 1995, 1996 Lennart Staflin ;; Copyright (C) 1992 Free Software Foundation, Inc. @@ -889,6 +889,7 @@ (define-key sgml-mode-map "\e\C-@" 'sgml-mark-element) ;;(define-key sgml-mode-map [?\M-\C-\ ] 'sgml-mark-element) (define-key sgml-mode-map "\e\C-h" 'sgml-mark-current-element) +(define-key sgml-mode-map [(meta backspace)] (lookup-key (current-global-map) [(meta backspace)])) (define-key sgml-mode-map "\e\C-t" 'sgml-transpose-element) (define-key sgml-mode-map "\M-\t" 'sgml-complete) diff -r f0deb0c0e6be -r eb5470882647 lisp/rmail/custom-load.el --- a/lisp/rmail/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -;;; custom-load.el --- automatically extracted custom dependencies - -;; Created by SL Baur on Sun Sep 28 14:03:34 1997 - -;;; Code: - - -;;; custom-load.el ends here diff -r f0deb0c0e6be -r eb5470882647 lisp/utils/custom-load.el --- a/lisp/utils/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/utils/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:05:58 1997 +;; Created by SL Baur on Sat Oct 4 18:11:53 1997 ;;; Code: @@ -25,7 +25,7 @@ (custom-put 'detached-minibuf 'custom-loads '("detached-minibuf")) (custom-put 'languages 'custom-loads '("crontab")) (custom-put 'edmacro 'custom-loads '("edmacro")) -(custom-put 'faces 'custom-loads '("highlight-headers")) +(custom-put 'faces 'custom-loads '("font" "highlight-headers")) (custom-put 'passwd 'custom-loads '("passwd")) (custom-put 'browse-url 'custom-loads '("browse-url")) (custom-put 'processes 'custom-loads '("passwd")) diff -r f0deb0c0e6be -r eb5470882647 lisp/utils/font.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/utils/font.el Mon Aug 13 10:01:22 2007 +0200 @@ -0,0 +1,1248 @@ +;;; font.el --- New font model +;; Author: wmperry +;; Created: 1997/09/05 15:44:37 +;; Version: 1.52 +;; Keywords: faces + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. +;;; +;;; 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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; The emacsen compatibility package - load it up before anything else +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(require 'cl) +(require 'devices) + +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + (` (defvar (, var) (, value) (, doc)))))) + +(if (not (fboundp 'try-font-name)) + (defun try-font-name (fontname &rest args) + (case window-system + ((x win32 w32 pm) (car-safe (x-list-fonts fontname))) + (ns (car-safe (ns-list-fonts fontname))) + (otherwise nil)))) + +(if (not (fboundp 'facep)) + (defun facep (face) + "Return t if X is a face name or an internal face vector." + (if (not window-system) + nil ; FIXME if FSF ever does TTY faces + (and (or (internal-facep face) + (and (symbolp face) (assq face global-face-data))) + t)))) + +(if (not (fboundp 'set-face-property)) + (defun set-face-property (face property value &optional locale + tag-set how-to-add) + "Change a property of FACE." + (and (symbolp face) + (put face property value)))) + +(if (not (fboundp 'face-property)) + (defun face-property (face property &optional locale tag-set exact-p) + "Return FACE's value of the given PROPERTY." + (and (symbolp face) (get face property)))) + +(require 'disp-table) + +(if (not (fboundp '<<)) (fset '<< 'lsh)) +(if (not (fboundp '&)) (fset '& 'logand)) +(if (not (fboundp '|)) (fset '| 'logior)) +(if (not (fboundp '~)) (fset '~ 'lognot)) +(if (not (fboundp '>>)) (defun >> (value count) (<< value (- count)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Lots of variables / keywords for use later in the program +;;; Not much should need to be modified +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defconst font-running-xemacs (string-match "XEmacs" (emacs-version)) + "Whether we are running in XEmacs or not.") + +(defmacro define-font-keywords (&rest keys) + (` + (eval-and-compile + (let ((keywords (quote (, keys)))) + (while keywords + (or (boundp (car keywords)) + (set (car keywords) (car keywords))) + (setq keywords (cdr keywords))))))) + +(defconst font-window-system-mappings + '((x . (x-font-create-name x-font-create-object)) + (ns . (ns-font-create-name ns-font-create-object)) + (win32 . (x-font-create-name x-font-create-object)) + (w32 . (x-font-create-name x-font-create-object)) + (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME + (tty . (tty-font-create-plist tty-font-create-object))) + "An assoc list mapping device types to the function used to create +a font name from a font structure.") + +(defconst ns-font-weight-mappings + '((:extra-light . "extralight") + (:light . "light") + (:demi-light . "demilight") + (:medium . "medium") + (:normal . "medium") + (:demi-bold . "demibold") + (:bold . "bold") + (:extra-bold . "extrabold")) + "An assoc list mapping keywords to actual NeXTstep specific +information to use") + +(defconst x-font-weight-mappings + '((:extra-light . "extralight") + (:light . "light") + (:demi-light . "demilight") + (:demi . "demi") + (:book . "book") + (:medium . "medium") + (:normal . "medium") + (:demi-bold . "demibold") + (:bold . "bold") + (:extra-bold . "extrabold")) + "An assoc list mapping keywords to actual Xwindow specific strings +for use in the 'weight' field of an X font string.") + +(defconst font-possible-weights + (mapcar 'car x-font-weight-mappings)) + +(defvar font-rgb-file nil + "Where the RGB file was found.") + +(defvar font-maximum-slippage "1pt" + "How much a font is allowed to vary from the desired size.") + +(defvar font-family-mappings + '( + ("serif" . ("new century schoolbook" + "utopia" + "charter" + "times" + "lucidabright" + "garamond" + "palatino" + "times new roman" + "baskerville" + "bookman" + "bodoni" + "computer modern" + "rockwell" + )) + ("sans-serif" . ("lucida" + "helvetica" + "gills-sans" + "avant-garde" + "univers" + "optima")) + ("elfin" . ("tymes")) + ("monospace" . ("courier" + "courier new" + "fixed" + "lucidatypewriter" + "clean" + "terminal")) + ("cursive" . ("sirene" + "zapf chancery")) + ) + "A list of font family mappings.") + +(define-font-keywords :family :style :size :registry :encoding) + +(define-font-keywords + :weight :extra-light :light :demi-light :medium :normal :demi-bold + :bold :extra-bold) + +(defvar font-style-keywords nil) + +(defsubst set-font-family (fontobj family) + (aset fontobj 1 family)) + +(defsubst set-font-weight (fontobj weight) + (aset fontobj 3 weight)) + +(defsubst set-font-style (fontobj style) + (aset fontobj 5 style)) + +(defsubst set-font-size (fontobj size) + (aset fontobj 7 size)) + +(defsubst set-font-registry (fontobj reg) + (aset fontobj 9 reg)) + +(defsubst set-font-encoding (fontobj enc) + (aset fontobj 11 enc)) + +(defsubst font-family (fontobj) + (aref fontobj 1)) + +(defsubst font-weight (fontobj) + (aref fontobj 3)) + +(defsubst font-style (fontobj) + (aref fontobj 5)) + +(defsubst font-size (fontobj) + (aref fontobj 7)) + +(defsubst font-registry (fontobj) + (aref fontobj 9)) + +(defsubst font-encoding (fontobj) + (aref fontobj 11)) + +(eval-when-compile + (defmacro define-new-mask (attr mask) + (` + (progn + (setq font-style-keywords + (cons (cons (quote (, attr)) + (cons + (quote (, (intern (format "set-font-%s-p" attr)))) + (quote (, (intern (format "font-%s-p" attr)))))) + font-style-keywords)) + (defconst (, (intern (format "font-%s-mask" attr))) (<< 1 (, mask)) + (, (format + "Bitmask for whether a font is to be rendered in %s or not." + attr))) + (defun (, (intern (format "font-%s-p" attr))) (fontobj) + (, (format "Whether FONTOBJ will be renderd in `%s' or not." attr)) + (if (/= 0 (& (font-style fontobj) + (, (intern (format "font-%s-mask" attr))))) + t + nil)) + (defun (, (intern (format "set-font-%s-p" attr))) (fontobj val) + (, (format "Set whether FONTOBJ will be renderd in `%s' or not." + attr)) + (cond + (val + (set-font-style fontobj (| (font-style fontobj) + (, (intern + (format "font-%s-mask" attr)))))) + (((, (intern (format "font-%s-p" attr))) fontobj) + (set-font-style fontobj (- (font-style fontobj) + (, (intern + (format "font-%s-mask" attr)))))))) + )))) + +(let ((mask 0)) + (define-new-mask bold (setq mask (1+ mask))) + (define-new-mask italic (setq mask (1+ mask))) + (define-new-mask oblique (setq mask (1+ mask))) + (define-new-mask dim (setq mask (1+ mask))) + (define-new-mask underline (setq mask (1+ mask))) + (define-new-mask overline (setq mask (1+ mask))) + (define-new-mask linethrough (setq mask (1+ mask))) + (define-new-mask strikethru (setq mask (1+ mask))) + (define-new-mask reverse (setq mask (1+ mask))) + (define-new-mask blink (setq mask (1+ mask))) + (define-new-mask smallcaps (setq mask (1+ mask))) + (define-new-mask bigcaps (setq mask (1+ mask))) + (define-new-mask dropcaps (setq mask (1+ mask)))) + +(defvar font-caps-display-table + (let ((table (make-display-table)) + (i 0)) + ;; Standard ASCII characters + (while (< i 26) + (aset table (+ i ?a) (+ i ?A)) + (setq i (1+ i))) + ;; Now ISO translations + (setq i 224) + (while (< i 247) ;; Agrave - Ouml + (aset table i (- i 32)) + (setq i (1+ i))) + (setq i 248) + (while (< i 255) ;; Oslash - Thorn + (aset table i (- i 32)) + (setq i (1+ i))) + table)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Utility functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defsubst set-font-style-by-keywords (fontobj styles) + (make-local-variable 'font-func) + (declare (special font-func)) + (if (listp styles) + (while styles + (setq font-func (car-safe (cdr-safe (assq (car styles) font-style-keywords))) + styles (cdr styles)) + (and (fboundp font-func) (funcall font-func fontobj t))) + (setq font-func (car-safe (cdr-safe (assq styles font-style-keywords)))) + (and (fboundp font-func) (funcall font-func fontobj t)))) + +(defsubst font-properties-from-style (fontobj) + (let ((style (font-style fontobj)) + (todo font-style-keywords) + type func retval) + (while todo + (setq func (cdr (cdr (car todo))) + type (car (pop todo))) + (if (funcall func fontobj) + (setq retval (cons type retval)))) + retval)) + +(defun font-unique (list) + (let ((retval) + (cur)) + (while list + (setq cur (car list) + list (cdr list)) + (if (member cur retval) + nil + (setq retval (cons cur retval)))) + (nreverse retval))) + +(defun font-higher-weight (w1 w2) + (let ((index1 (length (memq w1 font-possible-weights))) + (index2 (length (memq w2 font-possible-weights)))) + (cond + ((<= index1 index2) + (or w1 w2)) + ((not w2) + w1) + (t + w2)))) + +(defun font-spatial-to-canonical (spec &optional device) + "Convert SPEC (in inches, millimeters, points, or picas) into points" + ;; 1 in = 6 pa = 25.4 mm = 72 pt + (cond + ((numberp spec) + spec) + ((null spec) + nil) + (t + (let ((num nil) + (type nil) + ;; If for any reason we get null for any of this, default + ;; to 1024x768 resolution on a 17" screen + (pix-width (float (or (device-pixel-width device) 1024))) + (mm-width (float (or (device-mm-width device) 293))) + (retval nil)) + (cond + ((string-match "^ *\\([-+*/]\\) *" spec) ; math! whee! + (let ((math-func (intern (match-string 1 spec))) + (other (font-spatial-to-canonical + (substring spec (match-end 0) nil))) + (default (font-spatial-to-canonical + (font-default-size-for-device device)))) + (if (fboundp math-func) + (setq type "px" + spec (int-to-string (funcall math-func default other))) + (setq type "px" + spec (int-to-string other))))) + ((string-match "[^0-9.]+$" spec) + (setq type (substring spec (match-beginning 0)) + spec (substring spec 0 (match-beginning 0)))) + (t + (setq type "px" + spec spec))) + (setq num (string-to-number spec)) + (cond + ((member type '("pixel" "px" "pix")) + (setq retval (* num (/ pix-width mm-width) (/ 25.4 72.0)))) + ((member type '("point" "pt")) + (setq retval num)) + ((member type '("pica" "pa")) + (setq retval (* num 12.0))) + ((member type '("inch" "in")) + (setq retval (* num 72.0))) + ((string= type "mm") + (setq retval (* num (/ 72.0 25.4)))) + ((string= type "cm") + (setq retval (* num 10 (/ 72.0 25.4)))) + (t + (setq retval num)) + ) + retval)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; The main interface routines - constructors and accessor functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun make-font (&rest args) + (vector :family + (if (stringp (plist-get args :family)) + (list (plist-get args :family)) + (plist-get args :family)) + :weight + (plist-get args :weight) + :style + (if (numberp (plist-get args :style)) + (plist-get args :style) + 0) + :size + (plist-get args :size) + :registry + (plist-get args :registry) + :encoding + (plist-get args :encoding))) + +(defun font-create-name (fontobj &optional device) + (let* ((type (device-type device)) + (func (car (cdr-safe (assq type font-window-system-mappings))))) + (and func (fboundp func) (funcall func fontobj device)))) + +;;;###autoload +(defun font-create-object (fontname &optional device) + (let* ((type (device-type device)) + (func (car (cdr (cdr-safe (assq type font-window-system-mappings)))))) + (and func (fboundp func) (funcall func fontname device)))) + +(defun font-combine-fonts-internal (fontobj-1 fontobj-2) + (let ((retval (make-font)) + (size-1 (and (font-size fontobj-1) + (font-spatial-to-canonical (font-size fontobj-1)))) + (size-2 (and (font-size fontobj-2) + (font-spatial-to-canonical (font-size fontobj-2))))) + (set-font-weight retval (font-higher-weight (font-weight fontobj-1) + (font-weight fontobj-2))) + (set-font-family retval (font-unique (append (font-family fontobj-1) + (font-family fontobj-2)))) + (set-font-style retval (| (font-style fontobj-1) (font-style fontobj-2))) + (set-font-registry retval (or (font-registry fontobj-1) + (font-registry fontobj-2))) + (set-font-encoding retval (or (font-encoding fontobj-1) + (font-encoding fontobj-2))) + (set-font-size retval (cond + ((and size-1 size-2 (>= size-2 size-1)) + (font-size fontobj-2)) + ((and size-1 size-2) + (font-size fontobj-1)) + (size-1 + (font-size fontobj-1)) + (size-2 + (font-size fontobj-2)) + (t nil))) + + retval)) + +(defun font-combine-fonts (&rest args) + (cond + ((null args) + (error "Wrong number of arguments to font-combine-fonts")) + ((= (length args) 1) + (car args)) + (t + (let ((retval (font-combine-fonts-internal (nth 0 args) (nth 1 args)))) + (setq args (cdr (cdr args))) + (while args + (setq retval (font-combine-fonts-internal retval (car args)) + args (cdr args))) + retval)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; The window-system dependent code (TTY-style) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun tty-font-create-object (fontname &optional device) + (make-font :size "12pt")) + +(defun tty-font-create-plist (fontobj &optional device) + (let ((styles (font-style fontobj)) + (weight (font-weight fontobj))) + (list + (cons 'underline (font-underline-p fontobj)) + (cons 'highlight (if (or (font-bold-p fontobj) + (memq weight '(:bold :demi-bold))) t)) + (cons 'dim (font-dim-p fontobj)) + (cons 'blinking (font-blink-p fontobj)) + (cons 'reverse (font-reverse-p fontobj))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; The window-system dependent code (X-style) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar font-x-font-regexp (or (and font-running-xemacs + (boundp 'x-font-regexp) + x-font-regexp) + (let + ((- "[-?]") + (foundry "[^-]*") + (family "[^-]*") + (weight "\\(bold\\|demibold\\|medium\\|black\\)") + (weight\? "\\([^-]*\\)") + (slant "\\([ior]\\)") + (slant\? "\\([^-]?\\)") + (swidth "\\([^-]*\\)") + (adstyle "\\([^-]*\\)") + (pixelsize "\\(\\*\\|[0-9]+\\)") + (pointsize "\\(\\*\\|0\\|[0-9][0-9]+\\)") + (resx "\\([*0]\\|[0-9][0-9]+\\)") + (resy "\\([*0]\\|[0-9][0-9]+\\)") + (spacing "[cmp?*]") + (avgwidth "\\(\\*\\|[0-9]+\\)") + (registry "[^-]*") + (encoding "[^-]+") + ) + (concat "\\`\\*?[-?*]" + foundry - family - weight\? - slant\? - swidth - adstyle - + pixelsize - pointsize - resx - resy - spacing - avgwidth - + registry - encoding "\\'" + )))) + +(defvar font-x-registry-and-encoding-regexp + (or (and font-running-xemacs + (boundp 'x-font-regexp-registry-and-encoding) + (symbol-value 'x-font-regexp-registry-and-encoding)) + (let ((- "[-?]") + (registry "[^-]*") + (encoding "[^-]+")) + (concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'")))) + +(defun x-font-create-object (fontname &optional device) + (let ((case-fold-search t)) + (if (or (not (stringp fontname)) + (not (string-match font-x-font-regexp fontname))) + (make-font) + (let ((family nil) + (style nil) + (size nil) + (weight (match-string 1 fontname)) + (slant (match-string 2 fontname)) + (swidth (match-string 3 fontname)) + (adstyle (match-string 4 fontname)) + (pxsize (match-string 5 fontname)) + (ptsize (match-string 6 fontname)) + (retval nil) + (case-fold-search t) + ) + (if (not (string-match x-font-regexp-foundry-and-family fontname)) + nil + (setq family (list (downcase (match-string 1 fontname))))) + (if (string= "*" weight) (setq weight nil)) + (if (string= "*" slant) (setq slant nil)) + (if (string= "*" swidth) (setq swidth nil)) + (if (string= "*" adstyle) (setq adstyle nil)) + (if (string= "*" pxsize) (setq pxsize nil)) + (if (string= "*" ptsize) (setq ptsize nil)) + (if ptsize (setq size (/ (string-to-int ptsize) 10))) + (if (and (not size) pxsize) (setq size (concat pxsize "px"))) + (if weight (setq weight (intern-soft (concat ":" (downcase weight))))) + (if (and adstyle (not (equal adstyle ""))) + (setq family (append family (list (downcase adstyle))))) + (setq retval (make-font :family family + :weight weight + :size size)) + (set-font-bold-p retval (eq :bold weight)) + (cond + ((null slant) nil) + ((member slant '("i" "I")) + (set-font-italic-p retval t)) + ((member slant '("o" "O")) + (set-font-oblique-p retval t))) + (if (string-match font-x-registry-and-encoding-regexp fontname) + (progn + (set-font-registry retval (match-string 1 fontname)) + (set-font-encoding retval (match-string 2 fontname)))) + retval)))) + +(defun x-font-families-for-device (&optional device no-resetp) + (condition-case () + (require 'x-font-menu) + (error nil)) + (or device (setq device (selected-device))) + (if (boundp 'device-fonts-cache) + (let ((menu (or (cdr-safe (assq device device-fonts-cache))))) + (if (and (not menu) (not no-resetp)) + (progn + (reset-device-font-menus device) + (x-font-families-for-device device t)) + (let ((scaled (mapcar (function (lambda (x) (if x (aref x 0)))) + (aref menu 0))) + (normal (mapcar (function (lambda (x) (if x (aref x 0)))) + (aref menu 1)))) + (sort (font-unique (nconc scaled normal)) 'string-lessp)))) + (cons "monospace" (mapcar 'car font-family-mappings)))) + +(defvar font-default-cache nil) + +;;;###autoload +(defun font-default-font-for-device (&optional device) + (or device (setq device (selected-device))) + (if font-running-xemacs + (font-truename + (make-font-specifier + (face-font-name 'default device))) + (let ((font (cdr-safe (assq 'font (frame-parameters device))))) + (if (and (fboundp 'fontsetp) (fontsetp font)) + (aref (get-font-info (aref (cdr (get-fontset-info font)) 0)) 2) + font)))) + +;;;###autoload +(defun font-default-object-for-device (&optional device) + (let ((font (font-default-font-for-device device))) + (or (cdr-safe + (assoc font font-default-cache)) + (progn + (setq font-default-cache (cons (cons font + (font-create-object font)) + font-default-cache)) + (cdr-safe (assoc font font-default-cache)))))) + +;;;###autoload +(defun font-default-family-for-device (&optional device) + (or device (setq device (selected-device))) + (font-family (font-default-object-for-device device))) + +;;;###autoload +(defun font-default-registry-for-device (&optional device) + (or device (setq device (selected-device))) + (font-registry (font-default-object-for-device device))) + +;;;###autoload +(defun font-default-encoding-for-device (&optional device) + (or device (setq device (selected-device))) + (font-encoding (font-default-object-for-device device))) + +;;;###autoload +(defun font-default-size-for-device (&optional device) + (or device (setq device (selected-device))) + ;; face-height isn't the right thing (always 1 pixel too high?) + ;; (if font-running-xemacs + ;; (format "%dpx" (face-height 'default device)) + (font-size (font-default-object-for-device device))) + +(defun x-font-create-name (fontobj &optional device) + (if (and (not (or (font-family fontobj) + (font-weight fontobj) + (font-size fontobj) + (font-registry fontobj) + (font-encoding fontobj))) + (= (font-style fontobj) 0)) + (face-font 'default) + (or device (setq device (selected-device))) + (let* ((default (font-default-object-for-device device)) + (family (or (font-family fontobj) + (font-family default) + (x-font-families-for-device device))) + (weight (or (font-weight fontobj) :medium)) + (style (font-style fontobj)) + (size (or (if font-running-xemacs + (font-size fontobj)) + (font-size default))) + (registry (or (font-registry fontobj) + (font-registry default) + "*")) + (encoding (or (font-encoding fontobj) + (font-encoding default) + "*"))) + (if (stringp family) + (setq family (list family))) + (setq weight (font-higher-weight weight + (and (font-bold-p fontobj) :bold))) + (if (stringp size) + (setq size (truncate (font-spatial-to-canonical size device)))) + (setq weight (or (cdr-safe (assq weight x-font-weight-mappings)) "*")) + (let ((done nil) ; Did we find a good font yet? + (font-name nil) ; font name we are currently checking + (cur-family nil) ; current family we are checking + ) + (while (and family (not done)) + (setq cur-family (car family) + family (cdr family)) + (if (assoc cur-family font-family-mappings) + ;; If the family name is an alias as defined by + ;; font-family-mappings, then append those families + ;; to the front of 'family' and continue in the loop. + (setq family (append + (cdr-safe (assoc cur-family + font-family-mappings)) + family)) + ;; Not an alias for a list of fonts, so we just check it. + ;; First, convert all '-' to spaces so that we don't screw up + ;; the oh-so wonderful X font model. Wheee. + (let ((x (length cur-family))) + (while (> x 0) + (if (= ?- (aref cur-family (1- x))) + (aset cur-family (1- x) ? )) + (setq x (1- x)))) + ;; We treat oblique and italic as equivalent. Don't ask. + (let ((slants '("o" "i"))) + (while (and slants (not done)) + (setq font-name (format "-*-%s-%s-%s-*-*-*-%s-*-*-*-*-%s-%s" + cur-family weight + (if (or (font-italic-p fontobj) + (font-oblique-p fontobj)) + (car slants) + "r") + (if size + (int-to-string (* 10 size)) "*") + registry + encoding + ) + slants (cdr slants) + done (try-font-name font-name device)))))) + (if done font-name))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; The window-system dependent code (NS-style) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun ns-font-families-for-device (&optional device no-resetp) + ;; For right now, assume we are going to have the same storage for + ;; device fonts for NS as we do for X. Is this a valid assumption? + (or device (setq device (selected-device))) + (if (boundp 'device-fonts-cache) + (let ((menu (or (cdr-safe (assq device device-fonts-cache))))) + (if (and (not menu) (not no-resetp)) + (progn + (reset-device-font-menus device) + (ns-font-families-for-device device t)) + (let ((scaled (mapcar (function (lambda (x) (if x (aref x 0)))) + (aref menu 0))) + (normal (mapcar (function (lambda (x) (if x (aref x 0)))) + (aref menu 1)))) + (sort (font-unique (nconc scaled normal)) 'string-lessp)))))) + +(defun ns-font-create-name (fontobj &optional device) + (let ((family (or (font-family fontobj) + (ns-font-families-for-device device))) + (weight (or (font-weight fontobj) :medium)) + (style (or (font-style fontobj) (list :normal))) + (size (font-size fontobj)) + (registry (or (font-registry fontobj) "*")) + (encoding (or (font-encoding fontobj) "*"))) + ;; Create a font, wow! + (if (stringp family) + (setq family (list family))) + (if (or (symbolp style) (numberp style)) + (setq style (list style))) + (setq weight (font-higher-weight weight (car-safe (memq :bold style)))) + (if (stringp size) + (setq size (font-spatial-to-canonical size device))) + (setq weight (or (cdr-safe (assq weight ns-font-weight-mappings)) + "medium")) + (let ((done nil) ; Did we find a good font yet? + (font-name nil) ; font name we are currently checking + (cur-family nil) ; current family we are checking + ) + (while (and family (not done)) + (setq cur-family (car family) + family (cdr family)) + (if (assoc cur-family font-family-mappings) + ;; If the family name is an alias as defined by + ;; font-family-mappings, then append those families + ;; to the front of 'family' and continue in the loop. + (setq family (append + (cdr-safe (assoc cur-family + font-family-mappings)) + family)) + ;; CARL: Need help here - I am not familiar with the NS font + ;; model + (setq font-name "UNKNOWN FORMULA GOES HERE" + done (try-font-name font-name device)))) + (if done font-name)))) + + +;;; Cache building code +;;;###autoload +(defun x-font-build-cache (&optional device) + (let ((hashtable (make-hash-table :test 'equal :size 15)) + (fonts (mapcar 'x-font-create-object + (x-list-fonts "-*-*-*-*-*-*-*-*-*-*-*-*-*-*"))) + (plist nil) + (cur nil)) + (while fonts + (setq cur (car fonts) + fonts (cdr fonts) + plist (cl-gethash (car (font-family cur)) hashtable)) + (if (not (memq (font-weight cur) (plist-get plist 'weights))) + (setq plist (plist-put plist 'weights (cons (font-weight cur) + (plist-get plist 'weights))))) + (if (not (member (font-size cur) (plist-get plist 'sizes))) + (setq plist (plist-put plist 'sizes (cons (font-size cur) + (plist-get plist 'sizes))))) + (if (and (font-oblique-p cur) + (not (memq 'oblique (plist-get plist 'styles)))) + (setq plist (plist-put plist 'styles (cons 'oblique (plist-get plist 'styles))))) + (if (and (font-italic-p cur) + (not (memq 'italic (plist-get plist 'styles)))) + (setq plist (plist-put plist 'styles (cons 'italic (plist-get plist 'styles))))) + (cl-puthash (car (font-family cur)) plist hashtable)) + hashtable)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Now overwrite the original copy of set-face-font with our own copy that +;;; can deal with either syntax. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ###autoload +(defun font-set-face-font (&optional face font &rest args) + (cond + ((and (vectorp font) (= (length font) 12)) + (let ((font-name (font-create-name font))) + (set-face-property face 'font-specification font) + (cond + ((null font-name) ; No matching font! + nil) + ((listp font-name) ; For TTYs + (let (cur) + (while font-name + (setq cur (car font-name) + font-name (cdr font-name)) + (apply 'set-face-property face (car cur) (cdr cur) args)))) + (font-running-xemacs + (apply 'set-face-font face font-name args) + (apply 'set-face-underline-p face (font-underline-p font) args) + (if (and (or (font-smallcaps-p font) (font-bigcaps-p font)) + (fboundp 'set-face-display-table)) + (apply 'set-face-display-table + face font-caps-display-table args)) + (apply 'set-face-property face 'strikethru (or + (font-linethrough-p font) + (font-strikethru-p font)) + args)) + (t + (condition-case nil + (apply 'set-face-font face font-name args) + (error + (let ((args (car-safe args))) + (and (or (font-bold-p font) + (memq (font-weight font) '(:bold :demi-bold))) + (make-face-bold face args t)) + (and (font-italic-p font) (make-face-italic face args t))))) + (apply 'set-face-underline-p face (font-underline-p font) args))))) + (t + ;; Let the original set-face-font signal any errors + (set-face-property face 'font-specification nil) + (apply 'set-face-font face font args)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Now for emacsen specific stuff +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun font-update-device-fonts (device) + ;; Update all faces that were created with the 'font' package + ;; to appear correctly on the new device. This should be in the + ;; create-device-hook. This is XEmacs 19.12+ specific + (let ((faces (face-list 2)) + (cur nil) + (font nil) + (font-spec nil)) + (while faces + (setq cur (car faces) + faces (cdr faces) + font-spec (face-property cur 'font-specification)) + (if font-spec + (set-face-font cur font-spec device))))) + +(defun font-update-one-face (face &optional device-list) + ;; Update FACE on all devices in DEVICE-LIST + ;; DEVICE_LIST defaults to a list of all active devices + (setq device-list (or device-list (device-list))) + (if (devicep device-list) + (setq device-list (list device-list))) + (let* ((cur-device nil) + (font-spec (face-property face 'font-specification)) + (font nil)) + (if (not font-spec) + ;; Hey! Don't mess with fonts we didn't create in the + ;; first place. + nil + (while device-list + (setq cur-device (car device-list) + device-list (cdr device-list)) + (if (not (device-live-p cur-device)) + ;; Whoah! + nil + (if font-spec + (set-face-font face font-spec cur-device))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Various color related things +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(cond + ((fboundp 'display-warning) + (fset 'font-warn 'display-warning)) + ((fboundp 'w3-warn) + (fset 'font-warn 'w3-warn)) + ((fboundp 'url-warn) + (fset 'font-warn 'url-warn)) + ((fboundp 'warn) + (defun font-warn (class message &optional level) + (warn "(%s/%s) %s" class (or level 'warning) message))) + (t + (defun font-warn (class message &optional level) + (save-excursion + (set-buffer (get-buffer-create "*W3-WARNINGS*")) + (goto-char (point-max)) + (save-excursion + (insert (format "(%s/%s) %s\n" class (or level 'warning) message))) + (display-buffer (current-buffer)))))) + +(defun font-lookup-rgb-components (color) + "Lookup COLOR (a color name) in rgb.txt and return a list of RGB values. +The list (R G B) is returned, or an error is signaled if the lookup fails." + (let ((lib-list (if (boundp 'x-library-search-path) + x-library-search-path + ;; This default is from XEmacs 19.13 - hope it covers + ;; everyone. + (list "/usr/X11R6/lib/X11/" + "/usr/X11R5/lib/X11/" + "/usr/lib/X11R6/X11/" + "/usr/lib/X11R5/X11/" + "/usr/local/X11R6/lib/X11/" + "/usr/local/X11R5/lib/X11/" + "/usr/local/lib/X11R6/X11/" + "/usr/local/lib/X11R5/X11/" + "/usr/X11/lib/X11/" + "/usr/lib/X11/" + "/usr/local/lib/X11/" + "/usr/X386/lib/X11/" + "/usr/x386/lib/X11/" + "/usr/XFree86/lib/X11/" + "/usr/unsupported/lib/X11/" + "/usr/athena/lib/X11/" + "/usr/local/x11r5/lib/X11/" + "/usr/lpp/Xamples/lib/X11/" + "/usr/openwin/lib/X11/" + "/usr/openwin/share/lib/X11/"))) + (file font-rgb-file) + r g b) + (if (not file) + (while lib-list + (setq file (expand-file-name "rgb.txt" (car lib-list))) + (if (file-readable-p file) + (setq lib-list nil + font-rgb-file file) + (setq lib-list (cdr lib-list) + file nil)))) + (if (null file) + (list 0 0 0) + (save-excursion + (set-buffer (find-file-noselect file)) + (if (not (= (aref (buffer-name) 0) ? )) + (rename-buffer (generate-new-buffer-name " *rgb-tmp-buffer*"))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (if (re-search-forward (format "\t%s$" (regexp-quote color)) nil t) + (progn + (beginning-of-line) + (setq r (* (read (current-buffer)) 256) + g (* (read (current-buffer)) 256) + b (* (read (current-buffer)) 256))) + (font-warn 'color (format "No such color: %s" color)) + (setq r 0 + g 0 + b 0)) + (list r g b) )))))) + +(defun font-hex-string-to-number (string) + "Convert STRING to an integer by parsing it as a hexadecimal number." + (let ((conv-list '((?0 . 0) (?a . 10) (?A . 10) + (?1 . 1) (?b . 11) (?B . 11) + (?2 . 2) (?c . 12) (?C . 12) + (?3 . 3) (?d . 13) (?D . 13) + (?4 . 4) (?e . 14) (?E . 14) + (?5 . 5) (?f . 15) (?F . 15) + (?6 . 6) + (?7 . 7) + (?8 . 8) + (?9 . 9))) + (n 0) + (i 0) + (lim (length string))) + (while (< i lim) + (setq n (+ (* n 16) (or (cdr (assq (aref string i) conv-list)) 0)) + i (1+ i))) + n )) + +(defun font-parse-rgb-components (color) + "Parse RGB color specification and return a list of integers (R G B). +#FEFEFE and rgb:fe/fe/fe style specifications are parsed." + (let ((case-fold-search t) + r g b str) + (cond ((string-match "^#[0-9a-f]+$" color) + (cond + ((= (length color) 4) + (setq r (font-hex-string-to-number (substring color 1 2)) + g (font-hex-string-to-number (substring color 2 3)) + b (font-hex-string-to-number (substring color 3 4)) + r (* r 4096) + g (* g 4096) + b (* b 4096))) + ((= (length color) 7) + (setq r (font-hex-string-to-number (substring color 1 3)) + g (font-hex-string-to-number (substring color 3 5)) + b (font-hex-string-to-number (substring color 5 7)) + r (* r 256) + g (* g 256) + b (* b 256))) + ((= (length color) 10) + (setq r (font-hex-string-to-number (substring color 1 4)) + g (font-hex-string-to-number (substring color 4 7)) + b (font-hex-string-to-number (substring color 7 10)) + r (* r 16) + g (* g 16) + b (* b 16))) + ((= (length color) 13) + (setq r (font-hex-string-to-number (substring color 1 5)) + g (font-hex-string-to-number (substring color 5 9)) + b (font-hex-string-to-number (substring color 9 13)))) + (t + (font-warn 'color (format "Invalid RGB color specification: %s" + color)) + (setq r 0 + g 0 + b 0)))) + ((string-match "rgb:\\([0-9a-f]+\\)/\\([0-9a-f]+\\)/\\([0-9a-f]+\\)" + color) + (if (or (> (- (match-end 1) (match-beginning 1)) 4) + (> (- (match-end 2) (match-beginning 2)) 4) + (> (- (match-end 3) (match-beginning 3)) 4)) + (error "Invalid RGB color specification: %s" color) + (setq str (match-string 1 color) + r (* (font-hex-string-to-number str) + (expt 16 (- 4 (length str)))) + str (match-string 2 color) + g (* (font-hex-string-to-number str) + (expt 16 (- 4 (length str)))) + str (match-string 3 color) + b (* (font-hex-string-to-number str) + (expt 16 (- 4 (length str))))))) + (t + (font-warn 'html (format "Invalid RGB color specification: %s" + color)) + (setq r 0 + g 0 + b 0))) + (list r g b) )) + +(defsubst font-rgb-color-p (obj) + (or (and (vectorp obj) + (= (length obj) 4) + (eq (aref obj 0) 'rgb)))) + +(defsubst font-rgb-color-red (obj) (aref obj 1)) +(defsubst font-rgb-color-green (obj) (aref obj 2)) +(defsubst font-rgb-color-blue (obj) (aref obj 3)) + +(defun font-color-rgb-components (color) + "Return the RGB components of COLOR as a list of integers (R G B). +16-bit values are always returned. +#FEFEFE and rgb:fe/fe/fe style color specifications are parsed directly +into their components. +RGB values for color names are looked up in the rgb.txt file. +The variable x-library-search-path is use to locate the rgb.txt file." + (let ((case-fold-search t)) + (cond + ((and (font-rgb-color-p color) (floatp (aref color 1))) + (list (* 65535 (aref color 0)) + (* 65535 (aref color 1)) + (* 65535 (aref color 2)))) + ((font-rgb-color-p color) + (list (font-rgb-color-red color) + (font-rgb-color-green color) + (font-rgb-color-blue color))) + ((and (vectorp color) (= 3 (length color))) + (list (aref color 0) (aref color 1) (aref color 2))) + ((and (listp color) (= 3 (length color)) (floatp (car color))) + (mapcar (function (lambda (x) (* x 65535))) color)) + ((and (listp color) (= 3 (length color))) + color) + ((or (string-match "^#" color) + (string-match "^rgb:" color)) + (font-parse-rgb-components color)) + ((string-match "\\([0-9.]+\\)[ \t]\\([0-9.]+\\)[ \t]\\([0-9.]+\\)" + color) + (let ((r (string-to-number (match-string 1 color))) + (g (string-to-number (match-string 2 color))) + (b (string-to-number (match-string 3 color)))) + (if (floatp r) + (setq r (round (* 255 r)) + g (round (* 255 g)) + b (round (* 255 b)))) + (font-parse-rgb-components (format "#%02x%02x%02x" r g b)))) + (t + (font-lookup-rgb-components color))))) + +(defsubst font-tty-compute-color-delta (col1 col2) + (+ + (* (- (aref col1 0) (aref col2 0)) + (- (aref col1 0) (aref col2 0))) + (* (- (aref col1 1) (aref col2 1)) + (- (aref col1 1) (aref col2 1))) + (* (- (aref col1 2) (aref col2 2)) + (- (aref col1 2) (aref col2 2))))) + +(defun font-tty-find-closest-color (r g b) + ;; This is basically just a lisp copy of allocate_nearest_color + ;; from objects-x.c from Emacs 19 + ;; We really should just check tty-color-list, but unfortunately + ;; that does not include any RGB information at all. + ;; So for now we just hardwire in the default list and call it + ;; good for now. + (setq r (/ r 65535.0) + g (/ g 65535.0) + b (/ b 65535.0)) + (let* ((color_def (vector r g b)) + (colors [([1.0 1.0 1.0] . "white") + ([0.0 1.0 1.0] . "cyan") + ([1.0 0.0 1.0] . "magenta") + ([0.0 0.0 1.0] . "blue") + ([1.0 1.0 0.0] . "yellow") + ([0.0 1.0 0.0] . "green") + ([1.0 0.0 0.0] . "red") + ([0.0 0.0 0.0] . "black")]) + (no_cells (length colors)) + (x 1) + (nearest 0) + (nearest_delta 0) + (trial_delta 0)) + (setq nearest_delta (font-tty-compute-color-delta (car (aref colors 0)) + color_def)) + (while (/= no_cells x) + (setq trial_delta (font-tty-compute-color-delta (car (aref colors x)) + color_def)) + (if (< trial_delta nearest_delta) + (setq nearest x + nearest_delta trial_delta)) + (setq x (1+ x))) + (cdr-safe (aref colors nearest)))) + +(defun font-normalize-color (color &optional device) + "Return an RGB tuple, given any form of input. If an error occurs, black +is returned." + (case (device-type device) + ((x pm) + (apply 'format "#%02x%02x%02x" (font-color-rgb-components color))) + (win32 + (let* ((rgb (font-color-rgb-components color)) + (color (apply 'format "#%02x%02x%02x" rgb))) + (win32-define-rgb-color (nth 0 rgb) (nth 1 rgb) (nth 2 rgb) color) + color)) + (w32 + (let* ((rgb (font-color-rgb-components color)) + (color (apply 'format "#%02x%02x%02x" rgb))) + (w32-define-rgb-color (nth 0 rgb) (nth 1 rgb) (nth 2 rgb) color) + color)) + (tty + (apply 'font-tty-find-closest-color (font-color-rgb-components color))) + (ns + (let ((vals (mapcar (function (lambda (x) (>> x 8))) + (font-color-rgb-components color)))) + (apply 'format "RGB%02x%02x%02xff" vals))) + (otherwise + color))) + +(defun font-set-face-background (&optional face color &rest args) + (interactive) + (condition-case nil + (cond + ((or (font-rgb-color-p color) + (string-match "^#[0-9a-fA-F]+$" color)) + (apply 'set-face-background face + (font-normalize-color color) args)) + (t + (apply 'set-face-background face color args))) + (error nil))) + +(defun font-set-face-foreground (&optional face color &rest args) + (interactive) + (condition-case nil + (cond + ((or (font-rgb-color-p color) + (string-match "^#[0-9a-fA-F]+$" color)) + (apply 'set-face-foreground face (font-normalize-color color) args)) + (t + (apply 'set-face-foreground face color args))) + (error nil))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Support for 'blinking' fonts +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun font-map-windows (func &optional arg frame) + (let* ((start (selected-window)) + (cur start) + (result nil)) + (push (funcall func start arg) result) + (while (not (eq start (setq cur (next-window cur)))) + (push (funcall func cur arg) result)) + result)) + +(defun font-face-visible-in-window-p (window face) + (let ((st (window-start window)) + (nd (window-end window)) + (found nil) + (face-at nil)) + (setq face-at (get-text-property st 'face (window-buffer window))) + (if (or (eq face face-at) (and (listp face-at) (memq face face-at))) + (setq found t)) + (while (and (not found) + (/= nd + (setq st (next-single-property-change + st 'face + (window-buffer window) nd)))) + (setq face-at (get-text-property st 'face (window-buffer window))) + (if (or (eq face face-at) (and (listp face-at) (memq face face-at))) + (setq found t))) + found)) + +(defun font-blink-callback () + ;; Optimized to never invert the face unless one of the visible windows + ;; is showing it. + (let ((faces (if font-running-xemacs (face-list t) (face-list))) + (obj nil)) + (while faces + (if (and (setq obj (face-property (car faces) 'font-specification)) + (font-blink-p obj) + (memq t + (font-map-windows 'font-face-visible-in-window-p (car faces)))) + (invert-face (car faces))) + (pop faces)))) + +(defcustom font-blink-interval 0.5 + "How often to blink faces" + :type 'number + :group 'faces) + +(defun font-blink-initialize () + (cond + ((featurep 'itimer) + (if (get-itimer "font-blinker") + (delete-itimer (get-itimer "font-blinker"))) + (start-itimer "font-blinker" 'font-blink-callback + font-blink-interval + font-blink-interval)) + ((fboundp 'run-at-time) + (cancel-function-timers 'font-blink-callback) + (run-at-time font-blink-interval + font-blink-interval + 'font-blink-callback)) + (t nil))) + +(provide 'font) diff -r f0deb0c0e6be -r eb5470882647 lisp/viper/custom-load.el --- a/lisp/viper/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/viper/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:05:59 1997 +;; Created by SL Baur on Sat Oct 4 18:11:54 1997 ;;; Code: diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/ChangeLog --- a/lisp/w3/ChangeLog Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3406 +0,0 @@ -1997-09-05 William M. Perry - -* Makefile.in: Now includes the 'contrib' directory in distributions. - -* aclocal.m4: Fixed custom detection - would sometimes set CUSTOM to the - directory, sometimes to the filename... ick. - -* Makefile.in (dotemacs): Tweaked the install of autoloads into .emacs file - -* lisp/font.el (font-normalize-color): Ditto - -* lisp/url.el (url-setup-privacy-info): Ditto - -* lisp/devices.el: Everything now recognizes 'w32' as an alias for the - 'win32' device type. This is for Emacs 20.x compatibility, which will - have this change. - -1997-09-04 William M. Perry - -* Updated to Widget/Custom 1.9956 - -1997-08-25 William M. Perry - -* lisp/w3.el (w3-document-information): Fixed bug with empty 'meta' links. - -1997-08-20 William M. Perry - -* lisp/w3-menu.el ((fboundp 'id-menubar-set)): Avoid fset'ing - id-menubar-set - it was confusing oobr - -1997-08-19 William M. Perry - -* New file w3-imenu.el from T.V. Raman - -1997-07-26 SL Baur - - * mm.el (mm-extension-to-mime): Use `eq' for character comparison. - -Wed Mar 19 20:53:23 1997 Steven L Baur - -* Makefile (xemacs-w3): Special target for XEmacs Build. - -Thu Jul 10 16:40:34 1997 William M. Perry - -* Synch'd up to custom 1.9949 - added the widget and custom manuals to the - distribution. - -* lisp/Makefile.in: Fixed all makefile rebuilding rules. - -* lisp/w3.el (w3-do-setup): Removed w3-widget-global-map stuff, since the - new custom and widget library will not need it at all. - -Tue Jul 8 06:46:08 1997 William M. Perry - -* lisp/w3-e19.el (w3-mode-version-specifics): Turn back on - buffer-access-fontify-functions. This means that any text you yank out - of a Emacs/W3 buffer is guaranteed to be non-read-only. Unfortunately, - this then makes the text in the buffer non-read-only as well. Need to - find a way to do something similar for XEmacs. - -* lisp/w3-display.el (w3-draw-tree): Make sure everything ends up - read-only. - -* lisp/w3.el (w3-mode): New variale w3-widget-global-map that inherits - from widget-global-map, but overrides return and mouse-button2 to - noops. Removed some modeline cruft. - -* lisp/w3-vars.el: Removed old cruft that wasn't executed anymore - (widget nav. keybindings, etc.) - -* lisp/w3-e19.el (w3-store-in-clipboard): Try to use - interprogram-cut-function, as it seems the best way to do this under - Emacs 19. - -Mon Jul 7 15:50:17 1997 William M. Perry - -* lisp/w3.el (w3-reload-all-files): Brute force approach to making - sure all of our source files get reloaded. Walk through the obarray and - make anything called w3-* url-* ssl-* base64-* dsssl-* or mm-* 'unbound' - and 'funbound'. I am a little leery of this, as it could tromp on - users' personal variables that start with this, but nobody really uses - this very often anyway. Will post prominent warnings in the docs. - -Sun Jul 6 15:24:06 1997 William M. Perry - -* lisp/w3-e19.el (w3-window-size-change-function): New function fit for - use on window-size-change-functions to automatically redraw any visible - Emacs/W3 buffers when a frame or window is resized. - -* lisp/w3-cus.el (w3-modeline-format): Added 'BAD HTML' indicator to the - modeline instead of showing warnings - was a bit too disruptive in - casual browsing. - -* lisp/w3-menu.el (w3-menu-view-menu): Use it. - -* lisp/w3.el (w3-display-errors): New function to display the parsing - errors from an HTML page. - -* lisp/w3-parse.el: New way of storing warning messages during the parsing - phase so they don't jump out at the user immediately. Much less - obtrusive. - -Sat Jul 5 15:52:06 1997 William M. Perry - -* lisp/w3-display.el: Now keeps a stack of list-style types, so setting - the list-style on something like 'ol' or 'ul' will do the right thing. - -* lisp/url-news.el (url-news-use-article-mode): New variable for whether - to use Gnus' article-mode to display news articles. - -* lisp/w3.el (w3-internal-handle-preview): This will now work even if the - buffer being previewed isn't associated with a file. - -Thu Jul 3 15:51:56 1997 William M. Perry - -* lisp/w3-display.el: Better version of char-before for Emacs 19 - -Wed Jul 2 10:39:30 1997 William M. Perry - -* Emacs/W3 3.0.93 released - -Tue Jul 1 08:54:40 1997 William M. Perry - -* lisp/w3-display.el (w3-handle-string-content): EBOLA vaccination - -Sun Jun 29 22:26:43 1997 William M. Perry - -* lisp/w3-emulate.el: Make sure we call widget-button-press not w3-follow-link - -* configure.in: New --enable-site-install option to control whether init - code goes in user's .emacs file or default.el - -* Makefile.in (dotemacs): New target for modifying the user's .emacs file - or the sitewide default init. - (html): New target for building html versions of the manuals. - -Fri Jun 27 21:08:24 1997 William M. Perry - -* texi/Makefile.in (%.html): Added targets for making HTML versions of the - info files. - -1997-06-27 William M. Perry - -* lisp/w3.el: In non-XEmacs, the version-specific stuff is loaded from - (format "w3-e%d" emacs-major-version), in case we need to do anything - special for Emacs 20.x with Mule support. - -* Only use one conditionalization variable - w3-running-xemacs - -1997-06-26 William M. Perry - -* Makefile.in: Make sure we recursively make usin $(MAKE), not - vanilla 'make'. - -* lisp/w3.el (w3-insert-formatted-url): Works again, forgot to update it - to use the new widget properties. - (w3-maybe-follow-link): Ditto. - (w3-view-this-url): Ditto. - (w3-follow-link): Ditto. - (w3-complete-link): Ditto. - -Wed Jun 25 07:29:46 1997 William M. Perry - -* lisp/w3.el (w3-find-default-stylesheets): Added more directories to the - stylesheet search path. - -* Emacs/W3 3.0.92 released - -* Moved lisp stuff into its own subdirectory, integrated into configure, - make, and install procedures. - -* 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 - -* Emacs/W3 3.0.91 Released - -* 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 - -* w3.el (w3-mode): Avoid calling the global bindings for RET and mouse-2. - -1997-06-24 William M. Perry - -* 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 - -* 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 - -* 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 - -* 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 - -* 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 - -* 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 - -* custom-check: Was misusing 'tr' - -Sun Jun 15 22:17:01 1997 William M. Perry - -* Synch'd up to custom 1.9920 - -Sat Jun 14 15:37:09 1997 William M. Perry - -* 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 - -* 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 - -* w3-parse.el : Allow 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 - -* 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 - -* w3-display.el (w3-display-node): Protect against stylesheet specified - widths on horizontal rules. - -Mon Jun 9 22:42:26 1997 Istvan Marko - -* w3-hot.el (w3-hotlist-apropos): Let this work when reuse-buffers != no - -Mon Jun 9 22:35:04 1997 Dieter Maurer - -* 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 - -* 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 - -* 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 - -* 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 - -* 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 - -* 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 - -* 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 - -* w3.el (w3-document-information): some formatting changes - -Thu May 8 14:06:40 1997 William M. Perry - -* 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 - -* w3-sysdp.el (event-point): New stub. - -* url-cookie.el (url-cookie-handle-set-cookie): Don't use the 'warn' - facility for bad cookie 'set' commands, was too annoying. - -* w3.el (w3-save-as): Make sure to require ps-print before trying to - save/mail a document as postscript. The local binding of - ps-spool-buffer-name was causing the defvar not to happen, and you would - get errors when trying to kill emacs later. Ugh. - (w3-document-information): Make sure to escape entities for meta and - other info we throw in. - -* url-file.el (url-file): ftp/file retrieval can now be asynchronous - through the magic of [ange-ftp|efs]-copy-file-internal - -* url.el (url-sentinel): Allow a buffer as the first argument to - the sentinel function. - (url-retrieve-internally): Allow asynch ftp transfers - -* url-file.el (url-file): Asynchronous ftp downloads work now. - -* w3.el (w3-download-url): Made this function interactive. - -Mon Apr 28 13:31:36 1997 William M. Perry - -* w3.el (w3-download-url-at-point): new function to download document - under point. - (w3-download-this-url): new function to download current document. - -* w3-vars.el (w3-mode-map): Added 'D' and 'd' bindings for starting - document downloads. - -Thu Apr 24 08:29:34 1997 William M. Perry - -* Emacs/W3 3.0.85 released - -* w3-display.el (w3-display-table-dimensions): Deal with - colgroup/thead/tfoot/col better. Before was ignoring the rest of the - table. ack. - (w3-display-table): ditto - -* w3-prefs.el (w3-preferences-restore-variables): Slap things into - custom-land where they belong. - -* A few customization tweaks. - -Wed Apr 23 21:44:59 1997 - -* w3-e19.el (w3-store-in-clipboard): Make this work under OS/2 - -Tue Apr 22 07:23:51 1997 William M. Perry - -* devices.el: Removed defsubsts so that we should be able to share .elc - files again between emacs and XEmacs. - -* font.el: Added in code to make a face blink. Causes lots of screen - flicker under Emacs 19 though, so it is turned off by default. Turn it - on with ESC-: (font-blink-initialize) - should be able to optimize when - the callback actually does anything based on what fonts are visible in - the visible buffers. - (font-face-visible-in-window-p): New function to tell if a face is - visible in a buffer window. - (font-map-windows): New function to map a function over all visible - windows. - (font-blink-callback): Use them to optimize so that invert-face is not - called unless absolutely necessary. - -Mon Apr 21 08:58:02 1997 William M. Perry - -* w3-e19.el: Added in compile-time require of w3-props so that pages with - backgrounds don't puke and die. - -* w3.el (w3-find-default-stylesheets): Don't load a user's personal - stylesheet if we started up in '-q' mode. - -* Emacs/W3 3.0.84 released - -* w3-display.el: When using XEmacs 20.x w/mule support, we now define our - own special character set. This means that the table border chars work - again in XEmacs/mule - -* devices.el: Added magic to not optimize this file under XEmacs - its not - actually used, so no damage. It wouldn't compile under XEmacs because - it has subrs for all these, and our declaring them as defsubsts - thoroughly confuses the byte-compiler. - -Sun Apr 20 12:19:56 1997 William M. Perry - -* w3-sysdp.el: Moved device stuf out into its own devices.el file so that - it can be correctly byte-compiled. - Ditto for the text properties stuff (into w3-props.el) - -Fri Apr 18 13:09:31 1997 William M. Perry - -* Emacs/W3 3.0.83 released - -* Synch'd up to Widget 1.89 - -Thu Apr 17 06:20:56 1997 "T. V. Raman" - -* default.css (pre/xmp/plaintext/key/code/tt): Changes to default - stylesheet for spoken output of normally `monospaced' text. - -Tue Apr 15 16:28:11 1997 William M. Perry - -* w3.el (w3-find-specific-link): Don't signal an error in a target anchor - (#foo) is not found. - -Tue Apr 15 08:22:37 1997 John Palmieri - -* w3.el (w3-complete-link): protect against errors when hitting return - when point isn't on a link - -Mon Apr 14 16:18:43 1997 William M. Perry - -* mm.el (mm-parse-mailcaps): Moved ~/.mailcap to the front of the list so - that it gets parsed last, and has the highest priority. - -Sun Apr 13 20:28:30 1997 William M. Perry - -* w3.el (w3-complete-link): now correctly defaults to following the link - at point. - -Sat Apr 12 19:35:26 1997 William M. Perry - -* w3-speak.el: use widget-at instead of emacspeak-widget-at - -Fri Apr 11 07:39:26 1997 William M. Perry - -* w3-menu.el (w3-menu-edit-menu): Addded a preferences submenu with all - the W3 & URL customization items underneat it. - -* css.el (css-split-font-shorthand): Handle bad lists better - -* Emacs/W3 3.0.82 released - -* Synch'd up with Widget 1.78 - -* w3-display.el (w3-get-face-info): Don't look for face attributes on tags - unless w3-user-colors-take-precedence is nil - (w3-display-node): Don't honor face attributes on tag unless - w3-user-colors-take-precedence is nil - -* url-vars.el: Modified a few customizations to make them prettier - -* url-cache.el (url-cache-creation-function): Modified customization - -Fri Apr 11 07:03:20 1997 Hrvoje Niksic - -* url-cache.el, url-gw.el, url-cookie.el, url-irc.el, url-vars.el, url.el: - All URL related variables are now customizable. - -Wed Apr 9 16:46:52 1997 William M. Perry - -* Emacs/W3 3.0.81 released - -* w3-xemac.el (w3-text-pixel-width): And a XEmacs specific version of it. - -* w3-e19.el (w3-text-pixel-width): New function to return the pixel width - of a piece of text. - -* url.el (url-handle-no-scheme): Use it. - -* url-vars.el (url-handle-no-scheme-hook): New hook that should expand a - partial url like 'gnu' to a full URL, like 'http://www.gnu.org/'. - -* w3-sysdp.el (run-hook-with-args-until-success): Added a stub for - run-hook-with-args-until-success - -Tue Apr 8 12:20:39 1997 William M. Perry - -* w3-auto.el: Added autoloads for all the functions in url-ns for proxy - functions, and url-mail - -* url-ns.el (isPlainHostName): Fixed isPlainHostName - -* w3-parse.el (w3-parse-buffer): now throws up a bad style warning for - images without ALT attributes. - -* mm.el (mm-parse-mailcaps): Reverse the ':|;' separated path for MAILCAPS - so that earlier items take precedence, like standard unix PATH-like - variables do. - (mm-parse-mimetypes): Ditto for MIMETYPES - -Mon Apr 7 06:23:11 1997 William M. Perry - -* Emacs/W3 3.0.80 released - -* w3-parse.el: Some more transitions - don't imply

after some form - tags. - -* url-misc.el (url-finger): Ditto - -* url-http.el (url-http): Ditto - -* url-gopher.el (url-gopher-retrieve): Put in a process-sentinel of - 'ignore so that stupid 'process xxx exited with code nnn' messages are - not shown. - -* url.el (url-sentinel): Ditto - -* w3.el (w3-sentinel): remove call to url-clean-text - no longer needed - -Mon Apr 7 02:57:19 1997 Greg Stark - -* url.el (url-sentinel): once and for all eliminate the "first character - goes to wrong buffer" bug through brute force by setting the current - buffer to the buffer of the selected window at the end of a sentinel. - -* w3.el (w3-viewer-sentinel): ditto - -* w3-widget.el (widget-image-value-create): set tab-order to -1 on the - choice-items of client-side imagemaps to avoid having tab stop on them - three times, (it still stops on them twice) - -* Makefile: add "make fast" rule to not run a bazillion emacsen - -* FAQ: typos - -* docomp.el: try setting byte-compile-dynamic to t to reduce memory usage - -Fri Apr 4 06:23:31 1997 William M. Perry - -* url-file.el (url-format-directory): Use insert-file-contents instead of - -literally, so that ftp index files will work. - -* w3-emulate.el: lots of new commands to spoof the user-agent string. See - turn-[on|off]-[lynx|netscape|ie|arena]-masquerade-mode functions. - -Thu Apr 3 07:22:27 1997 William M. Perry - -* Emacs/W3 3.0.79 released - -* w3-parse.el: Put in

as part of the content-model of

    so that -

    at the front of a list doesn't cause a bogus list item to be shown. - -* url-http.el (url-parse-mime-headers): Make proxy authentication sort of - work again. - -* w3-display.el (w3-setup-terminal-chars): Check to see whether face is - actually different before trying to set its font to a terminal one. - -* url.el (url-buffer-visiting): Better matching of URLs - it was taking - the target into account - bad bad bad. - -Wed Apr 2 18:05:11 1997 William M. Perry - -* w3-forms.el (w3-form-add-element): New way to do hidden form - fields that retains the order information - damned idiots out there rely - on ordering. !#%!@ - -* w3.el (w3-fetch): Put some of the logic about _blank/_top frame targets - into w3-fetch - -* w3-display.el (w3-get-all-face-info): Added in support for the 'face' - attribute to specify font-family - -Wed Apr 2 13:08:36 1997 Frederic Lepied - -* w3-print.el (w3-print-this-url): Need to run LaTeX to get the indices - right. - -Tue Apr 1 11:20:54 1997 William M. Perry - -* Emacs/W3 3.0.78 released - -* css.el (css-color-light-p): New function - (css-active-device-types): Use it to add a 'dark' or 'light' property to - the active device types as necessary - -Mon Mar 31 09:07:13 1997 William M. Perry - -* w3-parse.el: More error transitions for tables (push tr before td/th - just after a table) - -* w3-display.el (w3-display-node): Use it for body/html attribute handling - (w3-fix-color): New function to make sure we don't pass hex values without - "#" in front of them. - -Sun Mar 30 15:00:59 1997 William M. Perry - -* w3-display.el (w3-display-node): Now honors alink/vlink/link attributes - on the body tag. - (w3-fixup-eol-faces): Fixed nuking of faces at end of line to deal with - bad underlining behaviour of Emacs 19. - -Sun Mar 30 14:28:32 1997 Greg Stark - -* w3-e19.el (w3-mode-version-specifics): Fixed buffer read-only errors - when trying to set a background face. - -Fri Mar 28 10:41:43 1997 William M. Perry - -* Emacs/W3 3.0.77 released - -* w3-display.el (w3-display-table): Face properties specified on the - 'table' element now propogate to table cells correctly. - -Fri Mar 28 07:53:48 1997 Greg Stark - -* w3-forms.el: Make sure we set the button-face on all widgets - -Fri Mar 28 07:53:48 1997 William M. Perry - -* w3-display.el (w3-frames): Use make-frame, not make-frame-command, so it - will work on XEmacs. - -* w3-e19.el (w3-mode-version-specifics): Now honors background/foreground - color requests in Emacs19 by coloring in the whole buffer. Oh how I - wish Emacs 19 had buffer-local faces. - -* w3-display.el (w3-display-table): Tables now look better under Emacs 19 - -Thu Mar 27 08:05:34 1997 William M. Perry - -* font.el (font-x-registry-and-encoding-regexp): got rid of compile - warning under Emacs 19 - -* w3-display.el (w3-display-handle-list-type): manually remove faces on - bullet/list items - (w3-display-node): We were being a bit rude to inhibit-read-only - - sometimes would leave it 't', which is bad bad bad, some might even say - pure evil. - -* Emacs-W3 3.0.76 released - -* Synch'd up to Widget 1.68 - -* w3-display.el (w3-display-node): Handles 'text' attribute correctly now - to set the default foreground when requested. - -* mm.el (mm-play-sound-file): Fixed it for new mule stuff - -* url-gw.el (url-gateway-nslookup-host): Added autoload for - gateway-nslookup-host - -* w3-display.el (w3-display-table): Expand each line of a table cell out - to the border, so that we get nicely colors backgrounds for table cells - now. - -* font.el (font-x-registry-and-encoding-regexp): New variable to match the - registry and encoding of a font name under X - (x-font-create-object): Use it to set the default registry and encoding - for font objects we create from font names. - (x-font-create-name): Grab the registry and encoding from the default - object for this device before defaulting back to '*' - -* w3-display.el (w3-setup-terminal-chars): Explicitly specify wildcard - registry and encoding for the table-hack-x-face, to deal with changes in - the font library. - -Wed Mar 26 06:23:51 1997 William M. Perry - -* custom-check: Should work better now, and spit out better instructions - for rebuilding correctly. - -* Emacs-W3 3.0.75 released - -* url.el (url-clean-text): Better matching of bogus process exited - messages. - -* font.el (font-rgb-color-p): No longer match "^#xxyyzz" as an rgb-color, - this screwed up bigtime in font-color-rgb-components. - (font-set-face-foreground): Do the test here instead. - (font-set-face-background): and here. - -* w3-widget.el (widget-image-value-create): For client side imagemaps, - make sure case-fold-search or :ignore-case is specified. - -* url-gw.el (url-gateway-nslookup-program): Default to using 'nslookup' as - url-gateway-nslookup-program - -Tue Mar 25 16:06:28 1997 William M. Perry - -* Emacs-W3 3.0.74 released - -Tue Mar 25 15:31:56 1997 Greg Stark - -* url-cookie.el (url-cookie-handle-set-cookie): don't deal with #!%@ed - microsoft web site cookies - they break good, clean, wholesome sites - like yahoo's stock pages. - -* ssl.el (ssl-program-arguments): Make sure everything gets turned into a - string, not an integer. - (open-ssl-stream): use a pipe instead of a pty if possible (why?) - -* w3-display.el (w3-display-node): Added back in support - -* w3.el (w3-notify-when-ready): protect against bad buffer switching - (minibuffer as active window lossage, etc) - -* w3-toolbar.el (w3-toolbar-make-buttons): Don't warn about toolbar - directory on Emacsen that can't do toolbars! - -Tue Mar 25 15:31:56 1997 William M. Perry - -* Emacs-W3 3.0.73 released - -* w3-display.el (w3-get-face-info): Allow passing in a second argument - that means 'check this attribute of the html tag if you don't find - something in the stylesheet'. This automatically enables - and . - -Tue Mar 25 06:45:02 1997 T. V. Raman - -* w3-forms.el (w3-form-keymap): patch to avoid lossage with emacspeak & - using terminal.el - -Tue Mar 25 06:45:02 1997 William M. Perry - -* ssl.el (ssl-program-arguments): Removed -quiet switch, since it requires - patches to s_client - -Mon Mar 24 10:56:11 1997 William M. Perry - -* Emacs-W3 3.0.72 released - -* w3-display.el (w3-display-node): Better handling of body and html style - attributes in XEmacs - -* w3.el (w3-mode): Removed call to kill-all-local-variables, as it - nukes buffer-local faces as well. - -* css.el (css-expand-length): Don't choke and use the wrong damn thing to - base percentages off of on percentage heights (ie: font-size: 80%) - -Mon Mar 24 07:12:52 1997 Gerry S Hayes - -* url-gw.el (url-open-telnet): Fixed stupid typo into-to-string -> - int-to-string - (url-open-rlogin): Ditto. - -Sun Mar 23 09:43:24 1997 William M. Perry - -* w3-display.el (w3-table-ascii-border-chars): Use a '+' in the ascii art - version of table borders. - -Sat Mar 22 00:45:34 1997 William M. Perry - -* w3-menu.el (w3-use-menus): Customized this variable - -* w3-display.el (w3-display-node): Don't run multiline text area's default - value through w3-normalize-spaces - -Thu Mar 20 23:44:50 1997 Greg Stark - -* w3-cus.el (w3-use-terminal-characters): New variable - (w3-use-terminal-characters-on-tty): New variable - (w3-use-terminal-glyphs): New variable - (w3-horizontal-rule-char): Make setting it to nil allow use of graphic - characters (also means people can avoid using graphic charactes for - horizontal rules if they wish) -* w3-display.el (w3-handle-image): clean up whitespace in alt tags - (w3-table-glyph-border-chars): New variable - (w3-table-graphic-border-chars): New variable - (w3-terminal-properties): New variable - (w3-insert-terminal-char): New inline function - (w3-horizontal-rule-char): New inline function - (w3-setup-terminal-chars): Set up all of these and make using graphic - characters work on XEmacs using text properties (and optionally use text - properties on FSF Emacs too). - (w3-table-hack-borders): Remove, obsoleted by w3-setup-terminal-chars - (w3-table-unhack-borders): don't have to fiddle with - w3-horizontal-rule-char any more. - (w3-display-table): Use w3-insert-terminal-char - (w3-size-of-tree): Use w3-horizontal-rule-char - (w3-display-node): Use w3-horizontal-rule-char, w3-insert-terminal-char, - uhm, i'm not sure if it was correct to remove the handle-content -* w3-forms.el (w3-fixup-eol-faces): try to remove mouse-face from end-of-lines as - well, uhm, this doesn't seem to work though. - (w3-form-determine-size): add keygen - (w3-form-encode-helper): add keygen support for the day when the ssl code - itself is released. -* w3-widget.el (widget-image-value-create): use 'item widgets instead of - 'push-button widgets and specify the format ourselves so we don't get - widget.el's arbitrary formatting. -* w3.el (w3-do-setup): call w3-setup-terminal-chars to make nice tables and - horizontal rules the default at least under X. -* mm.el added x-x509-ca-cert and x-x509-user-cert viewers but the tests - will fail so no one should should see this change until i release the - functions. - -Fri Mar 21 18:52:31 1997 William M. Perry - -* css.el (css-expand-length): Better support for percentage values in - lengths - -Thu Mar 20 06:22:29 1997 Istvan Marko - -* Added slot for no_proxy settings under the preferences panel - -Thu Mar 20 06:22:29 1997 William M. Perry - -* Emacs-W3 3.0.71 released - -* w3-parse.el:Added more transitions for error handling of raw 'td' or - 'th' outside of a 'tr' in tablebody. - -* url.el (url-default-callback): asynch downloads should now be cached - -* w3-script.el (w3-do-scripting): Customized, turned off by default - -Wed Mar 19 20:53:23 1997 Steven L Baur - -* Makefile (xemacs-w3): Special target for XEmacs Build. - -Wed Mar 19 05:56:56 1997 William M. Perry - -* font.el (x-font-families-for-device): Just in case - font-default-family-for-device fails under Emacs/NT, return "monospace" - at the front of the list. - -* url-vars.el (url-privacy-level): Now defaults to not sending your email - address in HTTP requests. - -Tue Mar 18 13:09:13 1997 William M. Perry - -* url-cookie.el (url-cookie-handle-set-cookie): Fixed variable typos - - doh. Today just hasn't been my day. - -* Emacs-W3 3.0.70 released - -* We now pass all tests on the forms tester page - http://www.research.digital.com/nsl/formtest/home.html - -* w3-display.el (w3-display-node): Better handling of in general. - -* w3-forms.el (w3-form-encode-xwfu): Encode : and / in xwfu, since the - form tester expects it. - -* url-cookie.el (url-cookie-trusted-urls): New variable - list of regexps - of URLs that you will accept cookies from without question. - (url-cookie-untrusted-urls): New variable - list of regexps of URLs that - you will _never_ accept cookies from. - (url-cookie-handle-set-cookie): Use them - (url-cookie-handle-set-cookie): When asking whether to allow a site to - set a cookie, show the cookies they are wanting to set. - -Tue Mar 18 06:47:46 1997 Thierry Emery - -* w3-display.el: Latest round of patches for support. - -* w3-cus.el (w3-display-frames): can now have 4 values. - nil no frame display whatsoever (currently the default) - 'as-links display frame hyperlinks, but do not fetch them - 'ask display frame hyperlinks and ask whether to fetch them - t display frame hyperlinks and fetch them - -Tue Mar 18 06:47:46 1997 William M. Perry - -* w3-parse.el (w3-parse-buffer): Duh, don't do `=' comparison on results - of char-after, since it is nil at the end of the buffer. - -Mon Mar 17 08:44:46 1997 William M. Perry - -* Emacs-W3 3.0.69 released - -* w3-sysdp.el (buffer-substring-no-properties): Added stub - -* url-gopher.el (url-gopher-retrieve): Ditto. - -* url.el: Ditto - -* w3-parse.el: Removed all sorts of fun (following-char) commands that can - cause ebola warnings under XEmacs 20.x - -* w3.el (w3-popup-info): Default to the URL under point instead of the - documents URL - -* w3-auto.el: updated autoloads - made sure everything was interactive if - appropriate. - -* w3-menu.el (w3-popup-menu): If w3-popup-menu-on-mouse-3 is nil, call - whatever button3 is bound to in global-map - -* w3-display.el: Added XEmacs version of frame-char-height and - frame-char-width - (w3-frames): If w3-display-frames is non-nil, then do a refresh with it - bound locally, so everything should just work. - -* url.el (url-do-setup): Global history file now defaults to ~/.w3/history - (url-do-setup): Cookie storage now defaults to ~/.w3/cookies - -Mon Mar 17 06:51:07 1997 Paul Stodghill - -* mm.el (mm-temporary-directory): Initialize variable from TMPDIR - environment variable - -Fri Mar 14 13:35:56 1997 William M. Perry - -* w3-forms.el (w3-form-create-custom): Fixed the 'custom' input type for - new filenames in the widget/custom package. - -* ssl.el (ssl-certificate-verification-depth): New variable to control how - far up a cert chain to look. - (ssl-view-certificate-program-name): New variable. - (ssl-view-certificate-program-arguments): New variable. - (ssl-certificate-directory-style): New variable. - (ssl-rehash-program-name): New variable. - (ssl-certificate-directory): New variable. - (ssl-program-arguments): Use some of them. - (ssl-accept-ca-certificate): Use the rest. - -* css.el (css-parse-args): Removed old code that could cause infinite loop - in stylesheet parsing on bad things like "foo=bar" instead of "foo:bar" - -* w3-cus.el: Added better groupings for the customization stuff. - -Thu Mar 13 19:54:50 1997 William M. Perry - -* Emacs-W3 3.0.68 released - -* w3-cus.el: Added customization support for Emacs-W3 - -* w3.el (w3-mail-current-document): Use url-mail-command instead of - w3-mail-command - -Thu Mar 13 11:41:42 1997 Greg Stark - -* w3-prefs.el: Implemented privacy panel - -Wed Mar 12 10:25:38 1997 William M. Perry - -* w3-e19.el (w3-mode-version-specifics): Use the nasty crufty - buffer-access-fontify-functions to make sure that we never yank - read-only text out of the Emacs-W3 buffer. - -* Synch'd up to Widget 1.62 - -Wed Mar 12 06:36:41 1997 Paul Stodghill - -* base64.el (base64-decode-region): Fixed typo in calling - command-on-region. - -Tue Mar 11 07:03:48 1997 William M. Perry - -* w3-auto.el (w3-use-hotlist): Made autoload interactive - -* w3-widget.el (widget-image-value-create): Was a little too aggressive - about when to apply the -1 :tab-order property. Now only images that - are not hyperlinks or imagemaps will not be tabbed to. - -* w3-prefs.el (w3-preferences-init-proxy-panel): Updated preferences panel - for new format of url-proxy-services - -* w3-vars.el (w3-hyperlink-menu): Fixed problem with calling wrong - bookmark function - would create a bookmark to the current document, not - the document under the mouse. - (w3-popup-menu): Added a few menu itmes (reload, show images, add bookmark) - -* w3-hot.el (w3-hotlist-add-document-at-point): Extract the title - correctly for the new widget implementation of hyperlinks. - -Mon Mar 10 06:31:48 1997 William M. Perry - -* w3-menu.el (w3-menu-options-menu): Fixed problem with XEmacs when - building without toolbars - would insert nil in the menu in a very wrong - place. - -* font.el (font-normalize-color): Under win32, make sure we define the - color before we try to use it, since Emacs doesn't support raw #RRGGBB - color specifications yet. - (font-rgb-color-p): make all #RRGGBB color specs go through - font-normalize-color - -* Emacs-W3 3.0.67 released - -Mon Mar 10 1997 Dave Love - -* w3.el (w3-do-setup): Make configuration file loading contingent - on init-file-user (i.e. suppressed with -q). - -Sun Mar 9 13:09:38 1997 William M. Perry - -* w3-widget.el (widget-image-value-create): Set :tab-order to -1 so the - latest widget library won't tab to image widgets. - -* w3.el (w3-mode): Make sure w3-mode-hook is run last, so that people can - turn off truncate-lines if they want. - -* ssl.el (open-ssl-stream): ssl-program-arguments is now dynamically - evaluated, similar to ps-lpr-switches. The special symbols 'host' and - 'port' are available, and bound to the hostname and port#/service we are - about to connect to. - -* w3-display.el (w3-finish-drawing): Remove all read-only properties on - text. - -* url-cache.el (url-cache-expired): fixed standalone mode - -Sat Mar 8 09:13:59 1997 William M. Perry - -* Emacs-W3 3.0.66 released. - -* url-cache.el (url-cache-prepare): Threw a condition-case around the - make-directory call, just in case we can't create the file for some - reason. Also fixed bug where the file wouldn't be cached until the - second time you visited it. - -* url.el (url-retrieve-internally): Deal with https asynch - -* w3-xemac.el (w3-mode-version-specifics): Don't try to add the toolbar if - device-type == 'stream. - -* w3-vars.el (w3-temporary-directory): Ditto. - -* url-vars.el (url-temporary-directory): Initialize from TMPDIR - environment variable. - -* w3.el (w3-start-viewer): Ditto. - -* md5.el (md5): Ditto. - -* mm.el (mm-compose-type): Don't use hardcoded /bin/sh and -c - use - shell-file-name and shell-command-switch - (mm-viewer-passes-test): ditto. - -* w3-sysdp.el: Better device-* functions for Emacs-19 under win32 and OS/2 - -* w3-display.el (w3-display-node): Better handling for support. - -Fri Mar 7 06:13:20 1997 William M. Perry <wmperry@aventail.com> - -* w3-script.el (w3-script-evaluate-form): protect against bad input during - the read-from-string when parsing emacs-lisp scripts. - -* w3-auto.el (w3-preferences-edit): Make the autoload for this be - interactive so that the user can actually find it! - -* Emacs-W3 3.0.65 released. - -* w3.el (w3-document-information): Better handling of last-modified - findings. - -* w3-forms.el (w3-form-create-image): Try to use the value of an - image-input area as the label for the widget we create. - -* w3-elisp.el (w3-elisp-safe-eval): Throw a condition-case() around the - eval to catch bad forms, etc. - -* w3-script.el (w3-script-evaluate-form): Don't signal an error on unknown - scripting languages, just show a warning. - -Thu Mar 6 08:24:49 1997 William M. Perry <wmperry@aventail.com> - -* w3.el (w3-complete-link): Protect against malformed widgets (null :from - or :to). Is this from delayed image widgets? - -* w3-vars.el (w3-mode-map): Changed binding of M-s to w3-save-as instead - of w3-search - does anybody use that instead of the forms interface? - -* w3.el (w3-document-information): Show document size - -* css.el (css-parse): Removed warning about old-style stuff for - device-dependent styles - was too annoying. Need to just remove this - support totally for the 3.0 release. - -* w3.el (w3-internal-handle-preview): When previewing a buffer, remove all - text properties from the document source before doing anything. - (w3-mail-current-document): Bind case-fold-search when looking for where - to insert the <base> tag. - (w3-loaded-stylesheets): New variable to keep track of what stylesheets - were loaded at startup. - -* url-cache.el (url-cache-create-filename-human-readable): New function to - create cached filenames using the old method, that was slightly more - human readable. - -Wed Mar 5 15:38:00 1997 William M. Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.64 released - -* w3-parse.el: OH god, finally got raw text inside a <tr> to push a <td> - onto the parse tree. got raw text inside a <table> to push a <tr> - onto the parse tee. - -* w3-widget.el: Support 'target' in img widgets - -Tue Mar 4 07:55:56 1997 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-display-node): Support 'seqnum' attribute - -* w3.el (w3-mail-document-author): Fixed for new 'link' representation - (w3-document-information): If a document has a 'Last modified: blah' line, - use it as the last modified information as a last resort. - -* Synch'ed up with widget 1.50 - -* w3-forms.el: Try to play nice with old and new versions of - widget-edit/wid-edit.el - -Tue Mar 4 06:23:41 1997 Michael Ernst <mernst@cs.washington.edu> - -* url.el (url-get-url-at-point): If a possible URL starts with www., slap - on 'http://', as someone probably just forgot it. - -Tue Mar 4 06:23:41 1997 William M. Perry <wmperry@aventail.com> - -* w3-prefs.el (w3-preferences-hooks-variables): Removed some old variables. - (w3-preferences-edit): The preferences panel actually works again. No - longer tries to use an imagemap - a dropdown is good enough dammit. - -* w3-vars.el: Removed some old variables - -* w3-display.el (w3-display-node): For <a> tags, do not embed a widget in - the buffer unless it actually has an 'href' attribute. This helps a - _lot_ with <a name="blah">...</a> constructs. - -Tue Mar 4 06:18:06 1997 Toby Speight <tms@ansa.co.uk> - -* w3.el (w3-mail-current-document): Allow TM (if it's in use) to choose - the appropriate Transfer-Encoding of a mailed document. - (w3-mail-current-document): Try real hard to put <base> where it belongs - (in the <head>, if that is not found, then just after <html>, otherwise - just at the beginning of the document) - -Mon Mar 3 07:10:11 1997 William M. Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.63 released - -* w3-forms.el (w3-form-field-label): Labels are now reimplemented for form - fields - -* w3-display.el (w3-parse-link): Now honors the old variable - w3-honor-stylesheets, which hadn't made it back onto the reimplemented - features list yet. - -* font.el: Added quite a few autoloads. Package no longer overwrites the - set-face-* functions, as this was deemed evil in the extreme. - -* w3-display.el (w3-face-for-element): Use the font-set-face-* functions - instead of the raw set-face-* functions. - -* w3-widget.el (widget-image-inaudible-p): New variable that controls - whether image widgets are rendered inaudible by emacspeak or not. - (widget-image-value-set): Use it. - -* url-cache.el (url-cache-directory): New variable that controls where you - cache files will be stored. Defaults to "~/.w3/cache" - (url-cache-creation-function): New variable that controls what function - will be used to create cached filenames. - (url-cache-create-filename-using-md5): This is now the default (and - only) cache-file-creation function. Suitably fast under Emacs 19 (lisp - implementation), _very_ fast under XEmacs, where it is written in C. - -Thu Feb 27 07:27:43 1997 William M. Perry <wmperry@aventail.com> - -* w3-sysdp.el: Added alias of make-symbolic-link to copy-file for NTEmacs - -* w3-elisp.el: Removed face functions from the safe list. - -Wed Feb 26 16:08:08 1997 Per Abrahamsen <abraham@dina.kvl.dk> - -* font.el (font-create-object): Added autoload. - -Wed Feb 26 08:17:37 1997 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-region): Fixed typo when binding - w3-display-same-buffer - no wonder it wasn't working right. - -* images.el (image-normalize): Bind file-coding-system to the appropriate - no-conversion so that running subprocesses doesn't munge the data when - running under MULE. - (image-normalize): Now uses call-process-region instead of - shell-command-on-region, and removed the explicit mention of '/bin/sh' - and friends. Uses the ability of call-process-region to specify a - separate file to use for stderr - yipeee. - -* url.el (url-setup-privacy-info): Slight change as to how url-system-type - and url-os-type are set up. No longer uses nested parens, as this seems - to confuse some sites that try to use the User-Agent header as a - state-tracker. - -Mon Feb 24 10:15:45 1997 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-widget-echo): Make sure that nothing that will be - echoed is the empty string. - -Sun Feb 23 08:34:18 1997 William M. Perry <wmperry@aventail.com> - -* url-cache.el (url-store-in-cache): fixed stupid bug in caching logic - -Sat Feb 22 07:21:29 1997 William M. Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.62 released - -Thu Feb 20 13:40:22 1997 William M. Perry <wmperry@aventail.com> - -* w3-forms.el (w3-form-summarize-password): By default, don't summarize - password entry boxes. - -Thu Feb 20 07:33:59 1997 Thierry Emery <Thierry.Emery@aar.alcatel-alsthom.fr> - -* w3-display.el (w3-frames): Better support for Frames - -Thu Feb 20 07:33:59 1997 William M. Perry <wmperry@aventail.com> - -* w3.el (w3-complete-link): Fixed bug in using try-completion to make sure - we have a match before passing a URL off to w3-fetch. - -* Synch'd up to widget 1.44 - -* url.el (url-default-callback): Caching works in asynch mode now. - -Wed Feb 19 05:48:40 1997 William M. Perry <wmperry@aventail.com> - -* css.el (css-split-font-shorthand): Make sure that the subelements of the - 'font' shorthand property get run through the property value-expansion - routines before getting returned. This royally screwed up font-family, - font-weight, and friends. - (css-expand-color): Now recognizes 'transparent' and 'none' as special - color names. - (css-expand-value): When dealing with color-shorthand, make sure - everything gets run through the value-expansion routines as well. Ack. - -* w3-elisp.el (w3-elisp-safe-function): You can now supply a validation - function for the arguments of a script-enabled function, its no longer a - binary operation on just the function name. You can also give it a - variable name, and the value of that variable at the time of execution - is what controls whether it is safe or not. - -* w3.el (w3-download-url): Finally fixed bug where w3-download-url would - not save in the correct directory if you just accepted the default - pathname it offered. - -* url-cache.el (url-cache-ignored-protocols): New variable controlling - what protocols we should never cache to disk. - (url-cache-cachable-p): use it. - -* w3.txi: Updated all nodes and menus, a few stylistic changes - -* w3-elisp.el: Added read-access to devices, frames, windows, buffers, and - property-lists. Also added function, lambda, point, and list accessors - (member, memq, assoc) - -* w3-display.el (w3-display-node): Bind widget-push-button-gui to nil in - w3-display-node so that images don't run into the - visible-portion-of-buffer-is-not-modifiable-bug. Ick. - -* w3-elisp.el: Don't allow access to 'set'-type text-property functions - from scripts. - -Tue Feb 18 15:11:08 1997 William M. Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.61 released - -* w3.txi (Supported URLs): added sections on each protocol supported - - needs lots of fleshing out. - -* url-misc.el (url-info): Info URL loader now unhex's the target, so that - you can have something like info:w3.info#Getting%20Started - -* url.el (url-do-setup): Removed secure-http (SHTTP) handler - who the - hell cares anymore, it lost. - -* w3-display.el (w3-display-node): Correctly calculates right margin as - documented (from window-width and right-margin) - -* w3.el: Removed w3-batch-fetch - -* url-vars.el: Removed lots of old variables - -* url-misc.el: Removed x-exec URL handler - no interest anymore. - -* w3-script.el (w3-script-evaluate-form): Use it. -(w3-do-scripting): New variable to control whether to do _any_ scripting -or not. - -* The URL package now stores the current parsed URL object instead of 5 or - 6 separate variables. - -* dist.Makefile: Removed old pgp and wais support, it was gross and - apparently nobody was using it. - -Tue Feb 18 06:13:03 1997 "T. V. Raman" <raman@adobe.com> - -* w3-forms.el (w3-form-summarize-radio-button): Better radio button - summarizer. - -Tue Feb 18 06:13:03 1997 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-finish-drawing): Moved #blah target finding in here, - where it belongs. - -* w3-vars.el (w3-mode-map): Added binding for raw '\t' instead of relying - on [tab]. Apparently this keysym isn't aliased under Emacs 19 on a - TTY. - -Mon Feb 17 15:10:38 1997 William M. Perry <wmperry@aventail.com> - -* w3-elisp.el: Interface to Emacs-Lisp for safe scripting. - -* w3-script.el: Basic client-side scripting has been implemented. - -* w3-xemac.el (w3-mouse-handler): Ditto - -* w3-e19.el (w3-mouse-handler): Plugged in handling of the onMouseOver event - -* w3-display.el (w3-handle-string-content): Now adds a text property that - contains w3-display-open-element-stack, so that from anywhere in the - buffer you can find out where you are in the parse tree. - -* default.css (input): ome default stylesheet updates for input fields on - TTYs - -Sun Feb 16 09:01:18 1997 Shuji Narazaki <narazaki@InetQ.or.jp> - -* mule-sysdp.el: Updated for mule 3.0 - -Sat Feb 15 15:35:15 1997 William M. Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.60 released - -* w3-display.el (w3-display-node): use it. - -* w3-vars.el (w3-display-frames): New variable for whether to show 'frame' - documents as a list of the subelements. - -* w3.txi (Speech Properties): finished this chapter. -(Media Selection): ditto -(Time Units): ditto -(Angle Units): ditto -(Properties): Explanatory text at beginnign of section - -Fri Feb 14 09:34:35 1997 William M. Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.59 released - -* w3.txi: Lots of documentation about stylesheets, chapter layout - changes. - -Thu Feb 13 07:01:59 1997 William M. Perry <wmperry@aventail.com> - -* Synch'd up to widget 1.38 - -* w3-forms.el (w3-form-resurrect-widgets): For now, don't use the nice new - GUI pushbuttons - they appear to suffer badly on long lines. - -* w3-mouse.el (w3-running-FSF19): Use new w3-popup-menu-on-mouse-3 variable - -* w3-vars.el: Removed _lots_ of obsolete variables -(w3-popup-menu-on-mouse-3): New variable to control whether W3 should - override mouse-3 or not. - -* Emacs-W3 3.0.58 released - -* w3.txi: Added stubs for stylesheet chapters and supported URLs - -* images.el (image-register-netpbm-utilities): This is now safe to call - multiple times again. - -Wed Feb 12 06:26:55 1997 William M. Perry <wmperry@aventail.com> - -* w3-forms.el (w3-form-keymap): When binding widget-end-of-line, make sure - that we do not overwrite Emacspeak's prefix-key. Now does a - where-is-internal to find the correct binding in global-map to - override. - -* w3-display.el (w3-display-node): bind :emacspeak-help to 'w3-widget-echo - in all the hypertext links. - -* w3-vars.el (w3-mode-map): New binding for \M-\t - this _should_ have - been taken care of by the [(meta tab)] definition, but evidently it - doesn't. *sigh* - -Tue Feb 11 07:33:50 1997 William M. Perry <wmperry@aventail.com> - -* w3-forms.el (w3-form-create-option-list): Specify :menu-tag-get so that - keyboard-based-completion doesn't get confused by the fact that some - items will have spaces slapped in at the end. - -* ssl.el (ssl-program-arguments): New variable - a list of command line - switches to send to the SSL program in a subprocess, before the hostname - and port number. - (open-ssl-stream): Use it. - -Mon Feb 10 07:45:31 1997 William M. Perry <wmperry@aventail.com> - -* url-file.el (url-file): Removed refs to variable url-use-hypertext-dired - -* url-vars.el: Removed obsolete variable url-use-hypertext-dired - -* url-file.el (url-dired-find-file-mouse): fixed bad typo of - (interactive...) spec, added documentation to a few functions. - (url-file): Removed refs to obsolete variable url-use-hypertext-dired - -* w3-xemac.el (w3-setup-version-specifics): Workaround for users of XEmacs - 19.14 or 20.0 with the bad bad bad lossage with text properties that - have null values. This bug is fixed in XEmacs 19.15, and will be in - 20.1 as well. This bug would cause you to get errors like: - internal error: no text-prop <#extent ....> start-open - -* w3.el (w3-widget-button-click): Deal with new image capabilities of the - widget checkbox/radio-button stuff. - -* Synch'ed up to widget 1.31 - -Sun Feb 9 15:39:19 1997 William M. Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.57 released - -* url-file.el (url-dired-minor-mode): New minor mode that overrides a few - of direds keybindings to use Emacs-W3 instead of straight find-file. - (url-format-directory): Now just uses dired to display directory - listings, much more powerful than the old way. Can copy files, act on - multiple files, you all know the drill. - -* w3.txi: Added more chapters, reorg of others. - -* w3-display.el (w3-maybe-start-image-download): Fixed handling of bad - images in the cache again. Duh. - No longer log to the warnings buffer if we fail to load an image. Just - use message - much less intrusive. We just usually don't care that much - about failed image loads. - -* url-gw.el (url-open-stream): fixed typo - was calling old - url-nslookup-host instead of url-gateway-nslookup-host - -* w3.el (w3-insert-formatted-url): Now inserts markup in lowercase. - -Sat Feb 8 13:54:43 1997 William M. Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.56 released. Getting closer! - -* w3-forms.el (w3-form-summarize-radio-button): Finally, a decent - summarization of radio buttons - Fixed typo in specifying summarizer for hidden form fields. - (w3-form-keymap): Bind C-a and C-e by default. - -* w3-widget.el (widget-image-value-create): When using emacspeak, show - client side imagemaps as a table. Need a more general solution for - this, but this makes us nicer than IE again. :) - -* Updated to widget 1.30 - -Fri Feb 7 16:49:55 1997 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-handle-string-content): Make sure faces text - properties are closed, so that things don't bleed over. - (w3-fixup-eol-faces): New function for Emacs 19 that removes face - information at newlines, so that underlining will not extend from the - end of a line to the window edges - very ugly. - -* w3-menu.el (w3-menu-initialize-w3-mode-menu-map): Don't support 'emacs - in w3-use-menus under Emacs in Windows 95/NT. - -* w3-display.el (w3-finalize-image-download): Deal with bad images better. - (w3-finish-drawing): Better protection of putting images in. - -* url-gw.el (url-open-stream): Don't auto-retry connections. Don't throw - an error if you fail to connect to a site. This is for image loadings - that fail for some reason or another. - -* css.el (css-expand-length): better handling of float values and 'ex' - unit type. - -* font.el (x-font-create-object): Unconditionally make case-fold-search - non-nil so that we don't lose big-time. This was the cause of the very - weird font-spatial-to-canonical lossage under XEmacs with font sizes of - something like '+12pt' - -* w3.el (w3-view-this-url): Use widget-echo-help if we didn't find a URL - under point. - -Fri Feb 7 15:22:25 1997 Charles Levert <charles@comm.polymtl.ca> - -* w3-widget.el (widget-image-notify): Bad data being fed to w3-fetch if a - client-side imagemap had an alt attribute (but only if the <map> came - _after_ the use. - -Fri Feb 7 15:22:25 1997 William M. Perry <wmperry@aventail.com> - -* font.el (font-spatial-to-canonical): protect against bad input to this - function. - -Fri Feb 7 15:19:36 1997 Toby Speight <tms@ansa.co.uk> - -* w3-parse.el (w3-parse-buffer): Parser didn't allow for the fact that - TAGC is optional on end-tags as well as on start-tags (i.e. "<b<i> - bold-italic</i</b>" is legal). - -Fri Feb 7 06:28:37 1997 William M. Perry <wmperry@aventail.com> - -* w3-forms.el (w3-form-keymap): Now inherits from widget-keymap, with a - few exceptions. - -* url.el (url-uncompress): This function now no longer looks at the file - extension to determine a compression/encoding method. This is so that - doing searches on `foo.tar.gz' will not bogusly cause the decompression - steps to run. Ick! - -* url-file.el (url-insert-possibly-compressed-file): This function no - longer atempts to decompress the file after loading it in. Instead, it - sets an appropriate content-transfer-encoding header based on the - filename, so that this will allow url-uncompress to work correctly on the - buffer. - -Thu Feb 6 06:24:26 1997 William M. Perry <wmperry@aventail.com> - -* w3-print.el (w3-postscript-print-function): New variable to control what - function is used to generate postscript output. - (w3-print-this-url): Use it. - -* w3-display.el (w3-handle-string-content): Make all inserted text - read-only - -* w3-forms.el (w3-form-use-old-style): New variable to control whether to - use the old-style interaction with form fields instead of the 'type - directly into the buffer' method - (w3-form-determine-size): Use it. - (w3-form-create-integer): Use it. - (w3-form-create-float): Use it. - (w3-form-create-text): Use it. - (w3-form-create-password): Use it. - (w3-revert-form): Fixed error with 'reset' buttons on forms that had - hidden form fields. - -* w3-vars.el (w3-mode-map): Define [backtab] by default - -* w3-display.el (w3-size-of-tree): Removed some warnings -(w3-display-table-dimensions): ditto - -* Updated to widget 1.26 - -* default.css: Some default formatting changes for input fields. - Everything is underlined by default except submit/reset/image/button - fields, so that they are a little easier to spot. - -* w3-parse.el (w3-parse-buffer): Now slaps pseudo-elements into input - fields so that stylesheets can access them. - -Wed Feb 5 14:42:12 1997 William M. Perry <wmperry@aventail.com> - -* Updated to widget 1.24 - -* Happy birthday Jenny P. - -Tue Feb 4 08:21:03 1997 William M. Perry <wmperry@aventail.com> - -* font.el (x-font-create-name): Better checking/optimizing of when to just - return the default font. - -* w3-forms.el: Make use of the new information, and pass it down to the - widget library appropriately. - -* w3-display.el (w3-display-node): Now passes in the entire list of active - faces to form creation functions. - -Mon Feb 3 07:26:18 1997 William M. Perry <wmperry@aventail.com> - -* w3-emulate.el (w3-lynx-emulation-minor-mode-map): Lots of new - keybindings for lynx emulation minor mode. - -* Emacs-W3 3.0.55 released - -* w3-forms.el (w3-form-determine-size): Fixed _STUPID_ problem where - option lists would lose everything but the first option in them. I'm a - dumbass. Sort modifies its list parameter! ICK ICK ICK. - -* url.el (url-after-change-function): Show prettier status messages. - Sizes are converted to bytes, k, or M, depending on how big the file - is. - -* w3.txi: Lots of documentation changes - volunteers welcome. - -* Removed personal annotation support, since it wasn't shown with the new - display engine, it needs to be rethought, and nobody had complained in - the entire beta cycle. - -* w3.el (w3-history-find-url-internal): Redid the history mechanism. - Toolbar and menu entries are now grayed out appropriately. - -* url-http.el (url-create-mime-request): Fixed cookie support if not going - through a proxy gateway. - -Sun Feb 2 22:05:41 1997 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-display-table): Fix for negative colwidth - -Fri Jan 31 14:28:54 1997 William M. Perry <wmperry@aventail.com> - -* w3.el (w3-fetch): Fixed targetted links (http://blah/#foo) - -Fri Jan 31 11:20:47 1997 Alf-Ivar Holm <alfh@ifi.uio.no> - -* w3.el (w3-mail-current-document): Fixed problem with calling - w3-parse-buffer with too many arguments when mailing LaTeX-ified - files. - -Fri Jan 31 11:19:37 1997 Cord Kielhorn <kielhorn@thphy.uni-duesseldorf.de> - -* css.el (css-expand-length): Fixed bad regexps for percentage and - character based lengths - -Thu Jan 30 20:27:06 1997 William M. Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.52 released - -* w3-display.el (w3-handle-image): When doing table auto layout, don't - start loading the images. - -Wed Jan 29 06:15:37 1997 William M. Perry <wmperry@aventail.com> - -* font.el (x-font-create-name): Yet another fix for not screwing up the - line-height in Emacs 19. - -* w3-display.el (w3-face-for-element): Uhh, oblique seems to work. - -* font.el (set-font-style-by-keywords): now deals with arguments that - aren't lists, for the font-style and font-variant CSS stuff - -* w3-display.el (w3-display-node): Reimplemented <cookie> tag. -(w3-display-node): Reimplemented <flame> tag. - -* url.el (url-insert-file-contents): url-insert-file-contents now - decodes/uncompresses the data before returning. - -* w3-display.el (w3-display-node): Reimplemented <pinhead> tag - -Tue Jan 28 06:22:08 1997 William M. Perry <wmperry@aventail.com> - -* font.el (x-font-create-name): Never take font size into account under - Emacs - too much chance of totally screwing up the users leading by - choosing a bigger font than their default. This sucks. But I can't - find a better solution. - -* w3.el: w3-mode now turns on truncate-lines by default. - -* w3-forms.el (w3-form-create-image): Better image input type support. - -Mon Jan 27 08:21:58 1997 William M. Perry <wmperry@aventail.com> - -* w3-forms.el (w3-form-create-password): Now uses real password entry - widgets provided by 'widget' - you _MUST_USE_ the widget library that - comes with Emacs-W3 for this, otherwise the info won't be hidden - correctly. - (w3-form-add-element): Deal with hidden text areas better when they are - in forms - -* Synch'd up to widget 1.22 - -Sun Jan 26 16:50:09 1997 William M. Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.51 released - -* w3-forms.el (w3-form-create-text): Now uses the real text entry widgets - provided by 'widget' - still can't do this for password fields yet - though. - -* Synch'd up to Widget 1.20 - -Sat Jan 25 13:38:12 1997 William M. Perry <wmperry@aventail.com> - -* url.el (url-expand-file-name): Now strips out spaces as well as - newlines/carriage returns. More fixes for that bastardized microsoft - home page. - -* url-http.el (url-create-mime-request): Make sure that we retrieve the - cookies for the real URL we are retrieving when going through a proxy. - Now the psychotic crap that is the microsoft home page should be - successfully retrieved if going through an HTTP proxy. - -* url-cookie.el (url-cookie-handle-set-cookie): Attempt to deal with - idiotic microsoft home page that sends out set-cookie headers that look - like MC1=ID=abc, and expects two cookies MC1='' and ID='abc' *sigh* - -* w3-forms.el, w3-display.el: Form elements now keep all their attributes - with them. Will be useful when we start allowing scripting. - (w3-form-create-custom): Rudimentary patches to allow embedding 'custom' - widgets into the buffer. Interesting. - -* w3-forms.el (w3-form-determine-size): New function to calculate how big - a form field will be - option lists should look much better now. - -Thu Jan 23 08:48:59 1997 William M. Perry <wmperry@aventail.com> - -* Synch'ed up to custom 1.19 - -* url-parse.el: document extra slots of url-generic-parse-url - -Thu Jan 23 08:34:34 1997 Joe Wells <jbw@cs.bu.edu> - -* url-file.el (url-file): Patch to tell ange-ftp and/or efs the password - in a file/ftp URL so that you won't be prompted for the password, even - if one was specified in the URL - -* url-parse.el (url-generic-parse-url): Fixed bug where specifying a - username and password in the URL would downcase the username and - password as well as the hostname. - -Wed Jan 22 08:28:13 1997 William M. Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.50 released - -* base64.el (base64-encode-region): Pulled in code from VM for quicker - encoding/decoding - -* mm.el (mm-content-transfer-encodings): Better base64 decoding - -Wed Jan 22 07:31:03 1997 Alf-Ivar Holm <alfh@ifi.uio.no> - -* w3-emulate.el (w3-lynx-emulation-minor-mode-map): Lynx [up] and [down] - bound to non-existing functions. - -* w3.el (w3-do-setup): Fixed installation of lynx emulation modes keymap. - -Tue Jan 21 07:56:51 1997 William M. Perry <wmperry@aventail.com> - -* url-misc.el (url-data): Make sure to url-decode the data before - inserting it into the buffer. - -* w3-menu.el (w3-toggle-minibuffer): better version - -* w3-forms.el (w3-form-create-integer): New form entry type - (w3-form-create-float): new form entry type - (w3-form-encode-helper): deal with the new integer/float types - -* w3-display.el (w3-display-node): Reimplemented <select multiple> as a - list of checkboxes - -Mon Jan 20 06:29:07 1997 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-display-node): Keep track of the last form's action, - for theoretically 'naked' input fields that we want to try and handle as - best we can anyway. - -* w3-parse.el: Much more lenient about where form elements can be found. - -* w3-forms.el: summarizer functions now take the widget as an extra - parameter. - -* w3.el (w3-find-etc-directory): New function - not used yet. - -* w3.txi: Warning! You now need a very new version of texinfo to compile - the .info or .dvi file yourself. - -* url-mail.el (url-mail): Now tries to use message-mail if it is bound - instead of just plain old 'mail'. - -* w3-forms.el (w3-form-add-element): Duh, fix hidden form fields. - -* font.el (font-normalize-color): Hopefully fixed color lossage under OS/2 - and Windows - -* w3-forms.el (w3-form-summarize-field): Actually 'message' the string as - a workaround for emacspeak 5.0 - -Sun Jan 19 09:32:15 1997 William M. Perry <wmperry@aventail.com> - -* w3-xemac.el (w3-mouse-handler): Ditto - -* w3-e19.el (w3-mouse-handler): Protect against 'bad format string' errors - when showing a hexified URL - -* w3-forms.el (w3-form-mark-widget): Be super paranoid and mark all - children and their children's children, and the parents of a widget. - (w3-form-create-radio-button): Make sure radio button children always - get updated via w3-form-mark-widget. - (w3-form-summarize-radio-button): Slightly better summarization of radio - buttons. - -* Emacs-W3 3.0.49 released - -* Synch'ed up with widget 1.18 - -Fri Jan 17 06:25:36 1997 Dave Love <d.love@dl.ac.uk> - -* w3-display.el: w3-echo-link now prefers the URL to the text of a link - -Fri Jan 17 06:25:36 1997 William M. Perry <wmperry@aventail.com> - -* w3-display.el: Fixed handling of inlined styles - -* w3-mouse.el: Some fixes for XEmacs when built with no X support - -* default.css: Now uses the new @media directives instead of the old - :blah: stuff - -* css.el (css-handle-media-directive): New function to handle @media - directives. - (css-parse): Deprecate the old :mediatype: way of specifying media - dependent styles. - -* w3-style.el (w3-handle-style): Now gets passed a plist instead of an - assoc list. - (w3-handle-style): Pay attention to the new 'media' attribute on - stylesheet links, and don't load the stylesheet if we aren't currently - running on that type of media. - -* css.el (css-properties): Added proposed printing properties from a W3C - draft. - -Thu Jan 16 06:06:45 1997 William M. Perry <wmperry@aventail.com> - -* css.el (css-handle-media-directive): Implemented the @media processing - instruction. - -* w3-forms.el (w3-form-summarize-option-list): Changed the summarize - function for option lists. Much saner now. - -* w3.el (w3-read-url-with-default): Use the URL at point before falling - back to http://www. - (w3-source-document): When sourcing a document, let set-auto-mode do the - right thing. .html comes up in html-mode, or whatever now. - -* url-cookie.el: Fixed some compile warnings under Emacs - -* w3-forms.el (w3-form-summarize-option-list): Make each choice-item have - emacspeak-help set. - -* w3-speak.el (w3-widget-backward): New advice -(w3-widget-forward): New advice - -* w3-forms.el (w3-form-create-option-list): Renamed function - -* Emacs-W3 3.0.48 released - -* w3-display.el (w3-face-for-element): Use background-color instead of - just background for css property. - -* w3-forms.el (w3-form-encode-helper): Fixed radio buttons, duh. - -* url-misc.el (url-do-terminal-emulator): Fixed bad var reference left - from old code. - -* url-gw.el: Moved all the gateway variables into their own namespace to - make it easier to turn this into a standalone package. - -* dist.Makefile (SOURCES): Added url-gw and w3 to the build targets. - -Wed Jan 15 08:00:37 1997 William M. Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.47 released - -* url.el (url-expand-file-name): Make sure to remove \r from the URL as - well as \n - -* url-gw.el (url-open-stream): Added in 'telnet' and 'rlogin' methods for - url-gateway-method. Code stolen from GNUS. Thanks lars! :) It would - be nice to make this file its own package and be able to override - open-network-stream so that all apps could get this for free. - -* url-misc.el (url-generic-emulator-loader): Consolidated the tn3270, - telnet, and rlogin URL loaders into one smarter function - -* url.el: Made cookie and auth modules autoloaded, removed some old autoloads -(url-open-stream) Moved to url-gw.el - -Mon Jan 13 22:11:00 1997 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-widget-echo): w3-echo-link can now be a list, so the - user can explicitly control fallback behaviour. - -* w3.txi: Added some pointers to CSS documentation - -* mule-sysdp.el (mule-code-convert-region): ditto - -* w3.el (w3-convert-code-for-mule): Fixed bug in XEmacs 20.0 mule - -Mon Jan 13 11:14:29 1997 T. V. Raman <raman@Adobe.COM> - -* w3.el (w3-widget-forward): Call widget-forward interactively so that - emacspeak will hook it correctly. - -Mon Jan 13 11:14:29 1997 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-refresh-buffer): Finally reimplemented - w3-refresh-buffer. - -Sun Jan 12 10:32:50 1997 Karl Eichwalder <ke@ke.Central.DE> - -* w3.txi: Add @dircategory and @direntry... @end. `install-info' - from texinfo-3.9 know about those. - -Sun Jan 12 21:49:44 1997 William M. Perry <wmperry@aventail.com> - -* w3.el (w3-save-as): Can now save a page as postscript again - -* w3-display.el (w3-display-node): inline styles work again - -* url-misc.el (url-data): Updated data: URL to the spec. - ftp://ietf.org/internet-drafts/draft-masinter-url-data-02.txt - -Sat Jan 11 20:47:24 1997 William M. Perry <wmperry@aventail.com> - -* Emacs-w3 3.0.45 released - -* url-misc.el (url-data): Now supports the 'data' URL type, which just - 'fetches' everything after the data: chunk of the URL - -Fri Jan 10 11:49:43 1997 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-display-node): Multicolumn works, but puts things - across instead of down - -* w3-parse.el: Basic support for parsing <multicol> - -* w3-display.el (w3-display-node): Make our semi-widgety hyperlinks - start/end open under XEmacs. - -* w3.el (w3-complete-link): Make sure we take case into account when doing - link completion. The user can use 'test' to complete to link titled - 'Test'. Uses try-completion for this, which seems to work since we - require a match. Is this the best way to do this? Other than not being - case-insensitive at this point? - -* w3-forms.el (w3-form-default-widget-creator): Better way of handling - updates to text entry fields. - (w3-revert-form): Everything should be reverted correctly, both in - internal storage and in the buffer - (w3-form-create-radio-button): Get a more unique identifier to store - radio elements by - old way could theoretically get collisions. - -* w3-display.el (w3-display-handle-list-type): Updated use of 'list-style' - to use new property 'list-style-type' - (w3-prepare-buffer): Now kills the source buffer before it starts - drawing the tree, to avoid *URL-n* buffers when not really necessary. - -* css.el (css-properties): Updated all the properties to the W3C's latest - 'recommendation' level CSS specification. - (css-handle-import): much better handling of @import - (css-parse): Better handling of '@' directives in general - (css-expand-value): General cleanup, reference the CSS and ACSS specs - for how/why we are parsing something the way we are. - -Thu Jan 9 06:17:08 1997 William M. Perry <wmperry@aventail.com> - -* Updated all copyright notices. Happy belated new year! - -* w3-display.el (w3-region): Fixed a few bugs with nuking too much of a - buffer when using w3-region - -* w3.el (w3-read-url-with-default): Use new variable. - -* w3-vars.el (w3-fetch-with-default): New variable to control whether or - not w3-fetch will figure out a good default value for the URL or not. - -* w3-forms.el (w3-form-mark-widget): New function to mark a widget and all - its children with an appropriate :emacspeak-help and 'w3-form-data - Now defines a few keywords to look more widget-y - -Wed Jan 8 09:27:47 1997 William M. Perry <wmperry@aventail.com> - -* css.el (css-expand-value): Added elevation, angle, and time units. - -* w3-display.el (w3-display-node): Turn on voice-lock-mode by default in - all w3 buffers. - -* css.el (css-properties): Added in new speech properties from the ACSS - note from the W3C. Please see - http://www.w3.org/pub/WWW/Style/CSS/Speech/NOTE-ACSS for more - information. - -* w3-forms.el: Moved all the form entry summarization functions from - w3-speak.el into w3-forms. Easier to keep in synch this way. - -* w3-display.el (w3-display-node): Reimplimented the 'keygen' form entry - type for netscape compatibility. - -Tue Jan 7 07:20:08 1997 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-region): New function that parses the HTML in a region - 'in-place', so that things like MIME mailers/gnus readers can show HTML - inline a lot easier. - -* w3-forms.el (w3-form-resurrect-widgets): Fixed case where a widget goes - all the way to point-max and next-single-property-change will return - nil. Would pass bad args to delete-region. - (w3-form-summarize-field): Moved some of the smarts about summarizing W3 - widgets from w3-speak into the core forms code. - -* font.el (define-font-keywords): New function for defining keywords that - will actually work across Emacs and XEmacs - -* w3-display.el (w3-display-node): Reimplemented 'note' functionality, by - converting it into a two-cell table. - (w3-display-node): Implemented <dir> as multi-column, as-per the RFC and - HTML 3.x specifications - -* default.css: Added default display type for dir and menu - -Mon Jan 6 21:49:52 1997 William M. Perry <wmperry@aventail.com> - -* url-http.el (url-create-mime-request): Fixed yet another stupid problem - in Host: header handling. Was never sending the right information if - you were not going through a proxy this time. *sigh* - -* w3-forms.el (w3-form-add-element): Fixed hidden form fields - -Sun Jan 5 22:38:54 1997 William M. Perry <wmperry@aventail.com> - -* url-vars.el (url-proxy-services): updated documentation string - -* w3-widget.el (widget-image-notify): Fixed client side handling of -imagemaps on a TTY or a delayed/broken image. Duhhh - -Fri Jan 3 Dave Love <d.love@dl.ac.uk> - -* w3-e19.el (w3-mouse-handler): Fix link echoing. - -Fri Jan 3 08:43:56 1997 William M. Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.43 released - -* font.el (make-font): Treat args as a plist, just for sanity's sake. - -Thu Jan 2 12:19:31 1997 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-table-hack-borders): Fix stupid use of 'otheriwse' - instead of 'otherwise' in a case statement. - -* w3-forms.el (w3-form-add-element): Fix stupid use of 'otheriwse' - instead of 'otherwise' in a case statement. - (w3-form-resurrect-widgets): Fixed XEmacs handling of widget recreation, - and also fixed problem where some widgets would be skipped. - -Tue Dec 31 07:37:17 1996 William M. Perry <wmperry@aventail.com> - -* w3-e19.el: All the menus in Emacs-19 now use the same constructors that - the :filter entries under XEmacs do. This will make things much easier - in the future in not duplicating crufty menu-construction code once for - XEmacs menu-structs and once for Emacs keymaps. - -* w3-menu.el (w3-menu-html-links-constructor): Now works with the Emacs 19 - implementation of property lists. - -Mon Dec 30 06:25:28 1996 William M. Perry <wmperry@aventail.com> - -* w3-menu.el (w3-popup-menu): context-sensitive menus over delayed images - work again - -* w3-display.el (w3-parse-link): New way to store <link> information from - an HTML document. - -* w3.el (w3-search): Deal with new <link> storage - -* w3-menu.el (w3-menu-html-links-constructor): Deal with new way <link> - items are stored - now uses the 'title' attribute if present. - -* w3-auto.el (w3-form-resurrect-widgets): Added autoload - -* url-file.el (url-format-directory): Removed url-forms-based-ftp option - - didn't really work anyway. - -Sun Dec 29 15:54:21 1996 William M. Perry <wmperry@aventail.com> - -* w3-forms.el (w3-form-resurrect-widgets): fixed stupid problem in munging - of the size of form elements. - -* Emacs-W3 3.0.42 released - -* w3-display.el (w3-table-hack-borders): Deal gracefully with not finding - a 'terminal' font to display hacked border chars in - -* w3-hot.el (w3-hotlist-add-document): don't hexify a url before sticking - it in the hotlist buffer - -* w3-display.el (w3-display-node): hyperlinks with images at the start - will now have a button associated with the entire link, not just the - image part. - -* w3-sysdp.el (fillin-text-property): made it work under Emacs19 - -Sun Dec 29 00:07:39 1996 Takahiro Hayata <hayata@sc511t.s.kobe-u.ac.jp> - -* mule-sysdp.el (mule-write-region-no-coding-system): Patch for Mule 2.3 - -Sun Dec 29 00:07:39 1996 William M. Perry <wmperry@aventail.com> - -* w3-forms.el (w3-form-add-element): Only insert stubs of the right length - for a for element, and do munging of that text into the actual widgets - later. This saves us a lot of grief and heartache when handling things - like radio buttons that span table elements because the markers have - become completely insane by the time the next widget is ready to be - created. - -Sat Dec 28 17:24:08 1996 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-display-table): Don't crap out on invalid tables where - table-dimensions tells us we have a 0 column or 0 row table. - -* w3-widget.el (widget-image-value-create): Use :action instead of :notify - for widget-image-callback - hyperlinked images under Emacs 19 should - work again. - -Thu Dec 26 18:26:25 1996 William M. Perry <wmperry@aventail.com> - -* w3.el (w3-widget-forward): Use this instead of widget-forward. -(w3-widget-backward): Ditto. Need to make both of these smart for w3. - -* w3-display.el (w3-display-node): Implemented the display class 'none' - for turning off the rendering of an element and its subcontent. - -Thu Dec 26 07:21:58 1996 William Perry <wmperry@aventail.com> - -* w3-parse.el (w3-parse-buffer): *sigh* Allow _ in attribute names. - -* Emacs-W3 3.0.41 released - -* url-parse.el (url-generic-parse-url): bind inhibit-read-only to 't' in - url parsing buffers, to avoid 'attempt to modify read-only text' - problems when the string passed to url-generic-parse-url has the - read-only text property set. - -* w3-e19.el (w3-setup-version-specifics): popup menus should work in - Emacs19 again. - -* css.el (css-expand-value): For margin and padding, make sure we _always_ - convert into a valid length spec. Setting a 'margin' or 'padding' - property group instead of individual margin-* or padding-* values would - cause the display engine to crap out. - (css-get): Fixed generic class-only lookups (.foo, etc) - -* w3-display.el (w3-display-handle-list-type): Tweaks to list indentation - -* w3-menu.el (w3-menu-html-links-constructor): Fixed stupid problem with - the new navigate menu under XEmacs. - -Tue Dec 24 22:46:11 1996 William M. Perry <wmperry@aventail.com> - -* css.el (css-expand-color): Better handling of X-style color specs - - convert them to internal RGB format. - -Tue Dec 24 02:50:08 1996 Christian Limpach <chris@nice.ch> - -* font.el (ns-font-families-for-device): added test for unbound - device-fonts-cache variable. - (ns-font-create-name): handle font-styles which are numbers. - -* w3-sysdp.el (try-font-name): added support for Nextstep. - -Tue Dec 24 06:16:33 1996 William M. Perry <wmperry@aventail.com> - -* w3.el (w3-open-local): Send filename through expand-file-name in - w3-open-local to avoid having illegal URLs like file:/~/test.html - -* w3-widget.el (widget-image-value-create): fixed new problem with client - side imagemaps. Should really work this time. - -* w3.el (w3-map-links): w3-map-links and hence w3-complete-link will now - find images that are also hyperlinks. - -Mon Dec 23 22:28:58 1996 William M. Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.40 released - -* w3-menu.el (w3-menu-go-menu): Added 'navigate' submenu to hold the - predefined <link> types. - -* w3-widget.el (widget-image-summarize): Image widgets should now be much - better at identifying themselves when being tab'ed to or waggled at with - the mouse. - -* w3-prefs.el: Fixed a few references to w3-glyphp (now widget-glyphp) - -* w3.el (w3-url-completion-function): Fixed completion of URLs - -Sat Dec 21 Dave Love <d.love@dl.ac.uk> - -* w3-display.el, w3-vars.el, w3.el: Define and use - w3-defined-link-types to canonicalize link descriptions' case for - ease of use. - -* w3-e19.el (w3-build-FSF19-menu): Add any recognised <link> items - to the menu in the absence of a toolbar. - -Thu Dec 19 13:52:35 1996 William Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.39 released - -* w3-forms.el (w3-form-encode-xwfu): Ditto. - -* url.el (url-hexify-string): Updated to use url-unreserved-chars when - escaping, ala - http://www.ics.uci.edu/pub/ietf/uri/draft-fielding-url-syntax-02.txt - -Wed Dec 18 22:09:41 1996 William M. Perry <wmperry@aventail.com> - -* w3.el (w3-mode): Removed bogus setting of widget-motion-hook from way - back - -* w3-parse.el (w3-parse-buffer): Better handling of <base> tag. - -* w3-display.el (w3-widget-echo): Better falling-back when the preferred - echo method yields nil. - -* url.el, w3-display.el, w3.el: Remove last vestiges of url-hash.el and - removed it from the distribution. - -Wed Dec 18 08:07:32 1996 William Perry <wmperry@aventail.com> - -* dsssl.el: Moved the DSSSL parser and friends into its own namespace. - -Removed dependencies on url-hash. - -* custom.el: Synch'd up to custom 1.13 - -Tue Dec 17 16:36:05 1996 William M. Perry <wmperry@aventail.com> - -* url.el (url-expand-file-name): If we weren't given a base object to work - from, and url-current-object is null, set it to the object returned by - parsing url-view-url. - -* url-http.el (url-create-mime-request): Send the right information in the - 'Host' header field when going through a proxy. - (url-setup-reload-timer): Emacs 19 doesn't deal well with 0-length - timeouts, so protect against trying to create one when dealing with the - refresh header. - -* w3-parse.el: Removed lots of crap for the old display engine - shouldn't - cons up as much garbage as before. Now it will just cons up garbage - that we actually need. - -Tue Dec 17 07:10:47 1996 William Perry <wmperry@aventail.com> - -* css.el (css-properties): New property type 'string-list' for font-family - -* w3.el (w3-find-default-stylesheets): Make sure to look in - data-directory/../../w3 for stylesheets - -Tue Dec 17 06:07:08 1996 William M. Perry <wmperry@aventail.com> - -* w3-toolbar.el: wrapped a condition-case around the require for - xpm-button and xbm-button so that it will compile under Emacs - -Mon Dec 16 08:19:40 1996 William Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.38 released. - -* dist.Makefile (OBJECTS): Removed xpm-button and xbm-button from the - distribution. Any version of XEmacs that can run the latest 3.0 stuff - has them already. - -* default.css: Make nested ol/ul items display class 'line' so they look - prettier. - -* w3-display.el (w3-display-node): EVIL hack to make the first item in a - nested list get indented correctly. - -* w3-about.el (w3-about): Fixed the about:style stylesheet to be - up-to-date with new CSS spec. - -* default.css: Turned down indentation on list items by default. - -* w3-display.el (w3-display-node): Mouse tracking should work under XEmacs - again. - -* dist.Makefile (all): Removed 'emacs' from dependency list. - -Mon Dec 16 06:03:14 1996 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-table-hack-borders): This should work on TTY's again. - -Sun Dec 15 14:19:53 1996 William M. Perry <wmperry@aventail.com> - -* Emacs-W3 3.0.37 released - -* w3-display.el: Better handling of paragraphs (well, any block-level - element within a list-item display group. - -* default.css (address): Changed <address> display tpye to line so that - right-justification will take effect. - -Sat Dec 14 10:24:13 1996 William M. Perry <wmperry@aventail.com> - -* w3-sysdp.el: Removed stubs for add-submenu - it was confusing 'custom' - -* dist.Makefile: More GNU-ish project makefile - -* url.el (url-default-find-proxy-for-url): Fixed no_proxy handling -(url-default-find-proxy-for-url): Don't pass 'www://' links to a proxy - -Fri Dec 13 22:50:45 1996 William M. Perry <wmperry@aventail.com> - -* dist.Makefile (URLSOURCES): Added socks.el to the distribution. Not - used just yet. - -* css.el (css-copy-stylesheet): Fixed problem with sharing the list - structure between the hash tables - document stylesheets would infect - the main w3-user-stylesheet and cause weirdness. - -Fri Dec 13 09:47:40 1996 William Perry <wmperry@aventail.com> - -* w3-style.el (w3-display-stylesheet): Fixed problem where - w3-display-stylesheet would override the buffer css-display was showing - the stylesheet in. Duhh. - -* mule-sysdp.el (mule-encode-string): Fixed stupid problem on non-XEmacs - mule - (mule-sysdep-version): Ditto. - -Fri Dec 13 06:25:45 1996 William M. Perry <wmperry@aventail.com> - -* css.el (css-get): Removed bogus recursive call to css-get, and moved the - guts of css-get out into its own fuction, which is in turn inlined into - css-get. Might even make things faster. At the least, I expect it to - get rid of the 'takes two makes to make w3-display.elc' problem some - people have been seeing. - -* w3-display.el (w3-display-handle-list-type): Fixed stupid problem with - margin handling where list-item display items were always flush-left - -Fri Dec 13 02:51:24 1996 Greg Stark <gsstark@mit.edu> -* w3-display.el (w3-display-line-break): correct right justification code - (w3-min-size-of-string): removed unused function that didn't work. - (w3-size-of-tree): maintain consistent w3-display-open-element-stack - don't hard code assumption that hr's are drawn with '-' - (w3-display-table-dimensions): major bug if the last column rowspans - (w3-table-lookup-char): new function - (w3-table-hack-borders): new function makes table borders use pretty - graphic characters instead of ascii characters. - (w3-table-unhack-borders): new function restore lame ascii borders. - (w3-display-table): Major changes to support drawing better borders - also fix various bugs and tweak various things. - -* w3-parse.el: remove = from set of characters that terminate an attribute - when guessing about an syntactically invalid attribute. - (didn't this get changed once already?) - -* w3.el (w3-sentinel): hack around bug that bit w3-preview-this-buffer - but I don't know what the right thing for Mule. - -Thu Dec 12 08:36:01 1996 William Perry <wmperry@aventail.com> -* Synch'd up to widget 1.13 - -* w3-display.el (w3-get-pad-string): Ack - watch for negative values in - w3-get-pad-string - -* Released 3.0.36 - -* w3-style.el (w3-display-stylesheet): Use new css-display function - -* css.el (css-get): Better class checking - (css-display): New function to pretty-print a stylesheet that is in - memory. - -* w3-parse.el (w3-parse-buffer): *sigh* Parser now keeps track of 'base' - of this document. Also normalizes 'align' attribute, as well as - auto-expanding any SRC or HREF attributes. - -* w3-display.el (w3-display-handle-list-type): Now handles text-indent - style property. - (w3-display-table): Can now specify properties on 'tr', for - vertical-alignment, etc. - (w3-display-node): Lots of changes to deal with new method of munging - class/align/etc in the parser. - -Wed Dec 11 17:37:14 1996 William M. Perry <wmperry@aventail.com> - -* w3-parse.el (w3-parse-buffer): Do munging of align/src/href/class - attributes to save time in w3-display-node and friends. - -* w3-prefs.el (w3-preferences-compatibility-variables): Fixed problems - with renaming of w3-style-ie-compatibility to css-ie-compatibility - -* w3-display.el (w3-display-node): fix for hyperlinks / form info in - tables. Duhh. - -Wed Dec 11 07:36:08 1996 William Perry <wmperry@aventail.com> - -* css.el (css-copy-stylesheet): New function - -* w3-display.el (w3-display-node): use it - -* mule-sysdp.el (mule-encode-string): Fixes for XEmacs w/mule -(mule-decode-string): Fixes for XEmacs w/mule - -* w3-display.el (w3-display-node): Fixed problem in isindex handling. - Using forms for isindex handling should work again. - -* css.el (css-specificity): new function css-specificity to find how - specific a certain rule is. Need to use this to sort rules in css-get. - -Tue Dec 10 22:37:59 1996 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-get-style-info): Changes to deal with new css.el - - should be much much faster now. - -* css.el (css-get): Radically changed the internal representation of - stylesheets, and how they are looked up. - -Mon Dec 9 22:31:11 1996 William M. Perry <wmperry@aventail.com> - -* w3-display.el (w3-face-for-element): Fixed bug in w3-face-for-element - where weight of the element wasn't being taken into account. - -* css.el: Changed font-variant style type from string to symbol-list - -Mon Dec 9 12:29:59 1996 William Perry <wmperry@aventail.com> - -* default.css: Changed default header sizes - should look better on most - machines - -Sun Dec 8 19:21:07 1996 William M. Perry <wmperry@aventail.com> - -* Emacs-w3 3.0.34 Released - -* w3-display.el: New macro w3-get-attribute to replace - (cdr (assq 'blah args)), just in case I ever decide to replace the - assoc list currently used. - -* New file mule-sysdp.el, to make supporting Mule 2.3, Mule 2.4, and - XEmacs 20.0 easier. - -* url-file.el (url-insert-possibly-compressed-file): handle mule 2.4 - -Fri Dec 6 06:54:03 1996 William Perry <wmperry@aventail.com> - -* w3-parse.el: Emit warnings when people try to slap attribute/value pairs - on end tags. Evil bastards. - Added SPAN, BDO, OBJECT, BASEFONT - -Fri Dec 6 04:42:24 1996 Greg Stark <gsstark@mit.edu> - -* default.css: add th td and caption text-align information - -* docomp.el: increase max-specpdl-size so it can compile w3-display - -* url.el (url-sentinel): avoid save-excursion around switch-buffer - -* w3-display (w3-display-line-break): if we're in nowrap mode but the - region doesn't end on a newline insert an extra newline, otherwise <br> - gets ignored inside a <pre> or nowrap environment. - Also protect against fill-column less than the length of fill-prefix. - Also avoid infloop in right justification, and - fix bug that caused right justification to never be executed. - -* w3-display (table-cut table-dimensions w3-display-table): - lots of new code to handle rowspan and autolayout. - -* (w3-display-fix-widgets): be more agressive adjust even markers that have - buffers and adjust parent markers. - -* w3-display (w3-display-node): These changes are important for tables - Don't insert insert-before on <a> tags before the class is adjusted - Don't insert more than one class into an <a> tag when we adjust it. - Protect against a negative fill-column when drawing <hr>s - Set adaptive-fill-mode (what's filladapt-mode?) - -* w3-parse.el: remove font from %block. WARNING, i have little idea what - consequences this has but it seems to have the desired effect of - handling table cells whose first tag is a <font> without discarding the - implied <p> tag. - -* w3-parse.el: skip-chars-forward "^>" when parsing end tags - (some people seem to think you can put attributes in end tags) - -Fri Dec 6 14:08:30 1996 William M. Perry <wmperry@cs.indiana.edu> - -* css.el: Better handling of text-decoration, to go along with the new version - of set-font-style-by-keywords - -* font.el: Faster version of set-font-style-by-keywords. - Fixed RGB spec. problem if you used non-floats. - -* w3-display.el: (w3-face-for-element) Obey some font function renaming. - (w3-face-for-element) Changed format specification on w3-style-face-xxx - creation. - (w3-display-node) Alignment specified via attributes overrides - stylesheet, not vice versa. - (w3-display-node) Fixed stupid mistake in 'link' handling where - stylesheets were ignored. - -Thu Dec 5 17:51:37 1996 William M. Perry <wmperry@cs.indiana.edu> - -* url.el: (url-retrieve-internally) Can now specify an alternative - function to determine whether a URL should be proxied or not. modelled - off the netscape auto-proxy-configuration crap, so hopefully someday we - can just suck down one of their files and be 'happy' with it. - -* w3-display.el, css.el: - Modified some of the css properties to not be inherited - let - w3-display figure it out on its own - quicker this way. Saves a few - thousand lookups over the life of a parse. - -Mon Dec 2 20:22:12 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-display.el: use better face names... avoids problems in xemacs - resource name checking. - -* w3-vars.el: Created version 3.0.33 - -* w3-parse.el: Fixed problem parsing attribute values like <img alt=''> - - the regexp didn't like empty attribute values specified with single - quotes. - -* w3.el: -Patches from Dave Love - -* font.el: Renamed the font-set-*-p to set-font-*-p, to be more in line with -set-face-underline-p and friends. Fixed stupid problem in -set-font-*-p where it would always just toggle the property, not -actually set it. Blah. Added code in x-font-create-name to try -oblique and italic versions of a font if italic is set. - -* default.css: Prettied up the :speech: section - -* w3-display.el: -Conditionalized get-style-info calls in w3-voice-for-element on -feature 'emacspeak - -* w3.el: Added code to try loading dtk-css-speech and w3-speak if the feature -'emacspeak' is available. - -* css.el: Fixed a few stupid problems. - -* font.el: -made tty-font-create-object return a 12pt font object, just for reference. - -* w3.txi: More updates to the documentation - -* w3.el, w3-style.el: Moved to using the new 'css' package - -* w3-parse.el: -Removed some old functions. Save some string creation by downcasing -tag and atribute names in the buffer instead of using 'downcase'. - -* w3-display.el: Moved to using the new 'css' package - -* w3-auto.el: Removed some outdated autoloads - -* font.el: Added function font-set-style-by-keywords - -* css.el: Better handling of various entities - beter way of specifying new -properties and how they should be handled. - -* default.css: *** empty log message *** - -* dist.Makefile: Added 'css.el' to targets - -* css.el: Initial revision - -* w3-vars.el: Renamed w3-right-border to w3-right-margin - -Sat Nov 30 17:42:38 1996 William M. Perry <wmperry@cs.indiana.edu> - -* custom-edit.el, custom.el, widget-edit.el, widget.el: --Synch'd up to Custom/Widget 1.09 - -Fri Nov 29 23:12:42 1996 William M. Perry <wmperry@cs.indiana.edu> - -* font.el: Actually try to use the 'oblique' property under X - -* w3-display.el: -Fix for sometimes getting an invalid glyph error in image retrieval. -Fixed problem where table display would pop something off the open element stack. - -* custom-edit.el, custom.el, widget-edit.el, widget.el: --Synch'd up to Custom/Widget 1.08 - -* w3-display.el: List filling seems to line up correctly now. -Fixed bug in ordered list handling (wrong arg passed to a format). -Changed the way spacing is handled. - -* w3-menu.el: Added new 'search' menu with common web indexes - -* dist.Makefile: -Don't specify widget*.el twice in SOURCES _AND_ CUSTOMSOURCES or -install under FreeBSD chokes. - -* w3-display.el: Protect against list-item display property outside of a list. - -* w3-sysdp.el: Fixed free var reference in make-device - -Thu Nov 28 23:01:11 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-display.el: -Protect against bad values of w3-last-fill-pos in w3-display-line-break - -* w3-e19.el, w3-menu.el: --Patches from Dave Love <d.love@dl.ac.uk> for using title of link in menus - -Wed Nov 27 22:59:56 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.32 - -* w3.txi: Started revamping some of the documentation - -* url-custom.el: Initial revision - -* w3-display.el: Handle 'menu' list type correctly - -* url.el: Patch from Thierry.Emery@aar.alcatel-alsthom.fr; -- insert information about processes in buffer "URL Status Display" - instead of *URL-<i>* : added a local variable `url-status-buf' and a - call to `set-buffer' - -- changed `url-get-working-buffer' to `url-get-working-buffer-name', - because `url-working-buffer' is expected to be a name, not a buffer - (my mistake) - -* w3-xemac.el, w3-vars.el: -Removed some old variables that aren't used anywhere now. - -* w3-e19.el: -Patch from Dave Love <d.love@dl.ac.uk> for 'title' version of w3-echo-link. - -* w3-display.el: -Patch from Dave Love <d.love@dl.ac.uk> for 'title' version of w3-echo-link. -Form info is now stuck on a stack instead of in a let-bound variable. -Only call w3-display-fix-widgets once! recursive calls to -w3-display-node when rendering tables caused it to happen more than it -should. - -* w3-forms.el: -Patch from Dave Love <d.love@dl.ac.uk> to protect against bad value -for 'next' in w3-next-widget. - -* dist.Makefile: Don't use `install -d', use mkdir -p if necessary - -Tue Nov 26 16:21:32 1996 William M. Perry <wmperry@cs.indiana.edu> - -* custom-edit.el, custom.el: synch'd up to custom 1.05 - -* widget.el, widget-edit.el: *** empty log message *** - -* widget-edit.el, widget.el: synch'd up to widget 1.05 - -* w3-display.el: Handles the 'dir' list type correctly now. - -* url.el: -Quick patch to check for url-working-buffer being a buffer, not a string. - -* w3-display.el: -Backed out _BAD BAD BAD_ change to protect against invalid values for -w3-last-fill-pos that basically fucked everything in regards to -vertical whitespace. - -Mon Nov 25 21:12:17 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-display.el: *** empty log message *** - -* w3-display.el: -Now only does incrememental display around block level elements. -Does better munging of pre-formatted text CR -> LF CRLF->LF, etc. - -* w3.el: Protect against errors in w3-sentinel on bad buffers. - -* w3-vars.el: Created version 3.0.31 - -* widget-edit.el: Fixed compile problems under emacs - -* w3-vars.el: *** empty log message *** - -* widget.el: Made widget.el compile in emacsen w/o native backquote support - -* w3-display.el: *** empty log message *** - -* w3-parse.el: -Patch from greg stark for dealing with '=' in misquoted attribute value pairs - -Sun Nov 24 23:25:25 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-display.el: Reimplemented targetted anchors (#foo) - -* url.el: *** empty log message *** - -* url-vars.el: -Changed default of url-mime-language-string to '*' to make some sites happy. - -* w3-display.el: Protect against w3-last-fill-pos getting an invalid position - -* w3.el, w3-display.el, w3-vars.el: -Patch from Dave Love <d.love@dl.ac.uk> to add new possibility 'title' -to w3-echo-link to show the 'title' attribute of a link if its there. - -* w3-speak.el: Patch from raman. - -* font.el: -Patch from nagae@mickey.ai.kyutech.ac.jp to handle fontsets correctly in mule - -* w3-display.el: Implemented a few more CSS properties. -list-style - control how list items are displayed. Ordered lists are - now different from unordered only in their list-style. - Need to implement contextual selectors to get ordered - lists to work out of the box though. -white-space - control whether whitespace is collapsed or not, and - whether text is wrapped. <pre> <xmp> and <plaintext> - are now all specified to use this in the default - stylesheet. -text-align - this replaces the old 'align' attribute - -Reimplemented inlined styles. - -* default.css: Varius updates to take advantage of the new CSS properties -white-space, list-style, etc. - -* w3-style.el: Handle url() and rgb() notation in color specifications - -* w3-vars.el: Removed a few outdated variables - -Sat Nov 23 02:10:37 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-display.el: *** empty log message *** - -* dsssl.el: Got rid of yet more compilation warnings. - -* custom.el, custom-edit.el: Synch'd up to custom 1.0.1 - -* w3-display.el: -Better handling of <hr> and <center>, and line spacing in general - -* default.css: Updates to default stylesheet to deal with <center> and <div> - -* w3.el, url.el, url-vars.el, url-http.el: -Patches from Thierry Emery to allow multiple asynch fetches. - -Fri Nov 22 22:26:35 1996 William M. Perry <wmperry@cs.indiana.edu> - -* widget-edit.el, widget.el: -Synch'd up to widget 1.01 - -* w3-style.el: Fixed a few fRemoved a few free variable sets/refs - -* w3.el: -When saving a document as html source, try to get into the 'head' before inserting the base. - -* w3-display.el, w3-style.el: -Stylesheets now store all there information as property lists instead -of assoc lists. Just easier. - -* font.el: Fix for font-normalize-color under nextstep - -Thu Nov 21 04:01:22 1996 William M. Perry <wmperry@cs.indiana.edu> - -* widget-edit.el, widget.el: synch'd to 1.00 of widget/custom - -Mon Nov 18 16:26:06 1996 William M. Perry <wmperry@cs.indiana.edu> - -* install.sh: Initial revision - -* html32.dsl: Updated to latest from jon bosak - -* w3-vars.el: Created version 3.0.30 - -Thu Nov 14 22:39:36 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3.el: Changed this so you can actually just do a (require 'w3-sysdp) and -each function will check to see if it should overwrite, instead of -conditionalizing that on the whole file. - -* url.el: *** empty log message *** - -* images.el, font.el, docomp.el, w3-sysdp.el: -Changed this so you can actually just do a (require 'w3-sysdp) and -each function will check to see if it should overwrite, instead of -conditionalizing that on the whole file. - -* w3-display.el: Moved some macros around. - -* widget.el, widget-edit.el, w3-forms.el: Sync'd up to Widget 0.999 - -* w3-auto.el, w3-menu.el: *** empty log message *** - -Sun Nov 10 18:08:24 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.29 - -* dsssl.el: Various changes, starting on the actual flow object stuff - -Tue Nov 5 05:26:07 1996 William M. Perry <wmperry@cs.indiana.edu> - -* url-news.el: Updated version checking of news to deal with 'red' gnus - -Mon Nov 4 14:47:47 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-display.el: Don't show the content of 'script' - typo - -Fri Nov 1 15:08:45 1996 William M. Perry <wmperry@cs.indiana.edu> - -* default.css: Changes from raman - -Thu Oct 31 18:51:52 1996 William M. Perry <wmperry@cs.indiana.edu> - -* widget-edit.el: - - -Tue Oct 29 19:53:38 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-display.el: *** empty log message *** - -Thu Oct 24 02:25:03 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-widget.el: Updated the image widget to the new widget stuff. - -Wed Oct 23 13:26:09 1996 William M. Perry <wmperry@cs.indiana.edu> - -* docomp.el: *** empty log message *** - -* url.el: Fixed bug in url-remove-relative-links that would choke on something -like: /foo/bar/./../baz/ - they /../ was removed first, removing its -parent directory, the /./ - ack. - -* w3-display.el: Image loading is back! -Client-side imagemaps are back! -Forms that span tables are working now. - -Mon Oct 21 21:32:33 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.28 - -* url-mail.el: Make mail handling a little more generic. - -* w3-display.el: -Fix for w3-display-fix-widgets so that links right up against each -other don't cause it to skip every-other-one. - -Sun Oct 20 16:47:05 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-style.el: don't map a pitch of 9 to 0. - -* w3-speak.el: -Added back in the advice for url-lazy-message that provided auditory -feedback during URL retrieval. Also added back in the -w3-speak-browse-page command. - -* w3-speak.el: -Some patches from TV Raman to fix multiline text entry area speaking -and a bogus call to widget-get in text entry area speaking. - -Fri Oct 18 12:27:04 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-display.el: -Patches from Thierry Emery <Thierry.Emery@aar.alcatel-alsthom.fr> to -implement 'colspan' on tables. Patch to support align=xxx on -arbitrary tags. - -Thu Oct 17 22:27:44 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.27 - -* w3-display.el: -fixed voicification of hyperlinks. Fixed problem in w3-normalize-spaces -and multi-line strings. - -Wed Oct 16 20:56:40 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-speak.el: Fix stupid problem. function renaming lossage. Fun - -* w3-display.el: -Fixed <select> form items that had no <option value=xxx selected> -entry in them. Wheee. - -* w3-display.el: -Fixed <select> form items that had an <option value=xxx selected> -entry in them. Wheee. - -* w3.el: document info is now shown as a table. - -* w3.el: Document information is now shown as a table. - -* w3-display.el, w3-vars.el: Now keeps better track of the <meta> tag info - -* w3-vars.el: Created version 3.0.26 - -* w3-display.el: *** empty log message *** - -Tue Oct 15 13:21:54 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-display.el: Added back in <meta> and <link> handling. -Fixed insert-before and insert-after for 'a' tag and pseudo-classes - -* w3-display.el: -Fixed some potential runaway style inheritance - need to think about a -better way to pop style info off the various stacks than -(w3-handle-content node) on an empty element. - -* w3-display.el: Fixed <textarea> elements in forms - -* w3-display.el, w3-forms.el: Fixed <select> elements in forms - -Sun Oct 13 23:50:03 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.25 - -* dsssl.el: Bug fixes - -* url-hash.el: -Fixed bug in url-gethash where it wasn't honoring the 'default' parameter - -Sat Oct 12 20:32:49 1996 William M. Perry <wmperry@cs.indiana.edu> - -* widget.el, widget-edit.el: Synched up to widget 0.99.4 - -Fri Oct 11 18:55:02 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-display.el: fix for xemacs w/ temp faces - -* w3-display.el: Fixed a bug with the insert-after handling. Duhh. - -* default.css, w3-display.el: Implemented insert-before and insert-after - -Wed Oct 9 19:00:59 1996 William M. Perry <wmperry@cs.indiana.edu> - -* ssl.el, url-cookie.el, url-file.el, url-gopher.el, url-hash.el, url-http.el, url-irc.el, url-mail.el, url-misc.el, url-news.el, url-nfs.el, url-parse.el, url-pgp.el, url-vars.el, url-wais.el, url.el, urlauth.el, w3-about.el, w3-annotat.el, w3-display.el, w3-e19.el, w3-emulate.el, w3-forms.el, w3-hot.el, w3-imap.el, w3-keyword.el, w3-latex.el, w3-menu.el, w3-mouse.el, w3-mule.el, w3-parse.el, w3-prefs.el, w3-print.el, w3-speak.el, w3-style.el, w3-toolbar.el, w3-vars.el, w3-widget.el, w3-xem20.el, w3-xemac.el, w3.el, xbm-button.el, xpm-button.el, base64.el, dsssl.el, font.el, images.el, md5.el, mm.el: --Updated copyrights/addresses - -Tue Oct 8 14:56:22 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-display.el: Tables now default to having no border - -* w3-forms.el: Require w3-vars so Gnus will work - -* w3-vars.el: Created version 3.0.24 - -* w3-speak.el: -Added a few patches from raman and the latest version of emacspeak - -everything appears to work out of the box now. - -* w3-style.el: -Added in a few autoloads for getting emacspeak to work right out of the box. - -* w3-display.el: Added back in the :help-echo stuff on widgets - -Mon Oct 7 18:09:17 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-display.el: -<isindex> works again. Automatically turns off filladapt-mode now, -since we apparently don't play well together. - -* default.css: Added some margins - -* w3-display.el: Fix for emacs 19 - -Fri Oct 4 17:08:51 1996 William M. Perry <wmperry@cs.indiana.edu> - -* dsssl.el: -Fixed a few errors in calling w3-dsssl-check-args. Now _EVERYTHING_ -compiles cleanly. - -* docomp.el: Added a few more variables to the 'expected-to-be-free' list. -Everything but dsssl.el compiles cleanly now. - -* url-news.el: Fixed a few typos that resulted in free variable references. - -* w3-display.el: New function w3-make-face to 'do the right thing' in -Emacs/XEmacs/Emacs-with-no-X-support. -Implemented margin-left and margin-right. -Fixed a few problems with runaway or insufficient application of styles. - -Mon Sep 30 19:43:35 1996 William M. Perry <wmperry@cs.indiana.edu> - -* url-hash.el: -Nasty hack to fix the !! error (("file \"cl-extra\" didn't define \"gethash\"")) stuff people are seeing under Emacs-19 - -* w3-vars.el: Created version 3.0.23 - -* w3-prefs.el: Updates for new widget package - -* w3-display.el: -No more recursion! Lots more shit broke though. Lists are totally broken. - -* w3.el: Updates for new widget package - -* w3-keyword.el: *** empty log message *** - -Sun Sep 29 21:26:47 1996 William M. Perry <wmperry@cs.indiana.edu> - -* widget.el, widget-edit.el: Updated to version 0.99 of the library - -* widget-edit.el: Allow the :help-echo widget stuff to be a symbol - -* w3.el: More updates for the latest widget package - -* w3-sysdp.el: New functions prepend-text-property, append-text-property, -fillin-text-property - -* default.css, url.el: *** empty log message *** - -Wed Sep 25 10:53:08 1996 William M. Perry <wmperry@cs.indiana.edu> - -* dist.Makefile: Removed custom.el and custom-edit.el from the distribution. - -Tue Sep 24 05:04:47 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.22 - -* widget.el, widget-edit.el: Updated to latest widget stuff from Per. - -* w3-parse.el: -Added <script> to %body.content so that stupid IE 3.0 demo pages would work. - -* w3-keyword.el: -Added some new keyword defs to get rid of compile-time warnings - -* w3-forms.el, w3-display.el: Now works with newest widget stuff - -* url.el: New function url-parse-query-string, to return an assoc list of name -value pairs from a URL-style query. url-unhex-string now takes an -optional second argument for whether to allow decoding of newlines or -not. - -* url-mail.el: -Now understands netscape-style 'extensions' to the mailto: specifier. -ie: mailto:wmperry?subject=thesubject&bcc=root - -* font.el: -Now always converts to points instead of pixels, seems to give better -results this way. - -Mon Sep 23 04:53:56 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.20 - -* dsssl.el: Made dsssl depend on url-hash - -Sun Sep 22 05:16:06 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-display.el, w3-parse.el: *** empty log message *** - -* w3-display.el: Some spacing changes, fix for nested lists - -* custom.el, widget-edit.el, widget.el: - - -* custom-edit.el: *** empty log message *** - -Fri Sep 20 05:07:12 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.19 - -* w3-display.el: *** empty log message *** - -* w3-sysdp.el: Added in stub for set-keymap-parents - -* w3-speak.el: Patches from raman - -* w3-prefs.el, w3-imap.el: *** empty log message *** - -* w3-hot.el: Fixed w3-read-html-bookmarks to work with some parser changes. - -* w3-forms.el: Made forms work again. - -* w3-display.el: Changed how the borders on tables are drawn. -Added back in the voice support. - -Thu Sep 19 05:12:49 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.18 - -* dist.Makefile: -Moved the URL and W3 packages back into one big distrubtion again - -* w3-vars.el: Created version 3.0.18 - -* w3-vars.el: Created version 3.0.19 - -* w3-display.el: Don't crap out on tables with 0 columns - -* docomp.el, url.el: *** empty log message *** - -Wed Sep 18 12:50:03 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.18 - -* docomp.el: *** empty log message *** - -* w3-display.el: Space filling fixes - -* w3-auto.el: Added autoload for w3-style-post-process-stylesheet - -Tue Sep 17 12:50:47 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.16 - -* w3-display.el, w3-e19.el: *** empty log message *** - -Mon Sep 16 04:46:18 1996 William M. Perry <wmperry@cs.indiana.edu> - -* custom-edit.el, custom.el, widget-edit.el, widget-example.el, widget.el: -Initial revision - -Sun Sep 15 22:47:53 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.15 - -* w3-display.el: Alignment stuff works (right, left, full, center). -Tables can now be borderless, and if it has borders, they are all there. -<pre>/<xmp> work. - -* url-vars.el: Created version 1.0.42 - -* url-http.el: *** empty log message *** - -* w3-vars.el: Created version 3.0.14 - -* html32.dsl: Initial revision - -* w3.el: Use the new display code. - -* w3-forms.el: A few changes for the latest display code - -* w3-vars.el: Created version 3.0.14 - -* w3-display.el: Actually mostly works - -* w3-parse.el: Removed hooks into the old display engine - -* url.el: *** empty log message *** - -* w3-speak.el: Update from raman - -* url.el: *** empty log message *** - -Sat Sep 14 16:48:24 1996 William M. Perry <wmperry@cs.indiana.edu> - -* url-gopher.el, url.el: -Added '...' to the downloading messages so that they do not show up in -the message log buffer under Emacs 19.xx - -* w3-parse.el: Changed content-model of <script> to fix problems on some sites -(notably netscape's) that use an unescaped </ in the script. BAD SGML -DAMMIT. - -Fri Sep 13 05:24:53 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.13 - -* w3-forms.el: Use the new :ignore-case stuff for choice items - -Thu Sep 12 05:57:47 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-display.el: Holy shit tables work. - -Tue Sep 10 03:11:55 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-speak.el: Bug-fixes from raman. - -Mon Sep 9 05:18:37 1996 William M. Perry <wmperry@cs.indiana.edu> - -* dsssl.el: -Removed a few compiler warnings and fixed a few bugs (equal, error, time - -* dsssl.el: -DSSSL (define ...)'d functions are now called correctly. Wow. Added -in most of the rest of the DSSSL(o) application profile functions. - -* dsssl.el: Initial revision - -* w3-parse.el: *** empty log message *** - -* w3-about.el, w3-annotat.el, w3-draw.el, w3-e19.el, w3-emulate.el, w3-forms.el, w3-hot.el, w3-imap.el, w3-keyword.el, w3-menu.el, w3-mouse.el, w3-mule.el, w3-prefs.el, w3-print.el, w3-speak.el, w3-style.el, w3-toolbar.el, w3-vars.el, w3-widget.el, w3.el, w3-xemac.el, images.el: -Changed copyright assignment - -* font.el: changed copyright assignment - -Sun Sep 8 00:31:52 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-draw.el: -Added in a stub handler for the 'frame' tag, so that you can still get -to frame pages written by idiots who don't use a decent 'noframe' -subdocument. - -* url.el: Removed nntp-after-change-function, since it screwed up GNUS - -Sat Sep 7 01:45:17 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-latex.el: updated email address for stephen peters - -Wed Sep 4 02:09:08 1996 William M. Perry <wmperry@cs.indiana.edu> - -* socks.el: Initial revision - -Sun Sep 1 16:22:50 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-draw.el: Don't load images on a TTY device in XEmacs. General speedup - -Thu Aug 29 04:09:40 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.12 - -Sun Aug 25 17:12:32 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-draw.el: Added some stubs for tables - -Mon Aug 19 03:30:47 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3.el: fixed bug in w3-insert-formatted-url - -Mon Aug 12 03:10:30 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-style.el: Don't make a null voice of paul-5555 if no stuff is specified. - -* default.css: Added speech elements to the default stylesheet. - -Sun Aug 11 16:41:58 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.11 - -* font.el: -Fix for font-default-font-for-device under XEmacs when you use a font -like '10x20' instead of the fully specified version - -Sat Aug 10 16:14:08 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-forms.el: -Do not encode the '.' in application/x-www-form-urlencoded. Fucking -netscape compatbility. What _SPEC_?! There aren't any specs on the -web, right?! - -* w3-forms.el: -Fixed problem with submissions of a form with the exact same arguments -causes elements from both form to be submitted. ack. - -Tue Aug 6 14:03:52 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-parse.el: -fixed stupid mistake in DTD I made when changing to 3.2 DTD - left -'style' out of head's content-model so no in-document stylesheet stuff -was getting parsed. gack. - -* w3-forms.el: No longer put a 'choose' in front of option menus - -* w3-speak.el: fixed bugs - -Mon Aug 5 14:03:09 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.10 - -* default.css: A few mild changes, and docs. - -Sun Aug 4 23:51:26 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-speak.el: new version of w3-speak from raman - -* w3-draw.el: Style search alg. now looks for tag/id|name first. Now supports -inlined 'style' keyword on any tag. Gack *sigh* - -* w3-style.el: -Can now have periods in class names. Fixed bug where the class would -be normalized to lowercase as well as the tag name. BAD BAD BAD. - -* w3-speak.el: some changes from raman - -* w3-style.el: Think I finally fixed some stylesheet weirdness - -* w3.el: Don't override user prefs w/w3-user-colors-take-precedence -duh - -* w3-parse.el: fixed graphical entities - -Sat Aug 3 20:09:50 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: -Added textual representation of the 'artist formerly known as prince' -graphical icons - -* md5.el: removed /bin/sh dependency in md5 - -Fri Aug 2 14:08:38 1996 William M. Perry <wmperry@cs.indiana.edu> - -* url-vars.el: Created version 1.0.41 - -* url.el: -no longer special case file:// urls when checking for no_proxy - thats -just stupid. - -Thu Aug 1 13:32:54 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-vars.el: Created version 3.0.9 - -* url.el: made url-insert-file-contents interactive - -* w3-sysdp.el: -added data-directory to sysdep version of x-library-search-path for -emacs under windows 95/nt - -* w3-vars.el: -Implemented &prince; and &princesymbol; graphical entities. Thanks -for the note Jamie Z! - -* w3-forms.el: fix for gopher searches - -* w3-draw.el: Added support for balloon-help - -Fri Jul 26 05:57:21 1996 William M. Perry <wmperry@cs.indiana.edu> - -* w3-display.el, w3-texinfo.el: Initial revision diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/FAQ --- a/lisp/w3/FAQ Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,176 +0,0 @@ -Q: Options menu is ugly under Emacs 19 -A: Wait for 19.35 - this is because of a 'feature lack' in easymenu.el - -Q: Animated GIFs cause XEmacs 19.14 or 20.0 to crash -A: There was a bug in the GIF decoding routines in XEmacs 19.14 - please - upgrade to XEmacs 19.15 or later. - -Q: I get an error when starting up: - Symbol's function definition is void: custom-declare-group -A: This usually means you compiled W3 in an emacs that could not find - the 'custom' package (or found an old version), but are running W3 - in an emacs that find the new one. This is usually the case if you - have a recent version of GNUS installed in a non-standard place. - - Make sure that you can load the custom library when compiling - emacs. Set the environment variable WIDGETDIR to where your custom - library lives (ie: ~/lisp/gnus/lisp) - -Q: W3 under OS/2 is incredibly slow -A: This appears to be a problem with how fonts are looked up. Thanks - to chang@wsu.edu for this analysis. - - In OS/2, the font name default to forms like - - "-*-Courier-medium-r-normal--*-100-*-*-m-*-cp850" ...... [1] - or - "10.Courier" - - In these two cases, font detection fails because this does not - match x-font-regexp. - - To solve this, set the default font as - "-*-Courier-medium-r-normal--*-100-*-*-m-*-cp850-1" - -Q: I like being warned about invalid HTML on my own pages, but how can - I make Emacs/W3 stop telling me almost everything on the Web is - invalid? -A: You can use the 'file preparation hook', which is run before any - parsing is done. - - (defun my-w3-file-prepare-hook () - (setq w3-debug-html - (if (or (string= (url-type url-current-object) "file") - (string-match ".*\\.some\\.domain\\.name" - (or (url-host url-current-object) ""))) - 'style - nil))) - (add-hook 'w3-file-prepare-hook 'my-w3-file-prepare-hook) - - This will turn on stylistic warnings for any local HTML files or - files loaded from the `*.some.domain.name' domain. - -Q: How do I make emacs scroll the window horizontally when tabbing - through links? -A: XEmacs: - (add-hook 'w3-mode-hook '(lambda () (auto-show-mode 1))) - - Emacs (if you have hscroll.el from ftp:// ?????): - (autoload 'turn-on-hscroll "hscroll" nil t) - (add-hook 'w3-mode-hook 'turn-on-hscroll) - -Courtesy of greg stark <gsstark@mit.edu> -Q: How do i get Shift-Tab to go backwards on a text terminal or XTerm? -aka: I hate the new text widgets, I can't go through the links with n and b - I can go forward using TAB but how do i go backward on a terminal? - -A: Not all terminals can distinguish between a shifted tab and an unshifted -tab at all. Tab is indicated on a text terminal by a control-i. There is no -such thing as capital control characters, so if the terminal is going to -indicate a shift-tab somehow it has to be completely differently. The most -appropriate thing to use is probably "backtab" which on old text terminals was -sometimes a separate key and Emacs is already set up to recognize -automatically if it exists. - -Making "backtab" work involves several steps. First you have to make sure your -console generates some character sequence to indicate the key you want to -generate a "backtab". Then you have to configure termcap or terminfo to -recognize that key sequence. Then you may have to make your programs do useful -things when they get a "backtab", Emacs for example will recognize it -automatically but except for the Widget and W3 commands nothing is ever bound -it it. - -Step 1 On An XTerm: XTerm obeys standard X Toolkit translations which you can -use to specify what character sequence Shift-Tab generates. The following X -Resources will cause Shift-Tab and Meta-Shift-Tab to generate reasonable -character sequences. You can either put this in your .Xresources or .Xdefaults -file, or you can put it in /usr/lib/X11/app-defaults/XTerm to make it a -site-wide default. (On Debian systems you should put it in -/etc/X11/Xresources, not the app-defaults files): - -XTerm*VT100.translations: #override \ - ~Meta Shift<Key>Tab: string(\033[Z) \n\ - Meta Shift<Key>Tab: string(\033\033[Z) \n - -I recommend these sequences, they are based on what seems to be a more or less -standard sequence ^[[Z for backtab. - -Step 1 On Rxvt: By default Rxvt sends ^[[Z for Shift-Tab. -However, if Shift-Tab generates another keysym, like for example in XFree86 -3.2 where it's bound to ISO_Left_Tab then Rxvt will just ignore it. You would -need to defeat this feature to make rxvt work again by doing something like: - -xmodmap -e 'keysym Tab = Tab' - -or adding that command to some global X configuration file (On Debian systems -adding ``Keysym Tab = Tab'' to /etc/X11/Xmodmap or ~/.Xmodmap is sufficient) - -Step 1 On A Linux Virtual Console: on a Linux virtual console you can -configure what character sequences are generated by which keys using the -loadkeys command. Many systems are set up to run loadkeys automatically on -startup with some keymap file. On Debian systems this is true, the keymap file -is specified in /etc/kbd/config and usually lives in the -/usr/lib/kbd/keytables directory. You want to put something like the following -in your keytable file: - -keycode 15 = Tab F91 - alt keycode 15 = Meta_Tab - shift alt keycode 15 = F92 - -where keycode 15 is Tab on my keyboard (and probably any keyboard). This -defines Tab and Alt-Tab normally, and also defines Shift-Tab to be F91 and -Shift-Alt-Tab to be F92. - -Then put something like this: -# backtab and M-backtab -string F91 = "\033[Z" -string F92 = "\033\033[Z" - -later in the file. This defines what character sequence F91 (Shift-Tab) and -F92 (Alt-Shift-Tab) should generate. I recommend these sequences, they are -based on what seems to be a more or less standard sequence ^[[Z for backtab. - -Step 2 On A Termcap System: - -The termcap capability is kB, i'm not familiar with termcap tools, i think you -just need to add it to the /etc/termcap file for the terminal you're concerned -with as kB=\E[Z. - -Step 2 On A Terminfo System: - -The terminfo capability is kcbt (the long name is key_btab). You want to run -infocmp to generate an edittable copy of the terminal info. Add the -capability, then use tic to compile that information. Something like this: - -infocmp $TERM > info -emacs info & # add kcbt=\E[Z, to the file -tic info - -If you do this as root it should add the new definition to the system wide -terminfo database. If you do it as a normal user it should create a -~/.terminfo database with a local terminfo info definition for that terminal. - -Step 3 On Emacs: - -The standard terminal initialization should recognize the backtab capability -automatically. To test it try C-h c Shift-Tab and see what it calls the key. -To bind commands to it just use [backtab] in local-set-key or global-set-key -as in: - -(local-set-key [backtab] 'hippie-expand) -or -(global-set-key [backtab] 'hippie-expand) - -In the interest of maintaining a single consistent set of key bindings between -X and tty emacsen you may want to make equivalent X keystroke generate -"backtab" as well, you can do this by doing this: - -(define-key function-key-map [S-tab] [backtab]) -or -(define-key function-key-map [iso-lefttab] [backtab]) - -To make S-tab or whatever keystroke you made generate backtab on a terminal -be recognized as backtab under X11 as well. You can check how Emacs recognizes -this keystroke currently by doing C-h c <keystroke>. - - diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/Makefile --- a/lisp/w3/Makefile Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,117 +0,0 @@ -# where the w3 lisp files should go -prefix = /usr/local -infodir = $(prefix)/info -datadir = $(prefix)/share -lispdir = $(datadir)/emacs/site-lisp -confdir = $(datadir)/emacs/w3 - -# what emacs is called on your system -EMACS = emacs - -# How to install a file -INSTALL = install - -# Various other stuff used -RM = rm -f -CP = cp - -# Change this to be how to convert texinfo files into info files -# examples: -# $(EMACS) -batch -q -l texinfmt -f batch-texinfo-format -# makeinfo -MAKEINFO = makeinfo - -############## no user servicable parts beyond this point ################### -# Have to preload a few things to get a nice clean compile - -DEPS = -l ./docomp.el -l ./w3-vars.el - -# compile with noninteractive and relatively clean environment -BATCHFLAGS = -batch -q -no-site-file - -# files that contain variables and macros that everything else depends on -CORE = docomp.el - -URLSOURCES = \ - url-nfs.el url-file.el url-cookie.el url-parse.el url-irc.el \ - url-gopher.el url-http.el url-mail.el url-misc.el url-news.el \ - url-vars.el url-auth.el mm.el md5.el url-gw.el ssl.el base64.el \ - url.el socks.el url-cache.el url-ns.el - -CUSTOMSOURCES = # widget.el widget-edit.el -CUSTOMOBJECTS = $(CUSTOMSOURCES:.el=.elc) -URLOBJECTS = $(URLSOURCES:.el=.elc) - -SOURCES = \ - $(CUSTOMSOURCES) $(URLSOURCES) mule-sysdp.el w3-widget.el \ - devices.el w3-imap.el css.el dsssl.el dsssl-flow.el font.el \ - images.el w3-vars.el w3-cus.el w3-style.el w3-keyword.el \ - w3-forms.el w3-emulate.el w3-props.el w3-auto.el w3-menu.el \ - w3-mouse.el w3-toolbar.el w3-prefs.el w3-speak.el w3-latex.el \ - w3-parse.el w3-display.el w3-print.el w3-about.el w3-hot.el \ - w3-e19.el w3-xemac.el w3.el w3-script.el w3-jscript.el \ - w3-elisp.el - -OBJECTS = $(SOURCES:.el=.elc) - -# Warning! Currently, the following file can _NOT_ be bytecompiled. -EXTRAS = w3-sysdp.el - -.SUFFIXES: .elc .el .el,v - -.el.elc: - $(EMACS) $(BATCHFLAGS) $(DEPS) -f batch-byte-compile $< - -w3: check-custom docomp.el $(OBJECTS) - @echo Build of w3 complete... - -xemacs-w3: docomp.el $(OBJECTS) - @echo Build of w3 complete... - -fast: check-custom docomp.el - $(EMACS) $(BATCHFLAGS) $(DEPS) -f batch-byte-compile $(SOURCES) - -all: w3.info w3 - -install: all - @echo Installing in $(lispdir) - @( if [ ! -d $(lispdir) ]; then mkdir -p $(lispdir); fi ) - @( if [ ! -d $(infodir) ]; then mkdir -p $(infodir); fi ) - @( if [ ! -d $(confdir) ]; then mkdir -p $(confdir); fi ) - $(INSTALL) -m 644 $(SOURCES) $(OBJECTS) $(lispdir) - $(INSTALL) -m 644 $(EXTRAS) $(lispdir) - $(INSTALL) -m 644 w3.info* $(infodir) - $(INSTALL) -m 644 default.css $(confdir)/stylesheet - $(INSTALL) -m 644 html32.dsl $(confdir)/ - -clean: - $(RM) $(OBJECTS) - -check-custom: - @./custom-check $(EMACS) - -w3.info: w3.txi - @$(MAKEINFO) w3.txi - -w3.dvi: w3.txi - tex w3.txi - texindex w3.cp w3.fn w3.ky w3.pg w3.tp w3.vr - tex w3.txi - $(RM) w3.cp w3.fn w3.ky w3.pg w3.tp w3.vr \ - w3.cps w3.fns w3.kys w3.pgs w3.tps w3.vrs \ - w3.log w3.toc w3.aux - -w3-vars.elc: w3-cus.elc w3-vars.el -w3-display.elc: w3-display.el css.elc font.elc w3-imap.elc -css.elc: css.el font.elc -w3.elc: css.elc w3-vars.elc w3.el -dsssl.elc: dsssl.el dsssl-flow.elc - -autoloads: auto-autoloads.el - -auto-autoloads.el: $(SOURCES) - $(EMACS) -batch -q -no-site-file \ - -eval '(setq autoload-target-directory "'`pwd`'/")' \ - -eval '(setq autoload-package-name "w3")' \ - -l autoload \ - -f batch-update-autoloads $? diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/auto-autoloads.el --- a/lisp/w3/auto-autoloads.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,189 +0,0 @@ -;;; DO NOT MODIFY THIS FILE -(if (featurep 'w3-autoloads) (error "Already loaded")) - -;;;### (autoloads (x-font-build-cache font-default-size-for-device font-default-encoding-for-device font-default-registry-for-device font-default-family-for-device font-default-object-for-device font-default-font-for-device font-create-object) "font" "w3/font.el") - -(autoload 'font-create-object "font" nil nil nil) - -(autoload 'font-default-font-for-device "font" nil nil nil) - -(autoload 'font-default-object-for-device "font" nil nil nil) - -(autoload 'font-default-family-for-device "font" nil nil nil) - -(autoload 'font-default-registry-for-device "font" nil nil nil) - -(autoload 'font-default-encoding-for-device "font" nil nil nil) - -(autoload 'font-default-size-for-device "font" nil nil nil) - -(autoload 'x-font-build-cache "font" nil nil nil) - -;;;*** - -;;;### (autoloads (url-cache-expired url-cache-extract url-is-cached url-store-in-cache) "url-cache" "w3/url-cache.el") - -(autoload 'url-store-in-cache "url-cache" "\ -Store buffer BUFF in the cache" nil nil) - -(autoload 'url-is-cached "url-cache" "\ -Return non-nil if the URL is cached." nil nil) - -(autoload 'url-cache-extract "url-cache" "\ -Extract FNAM from the local disk cache" nil nil) - -(autoload 'url-cache-expired "url-cache" "\ -Return t iff a cached file has expired." nil nil) - -;;;*** - -;;;### (autoloads (url-gateway-nslookup-host) "url-gw" "w3/url-gw.el") - -(autoload 'url-gateway-nslookup-host "url-gw" "\ -Attempt to resolve the given HOSTNAME using nslookup if possible." t nil) - -;;;*** - -;;;### (autoloads (url-retrieve url-popup-info url-get-url-at-point url-buffer-visiting url-normalize-url url-file-attributes) "url" "w3/url.el") - -(autoload 'url-file-attributes "url" "\ -Return a list of attributes of URL. -Value is nil if specified file cannot be opened. -Otherwise, list elements are: - 0. t for directory, string (name linked to) for symbolic link, or nil. - 1. Number of links to file. - 2. File uid. - 3. File gid. - 4. Last access time, as a list of two integers. - First integer has high-order 16 bits of time, second has low 16 bits. - 5. Last modification time, likewise. - 6. Last status change time, likewise. - 7. Size in bytes. (-1, if number is out of range). - 8. File modes, as a string of ten letters or dashes as in ls -l. - If URL is on an http server, this will return the content-type if possible. - 9. t iff file's gid would change if file were deleted and recreated. -10. inode number. -11. Device number. - -If file does not exist, returns nil." nil nil) - -(autoload 'url-normalize-url "url" "\ -Return a 'normalized' version of URL. This strips out default port -numbers, etc." nil nil) - -(autoload 'url-buffer-visiting "url" "\ -Return the name of a buffer (if any) that is visiting URL." nil nil) - -(autoload 'url-get-url-at-point "url" "\ -Get the URL closest to point, but don't change your -position. Has a preference for looking backward when not -directly on a symbol." nil nil) - -(autoload 'url-popup-info "url" "\ -Retrieve the HTTP/1.0 headers and display them in a temp buffer." nil nil) - -(autoload 'url-retrieve "url" "\ -Retrieve a document over the World Wide Web. -The document should be specified by its fully specified -Uniform Resource Locator. No parsing is done, just return the -document as the server sent it. The document is left in the -buffer specified by url-working-buffer. url-working-buffer is killed -immediately before starting the transfer, so that no buffer-local -variables interfere with the retrieval. HTTP/1.0 redirection will -be honored before this function exits." nil nil) - -;;;*** - -;;;### (autoloads (w3-hotlist-add-document w3-use-hotlist w3-hotlist-append w3-hotlist-rename-entry w3-hotlist-delete) "w3-hot" "w3/w3-hot.el") - -(autoload 'w3-hotlist-delete "w3-hot" "\ -Deletes a document from your hotlist file" t nil) - -(autoload 'w3-hotlist-rename-entry "w3-hot" "\ -Rename a hotlist item" t nil) - -(autoload 'w3-hotlist-append "w3-hot" "\ -Append a hotlist to the one in memory" t nil) - -(autoload 'w3-use-hotlist "w3-hot" "\ -Possibly go to a link in your W3/Mosaic hotlist. -This is part of the emacs World Wide Web browser. It will prompt for -one of the items in your 'hotlist'. A hotlist is a list of often -visited or interesting items you have found on the World Wide Web." t nil) - -(autoload 'w3-hotlist-add-document "w3-hot" "\ -Add this documents url to the hotlist" t nil) - -;;;*** - -;;;### (autoloads (w3-follow-link w3-follow-link-other-frame w3-do-setup w3 w3-preview-this-buffer w3-follow-url-at-point w3-follow-url-at-point-other-frame w3-maybe-follow-link w3-maybe-follow-link-mouse w3-fetch w3-fetch-other-frame w3-find-file w3-open-local) "w3" "w3/w3.el") - -(autoload 'w3-open-local "w3" "\ -Find a local file, and interpret it as a hypertext document. -It will prompt for an existing file or directory, and retrieve it as a -hypertext document." t nil) - -(autoload 'w3-find-file "w3" "\ -Find a local file, and interpret it as a hypertext document. -It will prompt for an existing file or directory, and retrieve it as a -hypertext document." t nil) - -(autoload 'w3-fetch-other-frame "w3" "\ -Attempt to follow the hypertext reference under point in a new frame. -With prefix-arg P, ignore viewers and dump the link straight -to disk." t nil) - -(autoload 'w3-fetch "w3" "\ -Retrieve a document over the World Wide Web. -Defaults to URL of the current document, if any. -With prefix argument, use the URL of the hyperlink under point instead." t nil) - -(autoload 'w3-maybe-follow-link-mouse "w3" "\ -Maybe follow a hypertext link under point. -If there is no link under point, this will try using -url-get-url-at-point" t nil) - -(autoload 'w3-maybe-follow-link "w3" "\ -Maybe follow a hypertext link under point. -If there is no link under point, this will try using -url-get-url-at-point" t nil) - -(autoload 'w3-follow-url-at-point-other-frame "w3" "\ -Follow the URL under PT, defaults to link under (point)" t nil) - -(autoload 'w3-follow-url-at-point "w3" "\ -Follow the URL under PT, defaults to link under (point)" t nil) - -(autoload 'w3-preview-this-buffer "w3" "\ -See what this buffer will look like when its formatted as HTML. -HTML is the HyperText Markup Language used by the World Wide Web to -specify formatting for text. More information on HTML can be found at -ftp.w3.org:/pub/www/doc." t nil) - -(autoload 'w3 "w3" "\ -Retrieve the default World Wide Web home page. -The World Wide Web is a global hypertext system started by CERN in -Switzerland in 1991. - -The home page is specified by the variable w3-default-homepage. The -document should be specified by its fully specified Uniform Resource -Locator. The document will be parsed as HTML (if appropriate) and -displayed in a new buffer." t nil) - -(autoload 'w3-do-setup "w3" "\ -Do setup - this is to avoid conflict with user settings when W3 is -dumped with emacs." nil nil) - -(autoload 'w3-follow-link-other-frame "w3" "\ -Attempt to follow the hypertext reference under point in a new frame. -With prefix-arg P, ignore viewers and dump the link straight -to disk." nil nil) - -(autoload 'w3-follow-link "w3" "\ -Attempt to follow the hypertext reference under point. -With prefix-arg P, ignore viewers and dump the link straight -to disk." t nil) - -;;;*** - -(provide 'w3-autoloads) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/base64.el --- a/lisp/w3/base64.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,274 +0,0 @@ -;;; base64.el,v --- Base64 encoding functions -;; Author: Kyle E. Jones -;; Created: 1997/03/12 14:37:09 -;; Version: 1.6 -;; Keywords: extensions - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (C) 1997 Kyle E. Jones -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; For non-MULE -(if (not (fboundp 'char-int)) - (fset 'char-int 'identity)) - -(defvar base64-alphabet - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") - -(defvar base64-decoder-program nil - "*Non-nil value should be a string that names a MIME base64 decoder. -The program should expect to read base64 data on its standard -input and write the converted data to its standard output.") - -(defvar base64-decoder-switches nil - "*List of command line flags passed to the command named by -base64-decoder-program.") - -(defvar base64-encoder-program nil - "*Non-nil value should be a string that names a MIME base64 encoder. -The program should expect arbitrary data on its standard -input and write base64 data to its standard output.") - -(defvar base64-encoder-switches nil - "*List of command line flags passed to the command named by -base64-encoder-program.") - -(defconst base64-alphabet-decoding-alist - '( - ( ?A . 00) ( ?B . 01) ( ?C . 02) ( ?D . 03) ( ?E . 04) ( ?F . 05) - ( ?G . 06) ( ?H . 07) ( ?I . 08) ( ?J . 09) ( ?K . 10) ( ?L . 11) - ( ?M . 12) ( ?N . 13) ( ?O . 14) ( ?P . 15) ( ?Q . 16) ( ?R . 17) - ( ?S . 18) ( ?T . 19) ( ?U . 20) ( ?V . 21) ( ?W . 22) ( ?X . 23) - ( ?Y . 24) ( ?Z . 25) ( ?a . 26) ( ?b . 27) ( ?c . 28) ( ?d . 29) - ( ?e . 30) ( ?f . 31) ( ?g . 32) ( ?h . 33) ( ?i . 34) ( ?j . 35) - ( ?k . 36) ( ?l . 37) ( ?m . 38) ( ?n . 39) ( ?o . 40) ( ?p . 41) - ( ?q . 42) ( ?r . 43) ( ?s . 44) ( ?t . 45) ( ?u . 46) ( ?v . 47) - ( ?w . 48) ( ?x . 49) ( ?y . 50) ( ?z . 51) ( ?0 . 52) ( ?1 . 53) - ( ?2 . 54) ( ?3 . 55) ( ?4 . 56) ( ?5 . 57) ( ?6 . 58) ( ?7 . 59) - ( ?8 . 60) ( ?9 . 61) ( ?+ . 62) ( ?/ . 63) - )) - -(defvar base64-alphabet-decoding-vector - (let ((v (make-vector 123 nil)) - (p base64-alphabet-decoding-alist)) - (while p - (aset v (car (car p)) (cdr (car p))) - (setq p (cdr p))) - v)) - -(defun base64-run-command-on-region (start end output-buffer command - &rest arg-list) - (let ((tempfile nil) status errstring) - (unwind-protect - (progn - (setq tempfile (make-temp-name "base64")) - (setq status - (apply 'call-process-region - start end command nil - (list output-buffer tempfile) - nil arg-list)) - (cond ((equal status 0) t) - ((zerop (save-excursion - (set-buffer (find-file-noselect tempfile)) - (buffer-size))) - t) - (t (save-excursion - (set-buffer (find-file-noselect tempfile)) - (setq errstring (buffer-string)) - (kill-buffer nil) - (cons status errstring))))) - (condition-case () - (delete-file tempfile) - (error nil))))) - -(defun base64-insert-char (char &optional count ignored buffer) - (condition-case nil - (progn - (insert-char char count ignored buffer) - (fset 'base64-insert-char 'insert-char)) - (wrong-number-of-arguments - (fset 'base64-insert-char 'base64-xemacs-insert-char) - (base64-insert-char char count ignored buffer)))) - -(defun base64-xemacs-insert-char (char &optional count ignored buffer) - (if (and buffer (eq buffer (current-buffer))) - (insert-char char count) - (save-excursion - (set-buffer buffer) - (insert-char char count)))) - -(defun base64-decode-region (start end) - (interactive "r") - (message "Decoding base64...") - (let ((work-buffer nil) - (done nil) - (counter 0) - (bits 0) - (lim 0) inputpos - (non-data-chars (concat "^=" base64-alphabet))) - (unwind-protect - (save-excursion - (setq work-buffer (generate-new-buffer " *base64-work*")) - (buffer-disable-undo work-buffer) - (if base64-decoder-program - (let* ((binary-process-output t) ; any text already has CRLFs - (status (apply 'base64-run-command-on-region - start end work-buffer - base64-decoder-program - base64-decoder-switches))) - (if (not (eq status t)) - (error "%s" (cdr status)))) - (goto-char start) - (skip-chars-forward non-data-chars end) - (while (not done) - (setq inputpos (point)) - (cond - ((> (skip-chars-forward base64-alphabet end) 0) - (setq lim (point)) - (while (< inputpos lim) - (setq bits (+ bits - (aref base64-alphabet-decoding-vector - (char-int (char-after inputpos))))) - (setq counter (1+ counter) - inputpos (1+ inputpos)) - (cond ((= counter 4) - (base64-insert-char (lsh bits -16) 1 nil work-buffer) - (base64-insert-char (logand (lsh bits -8) 255) 1 nil - work-buffer) - (base64-insert-char (logand bits 255) 1 nil - work-buffer) - (setq bits 0 counter 0)) - (t (setq bits (lsh bits 6))))))) - (cond - ((= (point) end) - (if (not (zerop counter)) - (error "at least %d bits missing at end of base64 encoding" - (* (- 4 counter) 6))) - (setq done t)) - ((= (char-after (point)) ?=) - (setq done t) - (cond ((= counter 1) - (error "at least 2 bits missing at end of base64 encoding")) - ((= counter 2) - (base64-insert-char (lsh bits -10) 1 nil work-buffer)) - ((= counter 3) - (base64-insert-char (lsh bits -16) 1 nil work-buffer) - (base64-insert-char (logand (lsh bits -8) 255) - 1 nil work-buffer)) - ((= counter 0) t))) - (t (skip-chars-forward non-data-chars end))))) - (or (markerp end) (setq end (set-marker (make-marker) end))) - (goto-char start) - (insert-buffer-substring work-buffer) - (delete-region (point) end)) - (and work-buffer (kill-buffer work-buffer)))) - (message "Decoding base64... done")) - -(defun base64-encode-region (start end) - (interactive "r") - (message "Encoding base64...") - (let ((work-buffer nil) - (counter 0) - (cols 0) - (bits 0) - (alphabet base64-alphabet) - inputpos) - (unwind-protect - (save-excursion - (setq work-buffer (generate-new-buffer " *base64-work*")) - (buffer-disable-undo work-buffer) - (if base64-encoder-program - (let ((status (apply 'base64-run-command-on-region - start end work-buffer - base64-encoder-program - base64-encoder-switches))) - (if (not (eq status t)) - (error "%s" (cdr status)))) - (setq inputpos start) - (while (< inputpos end) - (setq bits (+ bits (char-int (char-after inputpos)))) - (setq counter (1+ counter)) - (cond ((= counter 3) - (base64-insert-char (aref alphabet (lsh bits -18)) 1 nil - work-buffer) - (base64-insert-char - (aref alphabet (logand (lsh bits -12) 63)) - 1 nil work-buffer) - (base64-insert-char - (aref alphabet (logand (lsh bits -6) 63)) - 1 nil work-buffer) - (base64-insert-char - (aref alphabet (logand bits 63)) - 1 nil work-buffer) - (setq cols (+ cols 4)) - (cond ((= cols 72) - (base64-insert-char ?\n 1 nil work-buffer) - (setq cols 0))) - (setq bits 0 counter 0)) - (t (setq bits (lsh bits 8)))) - (setq inputpos (1+ inputpos))) - ;; write out any remaining bits with appropriate padding - (if (= counter 0) - nil - (setq bits (lsh bits (- 16 (* 8 counter)))) - (base64-insert-char (aref alphabet (lsh bits -18)) 1 nil - work-buffer) - (base64-insert-char (aref alphabet (logand (lsh bits -12) 63)) - 1 nil work-buffer) - (if (= counter 1) - (base64-insert-char ?= 2 nil work-buffer) - (base64-insert-char (aref alphabet (logand (lsh bits -6) 63)) - 1 nil work-buffer) - (base64-insert-char ?= 1 nil work-buffer))) - (if (> cols 0) - (base64-insert-char ?\n 1 nil work-buffer))) - (or (markerp end) (setq end (set-marker (make-marker) end))) - (goto-char start) - (insert-buffer-substring work-buffer) - (delete-region (point) end)) - (and work-buffer (kill-buffer work-buffer)))) - (message "Encoding base64... done")) - -(defun base64-encode (string) - (save-excursion - (set-buffer (get-buffer-create " *base64-encode*")) - (erase-buffer) - (insert string) - (base64-encode-region (point-min) (point-max)) - (skip-chars-backward " \t\r\n") - (delete-region (point-max) (point)) - (prog1 - (buffer-string) - (kill-buffer (current-buffer))))) - -(defun base64-decode (string) - (save-excursion - (set-buffer (get-buffer-create " *base64-decode*")) - (erase-buffer) - (insert string) - (base64-decode-region (point-min) (point-max)) - (goto-char (point-max)) - (skip-chars-backward " \t\r\n") - (delete-region (point-max) (point)) - (prog1 - (buffer-string) - (kill-buffer (current-buffer))))) - -(provide 'base64) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/css.el --- a/lisp/w3/css.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1032 +0,0 @@ -;;; css.el -- Cascading Style Sheet parser -;; Author: wmperry -;; Created: 1997/05/11 00:54:23 -;; Version: 1.39 -;; Keywords: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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-and-compile - (require 'cl) - (require 'font) - ) - -;; CBI = Cant Be Implemented - due to limitations in emacs/xemacs -;; NYI = Not Yet Implemented - due to limitations of space/time -;; NYPI = Not Yet Partially Implemented - possible partial support, eventually - -(defconst css-properties - '(;; Property name Inheritable? Type of data - ;; Base CSS level 1 properties: http://www.w3.org/pub/WWW/TR/REC-CSS1 - ;; Font properties, Section 5.2 - [font-family t string-list] - [font-style t symbol] - [font-variant t symbol] - [font-weight t weight] - [font-size t height] - [font nil font] - - ;; Color and background properties, Section 5.3 - [color t color] - [background nil color-shorthand] - [background-color nil color] - [background-image nil url] ; NYI - [background-repeat nil symbol] ; CBI - [background-attachment nil symbol] ; CBI - [background-position nil symbol] ; CBI - - ;; Text properties, Section 5.4 - [word-spacing t length] ; CBI - [letter-spacing t length] ; CBI - [text-decoration t symbol-list] - [vertical-align nil symbol] - [text-transform t symbol] - [text-align t symbol] - [text-indent t length] ; NYI - [line-height t length] ; CBI - - ;; Box properties, Section 5.5 - [margin nil boundary-shorthand] - [margin-left nil length] - [margin-right nil length] - [margin-top nil length] - [margin-bottom nil length] - [padding nil boundary-shorthand] - [padding-left nil length] - [padding-right nil length] - [padding-top nil length] - [padding-bottom nil length] - [border nil border-shorthand] - [border-left nil border] - [border-right nil border] - [border-top nil border] - [border-bottom nil border] - [border-top-width nil nil] - [border-right-width nil nil] - [border-bottom-width nil nil] - [border-left-width nil nil] - [border-width nil boundary-shorthand] - [border-color nil color] - [border-style nil symbol] - [width nil length] ; NYPI - [height nil length] ; NYPI - [float nil symbol] - [clear nil symbol] - - ;; Classification properties, Section 5.6 - [display nil symbol] - [list-style-type t symbol] - [list-style-image t url] - [list-style-position t symbol] - [list-style nil list-style] - [white-space t symbol] - - ;; These are for specifying speech properties (ACSS-style) - ;; http://www.w3.org/pub/WWW/Style/CSS/Speech/NOTE-ACSS - - ;; General audio properties, Section 3 - [volume t string] ; Needs its own type? - [pause-before nil time] - [pause-after nil time] - [pause nil pause] - [cue-before nil string] - [cue-after nil string] - [cue-during nil string] - [cue nil string] ; Needs its own type? - - ;; Spatial properties, Section 4 - [azimuth t angle] - [elevation t elevation] - - ;; Speech properties, Section 5 - [speed t string] - [voice-family t string-list] - [pitch t string] - [pitch-range t percentage] - [stress t percentage] - [richness t percentage] - [speak-punctuation t symbol] - [speak-date t symbol] - [speak-numeral t symbol] - [speak-time t symbol] - - ;; Proposed printing extensions - ;; http://www.w3.org/pub/WWW/Style/Group/WD-PRINT-961220 - ;; These apply only to pages (@page directive) - [size nil symbol] - [orientation nil symbol] - [margin-inside nil length] - ;; These apply to the document - [page-break-before nil symbol] - [page-break-after nil symbol] - - ;; These are for specifying speech properties (Raman-style) - [voice-family t string] - [gain t symbol] - [left-volume t integer] - [right-volume t integer] - [pitch t integer] - [pitch-range t integer] - [stress t integer] - [richness t integer] - ) - "A description of the various CSS properties and how to interpret them.") - -(put 'font 'css-shorthand t) -(put 'background 'css-shorthand t) -(put 'margin 'css-shorthand t) -(put 'padding 'css-shorthand t) -(put 'border 'css-shorthand t) -(put 'list-style 'css-shorthand t) - -(mapcar - (lambda (entry) - (put (aref entry 0) 'css-inherit (aref entry 1)) - (put (aref entry 0) 'css-type (aref entry 2))) - css-properties) - -(defconst css-weights - '(nil ;never used - :extra-light - :light - :demi-light - :medium - :normal - :demi-bold - :bold - :extra-bold - ) - "List of CSS font weights.") - -(defvar css-syntax-table - (copy-syntax-table emacs-lisp-mode-syntax-table) - "The syntax table for parsing stylesheets") - -(modify-syntax-entry ?' "\"" css-syntax-table) -(modify-syntax-entry ?` "\"" css-syntax-table) -(modify-syntax-entry ?{ "(" css-syntax-table) -(modify-syntax-entry ?} ")" css-syntax-table) - -(eval-when-compile - (defvar css-scratch-val nil) - (defvar css-scratch-id nil) - (defvar css-scratch-class nil) - (defvar css-scratch-possibles nil) - (defvar css-scratch-current nil) - (defvar css-scratch-classes nil) - (defvar css-scratch-class-match nil) - (defvar css-scratch-current-rule nil) - (defvar css-scratch-current-value nil) - ) - -(defconst css-running-xemacs - (string-match "XEmacs" (emacs-version)) - "Whether we are running in XEmacs or not.") - -(defsubst css-replace-regexp (regexp to-string) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (replace-match to-string t nil))) - -(defun css-contextual-match (rule stack) - (let ((ancestor) - (p-args) - (p-class) - (matched t)) - (while rule - (setq ancestor (assq (caar rule) stack)) - (if (not ancestor) - (setq rule nil - matched nil) - (setq p-args (cdr ancestor) - p-class (or (cdr-safe (assq 'class p-args)) t)) - (if (not (equal p-class (cdar rule))) - (setq matched nil - rule nil))) - (setq rule (cdr rule))) - matched)) - -(defsubst css-get-internal (tag args) - (declare (special tag sheet element-stack default)) - (setq css-scratch-id (or (cdr-safe (assq 'id args)) - (cdr-safe (assq 'name args))) - css-scratch-class (or (cdr-safe (assq 'class args)) t) - css-scratch-possibles (cl-gethash tag sheet)) - (while css-scratch-possibles - (setq css-scratch-current (car css-scratch-possibles) - css-scratch-current-rule (car css-scratch-current) - css-scratch-current-value (cdr css-scratch-current) - css-scratch-classes (if (listp (car css-scratch-current-rule)) - (cdar css-scratch-current-rule) - (cdr css-scratch-current-rule)) - css-scratch-class-match t - css-scratch-possibles (cdr css-scratch-possibles)) - (if (eq t css-scratch-classes) - (setq css-scratch-classes nil)) - (if (eq t css-scratch-class) - (setq css-scratch-class nil)) - (while css-scratch-classes - (if (not (member (pop css-scratch-classes) css-scratch-class)) - (setq css-scratch-class-match nil - css-scratch-classes nil))) - (cond - ((and (listp (car css-scratch-current-rule)) css-scratch-class-match) - ;; Contextual! - (setq css-scratch-current-rule (cdr css-scratch-current-rule)) - (if (css-contextual-match css-scratch-current-rule element-stack) - (setq css-scratch-val - (append css-scratch-val css-scratch-current-value))) - ) - (css-scratch-class-match - (setq css-scratch-val (append css-scratch-val css-scratch-current-value)) - ) - (t - nil)) - ) - ) - -(defsubst css-get (tag args &optional sheet element-stack) - (setq css-scratch-val nil - css-scratch-class (or (cdr-safe (assq 'class args)) t)) - - ;; check for things without the class - (if (listp css-scratch-class) - (css-get-internal tag nil)) - - ;; check for global class values - (css-get-internal '*document args) - - ;; Now check for things with the class - they will be stuck on the front - ;; of the list, which will mean we do the right thing - (css-get-internal tag args) - - ;; Defaults are up to the calling application to provide - css-scratch-val) - -(defun css-ancestor-get (info ancestors sheet) - ;; Inheritable property, check ancestors - (let (cur) - (while ancestors - (setq cur (car ancestors) - css-scratch-val (css-get info (car cur) (cdr cur) sheet) - ancestors (if css-scratch-val nil (cdr ancestors))))) - css-scratch-val) - -(defun css-split-selector (tag) - ;; Return a list - (cond - ((string-match " " tag) ; contextual - (let ((tags (split-string tag "[ \t]+")) - (result nil)) - (while tags - (setq result (cons (css-split-selector (car tags)) result) - tags (cdr tags))) - result)) - ((string-match "[:\\.]" tag) - (let ((tag (if (= (match-beginning 0) 0) - '*document - (intern (downcase (substring tag 0 (match-beginning 0)))))) - (rest (substring tag (match-beginning 0) nil)) - (classes nil)) - (while (string-match "^[:\\.][^:\\.]+" rest) - (if (= ?. (aref rest 0)) - (setq classes (cons (substring rest 1 (match-end 0)) classes)) - (setq classes (cons (substring rest 0 (match-end 0)) classes))) - (setq rest (substring rest (match-end 0) nil))) - (setq classes (sort classes 'string-lessp)) - (cons tag classes))) - ((string-match "^#" tag) ; id selector - (cons '*document (list tag))) - (t - (cons (intern (downcase tag)) t) - ) - ) - ) - -(defun css-applies-to (st nd) - (let ((results nil) - (save-pos nil)) - (narrow-to-region st nd) - (goto-char st) - (skip-chars-forward " \t\r\n") - (while (not (eobp)) - (setq save-pos (point)) - (skip-chars-forward "^,") - (skip-chars-backward " \r\t\n") - (setq results (cons (css-split-selector - (buffer-substring save-pos (point))) results)) - (skip-chars-forward ", \t\r\n")) - (widen) - results)) - -(defun css-split-font-shorthand (font) - ;; [<font-weight> || <font-style>]? <font-size> [ / <line-height> ]? <font-family> - (let (weight size height family retval) - (if (not (string-match " *\\([0-9.]+[^ /]+\\)" font)) - (progn - (message "Malformed font shorthand: %s" font) - nil) - (setq weight (if (/= 0 (match-beginning 0)) - (substring font 0 (match-beginning 0))) - size (match-string 1 font) - font (substring font (match-end 0) nil)) - (if (string-match " */ *\\([^ ]+\\) *" font) - ;; they specified a line-height as well - (setq height (match-string 1 font) - family (substring font (match-end 0) nil)) - (if (string-match "^[ \t]+" font) - (setq family (substring font (match-end 0) nil)) - (setq family font))) - (if weight - (push (cons 'font-weight (css-expand-value 'weight weight)) retval)) - (if size - (push (cons 'font-size (css-expand-length size)) retval)) - (if height - (push (cons 'line-height (css-expand-length height t)) retval)) - (if family - (push (cons 'font-family (css-expand-value 'string-list family)) retval)) - retval))) - -(if (not (fboundp 'frame-char-height)) - (defun frame-char-height (&optional frame) - "Height in pixels of a line in the font in frame FRAME. -If FRAME is omitted, the selected frame is used. -For a terminal frame, the value is always 1." - (font-height (face-font 'default frame)))) - -(defun css-expand-length (spec &optional height) - (cond - ((not (stringp spec)) spec) - ((string-equal spec "auto") nil) - ((string-match "\\([+-]?\\([0-9]+\\|[0-9]*\\.[0-9]+\\)\\)%" spec) ; A percentage - (setq spec (/ (string-to-int (match-string 1 spec)) 100.0)) - (if height - (round (* (frame-char-height) spec)) - (max 0 (round (* (frame-width) spec))))) - ((string-match "\\([+-]?\\([0-9]+\\|[0-9]*\\.[0-9]+\\)\\)e[mx]" spec) ; Character based - (max 0 (round (string-to-number (match-string 1 spec))))) - (t - (truncate (font-spatial-to-canonical spec))) - ) - ) - -(defsubst css-unhex-char (x) - (if (> x ?9) - (if (>= x ?a) - (+ 10 (- x ?a)) - (+ 10 (- x ?A))) - (- x ?0))) - -(defsubst css-pow (x n) - (apply '* (make-list n x))) - -(defun css-unhex (x) - (let ((ord (length x)) - (rval 0)) - (while (> ord 0) - (setq rval (+ rval - (* (css-pow 16 (- (length x) ord)) - (css-unhex-char (aref x (1- ord))))) - ord (1- ord))) - rval)) - -(defmacro css-symbol-list-as-regexp (&rest keys) - (` (eval-when-compile - (concat "^\\(" - (mapconcat 'symbol-name - (quote (, keys)) - "\\|") "\\)$")))) - -(defun css-expand-color (color) - (cond - ((string-match "^\\(transparent\\|none\\)$" color) - (setq color nil)) - ((string-match "^#" color) - (let (r g b) - (cond - ((string-match "^#...$" color) - ;; 3-char rgb spec, expand out to six chars by replicating - ;; digits, not adding zeros. - (setq r (css-unhex (make-string 2 (aref color 1))) - g (css-unhex (make-string 2 (aref color 2))) - b (css-unhex (make-string 2 (aref color 3))))) - ((string-match "^#\\(..\\)\\(..\\)\\(..\\)$" color) - (setq r (css-unhex (match-string 1 color)) - g (css-unhex (match-string 2 color)) - b (css-unhex (match-string 3 color)))) - (t - (setq color (substring color 1)) - (let* ((n (/ (length color) 3)) - (max (float (css-pow 16 n)))) - (setq r (css-unhex (substring color 0 n)) - g (css-unhex (substring color n (* n 2))) - b (css-unhex (substring color (* n 2) (* n 3))) - r (round (* (/ r max) 255)) - g (round (* (/ g max) 255)) - b (round (* (/ b max) 255)))))) - (setq color (vector 'rgb r g b)))) - ((string-match "^rgb *( *\\([0-9]+\\)[, ]+\\([0-9]+\\)[, ]+\\([0-9]+\\) *) *$" color) - ;; rgb(r,g,b) 0 - 255, cutting off at 255 - (setq color (vector - 'rgb - (min (string-to-int (match-string 1 color)) 255) - (min (string-to-int (match-string 2 color)) 255) - (min (string-to-int (match-string 3 color)) 255)))) - ((string-match "^rgb *( *\\([0-9]+\\) *%[, ]+\\([0-9]+\\) *%[, ]+\\([0-9]+\\) *% *) *$" color) - ;; rgb(r%,g%,b%) 0 - 100%, cutting off at 100% - (let ((r (min (string-to-number (match-string 1 color)) 100.0)) - (g (min (string-to-number (match-string 2 color)) 100.0)) - (b (min (string-to-number (match-string 3 color)) 100.0))) - (setq r (round (* r 2.55)) - g (round (* g 2.55)) - b (round (* b 2.55)) - color (vector 'rgb r g b)))) - (t - ;; Hmmm... pass it through unmangled and hope the underlying - ;; windowing system can handle it. - ) - ) - color - ) - -(defun css-expand-value (type value) - (if value - (case type - (length ; CSS, Section 6.1 - (setq value (css-expand-length value))) - (height - (setq value (css-expand-length value t))) - (percentage ; CSS, Section 6.2 - (setq value (/ (string-to-number value) - (if (fboundp 'float) (float 100) 1)))) - (color ; CSS, Section 6.3 - (setq value (css-expand-color value))) - (url ; CSS, Section 6.4 - (declare (special url purl)) - (if (string-match "url *(\\([^ )]+\\) *)" value) - (setq value (match-string 1 value))) - (if (string-match " *\\([^ ]+\\) *" value) - (setq value (match-string 1 value))) - (setq value (url-expand-file-name value (or url purl)))) - (angle ; ACSS, Section 2.2.1 - ) - (time ; ACSS, Section 2.2.2 - (let ((val (string-to-number value)) - (units 'ms)) - (if (string-match "^[0-9]+ *\\([a-zA-Z.]+\\)" value) - (setq units (intern (downcase (match-string 1 value))))) - (setq value (case units - ((s second seconds) - val) - ((min minute minutes) - (* val 60)) - ((hr hour hours) - (* val 60 60)) - ((day days) - (* val 24 60 60)) - (otherwise - (/ val (float 1000))))))) - (elevation ; ACSS, Section 4.2 - (if (string-match - (css-symbol-list-as-regexp below level above higher lower) value) - (setq value (intern (downcase (match-string value 1))) - value (case value - (below -90) - (above 90) - (level 0) - (higher 45) - (lower -45) - )) - (setq value (css-expand-value 'angle value)))) - (color-shorthand ; CSS, Section 5.3.7 - ;; color|image|repeat|attach|position - (let ((keys (split-string value " +")) - cur color image repeat attach position) - (while (setq cur (pop keys)) - (cond - ((string-match "url" cur) ; Only image can have a URL - (setq image (css-expand-value 'url cur))) - ((string-match "%" cur) ; Only position can have a perc. - (setq position (css-expand-value 'percentage cur))) - ((string-match "repeat" cur) ; Only repeat - (setq repeat (intern (downcase cur)))) - ((string-match "scroll\\|fixed" cur) - (setq attach (intern (downcase (substring cur - (match-beginning 0) - (match-end 0)))))) - ((string-match (css-symbol-list-as-regexp - top center bottom left right) cur) - ) - (t - (setq color (css-expand-value 'color cur))))) - (setq value (list (cons 'background-color color) - (cons 'background-image image) - (cons 'background-repeat repeat) - (cons 'background-attachment attach) - (cons 'background-position position))))) - (font ; CSS, Section 5.2.7 - ;; [style | variant | weight]? size[/line-height]? family - (setq value (css-split-font-shorthand value))) - (border ; width | style | color - ;; FIXME - ) - (border-shorthand ; width | style | color - ;; FIXME - ) - (list-style ; CSS, Section 5.6.6 - ;; keyword | position | url - (setq value (split-string value "[ ,]+")) - (if (= (length value) 1) - (setq value (list (cons 'list-style-type - (intern (downcase (car value)))))) - (setq value (list (cons 'list-style-type - (css-expand-value 'symbol (nth 0 value))) - (cons 'list-style-position - (css-expand-value 'symbol (nth 1 value))) - (cons 'list-style-image - (css-expand-value 'url (nth 2 value))))))) - (boundary-shorthand ; CSS, Section 5.5.x - ;; length|percentage|auto {1,4} - (setq value (split-string value "[ ,]+")) - (let* ((top (intern (format "%s-top" type))) - (bottom (intern (format "%s-bottom" type))) - (left (intern (format "%s-left" type))) - (right (intern (format "%s-right" type)))) - (setq top (cons top (css-expand-value (get top 'css-type) - (nth 0 value))) - right (cons right (css-expand-value (get right 'css-type) - (nth 1 value))) - bottom (cons bottom (css-expand-value (get bottom 'css-type) - (nth 2 value))) - left (cons left (css-expand-value (get left 'css-type) - (nth 3 value))) - value (list top right bottom left)))) - (weight ; CSS, Section 5.2.5 - ;; normal|bold|bolder|lighter|[1-9]00 - (cond - ((string-match "^[0-9]+" value) - (setq value (/ (string-to-number value) 100) - value (or (nth value css-weights) :bold))) - ((string-match (css-symbol-list-as-regexp normal bold bolder lighter) - value) - (setq value (intern (downcase (concat ":" value))))) - (t (setq value (intern ":bold"))))) - ;; The rest of these deal with how we handle things internally - ((symbol integer) ; Read it in - (setq value (read (downcase value)))) - (symbol-list ; A space/comma delimited symlist - (setq value (downcase value) - value (split-string value "[ ,]+") - value (mapcar 'intern value))) - (string-list ; A space/comma delimited list - (setq value (split-string value " *, *"))) - (otherwise ; Leave it as is - t) - ) - ) - value - ) - -(defun css-parse-args (st &optional nd) - ;; Return an assoc list of attribute/value pairs from a CSS style entry - (let ( - name ; From name= - value ; its value - results ; Assoc list of results - name-pos ; Start of XXXX= position - val-pos ; Start of value position - (case-fold-search t) - ) - (save-excursion - (if (stringp st) - (progn - (set-buffer (get-buffer-create " *css-style-temp*")) - (set-syntax-table css-syntax-table) - (erase-buffer) - (insert st) - (setq st (point-min) - nd (point-max))) - (set-syntax-table css-syntax-table)) - (save-restriction - (narrow-to-region st nd) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward ";, \n\t") - (setq name-pos (point)) - (skip-chars-forward "^ \n\t:,;") - (downcase-region name-pos (point)) - (setq name (intern (buffer-substring name-pos (point)))) - (skip-chars-forward " \t\n") - (if (not (eq (char-after (point)) ?:)) ; There is no value - (setq value nil) - (skip-chars-forward " \t\n:") - (setq val-pos (point) - value - (cond - ((or (= (or (char-after val-pos) 0) ?\") - (= (or (char-after val-pos) 0) ?')) - (buffer-substring (1+ val-pos) - (condition-case () - (prog2 - (forward-sexp 1) - (1- (point)) - (skip-chars-forward "\"")) - (error - (skip-chars-forward "^ \t\n") - (point))))) - (t - (buffer-substring val-pos - (progn - (skip-chars-forward "^;") - (skip-chars-backward " \t") - (point))))))) - (setq value (css-expand-value (get name 'css-type) value)) - (if (get name 'css-shorthand) - (setq results (append value results)) - (setq results (cons (cons name value) results))) - (skip-chars-forward ";, \n\t")) - results)))) - -(defun css-handle-media-directive (data active) - (let (type) - (if (string-match "\\([^ \t\r\n{]+\\)" data) - (setq type (intern (downcase (substring data (match-beginning 1) - (match-end 1)))) - data (substring data (match-end 1))) - (setq type 'unknown)) - (if (string-match "^[ \t\r\n]*{" data) - (setq data (substring data (match-end 0)))) - (if (memq type active) - (save-excursion - (insert data))))) - -(defun css-handle-import (data) - (let (url) - (setq url (css-expand-value 'url data)) - (and url - (let ((url-working-buffer (generate-new-buffer-name " *styleimport*")) - (url-mime-accept-string - "text/css ; level=2") - (sheet nil)) - (save-excursion - (set-buffer (get-buffer-create url-working-buffer)) - (setq url-be-asynchronous nil) - (url-retrieve url) - (css-clean-buffer) - (setq sheet (buffer-string)) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))) - (insert sheet))))) - -(defun css-clean-buffer () - ;; Nuke comments, etc. - (goto-char (point-min)) - (let ((save-pos nil)) - (while (search-forward "/*" nil t) - (setq save-pos (- (point) 2)) - (delete-region save-pos - (if (search-forward "*/" nil t) - (point) - (end-of-line) - (point))))) - (goto-char (point-min)) - (delete-matching-lines "^[ \t\r]*$") ; Nuke blank lines - (css-replace-regexp "^[ \t\r]+" "") ; Nuke whitespace at beg. of line - (css-replace-regexp "[ \t\r]+$" "") ; Nuke whitespace at end of line - (goto-char (point-min))) - -(if css-running-xemacs - (defun css-color-light-p (color-or-face) - (let (face color) - (cond - ((or (facep color-or-face) - (and (symbolp color-or-face) - (find-face color-or-face))) - (setq color (specifier-instance (face-background color-or-face)))) - ((color-instance-p color-or-face) - (setq color color-or-face)) - ((color-specifier-p color-or-face) - (setq color (specifier-instance color-or-face))) - ((stringp color-or-face) - (setq color (make-color-instance color-or-face))) - (t (signal 'wrong-type-argument 'color-or-face-p))) - (if color - (not (< (apply '+ (color-instance-rgb-components color)) - (/ (apply '+ (color-instance-rgb-components - (make-color-instance "white"))) 3))) - t))) - (defun css-color-values (color) - (cond - ((eq window-system 'x) - (x-color-values color)) - ((eq window-system 'pm) - (pm-color-values color)) - ((eq window-system 'ns) - (ns-color-values color)) - (t nil))) - (defun css-color-light-p (color-or-face) - (let (colors) - (cond - ((null window-system) - nil) - ((facep color-or-face) - (setq color-or-face (face-background color-or-face)) - (if (null color-or-face) - (setq color-or-face (cdr-safe - (assq 'background-color (frame-parameters))))) - (setq colors (css-color-values color-or-face))) - ((stringp color-or-face) - (setq colors (css-color-values color-or-face))) - ((font-rgb-color-p color-or-face) - (setq colors (list (font-rgb-color-red color-or-face) - (font-rgb-color-green color-or-face) - (font-rgb-color-blue color-or-face)))) - (t - (signal 'wrong-type-argument 'color-or-face-p))) - (not (< (apply '+ colors) - (/ (apply '+ (css-color-values "white")) 3))))) - ) - -(defun css-active-device-types (&optional device) - (let ((types (list 'all - (if css-running-xemacs 'xemacs 'emacs) - (if (css-color-light-p 'default) 'light 'dark))) - (type (device-type device))) - ;; For reasons I don't really want to get into, emacspeak and TTY - ;; are mutually exclusive for most of our purposes (insert-before, - ;; xetc) - (if (featurep 'emacspeak) - (setq types (cons 'speech types)) - (if (eq type 'tty) - (setq types (cons 'tty types)))) - (cond - ((eq 'color (device-class)) - (if (not (device-bitplanes)) - (setq types (cons 'color types)) - (setq types - (append - (list (intern (format "%dbit-color" - (device-bitplanes))) - (intern (format "%dbit" - (device-bitplanes))) - 'color) types)) - (if (= 24 (device-bitplanes)) - (setq types (cons 'truecolor types))))) - ((eq 'grayscale (device-class)) - (setq types (append (list (intern (format "%dbit-grayscale" - (device-bitplanes))) - 'grayscale) - types))) - ((eq 'mono (device-class)) - (setq types (append (list 'mono 'monochrome) types))) - (t - (setq types (cons 'unknown types)))) - ;; FIXME: Remove me when the real 3.0 comes out - (if (and (memq 'tty types) (memq 'color types)) - (setq types (cons 'ansi-tty types))) - types)) - -(defmacro css-rule-specificity-internal (rule) - (` - (progn - (setq tmp (cdr (, rule))) - (if (listp tmp) - (while tmp - (if (= ?# (aref (car tmp) 0)) - (incf a) - (incf b)) - (setq tmp (cdr tmp))))))) - -(defsubst css-specificity (rule) - ;; To find specificity, according to the september 1996 CSS draft - ;; a = # of ID attributes in the selector - ;; b = # of class attributes in the selector - ;; c = # of tag names in the selector - (let ((a 0) (b 0) (c 0) cur tmp) - (if (not (listp (car rule))) - (css-rule-specificity-internal rule) - (setq c (length rule)) - (while rule - (css-rule-specificity-internal (pop rule)))) - (+ (* 100 a) (* 10 b) c) - ) - ) - -(defun css-copy-stylesheet (sheet) - (let ((new (make-hash-table :size (hash-table-count sheet)))) - (cl-maphash - (function - (lambda (k v) - (cl-puthash k (copy-tree v) new))) sheet) - new)) - -(defsubst css-store-rule (attrs applies-to) - (declare (special sheet)) - (let (rules cur tag node) - (while applies-to - (setq cur (pop applies-to) - tag (car cur)) - (if (listp tag) - (setq tag (car tag))) - (setq rules (cl-gethash tag sheet)) - (cond - ((null rules) - ;; First rule for this tag. Create new ruleset - (cl-puthash tag (list (cons cur attrs)) sheet)) - ((setq node (assoc cur rules)) - ;; Similar rule already exists, splice in our information - (setcdr node (append attrs (cdr node)))) - (t - ;; First rule for this particular combination of tag/ancestors/class. - ;; Slap it onto the existing set of rules and push back into sheet. - (setq rules (cons (cons cur attrs) rules)) - (cl-puthash tag rules sheet)) - ) - ) - ) - ) - -(defun css-parse (url &optional string inherit) - (let ( - (url-mime-accept-string - "text/css ; level=2") - (save-pos nil) - (applies-to nil) ; List of tags to apply style to - (attrs nil) ; List of name/value pairs - (att nil) - (cur nil) - (val nil) - (device-type nil) - (purl (url-view-url t)) - (active-device-types (css-active-device-types (selected-device))) - (sheet inherit)) - (if (not sheet) - (setq sheet (make-hash-table :size 13 :test 'eq))) - (save-excursion - (set-buffer (get-buffer-create - (generate-new-buffer-name " *style*"))) - (set-syntax-table css-syntax-table) - (erase-buffer) - (if url (url-insert-file-contents url)) - (goto-char (point-max)) - (if string (insert string)) - (css-clean-buffer) - (goto-char (point-min)) - (while (not (eobp)) - (setq save-pos (point)) - (cond - ;; *sigh* SGML comments are being used to 'hide' data inlined - ;; with the <style> tag from older browsers. - ((or (looking-at "<!--+") ; begin - (looking-at "--+>")) ; end - (goto-char (match-end 0))) - ;; C++ style comments - ((looking-at "[ \t]*//") - (end-of-line)) - ;; Pre-Processor directives - ((looking-at "[ \t\r]*@\\([^ \t\r\n]\\)") - (let (data directive) - (skip-chars-forward " @\t\r") ; Past any leading whitespace - (setq save-pos (point)) - (skip-chars-forward "^ \t\r\n") ; Past the @ directive - (downcase-region save-pos (point)) - (setq directive (intern (buffer-substring save-pos (point)))) - (skip-chars-forward " \t\r") - (setq save-pos (point)) - (cond - ((looking-at "[^{]*\\({\\)") - (goto-char (match-beginning 1)) - (forward-sexp 1) - (setq data (buffer-substring save-pos (1- (point))))) - ((looking-at "[\"']+") - (setq save-pos (1+ save-pos)) - (forward-sexp 1) - (setq data (buffer-substring save-pos (1- (point))))) - (t - (skip-chars-forward "^;"))) - (if (not data) - (setq data (buffer-substring save-pos (point)))) - (setq save-pos (point)) - (case directive - (import (css-handle-import data)) - (media (css-handle-media-directive data active-device-types)) - (t (message "Unknown directive in stylesheet: @%s" directive))))) - ;; Giving us some output device information, old way - ((looking-at "[ \t\r]*:\\([^: \n]+\\):") - (downcase-region (match-beginning 1) (match-end 1)) - (setq device-type (intern (buffer-substring (match-beginning 1) - (match-end 1)))) - (goto-char (match-end 0)) - (if (not (memq device-type active-device-types)) - ;; Not applicable to us... skip the info - (progn - (if (re-search-forward ":[^:{ ]*:" nil t) - (goto-char (match-beginning 0)) - (goto-char (point-max)))))) - ;; Default is to treat it like a stylesheet declaration - (t - (skip-chars-forward "^{") - ;;(downcase-region save-pos (point)) - (setq applies-to (css-applies-to save-pos (point))) - (skip-chars-forward "^{") - (setq save-pos (point)) - (condition-case () - (forward-sexp 1) - (error (goto-char (point-max)))) - (skip-chars-backward "\r}") - (subst-char-in-region save-pos (point) ?\n ? ) - (subst-char-in-region save-pos (point) ?\r ? ) - ;; This is for not choking on garbage at the end of the buffer. - ;; I get bit by this every once in a while when going through my - ;; socks gateway. - (if (eobp) - nil - (setq attrs (css-parse-args (1+ save-pos) (point))) - (skip-chars-forward "}\r\n") - (css-store-rule attrs applies-to)) - ) - ) - (skip-chars-forward " \t\r\n")) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))) - sheet) - ) - -;; Tools for pretty-printing an existing stylesheet. -(defun css-rule-name (rule) - (cond - ((listp (car rule)) ; Contextual - (mapconcat 'css-rule-name - (reverse rule) " ")) - ((listp (cdr rule)) ; More than one class - (let ((classes (cdr rule)) - (rval (symbol-name (car rule)))) - (while classes - (setq rval (concat rval - (if (= (aref (car classes) 0) ?:) - (pop classes) - (concat "." (pop classes)))))) - rval)) - (t - (symbol-name (car rule))))) - -(defun css-display (sheet) - (with-output-to-temp-buffer "CSS Stylesheet" - (set-buffer standard-output) - (indented-text-mode) - (insert "# Stylesheet auto-regenerated by css.el\n#\n" - "# This is a mixture of the default stylesheet and any\n" - "# styles specified by the document. The rules are in no\n" - "# particular order.\n\n") - (let (tmp cur goal-col) - (cl-maphash - (function - (lambda (k v) - (while v - (setq cur (pop v)) - (insert (css-rule-name (car cur))) - (insert " { ") - (setq goal-col (point)) - (insert "\n") - ;; Display the rules - (setq tmp (cdr cur)) - (let (prop val) - (while tmp - (setq prop (caar tmp) - val (cdar tmp) - tmp (cdr tmp)) - (case (get prop 'css-type) - (symbol-list - (setq val (mapconcat 'symbol-name val ","))) - (weight - (setq val (substring (symbol-name val) 1 nil))) - (otherwise - nil) - ) - (insert (format " %s: %s;\n" prop val)))) - (insert "}\n\n"); - ))) - sheet)))) - -(provide 'css) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/custom-load.el --- a/lisp/w3/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,32 +0,0 @@ -;;; custom-load.el --- automatically extracted custom dependencies - -;; Created by SL Baur on Thu Oct 2 17:06:01 1997 - -;;; Code: - -(custom-put 'url 'custom-loads '("url-gw" "url-irc" "url-news" "url-vars" "url")) -(custom-put 'ssl 'custom-loads '("ssl")) -(custom-put 'url-cookie 'custom-loads '("url-cookie" "url-vars")) -(custom-put 'hypermedia 'custom-loads '("url-vars" "w3-cus")) -(custom-put 'w3-advanced 'custom-loads '("w3-cus")) -(custom-put 'w3-menus 'custom-loads '("w3-cus" "w3-menu")) -(custom-put 'url-gateway 'custom-loads '("url-gw")) -(custom-put 'w3-files 'custom-loads '("w3-cus")) -(custom-put 'comm 'custom-loads '("ssl")) -(custom-put 'url-cache 'custom-loads '("url-cache" "url-vars")) -(custom-put 'w3-printing 'custom-loads '("w3-cus")) -(custom-put 'w3-images 'custom-loads '("w3-cus")) -(custom-put 'url-history 'custom-loads '("url-vars")) -(custom-put 'url-hairy 'custom-loads '("url-vars")) -(custom-put 'url-mime 'custom-loads '("url-vars")) -(custom-put 'faces 'custom-loads '("font")) -(custom-put 'w3-hooks 'custom-loads '("w3-cus")) -(custom-put 'w3 'custom-loads '("w3-cus" "w3-script")) -(custom-put 'url-file 'custom-loads '("url-cache" "url-vars")) -(custom-put 'url-news 'custom-loads '("url-news")) -(custom-put 'w3-display 'custom-loads '("w3-cus")) -(custom-put 'w3-parsing 'custom-loads '("w3-cus")) -(custom-put 'i18n 'custom-loads '("url-vars")) -(custom-put 'w3-scripting 'custom-loads '("w3-script")) - -;;; custom-load.el ends here diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/devices.el --- a/lisp/w3/devices.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,342 +0,0 @@ -;;; devices.el -- XEmacs device API emulation -;; Author: wmperry -;; Created: 1997/09/05 15:41:55 -;; Version: 1.5 -;; Keywords: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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. -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; This is a complete implementation of all the device-* functions found in -;; XEmacs 19.14. A 'device' for Emacs 19 is just a frame, from which we can -;; determine the connection to an X display, etc. - -(require 'cl) -(eval-when-compile - (if (string-match "XEmacs" (emacs-version)) - (set 'byte-optimize nil))) - -(if (string-match "XEmacs" (emacs-version)) - nil -'() -(defalias 'selected-device 'ignore) -(defalias 'device-or-frame-p 'framep) -(defalias 'device-console 'ignore) -(defalias 'device-sound-enabled-p 'ignore) -(defalias 'device-live-p 'frame-live-p) -(defalias 'devicep 'framep) -(defalias 'frame-device 'identity) -(defalias 'redisplay-device 'redraw-frame) -(defalias 'redraw-device 'redraw-frame) -(defalias 'select-device 'select-frame) -(defalias 'set-device-class 'ignore) - -(defun make-device (type connection &optional props) - "Create a new device of type TYPE, attached to connection CONNECTION. - -The valid values for CONNECTION are device-specific; however, -CONNECTION is generally a string. (Specifically, for X devices, -CONNECTION should be a display specification such as \"foo:0\", and -for TTY devices, CONNECTION should be the filename of a TTY device -file, such as \"/dev/ttyp4\", or nil to refer to XEmacs' standard -input/output.) - -PROPS, if specified, should be a plist of properties controlling -device creation. - -If CONNECTION specifies an already-existing device connection, that -device is simply returned; no new device is created, and PROPS -have no effect." - (cond - ((and (eq type 'x) connection) - (make-frame-on-display connection props)) - ((eq type 'x) - (make-frame props)) - ((eq type 'tty) - nil) - (t - (error "Unsupported device-type: %s" type)))) - -(defun make-frame-on-device (type connection &optional props) - "Create a frame of type TYPE on CONNECTION. -TYPE should be a symbol naming the device type, i.e. one of - -x An X display. CONNECTION should be a standard display string - such as \"unix:0\", or nil for the display specified on the - command line or in the DISPLAY environment variable. Only if - support for X was compiled into XEmacs. -tty A standard TTY connection or terminal. CONNECTION should be - a TTY device name such as \"/dev/ttyp2\" (as determined by - the Unix command `tty') or nil for XEmacs' standard input - and output (usually the TTY in which XEmacs started). Only - if support for TTY's was compiled into XEmacs. -ns A connection to a machine running the NeXTstep windowing - system. Not currently implemented. -win32 A connection to a machine running Microsoft Windows NT or - Windows 95. Not currently implemented. -pc A direct-write MS-DOS frame. Not currently implemented. - -PROPS should be an plist of properties, as in the call to `make-frame'. - -If a connection to CONNECTION already exists, it is reused; otherwise, -a new connection is opened." - (make-device type connection props)) - -(defun make-tty-device (&optional tty terminal-type) - "Create a new device on TTY. - TTY should be the name of a tty device file (e.g. \"/dev/ttyp3\" under -SunOS et al.), as returned by the `tty' command. A value of nil means -use the stdin and stdout as passed to XEmacs from the shell. - If TERMINAL-TYPE is non-nil, it should be a string specifying the -type of the terminal attached to the specified tty. If it is nil, -the terminal type will be inferred from the TERM environment variable." - (make-device 'tty tty (list 'terminal-type terminal-type))) - -(defun make-x-device (&optional display) - (make-device 'x display)) - -(defun set-device-selected-frame (device frame) - "Set the selected frame of device object DEVICE to FRAME. -If DEVICE is nil, the selected device is used. -If DEVICE is the selected device, this makes FRAME the selected frame." - (select-frame frame)) - -(defun set-device-baud-rate (device rate) - "Set the output baud rate of DEVICE to RATE. -On most systems, changing this value will affect the amount of padding -and other strategic decisions made during redisplay." - (setq baud-rate rate)) - -(defun dfw-device (obj) - "Given a device, frame, or window, return the associated device. -Return nil otherwise." - (cond - ((windowp obj) - (window-frame obj)) - ((framep obj) - obj) - (t - nil))) - -(defun event-device (event) - "Return the device that EVENT occurred on. -This will be nil for some types of events (e.g. keyboard and eval events)." - (dfw-device (posn-window (event-start event)))) - -(defun device-connection (&optional device) - "Return the connection of the specified device. -DEVICE defaults to the selected device if omitted" - (or (cdr-safe (assq 'display (frame-parameters device))) "stdio")) - -(defun find-device (connection &optional type) - "Look for an existing device attached to connection CONNECTION. -Return the device if found; otherwise, return nil. - -If TYPE is specified, only return devices of that type; otherwise, -return devices of any type. (It is possible, although unlikely, -that two devices of different types could have the same connection -name; in such a case, the first device found is returned.)" - (let ((devices (device-list)) - (retval nil)) - (while (and devices (not nil)) - (if (equal connection (device-connection (car devices))) - (setq retval (car devices))) - (setq devices (cdr devices))) - retval)) - -(defalias 'get-device 'find-device) - -(defmacro device-baud-rate (&optional device) - "Return the output baud rate of DEVICE." - 'baud-rate) - -(defun device-on-window-system-p (&optional device) - "Return non-nil if DEVICE is on a window system. -This generally means that there is support for the mouse, the menubar, -the toolbar, glyphs, etc." - (and (cdr-safe (assq 'display (frame-parameters device))) t)) - -(defun device-name (&optional device) - "Return the name of the specified device." - (or (cdr-safe (assq 'display (frame-parameters device))) "stdio")) - -(defun device-frame-list (&optional device) - "Return a list of all frames on DEVICE. -If DEVICE is nil, the selected device will be used." - (let ((desired (device-connection device))) - (filtered-frame-list (function (lambda (x) (equal (device-connection x) - desired)))))) -(defun device-list () - "Return a list of all devices" - (let ((seen nil) - (cur nil) - (conn nil) - (retval nil) - (not-heard (frame-list))) - (while not-heard - (setq cur (car not-heard) - conn (device-connection cur) - not-heard (cdr not-heard)) - (if (member conn seen) - nil ; Already got it - (setq seen (cons conn seen) ; Whoo hoo, a new one! - retval (cons cur retval)))) - retval)) - -(defvar delete-device-hook nil - "Function or functions to call when a device is deleted. -One argument, the to-be-deleted device.") - -(defun delete-device (device &optional force) - "Delete DEVICE, permanently eliminating it from use. -Normally, you cannot delete the last non-minibuffer-only frame (you must -use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional -second argument FORCE is non-nil, you can delete the last frame. (This -will automatically call `save-buffers-kill-emacs'.)" - (let ((frames (device-frame-list device))) - (run-hook-with-args 'delete-device-hook device) - (while frames - (delete-frame (car frames) force) - (setq frames (cdr frames))))) - -(defun device-color-cells (&optional device) - (case window-system - ((x win32 w32 pm) (x-display-color-cells device)) - (ns (ns-display-color-cells device)) - (otherwise 1))) - -(defun device-pixel-width (&optional device) - (case window-system - ((x win32 w32 pm) (x-display-pixel-width device)) - (ns (ns-display-pixel-width device)) - (otherwise (frame-width device)))) - -(defun device-pixel-height (&optional device) - (case window-system - ((x win32 w32 pm) (x-display-pixel-height device)) - (ns (ns-display-pixel-height device)) - (otherwise (frame-height device)))) - -(defun device-mm-width (&optional device) - (case window-system - ((x win32 w32 pm) (x-display-mm-width device)) - (ns (ns-display-mm-width device)) - (otherwise nil))) - -(defun device-mm-height (&optional device) - (case window-system - ((x win32 w32 pm) (x-display-mm-height device)) - (ns (ns-display-mm-height device)) - (otherwise nil))) - -(defun device-bitplanes (&optional device) - (case window-system - ((x win32 w32 pm) (x-display-planes device)) - (ns (ns-display-planes device)) - (otherwise 2))) - -(defun device-class (&optional device) - (case window-system - (x ; X11 - (cond - ((fboundp 'x-display-visual-class) - (let ((val (symbol-name (x-display-visual-class device)))) - (cond - ((string-match "color" val) 'color) - ((string-match "gray-scale" val) 'grayscale) - (t 'mono)))) - ((fboundp 'x-display-color-p) - (if (x-display-color-p device) - 'color - 'mono)) - (t 'color))) - (pm ; OS/2 Presentation Manager - (cond - ((fboundp 'pm-display-visual-class) - (let ((val (symbol-name (pm-display-visual-class device)))) - (cond - ((string-match "color" val) 'color) - ((string-match "gray-scale" val) 'grayscale) - (t 'mono)))) - ((fboundp 'pm-display-color-p) - (if (pm-display-color-p device) - 'color - 'mono)) - (t 'color))) - (ns - (cond - ((fboundp 'ns-display-visual-class) - (let ((val (symbol-name (ns-display-visual-class device)))) - (cond - ((string-match "color" val) 'color) - ((string-match "gray-scale" val) 'grayscale) - (t 'mono)))) - ((fboundp 'ns-display-color-p) - (if (ns-display-color-p device) - 'color - 'mono)) - (t 'mono))) - (otherwise 'color))) - -(defun device-class-list () - "Returns a list of valid device classes." - (list 'color 'grayscale 'mono)) - -(defun valid-device-class-p (class) - "Given a CLASS, return t if it is valid. -Valid classes are 'color, 'grayscale, and 'mono." - (memq class (device-class-list))) - -(defun device-or-frame-type (device-or-frame) - "Return the type (e.g. `x' or `tty') of DEVICE-OR-FRAME. -DEVICE-OR-FRAME should be a device or a frame object. See `device-type' -for a description of the possible types." - (or window-system 'tty)) - -(defun device-type (&optional device) - "Return the type of the specified device (e.g. `x' or `tty'). -Value is `tty' for a tty device (a character-only terminal), -`x' for a device which is a connection to an X server, -'ns' for a device which is a connection to a NeXTStep dps server, -'win32' or 'w32' for a Windows-NT window, -'pm' for an OS/2 Presentation Manager window, -'intuition' for an Amiga screen" - (device-or-frame-type device)) - -(defun device-type-list () - "Return a list of valid console types." - (if window-system - (list window-system 'tty) - (list 'tty))) - -(defun valid-device-type-p (type) - "Given a TYPE, return t if it is valid." - (memq type (device-type-list))) - -) ; This closes the conditional on whether we are in XEmacs or not - -(provide 'devices) - -(eval-when-compile - (if (string-match "XEmacs" (emacs-version)) - (set 'byte-optimize t))) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/docomp.el --- a/lisp/w3/docomp.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,73 +0,0 @@ -(setq load-path (append (list (expand-file-name "./") - (or (getenv "WIDGETDIR") - (expand-file-name "../widget")) - ) - load-path)) - -(setq max-specpdl-size (* 10 max-specpdl-size) - max-lisp-eval-depth (* 10 max-lisp-eval-depth)) - -(defun w3-declare-variables (&rest args) - (while args - (eval (list 'defvar (car args) nil "")) - (setq args (cdr args)))) - -;; For Emacs 19 -(w3-declare-variables 'track-mouse 'menu-bar-help-menu 'menu-bar-mode - 'global-face-data) - -;; For XEmacs/Lucid -(w3-declare-variables 'current-menubar 'default-menubar 'extent - 'mode-motion-hook 'mode-popup-menu 'sound-alist - 'menubar-visible-p - 'inhibit-help-echo 'default-toolbar - 'bottom-toolbar-height 'top-toolbar-height - 'toolbar-buttons-captioned-p - 'right-toolbar-width 'left-toolbar-width - 'top-toolbar 'bottom-toolbar 'right-toolbar - 'left-toolbar 'device-fonts-cache - 'has-modeline-p 'baud-rate) - -;; For MULE -(w3-declare-variables '*noconv* '*autoconv* '*euc-japan* '*internal* - 'w3-mime-list-for-code-conversion 'lc-ltn1 - 'mule-version 'enable-multibyte-characters - 'mc-flag 'charset-latin-iso8859-1 - 'file-coding-system-for-read 'file-coding-system) - -;; For TM -(w3-declare-variables 'mime/editor-mode-flag 'mime-tag-format) - -;; For NNTP -(w3-declare-variables 'nntp-server-buffer 'nntp-server-process 'nntp/connection - 'gnus-nntp-server 'nntp-server-name 'nntp-version - 'gnus-default-nntp-server) - -;; For xpm-button -(w3-declare-variables 'x-library-search-path) - -;; For emacspeak -(w3-declare-variables 'dtk-voice-table 'dtk-punctuation-mode) - -;; For a few internal things -(w3-declare-variables 'tag 'w3-working-buffer 'proxy-info 'args - 'w3-image-widgets-waiting 'w3-form-info - 'w3-last-parse-tree 'command-line-args-left - 'standard-display-table 'w3-html-bookmarks - 'browse-url-browser-function 'widget-keymap) - -;; GNUS -(w3-declare-variables 'gnus-group-buffer 'gnus-version) - -(load "bytecomp" t t nil) -;; Emacs 19 byte compiler complains about too much stuff by default. -;; Turn off most of the warnings here. -(setq byte-compile-warnings '(free-vars) - byte-optimize t - ) - -(require 'cl) -(require 'w3-vars) -(require 'url) -(require 'mm) -(require 'w3-sysdp) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/dsssl-flow.el --- a/lisp/w3/dsssl-flow.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,124 +0,0 @@ -;;; dsssl-flow.el --- DSSSL flow objects -;; Author: wmperry -;; Created: 1997/04/21 15:58:59 -;; Version: 1.3 -;; Keywords: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996, 1997 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1997 by Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defstruct flow-object - (type 'unknown :read-only t) ; Name of this flow object - (properties nil) - (children nil) - (parent nil) - ) - -(defstruct dsssl-flow-processor - (name 'unknown :read-only t) ; Name of this processing backend - (init nil) ; initialize the backend - (handler nil) ; handle a single flow object - (sizeof nil) ; get size of a single flow object - (clean nil) ; cleanup instance of backend - ) - -(defvar dsssl-flow-active-faces nil) -(defvar dsssl-flow-active-voices nil) -(make-variable-buffer-local 'dsssl-flow-active-faces) -(make-variable-buffer-local 'dsssl-flow-active-voices) - -(defun dsssl-flow-display (flows processor) - (let ((handler (dsssl-flow-processor-handler processor)) - (flow-stack (list flows)) - (content nil) - (node nil) - (last-object nil) - ) - (while flow-stack - (setq content (pop flow-stack)) - (dsssl-flow-progress-meter) - ;; Handle the element's content - (while content - (dsssl-flow-progress-meter) - (if (stringp (car content)) - (dsssl-flow-handle-string-content (pop content)) - (setq node (pop content)) - ;; todo: collect all information about this flow object for faster - ;; lookup later. - (push (dsssl-flow-face-for-element node) dsssl-flow-active-faces) - (push (dsssl-flow-voice-for-element node) dsssl-flow-active-voices)) - (case (flow-object-type node) - ;; Core DSSL components basic flow object classes - (sequence ; 12.6.1 - ) - (display-group ; 12.6.2 - ) - (paragraph ; 12.6.6 - ) - (paragraph-break ; 12.6.7 - ) - (external-graphic ; 12.6.15 - ) - ;; DSSSL options required in DSSSL online - ;; Simple page flow object class - (simple-page-sequence ; 12.6.3 - ) - ;; Table flow object classes - (table ; 12.6.27.1 - ) - (table-part ; 12.6.27.2 - ) - (table-column ; 12.6.27.3 - ) - (table-row ; 12.6.27.5 - ) - (table-border ; 12.6.27.7 - ) - (table-cell ; 12.6.27.6 - ;; Do we need to handle table-cell at this level, or is that - ;; something that the display backend needs to handle, and we - ;; just query that in the `table-row' processor? - ) - ;; Online display flow object classes - (vertical-scroll ; 12.6.28.1 - ) - (multi-mode ; 12.6.28.2 - ) - (marginalia ; 12.6.28.4 - ) - ;; Emacs/W3 specific flow objects - (applet ; Wow, Java - ) - (script ; Scripts - ) - (form-element ; Any form element - ) - ;; pinhead, flame, and cookie can now all be handled by - ;; a stud-muffing DSSSL stylesheet - hooray! - - ;; Generic formatting - all things that can be fully specified - ;; by a CSS stylesheet. - (otherwise - ;; handle the content - (dsssl-flow-handle-content node))))))) - -(provide 'dsssl-flow) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/dsssl.el --- a/lisp/w3/dsssl.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,492 +0,0 @@ -;;; dsssl.el --- DSSSL parser -;; Author: wmperry -;; Created: 1997/06/10 06:01:32 -;; Version: 1.15 -;; Keywords: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996, 1997 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1997 by Free Software Foundation, Inc. -;;; -;;; 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 'cl) -(require 'dsssl-flow) - -(if (not (fboundp 'cl-copy-hashtable)) - (defun cl-copy-hashtable (h) - (let ((new (make-hash-table))) - (cl-maphash (function (lambda (k v) (cl-puthash k v new))) h) - new))) - -(defconst dsssl-builtin-functions - '(not boolean\? case equal\? null\? list\? list length append - reverse list-tail list-ref member symbol\? keyword\? quantity\? - number\? real\? integer\? = < > <= >= + * - / max min abs quotient - modulo remainder floor ceiling truncate round number->string - 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 identity error let) - "A list of all the builtin DSSSL functions that we support.") - -(defsubst dsssl-check-args (args expected) - ;; Signal an error if we don't have the expected # of arguments - (or (= (length args) expected) - (error "Wrong # arguments (expected %d): %d" expected (length args)))) - -(defsubst dsssl-min-args (args min) - (or (>= (length args) min) - (error "Wrong # arguments (expected at least %d): %d" min - (length args)))) - -(defun dsssl-call-function (func args) - (declare (special defines units)) - (let ((old-defines nil) - (old-units nil) - (func-args (nth 1 func)) - (real-func (nth 2 func)) - (retval nil)) - ;; Make sure we got the right # of arguments - (dsssl-check-args args (length func-args)) - - ;; make sure we evaluate all the arguments in the old environment - (setq args (mapcar 'dsssl-eval args)) - - ;; Save the old environment - (setq old-defines (cl-copy-hashtable defines) - old-units (cl-copy-hashtable units)) - - ;; Create the function's environment - (while func-args - (cl-puthash (car func-args) (car args) defines) - (setq func-args (cdr func-args) - args (cdr args))) - - ;; Now evaluate the function body, returning the value of the last one - (while real-func - (setq retval (dsssl-eval (car real-func)) - real-func (cdr real-func))) - - ;; Restore the previous environment - (setq defines old-defines - units old-units) - - ;; And we are out of here baby! - retval)) - -(defun dsssl-eval (form) - ;; We expect to have a 'defines' and 'units' hashtable floating around - ;; from higher up the call stack. - (declare (special defines units)) - (cond - ((consp form) ; A function call - (let ((func (car form)) - (args (cdr form))) - (case func - (cons - (dsssl-check-args args 2) - (cons (dsssl-eval (pop args)) (dsssl-eval (pop args)))) - (cdr - (dsssl-check-args args 1) - (cdr (dsssl-eval (pop args)))) - (car - (dsssl-check-args args 1) - (car (dsssl-eval (pop args)))) - (not - (dsssl-check-args args 1) - (not (dsssl-eval (car args)))) - (boolean\? - (dsssl-check-args args 1) - (and (symbolp (car args)) - (memq (car args) '(\#f \#t)))) - (if - (dsssl-min-args args 2) - (let ((val (dsssl-eval (pop args)))) - (if val - (dsssl-eval (nth 0 args)) - (if (nth 1 args) - (dsssl-eval (nth 1 args)))))) - (let ; FIXME - ) - (case - (dsssl-min-args args 2) - (let* ((val (dsssl-eval (pop args))) - (conditions args) - (done nil) - (possibles nil) - (cur nil)) - (while (and conditions (not done)) - (setq cur (pop conditions) - possibles (nth 0 cur)) - (if (or (and (listp possibles) - (member val possibles)) - (equal val possibles) - (memq possibles '(default otherwise))) - (setq done (dsssl-eval (nth 1 cur))))) - done)) - (equal\? - (dsssl-check-args args 2) - (equal (dsssl-eval (car args)) (dsssl-eval (cadr args)))) - (null\? - (dsssl-check-args args 1) - (null (dsssl-eval (car args)))) - (list\? - (dsssl-check-args args 1) - (listp (dsssl-eval (car args)))) - (list - (mapcar 'dsssl-eval args)) - (length - (dsssl-check-args args 1) - (length (dsssl-eval (car args)))) - (append - (apply 'append (mapcar 'dsssl-eval args))) - (reverse - (dsssl-check-args args 1) - (reverse (dsssl-eval (car args)))) - (list-tail - (dsssl-check-args args 2) - (nthcdr (dsssl-eval (car args)) (dsssl-eval (cadr args)))) - (list-ref - (dsssl-check-args args 2) - (nth (dsssl-eval (car args)) (dsssl-eval (cadr args)))) - (member - (dsssl-check-args args 2) - (member (dsssl-eval (car args)) (dsssl-eval (cadr args)))) - (symbol\? - (dsssl-check-args args 1) - (symbolp (dsssl-eval (car args)))) - (keyword\? - (dsssl-check-args args 1) - (keywordp (dsssl-eval (car args)))) - (quantity\? - (dsssl-check-args args 1) - (error "%s not implemented yet." func)) - (number\? - (dsssl-check-args args 1) - (numberp (dsssl-eval (car args)))) - (real\? - (dsssl-check-args args 1) - (let ((rval (dsssl-eval (car args)))) - (and (numberp rval) - (/= (truncate rval) rval)))) - (integer\? - (dsssl-check-args args 1) - (let ((rval (dsssl-eval (car args)))) - (and (numberp rval) - (= (truncate rval) rval)))) - ((= < > <= >=) - (dsssl-min-args args 2) - (let ((not-done t) - (initial (dsssl-eval (car args))) - (next nil)) - (setq args (cdr args)) - (while (and args not-done) - (setq next (dsssl-eval (car args)) - args (cdr args) - not-done (funcall func initial next) - initial next)) - not-done)) - ((+ *) - (dsssl-min-args args 2) - (let ((acc (dsssl-eval (car args)))) - (setq args (cdr args)) - (while args - (setq acc (funcall func acc (dsssl-eval (car args))) - args (cdr args))) - acc)) - (- - (dsssl-min-args args 1) - (apply func (mapcar 'dsssl-eval args))) - (/ - (dsssl-min-args args 1) - (if (= (length args) 1) - (/ 1 (dsssl-eval (car args))) - (apply func (mapcar 'dsssl-eval args)))) - ((max min) - (apply func (mapcar 'dsssl-eval args))) - (abs - (dsssl-check-args args 1) - (abs (dsssl-eval (car args)))) - (quotient ; FIXME - (error "`%s' not implemented yet!" func)) - (modulo - (dsssl-check-args args 2) - (mod (dsssl-eval (car args)) (dsssl-eval (cadr args)))) - (remainder - (dsssl-check-args args 2) - (% (dsssl-eval (car args)) (dsssl-eval (cadr args)))) - ((floor ceiling truncate round) - (dsssl-check-args args 1) - (funcall func (dsssl-eval (car args)))) - (number->string - (dsssl-min-args args 1) - (if (= (length args) 1) - (number-to-string (dsssl-eval (car args))) - (if (= (length args) 2) ; They gave us a radix - (error "Radix arg not supported yet.") - (dsssl-check-args args 1)))) - (string->number - (dsssl-min-args args 1) - (if (= (length args) 1) - (string-to-number (dsssl-eval (car args))) - (if (= (length args) 2) ; They gave us a radix - (error "Radix arg not supported yet.") - (dsssl-check-args args 1)))) - (char\? - (dsssl-check-args args 1) - (characterp (dsssl-eval (car args)))) - (char=\? - (dsssl-check-args args 2) - (char-equal (dsssl-eval (car args)) (dsssl-eval (cadr args)))) - (char-downcase - (dsssl-check-args args 1) - (downcase (dsssl-eval (car args)))) - (char-property ; FIXME - (error "`%s' not implemented yet!" func)) - (string\? - (dsssl-check-args args 1) - (stringp (dsssl-eval (car args)))) - (string - (dsssl-min-args args 1) - (mapconcat 'char-to-string (mapcar 'dsssl-eval args) "")) - (string-length - (dsssl-check-args args 1) - (length (dsssl-eval (car args)))) - (string-ref - (dsssl-check-args args 2) - (aref (dsssl-eval (car args)) (dsssl-eval (cadr args)))) - (string=\? - (dsssl-check-args args 2) - (string= (dsssl-eval (car args)) (dsssl-eval (cadr args)))) - (substring - (substring (dsssl-eval (pop args)) - (dsssl-eval (pop args)) - (dsssl-eval (pop args)))) - (string-append - (let ((rval "")) - (while args - (setq rval (concat rval (dsssl-eval (pop args))))) - rval)) - (procedure\? - (dsssl-check-args args 1) - (let* ((sym (dsssl-eval (car args))) - (def (cl-gethash sym defines))) - (or (memq sym dsssl-builtin-functions) - (and def (listp def) (eq (car def) 'lambda))))) - (apply ; FIXME - ) - (external-procedure ; FIXME - ) - (make - (let* ((type (dsssl-eval (pop args))) - (symname nil) - (props nil) - (tail nil) - (children nil) - (temp nil) - ) - ;; Massage :children into the last slot - (setq props (mapcar 'dsssl-eval args) - tail (last props) - children (car tail)) - (if (consp tail) - (setcar tail nil)) - (if (not (car props)) - (setq props nil)) - (setq temp (- (length props) 1)) - ;; Not sure if we should really bother with this or not, but - ;; it does at least make it look more common-lispy keywordish - ;; and such. DSSSL keywords look like font-weight:, this makes - ;; it :font-weight - (while (>= temp 0) - (setq symname (symbol-name (nth temp props))) - (if (string-match "^\\(.*\\):$" symname) - (setf (nth temp props) - (intern (concat ":" (match-string 1 symname))))) - (setq temp (- temp 2))) - - ;; Create the actual flow object - (make-flow-object :type type - :children children - :properties props) - ) - ) - (time - (mapconcat 'int-to-string (current-time) ":")) - (time->string - (dsssl-check-args args 1) - (current-time-string - (mapcar 'string-to-int - (split-string (dsssl-eval (car args)) ":")))) - (quote - (dsssl-check-args args 1) - (car args)) - (identity - (dsssl-check-args args 1) - (dsssl-eval (car args))) - (error - (apply 'error (mapcar 'dsssl-eval args))) - (otherwise - ;; A non-built-in function - look it up - (let ((def (cl-gethash func defines))) - (if (and def (listp def) (eq (car def) 'lambda)) - (dsssl-call-function def args) - (error "Symbol's function definition is void: %s" func)))) - ) - ) - ) - ((symbolp form) ; A variable - ;; A DSSSL keyword! - (if (string-match ":$" (symbol-name form)) - form - (let ((val (cl-gethash form defines 'ThIS-Is_A_BOgUs-VariuhhBBLE))) - (if (not (eq val 'ThIS-Is_A_BOgUs-VariuhhBBLE)) - val - ;; Ok, we got a bogus variable, but maybe it is really a UNIT - ;; dereference. Check. - (let ((name (symbol-name form)) - (the-units nil) - (number nil) - (conversion nil)) - (if (not (string-match "^\\([0-9.]+\\)\\([a-zA-Z]+\\)$" name)) - (error "Symbol's value as variable is void: %s" form) - (setq number (string-to-int (match-string 1 name)) - the-units (intern (downcase (match-string 2 name))) - conversion (cl-gethash the-units units)) - (if (or (not conversion) (not (numberp conversion))) - (error "Symbol's value as variable is void: %s" form) - (* number conversion)))))))) - (t - form) - ) - ) - -(defsubst dsssl-predeclared () - (declare (special defines units)) - (cl-puthash '\#f nil defines) - (cl-puthash 'nil nil defines) - (cl-puthash '\#t t defines) - ;; NOTE: All units are stored internally as points. - (cl-puthash 'in (float 72) units) - (cl-puthash 'mm (float (* 72 25.4)) units) - (cl-puthash 'cm (float (* 72 2.54)) units) - ) - -(defun dsssl-parse (buf) - ;; Return the full representation of the DSSSL stylesheet as a series - ;; of LISP objects. - (let ((defines (make-hash-table :size 13)) - (units (make-hash-table :size 13)) - (buf-contents nil)) - (dsssl-predeclared) - (save-excursion - (setq buf-contents (if (or (bufferp buf) (get-buffer buf)) - (progn - (set-buffer buf) - (buffer-string)) - buf)) - (set-buffer (generate-new-buffer " *dsssl-style*")) - (insert buf-contents) - (goto-char (point-min)) - (skip-chars-forward " \t\n\r") - (if (looking-at "<!") ; DOCTYPE present - (progn - ;; This should _DEFINITELY_ be smarter - (search-forward ">" nil t) - )) - (let ((result nil) - (temp nil) - (save-pos nil)) - (while (not (eobp)) - (condition-case () - (setq save-pos (point) - temp (read (current-buffer))) - (invalid-read-syntax - ;; This disgusting hack is in here so that we can basically - ;; extend the lisp reader to gracefully deal with converting - ;; DSSSL #\A to Emacs-Lisp ?A notation. If you know of a - ;; better way, please feel free to send me some email. - (setq temp nil) - (backward-char 1) - (if (looking-at "#\\\\") - (replace-match "?") - (insert "\\")) - (goto-char save-pos)) - (error nil)) - (cond - ((null temp) - nil) - ((listp temp) - (case (car temp) - (define-unit - (cl-puthash (cadr temp) (dsssl-eval (caddr temp)) - units)) - (define - (if (listp (cadr temp)) - ;; A function - (cl-puthash (caadr temp) - (list 'lambda - (cdadr temp) - (cddr temp)) defines) - ;; A normal define - (cl-puthash (cadr temp) - (dsssl-eval (caddr temp)) defines))) - (otherwise - (setq result (cons temp result))))) - (t - (setq result (cons temp result)))) - (skip-chars-forward " \t\n\r")) - (kill-buffer (current-buffer)) - (list defines units (nreverse result)))))) - -(defun dsssl-test (x) - (let* ((result (dsssl-parse x)) - (defines (nth 0 result)) - (units (nth 1 result)) - (forms (nth 2 result))) - (mapcar 'dsssl-eval forms))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The flow object classes. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defmacro flow-object-property (obj prop &optional default) - "Return property PROP of the DSSSL flow object OBJ. -OBJ can be any flow object class, as long as it was properly derived -from the base `flow-object' class." - (` (plist-get (flow-object-properties (, obj)) (, prop) (, default)))) - -;; Now for specific types of flow objects -;; Still to do: -;;; display-group -;;; paragraph -;;; sequence -;;; line-field -;;; paragraph-break -;;; simple-page-sequence -;;; score -;;; table -;;; table-row -;;; table-cell -;;; rule -;;; external-graphic - - -(provide 'dsssl) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/font.el --- a/lisp/w3/font.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1248 +0,0 @@ -;;; font.el --- New font model -;; Author: wmperry -;; Created: 1997/09/05 15:44:37 -;; Version: 1.52 -;; Keywords: faces - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The emacsen compatibility package - load it up before anything else -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'cl) -(require 'devices) - -(eval-and-compile - (condition-case () - (require 'custom) - (error nil)) - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - nil ;; We've got what we needed - ;; We have the old custom-library, hack around it! - (defmacro defgroup (&rest args) - nil) - (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))))) - -(if (not (fboundp 'try-font-name)) - (defun try-font-name (fontname &rest args) - (case window-system - ((x win32 w32 pm) (car-safe (x-list-fonts fontname))) - (ns (car-safe (ns-list-fonts fontname))) - (otherwise nil)))) - -(if (not (fboundp 'facep)) - (defun facep (face) - "Return t if X is a face name or an internal face vector." - (if (not window-system) - nil ; FIXME if FSF ever does TTY faces - (and (or (internal-facep face) - (and (symbolp face) (assq face global-face-data))) - t)))) - -(if (not (fboundp 'set-face-property)) - (defun set-face-property (face property value &optional locale - tag-set how-to-add) - "Change a property of FACE." - (and (symbolp face) - (put face property value)))) - -(if (not (fboundp 'face-property)) - (defun face-property (face property &optional locale tag-set exact-p) - "Return FACE's value of the given PROPERTY." - (and (symbolp face) (get face property)))) - -(require 'disp-table) - -(if (not (fboundp '<<)) (fset '<< 'lsh)) -(if (not (fboundp '&)) (fset '& 'logand)) -(if (not (fboundp '|)) (fset '| 'logior)) -(if (not (fboundp '~)) (fset '~ 'lognot)) -(if (not (fboundp '>>)) (defun >> (value count) (<< value (- count)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Lots of variables / keywords for use later in the program -;;; Not much should need to be modified -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst font-running-xemacs (string-match "XEmacs" (emacs-version)) - "Whether we are running in XEmacs or not.") - -(defmacro define-font-keywords (&rest keys) - (` - (eval-and-compile - (let ((keywords (quote (, keys)))) - (while keywords - (or (boundp (car keywords)) - (set (car keywords) (car keywords))) - (setq keywords (cdr keywords))))))) - -(defconst font-window-system-mappings - '((x . (x-font-create-name x-font-create-object)) - (ns . (ns-font-create-name ns-font-create-object)) - (win32 . (x-font-create-name x-font-create-object)) - (w32 . (x-font-create-name x-font-create-object)) - (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME - (tty . (tty-font-create-plist tty-font-create-object))) - "An assoc list mapping device types to the function used to create -a font name from a font structure.") - -(defconst ns-font-weight-mappings - '((:extra-light . "extralight") - (:light . "light") - (:demi-light . "demilight") - (:medium . "medium") - (:normal . "medium") - (:demi-bold . "demibold") - (:bold . "bold") - (:extra-bold . "extrabold")) - "An assoc list mapping keywords to actual NeXTstep specific -information to use") - -(defconst x-font-weight-mappings - '((:extra-light . "extralight") - (:light . "light") - (:demi-light . "demilight") - (:demi . "demi") - (:book . "book") - (:medium . "medium") - (:normal . "medium") - (:demi-bold . "demibold") - (:bold . "bold") - (:extra-bold . "extrabold")) - "An assoc list mapping keywords to actual Xwindow specific strings -for use in the 'weight' field of an X font string.") - -(defconst font-possible-weights - (mapcar 'car x-font-weight-mappings)) - -(defvar font-rgb-file nil - "Where the RGB file was found.") - -(defvar font-maximum-slippage "1pt" - "How much a font is allowed to vary from the desired size.") - -(defvar font-family-mappings - '( - ("serif" . ("new century schoolbook" - "utopia" - "charter" - "times" - "lucidabright" - "garamond" - "palatino" - "times new roman" - "baskerville" - "bookman" - "bodoni" - "computer modern" - "rockwell" - )) - ("sans-serif" . ("lucida" - "helvetica" - "gills-sans" - "avant-garde" - "univers" - "optima")) - ("elfin" . ("tymes")) - ("monospace" . ("courier" - "courier new" - "fixed" - "lucidatypewriter" - "clean" - "terminal")) - ("cursive" . ("sirene" - "zapf chancery")) - ) - "A list of font family mappings.") - -(define-font-keywords :family :style :size :registry :encoding) - -(define-font-keywords - :weight :extra-light :light :demi-light :medium :normal :demi-bold - :bold :extra-bold) - -(defvar font-style-keywords nil) - -(defsubst set-font-family (fontobj family) - (aset fontobj 1 family)) - -(defsubst set-font-weight (fontobj weight) - (aset fontobj 3 weight)) - -(defsubst set-font-style (fontobj style) - (aset fontobj 5 style)) - -(defsubst set-font-size (fontobj size) - (aset fontobj 7 size)) - -(defsubst set-font-registry (fontobj reg) - (aset fontobj 9 reg)) - -(defsubst set-font-encoding (fontobj enc) - (aset fontobj 11 enc)) - -(defsubst font-family (fontobj) - (aref fontobj 1)) - -(defsubst font-weight (fontobj) - (aref fontobj 3)) - -(defsubst font-style (fontobj) - (aref fontobj 5)) - -(defsubst font-size (fontobj) - (aref fontobj 7)) - -(defsubst font-registry (fontobj) - (aref fontobj 9)) - -(defsubst font-encoding (fontobj) - (aref fontobj 11)) - -(eval-when-compile - (defmacro define-new-mask (attr mask) - (` - (progn - (setq font-style-keywords - (cons (cons (quote (, attr)) - (cons - (quote (, (intern (format "set-font-%s-p" attr)))) - (quote (, (intern (format "font-%s-p" attr)))))) - font-style-keywords)) - (defconst (, (intern (format "font-%s-mask" attr))) (<< 1 (, mask)) - (, (format - "Bitmask for whether a font is to be rendered in %s or not." - attr))) - (defun (, (intern (format "font-%s-p" attr))) (fontobj) - (, (format "Whether FONTOBJ will be renderd in `%s' or not." attr)) - (if (/= 0 (& (font-style fontobj) - (, (intern (format "font-%s-mask" attr))))) - t - nil)) - (defun (, (intern (format "set-font-%s-p" attr))) (fontobj val) - (, (format "Set whether FONTOBJ will be renderd in `%s' or not." - attr)) - (cond - (val - (set-font-style fontobj (| (font-style fontobj) - (, (intern - (format "font-%s-mask" attr)))))) - (((, (intern (format "font-%s-p" attr))) fontobj) - (set-font-style fontobj (- (font-style fontobj) - (, (intern - (format "font-%s-mask" attr)))))))) - )))) - -(let ((mask 0)) - (define-new-mask bold (setq mask (1+ mask))) - (define-new-mask italic (setq mask (1+ mask))) - (define-new-mask oblique (setq mask (1+ mask))) - (define-new-mask dim (setq mask (1+ mask))) - (define-new-mask underline (setq mask (1+ mask))) - (define-new-mask overline (setq mask (1+ mask))) - (define-new-mask linethrough (setq mask (1+ mask))) - (define-new-mask strikethru (setq mask (1+ mask))) - (define-new-mask reverse (setq mask (1+ mask))) - (define-new-mask blink (setq mask (1+ mask))) - (define-new-mask smallcaps (setq mask (1+ mask))) - (define-new-mask bigcaps (setq mask (1+ mask))) - (define-new-mask dropcaps (setq mask (1+ mask)))) - -(defvar font-caps-display-table - (let ((table (make-display-table)) - (i 0)) - ;; Standard ASCII characters - (while (< i 26) - (aset table (+ i ?a) (+ i ?A)) - (setq i (1+ i))) - ;; Now ISO translations - (setq i 224) - (while (< i 247) ;; Agrave - Ouml - (aset table i (- i 32)) - (setq i (1+ i))) - (setq i 248) - (while (< i 255) ;; Oslash - Thorn - (aset table i (- i 32)) - (setq i (1+ i))) - table)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Utility functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defsubst set-font-style-by-keywords (fontobj styles) - (make-local-variable 'font-func) - (declare (special font-func)) - (if (listp styles) - (while styles - (setq font-func (car-safe (cdr-safe (assq (car styles) font-style-keywords))) - styles (cdr styles)) - (and (fboundp font-func) (funcall font-func fontobj t))) - (setq font-func (car-safe (cdr-safe (assq styles font-style-keywords)))) - (and (fboundp font-func) (funcall font-func fontobj t)))) - -(defsubst font-properties-from-style (fontobj) - (let ((style (font-style fontobj)) - (todo font-style-keywords) - type func retval) - (while todo - (setq func (cdr (cdr (car todo))) - type (car (pop todo))) - (if (funcall func fontobj) - (setq retval (cons type retval)))) - retval)) - -(defun font-unique (list) - (let ((retval) - (cur)) - (while list - (setq cur (car list) - list (cdr list)) - (if (member cur retval) - nil - (setq retval (cons cur retval)))) - (nreverse retval))) - -(defun font-higher-weight (w1 w2) - (let ((index1 (length (memq w1 font-possible-weights))) - (index2 (length (memq w2 font-possible-weights)))) - (cond - ((<= index1 index2) - (or w1 w2)) - ((not w2) - w1) - (t - w2)))) - -(defun font-spatial-to-canonical (spec &optional device) - "Convert SPEC (in inches, millimeters, points, or picas) into points" - ;; 1 in = 6 pa = 25.4 mm = 72 pt - (cond - ((numberp spec) - spec) - ((null spec) - nil) - (t - (let ((num nil) - (type nil) - ;; If for any reason we get null for any of this, default - ;; to 1024x768 resolution on a 17" screen - (pix-width (float (or (device-pixel-width device) 1024))) - (mm-width (float (or (device-mm-width device) 293))) - (retval nil)) - (cond - ((string-match "^ *\\([-+*/]\\) *" spec) ; math! whee! - (let ((math-func (intern (match-string 1 spec))) - (other (font-spatial-to-canonical - (substring spec (match-end 0) nil))) - (default (font-spatial-to-canonical - (font-default-size-for-device device)))) - (if (fboundp math-func) - (setq type "px" - spec (int-to-string (funcall math-func default other))) - (setq type "px" - spec (int-to-string other))))) - ((string-match "[^0-9.]+$" spec) - (setq type (substring spec (match-beginning 0)) - spec (substring spec 0 (match-beginning 0)))) - (t - (setq type "px" - spec spec))) - (setq num (string-to-number spec)) - (cond - ((member type '("pixel" "px" "pix")) - (setq retval (* num (/ pix-width mm-width) (/ 25.4 72.0)))) - ((member type '("point" "pt")) - (setq retval num)) - ((member type '("pica" "pa")) - (setq retval (* num 12.0))) - ((member type '("inch" "in")) - (setq retval (* num 72.0))) - ((string= type "mm") - (setq retval (* num (/ 72.0 25.4)))) - ((string= type "cm") - (setq retval (* num 10 (/ 72.0 25.4)))) - (t - (setq retval num)) - ) - retval)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The main interface routines - constructors and accessor functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun make-font (&rest args) - (vector :family - (if (stringp (plist-get args :family)) - (list (plist-get args :family)) - (plist-get args :family)) - :weight - (plist-get args :weight) - :style - (if (numberp (plist-get args :style)) - (plist-get args :style) - 0) - :size - (plist-get args :size) - :registry - (plist-get args :registry) - :encoding - (plist-get args :encoding))) - -(defun font-create-name (fontobj &optional device) - (let* ((type (device-type device)) - (func (car (cdr-safe (assq type font-window-system-mappings))))) - (and func (fboundp func) (funcall func fontobj device)))) - -;;;###autoload -(defun font-create-object (fontname &optional device) - (let* ((type (device-type device)) - (func (car (cdr (cdr-safe (assq type font-window-system-mappings)))))) - (and func (fboundp func) (funcall func fontname device)))) - -(defun font-combine-fonts-internal (fontobj-1 fontobj-2) - (let ((retval (make-font)) - (size-1 (and (font-size fontobj-1) - (font-spatial-to-canonical (font-size fontobj-1)))) - (size-2 (and (font-size fontobj-2) - (font-spatial-to-canonical (font-size fontobj-2))))) - (set-font-weight retval (font-higher-weight (font-weight fontobj-1) - (font-weight fontobj-2))) - (set-font-family retval (font-unique (append (font-family fontobj-1) - (font-family fontobj-2)))) - (set-font-style retval (| (font-style fontobj-1) (font-style fontobj-2))) - (set-font-registry retval (or (font-registry fontobj-1) - (font-registry fontobj-2))) - (set-font-encoding retval (or (font-encoding fontobj-1) - (font-encoding fontobj-2))) - (set-font-size retval (cond - ((and size-1 size-2 (>= size-2 size-1)) - (font-size fontobj-2)) - ((and size-1 size-2) - (font-size fontobj-1)) - (size-1 - (font-size fontobj-1)) - (size-2 - (font-size fontobj-2)) - (t nil))) - - retval)) - -(defun font-combine-fonts (&rest args) - (cond - ((null args) - (error "Wrong number of arguments to font-combine-fonts")) - ((= (length args) 1) - (car args)) - (t - (let ((retval (font-combine-fonts-internal (nth 0 args) (nth 1 args)))) - (setq args (cdr (cdr args))) - (while args - (setq retval (font-combine-fonts-internal retval (car args)) - args (cdr args))) - retval)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The window-system dependent code (TTY-style) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun tty-font-create-object (fontname &optional device) - (make-font :size "12pt")) - -(defun tty-font-create-plist (fontobj &optional device) - (let ((styles (font-style fontobj)) - (weight (font-weight fontobj))) - (list - (cons 'underline (font-underline-p fontobj)) - (cons 'highlight (if (or (font-bold-p fontobj) - (memq weight '(:bold :demi-bold))) t)) - (cons 'dim (font-dim-p fontobj)) - (cons 'blinking (font-blink-p fontobj)) - (cons 'reverse (font-reverse-p fontobj))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The window-system dependent code (X-style) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar font-x-font-regexp (or (and font-running-xemacs - (boundp 'x-font-regexp) - x-font-regexp) - (let - ((- "[-?]") - (foundry "[^-]*") - (family "[^-]*") - (weight "\\(bold\\|demibold\\|medium\\|black\\)") - (weight\? "\\([^-]*\\)") - (slant "\\([ior]\\)") - (slant\? "\\([^-]?\\)") - (swidth "\\([^-]*\\)") - (adstyle "\\([^-]*\\)") - (pixelsize "\\(\\*\\|[0-9]+\\)") - (pointsize "\\(\\*\\|0\\|[0-9][0-9]+\\)") - (resx "\\([*0]\\|[0-9][0-9]+\\)") - (resy "\\([*0]\\|[0-9][0-9]+\\)") - (spacing "[cmp?*]") - (avgwidth "\\(\\*\\|[0-9]+\\)") - (registry "[^-]*") - (encoding "[^-]+") - ) - (concat "\\`\\*?[-?*]" - foundry - family - weight\? - slant\? - swidth - adstyle - - pixelsize - pointsize - resx - resy - spacing - avgwidth - - registry - encoding "\\'" - )))) - -(defvar font-x-registry-and-encoding-regexp - (or (and font-running-xemacs - (boundp 'x-font-regexp-registry-and-encoding) - (symbol-value 'x-font-regexp-registry-and-encoding)) - (let ((- "[-?]") - (registry "[^-]*") - (encoding "[^-]+")) - (concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'")))) - -(defun x-font-create-object (fontname &optional device) - (let ((case-fold-search t)) - (if (or (not (stringp fontname)) - (not (string-match font-x-font-regexp fontname))) - (make-font) - (let ((family nil) - (style nil) - (size nil) - (weight (match-string 1 fontname)) - (slant (match-string 2 fontname)) - (swidth (match-string 3 fontname)) - (adstyle (match-string 4 fontname)) - (pxsize (match-string 5 fontname)) - (ptsize (match-string 6 fontname)) - (retval nil) - (case-fold-search t) - ) - (if (not (string-match x-font-regexp-foundry-and-family fontname)) - nil - (setq family (list (downcase (match-string 1 fontname))))) - (if (string= "*" weight) (setq weight nil)) - (if (string= "*" slant) (setq slant nil)) - (if (string= "*" swidth) (setq swidth nil)) - (if (string= "*" adstyle) (setq adstyle nil)) - (if (string= "*" pxsize) (setq pxsize nil)) - (if (string= "*" ptsize) (setq ptsize nil)) - (if ptsize (setq size (/ (string-to-int ptsize) 10))) - (if (and (not size) pxsize) (setq size (concat pxsize "px"))) - (if weight (setq weight (intern-soft (concat ":" (downcase weight))))) - (if (and adstyle (not (equal adstyle ""))) - (setq family (append family (list (downcase adstyle))))) - (setq retval (make-font :family family - :weight weight - :size size)) - (set-font-bold-p retval (eq :bold weight)) - (cond - ((null slant) nil) - ((member slant '("i" "I")) - (set-font-italic-p retval t)) - ((member slant '("o" "O")) - (set-font-oblique-p retval t))) - (if (string-match font-x-registry-and-encoding-regexp fontname) - (progn - (set-font-registry retval (match-string 1 fontname)) - (set-font-encoding retval (match-string 2 fontname)))) - retval)))) - -(defun x-font-families-for-device (&optional device no-resetp) - (condition-case () - (require 'x-font-menu) - (error nil)) - (or device (setq device (selected-device))) - (if (boundp 'device-fonts-cache) - (let ((menu (or (cdr-safe (assq device device-fonts-cache))))) - (if (and (not menu) (not no-resetp)) - (progn - (reset-device-font-menus device) - (x-font-families-for-device device t)) - (let ((scaled (mapcar (function (lambda (x) (if x (aref x 0)))) - (aref menu 0))) - (normal (mapcar (function (lambda (x) (if x (aref x 0)))) - (aref menu 1)))) - (sort (font-unique (nconc scaled normal)) 'string-lessp)))) - (cons "monospace" (mapcar 'car font-family-mappings)))) - -(defvar font-default-cache nil) - -;;;###autoload -(defun font-default-font-for-device (&optional device) - (or device (setq device (selected-device))) - (if font-running-xemacs - (font-truename - (make-font-specifier - (face-font-name 'default device))) - (let ((font (cdr-safe (assq 'font (frame-parameters device))))) - (if (and (fboundp 'fontsetp) (fontsetp font)) - (aref (get-font-info (aref (cdr (get-fontset-info font)) 0)) 2) - font)))) - -;;;###autoload -(defun font-default-object-for-device (&optional device) - (let ((font (font-default-font-for-device device))) - (or (cdr-safe - (assoc font font-default-cache)) - (progn - (setq font-default-cache (cons (cons font - (font-create-object font)) - font-default-cache)) - (cdr-safe (assoc font font-default-cache)))))) - -;;;###autoload -(defun font-default-family-for-device (&optional device) - (or device (setq device (selected-device))) - (font-family (font-default-object-for-device device))) - -;;;###autoload -(defun font-default-registry-for-device (&optional device) - (or device (setq device (selected-device))) - (font-registry (font-default-object-for-device device))) - -;;;###autoload -(defun font-default-encoding-for-device (&optional device) - (or device (setq device (selected-device))) - (font-encoding (font-default-object-for-device device))) - -;;;###autoload -(defun font-default-size-for-device (&optional device) - (or device (setq device (selected-device))) - ;; face-height isn't the right thing (always 1 pixel too high?) - ;; (if font-running-xemacs - ;; (format "%dpx" (face-height 'default device)) - (font-size (font-default-object-for-device device))) - -(defun x-font-create-name (fontobj &optional device) - (if (and (not (or (font-family fontobj) - (font-weight fontobj) - (font-size fontobj) - (font-registry fontobj) - (font-encoding fontobj))) - (= (font-style fontobj) 0)) - (face-font 'default) - (or device (setq device (selected-device))) - (let* ((default (font-default-object-for-device device)) - (family (or (font-family fontobj) - (font-family default) - (x-font-families-for-device device))) - (weight (or (font-weight fontobj) :medium)) - (style (font-style fontobj)) - (size (or (if font-running-xemacs - (font-size fontobj)) - (font-size default))) - (registry (or (font-registry fontobj) - (font-registry default) - "*")) - (encoding (or (font-encoding fontobj) - (font-encoding default) - "*"))) - (if (stringp family) - (setq family (list family))) - (setq weight (font-higher-weight weight - (and (font-bold-p fontobj) :bold))) - (if (stringp size) - (setq size (truncate (font-spatial-to-canonical size device)))) - (setq weight (or (cdr-safe (assq weight x-font-weight-mappings)) "*")) - (let ((done nil) ; Did we find a good font yet? - (font-name nil) ; font name we are currently checking - (cur-family nil) ; current family we are checking - ) - (while (and family (not done)) - (setq cur-family (car family) - family (cdr family)) - (if (assoc cur-family font-family-mappings) - ;; If the family name is an alias as defined by - ;; font-family-mappings, then append those families - ;; to the front of 'family' and continue in the loop. - (setq family (append - (cdr-safe (assoc cur-family - font-family-mappings)) - family)) - ;; Not an alias for a list of fonts, so we just check it. - ;; First, convert all '-' to spaces so that we don't screw up - ;; the oh-so wonderful X font model. Wheee. - (let ((x (length cur-family))) - (while (> x 0) - (if (= ?- (aref cur-family (1- x))) - (aset cur-family (1- x) ? )) - (setq x (1- x)))) - ;; We treat oblique and italic as equivalent. Don't ask. - (let ((slants '("o" "i"))) - (while (and slants (not done)) - (setq font-name (format "-*-%s-%s-%s-*-*-*-%s-*-*-*-*-%s-%s" - cur-family weight - (if (or (font-italic-p fontobj) - (font-oblique-p fontobj)) - (car slants) - "r") - (if size - (int-to-string (* 10 size)) "*") - registry - encoding - ) - slants (cdr slants) - done (try-font-name font-name device)))))) - (if done font-name))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The window-system dependent code (NS-style) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun ns-font-families-for-device (&optional device no-resetp) - ;; For right now, assume we are going to have the same storage for - ;; device fonts for NS as we do for X. Is this a valid assumption? - (or device (setq device (selected-device))) - (if (boundp 'device-fonts-cache) - (let ((menu (or (cdr-safe (assq device device-fonts-cache))))) - (if (and (not menu) (not no-resetp)) - (progn - (reset-device-font-menus device) - (ns-font-families-for-device device t)) - (let ((scaled (mapcar (function (lambda (x) (if x (aref x 0)))) - (aref menu 0))) - (normal (mapcar (function (lambda (x) (if x (aref x 0)))) - (aref menu 1)))) - (sort (font-unique (nconc scaled normal)) 'string-lessp)))))) - -(defun ns-font-create-name (fontobj &optional device) - (let ((family (or (font-family fontobj) - (ns-font-families-for-device device))) - (weight (or (font-weight fontobj) :medium)) - (style (or (font-style fontobj) (list :normal))) - (size (font-size fontobj)) - (registry (or (font-registry fontobj) "*")) - (encoding (or (font-encoding fontobj) "*"))) - ;; Create a font, wow! - (if (stringp family) - (setq family (list family))) - (if (or (symbolp style) (numberp style)) - (setq style (list style))) - (setq weight (font-higher-weight weight (car-safe (memq :bold style)))) - (if (stringp size) - (setq size (font-spatial-to-canonical size device))) - (setq weight (or (cdr-safe (assq weight ns-font-weight-mappings)) - "medium")) - (let ((done nil) ; Did we find a good font yet? - (font-name nil) ; font name we are currently checking - (cur-family nil) ; current family we are checking - ) - (while (and family (not done)) - (setq cur-family (car family) - family (cdr family)) - (if (assoc cur-family font-family-mappings) - ;; If the family name is an alias as defined by - ;; font-family-mappings, then append those families - ;; to the front of 'family' and continue in the loop. - (setq family (append - (cdr-safe (assoc cur-family - font-family-mappings)) - family)) - ;; CARL: Need help here - I am not familiar with the NS font - ;; model - (setq font-name "UNKNOWN FORMULA GOES HERE" - done (try-font-name font-name device)))) - (if done font-name)))) - - -;;; Cache building code -;;;###autoload -(defun x-font-build-cache (&optional device) - (let ((hashtable (make-hash-table :test 'equal :size 15)) - (fonts (mapcar 'x-font-create-object - (x-list-fonts "-*-*-*-*-*-*-*-*-*-*-*-*-*-*"))) - (plist nil) - (cur nil)) - (while fonts - (setq cur (car fonts) - fonts (cdr fonts) - plist (cl-gethash (car (font-family cur)) hashtable)) - (if (not (memq (font-weight cur) (plist-get plist 'weights))) - (setq plist (plist-put plist 'weights (cons (font-weight cur) - (plist-get plist 'weights))))) - (if (not (member (font-size cur) (plist-get plist 'sizes))) - (setq plist (plist-put plist 'sizes (cons (font-size cur) - (plist-get plist 'sizes))))) - (if (and (font-oblique-p cur) - (not (memq 'oblique (plist-get plist 'styles)))) - (setq plist (plist-put plist 'styles (cons 'oblique (plist-get plist 'styles))))) - (if (and (font-italic-p cur) - (not (memq 'italic (plist-get plist 'styles)))) - (setq plist (plist-put plist 'styles (cons 'italic (plist-get plist 'styles))))) - (cl-puthash (car (font-family cur)) plist hashtable)) - hashtable)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Now overwrite the original copy of set-face-font with our own copy that -;;; can deal with either syntax. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; ###autoload -(defun font-set-face-font (&optional face font &rest args) - (cond - ((and (vectorp font) (= (length font) 12)) - (let ((font-name (font-create-name font))) - (set-face-property face 'font-specification font) - (cond - ((null font-name) ; No matching font! - nil) - ((listp font-name) ; For TTYs - (let (cur) - (while font-name - (setq cur (car font-name) - font-name (cdr font-name)) - (apply 'set-face-property face (car cur) (cdr cur) args)))) - (font-running-xemacs - (apply 'set-face-font face font-name args) - (apply 'set-face-underline-p face (font-underline-p font) args) - (if (and (or (font-smallcaps-p font) (font-bigcaps-p font)) - (fboundp 'set-face-display-table)) - (apply 'set-face-display-table - face font-caps-display-table args)) - (apply 'set-face-property face 'strikethru (or - (font-linethrough-p font) - (font-strikethru-p font)) - args)) - (t - (condition-case nil - (apply 'set-face-font face font-name args) - (error - (let ((args (car-safe args))) - (and (or (font-bold-p font) - (memq (font-weight font) '(:bold :demi-bold))) - (make-face-bold face args t)) - (and (font-italic-p font) (make-face-italic face args t))))) - (apply 'set-face-underline-p face (font-underline-p font) args))))) - (t - ;; Let the original set-face-font signal any errors - (set-face-property face 'font-specification nil) - (apply 'set-face-font face font args)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Now for emacsen specific stuff -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun font-update-device-fonts (device) - ;; Update all faces that were created with the 'font' package - ;; to appear correctly on the new device. This should be in the - ;; create-device-hook. This is XEmacs 19.12+ specific - (let ((faces (face-list 2)) - (cur nil) - (font nil) - (font-spec nil)) - (while faces - (setq cur (car faces) - faces (cdr faces) - font-spec (face-property cur 'font-specification)) - (if font-spec - (set-face-font cur font-spec device))))) - -(defun font-update-one-face (face &optional device-list) - ;; Update FACE on all devices in DEVICE-LIST - ;; DEVICE_LIST defaults to a list of all active devices - (setq device-list (or device-list (device-list))) - (if (devicep device-list) - (setq device-list (list device-list))) - (let* ((cur-device nil) - (font-spec (face-property face 'font-specification)) - (font nil)) - (if (not font-spec) - ;; Hey! Don't mess with fonts we didn't create in the - ;; first place. - nil - (while device-list - (setq cur-device (car device-list) - device-list (cdr device-list)) - (if (not (device-live-p cur-device)) - ;; Whoah! - nil - (if font-spec - (set-face-font face font-spec cur-device))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Various color related things -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(cond - ((fboundp 'display-warning) - (fset 'font-warn 'display-warning)) - ((fboundp 'w3-warn) - (fset 'font-warn 'w3-warn)) - ((fboundp 'url-warn) - (fset 'font-warn 'url-warn)) - ((fboundp 'warn) - (defun font-warn (class message &optional level) - (warn "(%s/%s) %s" class (or level 'warning) message))) - (t - (defun font-warn (class message &optional level) - (save-excursion - (set-buffer (get-buffer-create "*W3-WARNINGS*")) - (goto-char (point-max)) - (save-excursion - (insert (format "(%s/%s) %s\n" class (or level 'warning) message))) - (display-buffer (current-buffer)))))) - -(defun font-lookup-rgb-components (color) - "Lookup COLOR (a color name) in rgb.txt and return a list of RGB values. -The list (R G B) is returned, or an error is signaled if the lookup fails." - (let ((lib-list (if (boundp 'x-library-search-path) - x-library-search-path - ;; This default is from XEmacs 19.13 - hope it covers - ;; everyone. - (list "/usr/X11R6/lib/X11/" - "/usr/X11R5/lib/X11/" - "/usr/lib/X11R6/X11/" - "/usr/lib/X11R5/X11/" - "/usr/local/X11R6/lib/X11/" - "/usr/local/X11R5/lib/X11/" - "/usr/local/lib/X11R6/X11/" - "/usr/local/lib/X11R5/X11/" - "/usr/X11/lib/X11/" - "/usr/lib/X11/" - "/usr/local/lib/X11/" - "/usr/X386/lib/X11/" - "/usr/x386/lib/X11/" - "/usr/XFree86/lib/X11/" - "/usr/unsupported/lib/X11/" - "/usr/athena/lib/X11/" - "/usr/local/x11r5/lib/X11/" - "/usr/lpp/Xamples/lib/X11/" - "/usr/openwin/lib/X11/" - "/usr/openwin/share/lib/X11/"))) - (file font-rgb-file) - r g b) - (if (not file) - (while lib-list - (setq file (expand-file-name "rgb.txt" (car lib-list))) - (if (file-readable-p file) - (setq lib-list nil - font-rgb-file file) - (setq lib-list (cdr lib-list) - file nil)))) - (if (null file) - (list 0 0 0) - (save-excursion - (set-buffer (find-file-noselect file)) - (if (not (= (aref (buffer-name) 0) ? )) - (rename-buffer (generate-new-buffer-name " *rgb-tmp-buffer*"))) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (if (re-search-forward (format "\t%s$" (regexp-quote color)) nil t) - (progn - (beginning-of-line) - (setq r (* (read (current-buffer)) 256) - g (* (read (current-buffer)) 256) - b (* (read (current-buffer)) 256))) - (font-warn 'color (format "No such color: %s" color)) - (setq r 0 - g 0 - b 0)) - (list r g b) )))))) - -(defun font-hex-string-to-number (string) - "Convert STRING to an integer by parsing it as a hexadecimal number." - (let ((conv-list '((?0 . 0) (?a . 10) (?A . 10) - (?1 . 1) (?b . 11) (?B . 11) - (?2 . 2) (?c . 12) (?C . 12) - (?3 . 3) (?d . 13) (?D . 13) - (?4 . 4) (?e . 14) (?E . 14) - (?5 . 5) (?f . 15) (?F . 15) - (?6 . 6) - (?7 . 7) - (?8 . 8) - (?9 . 9))) - (n 0) - (i 0) - (lim (length string))) - (while (< i lim) - (setq n (+ (* n 16) (or (cdr (assq (aref string i) conv-list)) 0)) - i (1+ i))) - n )) - -(defun font-parse-rgb-components (color) - "Parse RGB color specification and return a list of integers (R G B). -#FEFEFE and rgb:fe/fe/fe style specifications are parsed." - (let ((case-fold-search t) - r g b str) - (cond ((string-match "^#[0-9a-f]+$" color) - (cond - ((= (length color) 4) - (setq r (font-hex-string-to-number (substring color 1 2)) - g (font-hex-string-to-number (substring color 2 3)) - b (font-hex-string-to-number (substring color 3 4)) - r (* r 4096) - g (* g 4096) - b (* b 4096))) - ((= (length color) 7) - (setq r (font-hex-string-to-number (substring color 1 3)) - g (font-hex-string-to-number (substring color 3 5)) - b (font-hex-string-to-number (substring color 5 7)) - r (* r 256) - g (* g 256) - b (* b 256))) - ((= (length color) 10) - (setq r (font-hex-string-to-number (substring color 1 4)) - g (font-hex-string-to-number (substring color 4 7)) - b (font-hex-string-to-number (substring color 7 10)) - r (* r 16) - g (* g 16) - b (* b 16))) - ((= (length color) 13) - (setq r (font-hex-string-to-number (substring color 1 5)) - g (font-hex-string-to-number (substring color 5 9)) - b (font-hex-string-to-number (substring color 9 13)))) - (t - (font-warn 'color (format "Invalid RGB color specification: %s" - color)) - (setq r 0 - g 0 - b 0)))) - ((string-match "rgb:\\([0-9a-f]+\\)/\\([0-9a-f]+\\)/\\([0-9a-f]+\\)" - color) - (if (or (> (- (match-end 1) (match-beginning 1)) 4) - (> (- (match-end 2) (match-beginning 2)) 4) - (> (- (match-end 3) (match-beginning 3)) 4)) - (error "Invalid RGB color specification: %s" color) - (setq str (match-string 1 color) - r (* (font-hex-string-to-number str) - (expt 16 (- 4 (length str)))) - str (match-string 2 color) - g (* (font-hex-string-to-number str) - (expt 16 (- 4 (length str)))) - str (match-string 3 color) - b (* (font-hex-string-to-number str) - (expt 16 (- 4 (length str))))))) - (t - (font-warn 'html (format "Invalid RGB color specification: %s" - color)) - (setq r 0 - g 0 - b 0))) - (list r g b) )) - -(defsubst font-rgb-color-p (obj) - (or (and (vectorp obj) - (= (length obj) 4) - (eq (aref obj 0) 'rgb)))) - -(defsubst font-rgb-color-red (obj) (aref obj 1)) -(defsubst font-rgb-color-green (obj) (aref obj 2)) -(defsubst font-rgb-color-blue (obj) (aref obj 3)) - -(defun font-color-rgb-components (color) - "Return the RGB components of COLOR as a list of integers (R G B). -16-bit values are always returned. -#FEFEFE and rgb:fe/fe/fe style color specifications are parsed directly -into their components. -RGB values for color names are looked up in the rgb.txt file. -The variable x-library-search-path is use to locate the rgb.txt file." - (let ((case-fold-search t)) - (cond - ((and (font-rgb-color-p color) (floatp (aref color 1))) - (list (* 65535 (aref color 0)) - (* 65535 (aref color 1)) - (* 65535 (aref color 2)))) - ((font-rgb-color-p color) - (list (font-rgb-color-red color) - (font-rgb-color-green color) - (font-rgb-color-blue color))) - ((and (vectorp color) (= 3 (length color))) - (list (aref color 0) (aref color 1) (aref color 2))) - ((and (listp color) (= 3 (length color)) (floatp (car color))) - (mapcar (function (lambda (x) (* x 65535))) color)) - ((and (listp color) (= 3 (length color))) - color) - ((or (string-match "^#" color) - (string-match "^rgb:" color)) - (font-parse-rgb-components color)) - ((string-match "\\([0-9.]+\\)[ \t]\\([0-9.]+\\)[ \t]\\([0-9.]+\\)" - color) - (let ((r (string-to-number (match-string 1 color))) - (g (string-to-number (match-string 2 color))) - (b (string-to-number (match-string 3 color)))) - (if (floatp r) - (setq r (round (* 255 r)) - g (round (* 255 g)) - b (round (* 255 b)))) - (font-parse-rgb-components (format "#%02x%02x%02x" r g b)))) - (t - (font-lookup-rgb-components color))))) - -(defsubst font-tty-compute-color-delta (col1 col2) - (+ - (* (- (aref col1 0) (aref col2 0)) - (- (aref col1 0) (aref col2 0))) - (* (- (aref col1 1) (aref col2 1)) - (- (aref col1 1) (aref col2 1))) - (* (- (aref col1 2) (aref col2 2)) - (- (aref col1 2) (aref col2 2))))) - -(defun font-tty-find-closest-color (r g b) - ;; This is basically just a lisp copy of allocate_nearest_color - ;; from objects-x.c from Emacs 19 - ;; We really should just check tty-color-list, but unfortunately - ;; that does not include any RGB information at all. - ;; So for now we just hardwire in the default list and call it - ;; good for now. - (setq r (/ r 65535.0) - g (/ g 65535.0) - b (/ b 65535.0)) - (let* ((color_def (vector r g b)) - (colors [([1.0 1.0 1.0] . "white") - ([0.0 1.0 1.0] . "cyan") - ([1.0 0.0 1.0] . "magenta") - ([0.0 0.0 1.0] . "blue") - ([1.0 1.0 0.0] . "yellow") - ([0.0 1.0 0.0] . "green") - ([1.0 0.0 0.0] . "red") - ([0.0 0.0 0.0] . "black")]) - (no_cells (length colors)) - (x 1) - (nearest 0) - (nearest_delta 0) - (trial_delta 0)) - (setq nearest_delta (font-tty-compute-color-delta (car (aref colors 0)) - color_def)) - (while (/= no_cells x) - (setq trial_delta (font-tty-compute-color-delta (car (aref colors x)) - color_def)) - (if (< trial_delta nearest_delta) - (setq nearest x - nearest_delta trial_delta)) - (setq x (1+ x))) - (cdr-safe (aref colors nearest)))) - -(defun font-normalize-color (color &optional device) - "Return an RGB tuple, given any form of input. If an error occurs, black -is returned." - (case (device-type device) - ((x pm) - (apply 'format "#%02x%02x%02x" (font-color-rgb-components color))) - (win32 - (let* ((rgb (font-color-rgb-components color)) - (color (apply 'format "#%02x%02x%02x" rgb))) - (win32-define-rgb-color (nth 0 rgb) (nth 1 rgb) (nth 2 rgb) color) - color)) - (w32 - (let* ((rgb (font-color-rgb-components color)) - (color (apply 'format "#%02x%02x%02x" rgb))) - (w32-define-rgb-color (nth 0 rgb) (nth 1 rgb) (nth 2 rgb) color) - color)) - (tty - (apply 'font-tty-find-closest-color (font-color-rgb-components color))) - (ns - (let ((vals (mapcar (function (lambda (x) (>> x 8))) - (font-color-rgb-components color)))) - (apply 'format "RGB%02x%02x%02xff" vals))) - (otherwise - color))) - -(defun font-set-face-background (&optional face color &rest args) - (interactive) - (condition-case nil - (cond - ((or (font-rgb-color-p color) - (string-match "^#[0-9a-fA-F]+$" color)) - (apply 'set-face-background face - (font-normalize-color color) args)) - (t - (apply 'set-face-background face color args))) - (error nil))) - -(defun font-set-face-foreground (&optional face color &rest args) - (interactive) - (condition-case nil - (cond - ((or (font-rgb-color-p color) - (string-match "^#[0-9a-fA-F]+$" color)) - (apply 'set-face-foreground face (font-normalize-color color) args)) - (t - (apply 'set-face-foreground face color args))) - (error nil))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for 'blinking' fonts -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun font-map-windows (func &optional arg frame) - (let* ((start (selected-window)) - (cur start) - (result nil)) - (push (funcall func start arg) result) - (while (not (eq start (setq cur (next-window cur)))) - (push (funcall func cur arg) result)) - result)) - -(defun font-face-visible-in-window-p (window face) - (let ((st (window-start window)) - (nd (window-end window)) - (found nil) - (face-at nil)) - (setq face-at (get-text-property st 'face (window-buffer window))) - (if (or (eq face face-at) (and (listp face-at) (memq face face-at))) - (setq found t)) - (while (and (not found) - (/= nd - (setq st (next-single-property-change - st 'face - (window-buffer window) nd)))) - (setq face-at (get-text-property st 'face (window-buffer window))) - (if (or (eq face face-at) (and (listp face-at) (memq face face-at))) - (setq found t))) - found)) - -(defun font-blink-callback () - ;; Optimized to never invert the face unless one of the visible windows - ;; is showing it. - (let ((faces (if font-running-xemacs (face-list t) (face-list))) - (obj nil)) - (while faces - (if (and (setq obj (face-property (car faces) 'font-specification)) - (font-blink-p obj) - (memq t - (font-map-windows 'font-face-visible-in-window-p (car faces)))) - (invert-face (car faces))) - (pop faces)))) - -(defcustom font-blink-interval 0.5 - "How often to blink faces" - :type 'number - :group 'faces) - -(defun font-blink-initialize () - (cond - ((featurep 'itimer) - (if (get-itimer "font-blinker") - (delete-itimer (get-itimer "font-blinker"))) - (start-itimer "font-blinker" 'font-blink-callback - font-blink-interval - font-blink-interval)) - ((fboundp 'run-at-time) - (cancel-function-timers 'font-blink-callback) - (run-at-time font-blink-interval - font-blink-interval - 'font-blink-callback)) - (t nil))) - -(provide 'font) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/html32.dsl --- a/lisp/w3/html32.dsl Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,888 +0,0 @@ -<!doctype style-sheet PUBLIC "-//James Clark//DTD DSSSL Style Sheet//EN"> - -;; ###################################################################### -;; -;; DSSSL style sheet for HTML 3.2 print output -;; -;; 1996.11.17 -;; -;; Base version, August 1996: Jon Bosak, Sun Microsystems, based on work -;; by Anders Berglund, EBT, with critical assistance from James Clark -;; TOC section and recto/verso page treatments based on models by James -;; Clark, October 1996 -;; -;; ###################################################################### - -;; Features in HTML 3.2 that are not implemented in the style sheet: -;; -;; automatic table column widths -;; % on width attribute for TABLE -;; attributes on TH and TD: align, valign, rowspan, colspan -;; attributes on TABLE: width, align, border, cellspacing, cellpadding -;; start attribute on OL -;; value attribute on LI -;; noshade attribute on HR -;; -;; See also "Non-Printing Elements" below -;; -;; Features in the style sheet that are not in HTML 3.2: -;; -;; page headers that display the HEAD TITLE content -;; page footers that display the page number -;; autonumbering of heads and table captions -;; support for named units (pt, pi, cm, mm) in size attributes -;; automatic TOC generation - -;; ============================== UNITS ================================ - -(define-unit pi (/ 1in 6)) -(define-unit pt (/ 1in 72)) -(define-unit px (/ 1in 96)) - -;; see below for definition of "em" - - -;; ============================ PARAMETERS ============================== - -;; ........................... Basic "look" ............................. - -;; Visual acuity levels are "normal", "presbyopic", and -;; "large-type"; set the line following to choose the level - -(define %visual-acuity% "normal") -;; (define %visual-acuity% "presbyopic") -;; (define %visual-acuity% "large-type") - -(define %bf-size% - (case %visual-acuity% - (("normal") 11pt) - (("presbyopic") 12pt) - (("large-type") 24pt))) -(define %mf-size% (- %bf-size% 1pt)) -(define %hf-size% %bf-size%) - -(define-unit em %bf-size%) - -(define %autonum-level% 6) ;; zero disables autonumbering -(define %flushtext-headlevel% ;; heads above this hang out on the left - (if (equal? %visual-acuity% "large-type") 6 4)) -(define %body-start-indent% ;; sets the white space on the left - (if (equal? %visual-acuity% "large-type") 0pi 4pi)) -(define %toc?% #t) ;; enables TOC after H1 - -;; ........................ Basic page geometry ......................... - -(define %page-width% 8.5in) -(define %page-height% 11in) - -(define %left-right-margin% 6pi) -(define %top-margin% - (if (equal? %visual-acuity% "large-type") 7.5pi 6pi)) -(define %bottom-margin% - (if (equal? %visual-acuity% "large-type") 7.5pi 6pi)) -(define %header-margin% - (if (equal? %visual-acuity% "large-type") 4.5pi 3pi)) -(define %footer-margin% 3.5pi) - -(define %text-width% (- %page-width% (* %left-right-margin% 2))) -(define %body-width% (- %text-width% %body-start-indent%)) - -;; .......................... Spacing factors ........................... - -(define %para-sep% (/ %bf-size% 2.0)) -(define %block-sep% (* %para-sep% 2.0)) - -(define %line-spacing-factor% 1.2) -(define %bf-line-spacing% (* %bf-size% %line-spacing-factor%)) -(define %mf-line-spacing% (* %mf-size% %line-spacing-factor%)) -(define %hf-line-spacing% (* %hf-size% %line-spacing-factor%)) - -(define %head-before-factor% 1.0) -(define %head-after-factor% 0.6) -(define %hsize-bump-factor% 1.2) - -(define %ss-size-factor% 0.6) -(define %ss-shift-factor% 0.4) -(define %smaller-size-factor% 0.9) -(define %bullet-size-factor% 0.8) - -;; ......................... Fonts and bullets .......................... - -;; these font selections are for Windows 95 - -(define %title-font-family% "Arial") -(define %body-font-family% "Times New Roman") -(define %mono-font-family% "Courier New") -(define %dingbat-font-family% "Wingdings") - -;; these "bullet strings" are a hack that is completely dependent on -;; the Wingdings font family selected above; consider this a -;; placeholder for suitable ISO 10646 characters - -(define %disk-bullet% "l") -(define %circle-bullet% "¡") -(define %square-bullet% "o") - -(define %bullet-size% (* %bf-size% %bullet-size-factor%)) - - -;; ========================== COMMON FUNCTIONS ========================== - -(define (expt b n) - (if (= n 0) - 1 - (* b (expt b (- n 1))))) - -;; per ISO/IEC 10179 -(define (node-list-reduce nl proc init) - (if (node-list-empty? nl) - init - (node-list-reduce (node-list-rest nl) - proc - (proc init (node-list-first nl))))) - -;; per ISO/IEC 10179 -(define (node-list-length nl) - (node-list-reduce nl - (lambda (result snl) - (+ result 1)) - 0)) - -(define if-front-page - (external-procedure "UNREGISTERED::James Clark//Procedure::if-front-page")) - -(define if-first-page - (external-procedure "UNREGISTERED::James Clark//Procedure::if-first-page")) - -(define upperalpha - '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M - #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)) - -(define loweralpha - '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m - #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)) - -(define (char-downcase ch) - (case ch - ((#\A) #\a) ((#\B) #\b) ((#\C) #\c) ((#\D) #\d) ((#\E) #\e) - ((#\F) #\f) ((#\G) #\g) ((#\H) #\h) ((#\I) #\i) ((#\J) #\j) - ((#\K) #\k) ((#\L) #\l) ((#\M) #\m) ((#\N) #\n) ((#\O) #\o) - ((#\P) #\p) ((#\Q) #\q) ((#\R) #\r) ((#\S) #\s) ((#\T) #\t) - ((#\U) #\u) ((#\V) #\v) ((#\W) #\w) ((#\X) #\x) ((#\Y) #\y) - ((#\Z) #\z) (else ch))) - -(define (LOCASE slist) - (if (null? slist) - '() - (cons (char-downcase (car slist)) (LOCASE (cdr slist))))) - -(define (STR2LIST s) - (let ((len (string-length s))) - (let loop ((i 0) (ln len)) - (if (= i len) - '() - (cons (string-ref s i) (loop (+ i 1) ln)))))) - -(define (STRING-DOWNCASE s) - (apply string (LOCASE (STR2LIST s)))) - -(define (UNAME-START-INDEX u last) - (let ((c (string-ref u last))) - (if (or (member c upperalpha) (member c loweralpha)) - (if (= last 0) - 0 - (UNAME-START-INDEX u (- last 1))) - (+ last 1)))) - -(define (PARSEDUNIT u) ;; this doesn't deal with "%" yet - (if (string? u) - (let ((strlen (string-length u))) - (if (> strlen 2) - (let ((u-s-i (UNAME-START-INDEX u (- strlen 1)))) - (if (= u-s-i 0) ;; there's no number here - 1pi ;; so return something that might work - (if (= u-s-i strlen) ;; there's no unit name here - (* (string->number u) 1px) ;; so default to pixels (3.2) - (let* ((unum (string->number - (substring u 0 u-s-i))) - (uname (STRING-DOWNCASE - (substring u u-s-i strlen)))) - (case uname - (("mm") (* unum 1mm)) - (("cm") (* unum 1cm)) - (("in") (* unum 1in)) - (("pi") (* unum 1pi)) - (("pc") (* unum 1pi)) - (("pt") (* unum 1pt)) - (("px") (* unum 1px)) - (("barleycorn") (* unum 2pi)) ;; extensible! - (else - (cond - ((number? unum) - (* unum 1px)) - ((number? (string->number u)) - (* (string->number u) 1px)) - (else u)))))))) - (if (number? (string->number u)) - (* (string->number u) 1px) - 1pi))) - 1pi)) - -(define (INLIST?) - (or - (have-ancestor? "OL") - (have-ancestor? "UL") - (have-ancestor? "DIR") - (have-ancestor? "MENU") - (have-ancestor? "DL"))) - -(define (INHEAD?) - (or - (have-ancestor? "H1") - (have-ancestor? "H2") - (have-ancestor? "H3") - (have-ancestor? "H4") - (have-ancestor? "H5") - (have-ancestor? "H6"))) - -(define (HSIZE n) - (* %bf-size% - (expt %hsize-bump-factor% n))) - -(define (OLSTEP) - (case (modulo (length (hierarchical-number-recursive "OL")) 4) - ((1) 1.2em) - ((2) 1.2em) - ((3) 1.6em) - ((0) 1.4em))) - -(define (ULSTEP) 1em) - -(define (PQUAD) - (case (attribute-string "align") - (("LEFT") 'start) - (("CENTER") 'center) - (("RIGHT") 'end) - (else (inherited-quadding)))) - -(define (HQUAD) - (cond - ((string? (attribute-string "align")) (PQUAD)) - ((have-ancestor? "CENTER") 'center) - ((have-ancestor? "DIV") (inherited-quadding)) - (else 'start))) - -(define (BULLSTR sty) - (case sty - (("circle") %circle-bullet%) - (("square") %square-bullet%) - (else %disk-bullet%))) - - -;; ======================= NON-PRINTING ELEMENTS ======================== - -;; Note that HEAD includes TITLE, ISINDEX, BASE, META, STYLE, -;; SCRIPT, and LINK as possible children - -(element HEAD (empty-sosofo)) -(element FORM (empty-sosofo)) -(element APPLET (empty-sosofo)) -(element PARAM (empty-sosofo)) -(element TEXTFLOW (empty-sosofo)) -(element MAP (empty-sosofo)) -(element AREA (empty-sosofo)) - - -;; ========================== TABLE OF CONTENTS ========================= - -;; Container elements in which to look for headings -(define %clist% '("BODY" "DIV" "CENTER" "BLOCKQUOTE" "FORM")) - -(mode toc - (element h1 (empty-sosofo)) - (element h2 ($toc-entry$ 2)) - (element h3 ($toc-entry$ 3)) - (element h4 ($toc-entry$ 4)) - (element h5 ($toc-entry$ 5)) - (element h6 ($toc-entry$ 6)) - (default (apply process-matching-children - (append %hlist% %clist%))) -) - -(define %toc-indent% 1em) - -(define ($toc-entry$ level) - (make paragraph - use: para-style - start-indent: (+ %body-start-indent% - (* %toc-indent% (+ 1 level))) - first-line-start-indent: (* -3 %toc-indent%) - quadding: 'start - (literal (NUMLABEL level)) - (make link - destination: (current-node-address) - (with-mode #f (process-children-trim))) - (make leader (literal ".")) - (current-node-page-number-sosofo))) - -(define (MAKEBODYRULE) - (make rule - orientation: 'horizontal - space-before: (* 2 %block-sep%) - space-after: (* 2 %block-sep%) - line-thickness: 1pt - length: %body-width% - start-indent: %body-start-indent% - display-alignment: 'start)) - -(define (MAKETOC) - (if %toc?% - (sosofo-append - (MAKEBODYRULE) - (make paragraph - font-family-name: %title-font-family% - font-weight: 'bold - font-posture: 'upright - font-size: (HSIZE 2) - line-spacing: (* (HSIZE 2) %line-spacing-factor%) - space-before: (* (HSIZE 2) %head-before-factor%) - space-after: (* (HSIZE 2) %head-after-factor%) - start-indent: %body-start-indent% - quadding: 'start - keep-with-next?: #t - (literal "Table of Contents")) - (with-mode toc - (process-node-list (ancestor "BODY"))) - (MAKEBODYRULE)) - (empty-sosofo))) - -;; ============================ TOP LEVEL =============================== - -(define page-style - (style - page-width: %page-width% - page-height: %page-height% - left-margin: %left-right-margin% - right-margin: %left-right-margin% - top-margin: %top-margin% - bottom-margin: %bottom-margin% - header-margin: %header-margin% - footer-margin: %footer-margin% - font-family-name: %body-font-family% - font-size: %bf-size% - line-spacing: %bf-line-spacing%)) - -(element HTML - (let ((page-footer - (make sequence - font-size: %hf-size% - line-spacing: %hf-line-spacing% - font-posture: 'italic - (literal "Page ") - (page-number-sosofo))) - (page-header - (make sequence - font-size: %hf-size% - line-spacing: %hf-line-spacing% - font-posture: 'italic - (process-first-descendant "TITLE")))) - (make simple-page-sequence - use: page-style - left-header: (if-first-page - (empty-sosofo) - (if-front-page (empty-sosofo) page-header)) - right-header: (if-first-page - (empty-sosofo) - (if-front-page page-header (empty-sosofo))) - left-footer: (if-first-page - (empty-sosofo) - (if-front-page (empty-sosofo) page-footer)) - right-footer: (if-first-page - (empty-sosofo) - (if-front-page page-footer (empty-sosofo))) - input-whitespace-treatment: 'collapse - quadding: 'justify - (process-children-trim)))) - -(element BODY (process-children-trim)) - -;; ========================== BLOCK ELEMENTS ============================ - -;; ............................ Generic DIV ............................. - -(element DIV - (let ((align (attribute-string "align"))) - (make display-group - quadding: - (case align - (("LEFT") 'start) - (("CENTER") 'center) - (("RIGHT") 'end) - (else 'justify)) - (process-children-trim)))) - -(element CENTER - (make display-group - quadding: 'center - (process-children-trim))) - - -;; .............................. Headings .............................. - -(define %hlist% '("H1" "H2" "H3" "H4" "H5" "H6")) - -(define (NUMLABEL hlvl) - (let ((enl (element-number-list - (reverse (list-tail (reverse %hlist%) (- 6 hlvl)))))) - (let loop ((idx 1)) - (if (or (= idx %autonum-level%) (= idx hlvl)) - (if (= idx 2) ". " " ") - (let ((thisnum (list-ref enl idx))) - (string-append - (if (> idx 1) "." "") - (format-number thisnum "1") - (loop (+ idx 1)))))))) - -(define ($heading$ headlevel) - (let ((headsize (if (= headlevel 6) 0 (- 5 headlevel)))) - (make paragraph - font-family-name: %title-font-family% - font-weight: (if (< headlevel 6) 'bold 'medium) - font-posture: (if (< headlevel 6) 'upright 'italic) - font-size: (HSIZE headsize) - line-spacing: (* (HSIZE headsize) %line-spacing-factor%) - space-before: (* (HSIZE headsize) %head-before-factor%) - space-after: (if (and %toc?% (= headlevel 1)) - 4em ;; space if H1 before TOC - (* (HSIZE headsize) %head-after-factor%)) - start-indent: - (if (< headlevel %flushtext-headlevel%) - 0pt - %body-start-indent%) - quadding: (HQUAD) - keep-with-next?: #t - break-before: (if (and - %toc?% - (= headlevel 2) - (= (child-number) 1)) - 'page #f) ;; if TOC on, break before first H2 - (literal - (if (and (<= headlevel %autonum-level%) (> headlevel 1)) - (NUMLABEL headlevel) - (string-append ""))) - (process-children-trim)))) - -(element H1 - (sosofo-append - ($heading$ 1) - (MAKETOC))) - -(element H2 ($heading$ 2)) -(element H3 ($heading$ 3)) -(element H4 ($heading$ 4)) -(element H5 ($heading$ 5)) -(element H6 ($heading$ 6)) - - -;; ............................ Paragraphs .............................. - -(define para-style - (style - font-size: %bf-size% - font-weight: 'medium - font-posture: 'upright - font-family-name: %body-font-family% - line-spacing: %bf-line-spacing%)) - -(element P - (make paragraph - use: para-style - space-before: %para-sep% - start-indent: %body-start-indent% - quadding: (PQUAD) - (process-children-trim))) - -(element ADDRESS - (make paragraph - use: para-style - font-posture: 'italic - space-before: %para-sep% - start-indent: %body-start-indent% - (process-children-trim))) - -(element BLOCKQUOTE - (make paragraph - font-size: (- %bf-size% 1pt) - line-spacing: (- %bf-line-spacing% 1pt) - space-before: %para-sep% - start-indent: (+ %body-start-indent% 1em) - end-indent: 1em - (process-children-trim))) - -(define ($monopara$) - (make paragraph - use: para-style - space-before: %para-sep% - start-indent: %body-start-indent% - lines: 'asis - font-family-name: %mono-font-family% - font-size: %mf-size% - input-whitespace-treatment: 'preserve - quadding: 'start - (process-children-trim))) - -(element PRE ($monopara$)) -(element XMP ($monopara$)) -(element LISTING ($monopara$)) -(element PLAINTEXT ($monopara$)) - -(element BR - (make display-group - (empty-sosofo))) - - -;; ................... Lists: UL, OL, DIR, MENU, DL ..................... - -(define ($list-container$) - (make display-group - space-before: (if (INLIST?) %para-sep% %block-sep%) - space-after: (if (INLIST?) %para-sep% %block-sep%) - start-indent: (if (INLIST?) - (inherited-start-indent) - %body-start-indent%))) - -(define ($li-para$) - (make paragraph - use: para-style - start-indent: (+ (inherited-start-indent) (OLSTEP)) - first-line-start-indent: (- (OLSTEP)) - (process-children-trim))) - -(element UL ($list-container$)) - -(element (UL LI) - (let ((isnested (> (length (hierarchical-number-recursive "UL")) 1))) - (make paragraph - use: para-style - space-before: - (if (attribute-string "compact" (ancestor "UL")) 0pt %para-sep%) - start-indent: (+ (inherited-start-indent) (ULSTEP)) - first-line-start-indent: (- (ULSTEP)) - (make line-field - font-family-name: %dingbat-font-family% - font-size: (if isnested - (* %bullet-size% %bullet-size-factor%) - %bullet-size%) - field-width: (ULSTEP) - (literal - (let - ((litype - (attribute-string "type")) - (ultype - (attribute-string "type" (ancestor "UL")))) - (cond - ((string? litype) (BULLSTR (STRING-DOWNCASE litype))) - ((string? ultype) (BULLSTR (STRING-DOWNCASE ultype))) - (else %disk-bullet%))))) - (process-children-trim)))) - -(element (UL LI P) ($li-para$)) - -(element OL ($list-container$)) - -(element (OL LI) - (make paragraph - use: para-style - space-before: - (if (attribute-string "compact" (ancestor "OL")) 0pt %para-sep%) - start-indent: (+ (inherited-start-indent) (OLSTEP)) - first-line-start-indent: (- (OLSTEP)) - (make line-field - field-width: (OLSTEP) - (literal - (case (modulo - (length (hierarchical-number-recursive "OL")) 4) - ((1) (string-append - (format-number (child-number) "1") ".")) - ((2) (string-append - (format-number (child-number) "a") ".")) - ((3) (string-append - "(" (format-number (child-number) "i") ")")) - ((0) (string-append - "(" (format-number (child-number) "a") ")"))))) - (process-children-trim))) - -(element (OL LI P) ($li-para$)) - -;; Note that DIR cannot properly have block children. Here DIR is -;; interpreted as an unmarked list without extra vertical -;; spacing. - -(element DIR ($list-container$)) - -(element (DIR LI) - (make paragraph - use: para-style - start-indent: (+ (inherited-start-indent) (* 2.0 (ULSTEP))) - first-line-start-indent: (- (ULSTEP)) - (process-children-trim))) - -;; Note that MENU cannot properly have block children. Here MENU is -;; interpreted as a small-bulleted list with no extra vertical -;; spacing. - -(element MENU ($list-container$)) - -(element (MENU LI) - (make paragraph - use: para-style - start-indent: (+ (inherited-start-indent) (ULSTEP)) - first-line-start-indent: (- (ULSTEP)) - (make line-field - font-family-name: %dingbat-font-family% - font-size: %bullet-size% - field-width: (ULSTEP) - (literal %disk-bullet%)) - (process-children-trim))) - -;; This treatment of DLs doesn't apply a "compact" attribute set at one -;; level to any nested DLs. To change this behavior so that nested -;; DLs inherit the "compact" attribute from an ancestor DL, substitute -;; "inherited-attribute-string" for "attribute-string" in the -;; construction rules for DT and DD. - - -(element DL - (make display-group - space-before: (if (INLIST?) %para-sep% %block-sep%) - space-after: (if (INLIST?) %para-sep% %block-sep%) - start-indent: (if (INLIST?) - (+ (inherited-start-indent) 2em) - (+ %body-start-indent% 2em)) - (make paragraph))) - -(element DT - (let ((compact (attribute-string "compact" (ancestor "DL")))) - (if compact - (make line-field - field-width: 3em - (process-children-trim)) - (make paragraph - use: para-style - space-before: %para-sep% - first-line-start-indent: -1em - (process-children-trim))))) - -(element DD - (let ((compact (attribute-string "compact" (ancestor "DL")))) - (if compact - (sosofo-append - (process-children-trim) - (make paragraph-break)) - (make paragraph - use: para-style - start-indent: (+ (inherited-start-indent) 2em) - (process-children-trim))))) - - -;; ========================== INLINE ELEMENTS =========================== - -(define ($bold-seq$) - (make sequence - font-weight: 'bold - (process-children-trim))) - -(element B ($bold-seq$)) -(element EM ($bold-seq$)) -(element STRONG ($bold-seq$)) - -;; ------------ - -(define ($italic-seq$) - (make sequence - font-posture: 'italic - (process-children-trim))) - -(element I ($italic-seq$)) -(element CITE ($italic-seq$)) -(element VAR ($italic-seq$)) - -;; ------------ - -(define ($bold-italic-seq$) - (make sequence - font-weight: 'bold - font-posture: 'italic - (process-children-trim))) - -(element DFN ($bold-italic-seq$)) -(element A - (if (INHEAD?) - (process-children-trim) - ($bold-italic-seq$))) - -;; ------------ - -(define ($mono-seq$) - (make sequence - font-family-name: %mono-font-family% - font-size: %mf-size% - (process-children-trim))) - -(element TT ($mono-seq$)) -(element CODE ($mono-seq$)) -(element KBD ($mono-seq$)) -(element SAMP ($mono-seq$)) - -;; ------------ - -(define ($score-seq$ stype) - (make score - type: stype - (process-children-trim))) - -(element STRIKE ($score-seq$ 'through)) -(element U ($score-seq$ 'after)) - -;; ------------ - -(define ($ss-seq$ plus-or-minus) - (make sequence - font-size: - (* (inherited-font-size) %ss-size-factor%) - position-point-shift: - (plus-or-minus (* (inherited-font-size) %ss-shift-factor%)) - (process-children-trim))) - -(element SUP ($ss-seq$ +)) -(element SUB ($ss-seq$ -)) - -;; ------------ - -(define ($bs-seq$ div-or-mult) - (make sequence - font-size: - (div-or-mult (inherited-font-size) %smaller-size-factor%) - line-spacing: - (div-or-mult (inherited-line-spacing) %smaller-size-factor%))) - -(element BIG ($bs-seq$ /)) -(element SMALL ($bs-seq$ *)) - -;; ------------ - -(element FONT - (let ((fsize (attribute-string "SIZE"))) - (make sequence - font-size: - (if fsize (PARSEDUNIT fsize) (inherited-font-size))))) - - -;; ============================== RULES ================================= - -(element HR - (let ((align (attribute-string "ALIGN")) - (noshade (attribute-string "NOSHADE")) - (size (attribute-string "SIZE")) - (width (attribute-string "WIDTH"))) - (make rule - orientation: 'horizontal - space-before: %block-sep% - space-after: %block-sep% - line-thickness: (if size (PARSEDUNIT size) 1pt) - length: (if width (PARSEDUNIT width) %body-width%) - display-alignment: - (case align - (("LEFT") 'start) - (("CENTER") 'center) - (("RIGHT") 'end) - (else 'end))))) - - -;; ============================= GRAPHICS =============================== - -;; Note that DSSSL does not currently support text flowed around an -;; object, so the action of the ALIGN attribute is merely to shift the -;; image to the left or right. An extension to add runarounds to DSSSL -;; has been proposed and should be incorporated here when it becomes -;; final. - -(element IMG - (make external-graphic - entity-system-id: (attribute-string "src") - display?: #t - space-before: 1em - space-after: 1em - display-alignment: - (case (attribute-string "align") - (("LEFT") 'start) - (("RIGHT") 'end) - (else 'center)))) - -;; ============================== TABLES ================================ - -(element TABLE -;; number-of-columns is for future use - (let ((number-of-columns - (node-list-reduce (node-list-rest (children (current-node))) - (lambda (cols nd) - (max cols - (node-list-length (children nd)))) - 0))) - (make display-group - space-before: %block-sep% - space-after: %block-sep% - start-indent: %body-start-indent% -;; for debugging: -;; (make paragraph -;; (literal -;; (string-append -;; "Number of columns: " -;; (number->string number-of-columns)))) - (with-mode table-caption-mode (process-first-descendant "CAPTION")) - (make table - (process-children))))) - -(mode table-caption-mode - (element CAPTION - (make paragraph - use: para-style - font-weight: 'bold - space-before: %block-sep% - space-after: %para-sep% - start-indent: (inherited-start-indent) - (literal - (string-append - "Table " - (format-number - (element-number) "1") ". ")) - (process-children-trim)))) - -(element CAPTION (empty-sosofo)) ; don't show caption inside the table - -(element TR - (make table-row - (process-children-trim))) - -(element TH - (make table-cell - n-rows-spanned: (string->number (attribute-string "COLSPAN")) - (make paragraph - font-weight: 'bold - space-before: 0.25em - space-after: 0.25em - start-indent: 0.25em - end-indent: 0.25em - quadding: 'start - (process-children-trim)))) - -(element TD - (make table-cell - n-rows-spanned: (string->number (attribute-string "COLSPAN")) - (make paragraph - space-before: 0.25em - space-after: 0.25em - start-indent: 0.25em - end-indent: 0.25em - quadding: 'start - (process-children-trim)))) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/images.el --- a/lisp/w3/images.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,209 +0,0 @@ -;;; images.el --- Automatic image converters -;; Author: wmperry -;; Created: 1997/03/11 19:28:30 -;; Version: 1.10 -;; Keywords: images - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1995 - 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The emacsen compatibility package - load it up before anything else -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'mule-sysdp) - -(eval-and-compile - (if (not (and (string-match "XEmacs" emacs-version) - (or (> emacs-major-version 19) - (>= emacs-minor-version 14)))) - (require 'w3-sysdp))) - -(defvar image-temp-stack nil "Do no touch - internal storage.") -(defvar image-converters nil "Storage for the image converters.") -(defvar image-native-formats - (delq nil (cons (if (featurep 'x) 'xbm) - (mapcar (function (lambda (x) (if (featurep x) x))) - '(xpm gif jpeg tiff png)))) - "A list of image formats that this version of emacs supports natively.") - -(defun image-register-converter (from to converter) - "Register the image converter for FROM to TO. CONVERTER is the actual -command used to convert the image. If this is a string, it will be executed -in a subprocess. If a symbol, it is assumed to be a function. It will be -called with two arguments, the start and end of the data to be converted. -The function should replace that data with the new image data. The return -value is not significant." - (let* ((node (assq from image-converters)) - (replace (assq to (cdr-safe node)))) - (cond - (replace ; Replace existing converter - (setcdr replace converter) - (display-warning 'image (format "Replacing image converter %s->%s" - from to))) - (node ; Add to existing node - (setcdr node (cons (cons to converter) (cdr node)))) - (t ; New toplevel converter - (setq image-converters (cons (cons from (list (cons to converter))) - image-converters)))))) - -(defun image-unregister-converter (from to) - "Unregister the image converter for FROM to TO" - (let* ((node (assq from image-converters)) - (tos (cdr-safe node)) - (new nil)) - (while tos - (if (eq to (car (car tos))) - nil - (setq new (cons (car tos) new))) - (setq tos (cdr tos))) - (setcdr node new))) - -(defun image-converter-registered-p (from to) - (cdr-safe (assq to (cdr-safe (assq from image-converters))))) - -(defun image-converter-chain (from to) - "Return the shortest converter chain for image format FROM to TO" - (setq image-temp-stack (cons from image-temp-stack)) - (let ((converters (cdr-safe (assq from image-converters))) - (thisone nil) - (possibles nil) - (done nil)) - (while (and (not done) converters) - (setq thisone (car converters)) - (cond - ((eq (car thisone) to) - (setq done t)) - ((memq (car thisone) image-temp-stack) - nil) - (t - (setq possibles (cons (image-converter-chain (car thisone) to) - possibles)))) - (setq converters (cdr converters))) - (setq image-temp-stack (cdr image-temp-stack) - possibles (sort (delq nil possibles) - (function - (lambda (x y) - (< (length (delete 'ignore x)) - (length (delete 'ignore y))))))) - (if (not done) - (setq done (car possibles))) - (cond - ((eq done t) (list (cdr thisone))) - (done (setq done (cons (cdr thisone) done))) - (t nil)))) - -(defun image-normalize (format data) - "Return an image specification for XEmacs 19.13 and later. FORMAT specifies -the image format, DATA is the image data as a string. Any conversions to get -to a suitable internal image format will be carried out." - (setq image-temp-stack nil) - (if (stringp format) (setq format (intern format))) - (if (not (memq format image-native-formats)) - (let* ((winner (car-safe - (sort (mapcar - (function - (lambda (x) - (cons x - (delete 'ignore - (image-converter-chain format - x))))) - image-native-formats) - (function - (lambda (x y) - (cond - ((null (cdr x)) nil) - ((= (length (cdr x)) - (length (cdr y))) - (< (length (memq (car x) - image-native-formats)) - (length (memq (car y) - image-native-formats)))) - (t - (< (length (cdr x)) - (length (cdr y)))))))))) - (type (car-safe winner)) - (chain (cdr-safe winner)) - ) - (if chain - (save-excursion - (set-buffer (generate-new-buffer " *image-conversion*")) - (erase-buffer) - (insert data) - (while chain - (cond - ((stringp (car chain)) - (let ((file-coding-system mule-no-coding-system)) - (call-process-region - (point-min) (point-max) - shell-file-name t - (list (current-buffer) nil) - shell-command-switch - (car chain)))) - ((and (symbolp (car chain)) (fboundp (car chain))) - (funcall (car chain) (point-min) (point-max)))) - (setq chain (cdr chain))) - (setq data (buffer-string)) - (kill-buffer (current-buffer))) - (setq type format)) - (vector type ':data data)) - (vector format ':data data))) - -(defun image-register-netpbm-utilities () - "Register all the netpbm utility packages converters." - (interactive) - (if (image-converter-registered-p 'pgm 'pbm) - nil - (image-register-converter 'pgm 'pbm "pgmtopbm") - (image-register-converter 'ppm 'pgm "ppmtopgm") - (image-register-converter 'pnm 'xpm "(ppmquant 256 | ppmtoxpm)") - (image-register-converter 'ppm 'xpm "(ppmquant 256 | ppmtoxpm)") - (image-register-converter 'xpm 'ppm "xpmtoppm") - (image-register-converter 'gif 'ppm "giftopnm") - (image-register-converter 'pnm 'gif "(ppmquant 256 | ppmtogif)") - (image-register-converter 'ppm 'gif "(ppmquant 256 | ppmtogif)") - (image-register-converter 'bmp 'ppm "bmptoppm") - (image-register-converter 'ppm 'bmp "ppmtobmp") - (image-register-converter 'ppm 'ps "pnmtops") - (image-register-converter 'pnm 'ps "pnmtops") - (image-register-converter 'ps 'pnm "pstopnm") - (image-register-converter 'g3 'pbm "g3topbm") - (image-register-converter 'macpt 'pbm "macptopbm") - (image-register-converter 'pbm 'macpt "pbmtomacp") - (image-register-converter 'pcx 'ppm "pcxtoppm") - (image-register-converter 'ppm 'pcx "ppmtopcx") - (image-register-converter 'pict 'ppm "picttoppm") - (image-register-converter 'ppm 'pict "ppmtopict") - (image-register-converter 'pnm 'sgi "pnmtosgi") - (image-register-converter 'tga 'ppm "tgatoppm") - (image-register-converter 'ppm 'tga "ppmtotga") - (image-register-converter 'sgi 'pnm "sgitopnm") - (image-register-converter 'tiff 'pnm "tifftopnm") - (image-register-converter 'pnm 'tiff "pnmtotiff") - (image-register-converter 'xbm 'pbm "xbmtopbm") - (image-register-converter 'pbm 'xbm "pbmtoxbm") - (image-register-converter 'png 'pnm "pngtopnm") - (image-register-converter 'pnm 'png "pnmtopng") - (image-register-converter 'pnm 'jbg "pbmtojbg") - (image-register-converter 'jbg 'pnm "jbgtopbm") - (image-register-converter 'jpeg 'ppm "djpeg"))) - -(provide 'images) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/md5.el --- a/lisp/w3/md5.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,406 +0,0 @@ -;;; md5.el -- MD5 Message Digest Algorithm -;;; Gareth Rees <gdr11@cl.cam.ac.uk> - -;; LCD Archive Entry: -;; md5|Gareth Rees|gdr11@cl.cam.ac.uk| -;; MD5 cryptographic message digest algorithm| -;; 13-Nov-95|1.0|~/misc/md5.el.Z| - -;;; Details: ------------------------------------------------------------------ - -;; This is a direct translation into Emacs LISP of the reference C -;; implementation of the MD5 Message-Digest Algorithm written by RSA -;; Data Security, Inc. -;; -;; The algorithm takes a message (that is, a string of bytes) and -;; computes a 16-byte checksum or "digest" for the message. This digest -;; is supposed to be cryptographically strong in the sense that if you -;; are given a 16-byte digest D, then there is no easier way to -;; construct a message whose digest is D than to exhaustively search the -;; space of messages. However, the robustness of the algorithm has not -;; been proven, and a similar algorithm (MD4) was shown to be unsound, -;; so treat with caution! -;; -;; The C algorithm uses 32-bit integers; because GNU Emacs -;; implementations provide 28-bit integers (with 24-bit integers on -;; versions prior to 19.29), the code represents a 32-bit integer as the -;; cons of two 16-bit integers. The most significant word is stored in -;; the car and the least significant in the cdr. The algorithm requires -;; at least 17 bits of integer representation in order to represent the -;; carry from a 16-bit addition. - -;;; Usage: -------------------------------------------------------------------- - -;; To compute the MD5 Message Digest for a message M (represented as a -;; string or as a vector of bytes), call -;; -;; (md5-encode M) -;; -;; which returns the message digest as a vector of 16 bytes. If you -;; need to supply the message in pieces M1, M2, ... Mn, then call -;; -;; (md5-init) -;; (md5-update M1) -;; (md5-update M2) -;; ... -;; (md5-update Mn) -;; (md5-final) - -;;; Copyright and licence: ---------------------------------------------------- - -;; Copyright (C) 1995, 1996, 1997 by Gareth Rees -;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm -;; -;; md5.el 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. -;; -;; md5.el 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. -;; -;; The original copyright notice is given below, as required by the -;; licence for the original code. This code is distributed under *both* -;; RSA's original licence and the GNU General Public Licence. (There -;; should be no problems, as the former is more liberal than the -;; latter). - -;;; Original copyright notice: ------------------------------------------------ - -;; Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. -;; -;; License to copy and use this software is granted provided that it is -;; identified as the "RSA Data Security, Inc. MD5 Message- Digest -;; Algorithm" in all material mentioning or referencing this software or -;; this function. -;; -;; License is also granted to make and use derivative works provided -;; that such works are identified as "derived from the RSA Data -;; Security, Inc. MD5 Message-Digest Algorithm" in all material -;; mentioning or referencing the derived work. -;; -;; RSA Data Security, Inc. makes no representations concerning either -;; the merchantability of this software or the suitability of this -;; software for any particular purpose. It is provided "as is" without -;; express or implied warranty of any kind. -;; -;; These notices must be retained in any copies of any part of this -;; documentation and/or software. - -;;; Code: --------------------------------------------------------------------- - -(defvar md5-program "md5" - "*Program that reads a message on its standard input and writes an -MD5 digest on its output.") - -(defvar md5-maximum-internal-length 4096 - "*The maximum size of a piece of data that should use the MD5 routines -written in lisp. If a message exceeds this, it will be run through an -external filter for processing. Also see the `md5-program' variable. -This variable has no effect if you call the md5-init|update|final -functions - only used by the `md5' function's simpler interface.") - -(defvar md5-bits (make-vector 4 0) - "Number of bits handled, modulo 2^64. -Represented as four 16-bit numbers, least significant first.") -(defvar md5-buffer (make-vector 4 '(0 . 0)) - "Scratch buffer (four 32-bit integers).") -(defvar md5-input (make-vector 64 0) - "Input buffer (64 bytes).") - -(defun md5-unhex (x) - (if (> x ?9) - (if (>= x ?a) - (+ 10 (- x ?a)) - (+ 10 (- x ?A))) - (- x ?0))) - -(defun md5-encode (message) - "Encodes MESSAGE using the MD5 message digest algorithm. -MESSAGE must be a string or an array of bytes. -Returns a vector of 16 bytes containing the message digest." - (if (<= (length message) md5-maximum-internal-length) - (progn - (md5-init) - (md5-update message) - (md5-final)) - (save-excursion - (set-buffer (get-buffer-create " *md5-work*")) - (erase-buffer) - (insert message) - (call-process-region (point-min) (point-max) - md5-program - t (current-buffer)) - ;; MD5 digest is 32 chars long - ;; mddriver adds a newline to make neaten output for tty - ;; viewing, make sure we leave it behind. - (let ((data (buffer-substring (point-min) (+ (point-min) 32))) - (vec (make-vector 16 0)) - (ctr 0)) - (while (< ctr 16) - (aset vec ctr (+ (* 16 (md5-unhex (aref data (* ctr 2)))) - (md5-unhex (aref data (1+ (* ctr 2)))))) - (setq ctr (1+ ctr))))))) - -(defsubst md5-add (x y) - "Return 32-bit sum of 32-bit integers X and Y." - (let ((m (+ (car x) (car y))) - (l (+ (cdr x) (cdr y)))) - (cons (logand 65535 (+ m (lsh l -16))) (logand l 65535)))) - -;; FF, GG, HH and II are basic MD5 functions, providing transformations -;; for rounds 1, 2, 3 and 4 respectively. Each function follows this -;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x -;; by y bits to the left): -;; -;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b -;; -;; so we use the macro `md5-make-step' to construct each one. The -;; helper functions F, G, H and I operate on 16-bit numbers; the full -;; operation splits its inputs, operates on the halves separately and -;; then puts the results together. - -(defsubst md5-F (x y z) (logior (logand x y) (logand (lognot x) z))) -(defsubst md5-G (x y z) (logior (logand x z) (logand y (lognot z)))) -(defsubst md5-H (x y z) (logxor x y z)) -(defsubst md5-I (x y z) (logxor y (logior x (logand 65535 (lognot z))))) - -(defmacro md5-make-step (name func) - (` - (defun (, name) (a b c d x s ac) - (let* - ((m1 (+ (car a) ((, func) (car b) (car c) (car d)) (car x) (car ac))) - (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr x) (cdr ac))) - (m2 (logand 65535 (+ m1 (lsh l1 -16)))) - (l2 (logand 65535 l1)) - (m3 (logand 65535 (if (> s 15) - (+ (lsh m2 (- s 32)) (lsh l2 (- s 16))) - (+ (lsh m2 s) (lsh l2 (- s 16)))))) - (l3 (logand 65535 (if (> s 15) - (+ (lsh l2 (- s 32)) (lsh m2 (- s 16))) - (+ (lsh l2 s) (lsh m2 (- s 16))))))) - (md5-add (cons m3 l3) b))))) - -(md5-make-step md5-FF md5-F) -(md5-make-step md5-GG md5-G) -(md5-make-step md5-HH md5-H) -(md5-make-step md5-II md5-I) - -(defun md5-init () - "Initialise the state of the message-digest routines." - (aset md5-bits 0 0) - (aset md5-bits 1 0) - (aset md5-bits 2 0) - (aset md5-bits 3 0) - (aset md5-buffer 0 '(26437 . 8961)) - (aset md5-buffer 1 '(61389 . 43913)) - (aset md5-buffer 2 '(39098 . 56574)) - (aset md5-buffer 3 '( 4146 . 21622))) - -(defun md5-update (string) - "Update the current MD5 state with STRING (an array of bytes)." - (let ((len (length string)) - (i 0) - (j 0)) - (while (< i len) - ;; Compute number of bytes modulo 64 - (setq j (% (/ (aref md5-bits 0) 8) 64)) - - ;; Store this byte (truncating to 8 bits to be sure) - (aset md5-input j (logand 255 (aref string i))) - - ;; Update number of bits by 8 (modulo 2^64) - (let ((c 8) (k 0)) - (while (and (> c 0) (< k 4)) - (let ((b (aref md5-bits k))) - (aset md5-bits k (logand 65535 (+ b c))) - (setq c (if (> b (- 65535 c)) 1 0) - k (1+ k))))) - - ;; Increment number of bytes processed - (setq i (1+ i)) - - ;; When 64 bytes accumulated, pack them into sixteen 32-bit - ;; integers in the array `in' and then tranform them. - (if (= j 63) - (let ((in (make-vector 16 (cons 0 0))) - (k 0) - (kk 0)) - (while (< k 16) - (aset in k (md5-pack md5-input kk)) - (setq k (+ k 1) kk (+ kk 4))) - (md5-transform in)))))) - -(defun md5-pack (array i) - "Pack the four bytes at ARRAY reference I to I+3 into a 32-bit integer." - (cons (+ (lsh (aref array (+ i 3)) 8) (aref array (+ i 2))) - (+ (lsh (aref array (+ i 1)) 8) (aref array (+ i 0))))) - -(defun md5-byte (array n b) - "Unpack byte B (0 to 3) from Nth member of ARRAY of 32-bit integers." - (let ((e (aref array n))) - (cond ((eq b 0) (logand 255 (cdr e))) - ((eq b 1) (lsh (cdr e) -8)) - ((eq b 2) (logand 255 (car e))) - ((eq b 3) (lsh (car e) -8))))) - -(defun md5-final () - (let ((in (make-vector 16 (cons 0 0))) - (j 0) - (digest (make-vector 16 0)) - (padding)) - - ;; Save the number of bits in the message - (aset in 14 (cons (aref md5-bits 1) (aref md5-bits 0))) - (aset in 15 (cons (aref md5-bits 3) (aref md5-bits 2))) - - ;; Compute number of bytes modulo 64 - (setq j (% (/ (aref md5-bits 0) 8) 64)) - - ;; Pad out computation to 56 bytes modulo 64 - (setq padding (make-vector (if (< j 56) (- 56 j) (- 120 j)) 0)) - (aset padding 0 128) - (md5-update padding) - - ;; Append length in bits and transform - (let ((k 0) (kk 0)) - (while (< k 14) - (aset in k (md5-pack md5-input kk)) - (setq k (+ k 1) kk (+ kk 4)))) - (md5-transform in) - - ;; Store the results in the digest - (let ((k 0) (kk 0)) - (while (< k 4) - (aset digest (+ kk 0) (md5-byte md5-buffer k 0)) - (aset digest (+ kk 1) (md5-byte md5-buffer k 1)) - (aset digest (+ kk 2) (md5-byte md5-buffer k 2)) - (aset digest (+ kk 3) (md5-byte md5-buffer k 3)) - (setq k (+ k 1) kk (+ kk 4)))) - - ;; Return digest - digest)) - -;; It says in the RSA source, "Note that if the Mysterious Constants are -;; arranged backwards in little-endian order and decrypted with the DES -;; they produce OCCULT MESSAGES!" Security through obscurity? - -(defun md5-transform (in) - "Basic MD5 step. Transform md5-buffer based on array IN." - (let ((a (aref md5-buffer 0)) - (b (aref md5-buffer 1)) - (c (aref md5-buffer 2)) - (d (aref md5-buffer 3))) - (setq - a (md5-FF a b c d (aref in 0) 7 '(55146 . 42104)) - d (md5-FF d a b c (aref in 1) 12 '(59591 . 46934)) - c (md5-FF c d a b (aref in 2) 17 '( 9248 . 28891)) - b (md5-FF b c d a (aref in 3) 22 '(49597 . 52974)) - a (md5-FF a b c d (aref in 4) 7 '(62844 . 4015)) - d (md5-FF d a b c (aref in 5) 12 '(18311 . 50730)) - c (md5-FF c d a b (aref in 6) 17 '(43056 . 17939)) - b (md5-FF b c d a (aref in 7) 22 '(64838 . 38145)) - a (md5-FF a b c d (aref in 8) 7 '(27008 . 39128)) - d (md5-FF d a b c (aref in 9) 12 '(35652 . 63407)) - c (md5-FF c d a b (aref in 10) 17 '(65535 . 23473)) - b (md5-FF b c d a (aref in 11) 22 '(35164 . 55230)) - a (md5-FF a b c d (aref in 12) 7 '(27536 . 4386)) - d (md5-FF d a b c (aref in 13) 12 '(64920 . 29075)) - c (md5-FF c d a b (aref in 14) 17 '(42617 . 17294)) - b (md5-FF b c d a (aref in 15) 22 '(18868 . 2081)) - a (md5-GG a b c d (aref in 1) 5 '(63006 . 9570)) - d (md5-GG d a b c (aref in 6) 9 '(49216 . 45888)) - c (md5-GG c d a b (aref in 11) 14 '( 9822 . 23121)) - b (md5-GG b c d a (aref in 0) 20 '(59830 . 51114)) - a (md5-GG a b c d (aref in 5) 5 '(54831 . 4189)) - d (md5-GG d a b c (aref in 10) 9 '( 580 . 5203)) - c (md5-GG c d a b (aref in 15) 14 '(55457 . 59009)) - b (md5-GG b c d a (aref in 4) 20 '(59347 . 64456)) - a (md5-GG a b c d (aref in 9) 5 '( 8673 . 52710)) - d (md5-GG d a b c (aref in 14) 9 '(49975 . 2006)) - c (md5-GG c d a b (aref in 3) 14 '(62677 . 3463)) - b (md5-GG b c d a (aref in 8) 20 '(17754 . 5357)) - a (md5-GG a b c d (aref in 13) 5 '(43491 . 59653)) - d (md5-GG d a b c (aref in 2) 9 '(64751 . 41976)) - c (md5-GG c d a b (aref in 7) 14 '(26479 . 729)) - b (md5-GG b c d a (aref in 12) 20 '(36138 . 19594)) - a (md5-HH a b c d (aref in 5) 4 '(65530 . 14658)) - d (md5-HH d a b c (aref in 8) 11 '(34673 . 63105)) - c (md5-HH c d a b (aref in 11) 16 '(28061 . 24866)) - b (md5-HH b c d a (aref in 14) 23 '(64997 . 14348)) - a (md5-HH a b c d (aref in 1) 4 '(42174 . 59972)) - d (md5-HH d a b c (aref in 4) 11 '(19422 . 53161)) - c (md5-HH c d a b (aref in 7) 16 '(63163 . 19296)) - b (md5-HH b c d a (aref in 10) 23 '(48831 . 48240)) - a (md5-HH a b c d (aref in 13) 4 '(10395 . 32454)) - d (md5-HH d a b c (aref in 0) 11 '(60065 . 10234)) - c (md5-HH c d a b (aref in 3) 16 '(54511 . 12421)) - b (md5-HH b c d a (aref in 6) 23 '( 1160 . 7429)) - a (md5-HH a b c d (aref in 9) 4 '(55764 . 53305)) - d (md5-HH d a b c (aref in 12) 11 '(59099 . 39397)) - c (md5-HH c d a b (aref in 15) 16 '( 8098 . 31992)) - b (md5-HH b c d a (aref in 2) 23 '(50348 . 22117)) - a (md5-II a b c d (aref in 0) 6 '(62505 . 8772)) - d (md5-II d a b c (aref in 7) 10 '(17194 . 65431)) - c (md5-II c d a b (aref in 14) 15 '(43924 . 9127)) - b (md5-II b c d a (aref in 5) 21 '(64659 . 41017)) - a (md5-II a b c d (aref in 12) 6 '(25947 . 22979)) - d (md5-II d a b c (aref in 3) 10 '(36620 . 52370)) - c (md5-II c d a b (aref in 10) 15 '(65519 . 62589)) - b (md5-II b c d a (aref in 1) 21 '(34180 . 24017)) - a (md5-II a b c d (aref in 8) 6 '(28584 . 32335)) - d (md5-II d a b c (aref in 15) 10 '(65068 . 59104)) - c (md5-II c d a b (aref in 6) 15 '(41729 . 17172)) - b (md5-II b c d a (aref in 13) 21 '(19976 . 4513)) - a (md5-II a b c d (aref in 4) 6 '(63315 . 32386)) - d (md5-II d a b c (aref in 11) 10 '(48442 . 62005)) - c (md5-II c d a b (aref in 2) 15 '(10967 . 53947)) - b (md5-II b c d a (aref in 9) 21 '(60294 . 54161))) - - (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a)) - (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b)) - (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c)) - (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Here begins the merger with the XEmacs API and the md5.el from the URL -;;; package. Courtesy wmperry@cs.indiana.edu -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun md5 (object &optional start end) - "Return the MD5 (a secure message digest algorithm) of an object. -OBJECT is either a string or a buffer. -Optional arguments START and END denote buffer positions for computing the -hash of a portion of OBJECT." - (let ((buffer nil)) - (unwind-protect - (save-excursion - (setq buffer (generate-new-buffer " *md5-work*")) - (set-buffer buffer) - (cond - ((bufferp object) - (insert-buffer-substring object start end)) - ((stringp object) - (insert (if (or start end) - (substring object start end) - object))) - (t nil)) - (prog1 - (if (<= (point-max) md5-maximum-internal-length) - (mapconcat - (function (lambda (node) (format "%02x" node))) - (md5-encode (buffer-string)) - "") - (call-process-region (point-min) (point-max) - shell-file-name - t buffer nil - shell-command-switch md5-program) - ;; MD5 digest is 32 chars long - ;; mddriver adds a newline to make neaten output for tty - ;; viewing, make sure we leave it behind. - (buffer-substring (point-min) (+ (point-min) 32))) - (kill-buffer buffer))) - (and buffer (buffer-name buffer) (kill-buffer buffer) nil)))) - -(provide 'md5) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/mm.el --- a/lisp/w3/mm.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1266 +0,0 @@ -;;; mm.el,v --- Mailcap parsing routines, and MIME handling -;; Author: wmperry -;; Created: 1996/05/28 02:46:51 -;; Version: 1.96 -;; Keywords: mail, news, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1994, 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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. -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Generalized mailcap parsing and access routines -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Data structures -;;; --------------- -;;; The mailcap structure is an assoc list of assoc lists. -;;; 1st assoc list is keyed on the major content-type -;;; 2nd assoc list is keyed on the minor content-type (which can be a regexp) -;;; -;;; Which looks like: -;;; ----------------- -;;; ( -;;; ("application" -;;; ("postscript" . <info>) -;;; ) -;;; ("text" -;;; ("plain" . <info>) -;;; ) -;;; ) -;;; -;;; Where <info> is another assoc list of the various information -;;; related to the mailcap RFC. This is keyed on the lowercase -;;; attribute name (viewer, test, etc). This looks like: -;;; (("viewer" . viewerinfo) -;;; ("test" . testinfo) -;;; ("xxxx" . "string") -;;; ) -;;; -;;; Where viewerinfo specifies how the content-type is viewed. Can be -;;; a string, in which case it is run through a shell, with -;;; appropriate parameters, or a symbol, in which case the symbol is -;;; funcall'd, with the buffer as an argument. -;;; -;;; testinfo is a list of strings, or nil. If nil, it means the -;;; viewer specified is always valid. If it is a list of strings, -;;; these are used to determine whether a viewer passes the 'test' or -;;; not. -;;; -;;; The main interface to this code is: -;;; -;;; To set everything up: -;;; -;;; (mm-parse-mailcaps [path]) -;;; -;;; Where PATH is a unix-style path specification (: separated list -;;; of strings). If PATH is nil, the environment variable MAILCAPS -;;; will be consulted. If there is no environment variable, then a -;;; default list of paths is used. -;;; -;;; To retrieve the information: -;;; (mm-mime-info st [nd] [request]) -;;; -;;; Where st and nd are positions in a buffer that contain the -;;; content-type header information of a mail/news/whatever message. -;;; st can optionally be a string that contains the content-type -;;; information. -;;; -;;; Third argument REQUEST specifies what information to return. If -;;; it is nil or the empty string, the viewer (second field of the -;;; mailcap entry) will be returned. If it is a string, then the -;;; mailcap field corresponding to that string will be returned -;;; (print, description, whatever). If a number, then all the -;;; information for this specific viewer is returned. -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Variables, etc -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(eval-and-compile - (require 'cl) - (require 'devices)) - -(defconst mm-version (let ((x "1.96")) - (if (string-match "Revision: \\([^ \t\n]+\\)" x) - (substring x (match-beginning 1) (match-end 1)) - x)) - "Version # of MM package") - -(defvar mm-parse-args-syntax-table - (copy-syntax-table emacs-lisp-mode-syntax-table) - "A syntax table for parsing sgml attributes.") - -(modify-syntax-entry ?' "\"" mm-parse-args-syntax-table) -(modify-syntax-entry ?` "\"" mm-parse-args-syntax-table) -(modify-syntax-entry ?{ "(" mm-parse-args-syntax-table) -(modify-syntax-entry ?} ")" mm-parse-args-syntax-table) - -(defvar mm-mime-data - '( - ("multipart" . ( - ("alternative". (("viewer" . mm-multipart-viewer) - ("type" . "multipart/alternative"))) - ("mixed" . (("viewer" . mm-multipart-viewer) - ("type" . "multipart/mixed"))) - (".*" . (("viewer" . mm-save-binary-file) - ("type" . "multipart/*"))) - ) - ) - ("application" . ( - ("x-x509-ca-cert" . (("viewer" . ssl-view-site-cert) - ("test" . (fboundp 'ssl-view-site-cert)) - ("type" . "application/x-x509-ca-cert"))) - ("x-x509-user-cert" . (("viewer" . ssl-view-user-cert) - ("test" . (fboundp 'ssl-view-user-cert)) - ("type" . "application/x-x509-user-cert"))) - ("octet-stream" . (("viewer" . mm-save-binary-file) - ("type" ."application/octet-stream"))) - ("dvi" . (("viewer" . "open %s") - ("type" . "application/dvi") - ("test" . (eq (device-type) 'ns)))) - ("dvi" . (("viewer" . "xdvi %s") - ("test" . (eq (device-type) 'x)) - ("needsx11") - ("type" . "application/dvi"))) - ("dvi" . (("viewer" . "dvitty %s") - ("test" . (not (getenv "DISPLAY"))) - ("type" . "application/dvi"))) - ("emacs-lisp" . (("viewer" . mm-maybe-eval) - ("type" . "application/emacs-lisp"))) -; ("x-tar" . (("viewer" . tar-mode) -; ("test" . (fboundp 'tar-mode)) -; ("type" . "application/x-tar"))) - ("x-tar" . (("viewer" . mm-save-binary-file) - ("type" . "application/x-tar"))) - ("x-latex" . (("viewer" . tex-mode) - ("test" . (fboundp 'tex-mode)) - ("type" . "application/x-latex"))) - ("x-tex" . (("viewer" . tex-mode) - ("test" . (fboundp 'tex-mode)) - ("type" . "application/x-tex"))) - ("latex" . (("viewer" . tex-mode) - ("test" . (fboundp 'tex-mode)) - ("type" . "application/latex"))) - ("tex" . (("viewer" . tex-mode) - ("test" . (fboundp 'tex-mode)) - ("type" . "application/tex"))) - ("texinfo" . (("viewer" . texinfo-mode) - ("test" . (fboundp 'texinfo-mode)) - ("type" . "application/tex"))) - ("zip" . (("viewer" . mm-save-binary-file) - ("type" . "application/zip") - ("copiousoutput"))) - ("pdf" . (("viewer" . "acroread %s") - ("type" . "application/pdf"))) - ("postscript" . (("viewer" . "open %s") - ("type" . "application/postscript") - ("test" . (eq (device-type) 'ns)))) - ("postscript" . (("viewer" . "ghostview %s") - ("type" . "application/postscript") - ("test" . (eq (device-type) 'x)) - ("needsx11"))) - ("postscript" . (("viewer" . "ps2ascii %s") - ("type" . "application/postscript") - ("test" . (not (getenv "DISPLAY"))) - ("copiousoutput"))) - )) - ("audio" . ( - ("x-mpeg" . (("viewer" . "maplay %s") - ("type" . "audio/x-mpeg"))) - (".*" . (("viewer" . mm-play-sound-file) - ("test" . (or (featurep 'nas-sound) - (featurep 'native-sound))) - ("type" . "audio/*"))) - (".*" . (("viewer" . "showaudio") - ("type" . "audio/*"))) - )) - ("message" . ( - ("rfc-*822" . (("viewer" . vm-mode) - ("test" . (fboundp 'vm-mode)) - ("type" . "message/rfc-822"))) - ("rfc-*822" . (("viewer" . w3-mode) - ("test" . (fboundp 'w3-mode)) - ("type" . "message/rfc-822"))) - ("rfc-*822" . (("viewer" . view-mode) - ("test" . (fboundp 'view-mode)) - ("type" . "message/rfc-822"))) - ("rfc-*822" . (("viewer" . fundamental-mode) - ("type" . "message/rfc-822"))) - )) - ("image" . ( - ("x-xwd" . (("viewer" . "xwud -in %s") - ("type" . "image/x-xwd") - ("compose" . "xwd -frame > %s") - ("test" . (eq (device-type) 'x)) - ("needsx11"))) - ("x11-dump" . (("viewer" . "xwud -in %s") - ("type" . "image/x-xwd") - ("compose" . "xwd -frame > %s") - ("test" . (eq (device-type) 'x)) - ("needsx11"))) - ("windowdump" . (("viewer" . "xwud -in %s") - ("type" . "image/x-xwd") - ("compose" . "xwd -frame > %s") - ("test" . (eq (device-type) 'x)) - ("needsx11"))) - (".*" . (("viewer" . "open %s") - ("type" . "image/*") - ("test" . (eq (device-type) 'ns)))) - (".*" . (("viewer" . "xv -perfect %s") - ("type" . "image/*") - ("test" . (eq (device-type) 'x)) - ("needsx11"))) - )) - ("text" . ( - ("plain" . (("viewer" . w3-mode) - ("test" . (fboundp 'w3-mode)) - ("type" . "text/plain"))) - ("plain" . (("viewer" . view-mode) - ("test" . (fboundp 'view-mode)) - ("type" . "text/plain"))) - ("plain" . (("viewer" . fundamental-mode) - ("type" . "text/plain"))) - ("enriched" . (("viewer" . enriched-decode-region) - ("test" . (fboundp - 'enriched-decode-region)) - ("type" . "text/enriched"))) - ("html" . (("viewer" . w3-prepare-buffer) - ("test" . (fboundp 'w3-prepare-buffer)) - ("type" . "text/html"))) - )) - ("video" . ( - ("mpeg" . (("viewer" . "mpeg_play %s") - ("type" . "video/mpeg") - ("test" . (eq (device-type) 'x)) - ("needsx11"))) - )) - ("x-world" . ( - ("x-vrml" . (("viewer" . "webspace -remote %s -URL %u") - ("type" . "x-world/x-vrml") - ("description" - "VRML document"))))) - ("archive" . ( - ("tar" . (("viewer" . tar-mode) - ("type" . "archive/tar") - ("test" . (fboundp 'tar-mode)))) - )) - ) - "*The mailcap structure is an assoc list of assoc lists. -1st assoc list is keyed on the major content-type -2nd assoc list is keyed on the minor content-type (which can be a regexp) - -Which looks like: ------------------ -( - (\"application\" - (\"postscript\" . <info>) - ) - (\"text\" - (\"plain\" . <info>) - ) -) - -Where <info> is another assoc list of the various information -related to the mailcap RFC. This is keyed on the lowercase -attribute name (viewer, test, etc). This looks like: -((\"viewer\" . viewerinfo) - (\"test\" . testinfo) - (\"xxxx\" . \"string\") -) - -Where viewerinfo specifies how the content-type is viewed. Can be -a string, in which case it is run through a shell, with -appropriate parameters, or a symbol, in which case the symbol is -funcall'd, with the buffer as an argument. - -testinfo is a list of strings, or nil. If nil, it means the -viewer specified is always valid. If it is a list of strings, -these are used to determine whether a viewer passes the 'test' or -not.") - -(defvar mm-content-transfer-encodings - '(("base64" . base64-decode-region) - ("7bit" . ignore) - ("8bit" . ignore) - ("binary" . ignore) - ("x-compress" . ("uncompress" "-c")) - ("x-gzip" . ("gzip" "-dc")) - ("compress" . ("uncompress" "-c")) - ("gzip" . ("gzip" "-dc")) - ("x-hqx" . ("mcvert" "-P" "-s" "-S")) - ("quoted-printable" . mm-decode-quoted-printable) - ) - "*An assoc list of content-transfer-encodings and how to decode them.") - -(defvar mm-download-directory nil - "*Where downloaded files should go by default.") - -(defvar mm-temporary-directory (or (getenv "TMPDIR") "/tmp") - "*Where temporary files go.") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; A few things from w3 and url, just in case this is used without them -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun mm-generate-unique-filename (&optional fmt) - "Generate a unique filename in mm-temporary-directory" - (if (not fmt) - (let ((base (format "mm-tmp.%d" (user-real-uid))) - (fname "") - (x 0)) - (setq fname (format "%s%d" base x)) - (while (file-exists-p - (expand-file-name fname mm-temporary-directory)) - (setq x (1+ x) - fname (concat base (int-to-string x)))) - (expand-file-name fname mm-temporary-directory)) - (let ((base (concat "mm" (int-to-string (user-real-uid)))) - (fname "") - (x 0)) - (setq fname (format fmt (concat base (int-to-string x)))) - (while (file-exists-p - (expand-file-name fname mm-temporary-directory)) - (setq x (1+ x) - fname (format fmt (concat base (int-to-string x))))) - (expand-file-name fname mm-temporary-directory)))) - -(if (and (fboundp 'copy-tree) - (subrp (symbol-function 'copy-tree))) - (fset 'mm-copy-tree 'copy-tree) - (defun mm-copy-tree (tree) - (if (consp tree) - (cons (mm-copy-tree (car tree)) - (mm-copy-tree (cdr tree))) - (if (vectorp tree) - (let* ((new (copy-sequence tree)) - (i (1- (length new)))) - (while (>= i 0) - (aset new i (mm-copy-tree (aref new i))) - (setq i (1- i))) - new) - tree)))) - -(require 'mule-sysdp) - -(if (not (fboundp 'w3-save-binary-file)) - (defun mm-save-binary-file () - ;; Ok, this is truly fucked. In XEmacs, if you use the mouse to select - ;; a URL that gets saved via this function, read-file-name will pop up a - ;; dialog box for file selection. For some reason which buffer we are in - ;; gets royally screwed (even with save-excursions and the whole nine - ;; yards). SO, we just keep the old buffer name around and away we go. - (let ((old-buff (current-buffer)) - (file (read-file-name "Filename to save as: " - (or mm-download-directory "~/") - (file-name-nondirectory (url-view-url t)) - nil - (file-name-nondirectory (url-view-url t)))) - (require-final-newline nil)) - (set-buffer old-buff) - (mule-write-region-no-coding-system (point-min) (point-max) file) - (kill-buffer (current-buffer)))) - (fset 'mm-save-binary-file 'w3-save-binary-file)) - -(defun mm-maybe-eval () - "Maybe evaluate a buffer of emacs lisp code" - (if (yes-or-no-p "This is emacs-lisp code, evaluate it? ") - (eval-buffer (current-buffer)) - (emacs-lisp-mode))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The mailcap parser -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun mm-viewer-unescape (format &optional filename url) - (save-excursion - (set-buffer (get-buffer-create " *mm-parse*")) - (erase-buffer) - (insert format) - (goto-char (point-min)) - (while (re-search-forward "%\\(.\\)" nil t) - (let ((escape (aref (match-string 1) 0))) - (replace-match "" t t) - (case escape - (?% (insert "%")) - (?s (insert (or filename "\"\""))) - (?u (insert (or url "\"\"")))))) - (buffer-string))) - -(defun mm-in-assoc (elt list) - ;; Check to see if ELT matches any of the regexps in the car elements of LIST - (let (rslt) - (while (and list (not rslt)) - (and (car (car list)) - (string-match (car (car list)) elt) - (setq rslt (car list))) - (setq list (cdr list))) - rslt)) - -(defun mm-replace-regexp (regexp to-string) - ;; Quiet replace-regexp. - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (replace-match to-string t nil))) - -(defun mm-parse-mailcaps (&optional path) - ;; Parse out all the mailcaps specified in a unix-style path string PATH - (cond - (path nil) - ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS"))) - ((memq system-type '(ms-dos ms-windows windows-nt)) - (setq path (mapconcat 'expand-file-name '("~/mail.cap" "~/etc/mail.cap") - ";"))) - (t (setq path (mapconcat 'expand-file-name - '("~/.mailcap" - "/etc/mailcap:/usr/etc/mailcap" - "/usr/local/etc/mailcap") ":")))) - (let ((fnames (reverse - (mm-string-to-tokens path - (if (memq system-type - '(ms-dos ms-windows windows-nt)) - ?; - ?:)))) - fname) - (while fnames - (setq fname (car fnames)) - (if (and (file-exists-p fname) (file-readable-p fname)) - (mm-parse-mailcap (car fnames))) - (setq fnames (cdr fnames))))) - -(defun mm-parse-mailcap (fname) - ;; Parse out the mailcap file specified by FNAME - (let (major ; The major mime type (image/audio/etc) - minor ; The minor mime type (gif, basic, etc) - save-pos ; Misc saved positions used in parsing - viewer ; How to view this mime type - info ; Misc info about this mime type - ) - (save-excursion - (set-buffer (get-buffer-create " *mailcap*")) - (erase-buffer) - (insert-file-contents fname) - (set-syntax-table mm-parse-args-syntax-table) - (mm-replace-regexp "#.*" "") ; Remove all comments - (mm-replace-regexp "\n+" "\n") ; And blank lines - (mm-replace-regexp "\\\\[ \t\n]+" " ") ; And collapse spaces - (mm-replace-regexp (concat (regexp-quote "\\") "[ \t]*\n") "") - (goto-char (point-max)) - (skip-chars-backward " \t\n") - (delete-region (point) (point-max)) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward " \t\n") - (setq save-pos (point) - info nil) - (skip-chars-forward "^/;") - (downcase-region save-pos (point)) - (setq major (buffer-substring save-pos (point))) - (skip-chars-forward "/ \t\n") - (setq save-pos (point)) - (skip-chars-forward "^;") - (downcase-region save-pos (point)) - (setq minor - (cond - ((= ?* (or (char-after save-pos) 0)) ".*") - ((= (point) save-pos) ".*") - (t (buffer-substring save-pos (point))))) - (skip-chars-forward "; \t\n") - ;;; Got the major/minor chunks, now for the viewers/etc - ;;; The first item _must_ be a viewer, according to the - ;;; RFC for mailcap files (#1343) - (skip-chars-forward "; \t\n") - (setq save-pos (point)) - (skip-chars-forward "^;\n") - (if (= (or (char-after save-pos) 0) ?') - (setq viewer (progn - (narrow-to-region (1+ save-pos) (point)) - (goto-char (point-min)) - (prog1 - (read (current-buffer)) - (goto-char (point-max)) - (widen)))) - (setq viewer (buffer-substring save-pos (point)))) - (setq save-pos (point)) - (end-of-line) - (setq info (nconc (list (cons "viewer" viewer) - (cons "type" (concat major "/" - (if (string= minor ".*") - "*" minor)))) - (mm-parse-mailcap-extras save-pos (point)))) - (mm-mailcap-entry-passes-test info) - (mm-add-mailcap-entry major minor info))))) - -(defun mm-parse-mailcap-extras (st nd) - ;; Grab all the extra stuff from a mailcap entry - (let ( - name ; From name= - value ; its value - results ; Assoc list of results - name-pos ; Start of XXXX= position - val-pos ; Start of value position - done ; Found end of \'d ;s? - ) - (save-restriction - (narrow-to-region st nd) - (goto-char (point-min)) - (skip-chars-forward " \n\t;") - (while (not (eobp)) - (setq done nil) - (skip-chars-forward " \";\n\t") - (setq name-pos (point)) - (skip-chars-forward "^ \n\t=") - (downcase-region name-pos (point)) - (setq name (buffer-substring name-pos (point))) - (skip-chars-forward " \t\n") - (if (/= (or (char-after (point)) 0) ?=) ; There is no value - (setq value nil) - (skip-chars-forward " \t\n=") - (setq val-pos (point)) - (if (memq (char-after val-pos) '(?\" ?')) - (progn - (setq val-pos (1+ val-pos)) - (condition-case nil - (progn - (forward-sexp 1) - (backward-char 1)) - (error (goto-char (point-max))))) - (while (not done) - (skip-chars-forward "^;") - (if (= (or (char-after (1- (point))) 0) ?\\ ) - (progn - (subst-char-in-region (1- (point)) (point) ?\\ ? ) - (skip-chars-forward ";")) - (setq done t)))) - (setq value (buffer-substring val-pos (point)))) - (setq results (cons (cons name value) results))) - results))) - -(defun mm-string-to-tokens (str &optional delim) - "Return a list of words from the string STR" - (setq delim (or delim ? )) - (let (results y) - (mapcar - (function - (lambda (x) - (cond - ((and (= x delim) y) (setq results (cons y results) y nil)) - ((/= x delim) (setq y (concat y (char-to-string x)))) - (t nil)))) str) - (nreverse (cons y results)))) - -(defun mm-mailcap-entry-passes-test (info) - ;; Return t iff a mailcap entry passes its test clause or no test - ;; clause is present. - (let (status ; Call-process-regions return value - (test (assoc "test" info)); The test clause - ) - (setq status (and test (mm-string-to-tokens (cdr test)))) - (if (and (assoc "needsx11" info) (not (getenv "DISPLAY"))) - (setq status nil) - (cond - ((and (equal (nth 0 status) "test") - (equal (nth 1 status) "-n") - (or (equal (nth 2 status) "$DISPLAY") - (equal (nth 2 status) "\"$DISPLAY\""))) - (setq status (if (getenv "DISPLAY") t nil))) - ((and (equal (nth 0 status) "test") - (equal (nth 1 status) "-z") - (or (equal (nth 2 status) "$DISPLAY") - (equal (nth 2 status) "\"$DISPLAY\""))) - (setq status (if (getenv "DISPLAY") nil t))) - (test nil) - (t nil))) - (and test (listp test) (setcdr test status)))) - -(defun mm-parse-args (st &optional nd nodowncase) - ;; Return an assoc list of attribute/value pairs from an RFC822-type string - (let ( - name ; From name= - value ; its value - results ; Assoc list of results - name-pos ; Start of XXXX= position - val-pos ; Start of value position - ) - (save-excursion - (if (stringp st) - (progn - (set-buffer (get-buffer-create " *mm-temp*")) - (set-syntax-table mm-parse-args-syntax-table) - (erase-buffer) - (insert st) - (setq st (point-min) - nd (point-max))) - (set-syntax-table mm-parse-args-syntax-table)) - (save-restriction - (narrow-to-region st nd) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward "; \n\t") - (setq name-pos (point)) - (skip-chars-forward "^ \n\t=;") - (if (not nodowncase) - (downcase-region name-pos (point))) - (setq name (buffer-substring name-pos (point))) - (skip-chars-forward " \t\n") - (if (/= (or (char-after (point)) 0) ?=) ; There is no value - (setq value nil) - (skip-chars-forward " \t\n=") - (setq val-pos (point) - value - (cond - ((or (= (or (char-after val-pos) 0) ?\") - (= (or (char-after val-pos) 0) ?')) - (buffer-substring (1+ val-pos) - (condition-case () - (prog2 - (forward-sexp 1) - (1- (point)) - (skip-chars-forward "\"")) - (error - (skip-chars-forward "^ \t\n") - (point))))) - (t - (buffer-substring val-pos - (progn - (skip-chars-forward "^;") - (skip-chars-backward " \t") - (point))))))) - (setq results (cons (cons name value) results)) - (skip-chars-forward "; \n\t")) - results)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The action routines. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun mm-possible-viewers (major minor) - ;; Return a list of possible viewers from MAJOR for minor type MINOR - (let ((exact '()) - (wildcard '())) - (while major - (cond - ((equal (car (car major)) minor) - (setq exact (cons (cdr (car major)) exact))) - ((string-match (car (car major)) minor) - (setq wildcard (cons (cdr (car major)) wildcard)))) - (setq major (cdr major))) - (nconc (nreverse exact) (nreverse wildcard)))) - -(defun mm-unescape-mime-test (test type-info) - (let ((buff (get-buffer-create " *unescape*")) - save-pos save-chr subst) - (cond - ((symbolp test) test) - ((and (listp test) (symbolp (car test))) test) - ((or (stringp test) - (and (listp test) (stringp (car test)) - (setq test (mapconcat 'identity test " ")))) - (save-excursion - (set-buffer buff) - (erase-buffer) - (insert test) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward "^%") - (if (/= (- (point) - (progn (skip-chars-backward "\\\\") - (point))) - 0) ; It is an escaped % - (progn - (delete-char 1) - (skip-chars-forward "%.")) - (setq save-pos (point)) - (skip-chars-forward "%") - (setq save-chr (char-after (point))) - (cond - ((null save-chr) nil) - ((= save-chr ?t) - (delete-region save-pos (progn (forward-char 1) (point))) - (insert (or (cdr (assoc "type" type-info)) "\"\""))) - ((= save-chr ?M) - (delete-region save-pos (progn (forward-char 1) (point))) - (insert "\"\"")) - ((= save-chr ?n) - (delete-region save-pos (progn (forward-char 1) (point))) - (insert "\"\"")) - ((= save-chr ?F) - (delete-region save-pos (progn (forward-char 1) (point))) - (insert "\"\"")) - ((= save-chr ?{) - (forward-char 1) - (skip-chars-forward "^}") - (downcase-region (+ 2 save-pos) (point)) - (setq subst (buffer-substring (+ 2 save-pos) (point))) - (delete-region save-pos (1+ (point))) - (insert (or (cdr (assoc subst type-info)) "\"\""))) - (t nil)))) - (buffer-string))) - (t (error "Bad value to mm-unescape-mime-test. %s" test))))) - -(defun mm-viewer-passes-test (viewer-info type-info) - ;; Return non-nil iff the viewer specified by VIEWER-INFO passes its - ;; test clause (if any). - (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 - ) - (cond - ((not test-info) t) ; No test clause - ((not test) nil) ; Already failed test - ((eq test t) t) ; Already passed test - ((and (symbolp test) ; Lisp function as test - (fboundp test)) - (funcall test type-info)) - ((and (symbolp test) ; Lisp variable as test - (boundp test)) - (symbol-value test)) - ((and (listp test) ; List to be eval'd - (symbolp (car test))) - (eval test)) - (t - (setq test (mm-unescape-mime-test test type-info) - test (list shell-file-name nil nil nil shell-command-switch test) - status (apply 'call-process test)) - (= 0 status))))) - -(defun mm-add-mailcap-entry (major minor info) - (let ((old-major (assoc major mm-mime-data))) - (if (null old-major) ; New major area - (setq mm-mime-data - (cons (cons major (list (cons minor info))) - mm-mime-data)) - (let ((cur-minor (assoc minor old-major))) - (cond - ((or (null cur-minor) ; New minor area, or - (assoc "test" info)) ; Has a test, insert at beginning - (setcdr old-major (cons (cons minor info) (cdr old-major)))) - ((and (not (assoc "test" info)); No test info, replace completely - (not (assoc "test" cur-minor))) - (setcdr cur-minor info)) - (t - (setcdr old-major (cons (cons minor info) (cdr old-major))))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The main whabbo -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun mm-viewer-lessp (x y) - ;; Return t iff viewer X is more desirable than viewer Y - (let ((x-wild (string-match "[*?]" (or (cdr-safe (assoc "type" x)) ""))) - (y-wild (string-match "[*?]" (or (cdr-safe (assoc "type" y)) ""))) - (x-lisp (not (stringp (or (cdr-safe (assoc "viewer" x)) "")))) - (y-lisp (not (stringp (or (cdr-safe (assoc "viewer" y)) ""))))) - (cond - ((and x-lisp (not y-lisp)) - t) - ((and (not y-lisp) x-wild (not y-wild)) - t) - ((and (not x-wild) y-wild) - t) - (t nil)))) - -(defun mm-mime-info (st &optional nd request) - "Get the mime viewer command for HEADERLINE, return nil if none found. -Expects a complete content-type header line as its argument. This can -be simple like text/html, or complex like text/plain; charset=blah; foo=bar - -Third argument REQUEST specifies what information to return. If it is -nil or the empty string, the viewer (second field of the mailcap -entry) will be returned. If it is a string, then the mailcap field -corresponding to that string will be returned (print, description, -whatever). If a number, then all the information for this specific -viewer is returned." - (let ( - major ; Major encoding (text, etc) - minor ; Minor encoding (html, etc) - info ; Other info - save-pos ; Misc. position during parse - major-info ; (assoc major mm-mime-data) - minor-info ; (assoc minor major-info) - test ; current test proc. - viewers ; Possible viewers - passed ; Viewers that passed the test - viewer ; The one and only viewer - ) - (save-excursion - (cond - ((null st) - (set-buffer (get-buffer-create " *mimeparse*")) - (erase-buffer) - (insert "text/plain") - (setq st (point-min))) - ((stringp st) - (set-buffer (get-buffer-create " *mimeparse*")) - (erase-buffer) - (insert st) - (setq st (point-min))) - ((null nd) - (narrow-to-region st (progn (goto-char st) (end-of-line) (point)))) - (t (narrow-to-region st nd))) - (goto-char st) - (skip-chars-forward ": \t\n") - (buffer-enable-undo) - (setq viewer - (catch 'mm-exit - (setq save-pos (point)) - (skip-chars-forward "^/") - (downcase-region save-pos (point)) - (setq major (buffer-substring save-pos (point))) - (if (not (setq major-info (cdr (assoc major mm-mime-data)))) - (throw 'mm-exit nil)) - (skip-chars-forward "/ \t\n") - (setq save-pos (point)) - (skip-chars-forward "^ \t\n;") - (downcase-region save-pos (point)) - (setq minor (buffer-substring save-pos (point))) - (if (not - (setq viewers (mm-possible-viewers major-info minor))) - (throw 'mm-exit nil)) - (skip-chars-forward "; \t") - (if (eolp) - nil ; No qualifiers - (setq save-pos (point)) - (end-of-line) - (setq info (mm-parse-args save-pos (point))) - ) - (while viewers - (if (mm-viewer-passes-test (car viewers) info) - (setq passed (cons (car viewers) passed))) - (setq viewers (cdr viewers))) - (setq passed (sort (nreverse passed) 'mm-viewer-lessp)) - (car passed))) - (if (and (stringp (cdr (assoc "viewer" viewer))) - passed) - (setq viewer (car passed))) - (widen) - (cond - ((and (null viewer) (not (equal major "default"))) - (mm-mime-info "default" nil request)) - ((or (null request) (equal request "")) - (mm-unescape-mime-test (cdr (assoc "viewer" viewer)) info)) - ((stringp request) - (if (or (string= request "test") (string= request "viewer")) - (mm-unescape-mime-test (cdr-safe (assoc request viewer)) info))) - (t - ;; MUST make a copy *sigh*, else we modify mm-mime-data - (setq viewer (mm-copy-tree viewer)) - (let ((view (assoc "viewer" viewer)) - (test (assoc "test" viewer))) - (if view (setcdr view (mm-unescape-mime-test (cdr view) info))) - (if test (setcdr test (mm-unescape-mime-test (cdr test) info)))) - viewer))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Experimental MIME-types parsing -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar mm-mime-extensions - '( - ("" . "text/plain") - (".abs" . "audio/x-mpeg") - (".aif" . "audio/aiff") - (".aifc" . "audio/aiff") - (".aiff" . "audio/aiff") - (".ano" . "application/x-annotator") - (".au" . "audio/ulaw") - (".avi" . "video/x-msvideo") - (".bcpio" . "application/x-bcpio") - (".bin" . "application/octet-stream") - (".cdf" . "application/x-netcdr") - (".cpio" . "application/x-cpio") - (".csh" . "application/x-csh") - (".dvi" . "application/x-dvi") - (".el" . "application/emacs-lisp") - (".eps" . "application/postscript") - (".etx" . "text/x-setext") - (".exe" . "application/octet-stream") - (".fax" . "image/x-fax") - (".gif" . "image/gif") - (".hdf" . "application/x-hdf") - (".hqx" . "application/mac-binhex40") - (".htm" . "text/html") - (".html" . "text/html") - (".icon" . "image/x-icon") - (".ief" . "image/ief") - (".jpg" . "image/jpeg") - (".macp" . "image/x-macpaint") - (".man" . "application/x-troff-man") - (".me" . "application/x-troff-me") - (".mif" . "application/mif") - (".mov" . "video/quicktime") - (".movie" . "video/x-sgi-movie") - (".mp2" . "audio/x-mpeg") - (".mp2a" . "audio/x-mpeg2") - (".mpa" . "audio/x-mpeg") - (".mpa2" . "audio/x-mpeg2") - (".mpe" . "video/mpeg") - (".mpeg" . "video/mpeg") - (".mpega" . "audio/x-mpeg") - (".mpegv" . "video/mpeg") - (".mpg" . "video/mpeg") - (".mpv" . "video/mpeg") - (".ms" . "application/x-troff-ms") - (".nc" . "application/x-netcdf") - (".nc" . "application/x-netcdf") - (".oda" . "application/oda") - (".pbm" . "image/x-portable-bitmap") - (".pdf" . "application/pdf") - (".pgm" . "image/portable-graymap") - (".pict" . "image/pict") - (".png" . "image/png") - (".pnm" . "image/x-portable-anymap") - (".ppm" . "image/portable-pixmap") - (".ps" . "application/postscript") - (".qt" . "video/quicktime") - (".ras" . "image/x-raster") - (".rgb" . "image/x-rgb") - (".rtf" . "application/rtf") - (".rtx" . "text/richtext") - (".sh" . "application/x-sh") - (".sit" . "application/x-stuffit") - (".snd" . "audio/basic") - (".src" . "application/x-wais-source") - (".tar" . "archive/tar") - (".tcl" . "application/x-tcl") - (".tcl" . "application/x-tcl") - (".tex" . "application/x-tex") - (".texi" . "application/texinfo") - (".tga" . "image/x-targa") - (".tif" . "image/tiff") - (".tiff" . "image/tiff") - (".tr" . "application/x-troff") - (".troff" . "application/x-troff") - (".tsv" . "text/tab-separated-values") - (".txt" . "text/plain") - (".vbs" . "video/mpeg") - (".vox" . "audio/basic") - (".vrml" . "x-world/x-vrml") - (".wav" . "audio/x-wav") - (".wrl" . "x-world/x-vrml") - (".xbm" . "image/xbm") - (".xpm" . "image/x-pixmap") - (".xwd" . "image/windowdump") - (".zip" . "application/zip") - (".ai" . "application/postscript") - (".jpe" . "image/jpeg") - (".jpeg" . "image/jpeg") - ) - "*An assoc list of file extensions and the MIME content-types they -correspond to.") - -(defun mm-parse-mimetypes (&optional path) - ;; Parse out all the mimetypes specified in a unix-style path string PATH - (cond - (path nil) - ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES"))) - ((memq system-type '(ms-dos ms-windows windows-nt)) - (setq path (mapconcat 'expand-file-name - '("~/mime.typ" "~/etc/mime.typ") ";"))) - (t (setq path (mapconcat 'expand-file-name - '("~/.mime-types" - "/etc/mime-types:/usr/etc/mime-types" - "/usr/local/etc/mime-types" - "/usr/local/www/conf/mime-types") ":")))) - (let ((fnames (reverse - (mm-string-to-tokens path - (if (memq system-type - '(ms-dos ms-windows windows-nt)) - ?; - ?:)))) - fname) - (while fnames - (setq fname (car fnames)) - (if (and (file-exists-p fname) (file-readable-p fname)) - (mm-parse-mimetype-file (car fnames))) - (setq fnames (cdr fnames))))) - -(defun mm-parse-mimetype-file (fname) - ;; Parse out a mime-types file - (let (type ; The MIME type for this line - extns ; The extensions for this line - save-pos ; Misc. saved buffer positions - ) - (save-excursion - (set-buffer (get-buffer-create " *mime-types*")) - (erase-buffer) - (insert-file-contents fname) - (mm-replace-regexp "#.*" "") - (mm-replace-regexp "\n+" "\n") - (mm-replace-regexp "[ \t]+$" "") - (goto-char (point-max)) - (skip-chars-backward " \t\n") - (delete-region (point) (point-max)) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward " \t\n") - (setq save-pos (point)) - (skip-chars-forward "^ \t") - (downcase-region save-pos (point)) - (setq type (buffer-substring save-pos (point))) - (while (not (eolp)) - (skip-chars-forward " \t") - (setq save-pos (point)) - (skip-chars-forward "^ \t\n") - (setq extns (cons (buffer-substring save-pos (point)) extns))) - (while extns - (setq mm-mime-extensions - (cons - (cons (if (= (string-to-char (car extns)) ?.) - (car extns) - (concat "." (car extns))) type) mm-mime-extensions) - extns (cdr extns))))))) - -(defun mm-extension-to-mime (extn) - "Return the MIME content type of the file extensions EXTN" - (if (and (stringp extn) - (not (eq (string-to-char extn) ?.))) - (setq extn (concat "." extn))) - (cdr (assoc (downcase extn) mm-mime-extensions))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Editing/Composition of body parts -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun mm-compose-type (type) - ;; Compose a body section of MIME-type TYPE. - (let* ((info (mm-mime-info type nil 5)) - (fnam (mm-generate-unique-filename)) - (comp (or (cdr (assoc "compose" info)))) - (ctyp (cdr (assoc "composetyped" info))) - (buff (get-buffer-create " *mimecompose*")) - (typeit (not ctyp)) - (retval "") - (usef nil)) - (setq comp (mm-unescape-mime-test (or comp ctyp) info)) - (while (string-match "\\([^\\\\]\\)%s" comp) - (setq comp (concat (substring comp 0 (match-end 1)) fnam - (substring comp (match-end 0) nil)) - usef t)) - (call-process shell-file-name nil - (if usef nil buff) - nil shell-command-switch comp) - (setq retval - (concat - (if typeit (concat "Content-type: " type "\r\n\r\n") "") - (if usef - (save-excursion - (set-buffer buff) - (erase-buffer) - (insert-file-contents fnam) - (buffer-string)) - (save-excursion - (set-buffer buff) - (buffer-string))) - "\r\n")) - retval)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Misc. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun mm-type-to-file (type) - "Return the file extension for content-type TYPE" - (rassoc type mm-mime-extensions)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Miscellaneous MIME viewers written in elisp -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun mm-play-sound-file (&optional buff) - "Play a sound file in buffer BUFF (defaults to current buffer)" - (setq buff (or buff (current-buffer))) - (let ((fname (mm-generate-unique-filename "%s.au")) - (synchronous-sounds t)) ; Play synchronously - (mule-write-region-no-coding-system (point-min) (point-max) fname) - (kill-buffer (current-buffer)) - (play-sound-file fname) - (condition-case () - (delete-file fname) - (error nil)))) - -(defun mm-parse-mime-headers (&optional no-delete) - "Return a list of the MIME headers at the top of this buffer. If -optional argument NO-DELETE is non-nil, don't delete the headers." - (let* ((st (point-min)) - (nd (progn - (goto-char (point-min)) - (skip-chars-forward " \t\n") - (if (re-search-forward "^\r*$" nil t) - (1+ (point)) - (point-max)))) - save-pos - status - hname - hvalu - result - ) - (narrow-to-region st nd) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward " \t\n\r") - (setq save-pos (point)) - (skip-chars-forward "^:\n\r") - (downcase-region save-pos (point)) - (setq hname (buffer-substring save-pos (point))) - (skip-chars-forward ": \t ") - (setq save-pos (point)) - (skip-chars-forward "^\n\r") - (setq hvalu (buffer-substring save-pos (point)) - result (cons (cons hname hvalu) result))) - (or no-delete (delete-region st nd)) - result)) - -(defun mm-find-available-multiparts (separator &optional buf) - "Return a list of mime-headers for the various body parts of a -multipart message in buffer BUF with separator SEPARATOR. -The different multipart specs are put in `mm-temporary-directory'." - (let ((sep (concat "^--" separator "\r*$")) - headers - fname - results) - (save-excursion - (and buf (set-buffer buf)) - (goto-char (point-min)) - (while (re-search-forward sep nil t) - (let ((st (set-marker (make-marker) - (progn - (forward-line 1) - (beginning-of-line) - (point)))) - (nd (set-marker (make-marker) - (if (re-search-forward sep nil t) - (1- (match-beginning 0)) - (point-max))))) - (narrow-to-region st nd) - (goto-char st) - (if (looking-at "^\r*$") - (insert "Content-type: text/plain\n" - "Content-length: " (int-to-string (- nd st)) "\n")) - (setq headers (mm-parse-mime-headers) - fname (mm-generate-unique-filename)) - (let ((x (or (cdr (assoc "content-type" headers)) "text/plain"))) - (if (string-match "name=\"*\\([^ \"]+\\)\"*" x) - (setq fname (expand-file-name - (substring x (match-beginning 1) - (match-end 1)) - mm-temporary-directory)))) - (widen) - (if (assoc "content-transfer-encoding" headers) - (let ((coding (cdr - (assoc "content-transfer-encoding" headers))) - (cmd nil)) - (setq coding (and coding (downcase coding)) - cmd (or (cdr (assoc coding - mm-content-transfer-encodings)) - (read-string - (concat "How shall I decode " coding "? ") - "cat"))) - (if (string= cmd "") (setq cmd "cat")) - (if (stringp cmd) - (shell-command-on-region st nd cmd t) - (funcall cmd st nd)) - (or (eq cmd 'ignore) (set-marker nd (point))))) - (write-region st nd fname nil 5) - (delete-region st nd) - (setq results (cons - (cons - (cons "mm-filename" fname) headers) results))))) - results)) - -(defun mm-format-multipart-as-html (&optional buf type) - (if buf (set-buffer buf)) - (let* ((boundary (if (string-match - "boundary[ \t]*=[ \t\"]*\\([^ \"\t\n]+\\)" - type) - (regexp-quote - (substring type (match-beginning 1) (match-end 1))))) - (parts (mm-find-available-multiparts boundary))) - (erase-buffer) - (insert "<html>\n" - " <head>\n" - " <title>Multipart Message</title>\n" - " </head>\n" - " <body>\n" - " <h1> Multipart message encountered </h1>\n" - " <p> I have encountered a multipart MIME message.\n" - " The following parts have been detected. Please\n" - " select which one you want to view.\n" - " </p>\n" - " <ul>\n" - (mapconcat - (function (lambda (x) - (concat " <li> <a href=\"file:" - (cdr (assoc "mm-filename" x)) - "\">" - (or (cdr (assoc "content-description" x)) "") - "--" - (or (cdr (assoc "content-type" x)) - "unknown type") - "</a> </li>"))) - parts "\n") - " </ul>\n" - " </body>\n" - "</html>\n" - "<!-- Automatically generated by MM v" mm-version "-->\n"))) - -(defun mm-multipart-viewer () - (mm-format-multipart-as-html - (current-buffer) - (cdr (assoc "content-type" url-current-mime-headers))) - (let ((w3-working-buffer (current-buffer))) - (w3-prepare-buffer))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Transfer encodings we can decrypt automatically -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun mm-decode-quoted-printable (&optional st nd) - (interactive) - (setq st (or st (point-min)) - nd (or nd (point-max))) - (save-restriction - (narrow-to-region st nd) - (save-excursion - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (while (re-search-forward "=[0-9A-F][0-9A-F]" nil t) - (replace-match - (char-to-string - (+ - (* 16 (mm-hex-char-to-integer - (char-after (1+ (match-beginning 0))))) - (mm-hex-char-to-integer - (char-after (1- (match-end 0)))))))))) - (goto-char (point-max)))) - -;; Taken from hexl.el. -(defun mm-hex-char-to-integer (character) - "Take a char and return its value as if it was a hex digit." - (if (and (>= character ?0) (<= character ?9)) - (- character ?0) - (let ((ch (logior character 32))) - (if (and (>= ch ?a) (<= ch ?f)) - (- ch (- ?a 10)) - (error (format "Invalid hex digit `%c'." ch)))))) - - -(require 'base64) -(provide 'mm) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/mule-sysdp.el --- a/lisp/w3/mule-sysdp.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,178 +0,0 @@ -;;; mule-sysdp.el --- consolidate MULE-version dependencies in one file. - -;; Copyright (c) 1996, 1997 William Perry - -;; Author: William Perry <wmperry@cs.indiana.edu> -;; Keywords: lisp, tools - -;; The purpose of this file is to eliminate the cruftiness that -;; would otherwise be required of packages that want to run on multiple -;; versions of Emacs with and without Mule support. - -(require 'cl) - -(defconst mule-sysdep-version (if (featurep 'mule) - (cond - ((string-match "XEmacs" emacs-version) - 'xemacs) - ((and - (boundp 'mule-version) - (string-match "[0-9]+\\.[0-9]+" - mule-version)) - (string-to-number (substring - mule-version - (match-beginning 0) - (match-end 0)))) - (t 2.3)) - 0) - "What version of mule we are running under.") - -(defconst mule-retrieval-coding-system - (case mule-sysdep-version - (2.3 *euc-japan*) - (2.4 'coding-system-euc-japan) - (3.0 'euc-japan) - (xemacs 'euc-japan) - (otherwise nil)) - "Default retrieval coding system for packages that use this package.") - -(defconst mule-no-coding-system - (case mule-sysdep-version - (2.3 *noconv*) - (2.4 'no-conversion) - (3.0 'no-conversion) - (xemacs 'no-conversion) - (otherwise nil)) - "Coding system that means no coding system should be used.") - -(defun mule-detect-coding-version (st nd) - (case mule-sysdep-version - (2.3 (code-detect-region (point-min) (point-max))) - ((2.4 3.0 xemacs) - (detect-coding-region (point-min) (point-max))) - (otherwise nil))) - -(defun mule-code-convert-region (st nd code) - (if (and (listp code) (car code)) - (setq code (car code))) - (case mule-sysdep-version - (2.3 - (set 'mc-flag t) - (code-convert-region (point-min) (point-max) code *internal*) - (set-file-coding-system code)) - (2.4 - (setq enable-multibyte-characters t) - (if (memq code '(autodetect coding-system-automatic)) - nil - (decode-coding-region st nd code) - (set-buffer-file-coding-system code))) - (3.0 - (setq enable-multibyte-characters t) - (if (memq code '(autodetect automatic-conversion)) - nil - (or code (setq code 'automatic-conversion)) - (decode-coding-region st nd code) - (set-buffer-file-coding-system code))) - (xemacs - (if (and (listp code) (not (car code))) - (progn - (setq code 'autodetect) - (condition-case () - (get-coding-system 'autodetect) - (error (setq code 'automatic-conversion))))) - (decode-coding-region (point-min) (point-max) code) - (set-file-coding-system code)) - (otherwise - nil))) - -(defun mule-inhibit-code-conversion (proc) - (if (process-buffer proc) - (save-excursion - (set-buffer (process-buffer proc)) - (set 'mc-flag nil) - (set 'enable-multibyte-characters nil))) - (case mule-sysdep-version - ((3.0 2.4 2.3) - (set-process-coding-system proc mule-no-coding-system - mule-no-coding-system)) - (xemacs - (set-process-input-coding-system proc mule-no-coding-system) - (set-process-input-coding-system proc mule-no-coding-system)))) - -(defun mule-write-region-no-coding-system (st nd file) - (let ((enable-multibyte-characters t) - (coding-system-for-write 'no-conversion) - (file-coding-system mule-no-coding-system) - (buffer-file-coding-system mule-no-coding-system) - (mc-flag t)) - (case mule-sysdep-version - (2.3 (write-region st nd file nil nil nil *noconv*)) - (otherwise - (write-region st nd file))))) - -(defun mule-encode-string (str) - (case mule-sysdep-version - (2.3 - (code-convert-string str *internal* mule-retrieval-coding-system)) - ((2.4 3.0 xemacs) - (encode-coding-string str mule-retrieval-coding-system)) - (otherwise - str))) - -(defun mule-decode-string (str) - (and str - (case mule-sysdep-version - ((2.4 3.0 xemacs) - (decode-coding-string str mule-retrieval-coding-system)) - (2.3 - (code-convert-string str *internal* mule-retrieval-coding-system)) - (otherwise - str)))) - -(defun mule-truncate-string (str len &optional pad) - "Truncate string STR so that string-width of STR is not greater than LEN. - If width of the truncated string is less than LEN, and if a character PAD is - defined, add padding end of it." - (case mule-sysdep-version - ((2.4 3.0) - (let ((cl (string-to-vector str)) (n 0) (sw 0)) - (if (<= (string-width str) len) str - (while (<= (setq sw (+ (char-width (aref cl n)) sw)) len) - (setq n (1+ n))) - (string-match (make-string n ?.) str) - (setq str (substring str 0 (match-end 0)))) - (if pad (concat str (make-string (- len (string-width str)) pad)) str))) - (2.3 - (let ((cl (string-to-char-list str)) (n 0) (sw 0)) - (if (<= (string-width str) len) str - (while (<= (setq sw (+ (char-width (nth n cl)) sw)) len) - (setq n (1+ n))) - (string-match (make-string n ?.) str) - (setq str (substring str 0 (match-end 0)))) - (if pad (concat str (make-string (- len (string-width str)) pad)) str))) - (otherwise - (concat (if (> (length str) len) (substring str 0 len) str) - (if (or (null pad) (> (length str) len)) - "" - (make-string (- len (length str)) pad)))))) - -(defun mule-make-iso-character (char) - (if (<= char 127) - char - (case mule-sysdep-version - (2.3 (make-character lc-ltn1 char)) - (2.4 (make-char charset-latin-iso8859-1 char)) - (3.0 (make-char 'latin-iso8859-1 char)) - (xemacs char) - (otherwise char)))) - -(case mule-sysdep-version - ((2.3 2.4 3.0 xemacs) nil) - (otherwise (fset 'string-width 'length))) - -(and - (boundp 'MULE) - (not (featurep 'mule)) - (provide 'mule)) - -(provide 'mule-sysdp) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/socks.el --- a/lisp/w3/socks.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,385 +0,0 @@ -;;; socks.el --- A Socks v5 Client for Emacs -;; Author: wmperry -;; Created: 1997/08/08 21:08:34 -;; Version: 1.5 -;; Keywords: comm, firewalls - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996, 1997 by William M. Perry (wmperry@cs.indiana.edu) -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; This is an implementation of the SOCKS v5 protocol as defined in -;;; RFC 1928. -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'cl) - -(defconst socks-version 5) -(defvar socks-debug nil) - -;; Common socks v5 commands -(defconst socks-connect-command 1) -(defconst socks-bind-command 2) -(defconst socks-udp-associate-command 3) - -;; Miscellaneous other socks constants -(defconst socks-authentication-null 0) -(defconst socks-authentication-failure 255) - -;; Response codes -(defconst socks-response-success 0) -(defconst socks-response-general-failure 1) -(defconst socks-response-access-denied 2) -(defconst socks-response-network-unreachable 3) -(defconst socks-response-host-unreachable 4) -(defconst socks-response-connection-refused 5) -(defconst socks-response-ttl-expired 6) -(defconst socks-response-cmd-not-supported 7) -(defconst socks-response-address-not-supported 8) - -(defvar socks-errors - '("Succeeded" - "General SOCKS server failure" - "Connection not allowed by ruleset" - "Network unreachable" - "Host unreachable" - "Connection refused" - "Time-to-live expired" - "Command not supported" - "Address type not supported")) - -;; The socks v5 address types -(defconst socks-address-type-v4 1) -(defconst socks-address-type-name 3) -(defconst socks-address-type-v6 4) - -;; Base variables -(defvar socks-host (or (getenv "SOCKS5_SERVER") "socks")) -(defvar socks-port (or (getenv "SOCKS5_PORT") 1080)) -(defvar socks-timeout 5) -(defvar socks-connections (make-hash-table :size 13)) - -;; Miscellaneous stuff for authentication -(defvar socks-authentication-methods nil) -(defvar socks-username (user-login-name)) -(defvar socks-password nil) - -(defun socks-register-authentication-method (id desc callback) - (let ((old (assq id socks-authentication-methods))) - (if old - (setcdr old (cons desc callback)) - (setq socks-authentication-methods - (cons (cons id (cons desc callback)) - socks-authentication-methods))))) - -(defun socks-unregister-authentication-method (id) - (let ((old (assq id socks-authentication-methods))) - (if old - (setq socks-authentication-methods - (delq old socks-authentication-methods))))) - -(socks-register-authentication-method 0 "No authentication" 'identity) - -(defun socks-build-auth-list () - (let ((num 0) - (retval "")) - (mapcar - (function - (lambda (x) - (if (fboundp (cdr (cdr x))) - (setq retval (format "%s%c" retval (car x)) - num (1+ num))))) - socks-authentication-methods) - (format "%c%s" num retval))) - -(defconst socks-state-waiting-for-auth 0) -(defconst socks-state-submethod-negotiation 1) -(defconst socks-state-authenticated 2) -(defconst socks-state-waiting 3) -(defconst socks-state-connected 4) - -(defmacro socks-wait-for-state-change (proc htable cur-state) - (` - (while (and (= (cl-gethash 'state (, htable)) (, cur-state)) - (memq (process-status (, proc)) '(run open))) - (accept-process-output (, proc) socks-timeout)))) - -(defun socks-filter (proc string) - (let ((info (cl-gethash proc socks-connections)) - state desired-len) - (or info (error "socks-filter called on non-SOCKS connection %S" proc)) - (setq state (cl-gethash 'state info)) - (cond - ((= state socks-state-waiting-for-auth) - (cl-puthash 'scratch (concat string (cl-gethash 'scratch info)) info) - (setq string (cl-gethash 'scratch info)) - (if (< (length string) 2) - nil ; We need to spin some more - (cl-puthash 'authtype (aref string 1) info) - (cl-puthash 'scratch (substring string 2 nil) info) - (cl-puthash 'state socks-state-submethod-negotiation info))) - ((= state socks-state-submethod-negotiation) - ) - ((= state socks-state-authenticated) - ) - ((= state socks-state-waiting) - (cl-puthash 'scratch (concat string (cl-gethash 'scratch info)) info) - (setq string (cl-gethash 'scratch info)) - (if (< (length string) 4) - nil - (setq desired-len - (+ 6 ; Standard socks header - (cond - ((= (aref string 3) socks-address-type-v4) 4) - ((= (aref string 3) socks-address-type-v6) 16) - ((= (aref string 3) socks-address-type-name) - (if (< (length string) 5) - 255 - (+ 1 (aref string 4))))))) - (if (< (length string) desired-len) - nil ; Need to spin some more - (cl-puthash 'state socks-state-connected info) - (cl-puthash 'reply (aref string 1) info) - (cl-puthash 'response string info)))) - ((= state socks-state-connected) - ) - ) - ) - ) - -(defun socks-open-connection (&optional host port) - (interactive) - (setq host (or host socks-host) - port (or port socks-port)) - (save-excursion - (let ((proc (socks-original-open-network-stream "socks" - nil - host port)) - (info (make-hash-table :size 13)) - (authtype nil)) - - ;; Initialize process and info about the process - (set-process-filter proc 'socks-filter) - (process-kill-without-query proc) - (cl-puthash proc info socks-connections) - (cl-puthash 'state socks-state-waiting-for-auth info) - (cl-puthash 'authtype socks-authentication-failure info) - - ;; Send what we think we can handle for authentication types - (process-send-string proc (format "%c%s" socks-version - (socks-build-auth-list))) - - ;; Basically just do a select() until we change states. - (socks-wait-for-state-change proc info socks-state-waiting-for-auth) - (setq authtype (cl-gethash 'authtype info)) - (cond - ((= authtype socks-authentication-null) - (and socks-debug (message "No authentication necessary"))) - ((= authtype socks-authentication-failure) - (error "No acceptable authentication methods found.")) - (t - (let* ((auth-type (char-int (cl-gethash 'authtype info))) - (auth-handler (assoc auth-type socks-authentication-methods)) - (auth-func (and auth-handler (cdr (cdr auth-handler)))) - (auth-desc (and auth-handler (car (cdr auth-handler))))) - (set-process-filter proc nil) - (if (and auth-func (fboundp auth-func) - (funcall auth-func proc)) - nil ; We succeeded! - (delete-process proc) - (error "Failed to use auth method: %s (%d)" - (or auth-desc "Unknown") auth-type)) - ) - ) - ) - (cl-puthash 'state socks-state-authenticated info) - (set-process-filter proc 'socks-filter) - proc))) - -(defun socks-send-command (proc command atype address port) - (let ((addr (case atype - (socks-address-type-v4 address) - (socks-address-type-v6 address) - (t - (format "%c%s" (length address) address)))) - (info (cl-gethash proc socks-connections))) - (or info (error "socks-send-command called on non-SOCKS connection %S" - proc)) - (cl-puthash 'state socks-state-waiting info) - (process-send-string proc - (format - "%c%c%c%c%s%c%c" - socks-version ; version - command ; command - 0 ; reserved - atype ; address type - addr ; address - (lsh port -8) ; port, high byte - (- port (lsh (lsh port -8) 8)) ; port, low byte - )) - (socks-wait-for-state-change proc info socks-state-waiting) - (if (= (cl-gethash 'reply info) socks-response-success) - nil ; Sweet sweet success! - (delete-process proc) - (error "%s" (nth (cl-gethash 'reply info) socks-errors))) - proc)) - - -;; Replacement functions for open-network-stream, etc. -(defvar socks-noproxy nil - "*List of regexps matching hosts that we should not socksify connections to") - -(defun socks-find-route (host service) - (let ((route (cons socks-host socks-port)) - (noproxy socks-noproxy)) - (while noproxy - (if (eq ?! (aref (car noproxy) 0)) - (if (string-match (substring (car noproxy) 1) host) - (setq route nil - noproxy nil)) - (if (string-match (car noproxy) host) - (setq route nil - noproxy nil))) - (setq noproxy (cdr noproxy))) - route)) - -(if (fboundp 'socks-original-open-network-stream) - nil ; Do nothing, we've been here already - (fset 'socks-original-open-network-stream - (symbol-function 'open-network-stream)) - (fset 'open-network-stream 'socks-open-network-stream)) - -(defvar socks-services-file "/etc/services") -(defvar socks-tcp-services (make-hash-table :size 13 :test 'equal)) -(defvar socks-udp-services (make-hash-table :size 13 :test 'equal)) - -(defun socks-parse-services () - (if (not (and (file-exists-p socks-services-file) - (file-readable-p socks-services-file))) - (error "Could not find services file: %s" socks-services-file)) - (save-excursion - (clrhash socks-tcp-services) - (clrhash socks-udp-services) - (set-buffer (get-buffer-create " *socks-tmp*")) - (erase-buffer) - (insert-file-contents socks-services-file) - ;; Nuke comments - (goto-char (point-min)) - (while (re-search-forward "#.*" nil t) - (replace-match "")) - ;; Nuke empty lines - (goto-char (point-min)) - (while (re-search-forward "^[ \t\n]+" nil t) - (replace-match "")) - ;; Now find all the lines - (goto-char (point-min)) - (let (name port type) - (while (re-search-forward "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)/\\([a-z]+\\)" - nil t) - (setq name (downcase (match-string 1)) - port (string-to-int (match-string 2)) - type (downcase (match-string 3))) - (cl-puthash name port (if (equal type "udp") - socks-udp-services - socks-tcp-services)))))) - -(defun socks-find-services-entry (service &optional udp) - "Return the port # associated with SERVICE" - (if (= (hash-table-count socks-tcp-services) 0) - (socks-parse-services)) - (cl-gethash (downcase service) - (if udp socks-udp-services socks-tcp-services))) - -(defun socks-open-network-stream (name buffer host service) - (let* ((route (socks-find-route host service)) - proc info) - (if (not route) - (socks-original-open-network-stream name buffer host service) - (setq proc (socks-open-connection (car route) (cdr route)) - info (cl-gethash proc socks-connections)) - (socks-send-command proc socks-connect-command - socks-address-type-name - host - (if (stringp service) - (socks-find-services-entry service) - service)) - (cl-puthash 'buffer buffer info) - (cl-puthash 'host host info) - (cl-puthash 'service host info) - (set-process-filter proc nil) - (set-process-buffer proc (if buffer (get-buffer-create buffer))) - proc))) - -;; Authentication modules go here - -;; Basic username/password authentication, ala RFC 1929 -(socks-register-authentication-method 2 "Username/Password" - 'socks-username/password-auth) - -(defconst socks-username/password-auth-version 1) - -(if (not (fboundp 'char-int)) - (fset 'char-int 'identity)) - -(defun socks-username/password-auth-filter (proc str) - (let ((info (cl-gethash proc socks-connections)) - state desired-len) - (or info (error "socks-filter called on non-SOCKS connection %S" proc)) - (setq state (cl-gethash 'state info)) - (cl-puthash 'scratch (concat (cl-gethash 'scratch info) str) info) - (if (< (length (cl-gethash 'scratch info)) 2) - nil - (cl-puthash 'password-auth-status (char-int - (aref (cl-gethash 'scratch info) 1)) - info) - (cl-puthash 'state socks-state-authenticated info)))) - -(defun socks-username/password-auth (proc) - (if (not socks-password) - (setq socks-password (read-passwd - (format "Password for %s@%s: " - socks-username socks-host)))) - (let* ((info (cl-gethash proc socks-connections)) - (state (cl-gethash 'state info))) - (cl-puthash 'scratch "" info) - (set-process-filter proc 'socks-username/password-auth-filter) - (process-send-string proc - (format "%c%c%s%c%s" - socks-username/password-auth-version - (length socks-username) - socks-username - (length socks-password) - socks-password)) - (socks-wait-for-state-change proc info state) - (= (cl-gethash 'password-auth-status info) 0))) - - -;; More advanced GSS/API stuff, not yet implemented - volunteers? -;; (socks-register-authentication-method 1 "GSS/API" 'socks-gssapi-auth) - -(defun socks-gssapi-auth (proc) - nil) - - -;; CHAP stuff -;; (socks-register-authentication-method 3 "CHAP" 'socks-chap-auth) -(defun socks-chap-auth (proc) - nil) - -(provide 'socks) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/ssl.el --- a/lisp/w3/ssl.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,169 +0,0 @@ -;;; ssl.el,v --- ssl functions for emacsen without them builtin -;; Author: wmperry -;; Created: 1997/03/31 16:22:42 -;; Version: 1.14 -;; Keywords: comm - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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 'cl) -(require 'base64) - -(eval-and-compile - (condition-case () - (require 'custom) - (error nil)) - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - nil ;; We've got what we needed - ;; We have the old custom-library, hack around it! - (defmacro defgroup (&rest args) - nil) - (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))))) - -(defgroup ssl nil - "Support for `Secure Sockets Layer' encryption." - :group 'comm) - -(defcustom ssl-certificate-directory "~/.w3/certs/" - "*Directory to store CA certificates in" - :group 'ssl - :type 'directory) - -(defcustom ssl-rehash-program-name "c_rehash" - "*Program to run after adding a cert to a directory . -Run with one argument, the directory name." - :group 'ssl - :type 'string) - -(defcustom ssl-view-certificate-program-name "x509" - "*The program to run to provide a human-readable view of a certificate." - :group 'ssl - :type 'string) - -(defcustom ssl-view-certificate-program-arguments '("-text" "-inform" "DER") - "*Arguments that should be passed to the certificate viewing program. -The certificate is piped to it. -Maybe a way of passing a file should be implemented" - :group 'ssl - :type 'list) - -(defcustom ssl-certificate-directory-style 'ssleay - "*Style of cert database to use, the only valid value right now is `ssleay'. -This means a directory of pem encoded certificates with hash symlinks." - :group 'ssl - :type '(choice (const :tag "SSLeay" :value ssleay))) - -(defcustom ssl-certificate-verification-policy 0 - "*How far up the certificate chain we should verify." - :group 'ssl - :type '(choice (const :tag "No verification" :value 0) - (const :tag "Verification required" :value 1) - (const :tag "Reject connection if verification fails" :value 3) - (const :tag "SSL_VERIFY_CLIENT_ONCE" :value 5))) - -(defcustom ssl-program-name "s_client" - "*The program to run in a subprocess to open an SSL connection." - :group 'ssl - :type 'string) - -(defcustom ssl-program-arguments - '(;;"-quiet" - "-host" host - "-port" service - "-verify" (int-to-string ssl-certificate-verification-policy) - "-CApath" ssl-certificate-directory - ) - "*Arguments that should be passed to the program `ssl-program-name'. -This should be used if your SSL program needs command line switches to -specify any behaviour (certificate file locations, etc). -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." - :group 'ssl - :type 'list) - -(defun ssl-accept-ca-certificate () - "Ask if the user is willing to accept a new CA certificate. The buffer-name -should be the intended name of the certificate, and the buffer should probably -be in DER encoding" - ;; TODO, check if it is really new or if we already know it - (let* ((process-connection-type nil) - (tmpbuf (generate-new-buffer "X509 CA Certificate Information")) - (response (save-excursion - (and (eq 0 - (apply 'call-process-region - (point-min) (point-max) - ssl-view-certificate-program-name - nil tmpbuf t - ssl-view-certificate-program-arguments)) - (switch-to-buffer tmpbuf) - (goto-char (point-min)) - (or (recenter) t) - (yes-or-no-p - "Accept this CA to vouch for secure server identities? ") - (kill-buffer tmpbuf))))) - (if (not response) - nil - (if (not (file-directory-p ssl-certificate-directory)) - (make-directory ssl-certificate-directory)) - (case ssl-certificate-directory-style - (ssleay - (base64-encode-region (point-min) (point-max)) - (goto-char (point-min)) - (insert "-----BEGIN CERTIFICATE-----\n") - (goto-char (point-max)) - (insert "-----END CERTIFICATE-----\n") - (let ((f (expand-file-name - (concat (file-name-sans-extension (buffer-name)) ".pem") - ssl-certificate-directory))) - (write-file f) - (call-process ssl-rehash-program-name - nil nil nil - (expand-file-name ssl-certificate-directory)))))))) - -(defun open-ssl-stream (name buffer host service) - "Open a SSL connection for a service to a host. -Returns a subprocess-object to represent the connection. -Input and output work as for subprocesses; `delete-process' closes it. -Args are NAME BUFFER HOST SERVICE. -NAME is name for process. It is modified if necessary to make it unique. -BUFFER is the buffer (or buffer-name) to associate with the process. - Process output goes at end of that buffer, unless you specify - an output stream or filter function to handle the output. - BUFFER may be also nil, meaning that this process is not associated - with any buffer -Third arg is name of the host to connect to, or its IP address. -Fourth arg SERVICE is name of the service desired, or an integer -specifying a port number to connect to." - (if (integerp service) (setq service (int-to-string service))) - (let* ((process-connection-type nil) - (port service) - (proc (eval - (` - (start-process name buffer ssl-program-name - (,@ ssl-program-arguments)))))) - (process-kill-without-query proc) - proc)) - -(provide 'ssl) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url-auth.el --- a/lisp/w3/url-auth.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,305 +0,0 @@ -;;; url-auth.el --- Uniform Resource Locator authorization modules -;; Author: wmperry -;; Created: 1997/02/18 23:34:14 -;; Version: 1.6 -;; Keywords: comm, data, processes, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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 'url-vars) -(require 'url-parse) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Basic authorization code -;;; ------------------------ -;;; This implements the BASIC authorization type. See the online -;;; documentation at -;;; http://www.w3.org/hypertext/WWW/AccessAuthorization/Basic.html -;;; for the complete documentation on this type. -;;; -;;; This is very insecure, but it works as a proof-of-concept -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar url-basic-auth-storage nil - "Where usernames and passwords are stored. Its value is an assoc list of -assoc lists. The first assoc list is keyed by the server name. The cdr of -this is an assoc list based on the 'directory' specified by the url we are -looking up.") - -(defun url-basic-auth (url &optional prompt overwrite realm args) - "Get the username/password for the specified URL. -If optional argument PROMPT is non-nil, ask for the username/password -to use for the url and its descendants. If optional third argument -OVERWRITE is non-nil, overwrite the old username/password pair if it -is found in the assoc list. If REALM is specified, use that as the realm -instead of the pathname inheritance method." - (let* ((href (if (stringp url) - (url-generic-parse-url url) - url)) - (server (url-host href)) - (port (or (url-port href) "80")) - (path (url-filename href)) - user pass byserv retval data) - (setq server (concat server ":" port) - path (cond - (realm realm) - ((string-match "/$" path) path) - (t (url-basepath path))) - byserv (cdr-safe (assoc server url-basic-auth-storage))) - (cond - ((and prompt (not byserv)) - (setq user (read-string "Username: " (user-real-login-name)) - pass (funcall url-passwd-entry-func "Password: ") - url-basic-auth-storage - (cons (list server - (cons path - (setq retval - (base64-encode - (format "%s:%s" user pass))))) - url-basic-auth-storage))) - (byserv - (setq retval (cdr-safe (assoc path byserv))) - (if (and (not retval) - (string-match "/" path)) - (while (and byserv (not retval)) - (setq data (car (car byserv))) - (if (or (not (string-match "/" data)) ; Its a realm - take it! - (and - (>= (length path) (length data)) - (string= data (substring path 0 (length data))))) - (setq retval (cdr (car byserv)))) - (setq byserv (cdr byserv)))) - (if (or (and (not retval) prompt) overwrite) - (progn - (setq user (read-string "Username: " (user-real-login-name)) - pass (funcall url-passwd-entry-func "Password: ") - retval (base64-encode (format "%s:%s" user pass)) - byserv (assoc server url-basic-auth-storage)) - (setcdr byserv - (cons (cons path retval) (cdr byserv)))))) - (t (setq retval nil))) - (if retval (setq retval (concat "Basic " retval))) - retval)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Digest authorization code -;;; ------------------------ -;;; This implements the DIGEST authorization type. See the internet draft -;;; ftp://ds.internic.net/internet-drafts/draft-ietf-http-digest-aa-01.txt -;;; for the complete documentation on this type. -;;; -;;; This is very secure -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar url-digest-auth-storage nil - "Where usernames and passwords are stored. Its value is an assoc list of -assoc lists. The first assoc list is keyed by the server name. The cdr of -this is an assoc list based on the 'directory' specified by the url we are -looking up.") - -(defun url-digest-auth-create-key (username password realm method uri) - "Create a key for digest authentication method" - (let* ((info (if (stringp uri) - (url-generic-parse-url uri) - uri)) - (a1 (md5 (concat username ":" realm ":" password))) - (a2 (md5 (concat method ":" (url-filename info))))) - (list a1 a2))) - -(defun url-digest-auth (url &optional prompt overwrite realm args) - "Get the username/password for the specified URL. -If optional argument PROMPT is non-nil, ask for the username/password -to use for the url and its descendants. If optional third argument -OVERWRITE is non-nil, overwrite the old username/password pair if it -is found in the assoc list. If REALM is specified, use that as the realm -instead of hostname:portnum." - (if args - (let* ((href (if (stringp url) - (url-generic-parse-url url) - url)) - (server (url-host href)) - (port (or (url-port href) "80")) - (path (url-filename href)) - user pass byserv retval data) - (setq path (cond - (realm realm) - ((string-match "/$" path) path) - (t (url-basepath path))) - server (concat server ":" port) - byserv (cdr-safe (assoc server url-digest-auth-storage))) - (cond - ((and prompt (not byserv)) - (setq user (read-string "Username: " (user-real-login-name)) - pass (funcall url-passwd-entry-func "Password: ") - url-digest-auth-storage - (cons (list server - (cons path - (setq retval - (cons user - (url-digest-auth-create-key - user pass realm - (or url-request-method "GET") - url))))) - url-digest-auth-storage))) - (byserv - (setq retval (cdr-safe (assoc path byserv))) - (if (and (not retval) ; no exact match, check directories - (string-match "/" path)) ; not looking for a realm - (while (and byserv (not retval)) - (setq data (car (car byserv))) - (if (or (not (string-match "/" data)) - (and - (>= (length path) (length data)) - (string= data (substring path 0 (length data))))) - (setq retval (cdr (car byserv)))) - (setq byserv (cdr byserv)))) - (if (or (and (not retval) prompt) overwrite) - (progn - (setq user (read-string "Username: " (user-real-login-name)) - pass (funcall url-passwd-entry-func "Password: ") - retval (setq retval - (cons user - (url-digest-auth-create-key - user pass realm - (or url-request-method "GET") - url))) - byserv (assoc server url-digest-auth-storage)) - (setcdr byserv - (cons (cons path retval) (cdr byserv)))))) - (t (setq retval nil))) - (if retval - (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven")) - (opaque (or (cdr-safe (assoc "opaque" args)) "nonegiven"))) - (format - (concat "Digest username=\"%s\", realm=\"%s\"," - "nonce=\"%s\", uri=\"%s\"," - "response=\"%s\", opaque=\"%s\"") - (nth 0 retval) realm nonce (url-filename href) - (md5 (concat (nth 1 retval) ":" nonce ":" - (nth 2 retval))) opaque)))))) - -(defvar url-registered-auth-schemes nil - "A list of the registered authorization schemes and various and sundry -information associated with them.") - -;;###autoload -(defun url-get-authentication (url realm type prompt &optional args) - "Return an authorization string suitable for use in the WWW-Authenticate -header in an HTTP/1.0 request. - -URL is the url you are requesting authorization to. This can be either a - string representing the URL, or the parsed representation returned by - `url-generic-parse-url' -REALM is the realm at a specific site we are looking for. This should be a - string specifying the exact realm, or nil or the symbol 'any' to - specify that the filename portion of the URL should be used as the - realm -TYPE is the type of authentication to be returned. This is either a string - representing the type (basic, digest, etc), or nil or the symbol 'any' - to specify that any authentication is acceptable. If requesting 'any' - the strongest matching authentication will be returned. If this is - wrong, its no big deal, the error from the server will specify exactly - what type of auth to use -PROMPT is boolean - specifies whether to ask the user for a username/password - if one cannot be found in the cache" - (if (not realm) - (setq realm (cdr-safe (assoc "realm" args)))) - (if (stringp url) - (setq url (url-generic-parse-url url))) - (if (or (null type) (eq type 'any)) - ;; Whooo doogies! - ;; Go through and get _all_ the authorization strings that could apply - ;; to this URL, store them along with the 'rating' we have in the list - ;; of schemes, then sort them so that the 'best' is at the front of the - ;; list, then get the car, then get the cdr. - ;; Zooom zooom zoooooom - (cdr-safe - (car-safe - (sort - (mapcar - (function - (lambda (scheme) - (if (fboundp (car (cdr scheme))) - (cons (cdr (cdr scheme)) - (funcall (car (cdr scheme)) url nil nil realm)) - (cons 0 nil)))) - url-registered-auth-schemes) - (function - (lambda (x y) - (cond - ((null (cdr x)) nil) - ((and (cdr x) (null (cdr y))) t) - ((and (cdr x) (cdr y)) - (>= (car x) (car y))) - (t nil))))))) - (if (symbolp type) (setq type (symbol-name type))) - (let* ((scheme (car-safe - (cdr-safe (assoc (downcase type) - url-registered-auth-schemes))))) - (if (and scheme (fboundp scheme)) - (funcall scheme url prompt - (and prompt - (funcall scheme url nil nil realm args)) - realm args))))) - -;;###autoload -(defun url-register-auth-scheme (type &optional function rating) - "Register an HTTP authentication method. - -TYPE is a string or symbol specifying the name of the method. This - should be the same thing you expect to get returned in an Authenticate - header in HTTP/1.0 - it will be downcased. -FUNCTION is the function to call to get the authorization information. This - defaults to `url-?-auth', where ? is TYPE -RATING a rating between 1 and 10 of the strength of the authentication. - This is used when asking for the best authentication for a specific - URL. The item with the highest rating is returned." - (let* ((type (cond - ((stringp type) (downcase type)) - ((symbolp type) (downcase (symbol-name type))) - (t (error "Bad call to `url-register-auth-scheme'")))) - (function (or function (intern (concat "url-" type "-auth")))) - (rating (cond - ((null rating) 2) - ((stringp rating) (string-to-int rating)) - (t rating))) - (node (assoc type url-registered-auth-schemes))) - (if (not (fboundp function)) - (url-warn 'security - (format (eval-when-compile - "Tried to register `%s' as an auth scheme" - ", but it is not a function!") function))) - - (if node - (progn - (setcdr node (cons function rating)) - (url-warn 'security - (format - "Replacing authorization method `%s' - this could be bad." - type))) - (setq url-registered-auth-schemes - (cons (cons type (cons function rating)) - url-registered-auth-schemes))))) - -(defun url-auth-registered (scheme) - ;; Return non-nil iff SCHEME is registered as an auth type - (assoc scheme url-registered-auth-schemes)) - -(provide 'urlauth) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url-cache.el --- a/lisp/w3/url-cache.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,268 +0,0 @@ -;;; url-cache.el --- Uniform Resource Locator retrieval tool -;; Author: wmperry -;; Created: 1997/04/11 14:39:32 -;; Version: 1.12 -;; Keywords: comm, data, processes, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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 'md5) - -(defcustom url-cache-directory "~/.w3/cache/" - "*The directory where cache files should be stored." - :type 'directory - :group 'url-file) - -;; Cache manager -(defun url-cache-file-writable-p (file) - "Follows the documentation of file-writable-p, unlike file-writable-p." - (and (file-writable-p file) - (if (file-exists-p file) - (not (file-directory-p file)) - (file-directory-p (file-name-directory file))))) - -(defun url-cache-prepare (file) - "Makes it possible to cache data in FILE. -Creates any necessary parent directories, deleting any non-directory files -that would stop this. Returns nil if parent directories can not be -created. If FILE already exists as a non-directory, it changes -permissions of FILE or deletes FILE to make it possible to write a new -version of FILE. Returns nil if this can not be done. Returns nil if -FILE already exists as a directory. Otherwise, returns t, indicating that -FILE can be created or overwritten." - (cond - ((url-cache-file-writable-p file) - t) - ((file-directory-p file) - nil) - (t - (condition-case () - (or (make-directory (file-name-directory file) t) t) - (error nil))))) - -(defcustom url-cache-ignored-protocols - '("www" "about" "https" "mailto") - "*A list of protocols that we should never cache." - :type '(repeat (string :tag "Protocol")) - :group 'url-cache) - -(defun url-cache-cachable-p (obj) - ;; return t iff the current buffer is cachable - (cond - ((not url-automatic-caching) ; User doesn't want to cache - nil) - ((null obj) ; Something horribly confused - nil) - ((member (url-type obj) url-cache-ignored-protocols) - ;; We have been told to ignore this type of object - nil) - ((and (member (url-type obj) '("file" "ftp")) (not (url-host obj))) - ;; We never want to cache local files... what's the point? - nil) - ((member (url-type obj) '("http" "https")) - (let* ((status (cdr-safe (assoc "status" url-current-mime-headers))) - (class (if status (/ status 100) 0))) - (cond - ((string-match (eval-when-compile (regexp-quote "?")) - (url-filename obj)) - nil) - ((= class 2) - (memq status '(200))) - (t nil)))) - (t - nil))) - -;;;###autoload -(defun url-store-in-cache (&optional buff) - "Store buffer BUFF in the cache" - (if (not (and buff (get-buffer buff))) - nil - (save-excursion - (and buff (set-buffer buff)) - (if (not (url-cache-cachable-p url-current-object)) - nil - (let* ((fname (url-cache-create-filename (url-view-url t))) - (fname-hdr (concat fname ".hdr")) - (info (mapcar (function (lambda (var) - (cons (symbol-name var) - (symbol-value var)))) - '( url-current-content-length - url-current-object - url-current-isindex - url-current-mime-encoding - url-current-mime-headers - url-current-mime-type - )))) - (cond ((and (url-cache-prepare fname) - (url-cache-prepare fname-hdr)) - (write-region (point-min) (point-max) fname nil 5) - (set-buffer (get-buffer-create " *cache-tmp*")) - (erase-buffer) - (insert "(setq ") - (mapcar - (function - (lambda (x) - (insert (car x) " " - (cond ((null (setq x (cdr x))) "nil") - ((stringp x) (prin1-to-string x)) - ((listp x) (concat "'" (prin1-to-string x))) - ((vectorp x) (prin1-to-string x)) - ((numberp x) (int-to-string x)) - (t "'???")) "\n"))) - info) - (insert ")\n") - (write-region (point-min) (point-max) fname-hdr nil 5)))))))) - - -;;;###autoload -(defun url-is-cached (url) - "Return non-nil if the URL is cached." - (let* ((fname (url-cache-create-filename url)) - (attribs (file-attributes fname))) - (and fname ; got a filename - (file-exists-p fname) ; file exists - (not (eq (nth 0 attribs) t)) ; Its not a directory - (nth 5 attribs)))) ; Can get last mod-time - -(defun url-cache-create-filename-human-readable (url) - "Return a filename in the local cache for URL" - (if url - (let* ((url (if (vectorp url) (url-recreate-url url) url)) - (urlobj (url-generic-parse-url url)) - (protocol (url-type urlobj)) - (hostname (url-host urlobj)) - (host-components - (cons - (user-real-login-name) - (cons (or protocol "file") - (reverse (split-string (or hostname "localhost") - (eval-when-compile - (regexp-quote "."))))))) - (fname (url-filename urlobj))) - (if (and fname (/= (length fname) 0) (= (aref fname 0) ?/)) - (setq fname (substring fname 1 nil))) - (if fname - (let ((slash nil)) - (setq fname - (mapconcat - (function - (lambda (x) - (cond - ((and (= ?/ x) slash) - (setq slash nil) - "%2F") - ((= ?/ x) - (setq slash t) - "/") - (t - (setq slash nil) - (char-to-string x))))) fname "")))) - - (setq fname (and fname - (mapconcat - (function (lambda (x) - (if (= x ?~) "" (char-to-string x)))) - fname "")) - fname (cond - ((null fname) nil) - ((or (string= "" fname) (string= "/" fname)) - url-directory-index-file) - ((= (string-to-char fname) ?/) - (if (string= (substring fname -1 nil) "/") - (concat fname url-directory-index-file) - (substring fname 1 nil))) - (t - (if (string= (substring fname -1 nil) "/") - (concat fname url-directory-index-file) - fname)))) - (and fname - (expand-file-name fname - (expand-file-name - (mapconcat 'identity host-components "/") - url-cache-directory)))))) - -(defun url-cache-create-filename-using-md5 (url) - "Create a cached filename using MD5. - Very fast if you are in XEmacs, suitably fast otherwise." - (if url - (let* ((checksum (md5 url)) - (url (if (vectorp url) (url-recreate-url url) url)) - (urlobj (url-generic-parse-url url)) - (protocol (url-type urlobj)) - (hostname (url-host urlobj)) - (host-components - (cons - (user-real-login-name) - (cons (or protocol "file") - (nreverse - (delq nil - (split-string (or hostname "localhost") - (eval-when-compile - (regexp-quote ".")))))))) - (fname (url-filename urlobj))) - (and fname - (expand-file-name checksum - (expand-file-name - (mapconcat 'identity host-components "/") - url-cache-directory)))))) - -(defcustom url-cache-creation-function 'url-cache-create-filename-using-md5 - "*What function to use to create a cached filename." - :type '(choice (const :tag "MD5 of filename (low collision rate)" - :value url-cache-create-filename-using-md5) - (const :tag "Human readable filenames (higher collision rate)" - :value url-cache-create-filename-human-readable) - (function :tag "Other")) - :group 'url-cache) - -(defun url-cache-create-filename (url) - (funcall url-cache-creation-function url)) - -;;;###autoload -(defun url-cache-extract (fnam) - "Extract FNAM from the local disk cache" - (set-buffer (get-buffer-create url-working-buffer)) - (erase-buffer) - (setq url-current-mime-viewer nil) - (insert-file-contents-literally fnam) - (load (concat (if (memq system-type '(ms-windows ms-dos os2)) - (url-file-extension fnam t) - fnam) ".hdr") t t)) - -;;;###autoload -(defun url-cache-expired (url mod) - "Return t iff a cached file has expired." - (let* ((urlobj (if (vectorp url) url (url-generic-parse-url url))) - (type (url-type urlobj))) - (cond - (url-standalone-mode - (not (file-exists-p (url-cache-create-filename url)))) - ((string= type "http") - t) - ((member type '("file" "ftp")) - (if (or (equal mod '(0 0)) (not mod)) - (return t) - (or (> (nth 0 mod) (nth 0 (current-time))) - (> (nth 1 mod) (nth 1 (current-time)))))) - (t nil)))) - -(provide 'url-cache) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url-cookie.el --- a/lisp/w3/url-cookie.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,387 +0,0 @@ -;;; url-cookie.el --- Netscape Cookie support -;; Author: wmperry -;; Created: 1997/05/09 05:05:21 -;; Version: 1.17 -;; Keywords: comm, data, processes, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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 'timezone) -(require 'cl) - -(eval-and-compile - (let ((keywords - '(:name :value :expires :path :domain :test :secure))) - (while keywords - (or (boundp (car keywords)) - (set (car keywords) (car keywords))) - (setq keywords (cdr keywords))))) - -;; See http://home.netscape.com/newsref/std/cookie_spec.html for the -;; 'open standard' defining this crap. -;; -;; A cookie is stored internally as a vector of 7 slots -;; [ 'cookie name value expires path domain secure ] - -(defsubst url-cookie-name (cookie) (aref cookie 1)) -(defsubst url-cookie-value (cookie) (aref cookie 2)) -(defsubst url-cookie-expires (cookie) (aref cookie 3)) -(defsubst url-cookie-path (cookie) (aref cookie 4)) -(defsubst url-cookie-domain (cookie) (aref cookie 5)) -(defsubst url-cookie-secure (cookie) (aref cookie 6)) - -(defsubst url-cookie-set-name (cookie val) (aset cookie 1 val)) -(defsubst url-cookie-set-value (cookie val) (aset cookie 2 val)) -(defsubst url-cookie-set-expires (cookie val) (aset cookie 3 val)) -(defsubst url-cookie-set-path (cookie val) (aset cookie 4 val)) -(defsubst url-cookie-set-domain (cookie val) (aset cookie 5 val)) -(defsubst url-cookie-set-secure (cookie val) (aset cookie 6 val)) -(defsubst url-cookie-retrieve-arg (key args) (nth 1 (memq key args))) - -(defsubst url-cookie-create (&rest args) - (let ((retval (make-vector 7 nil))) - (aset retval 0 'cookie) - (url-cookie-set-name retval (url-cookie-retrieve-arg :name args)) - (url-cookie-set-value retval (url-cookie-retrieve-arg :value args)) - (url-cookie-set-expires retval (url-cookie-retrieve-arg :expires args)) - (url-cookie-set-path retval (url-cookie-retrieve-arg :path args)) - (url-cookie-set-domain retval (url-cookie-retrieve-arg :domain args)) - (url-cookie-set-secure retval (url-cookie-retrieve-arg :secure args)) - retval)) - -(defun url-cookie-p (obj) - (and (vectorp obj) (= (length obj) 7) (eq (aref obj 0) 'cookie))) - -(defun url-cookie-parse-file (&optional fname) - (setq fname (or fname url-cookie-file)) - (condition-case () - (load fname nil t) - (error (message "Could not load cookie file %s" fname)))) - -(defun url-cookie-clean-up (&optional secure) - (let* ( - (var (if secure 'url-cookie-secure-storage 'url-cookie-storage)) - (val (symbol-value var)) - (cur nil) - (new nil) - (cookies nil) - (cur-cookie nil) - (new-cookies nil) - ) - (while val - (setq cur (car val) - val (cdr val) - new-cookies nil - cookies (cdr cur)) - (while cookies - (setq cur-cookie (car cookies) - cookies (cdr cookies)) - (if (or (not (url-cookie-p cur-cookie)) - (url-cookie-expired-p cur-cookie) - (null (url-cookie-expires cur-cookie))) - nil - (setq new-cookies (cons cur-cookie new-cookies)))) - (if (not new-cookies) - nil - (setcdr cur new-cookies) - (setq new (cons cur new)))) - (set var new))) - -;;###autoload -(defun url-cookie-write-file (&optional fname) - (setq fname (or fname url-cookie-file)) - (url-cookie-clean-up) - (url-cookie-clean-up t) - (save-excursion - (set-buffer (get-buffer-create " *cookies*")) - (erase-buffer) - (fundamental-mode) - (insert ";; Emacs-W3 HTTP cookies file\n" - ";; Automatically generated file!!! DO NOT EDIT!!!\n\n" - "(setq url-cookie-storage\n '") - (pp url-cookie-storage (current-buffer)) - (insert ")\n(setq url-cookie-secure-storage\n '") - (pp url-cookie-secure-storage (current-buffer)) - (insert ")\n") - (write-file fname) - (kill-buffer (current-buffer)))) - -(defun url-cookie-store (name value &optional expires domain path secure) - "Stores a netscape-style cookie" - (let* ((storage (if secure url-cookie-secure-storage url-cookie-storage)) - (tmp storage) - (cur nil) - (found-domain nil)) - - ;; First, look for a matching domain - (setq found-domain (assoc domain storage)) - - (if found-domain - ;; Need to either stick the new cookie in existing domain storage - ;; or possibly replace an existing cookie if the names match. - (progn - (setq storage (cdr found-domain) - tmp nil) - (while storage - (setq cur (car storage) - storage (cdr storage)) - (if (and (equal path (url-cookie-path cur)) - (equal name (url-cookie-name cur))) - (progn - (url-cookie-set-expires cur expires) - (url-cookie-set-value cur value) - (setq tmp t)))) - (if (not tmp) - ;; New cookie - (setcdr found-domain (cons - (url-cookie-create :name name - :value value - :expires expires - :domain domain - :path path - :secure secure) - (cdr found-domain))))) - ;; Need to add a new top-level domain - (setq tmp (url-cookie-create :name name - :value value - :expires expires - :domain domain - :path path - :secure secure)) - (cond - (storage - (setcdr storage (cons (list domain tmp) (cdr storage)))) - (secure - (setq url-cookie-secure-storage (list (list domain tmp)))) - (t - (setq url-cookie-storage (list (list domain tmp)))))))) - -(defun url-cookie-expired-p (cookie) - (let* ( - (exp (url-cookie-expires cookie)) - (cur-date (and exp (timezone-parse-date (current-time-string)))) - (exp-date (and exp (timezone-parse-date exp))) - (cur-greg (and cur-date (timezone-absolute-from-gregorian - (string-to-int (aref cur-date 1)) - (string-to-int (aref cur-date 2)) - (string-to-int (aref cur-date 0))))) - (exp-greg (and exp (timezone-absolute-from-gregorian - (string-to-int (aref exp-date 1)) - (string-to-int (aref exp-date 2)) - (string-to-int (aref exp-date 0))))) - (diff-in-days (and exp (- cur-greg exp-greg))) - ) - (cond - ((not exp) nil) ; No expiry == expires at browser quit - ((< diff-in-days 0) nil) ; Expires sometime after today - ((> diff-in-days 0) t) ; Expired before today - (t ; Expires sometime today, check times - (let* ((cur-time (timezone-parse-time (aref cur-date 3))) - (exp-time (timezone-parse-time (aref exp-date 3))) - (cur-norm (+ (* 360 (string-to-int (aref cur-time 2))) - (* 60 (string-to-int (aref cur-time 1))) - (* 1 (string-to-int (aref cur-time 0))))) - (exp-norm (+ (* 360 (string-to-int (aref exp-time 2))) - (* 60 (string-to-int (aref exp-time 1))) - (* 1 (string-to-int (aref exp-time 0)))))) - (> (- cur-norm exp-norm) 1)))))) - -;;###autoload -(defun url-cookie-retrieve (host path &optional secure) - "Retrieves all the netscape-style cookies for a specified HOST and PATH" - (let ((storage (if secure - (append url-cookie-secure-storage url-cookie-storage) - url-cookie-storage)) - (case-fold-search t) - (cookies nil) - (cur nil) - (retval nil) - (path-regexp nil)) - (while storage - (setq cur (car storage) - storage (cdr storage) - cookies (cdr cur)) - (if (and (car cur) - (string-match (concat "^.*" (regexp-quote (car cur)) "$") host)) - ;; The domains match - a possible hit! - (while cookies - (setq cur (car cookies) - cookies (cdr cookies) - path-regexp (concat "^" (regexp-quote - (url-cookie-path cur)))) - (if (and (string-match path-regexp path) - (not (url-cookie-expired-p cur))) - (setq retval (cons cur retval)))))) - retval)) - -;;###autolaod -(defun url-cookie-generate-header-lines (host path secure) - (let* ((cookies (url-cookie-retrieve host path secure)) - (retval nil) - (cur nil) - (chunk nil)) - ;; Have to sort this for sending most specific cookies first - (setq cookies (and cookies - (sort cookies - (function - (lambda (x y) - (> (length (url-cookie-path x)) - (length (url-cookie-path y)))))))) - (while cookies - (setq cur (car cookies) - cookies (cdr cookies) - chunk (format "%s=%s" (url-cookie-name cur) (url-cookie-value cur)) - retval (if (< 80 (+ (length retval) (length chunk) 4)) - (concat retval "\r\nCookie: " chunk) - (if retval - (concat retval "; " chunk) - (concat "Cookie: " chunk))))) - (if retval - (concat retval "\r\n") - ""))) - -(defvar url-cookie-two-dot-domains - (concat "\\.\\(" - (mapconcat 'identity (list "com" "edu" "net" "org" "gov" "mil" "int") - "\\|") - "\\)$") - "A regular expression of top-level domains that only require two matching -'.'s in the domain name in order to set a cookie.") - -(defcustom url-cookie-trusted-urls nil - "*A list of regular expressions matching URLs to always accept cookies from." - :type '(repeat regexp) - :group 'url-cookie) - -(defcustom url-cookie-untrusted-urls nil - "*A list of regular expressions matching URLs to never accept cookies from." - :type '(repeat regexp) - :group 'url-cookie) - -(defun url-cookie-host-can-set-p (host domain) - (let ((numdots 0) - (tmp domain) - (last nil) - (case-fold-search t) - (mindots 3)) - (while (setq last (string-match "\\." host last)) - (setq numdots (1+ numdots) - last (1+ last))) - (if (string-match url-cookie-two-dot-domains domain) - (setq mindots 2)) - (cond - ((string= host domain) ; Apparently netscape lets you do this - t) - ((< numdots mindots) ; Not enough dots in domain name! - nil) - (t - (string-match (concat (regexp-quote domain) "$") host))))) - -(defun url-header-comparison (x y) - (string= (downcase x) (downcase y))) - -;;###autoload -(defun url-cookie-handle-set-cookie (str) - (let* ((args (mm-parse-args str nil t)) ; Don't downcase names - (case-fold-search t) - (secure (and (assoc* "secure" args :test 'url-header-comparison) t)) - (domain (or (cdr-safe (assoc* "domain" args :test - 'url-header-comparison)) - (url-host url-current-object))) - (current-url (url-view-url t)) - (trusted url-cookie-trusted-urls) - (untrusted url-cookie-untrusted-urls) - (expires (cdr-safe (assoc* "expires" args :test - 'url-header-comparison))) - (path (or (cdr-safe (assoc* "path" args :test - 'url-header-comparison)) - (file-name-directory - (url-filename url-current-object)))) - (rest nil)) - (while args - (if (not (member (downcase (car (car args))) - '("secure" "domain" "expires" "path"))) - (setq rest (cons (car args) rest))) - (setq args (cdr args))) - - ;; Sometimes we get dates that the timezone package cannot handle very - ;; gracefully - take care of this here, instead of in url-cookie-expired-p - ;; to speed things up. - (if (and expires - (string-match - (concat "^[^,]+, +\\(..\\)-\\(...\\)-\\(..\\) +" - "\\(..:..:..\\) +\\[*\\([^\]]+\\)\\]*$") - expires)) - (setq expires (concat (url-match expires 1) " " - (url-match expires 2) " " - (url-match expires 3) " " - (url-match expires 4) " [" - (url-match expires 5) "]"))) - (while (consp trusted) - (if (string-match (car trusted) current-url) - (setq trusted (- (match-end 0) (match-beginning 0))) - (pop trusted))) - (while (consp untrusted) - (if (string-match (car untrusted) current-url) - (setq untrusted (- (match-end 0) (match-beginning 0))) - (pop untrusted))) - (if (and trusted untrusted) - ;; Choose the more specific match - (if (> trusted untrusted) - (setq untrusted nil) - (setq trusted nil))) - (cond - (untrusted - ;; The site was explicity marked as untrusted by the user - nil) - ((and (listp url-privacy-level) (memq 'cookies url-privacy-level)) - ;; user never wants cookies - nil) - ((and url-cookie-confirmation - (not trusted) - (save-window-excursion - (with-output-to-temp-buffer "*Cookie Warning*" - (mapcar - (function - (lambda (x) - (princ (format "%s - %s" (car x) (cdr x))))) rest)) - (prog1 - (not (funcall url-confirmation-func - (format "Allow %s to set these cookies? " - (url-host url-current-object)))) - (if (get-buffer "*Cookie Warning*") - (kill-buffer "*Cookie Warning*"))))) - ;; user wants to be asked, and declined. - nil) - ((url-cookie-host-can-set-p (url-host url-current-object) domain) - ;; Cookie is accepted by the user, and passes our security checks - (let ((cur nil)) - (while rest - (setq cur (pop rest)) - (url-cookie-store (car cur) (cdr cur) - expires domain path secure)))) - (t - (message "%s tried to set a cookie for domain %s - rejected." - (url-host url-current-object) domain))))) - -(provide 'url-cookie) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url-file.el --- a/lisp/w3/url-file.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,258 +0,0 @@ -;;; url-file.el --- File retrieval code -;; Author: wmperry -;; Created: 1997/06/24 22:38:39 -;; Version: 1.21 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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 'url-vars) -(require 'mule-sysdp) -(require 'url-parse) - -(defun url-insert-possibly-compressed-file (fname &rest args) - ;; Insert a file into a buffer, checking for compressed versions. - (let ((compressed nil) - ;; - ;; F*** *U** **C* ***K!!! - ;; We cannot just use insert-file-contents-literally here, because - ;; then we would lose big time with ange-ftp. *sigh* - (crypt-encoding-alist nil) - (jka-compr-compression-info-list nil) - (jam-zcat-filename-list nil) - (file-coding-system-for-read mule-no-coding-system) - (coding-system-for-read mule-no-coding-system)) - (setq compressed - (cond - ((file-exists-p fname) - (if (string-match "\\.\\(z\\|gz\\|Z\\)$" fname) - (case (intern (match-string 1 fname)) - ((z gz) - (setq url-current-mime-headers (cons - (cons - "content-transfer-encoding" - "gzip") - url-current-mime-headers))) - (Z - (setq url-current-mime-headers (cons - (cons - "content-transfer-encoding" - "compress") - url-current-mime-headers)))) - nil)) - ((file-exists-p (concat fname ".Z")) - (setq fname (concat fname ".Z") - url-current-mime-headers (cons (cons - "content-transfer-encoding" - "compress") - url-current-mime-headers))) - ((file-exists-p (concat fname ".gz")) - (setq fname (concat fname ".gz") - url-current-mime-headers (cons (cons - "content-transfer-encoding" - "gzip") - url-current-mime-headers))) - ((file-exists-p (concat fname ".z")) - (setq fname (concat fname ".z") - url-current-mime-headers (cons (cons - "content-transfer-encoding" - "gzip") - url-current-mime-headers))) - (t - (error "File not found %s" fname)))) - (apply 'insert-file-contents fname args) - (set-buffer-modified-p nil))) - -(defvar url-dired-minor-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-m" 'url-dired-find-file) - (if url-running-xemacs - (define-key map [button2] 'url-dired-find-file-mouse) - (define-key map [mouse-2] 'url-dired-find-file-mouse)) - map) - "Keymap used when browsing directories.") - -(defvar url-dired-minor-mode nil - "Whether we are in url-dired-minor-mode") - -(make-variable-buffer-local 'url-dired-minor-mode) - -(defun url-dired-find-file () - "In dired, visit the file or directory named on this line, using Emacs-W3." - (interactive) - (w3-open-local (dired-get-filename))) - -(defun url-dired-find-file-mouse (event) - "In dired, visit the file or directory name you click on, using Emacs-W3." - (interactive "@e") - (if (event-point event) - (progn - (goto-char (event-point event)) - (url-dired-find-file)))) - -(defun url-dired-minor-mode (&optional arg) - "Minor mode for directory browsing with Emacs-W3." - (interactive "P") - (cond - ((null arg) - (setq url-dired-minor-mode (not url-dired-minor-mode))) - ((equal 0 arg) - (setq url-dired-minor-mode nil)) - (t - (setq url-dired-minor-mode t)))) - -(add-minor-mode 'url-dired-minor-mode " URL" url-dired-minor-mode-map) - -(defun url-format-directory (dir) - ;; Format the files in DIR into hypertext - (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." - (let ((case-fold-search t)) - (or - (null host) - (string= "" host) - (equal (downcase host) (downcase (system-name))) - (and (string-match "^localhost$" host) t) - (and (not (string-match (regexp-quote ".") host)) - (equal (downcase host) (if (string-match (regexp-quote ".") - (system-name)) - (substring (system-name) 0 - (match-beginning 0)) - (system-name))))))) - -(defun url-file-build-continuation (name) - (list 'url-file-asynch-callback - name (current-buffer) - url-current-callback-func url-current-callback-data)) - -(defun url-file-asynch-callback (x y name buff func args &optional efs) - (if (featurep 'efs) - ;; EFS passes us an extra argument - (setq name buff - buff func - func args - args efs)) - (cond - ((not name) nil) - ((not (file-exists-p name)) nil) - (t - (if (not buff) - (setq buff (generate-new-buffer " *url-asynch-file*"))) - (set-buffer buff) - (insert-file-contents-literally name) - (condition-case () - (delete-file name) - (error nil)))) - (if func - (apply func args) - (url-sentinel (current-buffer) nil))) - -(defun url-file (url) - ;; Find a file - (let* ((urlobj (url-generic-parse-url url)) - (user (url-user urlobj)) - (pass (url-password urlobj)) - (site (url-host urlobj)) - (file (url-unhex-string (url-filename urlobj))) - (dest (url-target urlobj)) - (filename (if (or user (not (url-host-is-local-p site))) - (concat "/" (or user "anonymous") "@" site ":" 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 - ((featurep 'ange-ftp) - (ange-ftp-set-passwd site user pass)) - ((or (featurep 'efs) (featurep 'efs-auto)) - (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)) - (setq filename (concat filename "/"))) - (if (not (string-match "/$" file)) - (setq file (concat file "/"))) - (url-set-filename urlobj file) - (url-format-directory filename)) - (url-be-asynchronous - (cond - ((file-exists-p filename) nil) - ((file-exists-p (concat filename ".Z")) - (setq filename (concat filename ".Z"))) - ((file-exists-p (concat filename ".gz")) - (setq filename (concat filename ".gz"))) - ((file-exists-p (concat filename ".z")) - (setq filename (concat filename ".z"))) - (t nil)) - (let ((new (mm-generate-unique-filename))) - (cond - ((url-host-is-local-p site) - (insert-file-contents-literally filename) - (if (featurep 'efs) - (url-file-asynch-callback nil nil nil nil nil - url-current-callback-func - url-current-callback-data) - (url-file-asynch-callback nil nil nil nil - url-current-callback-func - url-current-callback-data))) - ((featurep 'ange-ftp) - (ange-ftp-copy-file-internal filename (expand-file-name new) t - nil t - (url-file-build-continuation new) - t)) - ((or (featurep 'efs) (featurep 'efs-auto)) - (efs-copy-file-internal filename (efs-ftp-path filename) - new (efs-ftp-path new) - t nil 0 - (url-file-build-continuation new) - 0 nil))))) - (t - (let ((errobj nil)) - (if (or url-source ; Need it in a buffer - (and (symbolp viewer) - (not (eq viewer 'w3-default-local-file))) - (stringp viewer)) - (condition-case errobj - (url-insert-possibly-compressed-file filename t) - (error - (url-save-error errobj) - (url-retrieve (concat "www://error/nofile/" file)))))))))) - -(fset 'url-ftp 'url-file) - -(provide 'url-file) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url-gopher.el --- a/lisp/w3/url-gopher.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,469 +0,0 @@ -;;; url-gopher.el --- Gopher Uniform Resource Locator retrieval code -;; Author: wmperry -;; Created: 1997/04/07 13:24:21 -;; Version: 1.8 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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 'url-vars) -(require 'url-parse) - -(defun url-grok-gopher-href (url) - "Return a list of attributes from a gopher url. List is of the -type: host port selector-string MIME-type extra-info" - (let (host ; host name - port ; Port # - selector ; String to send to gopher host - type ; MIME type - extra ; Extra information - x ; Temporary storage for host/port - y ; Temporary storage for selector - ylen - ) - (or (string-match "gopher:/*\\([^/]+\\)\\(/*\\)" url) - (error "Can't understand url %s" url)) - (setq x (url-match url 1) ; The host (and possible port #) - ylen (- (length url) (match-end 2)) - y (if (= ylen 0) ; The selector (and possible type) - "" - (url-unhex-string (substring url (- ylen))))) - - ;First take care of the host/port/gopher+ information from the url - ;A + after the port # (host:70+) specifies a gopher+ link - ;A ? after the port # (host:70?) specifies a gopher+ ask block - (if (string-match "^\\([^:]+\\):\\([0-9]+\\)\\([?+]*\\)" x) - (setq host (url-match x 1) - port (url-match x 2) - extra (url-match x 3)) - (setq host x - port "70" - extra nil)) - (cond - ((equal extra "") (setq extra nil)) - ((equal extra "?") (setq extra 'ask-block)) - ((equal extra "+") (setq extra 'gopher+))) - - ; Next, get the type/get rid of the Mosaic double-typing. Argh. - (setq x (string-to-char y) ; Get gopher type - selector (if (or url-use-hypertext-gopher - (< 3 (length y))) - y ; Get the selector string - (substring y 1 nil)) - type (cdr (assoc x url-gopher-to-mime))) - (list host port (or selector "") type extra))) - - -(defun url-convert-ask-to-form (ask) - ;; Convert a Gopher+ ASK block into a form. Returns a string to be - ;; inserted into a buffer to create the form." - (let ((form (concat "<form enctype=application/gopher-ask-block\n" - " method=\"GOPHER-ASK\">\n" - " <ul plain>\n")) - (type "") - (x 0) - (parms "")) - (while (string-match "^\\([^:]+\\): +\\(.*\\)" ask) - (setq parms (url-match ask 2) - type (url-strip-leading-spaces (downcase (url-match ask 1))) - x (1+ x) - ask (substring ask (if (= (length ask) (match-end 0)) - (match-end 0) (1+ (match-end 0))) nil)) - (cond - ((string= "note" type) (setq form (concat form parms))) - ((or (string= "ask" type) - (string= "askf" type) - (string= "choosef" type)) - (setq parms (url-string-to-tokens parms ?\t) - form (format "%s\n<li>%s<input name=\"%d\" value=\"%s\">" - form (or (nth 0 parms) "Text:") - x (or (nth 1 parms) "")))) - ((string= "askp" type) - (setq parms (mapcar 'car (nreverse (url-split parms "\t"))) - form (format - "%s\n<li>%s<input name=\"%d\" type=\"password\" value=\"%s\">" - form ; Earlier string - (or (nth 0 parms) "Password:") ; Prompt - x ; Name - (or (nth 1 parms) "") ; Default value - ))) - ((string= "askl" type) - (setq parms (url-string-to-tokens parms ?\t) - form (format "%s\n<li>%s<textarea name=\"%d\">%s</textarea>" - form ; Earlier string - (or (nth 0 parms) "") ; Prompt string - x ; Name - (or (nth 1 parms) "") ; Default value - ))) - ((or (string= "select" type) - (string= "choose" type)) - (setq parms (url-string-to-tokens parms ?\t) - form (format "%s\n<li>%s<select name=\"%d\">" form (car parms) x) - parms (cdr parms)) - (if (null parms) (setq parms (list "Yes" "No"))) - (while parms - (setq form (concat form "<option>" (car parms) "\n") - parms (cdr parms))) - (setq form (concat form "</select>"))))) - (concat form "\n<li><input type=\"SUBMIT\"" - " value=\"Submit Gopher+ Ask Block\"></ul></form>"))) - -(defun url-grok-gopher-line () - "Return a list of link attributes from a gopher string. Order is: -title, type, selector string, server, port, gopher-plus?" - (let (type selector server port gopher+ st nd) - (beginning-of-line) - (setq st (point)) - (end-of-line) - (setq nd (point)) - (save-excursion - (mapcar (function - (lambda (var) - (goto-char st) - (skip-chars-forward "^\t\n" nd) - (set-variable var (buffer-substring st (point))) - (setq st (min (point-max) (1+ (point)))))) - '(type selector server port)) - (setq gopher+ (and (/= (1- st) nd) (buffer-substring st nd))) - (list type (concat (substring type 0 1) selector) server port gopher+)))) - -(defun url-format-gopher-link (gophobj) - ;; Insert a gopher link as an <A> tag - (let ((title (nth 0 gophobj)) - (ref (nth 1 gophobj)) - (type (if (> (length (nth 0 gophobj)) 0) - (substring (nth 0 gophobj) 0 1) "")) - (serv (nth 2 gophobj)) - (port (nth 3 gophobj)) - (plus (nth 4 gophobj)) - (desc nil)) - (if (and (equal type "") - (> (length title) 0)) - (setq type (substring title 0 1))) - (setq title (and title (substring title 1 nil)) - title (mapconcat - (function - (lambda (x) - (cond - ((= x ?&) "&amp;") - ((= x ?<) "&lt;"); - ((= x ?>) "&gt;"); - (t (char-to-string x))))) title "") - desc (or (cdr (assoc type url-gopher-labels)) "(UNK)")) - (cond - ((null ref) "") - ((equal type "8") - (format "<LI> %s <A HREF=\"telnet://%s:%s/\">%s</A>\n" - desc serv port title)) - ((equal type "T") - (format "<LI> %s <A HREF=\"tn3270://%s:%s/\">%s</A>\n" - desc serv port title)) - (t (format "<LI> %s <A METHODS=%s HREF=\"gopher://%s:%s/%s\">%s</A>\n" - desc type serv (concat port plus) - (url-hexify-string ref) title))))) - -(defun url-gopher-clean-text (&optional buffer) - "Decode text transmitted by gopher. -0. Delete status line. -1. Delete `^M' at end of line. -2. Delete `.' at end of buffer (end of text mark). -3. Delete `.' at beginning of line. (does gopher want this?)" - (set-buffer (or buffer url-working-buffer)) - ;; Insert newline at end of buffer. - (goto-char (point-max)) - (if (not (bolp)) - (insert "\n")) - ;; Delete `^M' at end of line. - (goto-char (point-min)) - (while (re-search-forward "\r[^\n]*$" nil t) - (replace-match "")) -; (goto-char (point-min)) -; (while (not (eobp)) -; (end-of-line) -; (if (= (preceding-char) ?\r) -; (delete-char -1)) -; (forward-line 1) -; ) - ;; Delete `.' at end of buffer (end of text mark). - (goto-char (point-max)) - (forward-line -1) ;(beginning-of-line) - (while (looking-at "^\\.$") - (delete-region (point) (progn (forward-line 1) (point))) - (forward-line -1)) - ;; Replace `..' at beginning of line with `.'. - (goto-char (point-min)) - ;; (replace-regexp "^\\.\\." ".") - (while (search-forward "\n.." nil t) - (delete-char -1)) - ) - -(defun url-parse-gopher (&optional buffer) - (save-excursion - (set-buffer (or buffer url-working-buffer)) - (url-replace-regexp "^\r*$\n" "") - (url-replace-regexp "^\\.\r*$\n" "") - (url-gopher-clean-text (current-buffer)) - (goto-char (point-max)) - (skip-chars-backward "\n\r\t ") - (delete-region (point-max) (point)) - (insert "\n") - (goto-char (point-min)) - (skip-chars-forward " \t\n") - (delete-region (point-min) (point)) - (let* ((len (count-lines (point-min) (point-max))) - (objs nil) - (i 0)) - (while (not (eobp)) - (setq objs (cons (url-grok-gopher-line) objs) - i (1+ i)) - (url-lazy-message "Converting gopher listing... %d/%d (%d%%)" - i len (url-percentage i len)) - - (forward-line 1)) - (setq objs (nreverse objs)) - (erase-buffer) - (insert "<title>" - (cond - ((or (string= "" (url-filename url-current-object)) - (string= "1/" (url-filename url-current-object)) - (string= "1" (url-filename url-current-object))) - (concat "Gopher root at " (url-host url-current-object))) - ((string-match (format "^[%s]+/" url-gopher-types) - (url-filename url-current-object)) - (substring (url-filename url-current-object) 2 nil)) - (t (url-filename url-current-object))) - "</title><ol>" - (mapconcat 'url-format-gopher-link objs "") - "</ol>")))) - -(defun url-gopher-retrieve (host port selector &optional wait-for) - ;; Fetch a gopher object and don't mess with it at all - (let ((proc (url-open-stream "*gopher*" url-working-buffer - host (if (stringp port) (string-to-int port) - port))) - (len nil) - (parsed nil)) - (url-clear-tmp-buffer) - (if (> (length selector) 0) - (setq selector (substring selector 1 nil))) - (if (not (processp proc)) - nil - (save-excursion - (set-process-sentinel proc 'ignore) - (process-send-string proc (concat selector "\r\n")) - (while (and (or (not wait-for) - (progn - (goto-char (point-min)) - (not (re-search-forward wait-for nil t)))) - (memq (url-process-status proc) '(run open))) - (if (not parsed) - (cond - ((and (eq ?+ (char-after 1)) - (memq (char-after 2) - (list ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))) - (setq parsed (copy-marker 2) - len (read parsed)) - (delete-region (point-min) parsed)) - ((and (eq ?+ (char-after 1)) - (eq ?- (char-after 2))) - (setq len nil - parsed t) - (goto-char (point-min)) - (delete-region (point-min) (progn - (end-of-line) - (point)))) - ((and (eq ?- (char-after 1)) - (eq ?- (char-after 2))) - (setq parsed t - len nil) - (goto-char (point-min)) - (delete-region (point-min) (progn - (end-of-line) - (point)))))) - (if len (url-lazy-message "Reading... %d of %d bytes (%d%%)" - (point-max) - len - (url-percentage (point-max) len)) - (url-lazy-message "Read... %d bytes." (point-max))) - (url-accept-process-output proc)) - (condition-case () - (url-kill-process proc) - (error nil)) - (while (looking-at "\r") (delete-char 1)))))) - -(defun url-do-gopher-cso-search (descr) - ;; Do a gopher CSO search and return a plaintext document - (let ((host (nth 0 descr)) - (port (nth 1 descr)) - (file (nth 2 descr)) - search-type search-term) - (string-match "search-by=\\([^&]+\\)" file) - (setq search-type (url-match file 1)) - (string-match "search-term=\\([^&]+\\)" file) - (setq search-term (url-match file 1)) - (url-gopher-retrieve host port (format "2query %s=%s" - search-type search-term) "^[2-9]") - (goto-char (point-min)) - (url-replace-regexp "^-[0-9][0-9][0-9]:[0-9]*:" "") - (url-replace-regexp "^[^15][0-9][0-9]:.*" "") - (url-replace-regexp "^[15][0-9][0-9]:\\(.*\\)" "<H1>\\1</H1>&ensp;<PRE>") - (goto-char (point-min)) - (insert "<title>Results of CSO search</title>\n" - "<h1>" search-type " = " search-term "</h1>\n") - (goto-char (point-max)) - (insert "</pre>"))) - -(defun url-do-gopher (descr) - ;; Fetch a gopher object - (let ((host (nth 0 descr)) - (port (nth 1 descr)) - (file (nth 2 descr)) - (type (nth 3 descr)) - (extr (nth 4 descr)) - parse-gopher) - (cond - ((and ; Gopher CSO search - (equal type "www/gopher-cso-search") - (string-match "search-by=" file)) ; With a search term in it - (url-do-gopher-cso-search descr) - (setq type "text/html")) - ((equal type "www/gopher-cso-search") ; Blank CSO search - (url-clear-tmp-buffer) - (insert "<html>\n" - " <head>\n" - " <title>CSO Search</title>\n" - " </head>\n" - " <body>\n" - " <div>\n" - " <h1>This is a CSO search</h1>\n" - " <hr>\n" - " <form>\n" - " <ul>\n" - " <li> Search by: <select name=\"search-by\">\n" - " <option>Name\n" - " <option>Phone\n" - " <option>Email\n" - " <option>Address\n" - " </select>\n" - " <li> Search for: <input name=\"search-term\">\n" - " <li> <input type=\"submit\" value=\"Submit query\">\n" - " </ul>\n" - " </form>\n" - " </div>\n" - " </body>\n" - "</html>\n" - "<!-- Automatically generated by URL v" url-version " -->\n") - (setq type "text/html" - parse-gopher t)) - ((and - (equal type "www/gopher-search") ; Ack! Mosaic-style search href - (string-match "\t" file)) ; and its got a search term in it! - (url-gopher-retrieve host port file) - (setq type "www/gopher" - parse-gopher t)) - ((and - (equal type "www/gopher-search") ; Ack! Mosaic-style search href - (string-match "\\?" file)) ; and its got a search term in it! - (setq file (concat (substring file 0 (match-beginning 0)) "\t" - (substring file (match-end 0) nil))) - (url-gopher-retrieve host port file) - (setq type "www/gopher" - parse-gopher t)) - ((equal type "www/gopher-search") ; Ack! Mosaic-style search href - (setq type "text/html" - parse-gopher t) - (url-clear-tmp-buffer) - (insert "<html>\n" - " <head>\n" - " <title>Gopher Server</title>\n" - " </head>\n" - " <body>\n" - " <div>\n" - " <h1>Searchable Gopher Index</h1>\n" - " <hr>\n" - " <p>\n" - " Enter the search keywords below\n" - " </p>" - " <form enctype=\"application/x-gopher-query\">\n" - " <input name=\"internal-gopher\">\n" - " </form>\n" - " <hr>\n" - " </div>\n" - " </body>\n" - "</html>\n" - "<!-- Automatically generated by URL v" url-version " -->\n")) - ((null extr) ; Normal Gopher link - (url-gopher-retrieve host port file) - (setq parse-gopher t)) - ((eq extr 'gopher+) ; A gopher+ link - (url-gopher-retrieve host port (concat file "\t+")) - (setq parse-gopher t)) - ((eq extr 'ask-block) ; A gopher+ interactive query - (url-gopher-retrieve host port (concat file "\t!")) ; Fetch the info - (goto-char (point-min)) - (cond - ((re-search-forward "^\\+ASK:[ \t\r]*" nil t) ; There is an ASK - (let ((x (buffer-substring (1+ (point)) - (or (re-search-forward "^\\+[^:]+:" nil t) - (point-max))))) - (erase-buffer) - (insert (url-convert-ask-to-form x)) - (setq type "text/html" parse-gopher t))) - (t (setq parse-gopher t))))) - (if (or (equal type "www/gopher") - (equal type "text/plain") - (equal file "") - (equal type "text/html")) - (url-gopher-clean-text)) - (if (and parse-gopher (or (equal type "www/gopher") - (equal file ""))) - (progn - (url-parse-gopher) - (setq type "text/html" - url-current-mime-viewer (mm-mime-info type nil 5)))) - (setq url-current-mime-type (or type "text/plain") - url-current-mime-viewer (mm-mime-info type nil 5)))) - -(defun url-gopher (url) - ;; Handle gopher URLs - (let ((descr (url-grok-gopher-href url))) - (cond - ((or (not (member (nth 1 descr) url-bad-port-list)) - (funcall - url-confirmation-func - (format "Warning! Trying to connect to port %s - continue? " - (nth 1 descr)))) - (if url-use-hypertext-gopher - (url-do-gopher descr) - (gopher-dispatch-object (vector (if (= 0 (length (nth 2 descr))) - ?1 - (string-to-char (nth 2 descr))) - (nth 2 descr) (nth 2 descr) - (nth 0 descr) - (string-to-int (nth 1 descr))) - (current-buffer)))) - (t - (ding) - (url-warn 'security "Aborting connection to bad port..."))))) - -(provide 'url-gopher) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url-gw.el --- a/lisp/w3/url-gw.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,259 +0,0 @@ -;;; url-gw.el --- Gateway munging for URL loading -;; Author: wmperry -;; Created: 1997/04/11 14:39:18 -;; Version: 1.9 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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 'cl) - -(defgroup url-gateway nil - "URL gateway variables" - :group 'url) - -(defcustom url-gateway-local-host-regexp nil - "*A regular expression specifying local hostnames/machines." - :type '(choice (const nil) regexp) - :group 'url-gateway) - -(defcustom url-gateway-prompt-pattern - "^[^#$%>;]*[#$%>;] *" ;; "bash\\|\$ *\r?$\\|> *\r?" - "*A regular expression matching a shell prompt." - :type 'regexp - :group 'url-gateway) - -(defcustom url-gateway-rlogin-host nil - "*What hostname to actually rlog into before doing a telnet." - :type '(choice (const nil) string) - :group 'url-gateway) - -(defcustom url-gateway-rlogin-user-name nil - "*Username to log into the remote machine with when using rlogin." - :type '(choice (const nil) string) - :group 'url-gateway) - -(defcustom url-gateway-rlogin-parameters '("telnet" "-8") - "*Parameters to `url-open-rlogin'. -This list will be used as the parameter list given to rsh." - :type '(repeat string) - :group 'url-gateway) - -(defcustom url-gateway-telnet-host nil - "*What hostname to actually login to before doing a telnet." - :type '(choice (const nil) string) - :group 'url-gateway) - -(defcustom url-gateway-telnet-parameters '("exec" "telnet" "-8") - "*Parameters to `url-open-telnet'. -This list will be executed as a command after logging in via telnet." - :type '(repeat string) - :group 'url-gateway) - -(defcustom url-gateway-telnet-login-prompt "^\r*.?login:" - "*Prompt that tells us we should send our username when loggin in w/telnet." - :type 'regexp - :group 'url-gateway) - -(defcustom url-gateway-telnet-password-prompt "^\r*.?password:" - "*Prompt that tells us we should send our password when loggin in w/telnet." - :type 'regexp - :group 'url-gateway) - -(defcustom url-gateway-telnet-user-name nil - "User name to log in via telnet with." - :type '(choice (const nil) string) - :group 'url-gateway) - -(defcustom url-gateway-telnet-password nil - "Password to use to log in via telnet with." - :type '(choice (const nil) string) - :group 'url-gateway) - -(defcustom url-gateway-broken-resolution nil - "*Whether to use nslookup to resolve hostnames. -This should be used when your version of Emacs cannot correctly use DNS, -but your machine can. This usually happens if you are running a statically -linked Emacs under SunOS 4.x" - :type 'boolean - :group 'url-gateway) - -(defcustom url-gateway-nslookup-program "nslookup" - "*If non-NIL then a string naming nslookup program." - :type '(choice (const :tag "None" :value nil) string) - :group 'url-gateway) - -;; Stolen from ange-ftp -;;;###autoload -(defun url-gateway-nslookup-host (host) - "Attempt to resolve the given HOSTNAME using nslookup if possible." - (interactive "sHost: ") - (if url-gateway-nslookup-program - (let ((proc (start-process " *nslookup*" " *nslookup*" - url-gateway-nslookup-program host)) - (res host)) - (process-kill-without-query proc) - (save-excursion - (set-buffer (process-buffer proc)) - (while (memq (process-status proc) '(run open)) - (accept-process-output proc)) - (goto-char (point-min)) - (if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t) - (setq res (buffer-substring (match-beginning 1) - (match-end 1)))) - (kill-buffer (current-buffer))) - res) - host)) - -;; Stolen from red gnus nntp.el -(defun url-wait-for-string (regexp proc) - "Wait until string arrives in the buffer." - (let ((buf (current-buffer))) - (goto-char (point-min)) - (while (not (re-search-forward regexp nil t)) - (accept-process-output proc) - (set-buffer buf) - (goto-char (point-min))))) - -;; Stolen from red gnus nntp.el -(defun url-open-rlogin (name buffer host service) - "Open a connection using rsh." - (if (not (stringp service)) - (setq service (int-to-string service))) - (let ((proc (if url-gateway-rlogin-user-name - (start-process - name buffer "rsh" - url-gateway-rlogin-host "-l" url-gateway-rlogin-user-name - (mapconcat 'identity - (append url-gateway-rlogin-parameters - (list host service)) " ")) - (start-process - name buffer "rsh" url-gateway-rlogin-host - (mapconcat 'identity - (append url-gateway-rlogin-parameters - (list host service)) - " "))))) - (set-buffer buffer) - (url-wait-for-string "^\r*200" proc) - (beginning-of-line) - (delete-region (point-min) (point)) - proc)) - -;; Stolen from red gnus nntp.el -(defun url-open-telnet (name buffer host service) - (if (not (stringp service)) - (setq service (int-to-string service))) - (save-excursion - (set-buffer (get-buffer-create buffer)) - (erase-buffer) - (let ((proc (start-process name buffer "telnet" "-8")) - (case-fold-search t)) - (when (memq (process-status proc) '(open run)) - (process-send-string proc "set escape \^X\n") - (process-send-string proc (concat - "open " url-gateway-telnet-host "\n")) - (url-wait-for-string url-gateway-telnet-login-prompt proc) - (process-send-string - proc (concat - (or url-gateway-telnet-user-name - (setq url-gateway-telnet-user-name (read-string "login: "))) - "\n")) - (url-wait-for-string url-gateway-telnet-password-prompt proc) - (process-send-string - proc (concat - (or url-gateway-telnet-password - (setq url-gateway-telnet-password - (funcall url-passwd-entry-func "Password: "))) - "\n")) - (erase-buffer) - (url-wait-for-string url-gateway-prompt-pattern proc) - (process-send-string - proc (concat (mapconcat 'identity - (append url-gateway-telnet-parameters - (list host service)) " ") "\n")) - (url-wait-for-string "^\r*Escape character.*\r*\n+" proc) - (delete-region (point-min) (match-end 0)) - (process-send-string proc "\^]\n") - (url-wait-for-string "^telnet" proc) - (process-send-string proc "mode character\n") - (accept-process-output proc 1) - (sit-for 1) - (goto-char (point-min)) - (forward-line 1) - (delete-region (point) (point-max))) - proc))) - -;;###autoload -(defun url-open-stream (name buffer host service) - "Open a stream to a host" - (let ((gw-method (if (and url-gateway-local-host-regexp - (not (eq 'ssl url-gateway-method)) - (string-match - url-gateway-local-host-regexp - host)) - 'native - url-gateway-method)) - ;; This hack is for OS/2 Emacs so that it will not do bogus CRLF - ;; conversions while trying to be 'helpful' - (tcp-binary-process-output-services (if (stringp service) - (list service) - (list service - (int-to-string service)))) - - ;; An attempt to deal with denied connections, and attempt to reconnect - (cur-retries 0) - (retry t) - (errobj nil) - (conn nil)) - - ;; If the user told us to do DNS for them, do it. - (if url-gateway-broken-resolution - (setq host (url-gateway-nslookup-host host))) - - (condition-case errobj - (setq conn (case gw-method - (ssl - (open-ssl-stream name buffer host service)) - ((tcp native) - (and (eq 'tcp gw-method) (require 'tcp)) - (open-network-stream name buffer host service)) - (socks - (socks-open-network-stream name buffer host service)) - (telnet - (url-open-telnet name buffer host service)) - (rlogin - (url-open-rlogin name buffer host service)) - (otherwise - (error "Bad setting of url-gateway-method: %s" - url-gateway-method)))) - (error - (insert "Could not contact host: " host " / " - (if (stringp service) service (int-to-string service)) - "\nAttempted using gateway method: " - (symbol-name gw-method) - "\n---- Error was: ----\n") - (setq url-current-mime-headers '(("content-type" . "text/plain"))) - (display-error errobj (current-buffer)))) - (if conn - (mule-inhibit-code-conversion conn)) - conn)) - -(provide 'url-gw) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url-http.el --- a/lisp/w3/url-http.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,604 +0,0 @@ -;;; url-http.el --- HTTP Uniform Resource Locator retrieval code -;; Author: wmperry -;; Created: 1997/04/07 13:24:34 -;; Version: 1.18 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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 'url-vars) -(require 'url-parse) -(require 'url-cookie) -(require 'timezone) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for HTTP/1.0 MIME messages -;;; ---------------------------------- -;;; These functions are the guts of the HTTP/0.9 and HTTP/1.0 transfer -;;; protocol, handling access authorization, format negotiation, the -;;; whole nine yards. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun url-parse-viewer-types () - "Create a string usable for an Accept: header from mm-mime-data" - (let ((tmp mm-mime-data) - label mjr mnr cur-mnr (str "")) - (while tmp - (setq mnr (cdr (car tmp)) - mjr (car (car tmp)) - tmp (cdr tmp)) - (while mnr - (setq cur-mnr (car mnr) - label (concat mjr "/" (if (string= ".*" (car cur-mnr)) - "*" - (car cur-mnr)))) - (cond - ((string-match (regexp-quote label) str) nil) - ((> (+ (% (length str) 60) - (length (concat ", " mjr "/" (car cur-mnr)))) 60) - (setq str (format "%s\r\nAccept: %s" str label))) - (t - (setq str (format "%s, %s" str label)))) - (setq mnr (cdr mnr)))) - (substring str 2 nil))) - -(defun url-create-multipart-request (file-list) - "Create a multi-part MIME request for all files in FILE-LIST" - (let ((separator (current-time-string)) - (content "message/http-request") - (ref-url nil)) - (setq separator - (concat "separator-" - (mapconcat - (function - (lambda (char) - (if (memq char url-mime-separator-chars) - (char-to-string char) ""))) separator ""))) - (cons separator - (concat - (mapconcat - (function - (lambda (file) - (concat "--" separator "\nContent-type: " content "\n\n" - (url-create-mime-request file ref-url)))) file-list - "\n") - "--" separator)))) - -(defun url-create-message-id () - "Generate a string suitable for the Message-ID field of a request" - (concat "<" (url-create-unique-id) "@" (system-name) ">")) - -(defun url-create-unique-id () - ;; Generate unique ID from user name and current time. - (let* ((date (current-time-string)) - (name (user-login-name)) - (dateinfo (and date (timezone-parse-date date))) - (timeinfo (and date (timezone-parse-time (aref dateinfo 3))))) - (if (and dateinfo timeinfo) - (concat (upcase name) "." - (aref dateinfo 0) ; Year - (aref dateinfo 1) ; Month - (aref dateinfo 2) ; Day - (aref timeinfo 0) ; Hour - (aref timeinfo 1) ; Minute - (aref timeinfo 2) ; Second - ) - (error "Cannot understand current-time-string: %s." date)) - )) - -(defun url-http-user-agent-string () - (if (or (eq url-privacy-level 'paranoid) - (and (listp url-privacy-level) - (memq 'agent url-privacy-level))) - "" - (format "User-Agent: %s/%s URL/%s%s\r\n" - url-package-name url-package-version - url-version - (cond - ((and url-os-type url-system-type) - (concat " (" url-os-type "; " url-system-type ")")) - ((or url-os-type url-system-type) - (concat " (" (or url-system-type url-os-type) ")")) - (t ""))))) - -(defun url-create-mime-request (fname ref-url) - "Create a MIME request for fname, referred to by REF-URL." - (let* ((extra-headers) - (request nil) - (url (url-view-url t)) - (no-cache (cdr-safe (assoc "Pragma" url-request-extra-headers))) - (proxy-auth (if (or (cdr-safe (assoc "Proxy-Authorization" - url-request-extra-headers)) - (not (boundp 'proxy-info))) - nil - (let ((url-basic-auth-storage - url-proxy-basic-authentication)) - (url-get-authentication url nil 'any nil)))) - (proxy-obj (if (and (boundp 'proxy-info) proxy-info) - (url-generic-parse-url proxy-info))) - (real-fname (if proxy-obj (url-filename proxy-obj) fname)) - (host (or (and proxy-obj (url-host proxy-obj)) - (url-host url-current-object))) - (auth (if (cdr-safe (assoc "Authorization" url-request-extra-headers)) - nil - (url-get-authentication (or - (and (boundp 'proxy-info) - proxy-info) - url) nil 'any nil)))) - (setq no-cache (and no-cache (string-match "no-cache" no-cache))) - (if auth - (setq auth (concat "Authorization: " auth "\r\n"))) - (if proxy-auth - (setq proxy-auth (concat "Proxy-Authorization: " proxy-auth "\r\n"))) - - (if (and ref-url (stringp ref-url) (or (string= ref-url "file:nil") - (string= ref-url ""))) - (setq ref-url nil)) - - (if (or (memq url-privacy-level '(low high paranoid)) - (and (listp url-privacy-level) - (memq 'lastloc url-privacy-level))) - (setq ref-url nil)) - - (setq extra-headers (mapconcat - (function (lambda (x) - (concat (car x) ": " (cdr x)))) - url-request-extra-headers "\r\n")) - (if (not (equal extra-headers "")) - (setq extra-headers (concat extra-headers "\r\n"))) - (setq request - (format - (concat - "%s %s HTTP/1.0\r\n" ; The request - "MIME-Version: 1.0\r\n" ; Version of MIME we speaketh - "Extension: %s\r\n" ; HTTP extensions we support - "Host: %s\r\n" ; Who we want to talk to - "%s" ; Who its from - "Accept-encoding: %s\r\n" ; Encodings we understand - "Accept-language: %s\r\n" ; Languages we understand - "Accept: %s\r\n" ; Types we understand - "%s" ; User agent - "%s" ; Authorization - "%s" ; Cookies - "%s" ; Proxy Authorization - "%s" ; If-modified-since - "%s" ; Where we came from - "%s" ; Any extra headers - "%s" ; Any data - "\r\n") ; End request - (or url-request-method "GET") - fname - (or url-extensions-header "none") - (or host "UNKNOWN.HOST.NAME") - (if url-personal-mail-address - (concat "From: " url-personal-mail-address "\r\n") - "") - url-mime-encoding-string - url-mime-language-string - url-mime-accept-string - (url-http-user-agent-string) - (or auth "") - (url-cookie-generate-header-lines - host real-fname (equal "https" (url-type url-current-object))) - (or proxy-auth "") - (if (and (not no-cache) - (member url-request-method '("GET" nil))) - (let ((tm (url-is-cached url))) - (if tm - (concat "If-modified-since: " - (url-get-normalized-date tm) "\r\n") - "")) - "") - (if ref-url (concat "Referer: " ref-url "\r\n") "") - extra-headers - (if url-request-data - (format "Content-length: %d\r\n\r\n%s" - (length url-request-data) url-request-data) - ""))) - request)) - -(defun url-setup-reload-timer (url must-be-viewing &optional time) - ;; Set up a timer to load URL at optional TIME. If TIME is unspecified, - ;; default to 5 seconds. Only loads document if MUST-BE-VIEWING is the - ;; current URL when the timer expires." - (if (or (not time) - (<= time 0)) - (setq time 5)) - (let ((func - (` (lambda () - (if (equal (url-view-url t) (, must-be-viewing)) - (let ((w3-reuse-buffers 'no)) - (if (equal (, url) (url-view-url t)) - (kill-buffer (current-buffer))) - (w3-fetch (, url)))))))) - (cond - ((featurep 'itimer) - (start-itimer "reloader" func time)) - ((fboundp 'run-at-time) - (run-at-time time nil func)) - (t - (url-warn 'url "Cannot set up timer for automatic reload, sorry!"))))) - -(defun url-handle-refresh-header (reload) - (if (and reload - url-honor-refresh-requests - (or (eq url-honor-refresh-requests t) - (funcall url-confirmation-func "Honor refresh request? "))) - (let ((uri (url-view-url t))) - (if (string-match ";" reload) - (progn - (setq uri (substring reload (match-end 0) nil) - reload (substring reload 0 (match-beginning 0))) - (if (string-match - "ur[li][ \t]*=[ \t]*\"*\\([^ \t\"]+\\)\"*" - uri) - (setq uri (url-match uri 1))) - (setq uri (url-expand-file-name uri (url-view-url t))))) - (url-setup-reload-timer uri (url-view-url t) - (string-to-int (or reload "5")))))) - -(defun url-parse-mime-headers (&optional no-delete switch-buff) - ;; Parse mime headers and remove them from the html - (and switch-buff (set-buffer url-working-buffer)) - (let* ((st (point-min)) - (nd (progn - (goto-char (point-min)) - (skip-chars-forward " \t\n") - (if (re-search-forward "^\r*$" nil t) - (1+ (point)) - (point-max)))) - save-pos - status - class - hname - hvalu - result - ) - (narrow-to-region st (min nd (point-max))) - (goto-char (point-min)) - (skip-chars-forward " \t\n") ; Get past any blank crap - (skip-chars-forward "^ \t") ; Skip over the HTTP/xxx - (setq status (read (current-buffer)); Quicker than buffer-substring, etc. - result (cons (cons "status" status) result)) - (end-of-line) - (while (not (eobp)) - (skip-chars-forward " \t\n\r") - (setq save-pos (point)) - (skip-chars-forward "^:\n\r") - (downcase-region save-pos (point)) - (setq hname (buffer-substring save-pos (point))) - (skip-chars-forward ": \t ") - (setq save-pos (point)) - (skip-chars-forward "^\n\r") - (setq hvalu (buffer-substring save-pos (point)) - result (cons (cons hname hvalu) result)) - (if (string= hname "set-cookie") - (url-cookie-handle-set-cookie hvalu))) - (or no-delete (delete-region st (min nd (point)))) - (setq url-current-mime-type (cdr (assoc "content-type" result)) - url-current-mime-encoding (cdr (assoc "content-encoding" result)) - url-current-mime-viewer (mm-mime-info url-current-mime-type nil t) - url-current-mime-headers result - url-current-can-be-cached - (not (string-match "no-cache" - (or (cdr-safe (assoc "pragma" result)) "")))) - (url-handle-refresh-header (cdr-safe (assoc "refresh" result))) - (if (and url-request-method - (not (string= url-request-method "GET"))) - (setq url-current-can-be-cached nil)) - (let ((expires (cdr-safe (assoc "expires" result)))) - (if (and expires url-current-can-be-cached (featurep 'timezone)) - (progn - (if (string-match - (concat "^[^,]+, +\\(..\\)-\\(...\\)-\\(..\\) +" - "\\(..:..:..\\) +\\[*\\([^\]]+\\)\\]*$") - expires) - (setq expires (concat (url-match expires 1) " " - (url-match expires 2) " " - (url-match expires 3) " " - (url-match expires 4) " [" - (url-match expires 5) "]"))) - (setq expires - (let ((d1 (mapcar - (function - (lambda (s) (and s (string-to-int s)))) - (timezone-parse-date - (current-time-string)))) - (d2 (mapcar - (function (lambda (s) (and s (string-to-int s)))) - (timezone-parse-date expires)))) - (- (timezone-absolute-from-gregorian - (nth 1 d1) (nth 2 d1) (car d1)) - (timezone-absolute-from-gregorian - (nth 1 d2) (nth 2 d2) (car d2)))) - url-current-can-be-cached (/= 0 expires))))) - (setq class (/ status 100)) - (cond - ;; Classes of response codes - ;; - ;; 5xx = Server Error - ;; 4xx = Client Error - ;; 3xx = Redirection - ;; 2xx = Successful - ;; 1xx = Informational - ;; - ((= class 2) ; Successful in some form or another - (cond - ((or (= status 206) ; Partial content - (= status 205)) ; Reset content - (setq url-current-can-be-cached nil)) - ((= status 204) ; No response - leave old document - (kill-buffer url-working-buffer)) - (t nil)) ; All others indicate success - ) - ((= class 3) ; Redirection of some type - (cond - ((or (= status 301) ; Moved - retry with Location: header - (= status 302) ; Found - retry with Location: header - (= status 303)) ; Method - retry with location/method - (let ((x (url-view-url t)) - (redir (or (cdr (assoc "uri" result)) - (cdr (assoc "location" result)))) - (redirmeth (upcase (or (cdr (assoc "method" result)) - url-request-method - "get")))) - (if (and redir (string-match "\\([^ \t]+\\)[ \t]" redir)) - (setq redir (url-match redir 1))) - (if (and redir (string-match "^<\\(.*\\)>$" redir)) - (setq redir (url-match redir 1))) - - ;; As per Roy Fielding, 303 maps _any_ method to a 'GET' - (if (= 303 status) - (setq redirmeth "GET")) - - ;; As per Roy Fielding, 301, 302 use the same method as the - ;; original request, but if != GET, user interaction is - ;; required. - (if (and (not (string= "GET" redirmeth)) - (not (funcall - url-confirmation-func - (concat - "Honor redirection with non-GET method " - "(possible security risks)? ")))) - (progn - (url-warn 'url - (format - "The URL %s tried to issue a redirect to %s using a method other than -GET, which can open up various security holes. Please see the -HTTP/1.0 specification for more details." x redir) 'error) - (if (funcall url-confirmation-func - "Continue (with method of GET)? ") - (setq redirmeth "GET") - (error "Transaction aborted.")))) - - (if (not (equal x redir)) - (let ((url-request-method redirmeth)) - (url-maybe-relative redir)) - (progn - (goto-char (point-max)) - (insert "<hr>Error! This URL tried to redirect me to itself!<P>" - "Please notify the server maintainer."))))) - ((= status 304) ; Cached document is newer - (message "Extracting from cache...") - (url-cache-extract (url-cache-create-filename (url-view-url t)))) - ((= status 305) ; Use proxy in Location: header - nil))) - ((= class 4) ; Client error - (cond - ((and (= status 401) ; Unauthorized access, retry w/auth. - (< url-current-passwd-count url-max-password-attempts)) - (setq url-current-passwd-count (1+ url-current-passwd-count)) - (let* ((y (or (cdr (assoc "www-authenticate" result)) "basic")) - (url (url-view-url t)) - (type (downcase (if (string-match "[ \t]" y) - (substring y 0 (match-beginning 0)) - y)))) - (cond - ((url-auth-registered type) - (let ((args y) - (ctr (1- (length y))) - auth - (url-request-extra-headers url-request-extra-headers)) - (while (/= 0 ctr) - (if (= ?, (aref args ctr)) - (aset args ctr ?\;)) - (setq ctr (1- ctr))) - (setq args (mm-parse-args y) - auth (url-get-authentication url - (cdr-safe - (assoc "realm" args)) - type t args)) - (if auth - (setq url-request-extra-headers - (cons (cons "Authorization" auth) - url-request-extra-headers))) - (url-retrieve url t))) - (t - (widen) - (goto-char (point-max)) - (setq url-current-can-be-cached nil) - (insert "<hr>Sorry, but I do not know how to handle " y - " authentication. If you'd like to write it," - " send it to " url-bug-address ".<hr>"))))) - ((= status 407) ; Proxy authentication required - (let* ((y (or (cdr (assoc "proxy-authenticate" result)) "basic")) - (url (url-view-url t)) - (urlobj (url-generic-parse-url url)) - (url-basic-auth-storage url-proxy-basic-authentication) - (url-using-proxy (url-find-proxy-for-url urlobj - (url-host urlobj))) - (type (downcase (if (string-match "[ \t]" y) - (substring y 0 (match-beginning 0)) - y)))) - (cond - ((url-auth-registered type) - (let ((args y) - (ctr (1- (length y))) - auth - (url-request-extra-headers url-request-extra-headers)) - (while (/= 0 ctr) - (if (= ?, (aref args ctr)) - (aset args ctr ?\;)) - (setq ctr (1- ctr))) - (setq args (mm-parse-args y) - auth (url-get-authentication (or url-using-proxy url) - (cdr-safe - (assoc "realm" args)) - type t args)) - (if auth - (setq url-request-extra-headers - (cons (cons "Proxy-Authorization" auth) - url-request-extra-headers))) - (setq url-proxy-basic-authentication url-basic-auth-storage) - (url-retrieve url t))) - (t - (widen) - (goto-char (point-max)) - (setq url-current-can-be-cached nil) - (insert "<hr>Sorry, but I do not know how to handle " y - " authentication. If you'd like to write it," - " send it to " url-bug-address ".<hr>"))))) - ;;((= status 400) nil) ; Bad request - syntax - ;;((= status 401) nil) ; Tried too many times - ;;((= status 402) nil) ; Payment required, retry w/Chargeto: - ;;((= status 403) nil) ; Access is forbidden - ;;((= status 404) nil) ; Not found... - ;;((= status 405) nil) ; Method not allowed - ;;((= status 406) nil) ; None acceptable - ;;((= status 408) nil) ; Request timeout - ;;((= status 409) nil) ; Conflict - ;;((= status 410) nil) ; Document is gone - ;;((= status 411) nil) ; Length required - ;;((= status 412) nil) ; Unless true - (t ; All others mena something hosed - (setq url-current-can-be-cached nil)))) - ((= class 5) -;;; (= status 504) ; Gateway timeout -;;; (= status 503) ; Service unavailable -;;; (= status 502) ; Bad gateway -;;; (= status 501) ; Facility not supported -;;; (= status 500) ; Internal server error - (setq url-current-can-be-cached nil)) - ((= class 1) - (cond - ((or (= status 100) ; Continue - (= status 101)) ; Switching protocols - nil))) - (t - (setq url-current-can-be-cached nil))) - (widen) - status)) - -(defun url-mime-response-p (&optional switch-buff) - ;; Determine if the current buffer is a MIME response - (and switch-buff (set-buffer url-working-buffer)) - (goto-char (point-min)) - (skip-chars-forward " \t\n") - (and (looking-at "^HTTP/.+"))) - -(defsubst url-recreate-with-attributes (obj) - (if (url-attributes obj) - (concat (url-filename obj) ";" - (mapconcat - (function - (lambda (x) - (if (cdr x) - (concat (car x) "=" (cdr x)) - (car x)))) (url-attributes obj) ";")) - (url-filename obj))) - -(defun url-http (url &optional proxy-info) - ;; Retrieve URL via http. - (let* ((urlobj (url-generic-parse-url url)) - (ref-url (or url-current-referer (url-view-url t)))) - (url-clear-tmp-buffer) - (let* ((server (url-host urlobj)) - (port (url-port urlobj)) - (file (or proxy-info (url-recreate-with-attributes urlobj))) - (dest (url-target urlobj)) - request) - (if (equal port "") (setq port "80")) - (if (equal file "") (setq file "/")) - (if (not server) - (progn - (url-warn - 'url - (eval-when-compile - (concat - "Malformed URL got passed into url-retrieve.\n" - "Either `url-expand-file-name' is broken in some\n" - "way, or an incorrect URL was manually entered (more likely)." - ))) - (error "Malformed URL: `%s'" url))) - (if (or (not (member port url-bad-port-list)) - (funcall url-confirmation-func - (concat - "Warning! Trying to connect to port " - port - " - continue? "))) - (progn - (setq request (url-create-mime-request file ref-url)) - (url-lazy-message "Contacting %s:%s" server port) - (let ((process - (url-open-stream "WWW" url-working-buffer server - (string-to-int port)))) - (if (not (processp process)) - nil - (progn - (url-process-put process 'url (or proxy-info url)) - (set-process-sentinel process 'ignore) - (process-kill-without-query process) - (process-send-string process request) - (url-lazy-message "Request sent, waiting for response...") - (setq url-current-content-length nil) - (make-local-variable 'after-change-functions) - (add-hook 'after-change-functions 'url-after-change-function) - (if url-be-asynchronous - (set-process-sentinel process 'url-sentinel) - (unwind-protect - (save-excursion - (set-buffer url-working-buffer) - (while (memq (url-process-status process) - '(run open)) - (url-accept-process-output process))) - (condition-case () - (url-kill-process process) - (error nil)))) - (if url-be-asynchronous - nil - (message "Retrieval complete.") - (remove-hook 'after-change-functions - 'url-after-change-function)))))) - (progn - (ding) - (url-warn 'security "Aborting connection to bad port...")))))) - -(defun url-https (url) - ;; Retrieve a URL via SSL - (condition-case () - (require 'ssl) - (error (error "Not configured for SSL, please read the info pages."))) - (let ((url-this-is-ssl t) - (url-gateway-method 'ssl)) - (url-http url))) - -(provide 'url-http) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url-irc.el --- a/lisp/w3/url-irc.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,74 +0,0 @@ -;;; url-irc.el --- IRC URL interface -;; Author: wmperry -;; Created: 1997/04/11 14:40:56 -;; Version: 1.6 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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 'url-vars) -(require 'url-parse) - -(defcustom url-irc-function 'url-irc-zenirc - "*Function to actually open an IRC connection. -Should be a function that takes several argument: - HOST - the hostname of the IRC server to contact - PORT - the port number of the IRC server to contact - CHANNEL - What channel on the server to visit right away (can be nil) - USER - What username to use -PASSWORD - What password to use" - :type '(choice (const :tag "ZEN IRC" :value 'url-irc-zenirc) - (function :tag "Other")) - :group 'url) - -(defun url-irc-zenirc (host port channel user password) - (let ((zenirc-buffer-name (if (and user host port) - (format "%s@%s:%d" user host port) - (format "%s:%d" host port))) - (zenirc-server-alist - (list - (list host port password nil user)))) - (zenirc) - (goto-char (point-max)) - (if (not channel) - nil - (insert "/join " channel) - (zenirc-send-line)))) - -(defun url-irc (url) - (let* ((urlobj (url-generic-parse-url url)) - (host (url-host urlobj)) - (port (string-to-int (url-port urlobj))) - (pass (url-password urlobj)) - (user (url-user urlobj)) - (chan (url-filename urlobj))) - (if (url-target urlobj) - (setq chan (concat chan "#" (url-target urlobj)))) - (and (get-buffer url-working-buffer) - (kill-buffer url-working-buffer)) - (if (string-match "^/" chan) - (setq chan (substring chan 1 nil))) - (if (= (length chan) 0) - (setq chan nil)) - (funcall url-irc-function host port chan user pass))) - diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url-mail.el --- a/lisp/w3/url-mail.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,196 +0,0 @@ -;;; url-mail.el --- Mail Uniform Resource Locator retrieval code -;; Author: wmperry -;; Created: 1997/01/20 19:52:07 -;; Version: 1.7 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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 'url-vars) -(require 'url-parse) - -(defmacro url-mailserver-skip-chunk () - (` (while (and (not (looking-at "/")) - (not (eobp))) - (forward-sexp 1)))) - -(defun url-mail (&rest args) - (interactive "P") - (if (fboundp 'message-mail) - (apply 'message-mail args) - (or (apply 'mail args) - (error "Mail aborted")))) - -(defun url-mail-goto-field (field) - (if (not field) - (goto-char (point-max)) - (let ((dest nil) - (lim nil) - (case-fold-search t)) - (save-excursion - (goto-char (point-min)) - (if (re-search-forward (regexp-quote mail-header-separator) nil t) - (setq lim (match-beginning 0))) - (goto-char (point-min)) - (if (re-search-forward (concat "^" (regexp-quote field) ":") lim t) - (setq dest (match-beginning 0)))) - (if dest - (progn - (goto-char dest) - (end-of-line)) - (goto-char lim) - (insert (capitalize field) ": ") - (save-excursion - (insert "\n")))))) - -(defun url-mailto (url) - ;; Send mail to someone - (if (not (string-match "mailto:/*\\(.*\\)" url)) - (error "Malformed mailto link: %s" url)) - (setq url (substring url (match-beginning 1) nil)) - (if (get-buffer url-working-buffer) - (kill-buffer url-working-buffer)) - (let (to args source-url subject func) - (if (string-match (regexp-quote "?") url) - (setq to (url-unhex-string (substring url 0 (match-beginning 0))) - args (url-parse-query-string - (substring url (match-end 0) nil) t)) - (setq to (url-unhex-string url))) - (setq source-url (url-view-url t)) - (if (and url-request-data (not (assoc "subject" args))) - (setq args (cons (list "subject" - (concat "Automatic submission from " - url-package-name "/" - url-package-version)) args))) - (if (and source-url (not (assoc "x-url-from" args))) - (setq args (cons (list "x-url-from" source-url) args))) - (setq args (cons (list "to" to) args) - subject (cdr-safe (assoc "subject" args))) - (if (fboundp url-mail-command) (funcall url-mail-command) (mail)) - (while args - (url-mail-goto-field (caar args)) - (setq func (intern-soft (concat "mail-" (caar args)))) - (insert (mapconcat 'identity (cdar args) ", ")) - (setq args (cdr args))) - (url-mail-goto-field "X-Mailer") - (insert url-package-name "/" url-package-version) - (if (not url-request-data) - (if subject - (url-mail-goto-field nil) - (url-mail-goto-field "subject")) - (if url-request-extra-headers - (mapconcat - (function - (lambda (x) - (url-mail-goto-field (car x)) - (insert (cdr x)))) - url-request-extra-headers "")) - (goto-char (point-max)) - (insert url-request-data) - (mail-send-and-exit nil)))) - -(defun url-mailserver (url) - ;; Send mail to someone, much cooler/functional than mailto - (if (get-buffer url-working-buffer) - (kill-buffer url-working-buffer)) - (set-buffer (get-buffer-create " *mailserver*")) - (erase-buffer) - (insert url) - (goto-char (point-min)) - (set-syntax-table url-mailserver-syntax-table) - (skip-chars-forward "^:") ; Get past mailserver - (skip-chars-forward ":") ; Get past : - ;; Handle some ugly malformed URLs, but bitch about it. - (if (looking-at "/") - (progn - (url-warn 'url "Invalid mailserver URL... attempting to cope.") - (skip-chars-forward "/"))) - - (let ((save-pos (point)) - (url (url-view-url t)) - (rfc822-addr nil) - (subject nil) - (body nil)) - (url-mailserver-skip-chunk) - (setq rfc822-addr (buffer-substring save-pos (point))) - (forward-char 1) - (setq save-pos (point)) - (url-mailserver-skip-chunk) - (setq subject (buffer-substring save-pos (point))) - (if (not (eobp)) - (progn ; There is some text to use - (forward-char 1) ; as the body of the message - (setq body (buffer-substring (point) (point-max))))) - (if (fboundp url-mail-command) (funcall url-mail-command) (mail)) - (url-mail-goto-field "to") - (insert rfc822-addr) - (if (and url (not (string= url ""))) - (progn - (url-mail-goto-field "X-URL-From") - (insert url))) - (url-mail-goto-field "X-Mailer") - (insert url-package-name "/" url-package-version) - (url-mail-goto-field "subject") - ;; Massage the subject from URLEncoded garbage - ;; Note that we do not allow any newlines in the subject, - ;; as recommended by the Internet Draft on the mailserver - ;; URL - this means the document author cannot spoof additional - ;; header lines, which is a 'Good Thing' - (if subject - (progn - (setq subject (url-unhex-string subject)) - (let ((x (1- (length subject))) - (y 0)) - (while (<= y x) - (if (memq (aref subject y) '(?\r ?\n)) - (aset subject y ? )) - (setq y (1+ y)))))) - (insert subject) - (if url-request-extra-headers - (progn - (goto-char (point-min)) - (insert - (mapconcat - (function - (lambda (x) - (url-mail-goto-field (car x)) - (insert (cdr x)))) - url-request-extra-headers "")))) - (goto-char (point-max)) - ;; Massage the body from URLEncoded garbage - (if body - (let ((x (1- (length body))) - (y 0)) - (while (<= y x) - (if (= (aref body y) ?/) - (aset body y ?\n)) - (setq y (1+ y))) - (setq body (url-unhex-string body)))) - (and body (insert body)) - (and url-request-data (insert url-request-data)) - (if (and (or body url-request-data) - (funcall url-confirmation-func - (concat "Send message to " rfc822-addr "? "))) - (mail-send-and-exit nil)))) - -(provide 'url-mail) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url-misc.el --- a/lisp/w3/url-misc.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,191 +0,0 @@ -;;; url-misc.el --- Misc Uniform Resource Locator retrieval code -;; Author: wmperry -;; Created: 1997/08/12 22:58:50 -;; Version: 1.20 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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 'url-vars) -(require 'url-parse) -(require 'widget) -(autoload 'Info-goto-node "info" "" t) - -(defun url-netrek (url) - ;; Start a netrek client - (if (get-buffer url-working-buffer) - (kill-buffer url-working-buffer)) - (let ((data (url-generic-parse-url url))) - (error - "I should launch netrek on: %s %s" (url-host data) (url-port data)))) - -(defun url-info (url) - ;; Fetch an info node - (if (get-buffer url-working-buffer) - (kill-buffer url-working-buffer)) - (let* ((data (url-generic-parse-url url)) - (fname (url-filename data)) - (node (url-unhex-string (or (url-target data) "Top")))) - (if (and fname node) - (Info-goto-node (concat "(" fname ")" node)) - (error "Malformed url: %s" url)))) - -(defun url-finger (url) - ;; Find a finger reference - (setq url-current-mime-headers '(("content-type" . "text/html")) - url-current-mime-type "text/html") - (set-buffer (get-buffer-create url-working-buffer)) - (let* ((urlobj (if (vectorp url) url - (url-generic-parse-url url))) - (host (or (url-host urlobj) "localhost")) - (port (or (url-port urlobj) - (cdr-safe (assoc "finger" url-default-ports)))) - (user (url-unhex-string (url-filename urlobj))) - (proc (url-open-stream "finger" url-working-buffer host - (string-to-int port)))) - (if (not (processp proc)) - nil - (process-kill-without-query proc) - (set-process-sentinel proc 'ignore) - (if (= (string-to-char user) ?/) - (setq user (substring user 1 nil))) - (goto-char (point-min)) - (insert "<html>\n" - " <head>\n" - " <title>Finger information for " user "@" host "</title>\n" - " </head>\n" - " <body>\n" - " <h1>Finger information for " user "@" host "</h1>\n" - " <hr>\n" - " <pre>\n") - (process-send-string proc (concat user "\r\n")) - (while (memq (url-process-status proc) '(run open)) - (url-after-change-function) - (url-accept-process-output proc)) - (goto-char (point-min)) - (url-replace-regexp "^Process .* exited .*code .*$" "") - (goto-char (point-max)) - (insert " </pre>\n" - " </body>\n" - "</html>\n")))) - -(defun url-do-terminal-emulator (type server port user) - (terminal-emulator - (generate-new-buffer (format "%s%s" (if user (concat user "@") "") server)) - (case type - (rlogin "rlogin") - (telnet "telnet") - (tn3270 "tn3270") - (otherwise - (error "Unknown terminal emulator required: %s" type))) - (if user - (case type - (rlogin - (list server "-l" user)) - (telnet - (if user (message "Please log in as user: %s" user)) - (if port - (list server port) - (list server))) - (tn3270 - (if user (message "Please log in as user: %s" user)) - (list server)))))) - -(defun url-generic-emulator-loader (url) - (if (get-buffer url-working-buffer) - (kill-buffer url-working-buffer)) - (or (string-match "^\\([^:]+\\):/*\\(.*@\\)*\\([^/]*\\)/*" url) - (error "Invalid URL: %s" url)) - (let* ((type (intern (downcase (match-string 1 url)))) - (server (match-string 3 url)) - (name (if (match-beginning 2) - (substring url (match-beginning 2) (1- (match-end 2))))) - (port (if (string-match ":" server) - (prog1 - (substring server (match-end 0)) - (setq server (substring server 0 (match-beginning 0))))))) - (url-do-terminal-emulator type server port name))) - -(fset 'url-rlogin 'url-generic-emulator-loader) -(fset 'url-telnet 'url-generic-emulator-loader) -(fset 'url-tn3270 'url-generic-emulator-loader) - -(defun url-proxy (url) - ;; Retrieve URL from a proxy. - ;; Expects `url-using-proxy' to be bound to the specific proxy to use." - (let ((urlobj (url-generic-parse-url url))) - (url-set-target urlobj nil) - (url-http url-using-proxy (url-recreate-url urlobj)))) - -(defvar url-webmail-gateway "w3mail@gmd.de" - "*Where to send webmail requests") - -(defvar url-webmail-switches '(" " "-uu -z" "-uu -z -s 100")) - -(defun url-proxy-via-mail (url) - ;; Return URL from a web->mail gateway - (let ((urlobj (url-generic-parse-url url))) - (funcall url-mail-command) - (set (make-local-variable 'inhibit-read-only) t) - (goto-char (point-min)) - (if (search-forward mail-header-separator nil t) - (progn - (forward-char 1) - (delete-region (point) (point-max))) - (goto-char (point-max))) - (if (fboundp 'widget-minor-mode) - (widget-minor-mode 1)) - (apply 'widget-create 'menu-choice - :value " " - :format "%[%t%] %v" - :tag "get" - (mapcar (lambda (x) (list 'choice-item :format "%v" x)) - url-webmail-switches)) - (insert " " url) - (if url-request-data - (insert "?" url-request-data)) - (url-mail-goto-field "To") - (insert url-webmail-gateway))) - -;; ftp://ietf.org/internet-drafts/draft-masinter-url-data-02.txt -(defun url-data (url) - (set-buffer (get-buffer-create url-working-buffer)) - (let ((content-type nil) - (encoding nil) - (data nil)) - (cond - ((string-match "^data:\\([^;,]*\\);*\\([^,]*\\)," url) - (setq content-type (match-string 1 url) - encoding (match-string 2 url) - data (url-unhex-string (substring url (match-end 0)))) - (if (= 0 (length content-type)) (setq content-type "text/plain")) - (if (= 0 (length encoding)) (setq encoding "8bit"))) - (t nil)) - (setq url-current-content-length (length data) - url-current-mime-type content-type - url-current-mime-encoding encoding - url-current-mime-headers (list (cons "content-type" content-type) - (cons "content-encoding" encoding))) - (and data (insert data)))) - -(provide 'url-misc) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url-news.el --- a/lisp/w3/url-news.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,306 +0,0 @@ -;;; url-news.el --- News Uniform Resource Locator retrieval code -;; Author: wmperry -;; Created: 1997/07/05 22:54:24 -;; Version: 1.8 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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 'url-vars) -(require 'url-parse) - -(defgroup url-news nil - "News related options" - :group 'url) - -(defcustom url-news-use-article-mode nil - "*Whether to use Gnus' article mode for displaying news articles." - :type 'boolean - :group 'url-news) - -(defun url-format-news () - (url-clear-tmp-buffer) - (insert "HTTP/1.0 200 Retrieval OK\r\n" - (save-excursion - (set-buffer nntp-server-buffer) - (buffer-string))) - (url-parse-mime-headers) - (let* ((from (cdr (assoc "from" url-current-mime-headers))) - (qfrom (if from (url-insert-entities-in-string from) nil)) - (subj (cdr (assoc "subject" url-current-mime-headers))) - (qsubj (if subj (url-insert-entities-in-string subj) nil)) - (org (cdr (assoc "organization" url-current-mime-headers))) - (qorg (if org (url-insert-entities-in-string org) nil)) - (typ (or (cdr (assoc "content-type" url-current-mime-headers)) - "text/plain")) - (inhibit-read-only t) - (qgrps (mapcar 'car - (url-split - (url-insert-entities-in-string - (or (cdr (assoc "newsgroups" - url-current-mime-headers)) - "")) - "[ \t\n,]+"))) - (qrefs (delete "" - (mapcar - 'url-insert-entities-in-string - (mapcar 'car - (url-split - (or (cdr (assoc "references" - url-current-mime-headers)) - "") - "[ \t,\n<>]+"))))) - (date (cdr (assoc "date" url-current-mime-headers)))) - (if (or (not (string-match "text/" typ)) - (string-match "text/html" typ)) - nil ; Let natural content-type take over - (if (and (fboundp 'gnus-article-mode) - url-news-use-article-mode) - (progn - (kill-buffer (current-buffer)) - (set-buffer (get-buffer-create "Emacs/W3 News")) - (erase-buffer) - (insert - (save-excursion - (set-buffer nntp-server-buffer) - (save-restriction - (widen) - (buffer-string)))) - (gnus-article-mode) - (article-hide-headers 1) - (goto-char (point-min)) - (display-buffer (current-buffer))) - (insert "<html>\n" - " <head>\n" - " <title>" qsubj "</title>\n" - " <link rev=\"made\" href=\"mailto:" qfrom "\">\n" - " </head>\n" - " <body>\n" - " <div>\n" - " <h1 align=center>" qsubj "</h1>\n" - " <p role=\"headers\">\n" - " <b>From</b>: " qfrom "<br>\n" - " <b>Newsgroups</b>: " - (mapconcat - (function - (lambda (grp) - (concat "<a href=\"" grp "\">" grp "</a>"))) qgrps ", ") - "<br>\n" - (if org - (concat - " <b>Organization</b>: <i> " qorg "</i> <br>\n") - "") - " <b>Date</b>: <date> " date "</date> <br>\n" - " </p> <hr>\n" - (if (null qrefs) - "" - (concat - " <p>References\n" - " <ol>\n" - (mapconcat - (function - (lambda (ref) - (concat " <li> <a href=\"" ref "\"> " - ref "</a></li>\n"))) - qrefs "") - " </ol>\n" - " </p>\n" - " <hr>\n")) - " <ul plain>\n" - " <li><a href=\"newspost:disfunctional\"> " - "Post to this group </a></li>\n" - " <li><a href=\"mailto:" qfrom "\"> Reply to " qfrom - "</a></li>\n" - " </ul>\n" - " <hr>" - " <pre>\n") - (let ((s (buffer-substring (point) (point-max)))) - (delete-region (point) (point-max)) - (insert (url-insert-entities-in-string s))) - (goto-char (point-max)) - (setq url-current-mime-type "text/html" - url-current-mime-viewer (mm-mime-info url-current-mime-type nil 5)) - (let ((x (assoc "content-type" url-current-mime-headers))) - (if x - (setcdr x "text/html") - (setq url-current-mime-headers (cons (cons "content-type" - "text/html") - url-current-mime-headers)))) - (insert "\n" - " </pre>\n" - " </div>\n" - " </body>\n" - "</html>\n" - "<!-- Automatically generated by URL/" url-version - "-->"))))) - -(defun url-check-gnus-version () - (require 'nntp) - (condition-case () - (require 'gnus) - (error (setq gnus-version "GNUS not found"))) - (if (or (not (boundp 'gnus-version)) - (string-match "v5.[.0-9]+$" gnus-version) - (string-match "Red" gnus-version)) - nil - (url-warn 'url (concat - "The version of GNUS found on this system is too old and does\n" - "not support the necessary functionality for the URL package.\n" - "Please upgrade to version 5.x of GNUS. This is bundled by\n" - "default with Emacs 19.30 and XEmacs 19.14 and later.\n\n" - "This version of GNUS is: " gnus-version "\n")) - (fset 'url-news 'url-news-version-too-old)) - (fset 'url-check-gnus-version 'ignore)) - -(defun url-news-version-too-old (article) - (set-buffer (get-buffer-create url-working-buffer)) - (setq url-current-mime-headers '(("content-type" . "text/html")) - url-current-mime-type "text/html") - (insert "<html>\n" - " <head>\n" - " <title>News Error</title>\n" - " </head>\n" - " <body>\n" - " <h1>News Error - too old</h1>\n" - " <p>\n" - " The version of GNUS found on this system is too old and does\n" - " not support the necessary functionality for the URL package.\n" - " Please upgrade to version 5.x of GNUS. This is bundled by\n" - " default with Emacs 19.30 and XEmacs 19.14 and later.\n\n" - " This version of GNUS is: " gnus-version "\n" - " </p>\n" - " </body>\n" - "</html>\n")) - -(defun url-news-open-host (host port user pass) - (if (fboundp 'nnheader-init-server-buffer) - (nnheader-init-server-buffer)) - (nntp-open-server host (list (string-to-int port))) - (if (and user pass) - (progn - (nntp-send-command "^.*\r?\n" "AUTHINFO USER" user) - (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" pass) - (if (not (nntp-server-opened host)) - (url-warn 'url (format "NNTP authentication to `%s' as `%s' failed" - host user)))))) - -(defun url-news-fetch-article-number (newsgroup article) - (nntp-request-group newsgroup) - (nntp-request-article article)) - -(defun url-news-fetch-message-id (host port message-id) - (if (eq ?> (aref message-id (1- (length message-id)))) - nil - (setq message-id (concat "<" message-id ">"))) - (if (nntp-request-article message-id) - (url-format-news) - (set-buffer (get-buffer-create url-working-buffer)) - (setq url-current-can-be-cached nil) - (insert "<html>\n" - " <head>\n" - " <title>Error</title>\n" - " </head>\n" - " <body>\n" - " <div>\n" - " <h1>Error requesting article...</h1>\n" - " <p>\n" - " The status message returned by the NNTP server was:" - "<br><hr>\n" - " <xmp>\n" - (nntp-status-message) - " </xmp>\n" - " </p>\n" - " <p>\n" - " If you If you feel this is an error, <a href=\"" - "mailto:" url-bug-address "\">send me mail</a>\n" - " </p>\n" - " </div>\n" - " </body>\n" - "</html>\n" - "<!-- Automatically generated by URL v" url-version " -->\n" - ))) - -(defun url-news-fetch-newsgroup (newsgroup host) - (if (string-match "^/+" newsgroup) - (setq newsgroup (substring newsgroup (match-end 0)))) - (if (string-match "/+$" newsgroup) - (setq newsgroup (substring newsgroup 0 (match-beginning 0)))) - - ;; This saves a bogus 'Untitled' buffer by Emacs-W3 - (kill-buffer url-working-buffer) - - ;; This saves us from checking new news if GNUS is already running - (if (or (not (get-buffer gnus-group-buffer)) - (save-excursion - (set-buffer gnus-group-buffer) - (not (eq major-mode 'gnus-group-mode)))) - (gnus)) - (set-buffer gnus-group-buffer) - (goto-char (point-min)) - (gnus-group-read-ephemeral-group newsgroup (list 'nntp host) - nil - (cons (current-buffer) 'browse))) - -(defun url-news (article) - ;; Find a news reference - (url-check-gnus-version) - (let* ((urlobj (url-generic-parse-url article)) - (host (or (url-host urlobj) url-news-server)) - (port (or (url-port urlobj) - (cdr-safe (assoc "news" url-default-ports)))) - (article-brackets nil) - (article (url-filename urlobj))) - (url-news-open-host host port (url-user urlobj) (url-password urlobj)) - (cond - ((string-match "@" article) ; Its a specific article - (url-news-fetch-message-id host port article)) - ((string= article "") ; List all newsgroups - (gnus) - (kill-buffer url-working-buffer)) - (t ; Whole newsgroup - (url-news-fetch-newsgroup article host))))) - -(defun url-nntp (url) - ;; Find a news reference - (url-check-gnus-version) - (let* ((urlobj (url-generic-parse-url url)) - (host (or (url-host urlobj) url-news-server)) - (port (or (url-port urlobj) - (cdr-safe (assoc "nntp" url-default-ports)))) - (article-brackets nil) - (article (url-filename urlobj))) - (url-news-open-host host port (url-user urlobj) (url-password urlobj)) - (cond - ((string-match "@" article) ; Its a specific article - (url-news-fetch-message-id host port article)) - ((string-match "/\\([0-9]+\\)$" article) - (url-news-fetch-article-number (substring article 0 - (match-beginning 0)) - (match-string 1 article))) - - ((string= article "") ; List all newsgroups - (gnus) - (kill-buffer url-working-buffer)) - (t ; Whole newsgroup - (url-news-fetch-newsgroup article))))) - -(provide 'url-news) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url-nfs.el --- a/lisp/w3/url-nfs.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,73 +0,0 @@ -;;; url-nfs.el --- NFS URL interface -;; Author: wmperry -;; Created: 1997/01/10 00:13:05 -;; Version: 1.3 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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 'url-vars) -(require 'url-parse) -(require 'cl) - -(defvar url-nfs-automounter-directory-spec - "file:/net/%h%f" - "*How to invoke the NFS automounter. Certain % sequences are recognized. - -%h -- the hostname of the NFS server -%n -- the port # of the NFS server -%u -- the username to use to authenticate -%p -- the password to use to authenticate -%f -- the filename on the remote server -%% -- a literal % - -Each can be used any number of times.") - -(defun url-nfs-unescape (format host port user pass file) - (save-excursion - (set-buffer (get-buffer-create " *nfs-parse*")) - (erase-buffer) - (insert format) - (goto-char (point-min)) - (while (re-search-forward "%\\(.\\)" nil t) - (let ((escape (aref (match-string 1) 0))) - (replace-match "" t t) - (case escape - (?% (insert "%")) - (?h (insert host)) - (?n (insert (or port ""))) - (?u (insert (or user ""))) - (?p (insert (or pass ""))) - (?f (insert (or file "/")))))) - (buffer-string))) - -(defun url-nfs (url) - (let* ((urlobj (url-generic-parse-url url)) - (host (url-host urlobj)) - (port (string-to-int (url-port urlobj))) - (pass (url-password urlobj)) - (user (url-user urlobj)) - (file (url-filename urlobj))) - (url-retrieve (url-nfs-unescape url-nfs-automounter-directory-spec - host port user pass file)))) - diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url-ns.el --- a/lisp/w3/url-ns.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,64 +0,0 @@ -;;; url-ns.el --- Various netscape-ish functions for proxy definitions -;; Author: wmperry -;; Created: 1997/07/14 05:11:46 -;; Version: 1.4 -;; Keywords: comm, data, processes, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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 'url-gw) - -(defun isPlainHostName (host) - (not (string-match "\\." host))) - -(defun dnsDomainIs (host dom) - (string-match (concat (regexp-quote dom) "$") host)) - -(defun dnsResolve (host) - (url-gateway-nslookup-host host)) - -(defun isResolvable (host) - (if (string-match "^[0-9.]+$" host) - t - (not (string= host (url-gateway-nslookup-host host))))) - -(defun isInNet (ip net mask) - (let ((netc (split-string ip "\\.")) - (ipc (split-string net "\\.")) - (maskc (split-string mask "\\."))) - (if (or (/= (length netc) (length ipc)) - (/= (length ipc) (length maskc))) - nil - (setq netc (mapcar 'string-to-int netc) - ipc (mapcar 'string-to-int ipc) - maskc (mapcar 'string-to-int maskc)) - (and - (= (logand (nth 0 netc) (nth 0 maskc)) - (logand (nth 0 ipc) (nth 0 maskc))) - (= (logand (nth 1 netc) (nth 1 maskc)) - (logand (nth 1 ipc) (nth 1 maskc))) - (= (logand (nth 2 netc) (nth 2 maskc)) - (logand (nth 2 ipc) (nth 2 maskc))) - (= (logand (nth 3 netc) (nth 3 maskc)) - (logand (nth 3 ipc) (nth 3 maskc))))))) - -(provide 'url-ns) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url-parse.el --- a/lisp/w3/url-parse.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,194 +0,0 @@ -;;; url-parse.el --- Uniform Resource Locator parser -;; Author: wmperry -;; Created: 1997/01/23 16:48:58 -;; Version: 1.6 -;; Keywords: comm, data, processes - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defmacro url-type (urlobj) - (` (aref (, urlobj) 0))) - -(defmacro url-user (urlobj) - (` (aref (, urlobj) 1))) - -(defmacro url-password (urlobj) - (` (aref (, urlobj) 2))) - -(defmacro url-host (urlobj) - (` (aref (, urlobj) 3))) - -(defmacro url-port (urlobj) - (` (or (aref (, urlobj) 4) - (if (url-fullness (, urlobj)) - (cdr-safe (assoc (url-type (, urlobj)) url-default-ports)))))) - -(defmacro url-filename (urlobj) - (` (aref (, urlobj) 5))) - -(defmacro url-target (urlobj) - (` (aref (, urlobj) 6))) - -(defmacro url-attributes (urlobj) - (` (aref (, urlobj) 7))) - -(defmacro url-fullness (urlobj) - (` (aref (, urlobj) 8))) - -(defmacro url-set-type (urlobj type) - (` (aset (, urlobj) 0 (, type)))) - -(defmacro url-set-user (urlobj user) - (` (aset (, urlobj) 1 (, user)))) - -(defmacro url-set-password (urlobj pass) - (` (aset (, urlobj) 2 (, pass)))) - -(defmacro url-set-host (urlobj host) - (` (aset (, urlobj) 3 (, host)))) - -(defmacro url-set-port (urlobj port) - (` (aset (, urlobj) 4 (, port)))) - -(defmacro url-set-filename (urlobj file) - (` (aset (, urlobj) 5 (, file)))) - -(defmacro url-set-target (urlobj targ) - (` (aset (, urlobj) 6 (, targ)))) - -(defmacro url-set-attributes (urlobj targ) - (` (aset (, urlobj) 7 (, targ)))) - -(defmacro url-set-full (urlobj val) - (` (aset (, urlobj) 8 (, val)))) - -(defun url-recreate-url (urlobj) - (concat (url-type urlobj) ":" (if (url-host urlobj) "//" "") - (if (url-user urlobj) - (concat (url-user urlobj) - (if (url-password urlobj) - (concat ":" (url-password urlobj))) - "@")) - (url-host urlobj) - (if (and (url-port urlobj) - (not (equal (url-port urlobj) - (cdr-safe (assoc (url-type urlobj) - url-default-ports))))) - (concat ":" (url-port urlobj))) - (or (url-filename urlobj) "/") - (if (url-target urlobj) - (concat "#" (url-target urlobj))) - (if (url-attributes urlobj) - (concat ";" - (mapconcat - (function - (lambda (x) - (if (cdr x) - (concat (car x) "=" (cdr x)) - (car x)))) (url-attributes urlobj) ";"))))) - -(defun url-generic-parse-url (url) - "Return a vector of the parts of URL. -Format is: -[proto username password hostname portnumber file reference attributes fullp]" - (cond - ((null url) - (make-vector 9 nil)) - ((or (not (string-match url-nonrelative-link url)) - (= ?/ (string-to-char url))) - (let ((retval (make-vector 9 nil))) - (url-set-filename retval url) - (url-set-full retval nil) - retval)) - (t - (save-excursion - (set-buffer (get-buffer-create " *urlparse*")) - (set-syntax-table url-mailserver-syntax-table) - (let ((save-pos nil) - (prot nil) - (user nil) - (pass nil) - (host nil) - (port nil) - (file nil) - (refs nil) - (attr nil) - (full nil) - (inhibit-read-only t)) - (erase-buffer) - (insert url) - (goto-char (point-min)) - (setq save-pos (point)) - (if (not (looking-at "//")) - (progn - (skip-chars-forward "a-zA-Z+.\\-") - (downcase-region save-pos (point)) - (setq prot (buffer-substring save-pos (point))) - (skip-chars-forward ":") - (setq save-pos (point)))) - - ;; We are doing a fully specified URL, with hostname and all - (if (looking-at "//") - (progn - (setq full t) - (forward-char 2) - (setq save-pos (point)) - (skip-chars-forward "^/") - (setq host (buffer-substring save-pos (point))) - (if (string-match "^\\([^@]+\\)@" host) - (setq user (url-match host 1) - host (substring host (match-end 0) nil))) - (if (and user (string-match "\\([^:]+\\):\\(.*\\)" user)) - (setq pass (url-match user 2) - user (url-match user 1))) - (if (string-match ":\\([0-9+]+\\)" host) - (setq port (url-match host 1) - host (substring host 0 (match-beginning 0)))) - (if (string-match ":$" host) - (setq host (substring host 0 (match-beginning 0)))) - (setq host (downcase host) - save-pos (point)))) - ;; Now check for references - (setq save-pos (point)) - (skip-chars-forward "^#") - (if (eobp) - nil - (delete-region - (point) - (progn - (skip-chars-forward "#") - (setq refs (buffer-substring (point) (point-max))) - (point-max)))) - (goto-char save-pos) - (skip-chars-forward "^;") - (if (not (eobp)) - (setq attr (mm-parse-args (point) (point-max)) - attr (nreverse attr))) - (setq file (buffer-substring save-pos (point))) - (and port (string= port (or (cdr-safe (assoc prot url-default-ports)) - "")) - (setq port nil)) - (if (and host (string-match "%[0-9][0-9]" host)) - (setq host (url-unhex-string host))) - (vector prot user pass host port file refs attr full)))))) - -(provide 'url-parse) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url-vars.el --- a/lisp/w3/url-vars.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,591 +0,0 @@ -;;; url-vars.el --- Variables for Uniform Resource Locator tool -;; Author: wmperry -;; Created: 1997/07/12 04:58:35 -;; Version: 1.71 -;; Keywords: comm, data, processes, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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-and-compile - (condition-case () - (require 'custom) - (error nil)) - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - nil ;; We've got what we needed - ;; We have the old custom-library, hack around it! - (defmacro defgroup (&rest args) - nil) - (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))))) - -(defconst url-version (let ((x "p3.0.104")) - (if (string-match "State: \\([^ \t\n]+\\)" x) - (substring x (match-beginning 1) (match-end 1)) - x)) - "Version # of URL package.") - -(defgroup url nil - "Uniform Resource Locator tool" - :group 'hypermedia) - -(defgroup url-file nil - "URL storage" - :prefix "url-" - :group 'url) - -(defgroup url-cache nil - "URL cache" - :prefix "url-" - :prefix "url-cache-" - :group 'url) - -(defgroup url-history nil - "History variables in the URL package" - :prefix "url-" - :group 'url) - -(defgroup url-cookie nil - "URL cookies" - :prefix "url-" - :prefix "url-cookie-" - :group 'url) - -(defgroup url-mime nil - "MIME options of URL" - :prefix "url-" - :group 'url) - -(defgroup url-hairy nil - "Hairy options of URL" - :prefix "url-" - :group 'url) - - -(defvar url-current-can-be-cached t - "*Whether the current URL can be cached.") - -(defvar url-current-object nil - "A parsed representation of the current url") - -(defvar url-current-callback-func nil - "*The callback function for the current buffer.") - -(defvar url-current-callback-data nil - "*The data to be passed to the callback function. This should be a list, -each item in the list will be an argument to the url-current-callback-func.") - -(mapcar 'make-variable-buffer-local '( - url-current-callback-data - url-current-callback-func - url-current-can-be-cached - url-current-content-length - url-current-isindex - url-current-mime-encoding - url-current-mime-headers - url-current-mime-type - url-current-mime-viewer - url-current-object - url-current-referer - - ;; obsolete - ;; url-current-file - ;; url-current-port - ;; url-current-server - ;; url-current-type - ;; url-current-user - )) - -(defvar url-cookie-storage nil "Where cookies are stored.") -(defvar url-cookie-secure-storage nil "Where secure cookies are stored.") -(defcustom url-cookie-file nil "*Where cookies are stored on disk." - :type '(choice (const :tag "Default" :value nil) file) - :group 'url-file - :group 'url-cookie) - -(defcustom url-default-retrieval-proc 'url-default-callback - "*The default action to take when an asynchronous retrieval completes." - :type 'function - :group 'url-hairy) - -(defcustom url-honor-refresh-requests t - "*Whether to do automatic page reloads at the request of the document -author or the server via the `Refresh' header in an HTTP/1.0 response. -If nil, no refresh requests will be honored. -If t, all refresh requests will be honored. -If non-nil and not t, the user will be asked for each refresh request." - :type '(choice (const :tag "off" nil) - (const :tag "on" t) - (const :tag "ask" 'ask)) - :group 'url-hairy) - -(defcustom url-inhibit-mime-parsing nil - "Whether to parse out (and delete) the MIME headers from a message." - :type 'boolean - :group 'url-mime) - -(defcustom url-automatic-caching nil - "*If non-nil, all documents will be automatically cached to the local -disk." - :type 'boolean - :group 'url-cache) - -(defcustom url-cache-expired - (function (lambda (t1 t2) (>= (- (car t2) (car t1)) 5))) - "*A function (`funcall'able) that takes two times as its arguments, and -returns non-nil if the second time is 'too old' when compared to the first -time." - :type 'function - :group 'url-cache) - -(defvar url-bug-address "wmperry@cs.indiana.edu" - "Where to send bug reports.") - -(defcustom url-cookie-confirmation nil - "*If non-nil, confirmation by the user is required to accept HTTP cookies." - :type 'boolean - :group 'url-cookie) - -(defcustom url-personal-mail-address nil - "*Your full email address. -This is what is sent to HTTP/1.0 servers as the FROM field in an HTTP/1.0 -request." - :type '(choice (const nil) string) - :group 'url) - -(defcustom url-directory-index-file "index.html" - "*The filename to look for when indexing a directory. -If this file exists, and is readable, then it will be viewed instead of -using `dired' to view the directory." - :type 'string - :group 'url-file) - -(defcustom url-privacy-level '(email) - "*How private you want your requests to be. -HTTP/1.0 has header fields for various information about the user, including -operating system information, email addresses, the last page you visited, etc. -This variable controls how much of this information is sent. - -This should a symbol or a list. -Valid values if a symbol are: -none -- Send all information -low -- Don't send the last location -high -- Don't send the email address or last location -paranoid -- Don't send anything - -If a list, this should be a list of symbols of what NOT to send. -Valid symbols are: -email -- the email address -os -- the operating system info -lastloc -- the last location -agent -- Do not send the User-Agent string -cookie -- never accept HTTP cookies - -Samples: - - (setq url-privacy-level 'high) - (setq url-privacy-level '(email lastloc)) ;; equivalent to 'high - (setq url-privacy-level '(os)) - -::NOTE:: -This variable controls several other variables and is _NOT_ automatically -updated. Call the function `url-setup-privacy-info' after modifying this -variable." - :type '(choice (const :tag "None (you believe in the basic goodness of humanity)" - :value none) - (const :tag "Low (do not reveal last location)" - :value low) - (const :tag "High (no email address or last location)" - :value high) - (const :tag "Paranoid (reveal nothing!)" - :value paranoid) - (checklist :tag "Custom" - (const :tag "Email address" :value email) - (const :tag "Operating system" :value os) - (const :tag "Last location" :value lastloc) - (const :tag "Browser identification" :value agent) - (const :tag "No cookies" :value cookie))) - :group 'url) - -(defvar url-history-list nil "List of urls visited this session.") - -(defvar url-inhibit-uncompression nil "Do not do decompression if non-nil.") - -(defcustom url-keep-history nil - "*Controls whether to keep a list of all the URLS being visited. -If non-nil, url will keep track of all the URLS visited. -If eq to `t', then the list is saved to disk at the end of each emacs -session." - :type 'boolean - :group 'url-history) - -(defcustom url-uncompressor-alist '((".z" . "x-gzip") - (".gz" . "x-gzip") - (".uue" . "x-uuencoded") - (".hqx" . "x-hqx") - (".Z" . "x-compress")) - "*An assoc list of file extensions and the appropriate -content-transfer-encodings for each." - :type '(repeat (cons :format "%v" - (string :tag "Extension") - (string :tag "Encoding"))) - :group 'url-mime) - -(defcustom url-mail-command 'url-mail - "*This function will be called whenever url needs to send mail. -It should enter a mail-mode-like buffer in the current window. -The commands mail-to and mail-subject should still work in this -buffer, and it should use mail-header-separator if possible." - :type 'function - :group 'url) - -(defcustom url-proxy-services nil - "*An assoc list of access types and servers that gateway them. -Looks like ((\"http\" . \"hostname:portnumber\") ....) This is set up -from the ACCESS_proxy environment variables in url-do-setup." - :type '(repeat (cons :format "%v" - (string :tag "Protocol") - (string :tag "Proxy"))) - :group 'url) - -(defcustom url-global-history-file nil - "*The global history file used by both Mosaic/X and the url package. -This file contains a list of all the URLs you have visited. This file -is parsed at startup and used to provide URL completion." - :type '(choice (const :tag "Default" :value nil) file) - :group 'url-history) - -(defcustom url-global-history-save-interval 3600 - "*The number of seconds between automatic saves of the history list. -Default is 1 hour. Note that if you change this variable after `url-do-setup' -has been run, you need to run the `url-setup-save-timer' function manually." - :type 'integer - :group 'url-history) - -(defvar url-global-history-timer nil) - -(defcustom url-passwd-entry-func nil - "*This is a symbol indicating which function to call to read in a -password. It will be set up depending on whether you are running EFS -or ange-ftp at startup if it is nil. This function should accept the -prompt string as its first argument, and the default value as its -second argument." - :type '(choice (const :tag "Guess" :value nil) - (const :tag "Use Ange-FTP" :value ange-ftp-read-passwd) - (const :tag "Use EFS" :value efs-read-passwd) - (const :tag "Use Password Package" :value read-passwd) - (function :tag "Other")) - :group 'url-hairy) - -(defcustom url-gopher-labels - '(("0" . "(TXT)") - ("1" . "(DIR)") - ("2" . "(CSO)") - ("3" . "(ERR)") - ("4" . "(MAC)") - ("5" . "(PCB)") - ("6" . "(UUX)") - ("7" . "(???)") - ("8" . "(TEL)") - ("T" . "(TN3)") - ("9" . "(BIN)") - ("g" . "(GIF)") - ("I" . "(IMG)") - ("h" . "(WWW)") - ("s" . "(SND)")) - "*An assoc list of gopher types and how to describe them in the gopher -menus. These can be any string, but HTML/HTML+ entities should be -used when necessary, or it could disrupt formatting of the document -later on. It is also a good idea to make sure all the strings are the -same length after entity references are removed, on a strictly -stylistic level." - :type '(repeat (cons (string :tag "Type") - (string :tag "Description"))) - :group 'url-hairy) - -(defcustom url-gopher-icons - '( - ("0" . "&text.document;") - ("1" . "&folder;") - ("2" . "&index;") - ("3" . "&stop;") - ("4" . "&binhex.document;") - ("5" . "&binhex.document;") - ("6" . "&uuencoded.document;") - ("7" . "&index;") - ("8" . "&telnet;") - ("T" . "&tn3270;") - ("9" . "&binary.document;") - ("g" . "&image;") - ("I" . "&image;") - ("s" . "&audio;")) - "*An assoc list of gopher types and the graphic entity references to -show when possible." - :type '(repeat (cons (string :tag "Type") - (string :tag "Icon"))) - :group 'url-hairy) - -(defcustom url-standalone-mode nil "*Rely solely on the cache?" - :type 'boolean - :group 'url-cache) -(defcustom url-multiple-p t - "*If non-nil, multiple queries are possible through ` *URL-<i>*' buffers" - :type 'boolean - :group 'url-hairy) -(defvar url-default-working-buffer " *URL*" " The default buffer to do all of the processing in.") -(defvar url-working-buffer url-default-working-buffer - "The buffer to do all of the processing in. -It defaults to `url-default-working-buffer' and is bound to *URL-<i>* -buffers when used for multiple requests, cf. `url-multiple-p'") -(defvar url-current-referer nil "Referer of this page.") -(defvar url-current-content-length nil "Current content length.") -(defvar url-current-isindex nil "Is the current document a searchable index?") -(defvar url-current-mime-encoding nil "MIME encoding of current document.") -(defvar url-current-mime-headers nil "An alist of MIME headers.") -(defvar url-current-mime-type nil "MIME type of current document.") -(defvar url-current-mime-viewer nil "How to view the current MIME doc.") -(defvar url-current-passwd-count 0 "How many times password has failed.") -(defvar url-gopher-types "0123456789+gIThws:;<" - "A string containing character representations of all the gopher types.") -(defvar url-mime-separator-chars (mapcar 'identity - (concat "ABCDEFGHIJKLMNOPQRSTUVWXYZ" - "abcdefghijklmnopqrstuvwxyz" - "0123456789'()+_,-./=?")) - "Characters allowable in a MIME multipart separator.") - -(defcustom url-bad-port-list - '("25" "119" "19") - "*List of ports to warn the user about connecting to. Defaults to just -the mail, chargen, and NNTP ports so you cannot be tricked into sending -fake mail or forging messages by a malicious HTML document." - :type '(repeat (string :tag "Port")) - :group 'url-hairy) - -(defcustom url-be-anal-about-file-attributes nil - "*Whether to use HTTP/1.0 to figure out file attributes -or just guess based on file extension, etc." - :type 'boolean - :group 'url-mime) - -(defcustom url-be-asynchronous nil - "*Controls whether document retrievals over HTTP should be done in -the background. This allows you to keep working in other windows -while large downloads occur." - :type 'boolean - :group 'url) -(make-variable-buffer-local 'url-be-asynchronous) - -(defvar url-request-data nil "Any data to send with the next request.") - -(defvar url-request-extra-headers nil - "A list of extra headers to send with the next request. Should be -an assoc list of headers/contents.") - -(defvar url-request-method nil "The method to use for the next request.") - -(defvar url-mime-encoding-string nil - "*String to send to the server in the Accept-encoding: field in HTTP/1.0 -requests. This is created automatically from mm-content-transfer-encodings.") - -(defcustom url-mime-language-string "*" - "*String to send to the server in the Accept-language: field in -HTTP/1.0 requests." - :type 'string - :group 'url-mime - :group 'i18n) - -(defvar url-mime-accept-string nil - "String to send to the server in the Accept: field in HTTP/1.0 requests. -This is created automatically from url-mime-viewers, after the mailcap file -has been parsed.") - -(defvar url-history-changed-since-last-save nil - "Whether the history list has changed since the last save operation.") - -(defvar url-proxy-basic-authentication nil - "Internal structure - do not modify!") - -(defvar url-registered-protocols nil - "Internal structure - do not modify! See `url-register-protocol'") - -(defvar url-package-version "Unknown" "Version # of package using URL.") - -(defvar url-package-name "Unknown" "Version # of package using URL.") - -(defvar url-system-type nil "What type of system we are on.") -(defvar url-os-type nil "What OS we are on.") - -(defcustom url-max-password-attempts 5 - "*Maximum number of times a password will be prompted for when a -protected document is denied by the server." - :type 'integer - :group 'url) - -(defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp") - "*Where temporary files go." - :type 'directory - :group 'url-file) - -(defcustom url-show-status t - "*Whether to show a running total of bytes transferred. Can cause a -large hit if using a remote X display over a slow link, or a terminal -with a slow modem." - :type 'boolean - :group 'url) - -(defvar url-using-proxy nil - "Either nil or the fully qualified proxy URL in use, e.g. -http://www.domain.com/") - -(defcustom url-news-server nil - "*The default news server to get newsgroups/articles from if no server -is specified in the URL. Defaults to the environment variable NNTPSERVER -or \"news\" if NNTPSERVER is undefined." - :type '(choice (const :tag "None" :value nil) string) - :group 'url) - -(defcustom url-gopher-to-mime - '((?0 . "text/plain") ; It's a file - (?1 . "www/gopher") ; Gopher directory - (?2 . "www/gopher-cso-search") ; CSO search - (?3 . "text/plain") ; Error - (?4 . "application/mac-binhex40") ; Binhexed macintosh file - (?5 . "application/pc-binhex40") ; DOS binary archive of some sort - (?6 . "archive/x-uuencode") ; Unix uuencoded file - (?7 . "www/gopher-search") ; Gopher search! - (?9 . "application/octet-stream") ; Binary file! - (?g . "image/gif") ; Gif file - (?I . "image/gif") ; Some sort of image - (?h . "text/html") ; HTML source - (?s . "audio/basic") ; Sound file - ) - "*An assoc list of gopher types and their corresponding MIME types." - :type '(repeat (cons sexp string)) - :group 'url-hairy) - -(defcustom url-use-hypertext-gopher t - "*Controls how gopher documents are retrieved. -If non-nil, the gopher pages will be converted into HTML and parsed -just like any other page. If nil, the requests will be passed off to -the gopher.el package by Scott Snyder. Using the gopher.el package -will lose the gopher+ support, and inlined searching." - :type 'boolean - :group 'url) - -(defvar url-global-history-hash-table nil - "Hash table for global history completion.") - -(defvar url-nonrelative-link - "^\\([-a-zA-Z0-9+.]+:\\)" - "A regular expression that will match an absolute URL.") - -(defcustom url-confirmation-func 'y-or-n-p - "*What function to use for asking yes or no functions. Possible -values are 'yes-or-no-p or 'y-or-n-p, or any function that takes a -single argument (the prompt), and returns t only if a positive answer -is gotten." - :type '(choice (const :tag "Short (y or n)" :value y-or-n-p) - (const :tag "Long (yes or no)" :value yes-or-no-p) - (function :tag "Other")) - :group 'url-hairy) - -(defcustom url-gateway-method 'native - "*The type of gateway support to use. -Should be a symbol specifying how we are to get a connection off of the -local machine. - -Currently supported methods: -'telnet :: Run telnet in a subprocess to connect -'rlogin :: Rlogin to another machine to connect -'socks :: Connects through a socks server -'ssl :: Connection should be made with SSL -'tcp :: Use the excellent tcp.el package from gnus. - This simply does a (require 'tcp), then sets - url-gateway-method to be 'native. -'native :: Use the native open-network-stream in emacs -" - :type '(radio (const :tag "Telnet to gateway host" :value telnet) - (const :tag "Rlogin to gateway host" :value rlogin) - (const :tag "Use SOCKS proxy" :value socks) - (const :tag "Use SSL for all connections" :value ssl) - (const :tag "Use the `tcp' package" :value tcp) - (const :tag "Direct connection" :value native)) - :group 'url-hairy) - -(defvar url-running-xemacs (string-match "XEmacs" emacs-version) - "*Got XEmacs?") - -(defvar url-default-ports '(("http" . "80") - ("gopher" . "70") - ("telnet" . "23") - ("news" . "119") - ("https" . "443") - ("shttp" . "80")) - "An assoc list of protocols and default port #s") - -(defvar url-setup-done nil "*Has setup configuration been done?") - -(defvar url-source nil - "*Whether to force a sourcing of the next buffer. This forces local -files to be read into a buffer, no matter what. Gets around the -optimization that if you are passing it to a viewer, just make a -symbolic link, which looses if you want the source for inlined -images/etc.") - -(defconst weekday-alist - '(("Sunday" . 0) ("Monday" . 1) ("Tuesday" . 2) ("Wednesday" . 3) - ("Thursday" . 4) ("Friday" . 5) ("Saturday" . 6) - ("Tues" . 2) ("Thurs" . 4) - ("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3) - ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))) - -(defconst monthabbrev-alist - '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6) - ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12)) - ) - -(defvar url-lazy-message-time 0) - -(defvar url-extensions-header "Security/Digest Security/SSL") - -(defvar url-mailserver-syntax-table - (copy-syntax-table emacs-lisp-mode-syntax-table) - "*A syntax table for parsing the mailserver URL") - -(modify-syntax-entry ?' "\"" url-mailserver-syntax-table) -(modify-syntax-entry ?` "\"" url-mailserver-syntax-table) -(modify-syntax-entry ?< "(>" url-mailserver-syntax-table) -(modify-syntax-entry ?> ")<" url-mailserver-syntax-table) -(modify-syntax-entry ?/ " " url-mailserver-syntax-table) - -(defvar url-handle-no-scheme-hook nil - "*Hooks to be run until one can successfully transform an incomplete URL. - -Each hook is called with a single argument URL and should return a tranformed -url with a valid scheme (e.g., \"gnu\" --> \"http://www.gnu.org/\"), or nil -otherwise.") - -;;; Make OS/2 happy - yeeks -(defvar tcp-binary-process-input-services nil - "*Make OS/2 happy with our CRLF pairs...") - -(provide 'url-vars) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/url.el --- a/lisp/w3/url.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2097 +0,0 @@ -;;; url.el --- Uniform Resource Locator retrieval tool -;; Author: wmperry -;; Created: 1997/09/05 15:43:50 -;; Version: 1.81 -;; Keywords: comm, data, processes, hypermedia - -;;; LCD Archive Entry: -;;; url|William M. Perry|wmperry@cs.indiana.edu| -;;; Functions for retrieving/manipulating URLs| -;;; 1997/09/05 15:43:50|1.81|Location Undetermined -;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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 'cl) -(require 'url-vars) -(require 'url-parse) -(require 'mm) -(require 'mule-sysdp) -(require 'devices) -(or (featurep 'efs) - (featurep 'efs-auto) - (condition-case () - (require 'ange-ftp) - (error nil))) - -(eval-and-compile - (if (not (and (string-match "XEmacs" emacs-version) - (or (> emacs-major-version 19) - (>= emacs-minor-version 14)))) - (require 'w3-sysdp))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Functions that might not exist in old versions of emacs -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun url-save-error (errobj) - (save-excursion - (set-buffer (get-buffer-create " *url-error*")) - (erase-buffer)) - (display-error errobj (get-buffer-create " *url-error*"))) - -(cond - ((fboundp 'display-warning) - (fset 'url-warn 'display-warning)) - ((fboundp 'w3-warn) - (fset 'url-warn 'w3-warn)) - ((fboundp 'warn) - (defun url-warn (class message &optional level) - (warn "(%s/%s) %s" class (or level 'warning) message))) - (t - (defun url-warn (class message &optional level) - (save-excursion - (set-buffer (get-buffer-create "*W3-WARNINGS*")) - (goto-char (point-max)) - (save-excursion - (insert (format "(%s/%s) %s\n" class (or level 'warning) message))) - (display-buffer (current-buffer)))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Autoload all the URL loaders -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(autoload 'url-file "url-file") -(autoload 'url-ftp "url-file") -(autoload 'url-gopher "url-gopher") -(autoload 'url-irc "url-irc") -(autoload 'url-http "url-http") -(autoload 'url-nfs "url-nfs") -(autoload 'url-mailserver "url-mail") -(autoload 'url-mailto "url-mail") -(autoload 'url-mail "url-mail") -(autoload 'url-info "url-misc") -(autoload 'url-shttp "url-http") -(autoload 'url-https "url-http") -(autoload 'url-data "url-misc") -(autoload 'url-finger "url-misc") -(autoload 'url-rlogin "url-misc") -(autoload 'url-telnet "url-misc") -(autoload 'url-tn3270 "url-misc") -(autoload 'url-proxy "url-misc") -(autoload 'url-netrek "url-misc") -(autoload 'url-news "url-news") -(autoload 'url-nntp "url-news") - -(autoload 'url-open-stream "url-gw") -(autoload 'url-mime-response-p "url-http") -(autoload 'url-parse-mime-headers "url-http") -(autoload 'url-handle-refresh-header "url-http") -(autoload 'url-create-mime-request "url-http") -(autoload 'url-create-message-id "url-http") -(autoload 'url-create-multipart-request "url-http") -(autoload 'url-parse-viewer-types "url-http") - -(autoload 'url-get-authentication "url-auth") -(autoload 'url-register-auth-scheme "url-auth") -(autoload 'url-cookie-write-file "url-cookie") -(autoload 'url-cookie-retrieve "url-cookie") -(autoload 'url-cookie-generate-header-lines "url-cookie") -(autoload 'url-cookie-handle-set-cookie "url-cookie") - -(autoload 'url-is-cached "url-cache") -(autoload 'url-store-in-cache "url-cache") -(autoload 'url-is-cached "url-cache") -(autoload 'url-cache-create-filename "url-cache") -(autoload 'url-cache-extract "url-cache") -(autoload 'url-cache-expired "url-cache") - -(require 'md5) -(require 'base64) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; File-name-handler-alist functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun url-setup-file-name-handlers () - ;; Setup file-name handlers. - '(cond - ((not (boundp 'file-name-handler-alist)) - nil) ; Don't load if no alist - ((rassq 'url-file-handler file-name-handler-alist) - nil) ; Don't load twice - (t - (setq file-name-handler-alist - (let ((new-handler (cons - (concat "^/*" - (substring url-nonrelative-link1 nil)) - 'url-file-handler))) - (if file-name-handler-alist - (append (list new-handler) file-name-handler-alist) - (list new-handler))))))) - -(defun url-file-handler (operation &rest args) - ;; Function called from the file-name-handler-alist routines. OPERATION - ;; is what needs to be done ('file-exists-p, etc). args are the arguments - ;; that would have been passed to OPERATION." - (let ((fn (get operation 'url-file-handlers)) - (url (car args)) - (myargs (cdr args))) - (if (= (string-to-char url) ?/) - (setq url (substring url 1 nil))) - (if fn (apply fn url myargs) - (let (file-name-handler-alist) - (apply operation url myargs))))) - -(defun url-file-handler-identity (&rest args) - (car args)) - -(defun url-file-handler-null (&rest args) - nil) - -(put 'file-directory-p 'url-file-handlers 'url-file-handler-null) -(put 'substitute-in-file-name 'url-file-handlers 'url-file-handler-identity) -(put 'file-writable-p 'url-file-handlers 'url-file-handler-null) -(put 'file-truename 'url-file-handlers 'url-file-handler-identity) -(put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents) -(put 'expand-file-name 'url-file-handlers 'url-expand-file-name) -(put 'directory-files 'url-file-handlers 'url-directory-files) -(put 'file-directory-p 'url-file-handlers 'url-file-directory-p) -(put 'file-writable-p 'url-file-handlers 'url-file-writable-p) -(put 'file-readable-p 'url-file-handlers 'url-file-exists) -(put 'file-executable-p 'url-file-handlers 'null) -(put 'file-symlink-p 'url-file-handlers 'null) -(put 'file-exists-p 'url-file-handlers 'url-file-exists) -(put 'copy-file 'url-file-handlers 'url-copy-file) -(put 'file-attributes 'url-file-handlers 'url-file-attributes) -(put 'file-name-all-completions 'url-file-handlers - 'url-file-name-all-completions) -(put 'file-name-completion 'url-file-handlers 'url-file-name-completion) -(put 'file-local-copy 'url-file-handlers 'url-file-local-copy) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Utility functions -;;; ----------------- -;;; Various functions used around the url code. -;;; Some of these qualify as hacks, but hey, this is elisp. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(if (fboundp 'mm-string-to-tokens) - (fset 'url-string-to-tokens 'mm-string-to-tokens) - (defun url-string-to-tokens (str &optional delim) - "Return a list of words from the string STR" - (setq delim (or delim ? )) - (let (results y) - (mapcar - (function - (lambda (x) - (cond - ((and (= x delim) y) (setq results (cons y results) y nil)) - ((/= x delim) (setq y (concat y (char-to-string x)))) - (t nil)))) str) - (nreverse (cons y results))))) - -(defun url-days-between (date1 date2) - ;; Return the number of days between date1 and date2. - (- (url-day-number date1) (url-day-number date2))) - -(defun url-day-number (date) - (let ((dat (mapcar (function (lambda (s) (and s (string-to-int s)) )) - (timezone-parse-date date)))) - (timezone-absolute-from-gregorian - (nth 1 dat) (nth 2 dat) (car dat)))) - -(defun url-seconds-since-epoch (date) - ;; Returns a number that says how many seconds have - ;; lapsed between Jan 1 12:00:00 1970 and DATE." - (let* ((tdate (mapcar (function (lambda (ti) (and ti (string-to-int ti)))) - (timezone-parse-date date))) - (ttime (mapcar (function (lambda (ti) (and ti (string-to-int ti)))) - (timezone-parse-time - (aref (timezone-parse-date date) 3)))) - (edate (mapcar (function (lambda (ti) (and ti (string-to-int ti)))) - (timezone-parse-date "Jan 1 12:00:00 1970"))) - (tday (- (timezone-absolute-from-gregorian - (nth 1 tdate) (nth 2 tdate) (nth 0 tdate)) - (timezone-absolute-from-gregorian - (nth 1 edate) (nth 2 edate) (nth 0 edate))))) - (+ (nth 2 ttime) - (* (nth 1 ttime) 60) - (* (nth 0 ttime) 60 60) - (* tday 60 60 24)))) - -(defun url-match (s x) - ;; Return regexp match x in s. - (substring s (match-beginning x) (match-end x))) - -(defun url-split (str del) - ;; Split the string STR, with DEL (a regular expression) as the delimiter. - ;; Returns an assoc list that you can use with completing-read." - (let (x y) - (while (string-match del str) - (setq y (substring str 0 (match-beginning 0)) - str (substring str (match-end 0) nil)) - (if (not (string-match "^[ \t]+$" y)) - (setq x (cons (list y y) x)))) - (if (not (equal str "")) - (setq x (cons (list str str) x))) - x)) - -(defun url-replace-regexp (regexp to-string) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (replace-match to-string t nil))) - -(defun url-clear-tmp-buffer () - (set-buffer (get-buffer-create url-working-buffer)) - (if buffer-read-only (toggle-read-only)) - (erase-buffer)) - -(defun url-maybe-relative (url) - (url-retrieve (url-expand-file-name url))) - -(defun url-buffer-is-hypertext (&optional buff) - "Return t if a buffer contains HTML, as near as we can guess." - (setq buff (or buff (current-buffer))) - (save-excursion - (set-buffer buff) - (let ((case-fold-search t)) - (goto-char (point-min)) - (re-search-forward - "<\\(TITLE\\|HEAD\\|BASE\\|H[0-9]\\|ISINDEX\\|P\\)>" nil t)))) - -(defun url-percentage (x y) - (if (fboundp 'float) - (round (* 100 (/ x (float y)))) - (/ (* x 100) y))) - -(defun url-pretty-length (n) - (cond - ((< n 1024) - (format "%d bytes" n)) - ((< n (* 1024 1024)) - (format "%dk" (/ n 1024.0))) - (t - (format "%2.2fM" (/ n (* 1024 1024.0)))))) - -(defun url-after-change-function (&rest args) - ;; The nitty gritty details of messaging the HTTP/1.0 status messages - ;; in the minibuffer." - (or url-current-content-length - (save-excursion - (goto-char (point-min)) - (skip-chars-forward " \t\n") - (if (not (looking-at "HTTP/[0-9]\.[0-9]")) - (setq url-current-content-length 0) - (setq url-current-isindex - (and (re-search-forward "$\r*$" nil t) (point))) - (if (re-search-forward - "^content-type:[ \t]*\\([^\r\n]+\\)\r*$" - url-current-isindex t) - (setq url-current-mime-type (downcase - (url-eat-trailing-space - (buffer-substring - (match-beginning 1) - (match-end 1)))))) - (goto-char (point-min)) - (if (re-search-forward "^content-length:\\([^\r\n]+\\)\r*$" - url-current-isindex t) - (setq url-current-content-length - (string-to-int (buffer-substring (match-beginning 1) - (match-end 1)))) - (setq url-current-content-length nil)))) - ) - (let ((current-length (max (point-max) - (if url-current-isindex - (- (point-max) url-current-isindex) - (point-max))))) - (cond - ((and url-current-content-length (> url-current-content-length 1) - url-current-mime-type) - (url-lazy-message "Reading [%s]... %s of %s (%d%%)" - url-current-mime-type - (url-pretty-length current-length) - (url-pretty-length url-current-content-length) - (url-percentage current-length - url-current-content-length))) - ((and url-current-content-length (> url-current-content-length 1)) - (url-lazy-message "Reading... %s of %s (%d%%)" - (url-pretty-length current-length) - (url-pretty-length url-current-content-length) - (url-percentage current-length - url-current-content-length))) - ((and (/= 1 current-length) url-current-mime-type) - (url-lazy-message "Reading [%s]... %s" - url-current-mime-type - (url-pretty-length current-length))) - ((/= 1 current-length) - (url-lazy-message "Reading... %s." - (url-pretty-length current-length))) - (t (url-lazy-message "Waiting for response..."))))) - -(defun url-insert-entities-in-string (string) - "Convert HTML markup-start characters to entity references in STRING. - Also replaces the \" character, so that the result may be safely used as - an attribute value in a tag. Returns a new string with the result of the - conversion. Replaces these characters as follows: - & ==> &amp; - < ==> &lt; - > ==> &gt; - \" ==> &quot;" - (if (string-match "[&<>\"]" string) - (save-excursion - (set-buffer (get-buffer-create " *entity*")) - (erase-buffer) - (buffer-disable-undo (current-buffer)) - (insert string) - (goto-char (point-min)) - (while (progn - (skip-chars-forward "^&<>\"") - (not (eobp))) - (insert (cdr (assq (char-after (point)) - '((?\" . "&quot;") - (?& . "&amp;") - (?< . "&lt;") - (?> . "&gt;"))))) - (delete-char 1)) - (buffer-string)) - string)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Information information -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar url-process-lookup-table nil) - -(defun url-process-get (proc prop &optional default) - "Get a value associated to PROC as property PROP - in plist stored in `url-process-lookup-table'" - (or (plist-get (cdr-safe (assq proc url-process-lookup-table)) prop) - default)) - -(defun url-process-put (proc prop val) - "Associate to PROC as property PROP the value VAL - in plist stored in `url-process-lookup-table'" - (let ((node (assq proc url-process-lookup-table))) - (if (not node) - (setq url-process-lookup-table (cons (cons proc (list prop val)) - url-process-lookup-table)) - (setcdr node (plist-put (cdr node) prop val))))) - -(defun url-gc-process-lookup-table () - (let (new) - (while url-process-lookup-table - (if (not (memq (process-status (caar url-process-lookup-table)) - '(stop closed nil))) - (setq new (cons (car url-process-lookup-table) new))) - (setq url-process-lookup-table (cdr url-process-lookup-table))) - (setq url-process-lookup-table new))) - -(defun url-process-list () - (url-gc-process-lookup-table) - (let ((processes (process-list)) - (retval nil)) - (while processes - (if (url-process-get (car processes) 'url) - (setq retval (cons (car processes) retval))) - (setq processes (cdr processes))) - retval)) - -(defun url-list-processes () - (interactive) - (let ((processes (url-process-list)) - proc total-len len type url - (url-status-buf (get-buffer-create "URL Status Display"))) - (set-buffer url-status-buf) - (erase-buffer) - (display-buffer url-status-buf) - (insert - (eval-when-compile (format "%-40s %-20s %-15s" "URL" "Size" "Type")) "\n" - (eval-when-compile (make-string 77 ?-)) "\n") - (while processes - (setq proc (car processes) - processes (cdr processes)) - (save-excursion - (set-buffer (process-buffer proc)) - (setq total-len url-current-content-length - len (max (point-max) - (if url-current-isindex - (- (point-max) url-current-isindex) - (point-max))) - type url-current-mime-type - url (url-process-get proc 'url)) - (set-buffer url-status-buf) - (insert - (format "%-40s%s%-20s %-15s\n" - (url-process-get proc 'url) - (if (> (length url) 40) - (format "\n%-40s " " ") - " ") - (if total-len - (format "%d of %d" len total-len) - (format "%d" len)) - (or type "unknown"))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; file-name-handler stuff calls this -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun url-have-visited-url (url &rest args) - "Return non-nil iff the user has visited URL before. -The return value is a cons of the url and the date last accessed as a string" - (cl-gethash url url-global-history-hash-table)) - -(defun url-directory-files (url &rest args) - "Return a list of files on a server." - nil) - -(defun url-file-writable-p (url &rest args) - "Return t iff a url is writable by this user" - nil) - -(defun url-copy-file (url &rest args) - "Copy a url to the specified filename." - nil) - -(defun url-file-directly-accessible-p (url) - "Returns t iff the specified URL is directly accessible -on your filesystem. (nfs, local file, etc)." - (let* ((urlobj (if (vectorp url) url (url-generic-parse-url url))) - (type (url-type urlobj))) - (and (member type '("file" "ftp")) - (not (url-host urlobj))))) - -;;;###autoload -(defun url-file-attributes (url &rest args) - "Return a list of attributes of URL. -Value is nil if specified file cannot be opened. -Otherwise, list elements are: - 0. t for directory, string (name linked to) for symbolic link, or nil. - 1. Number of links to file. - 2. File uid. - 3. File gid. - 4. Last access time, as a list of two integers. - First integer has high-order 16 bits of time, second has low 16 bits. - 5. Last modification time, likewise. - 6. Last status change time, likewise. - 7. Size in bytes. (-1, if number is out of range). - 8. File modes, as a string of ten letters or dashes as in ls -l. - If URL is on an http server, this will return the content-type if possible. - 9. t iff file's gid would change if file were deleted and recreated. -10. inode number. -11. Device number. - -If file does not exist, returns nil." - (and url - (let* ((urlobj (url-generic-parse-url url)) - (type (url-type urlobj)) - (url-automatic-caching nil) - (data nil) - (exists nil)) - (cond - ((equal type "http") - (cond - ((not url-be-anal-about-file-attributes) - (setq data (list - (url-file-directory-p url) ; Directory - 1 ; number of links to it - 0 ; UID - 0 ; GID - (cons 0 0) ; Last access time - (cons 0 0) ; Last mod. time - (cons 0 0) ; Last status time - -1 ; file size - (mm-extension-to-mime - (url-file-extension (url-filename urlobj))) - nil ; gid would change - 0 ; inode number - 0 ; device number - ))) - (t ; HTTP/1.0, use HEAD - (let ((url-request-method "HEAD") - (url-request-data nil) - (url-working-buffer " *url-temp*")) - (save-excursion - (condition-case () - (progn - (url-retrieve url) - (setq data (and - (setq exists - (cdr - (assoc "status" - url-current-mime-headers))) - (>= exists 200) - (< exists 300) - (list - (url-file-directory-p url) ; Directory - 1 ; links to - 0 ; UID - 0 ; GID - (cons 0 0) ; Last access time - (cons 0 0) ; Last mod. time - (cons 0 0) ; Last status time - (or ; Size in bytes - (cdr (assoc "content-length" - url-current-mime-headers)) - -1) - (or - (cdr (assoc "content-type" - url-current-mime-headers)) - (mm-extension-to-mime - (url-file-extension - (url-filename urlobj)))) ; content-type - nil ; gid would change - 0 ; inode number - 0 ; device number - )))) - (error nil)) - (and (not data) - (setq data (list (url-file-directory-p url) - 1 0 0 (cons 0 0) (cons 0 0) (cons 0 0) - -1 (mm-extension-to-mime - (url-file-extension - (url-filename - url-current-object))) - nil 0 0))) - (kill-buffer " *url-temp*")))))) - ((member type '("ftp" "file")) - (let ((fname (if (url-host urlobj) - (concat "/" - (if (url-user urlobj) - (concat (url-user urlobj) "@") - "") - (url-host urlobj) ":" - (url-filename urlobj)) - (url-filename urlobj)))) - (setq data (or (file-attributes fname) (make-list 12 nil))) - (setcar (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr data)))))))) - (mm-extension-to-mime (url-file-extension fname))))) - (t nil)) - data))) - -(defun url-file-name-all-completions (file dirname &rest args) - "Return a list of all completions of file name FILE in directory DIR. -These are all file names in directory DIR which begin with FILE." - ;; need to rewrite - ) - -(defun url-file-name-completion (file dirname &rest args) - "Complete file name FILE in directory DIR. -Returns the longest string -common to all filenames in DIR that start with FILE. -If there is only one and FILE matches it exactly, returns t. -Returns nil if DIR contains no name starting with FILE." - (apply 'url-file-name-all-completions file dirname args)) - -(defun url-file-local-copy (file &rest args) - "Copy the file FILE into a temporary file on this machine. -Returns the name of the local copy, or nil, if FILE is directly -accessible." - nil) - -(defun url-insert-file-contents (url &rest args) - "Insert the contents of the URL in this buffer." - (interactive "sURL: ") - (save-excursion - (let ((old-asynch url-be-asynchronous)) - (setq-default url-be-asynchronous nil) - (let ((buf (current-buffer)) - (url-working-buffer (cdr (url-retrieve url)))) - (setq-default url-be-asynchronous old-asynch) - (set-buffer url-working-buffer) - (url-uncompress) - (set-buffer buf) - (insert-buffer url-working-buffer) - (setq buffer-file-name url) - (save-excursion - (set-buffer url-working-buffer) - (set-buffer-modified-p nil)) - (kill-buffer url-working-buffer))))) - -(defun url-file-directory-p (url &rest args) - "Return t iff a url points to a directory" - (equal (substring url -1 nil) "/")) - -(defun url-file-exists (url &rest args) - "Return t iff a file exists." - (let* ((urlobj (url-generic-parse-url url)) - (type (url-type urlobj)) - (exists nil)) - (cond - ((equal type "http") ; use head - (let ((url-request-method "HEAD") - (url-request-data nil) - (url-working-buffer " *url-temp*")) - (save-excursion - (url-retrieve url) - (setq exists (or (cdr - (assoc "status" url-current-mime-headers)) 500)) - (kill-buffer " *url-temp*") - (setq exists (and (>= exists 200) (< exists 300)))))) - ((member type '("ftp" "file")) ; file-attributes - (let ((fname (if (url-host urlobj) - (concat "/" - (if (url-user urlobj) - (concat (url-user urlobj) "@") - "") - (url-host urlobj) ":" - (url-filename urlobj)) - (url-filename urlobj)))) - (setq exists (file-exists-p fname)))) - (t nil)) - exists)) - -;;;###autoload -(defun url-normalize-url (url) - "Return a 'normalized' version of URL. This strips out default port -numbers, etc." - (let (type data grok retval) - (setq data (url-generic-parse-url url) - type (url-type data)) - (if (member type '("www" "about" "mailto" "mailserver" "info")) - (setq retval url) - (url-set-target data nil) - (setq retval (url-recreate-url data))) - retval)) - -;;;###autoload -(defun url-buffer-visiting (url) - "Return the name of a buffer (if any) that is visiting URL." - (setq url (url-normalize-url url)) - (let ((bufs (buffer-list)) - (found nil)) - (while (and bufs (not found)) - (save-excursion - (set-buffer (car bufs)) - (setq found (if (and - (not (string-match " \\*URL-?[0-9]*\\*" (buffer-name (car bufs)))) - (memq major-mode '(url-mode w3-mode)) - (equal (url-normalize-url (url-view-url t)) url)) - (car bufs) nil) - bufs (cdr bufs)))) - found)) - -(defun url-file-size (url &rest args) - "Return the size of a file in bytes, or -1 if can't be determined." - (let* ((urlobj (url-generic-parse-url url)) - (type (url-type urlobj)) - (size -1) - (data nil)) - (cond - ((equal type "http") ; use head - (let ((url-request-method "HEAD") - (url-request-data nil) - (url-working-buffer " *url-temp*")) - (save-excursion - (url-retrieve url) - (setq size (or (cdr - (assoc "content-length" url-current-mime-headers)) - -1)) - (kill-buffer " *url-temp*")))) - ((member type '("ftp" "file")) ; file-attributes - (let ((fname (if (url-host urlobj) - (concat "/" - (if (url-user urlobj) - (concat (url-user urlobj) "@") - "") - (url-host urlobj) ":" - (url-filename urlobj)) - (url-filename urlobj)))) - (setq data (file-attributes fname) - size (nth 7 data)))) - (t nil)) - (cond - ((stringp size) (string-to-int size)) - ((integerp size) size) - ((null size) -1) - (t -1)))) - -(defun url-generate-new-buffer-name (start) - "Create a new buffer name based on START." - (let ((x 1) - name) - (if (not (get-buffer start)) - start - (progn - (setq name (format "%s<%d>" start x)) - (while (get-buffer name) - (setq x (1+ x) - name (format "%s<%d>" start x))) - name)))) - -(defun url-generate-unique-filename (&optional fmt) - "Generate a unique filename in url-temporary-directory" - (if (not fmt) - (let ((base (format "url-tmp.%d" (user-real-uid))) - (fname "") - (x 0)) - (setq fname (format "%s%d" base x)) - (while (file-exists-p (expand-file-name fname url-temporary-directory)) - (setq x (1+ x) - fname (concat base (int-to-string x)))) - (expand-file-name fname url-temporary-directory)) - (let ((base (concat "url" (int-to-string (user-real-uid)))) - (fname "") - (x 0)) - (setq fname (format fmt (concat base (int-to-string x)))) - (while (file-exists-p (expand-file-name fname url-temporary-directory)) - (setq x (1+ x) - fname (format fmt (concat base (int-to-string x))))) - (expand-file-name fname url-temporary-directory)))) - -(defun url-lazy-message (&rest args) - "Just like `message', but is a no-op if called more than once a second. -Will not do anything if url-show-status is nil." - (if (or (null url-show-status) - (= url-lazy-message-time - (setq url-lazy-message-time (nth 1 (current-time))))) - nil - (apply 'message args))) - - -(defun url-kill-process (proc) - "Kill the process PROC - knows about all the various gateway types, -and acts accordingly." - (delete-process proc)) - -(defun url-accept-process-output (proc) - "Allow any pending output from subprocesses to be read by Emacs. -It is read into the process' buffers or given to their filter functions. -Where possible, this will not exit until some output is received from PROC, -or 1 second has elapsed." - (accept-process-output proc 1)) - -(defun url-process-status (proc) - "Return the process status of a url buffer" - (process-status proc)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Miscellaneous functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun url-setup-privacy-info () - (interactive) - (setq url-system-type - (cond - ((or (eq url-privacy-level 'paranoid) - (and (listp url-privacy-level) - (memq 'os url-privacy-level))) - nil) - ;; First, we handle the inseparable OS/Windowing system - ;; combinations - ((eq system-type 'Apple-Macintosh) "Macintosh") - ((eq system-type 'next-mach) "NeXT") - ((eq system-type 'windows-nt) "Windows-NT; 32bit") - ((eq system-type 'ms-windows) "Windows; 16bit") - ((eq system-type 'ms-dos) "MS-DOS; 32bit") - ((memq (device-type) '(win32 w32)) "Windows; 32bit") - ((eq (device-type) 'pm) "OS/2; 32bit") - (t - (case (device-type) - (x "X11") - (ns "OpenStep") - (tty "TTY") - (otherwise nil))))) - - (setq url-personal-mail-address (or url-personal-mail-address - user-mail-address - (format "%s@%s" (user-real-login-name) - (system-name)))) - - (if (or (memq url-privacy-level '(paranoid high)) - (and (listp url-privacy-level) - (memq 'email url-privacy-level))) - (setq url-personal-mail-address nil)) - - (setq url-os-type - (cond - ((or (eq url-privacy-level 'paranoid) - (and (listp url-privacy-level) - (memq 'os url-privacy-level))) - nil) - ((boundp 'system-configuration) - system-configuration) - ((boundp 'system-type) - (symbol-name system-type)) - (t nil)))) - -(defun url-handle-no-scheme (url) - (let ((temp url-registered-protocols) - (found nil)) - (while (and temp (not found)) - (if (and (not (member (car (car temp)) '("auto" "www"))) - (string-match (concat "^" (car (car temp)) "\\.") - url)) - (setq found t) - (setq temp (cdr temp)))) - (cond - (found ; Found something like ftp.spry.com - (url-retrieve (concat (car (car temp)) "://" url))) - ((string-match "^www\\." url) - (url-retrieve (concat "http://" url))) - ((string-match "\\(\\.[^\\.]+\\)\\(\\.[^\\.]+\\)" url) - ;; Ok, we have at least two dots in the filename, just stick http on it - (url-retrieve (concat "http://" url))) - ((setq temp (run-hook-with-args-until-success - 'url-handle-no-scheme-hook url)) - (url-retrieve temp)) - (t - (url-retrieve (concat "http://www." url ".com")))))) - -(defun url-setup-save-timer () - "Reset the history list timer." - (interactive) - (cond - ((featurep 'itimer) - (if (get-itimer "url-history-saver") - (delete-itimer (get-itimer "url-history-saver"))) - (start-itimer "url-history-saver" 'url-write-global-history - url-global-history-save-interval - url-global-history-save-interval)) - ((fboundp 'run-at-time) - (run-at-time url-global-history-save-interval - url-global-history-save-interval - 'url-write-global-history)) - (t nil))) - -(defvar url-download-minor-mode nil) - -(defun url-download-minor-mode (on) - (setq url-download-minor-mode (if on - (1+ (or url-download-minor-mode 0)) - (1- (or url-download-minor-mode 1)))) - (if (<= url-download-minor-mode 0) - (setq url-download-minor-mode nil))) - -(defun url-do-setup () - "Do setup - this is to avoid conflict with user settings when URL is -dumped with emacs." - (if url-setup-done - nil - - (add-minor-mode 'url-download-minor-mode " Webbing" nil) - - ;; Make OS/2 happy - (setq tcp-binary-process-input-services - (append '("http" "80") - tcp-binary-process-input-services)) - - ;; Register all the protocols we can handle - (url-register-protocol 'file) - (url-register-protocol 'ftp nil nil "21") - (url-register-protocol 'gopher nil nil "70") - (url-register-protocol 'http nil nil "80") - (url-register-protocol 'https nil nil "443") - (url-register-protocol 'nfs nil nil "2049") - (url-register-protocol 'info nil 'url-identity-expander) - (url-register-protocol 'mailserver nil 'url-identity-expander) - (url-register-protocol 'finger nil 'url-identity-expander "79") - (url-register-protocol 'mailto nil 'url-identity-expander) - (url-register-protocol 'news nil 'url-identity-expander "119") - (url-register-protocol 'nntp nil 'url-identity-expander "119") - (url-register-protocol 'irc nil 'url-identity-expander "6667") - (url-register-protocol 'data nil 'url-identity-expander) - (url-register-protocol 'netrek nil 'url-identity-expander) - (url-register-protocol 'rlogin) - (url-register-protocol 'telnet) - (url-register-protocol 'tn3270) - (url-register-protocol 'proxy) - (url-register-protocol 'auto 'url-handle-no-scheme) - - ;; Register all the authentication schemes we can handle - (url-register-auth-scheme "basic" nil 4) - (url-register-auth-scheme "digest" nil 7) - - ;; Filename handler stuff for emacsen that support it - (url-setup-file-name-handlers) - - (setq url-cookie-file - (or url-cookie-file - (expand-file-name "~/.w3/cookies"))) - - (setq url-global-history-file - (or url-global-history-file - (and (memq system-type '(ms-dos ms-windows)) - (expand-file-name "~/mosaic.hst")) - (and (memq system-type '(axp-vms vax-vms)) - (expand-file-name "~/mosaic.global-history")) - (condition-case () - (expand-file-name "~/.w3/history") - (error nil)))) - - ;; Parse the global history file if it exists, so that it can be used - ;; for URL completion, etc. - (if (and url-global-history-file - (file-exists-p url-global-history-file)) - (url-parse-global-history)) - - ;; Setup save timer - (and url-global-history-save-interval (url-setup-save-timer)) - - (if (and url-cookie-file - (file-exists-p url-cookie-file)) - (url-cookie-parse-file url-cookie-file)) - - ;; Read in proxy gateways - (let ((noproxy (and (not (assoc "no_proxy" url-proxy-services)) - (or (getenv "NO_PROXY") - (getenv "no_PROXY") - (getenv "no_proxy"))))) - (if noproxy - (setq url-proxy-services - (cons (cons "no_proxy" - (concat "\\(" - (mapconcat - (function - (lambda (x) - (cond - ((= x ?,) "\\|") - ((= x ? ) "") - ((= x ?.) (regexp-quote ".")) - ((= x ?*) ".*") - ((= x ??) ".") - (t (char-to-string x))))) - noproxy "") "\\)")) - url-proxy-services)))) - - ;; Set the password entry funtion based on user defaults or guess - ;; based on which remote-file-access package they are using. - (cond - (url-passwd-entry-func nil) ; Already been set - ((fboundp 'read-passwd) ; Use secure password if available - (setq url-passwd-entry-func 'read-passwd)) - ((or (featurep 'efs) ; Using EFS - (featurep 'efs-auto)) ; or autoloading efs - (if (not (fboundp 'read-passwd)) - (autoload 'read-passwd "passwd" "Read in a password" nil)) - (setq url-passwd-entry-func 'read-passwd)) - ((or (featurep 'ange-ftp) ; Using ange-ftp - (and (boundp 'file-name-handler-alist) - (not (string-match "Lucid" (emacs-version))))) - (setq url-passwd-entry-func 'ange-ftp-read-passwd)) - (t - (url-warn - 'security - "(url-setup): Can't determine how to read passwords, winging it."))) - - ;; Set up the news service if they haven't done so - (setq url-news-server - (cond - (url-news-server url-news-server) - ((and (boundp 'gnus-default-nntp-server) - (not (equal "" gnus-default-nntp-server))) - gnus-default-nntp-server) - ((and (boundp 'gnus-nntp-server) - (not (null gnus-nntp-server)) - (not (equal "" gnus-nntp-server))) - gnus-nntp-server) - ((and (boundp 'nntp-server-name) - (not (null nntp-server-name)) - (not (equal "" nntp-server-name))) - nntp-server-name) - ((getenv "NNTPSERVER") (getenv "NNTPSERVER")) - (t "news"))) - - ;; Set up the MIME accept string if they haven't got it hardcoded yet - (or url-mime-accept-string - (setq url-mime-accept-string (url-parse-viewer-types))) - (or url-mime-encoding-string - (setq url-mime-encoding-string - (mapconcat 'car - mm-content-transfer-encodings - ", "))) - - (url-setup-privacy-info) - (run-hooks 'url-load-hook) - (setq url-setup-done t))) - -(defvar url-get-url-filename-chars "-%.?@a-zA-Z0-9()_/:~=&" - "Valid characters in a URL") - -;;;###autoload -(defun url-get-url-at-point (&optional pt) - "Get the URL closest to point, but don't change your -position. Has a preference for looking backward when not -directly on a symbol." - ;; Not at all perfect - point must be right in the name. - (save-excursion - (if pt (goto-char pt)) - (let (start url) - (save-excursion - ;; first see if you're just past a filename - (if (not (eobp)) - (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens - (progn - (skip-chars-backward " \n\t\r({[]})") - (if (not (bobp)) - (backward-char 1))))) - (if (and (char-after (point)) - (string-match (eval-when-compile - (concat "[" url-get-url-filename-chars "]")) - (char-to-string (char-after (point))))) - (progn - (skip-chars-backward url-get-url-filename-chars) - (setq start (point)) - (skip-chars-forward url-get-url-filename-chars)) - (setq start (point))) - (setq url (buffer-substring-no-properties start (point)))) - (if (string-match "^URL:" url) - (setq url (substring url 4 nil))) - (if (string-match "\\.$" url) - (setq url (substring url 0 -1))) - (if (string-match "^www\\." url) - (setq url (concat "http://" url))) - (if (not (string-match url-nonrelative-link url)) - (setq url nil)) - url))) - -(defun url-eat-trailing-space (x) - ;; Remove spaces/tabs at the end of a string - (let ((y (1- (length x))) - (skip-chars (list ? ?\t ?\n))) - (while (and (>= y 0) (memq (aref x y) skip-chars)) - (setq y (1- y))) - (substring x 0 (1+ y)))) - -(defun url-strip-leading-spaces (x) - ;; Remove spaces at the front of a string - (let ((y (1- (length x))) - (z 0) - (skip-chars (list ? ?\t ?\n))) - (while (and (<= z y) (memq (aref x z) skip-chars)) - (setq z (1+ z))) - (substring x z nil))) - -(defun url-convert-newlines-to-spaces (x) - "Convert newlines and carriage returns embedded in a string into spaces, -and swallow following whitespace. -The argument is not side-effected, but may be returned by this function." - (if (string-match "[\n\r]+\\s-*" x) ; [\\n\\r\\t ] - (concat (substring x 0 (match-beginning 0)) " " - (url-convert-newlines-to-spaces - (substring x (match-end 0)))) - x)) - -;; Test cases -;; (url-convert-newlines-to-spaces "foo bar") ; nothing happens -;; (url-convert-newlines-to-spaces "foo\n \t bar") ; whitespace converted -;; -;; This implementation doesn't mangle the match-data, is fast, and doesn't -;; create garbage, but it leaves whitespace. -;; (defun url-convert-newlines-to-spaces (x) -;; "Convert newlines and carriage returns embedded in a string into spaces. -;; The string is side-effected, then returned." -;; (let ((i 0) -;; (limit (length x))) -;; (while (< i limit) -;; (if (or (= ?\n (aref x i)) -;; (= ?\r (aref x i))) -;; (aset x i ? )) -;; (setq i (1+ i))) -;; x)) - -(defun url-expand-file-name (url &optional default) - "Convert URL to a fully specified URL, and canonicalize it. -Second arg DEFAULT is a URL to start with if URL is relative. -If DEFAULT is nil or missing, the current buffer's URL is used. -Path components that are `.' are removed, and -path components followed by `..' are removed, along with the `..' itself." - (if url - (setq url (mapconcat (function (lambda (x) - (if (memq x '(? ?\n ?\r)) - "" - (char-to-string x)))) - (url-strip-leading-spaces - (url-eat-trailing-space url)) ""))) - (cond - ((null url) nil) ; Something hosed! Be graceful - ((string-match "^#" url) ; Offset link, use it raw - url) - (t - (let* ((urlobj (url-generic-parse-url url)) - (inhibit-file-name-handlers t) - (defobj (cond - ((vectorp default) default) - (default (url-generic-parse-url default)) - (url-current-object url-current-object) - (t (url-generic-parse-url (url-view-url t))))) - (expander (cdr-safe - (cdr-safe - (assoc (or (url-type urlobj) - (url-type defobj)) - url-registered-protocols))))) - (if (string-match "^//" url) - (setq urlobj (url-generic-parse-url (concat (url-type defobj) ":" - url)))) - (if (fboundp expander) - (funcall expander urlobj defobj) - (message "Unknown URL scheme: %s" (or (url-type urlobj) - (url-type defobj))) - (url-identity-expander urlobj defobj)) - (url-recreate-url urlobj))))) - -(defun url-default-expander (urlobj defobj) - ;; The default expansion routine - urlobj is modified by side effect! - (url-set-type urlobj (or (url-type urlobj) (url-type defobj))) - (url-set-port urlobj (or (url-port urlobj) - (and (string= (url-type urlobj) - (url-type defobj)) - (url-port defobj)))) - (if (not (string= "file" (url-type urlobj))) - (url-set-host urlobj (or (url-host urlobj) (url-host defobj)))) - (if (string= "ftp" (url-type urlobj)) - (url-set-user urlobj (or (url-user urlobj) (url-user defobj)))) - (if (string= (url-filename urlobj) "") - (url-set-filename urlobj "/")) - (if (string-match "^/" (url-filename urlobj)) - nil - (url-set-filename urlobj - (url-remove-relative-links - (concat (url-basepath (url-filename defobj)) - (url-filename urlobj)))))) - -(defun url-identity-expander (urlobj defobj) - (url-set-type urlobj (or (url-type urlobj) (url-type defobj)))) - -(defconst url-unreserved-chars - '( - ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z - ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z - ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 - ?$ ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\) ?,) - "A list of characters that are _NOT_ reserve in the URL spec. -This is taken from draft-fielding-url-syntax-02.txt - check your local -internet drafts directory for a copy.") - -(defun url-hexify-string (str) - "Escape characters in a string" - (mapconcat - (function - (lambda (char) - (if (not (memq char url-unreserved-chars)) - (if (< char 16) - (upcase (format "%%0%x" char)) - (upcase (format "%%%x" char))) - (char-to-string char)))) - (mule-decode-string str) "")) - -(defun url-make-sequence (start end) - "Make a sequence (list) of numbers from START to END" - (cond - ((= start end) '()) - ((> start end) '()) - (t - (let ((sqnc '())) - (while (<= start end) - (setq sqnc (cons end sqnc) - end (1- end))) - sqnc)))) - -(defun url-file-extension (fname &optional x) - "Return the filename extension of FNAME. If optional variable X is t, -then return the basename of the file with the extension stripped off." - (if (and fname (string-match "\\.[^./]+$" fname)) - (if x (substring fname 0 (match-beginning 0)) - (substring fname (match-beginning 0) nil)) - ;; - ;; If fname has no extension, and x then return fname itself instead of - ;; nothing. When caching it allows the correct .hdr file to be produced - ;; for filenames without extension. - ;; - (if x - fname - ""))) - -(defun url-basepath (file &optional x) - "Return the base pathname of FILE, or the actual filename if X is true" - (cond - ((null file) "") - (x (file-name-nondirectory file)) - (t (file-name-directory file)))) - -(defun url-parse-query-string (query &optional downcase) - (let (retval pairs cur key val) - (setq pairs (split-string query "&")) - (while pairs - (setq cur (car pairs) - pairs (cdr pairs)) - (if (not (string-match "=" cur)) - nil ; Grace - (setq key (url-unhex-string (substring cur 0 (match-beginning 0))) - val (url-unhex-string (substring cur (match-end 0) nil))) - (if downcase - (setq key (downcase key))) - (setq cur (assoc key retval)) - (if cur - (setcdr cur (cons val (cdr cur))) - (setq retval (cons (list key val) retval))))) - retval)) - -(defun url-unhex (x) - (if (> x ?9) - (if (>= x ?a) - (+ 10 (- x ?a)) - (+ 10 (- x ?A))) - (- x ?0))) - -(defun url-unhex-string (str &optional allow-newlines) - "Remove %XXX embedded spaces, etc in a url. -If optional second argument ALLOW-NEWLINES is non-nil, then allow the -decoding of carriage returns and line feeds in the string, which is normally -forbidden in URL encoding." - (setq str (or str "")) - (let ((tmp "") - (case-fold-search t)) - (while (string-match "%[0-9a-f][0-9a-f]" str) - (let* ((start (match-beginning 0)) - (ch1 (url-unhex (elt str (+ start 1)))) - (code (+ (* 16 ch1) - (url-unhex (elt str (+ start 2)))))) - (setq tmp (concat - tmp (substring str 0 start) - (cond - (allow-newlines - (char-to-string code)) - ((or (= code ?\n) (= code ?\r)) - " ") - (t (char-to-string code)))) - str (substring str (match-end 0))))) - (setq tmp (concat tmp str)) - tmp)) - -(defun url-remove-compressed-extensions (filename) - (while (assoc (url-file-extension filename) url-uncompressor-alist) - (setq filename (url-file-extension filename t))) - filename) - -(defun url-uncompress () - "Do any necessary uncompression on `url-working-buffer'" - (set-buffer url-working-buffer) - (if (not url-inhibit-uncompression) - (let* ((decoder nil) - (code-1 (cdr-safe - (assoc "content-transfer-encoding" - url-current-mime-headers))) - (code-2 (cdr-safe - (assoc "content-encoding" url-current-mime-headers))) - (done nil) - (default-process-coding-system - (cons mule-no-coding-system mule-no-coding-system))) - (mapcar - (function - (lambda (code) - (setq decoder (and (not (member code done)) - (cdr-safe - (assoc code mm-content-transfer-encodings))) - done (cons code done)) - (if (not decoder) - nil - (message "Decoding (%s)..." code) - (cond - ((stringp decoder) - (call-process-region (point-min) (point-max) decoder t t nil)) - ((listp decoder) - (apply 'call-process-region (point-min) (point-max) - (car decoder) t t nil (cdr decoder))) - ((and (symbolp decoder) (fboundp decoder)) - (funcall decoder (point-min) (point-max))) - (t - (error "Bad entry for %s in `mm-content-transfer-encodings'" - code))) - (message "Decoding (%s)... done." code)))) - (list code-1 code-2)))) - (set-buffer-modified-p nil)) - -(defun url-filter (proc string) - (save-excursion - (set-buffer url-working-buffer) - (insert string) - (if (string-match "\nConnection closed by" string) - (progn (set-process-filter proc nil) - (url-sentinel proc string)))) - string) - -(defun url-default-callback (buf) - (url-download-minor-mode nil) - (url-store-in-cache buf) - (cond - ((save-excursion (set-buffer buf) - (and url-current-callback-func - (fboundp url-current-callback-func))) - (save-excursion - (save-window-excursion - (set-buffer buf) - (cond - ((listp url-current-callback-data) - (apply url-current-callback-func - url-current-callback-data)) - (url-current-callback-data - (funcall url-current-callback-func - url-current-callback-data)) - (t - (funcall url-current-callback-func)))))) - ((and (fboundp 'w3-sentinel) (get-buffer buf)) - (w3-sentinel)) - (t - (message "Retrieval for %s complete." buf)))) - -(defun url-sentinel (proc string) - (let* ((buf (if (processp proc) (process-buffer proc) proc)) - (url-working-buffer (and buf (get-buffer buf))) - status) - (if (not url-working-buffer) - (url-warn 'url (format "Process %s completed with no buffer!" proc)) - (save-excursion - (set-buffer url-working-buffer) - (remove-hook 'after-change-functions 'url-after-change-function) - (if url-be-asynchronous - (progn - (widen) - (cond - ((and (null proc) (not url-working-buffer)) nil) - ((url-mime-response-p) - (setq status (url-parse-mime-headers)))) - (if (not url-current-mime-type) - (setq url-current-mime-type (or - (mm-extension-to-mime - (url-file-extension - (url-filename - url-current-object))) - "text/plain")))))) - (if (member status '(401 301 302 303 204)) - nil - (funcall url-default-retrieval-proc (buffer-name url-working-buffer))))) - ;; FSF Emacs doesn't do this after calling a process-sentinel - (set-buffer (window-buffer (selected-window)))) - -(defun url-remove-relative-links (name) - ;; Strip . and .. from pathnames - (let ((new (if (not (string-match "^/" name)) - (concat "/" name) - name))) - (while (string-match "/\\(\\./\\)" new) - (setq new (concat (substring new 0 (match-beginning 1)) - (substring new (match-end 1))))) - (while (string-match "/\\([^/]*/\\.\\./\\)" new) - (setq new (concat (substring new 0 (match-beginning 1)) - (substring new (match-end 1))))) - (while (string-match "^/\\.\\.\\(/\\)" new) - (setq new (substring new (match-beginning 1) nil))) - new)) - -(defun url-truncate-url-for-viewing (url &optional width) - "Return a shortened version of URL that is WIDTH characters or less wide. -WIDTH defaults to the current frame width." - (let* ((fr-width (or width (frame-width))) - (str-width (length url)) - (tail (file-name-nondirectory url)) - (fname nil) - (modified 0) - (urlobj nil)) - ;; The first thing that can go are the search strings - (if (and (>= str-width fr-width) - (string-match "?" url)) - (setq url (concat (substring url 0 (match-beginning 0)) "?...") - str-width (length url) - tail (file-name-nondirectory url))) - (if (< str-width fr-width) - nil ; Hey, we are done! - (setq urlobj (url-generic-parse-url url) - fname (url-filename urlobj) - fr-width (- fr-width 4)) - (while (and (>= str-width fr-width) - (string-match "/" fname)) - (setq fname (substring fname (match-end 0) nil) - modified (1+ modified)) - (url-set-filename urlobj fname) - (setq url (url-recreate-url urlobj) - str-width (length url))) - (if (> modified 1) - (setq fname (concat "/.../" fname)) - (setq fname (concat "/" fname))) - (url-set-filename urlobj fname) - (setq url (url-recreate-url urlobj))) - url)) - -(defun url-view-url (&optional no-show) - "View the current document's URL. Optional argument NO-SHOW means -just return the URL, don't show it in the minibuffer." - (interactive) - (if (not url-current-object) - nil - (if no-show - (url-recreate-url url-current-object) - (message "%s" (url-recreate-url url-current-object))))) - -(defun url-parse-Netscape-history (fname) - ;; Parse a Netscape/X style global history list. - (let (pos ; Position holder - url ; The URL - time) ; Last time accessed - (goto-char (point-min)) - (skip-chars-forward "^\n") - (skip-chars-forward "\n \t") ; Skip past the tag line - (setq url-global-history-hash-table (make-hash-table :size 131 - :test 'equal)) - ;; Here we will go to the end of the line and - ;; skip back over a token, since we might run - ;; into spaces in URLs, depending on how much - ;; smarter netscape is than the old XMosaic :) - (while (not (eobp)) - (setq pos (point)) - (end-of-line) - (skip-chars-backward "^ \t") - (skip-chars-backward " \t") - (setq url (buffer-substring pos (point)) - pos (1+ (point))) - (skip-chars-forward "^\n") - (setq time (buffer-substring pos (point))) - (skip-chars-forward "\n") - (setq url-history-changed-since-last-save t) - (cl-puthash url time url-global-history-hash-table)))) - -(defun url-parse-Mosaic-history-v1 (fname) - ;; Parse an NCSA Mosaic/X style global history list - (goto-char (point-min)) - (skip-chars-forward "^\n") - (skip-chars-forward "\n \t") ; Skip past the tag line - (skip-chars-forward "^\n") - (skip-chars-forward "\n \t") ; Skip past the second tag line - (setq url-global-history-hash-table (make-hash-table :size 131 - :test 'equal)) - (let (pos ; Temporary position holder - bol ; Beginning-of-line - url ; URL - time ; Time - last-end ; Last ending point - ) - (while (not (eobp)) - (setq bol (point)) - (end-of-line) - (setq pos (point) - last-end (point)) - (skip-chars-backward "^ \t" bol) ; Skip over year - (skip-chars-backward " \t" bol) - (skip-chars-backward "^ \t" bol) ; Skip over time - (skip-chars-backward " \t" bol) - (skip-chars-backward "^ \t" bol) ; Skip over day # - (skip-chars-backward " \t" bol) - (skip-chars-backward "^ \t" bol) ; Skip over month - (skip-chars-backward " \t" bol) - (skip-chars-backward "^ \t" bol) ; Skip over day abbrev. - (if (bolp) - nil ; Malformed entry!!! Ack! Bailout! - (setq time (buffer-substring pos (point))) - (skip-chars-backward " \t") - (setq pos (point))) - (beginning-of-line) - (setq url (buffer-substring (point) pos)) - (goto-char (min (1+ last-end) (point-max))) ; Goto next line - (if (/= (length url) 0) - (progn - (setq url-history-changed-since-last-save t) - (cl-puthash url time url-global-history-hash-table)))))) - -(defun url-parse-Mosaic-history-v2 (fname) - ;; Parse an NCSA Mosaic/X style global history list (version 2) - (goto-char (point-min)) - (skip-chars-forward "^\n") - (skip-chars-forward "\n \t") ; Skip past the tag line - (skip-chars-forward "^\n") - (skip-chars-forward "\n \t") ; Skip past the second tag line - (setq url-global-history-hash-table (make-hash-table :size 131 - :test 'equal)) - (let (pos ; Temporary position holder - bol ; Beginning-of-line - url ; URL - time ; Time - last-end ; Last ending point - ) - (while (not (eobp)) - (setq bol (point)) - (end-of-line) - (setq pos (point) - last-end (point)) - (skip-chars-backward "^ \t" bol) ; Skip over time - (if (bolp) - nil ; Malformed entry!!! Ack! Bailout! - (setq time (buffer-substring pos (point))) - (skip-chars-backward " \t") - (setq pos (point))) - (beginning-of-line) - (setq url (buffer-substring (point) pos)) - (goto-char (min (1+ last-end) (point-max))) ; Goto next line - (if (/= (length url) 0) - (progn - (setq url-history-changed-since-last-save t) - (cl-puthash url time url-global-history-hash-table)))))) - -(defun url-parse-Emacs-history (&optional fname) - ;; Parse out the Emacs-w3 global history file for completion, etc. - (or fname (setq fname (expand-file-name url-global-history-file))) - (cond - ((not (file-exists-p fname)) - (message "%s does not exist." fname)) - ((not (file-readable-p fname)) - (message "%s is unreadable." fname)) - (t - (condition-case () - (load fname nil t) - (error (message "Could not load %s" fname))) - (if (boundp 'url-global-history-completion-list) - ;; Hey! Automatic conversion of old format! - (progn - (setq url-global-history-hash-table (make-hash-table :size 131 - :test 'equal) - url-history-changed-since-last-save t) - (mapcar (function - (lambda (x) - (cl-puthash (car x) (cdr x) - url-global-history-hash-table))) - (symbol-value 'url-global-history-completion-list))))))) - -(defun url-parse-global-history (&optional fname) - ;; Parse out the mosaic global history file for completions, etc. - (or fname (setq fname (expand-file-name url-global-history-file))) - (cond - ((not (file-exists-p fname)) - (message "%s does not exist." fname)) - ((not (file-readable-p fname)) - (message "%s is unreadable." fname)) - (t - (save-excursion - (set-buffer (get-buffer-create " *url-tmp*")) - (erase-buffer) - (insert-file-contents-literally fname) - (goto-char (point-min)) - (cond - ((looking-at "(setq") (url-parse-Emacs-history fname)) - ((looking-at "ncsa-mosaic-.*-1$") (url-parse-Mosaic-history-v1 fname)) - ((looking-at "ncsa-mosaic-.*-2$") (url-parse-Mosaic-history-v2 fname)) - ((or (looking-at "MCOM-") (looking-at "netscape")) - (url-parse-Netscape-history fname)) - (t - (url-warn 'url (format "Cannot deduce type of history file: %s" - fname)))))))) - -(defun url-write-Emacs-history (fname) - ;; Write an Emacs-w3 style global history list into FNAME - (erase-buffer) - (let ((count 0)) - (cl-maphash (function - (lambda (key value) - (while (string-match "[\r\n]+" key) - (setq key (concat (substring key 0 (match-beginning 0)) - (substring key (match-end 0) nil)))) - (setq count (1+ count)) - (insert "(cl-puthash \"" key "\"" - (if (not (stringp value)) " '" "") - (prin1-to-string value) - " url-global-history-hash-table)\n"))) - url-global-history-hash-table) - (goto-char (point-min)) - (insert (format - "(setq url-global-history-hash-table (make-hash-table :size %d :test 'equal))\n" - (/ count 4))) - (goto-char (point-max)) - (insert "\n") - (write-file fname))) - -(defun url-write-Netscape-history (fname) - ;; Write a Netscape-style global history list into FNAME - (erase-buffer) - (let ((last-valid-time "785305714")) ; Picked out of thin air, - ; in case first in assoc list - ; doesn't have a valid time - (goto-char (point-min)) - (insert "MCOM-Global-history-file-1\n") - (cl-maphash (function - (lambda (url time) - (if (or (not (stringp time)) (string-match " \t" time)) - (setq time last-valid-time) - (setq last-valid-time time)) - (insert url " " time "\n"))) - url-global-history-hash-table) - (write-file fname))) - -(defun url-write-Mosaic-history-v1 (fname) - ;; Write a Mosaic/X-style global history list into FNAME - (erase-buffer) - (goto-char (point-min)) - (insert "ncsa-mosaic-history-format-1\nGlobal\n") - (cl-maphash (function - (lambda (url time) - (if (listp time) - (setq time (current-time-string time))) - (if (or (not (stringp time)) - (not (string-match " " time))) - (setq time (current-time-string))) - (insert url " " time "\n"))) - url-global-history-hash-table) - (write-file fname)) - -(defun url-write-Mosaic-history-v2 (fname) - ;; Write a Mosaic/X-style global history list into FNAME - (let ((last-valid-time "827250806")) - (erase-buffer) - (goto-char (point-min)) - (insert "ncsa-mosaic-history-format-2\nGlobal\n") - (cl-maphash (function - (lambda (url time) - (if (listp time) - (setq time last-valid-time) - (setq last-valid-time time)) - (if (not (stringp time)) - (setq time last-valid-time)) - (insert url " " time "\n"))) - url-global-history-hash-table) - (write-file fname))) - -(defun url-write-global-history (&optional fname) - "Write the global history file into `url-global-history-file'. -The type of data written is determined by what is in the file to begin -with. If the type of storage cannot be determined, then prompt the -user for what type to save as." - (interactive) - (or fname (setq fname (expand-file-name url-global-history-file))) - (cond - ((not url-history-changed-since-last-save) nil) - ((not (file-writable-p fname)) - (message "%s is unwritable." fname)) - (t - (let ((make-backup-files nil) - (version-control nil) - (require-final-newline t)) - (save-excursion - (set-buffer (get-buffer-create " *url-tmp*")) - (erase-buffer) - (condition-case () - (insert-file-contents-literally fname) - (error nil)) - (goto-char (point-min)) - (cond - ((looking-at "ncsa-mosaic-.*-1$") (url-write-Mosaic-history-v1 fname)) - ((looking-at "ncsa-mosaic-.*-2$") (url-write-Mosaic-history-v2 fname)) - ((looking-at "MCOM-") (url-write-Netscape-history fname)) - ((looking-at "netscape") (url-write-Netscape-history fname)) - ((looking-at "(setq") (url-write-Emacs-history fname)) - (t (url-write-Emacs-history fname))) - (kill-buffer (current-buffer)))))) - (setq url-history-changed-since-last-save nil)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The main URL fetching interface -;;; ------------------------------- -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;###autoload -(defun url-popup-info (url) - "Retrieve the HTTP/1.0 headers and display them in a temp buffer." - (let* ((urlobj (url-generic-parse-url url)) - (type (url-type urlobj)) - data) - (cond - ((string= type "http") - (let ((url-request-method "HEAD") - (url-automatic-caching nil) - (url-inhibit-mime-parsing t) - (url-working-buffer " *popup*")) - (save-excursion - (set-buffer (get-buffer-create url-working-buffer)) - (erase-buffer) - (setq url-be-asynchronous nil) - (url-retrieve url) - (subst-char-in-region (point-min) (point-max) ?\r ? ) - (buffer-string)))) - ((or (string= type "file") (string= type "ftp")) - (setq data (url-file-attributes url)) - (set-buffer (get-buffer-create - (url-generate-new-buffer-name "*Header Info*"))) - (erase-buffer) - (if data - (concat (if (stringp (nth 0 data)) - (concat " Linked to: " (nth 0 data)) - (concat " Directory: " (if (nth 0 data) "Yes" "No"))) - "\n Links: " (int-to-string (nth 1 data)) - "\n File UID: " (int-to-string (nth 2 data)) - "\n File GID: " (int-to-string (nth 3 data)) - "\n Last Access: " (current-time-string (nth 4 data)) - "\nLast Modified: " (current-time-string (nth 5 data)) - "\n Last Changed: " (current-time-string (nth 6 data)) - "\n Size (bytes): " (int-to-string (nth 7 data)) - "\n File Type: " (or (nth 8 data) "text/plain")) - (concat "No info found for " url))) - ((and (string= type "news") (string-match "@" url)) - (let ((art (url-filename urlobj))) - (if (not (string= (substring art -1 nil) ">")) - (setq art (concat "<" art ">"))) - (url-get-headers-from-article-id art))) - (t (concat "Don't know how to find information on " url))))) - -(defun url-decode-text () - ;; Decode text transmitted by NNTP. - ;; 0. Delete status line. - ;; 1. Delete `^M' at end of line. - ;; 2. Delete `.' at end of buffer (end of text mark). - ;; 3. Delete `.' at beginning of line." - (save-excursion - (set-buffer nntp-server-buffer) - ;; Insert newline at end of buffer. - (goto-char (point-max)) - (if (not (bolp)) - (insert "\n")) - ;; Delete status line. - (goto-char (point-min)) - (delete-region (point) (progn (forward-line 1) (point))) - ;; Delete `^M' at end of line. - ;; (replace-regexp "\r$" "") - (while (not (eobp)) - (end-of-line) - (if (= (preceding-char) ?\r) - (delete-char -1)) - (forward-line 1) - ) - ;; Delete `.' at end of buffer (end of text mark). - (goto-char (point-max)) - (forward-line -1) ;(beginning-of-line) - (if (looking-at "^\\.$") - (delete-region (point) (progn (forward-line 1) (point)))) - ;; Replace `..' at beginning of line with `.'. - (goto-char (point-min)) - ;; (replace-regexp "^\\.\\." ".") - (while (search-forward "\n.." nil t) - (delete-char -1)) - )) - -(defun url-get-headers-from-article-id (art) - ;; Return the HEAD of ART (a usenet news article) - (cond - ((string-match "flee" nntp-version) - (nntp/command "HEAD" art) - (save-excursion - (set-buffer nntp-server-buffer) - (while (progn (goto-char (point-min)) - (not (re-search-forward "^.\r*$" nil t))) - (url-accept-process-output nntp/connection)))) - (t - (nntp-send-command "^\\.\r$" "HEAD" art) - (url-decode-text))) - (save-excursion - (set-buffer nntp-server-buffer) - (buffer-string))) - -(defcustom url-external-retrieval-program "www" - "*Name of the external executable to run to retrieve URLs." - :type 'string - :group 'url) - -(defcustom url-external-retrieval-args '("-source") - "*A list of arguments to pass to `url-external-retrieval-program' to -retrieve a URL by its HTML source." - :type '(repeat string) - :group 'url) - -(defun url-retrieve-externally (url &optional no-cache) - (let ((url-working-buffer (if (and url-multiple-p - (string-equal url-working-buffer - url-default-working-buffer)) - (url-get-working-buffer-name) - url-working-buffer))) - (if (get-buffer-create url-working-buffer) - (save-excursion - (set-buffer url-working-buffer) - (set-buffer-modified-p nil) - (kill-buffer url-working-buffer))) - (set-buffer (get-buffer-create url-working-buffer)) - (let* ((args (append url-external-retrieval-args (list url))) - (urlobj (url-generic-parse-url url)) - (type (url-type urlobj))) - (if (or (member type '("www" "about" "mailto" "mailserver")) - (url-file-directly-accessible-p urlobj)) - (url-retrieve-internally url) - (url-lazy-message "Retrieving %s..." url) - (apply 'call-process url-external-retrieval-program - nil t nil args) - (url-lazy-message "Retrieving %s... done" url))))) - -(defun url-get-normalized-date (&optional specified-time) - ;; Return a 'real' date string that most HTTP servers can understand. - (require 'timezone) - (let* ((raw (if specified-time (current-time-string specified-time) - (current-time-string))) - (gmt (timezone-make-date-arpa-standard raw - (nth 1 (current-time-zone)) - "GMT")) - (parsed (timezone-parse-date gmt)) - (day (cdr-safe (assoc (substring raw 0 3) weekday-alist))) - (year nil) - (month (car - (rassoc - (string-to-int (aref parsed 1)) monthabbrev-alist))) - ) - (setq day (or (car-safe (rassoc day weekday-alist)) - (substring raw 0 3)) - year (aref parsed 0)) - ;; This is needed for plexus servers, or the server will hang trying to - ;; parse the if-modified-since header. Hopefully, I can take this out - ;; soon. - (if (and year (> (length year) 2)) - (setq year (substring year -2 nil))) - - (concat day ", " (aref parsed 2) "-" month "-" year " " - (aref parsed 3) " " (or (aref parsed 4) - (concat "[" (nth 1 (current-time-zone)) - "]"))))) - -(defun url-get-working-buffer-name () - "Get a working buffer name such as ` *URL-<i>*' without a live process and empty" - (let ((num 1) - name buf) - (while (progn (setq name (format " *URL-%d*" num)) - (setq buf (get-buffer name)) - (and buf (or (get-buffer-process buf) - (save-excursion (set-buffer buf) - (> (point-max) 1))))) - (setq num (1+ num))) - name)) - -(defun url-default-find-proxy-for-url (urlobj host) - (cond - ((or (and (assoc "no_proxy" url-proxy-services) - (string-match - (cdr - (assoc "no_proxy" url-proxy-services)) - host)) - (equal "www" (url-type urlobj))) - "DIRECT") - ((cdr (assoc (url-type urlobj) url-proxy-services)) - (concat "PROXY " (cdr (assoc (url-type urlobj) url-proxy-services)))) - ;; - ;; Should check for socks - ;; - (t - "DIRECT"))) - -(defvar url-proxy-locator 'url-default-find-proxy-for-url) - -(defun url-find-proxy-for-url (url host) - (let ((proxies (split-string (funcall url-proxy-locator url host) " *; *")) - (proxy nil) - (case-fold-search t)) - ;; Not sure how I should handle gracefully degrading from one proxy to - ;; another, so for now just deal with the first one - ;; (while proxies - (if (listp proxies) - (setq proxy (pop proxies)) - (setq proxy proxies)) - (cond - ((string-match "^direct" proxy) nil) - ((string-match "^proxy +" proxy) - (concat "http://" (substring proxy (match-end 0)) "/")) - ((string-match "^socks +" proxy) - (concat "socks://" (substring proxy (match-end 0)))) - (t - (url-warn 'url (format "Unknown proxy directive: %s" proxy) 'critical) - nil)))) - -(defun url-retrieve-internally (url &optional no-cache) - (let* ((url-working-buffer (if (and url-multiple-p - (string-equal - (if (bufferp url-working-buffer) - (buffer-name url-working-buffer) - url-working-buffer) - url-default-working-buffer)) - (url-get-working-buffer-name) - url-working-buffer)) - (urlobj (url-generic-parse-url url)) - (type (url-type urlobj)) - (url-using-proxy (if (url-host urlobj) - (url-find-proxy-for-url urlobj - (url-host urlobj)) - nil)) - (handler nil) - (original-url url) - (cached nil)) - (if url-using-proxy (setq type "proxy")) - (setq cached (url-is-cached url) - cached (and cached (not (url-cache-expired url cached))) - handler (if cached - 'url-cache-extract - (car-safe - (cdr-safe (assoc (or type "auto") - url-registered-protocols)))) - url (if cached (url-cache-create-filename url) url)) - (save-excursion - (set-buffer (get-buffer-create url-working-buffer)) - (setq url-current-can-be-cached (not no-cache) - url-current-object urlobj)) - (if (and handler (fboundp handler)) - (funcall handler url) - (set-buffer (get-buffer-create url-working-buffer)) - (erase-buffer) - (setq url-current-mime-type "text/html") - (insert "<title> Link Error! </title>\n" - "<h1> An error has occurred... </h1>\n" - (format "The link type `<code>%s</code>'" type) - " is unrecognized or unsupported at this time.<p>\n" - "If you feel this is an error in Emacs-W3, please " - "<a href=\"mailto://" url-bug-address "\">send me mail.</a>" - "<p><address>William Perry</address><br>" - "<address>" url-bug-address "</address>")) - (cond - ((and url-be-asynchronous (not cached) - (member type '("http" "https" "proxy" "file" "ftp"))) - nil) - ((and url-be-asynchronous (get-buffer url-working-buffer)) - (funcall url-default-retrieval-proc (buffer-name))) - ((not (get-buffer url-working-buffer)) nil) - ((and (not url-inhibit-mime-parsing) - (or cached (url-mime-response-p t))) - (or cached (url-parse-mime-headers nil t)))) - (if (and (or (not url-be-asynchronous) - (not (equal type "http"))) - url-current-object - (not url-current-mime-type)) - (setq url-current-mime-type (mm-extension-to-mime - (url-file-extension - (url-filename - url-current-object))))) - (if (not url-be-asynchronous) - (url-store-in-cache url-working-buffer)) - (if (not url-global-history-hash-table) - (setq url-global-history-hash-table (make-hash-table :size 131 - :test 'equal))) - (if (not (string-match "^\\(about\\|www\\):" original-url)) - (progn - (setq url-history-changed-since-last-save t) - (cl-puthash original-url (current-time) - url-global-history-hash-table))) - (cons cached url-working-buffer))) - -;;;###autoload -(defun url-retrieve (url &optional no-cache expected-md5) - "Retrieve a document over the World Wide Web. -The document should be specified by its fully specified -Uniform Resource Locator. No parsing is done, just return the -document as the server sent it. The document is left in the -buffer specified by url-working-buffer. url-working-buffer is killed -immediately before starting the transfer, so that no buffer-local -variables interfere with the retrieval. HTTP/1.0 redirection will -be honored before this function exits." - (url-do-setup) - ;;(url-download-minor-mode t) - (if (and (fboundp 'set-text-properties) - (subrp (symbol-function 'set-text-properties))) - (set-text-properties 0 (length url) nil url)) - (if (and url (string-match "^url:" url)) - (setq url (substring url (match-end 0) nil))) - (let ((status (url-retrieve-internally url no-cache))) - status)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; How to register a protocol -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun url-register-protocol (protocol &optional retrieve expander defport) - "Register a protocol with the URL retrieval package. -PROTOCOL is the type of protocol being registers (http, nntp, etc), - and is the first chunk of the URL. ie: http:// URLs will be - handled by the protocol registered as 'http'. PROTOCOL can - be either a symbol or a string - it is converted to a string, - and lowercased before being registered. -RETRIEVE (optional) is the function to be called with a url as its - only argument. If this argument is omitted, then this looks - for a function called 'url-PROTOCOL'. A warning is shown if - the function is undefined, but the protocol is still - registered. -EXPANDER (optional) is the function to call to expand a relative link - of type PROTOCOL. If omitted, this defaults to - `url-default-expander' - -Any proxy information is read in from environment variables at this -time, so this function should only be called after dumping emacs." - (let* ((protocol (cond - ((stringp protocol) (downcase protocol)) - ((symbolp protocol) (downcase (symbol-name protocol))) - (t nil))) - - (retrieve (or retrieve (intern (concat "url-" protocol)))) - (expander (or expander 'url-default-expander)) - (cur-protocol (assoc protocol url-registered-protocols)) - (urlobj nil) - (cur-proxy (assoc protocol url-proxy-services)) - (env-proxy (or (getenv (concat protocol "_proxy")) - (getenv (concat protocol "_PROXY")) - (getenv (upcase (concat protocol "_PROXY")))))) - - (if (not protocol) - (error "Invalid data to url-register-protocol.")) - - (if (not (fboundp retrieve)) - (message "Warning: %s registered, but no function found." protocol)) - - ;; Store the default port, if none previously specified and - ;; defport given - (if (and defport (not (assoc protocol url-default-ports))) - (setq url-default-ports (cons (cons protocol defport) - url-default-ports))) - - ;; Store the appropriate information for later - (if cur-protocol - (setcdr cur-protocol (cons retrieve expander)) - (setq url-registered-protocols (cons (cons protocol - (cons retrieve expander)) - url-registered-protocols))) - - ;; Store any proxying information - this will not overwrite an old - ;; entry, so that people can still set this information in their - ;; .emacs file - (cond - (cur-proxy nil) ; Keep their old settings - ((null env-proxy) nil) ; No proxy setup - ;; First check if its something like hostname:port - ((string-match "^\\([^:]+\\):\\([0-9]+\\)$" env-proxy) - (setq urlobj (url-generic-parse-url nil)) ; Get a blank object - (url-set-type urlobj "http") - (url-set-host urlobj (url-match env-proxy 1)) - (url-set-port urlobj (url-match env-proxy 2))) - ;; Then check if its a fully specified URL - ((string-match url-nonrelative-link env-proxy) - (setq urlobj (url-generic-parse-url env-proxy)) - (url-set-type urlobj "http") - (url-set-target urlobj nil)) - ;; Finally, fall back on the assumption that its just a hostname - (t - (setq urlobj (url-generic-parse-url nil)) ; Get a blank object - (url-set-type urlobj "http") - (url-set-host urlobj env-proxy))) - - (if (and (not cur-proxy) urlobj) - (progn - (setq url-proxy-services - (cons (cons protocol (concat (url-host urlobj) ":" - (url-port urlobj))) - url-proxy-services)) - (message "Using a proxy for %s..." protocol))))) - -(provide 'url) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-about.el --- a/lisp/w3/w3-about.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,584 +0,0 @@ -;;; w3-about.el --- About pages for emacs-w3 -;; Author: wmperry -;; Created: 1997/02/18 23:36:35 -;; Version: 1.8 -;; Keywords: hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun w3-about (url) - ;; Fetch an about page url - (let* ((data (url-generic-parse-url url)) - (node (downcase (url-filename data)))) - (if (string= "document" node) - (w3-document-information) - (save-excursion - (set-buffer (get-buffer-create url-working-buffer)) - (erase-buffer) - (setq url-current-mime-viewer (mm-mime-info "text/html" nil 5) - url-current-mime-headers '(("content-type" . "text/html"))) - (cond - ((string= "" node) - (insert (format - " -<html> - <head> - <title>Emacs-W3 v%s</title> - <link rel=\"made\" href=\"mailto:wmperry@cs.indiana.edu\"> - <link rel=\"stylesheet\" href=\"about:style\"> - </head> - <body> - <h1>Emacs-W3 &trade;<br>v%s</h1> - <p align=\"center\"> - Copyright &copy; 1993-1995 William M. Perry<br> - All rights reserved. - </p> - <hr width=\"50%%\"> - <p> - Welcome to Emacs-w3! Please see the <a href=\"info:w3#Top\">info - documentation</a>, or the <a - href=\"http://www.cs.indiana.edu/elisp/w3/docs.html\">HTML - version</a> online. - </p> - <p> - Information about the <a href=\"authors\">authors</a>, <a - href=\"emacs\">versions of emacs</a>, and <a - href=\"eggs\">easter eggs</a> is also available. - </p> - <address> - Please send any bugs/comments to<br> - <a href=\"mailto:%s\">%s</a> - </address> - <hr> - <wired><pinhead></wired> - </body> -</html> -" - w3-version-number w3-version-number w3-bug-address w3-bug-address))) - ((string= "style" node) - (insert - " -/* This is the stylesheet for the about pages for Emacs-w3 */ - -address,h1,h2,h3,h4,h5,h6 { text-align: center } -wired { color: yellow } -wired { background: red } -")) - ((string= "license" node) - (kill-buffer (current-buffer)) - (describe-copying)) - ((string= "warranty" node) - (kill-buffer (current-buffer)) - (describe-no-warranty)) - ((string= "arena.xpm" node) - (insert - "/* XPM */ -static char *arena[] = { -/* width height num_colors chars_per_pixel */ -\" 109 84 3 1\", -/* colors */ -\". c #d2c7b1\", -\"# c #dcd1ba\", -\"a c #e6dac2\", -/* pixels */ -\"a.a.aa.a##a###aa##a.a.#.aa.....a##a#aa.#a#a###.#.#aa.aa.#aa#aa#.a.a.aa.a##a###aa##a.a.#.aa.....a##a#aa.#a#a##\", -\"#a.a#a##a###...a#aa#aa..aa.aa###aa#.a...a.aa#..a##..aa#a.##aa.a.#a.a#a##a###...a#aa#aa..aa.aa###aa#.a...a.aa#\", -\"a.aaa.aaa#aa#aa#.aa#....aa..###a.#a...#.#.#.....a.#.#aaa#aa..#a#a.aaa.aaa#aa#aa#.aa#....aa..###a.#a...#.#.#..\", -\".#a#.##a..a#aa#.###a.#a..a#.aa.##.#.a#.#..a#.a#a#a.aa#.##a####.#.#a#.##a..a#aa#.###a.#a..a#.aa.##.#.a#.#..a#.\", -\"####.###a##a.#aa#.#..a..##a.a#a##a##..aa##.#..#.....a..##..a.a..####.###a##a.#aa#.#..a..##a.a#a##a##..aa##.#.\", -\"..aa..a#aa#.#a#aaa.a#aa.#....#a#a.###a.#a.a.aaa.###.aaaa#.##aa.#..aa..a#aa#.#a#aaa.a#aa.#....#a#a.###a.#a.a.a\", -\"##a##aa#a#..#a..a.##a..#..##..aaa#a.aaa.#a..###.a.#.#aa#.##.a.a###a##aa#a#..#a..a.##a..#..##..aaa#a.aaa.#a..#\", -\".aaaaaaa#a#.aaa#.a#.aa.#a.a#aa..##aa#.##..#.a..#.a#.#a####aaaaa#.aaaaaaa#a#.aaa#.a#.aa.#a.a#aa..##aa#.##..#.a\", -\".a#.aa#.#a..a#aa###.aa#.a.a#.#.a.##.aaaa#####aaa.a.a#.a..a.aa#...a#.aa#.#a..a#aa###.aa#.a.a#.#.a.##.aaaa#####\", -\"#.#.##.##a.#.a#..#a###a.##aa..a.#a#a.##a#.##...a#.aa.aa#a..aa####.#.##.##a.#.a#..#a###a.##aa..a.#a#a.##a#.##.\", -\".#.##a..a..#a.#.#aa##a.#..#aa#.#a#...#..#.a#a#aa#.#a.aa..##.aaaa.#.##a..a..#a.#.#aa##a.#..#aa#.#a#...#..#.a#a\", -\".#aa...a.a##aaa..#a.aa.#a##...#a##aa#aa#..#...#.##...a.a...aa..a.#aa...a.a##aaa..#a.aa.#a##...#a##aa#aa#..#..\", -\".aaa###.a#..a#.#..aa.a##..##.#a#.a##a#a.#aa#....#..#a.a.a#aa.aa#.aaa###.a#..a#.#..aa.a##..##.#a#.a##a#a.#aa#.\", -\"#.#...aa.#aaaa.#####.##..a..a.##.#aa##aaaaa.aa.aa#.#....##aa.a###.#...aa.#aaaa.#####.##..a..a.##.#aa##aaaaa.a\", -\".a...a.aa.#a#aa#.aa.a.a...#a#..a#a.a.a##.#aaaa.#a##aa.#aa.#a.#.#.a...a.aa.#a#aa#.aa.a.a...#a#..a#a.a.a##.#aaa\", -\"#.a.a#aaaaa#aa#.a#.aaa.#aa#..a##aa#a#.aaa..##.a.aa.aa.a....##a.##.a.a#aaaaa#aa#.a#.aaa.#aa#..a##aa#a#.aaa..##\", -\"..##.aaaa#aa.aa.#a#a#a#.a##.###..##.a#.#aa.a#.a#.###a.###a#.#aa...##.aaaa#aa.aa.#a#a#a#.a##.###..##.a#.#aa.a#\", -\".a.#.aaa######a##.##a#..a#.#.aa.aa#aa...a#.a#.aaaa#a..a.aa#...a#.a.#.aaa######a##.##a#..a#.#.aa.aa#aa...a#.a#\", -\".a#.##a#a#####.##a.#.a#aaa#a.##a.aa##aa##aa.aa##..a###a#a.aaa..a.a#.##a#a#####.##a.#.a#aaa#a.##a.aa##aa##aa.a\", -\"a.aa#.##.a.a#aaa...aa.aaaa.#a#a.a.a.#aa..#a#aa#.aaaa.aa#....#a.#a.aa#.##.a.a#aaa...aa.aaaa.#a#a.a.a.#aa..#a#a\", -\"#.aaa.###aa.#.aaa##aa#.aaaa#.###a#.a.#..aaa#.a.a#.#....a#.#a#a.##.aaa.###aa.#.aaa##aa#.aaaa#.###a#.a.#..aaa#.\", -\"##a.aa..#.a.##.a.a###a##a#....a#...a#a..#a..#.aa..a.#a.#..a..a.a##a.aa..#.a.##.a.a###a##a#....a#...a#a..#a..#\", -\"a#.a#a..#a.####..#aa###.#aa#a..aa.a.aa#aa#a..a#..aaa#a..a#a.aaa.a#.a#a..#a.####..#aa###.#aa#a..aa.a.aa#aa#a..\", -\"#a..aaa.a.#.a##aa##aa#aa.aaa##.###...aa.aa#a.##a##a.a##.#..#.##a#a..aaa.a.#.a##aa##aa#aa.aaa##.###...aa.aa#a.\", -\".a.a.a#a#a#.#a...aaa##...#.#aa#aaa...##.###.a#a.#.#a.a..#aaa.a.a.a.a.a#a#a#.#a...aaa##...#.#aa#aaa...##.###.a\", -\"a.#a#.##...#.aa#####aaa#.###a##..a.a.##..#.#a####.#.###.a....##aa.#a#.##...#.aa#####aaa#.###a##..a.a.##..#.#a\", -\".#a#a.###....##..a#a#.a##..#aaa#a.#aa###.#..a####a..###aaa..#.##.#a#a.###....##..a#a#.a##..#aaa#a.#aa###.#..a\", -\".##aa#a.#..##aa.a.#..###a#.aa.#.##..#.##...#..a.####.#.a.a##aa.#.##aa#a.#..##aa.a.#..###a#.aa.#.##..#.##...#.\", -\".#a#.#a#a#..a#a.a#a.a#.aa#.#aa##aaa##.##...aa#..#.##...##.####aa.#a#.#a#a#..a#a.a#a.a#.aa#.#aa##aaa##.##...aa\", -\"..aaaa.a#a.#.aa.....a.aa...aa#aa.a####aa##a.##a####.aa.#a.a..#.#..aaaa.a#a.#.aa.....a.aa...aa#aa.a####aa##a.#\", -\".#...#..####.#.a.a.aa.#aa...#aa#a.###a#aa..a#.#a.##.#a##.aaaa.##.#...#..####.#.a.a.aa.#aa...#aa#a.###a#aa..a#\", -\"aa##..a.a..a.aa.###aa.##aa.a##a..#.###.a.#a#a#...##a.aaaa#..#.aaaa##..a.a..a.aa.###aa.##aa.a##a..#.###.a.#a#a\", -\"#aaaaa#aa#a##.a#aa...aaa.aaaa..a#.a.##.a.#.a#.a#a###.##a#aa.aaa##aaaaa#aa#a##.a#aa...aaa.aaaa..a#.a.##.a.#.a#\", -\"..a#..#####aa#a.aa.a##.a.a#.#aa#.a.#a.#aa#...a...#.a#.a##a.aa..#..a#..#####aa#a.aa.a##.a.a#.#aa#.a.#a.#aa#...\", -\"#aa#a....#aa####a.#a.#aa#a#..#.a#.aa#.aa##a.#a.#..a#a#..#a.a.aaa#aa#a....#aa####a.#a.#aa#a#..#.a#.aa#.aa##a.#\", -\"#aa...#aa#a.#.#.a.a#a#####a#.a.#a#a##.aa.#aaaa#.aaa..#..a...aa.a#aa...#aa#a.#.#.a.a#a#####a#.a.#a#a##.aa.#aaa\", -\"....#..#a##.#.##aa###aaaaa..a..#.#..##.##..#aa.#.aa#a.a.#aa.a.aa....#..#a##.#.##aa###aaaaa..a..#.#..##.##..#a\", -\"#a#a..#a#aa.a..a...##.a##.#a##.....a.##.aa.aa....aa..###a##..##a#a#a..#a#aa.a..a...##.a##.#a##.....a.##.aa.aa\", -\"aa#aa.a##.#a##a#...#.#a#aa#.#a#aaa.##a.##.aa.#.aaa##.a#a.##a#.a.aa#aa.a##.#a##a#...#.#a#aa#.#a#aaa.##a.##.aa.\", -\"a.##.a##.a#a.###..aa.#..a#.a#.a#.a#a..#a##a.a#..a...aaaaa###....a.##.a##.a#a.###..aa.#..a#.a#.a#.a#a..#a##a.a\", -\"#a......##.##a.aaaa#.##a...###.#.#a.a.aa#.#a..aaa...#.#aaaa###a##a......##.##a.aaaa#.##a...###.#.#a.a.aa#.#a.\", -\".aa#a#..a.#a...a..a##.###...####a..#aa#a..a..a.a#....a##a.a#..a..aa#a#..a.#a...a..a##.###...####a..#aa#a..a..\", -\".#..#.aa#aaaa.aa..a.aa#.#.#..a##.##a##a.aaaaa...#.##a#.aaaa##.a..#..#.aa#aaaa.aa..a.aa#.#.#..a##.##a##a.aaaaa\", -\"aa..#.a##a.a##aaaa#aa#aa#a.#a...a#a##a#.a.#a.a#..a.a..####a.a##.aa..#.a##a.a##aaaa#aa#aa#a.#a...a#a##a#.a.#a.\", -\"a#...##..#.#aa#.aa...#..#.aa#a...###.##a###a#.a#.#.a.#.a.aa#.#a#a#...##..#.#aa#.aa...#..#.aa#a...###.##a###a#\", -\"#a.aa.##a.aa#.a.###.a#a##aaa.aa###.a.#a####...a.a...#.a#a##.###a#a.aa.##a.aa#.a.###.a#a##aaa.aa###.a.#a####..\", -\"a##.a.#.a..a#...###aa###a.a.aaaa.##.#a.#.#.a.##aa.a#.a.###.#aa.#a##.a.#.a..a#...###aa###a.a.aaaa.##.#a.#.#.a.\", -\"#a##..##.#.aa..######.a#aaa#a.aa#a.###a.###.aaa.a.a#a#aaaa##a#aa#a##..##.#.aa..######.a#aaa#a.aa#a.###a.###.a\", -\".a#a#.a###a##.a....##aa..a.a...#a#.a#a..###.aa#.a..a#.a.aa#a.a##.a#a#.a###a##.a....##aa..a.a...#a#.a#a..###.a\", -\"a.a#.#aa#aa#.#aaa.#a.a##.aa..aa#a.a..a..a##.a#aa..#a.aa#a##a.a#.a.a#.#aa#aa#.#aaa.#a.a##.aa..aa#a.a..a..a##.a\", -\"..a##a.##.####a##..a#a.aa.aa.a.aa##.##a##.###a.aaa..#aaa#.#.a#....a##a.##.####a##..a#a.aa.aa.a.aa##.##a##.###\", -\".#..#....a..a#..####.#a##.#a#a.aa.##a.a.a#a.aaa#a#...a#.....a..a.#..#....a..a#..####.#a##.#a#a.aa.##a.a.a#a.a\", -\"..#.#.a...a.#.a#.a#a##.a...#a.#.###a....a#....a#.#.#a.##..#a...#..#.#.a...a.#.a#.a#a##.a...#a.#.###a....a#...\", -\"aa###.aaaa##aa..a#aaa.#a..a.a#.a#a..#..#.##aa#.##.a#.#.aaa#.aa#aaa###.aaaa##aa..a#aaa.#a..a.a#.a#a..#..#.##aa\", -\"#.a#a..#aaa..#aa##aa#..aa...a#####a..###.aa..a.#.#a.#a#.a#a.a#aa#.a#a..#aaa..#aa##aa#..aa...a#####a..###.aa..\", -\"a#a.aa##a..#.a#aa..#a#.#a#..#.#.###a#.#...aaaa##aa.#aaa...###.#aa#a.aa##a..#.a#aa..#a#.#a#..#.#.###a#.#...aaa\", -\"aa.#...##...a#.##.a..a###..#..#.#.a.a#aa.a##.aa.aaa..a.a##.a.#a#aa.#...##...a#.##.a..a###..#..#.#.a.a#aa.a##.\", -\"a###..##aa##.#.####.###..aa.a#..aa.###a#a##a#a#aa.##a.a.a#.#aaa#a###..##aa##.#.####.###..aa.a#..aa.###a#a##a#\", -\"#a#...a.aaa#.#a.a#aa#a#a#a.aa....a#.#..a.##....aa#.a.#a..#.##aaa#a#...a.aaa#.#a.a#aa#a#a#a.aa....a#.#..a.##..\", -\"a.aaa#a######a##.a#aaa.###.##aaa.aa##a#.#a#aaa###a..#a##a..aa.a.a.aaa#a######a##.a#aaa.###.##aaa.aa##a#.#a#aa\", -\"a##...##aaaa##a##..#aa#..##.#.a####a.......#a#a##a###a####a..a.aa##...##aaaa##a##..#aa#..##.#.a####a.......#a\", -\".a.a..#a....#a#...a#..#.a.#.aa.a..##a...#a.#aa...#.a##.aa.#.aa#..a.a..#a....#a#...a#..#.a.#.aa.a..##a...#a.#a\", -\".a..aa#..a.aa#.aaaaa##.a.a.a.a#.a.#..a....#.#a..aa...a...a#aaa#a.a..aa#..a.aa#.aaaaa##.a.a.a.a#.a.#..a....#.#\", -\"##.a.a.a.##...#..#aaa.a.#.a#.#a#.a..#aa.#a##aaaa.aa#.##.aa..aa####.a.a.a.##...#..#aaa.a.#.a#.#a#.a..#aa.#a##a\", -\"a.a.aa.a##a###aa##a.a.#.aa.....a##a#aa.#a#a###.#.#aa.aa.#aa#aa#.a.a.aa.a##a###aa##a.a.#.aa.....a##a#aa.#a#a##\", -\"#a.a#a##a###...a#aa#aa..aa.aa###aa#.a...a.aa#..a##..aa#a.##aa.a.#a.a#a##a###...a#aa#aa..aa.aa###aa#.a...a.aa#\", -\"a.aaa.aaa#aa#aa#.aa#....aa..###a.#a...#.#.#.....a.#.#aaa#aa..#a#a.aaa.aaa#aa#aa#.aa#....aa..###a.#a...#.#.#..\", -\".#a#.##a..a#aa#.###a.#a..a#.aa.##.#.a#.#..a#.a#a#a.aa#.##a####.#.#a#.##a..a#aa#.###a.#a..a#.aa.##.#.a#.#..a#.\", -\"####.###a##a.#aa#.#..a..##a.a#a##a##..aa##.#..#.....a..##..a.a..####.###a##a.#aa#.#..a..##a.a#a##a##..aa##.#.\", -\"..aa..a#aa#.#a#aaa.a#aa.#....#a#a.###a.#a.a.aaa.###.aaaa#.##aa.#..aa..a#aa#.#a#aaa.a#aa.#....#a#a.###a.#a.a.a\", -\"##a##aa#a#..#a..a.##a..#..##..aaa#a.aaa.#a..###.a.#.#aa#.##.a.a###a##aa#a#..#a..a.##a..#..##..aaa#a.aaa.#a..#\", -\".aaaaaaa#a#.aaa#.a#.aa.#a.a#aa..##aa#.##..#.a..#.a#.#a####aaaaa#.aaaaaaa#a#.aaa#.a#.aa.#a.a#aa..##aa#.##..#.a\", -\".a#.aa#.#a..a#aa###.aa#.a.a#.#.a.##.aaaa#####aaa.a.a#.a..a.aa#...a#.aa#.#a..a#aa###.aa#.a.a#.#.a.##.aaaa#####\", -\"#.#.##.##a.#.a#..#a###a.##aa..a.#a#a.##a#.##...a#.aa.aa#a..aa####.#.##.##a.#.a#..#a###a.##aa..a.#a#a.##a#.##.\", -\".#.##a..a..#a.#.#aa##a.#..#aa#.#a#...#..#.a#a#aa#.#a.aa..##.aaaa.#.##a..a..#a.#.#aa##a.#..#aa#.#a#...#..#.a#a\", -\".#aa...a.a##aaa..#a.aa.#a##...#a##aa#aa#..#...#.##...a.a...aa..a.#aa...a.a##aaa..#a.aa.#a##...#a##aa#aa#..#..\", -\".aaa###.a#..a#.#..aa.a##..##.#a#.a##a#a.#aa#....#..#a.a.a#aa.aa#.aaa###.a#..a#.#..aa.a##..##.#a#.a##a#a.#aa#.\", -\"#.#...aa.#aaaa.#####.##..a..a.##.#aa##aaaaa.aa.aa#.#....##aa.a###.#...aa.#aaaa.#####.##..a..a.##.#aa##aaaaa.a\", -\".a...a.aa.#a#aa#.aa.a.a...#a#..a#a.a.a##.#aaaa.#a##aa.#aa.#a.#.#.a...a.aa.#a#aa#.aa.a.a...#a#..a#a.a.a##.#aaa\", -\"#.a.a#aaaaa#aa#.a#.aaa.#aa#..a##aa#a#.aaa..##.a.aa.aa.a....##a.##.a.a#aaaaa#aa#.a#.aaa.#aa#..a##aa#a#.aaa..##\", -\"..##.aaaa#aa.aa.#a#a#a#.a##.###..##.a#.#aa.a#.a#.###a.###a#.#aa...##.aaaa#aa.aa.#a#a#a#.a##.###..##.a#.#aa.a#\", -\".a.#.aaa######a##.##a#..a#.#.aa.aa#aa...a#.a#.aaaa#a..a.aa#...a#.a.#.aaa######a##.##a#..a#.#.aa.aa#aa...a#.a#\", -\".a#.##a#a#####.##a.#.a#aaa#a.##a.aa##aa##aa.aa##..a###a#a.aaa..a.a#.##a#a#####.##a.#.a#aaa#a.##a.aa##aa##aa.a\", -\"a.aa#.##.a.a#aaa...aa.aaaa.#a#a.a.a.#aa..#a#aa#.aaaa.aa#....#a.#a.aa#.##.a.a#aaa...aa.aaaa.#a#a.a.a.#aa..#a#a\" -}; -") - (setq url-current-mime-headers - '(("content-type" . "image/x-pixmap")) - url-current-mime-type "image/x-pixmap" - url-current-mime-viewer (mm-mime-info "image/x-pixmap" nil 5))) - ((string= "cXVvdGVz" (base64-encode node)) - (insert - " -H4sIAMtPtS8AA5VZTZPbNhLdM38FrMtcNPoBe5kax+tYW/HGtXHWtUeIhERkSIABQDPMr9/3ukFq -7JzW5bIlimz05+vXzb81D597Z+bgv7qUnfHZWPOpP707mdK7jK+lt8X8GDuz2Iz77GVwpkST57Z1 -OV/nYVhN564udKeHxuDPo/mnHV02H2NKcTmaw88Bt7x1t1iKC+adnW99cenQ/K15eGsvHrfa5Mzg -X5x58bwnH3n4am543vjA0+LoSu/DzYxz25sx4oHsg88Q9P8f+852xg6LXWld5HUz1J/FShxuLi4X -M7rOtz64o1l6j3PP5jbDaHipWfrVZAen2cHEq5mz6bzr+LHMF5faeYjw3gmnfbTrBY4NJqYOB8Ca -OeBDLjZ0ZrThxYcOBzjT26/i2iHGFwOnU40FDzW+ZDdc/24OH/Xuw8m8tdm3Fr4/Gl8eMuR0iOIk -5y/wl5tsskWfz+axOfCgg+GRB5XwhXHtooR5u290Npgnc6ZEa8aV7sUJeKphGuCqmB2ZJlVzWng2 -fZxg4hXybtnQK6ZYhDPKJzVj6ESQRrbtIw61iHe4abCbLoaHYn6b4fZbNBcc4/+E4y+utTPuPeOT -uASRZ7owI8wPve9ni79QzJe+kYu3iGT1nbPi/XMRVWjPxd+oNV3c0qzLXOC81z/foG69QxJCo2BL -g4tqqMYfwVpEkWHAFT8UhiFABnIKntUfch+L6f0osZULsDa4rpFrdEW9jgzFo20cp8GPLhSbVug2 -TlAmF9++iA+hSbYePjycm94NE3KN8szbeDkdRLXqHxiAywnmxyDfpzj4FqXl3GQmFyfUr4We5pri -iHOnwQYHh9jcN1LuCI/GYrEBioX1ErsVXwYGS8yE6sPKL11cAq/wGJWQy3y9SkQDiwaFx5iIBBgI -P88TbG+LlrscJiFf4ovkL1PtFmGlpCeL8fOH589Pb2gigepqYQqSHP7q/dCZFtHKMAZxhCuPxuXJ -tZ6Fob6Ic+kNaqFIZfSuoQCG8nm8+OLhItgsulg65IasK4WmRYbzPy6gsN8Pa0l2OhlRQL/w4AYS -nHiDH/Z8WsR5l8hcFSVE7pbHuCESmHrLc0sZXIPzVgkD4ucAc6huSJJcViHiVPhvhsG9nSanMYAo -vXZxjZpQbZJUfegMEICPA30S0QtJFChr8lq1V7PGuSYysiQmcw6dxz2sJRMifrJTJBrzNBTIHCAl -Xps2ht9nYK/tYsrwxCihQ9FQntybX5CfixQrPXCLg/SPI8pYcqshmL+ot9QCyN8LV/qLXZnrJiPx -hrg4mnsyv7DxIKxOc14tQPfxTOG42NQx1eHaNIfAMEqmVyy9eoAuAnwLTIbOBpT7scktamWUe4lO -yU/T9uXibjd+vsI1IzB91cQ2q4MlHxPilAjZAIfjDg3nh1GKmbqc9rqM0G9wNyf4B3VYjFDStXNK -PKH0iX0I2QrEyCUmBRQi6dqgl5Q5IcG0PI38ThM+AXVXyeYvohZ8AejEc1TYmt/ihd3Tpa/eLXS9 -Or06WtspPI1gUbK/NlKOgt5Toi1tb9PNCYx+jvAAUjz+ISCw18wF0XEFdfdH66aKz2gTSJ5xRoc6 -4lMDsE8u3lA1/br3APq/RReEvcU4y8Tiw2oMPESNFHzhXwVoQUhX6IAkwUPL/eqUICBrfbsiz6Xj -xCYzMBZFNPhO0+9iL+uT0Wa8uAfgbhBTX0Jc5FSkqsQHKdZG1FvNmosbvLvmih84qPXA6KxFCgQH -EKDct0fowxEwm4C+2p6LtFifBLryZj/NYze1RNgQV/ZeavEpRSha0cvZhLORswAd1AF4TMparyFW -NhSlwqzCLP4RoAMKJy9oneckiIln4WLXVW0MDRUUHSLvYpfRZNUUoTCmLFqYYs5XspMaN9e6AFdT -koMXRy3xgeCAhxpi9jU5B7iMErpdGmrSMMMFXqZYrJT5ALlIWXoEdnTHBrnHQFD9nrnE2lj4ja3D -M7eKOu5syIDAPfLkiwWYrq8ytQVoBGGWDM8VcIDOfA6MQlHG8ZDIN9URuUXTxe8PX10D/AY9e4Vf -OBNYlwouMXibkzyJChLzYtuXza8FDdycm8URy/VS60EGdwwVtXAsqgbkD53WCko8ZxIcSJRk5mPB -tThTuCcu0/l4OPk8oV8KJ0V92kusFIYchY4nXqCVoPnPSZj6I8hm8QOkA+UGMCppG7iVXrH3U5jt -bKANm9iz+fDrx+d/mQ//eH735g0pbEQSVu6g3KBK0wIdCBNm8sgMqZM2ghVvnFmS5+JcaCZLNEIl -JvpA/PFdWuYXjBPkfij1ER14IVARoBc4kB1X8mnr/cKTKw51TrEDLaEg+XLtjArux9plFipC+tra -r1Afxa8ebGft+azdhpzmiRxu9JgIjmS1gosqijkAFbdYHwVqgXYCqUq6qMZbx2KVVC2qMpixqYQs -TyzJ3M/s/neGi4ME3FGLRMUMmoeoS8FUdGfGwjNSGSx3ZqaUt6iK/pwCioTn/xetgMCmhaLWV9+J -ptJCntBOt7FKHbHl59JHdXWNOUnHRphDRovWymQSoIK7k3keMkhb74TWyFjkGlCJlGAD9ZGDPPmf -2HI2V+eGbeQbBoEqRQmlCEQmIUdsyFJeDWp95EiCSUh4J6tVyHOdMjSDFHnhv0iXMsdqf4U+YDgA -84Gjjwuv7q7MtErgbUdp4zdRh0av1Z2N4g5QAt38WszOsFPbP6FsfgMUPMZHUjmXKo/CkBP8lYGd -YYgPjaQAfYhKkdlN4lzvRca4je2jKRwQyNPBPF/LNgScmznPwm/FhUTwQoqBGxRjkIxo2yPr1N1p -3oOQPDTi7PS2DZRvrmTagXv0hyuEs4qve6sOjdyUNMmIdtv9GxTSP7VXXGglJhxKqI+Qg70inDoe -Ssu3uNA5CX872Iwin173P9jRsf1pipL9xEbGGGVBc8dGrHOMDBElrZXTiNh6PBQ5GRZEdhzkHSCO -6CHhtuV7xWi+6M4zfkEHxgQC+gnnbqOpZD0mteleuiNZRUM34+FvYGkeAfL0Y62kxRM9krTP1hb4 -gCdXOUeUPMqM3VOf3Ii8Dksc6yk0zEwe5K69a7DUlF6FTxUZr3uYLwmVj5WG8ixOTDRhWEWc9Jz6 -APgpG6kQvuewajOTu+77F8KgY+jaFNmCTIocIzkSijlxW9cguXKD/vJyp3y3eYPRvJFtrTvklwxG -TLrzfQ/CERwdaTdRaaGUgShDPT84mRKFcl8ivDfKUkgPJS8BOujpqEog1YftkueIpeskgIPsTzC/ -R47/hEJOCD4Vo0sasHRHcanSPnq7J3blrNePyH9CXmaLu3H1grN+sqpJHT/m4Gpf3OAnsQo44Olk -/06SODYd/j8elNLVvBFfuPsKpZqrSwb2LWBw2UgUhxbmEmQNerdw68yBihlKBmx92UYbZgUZmIPf -w+NjRaLbHE7b1D06EE2vzR35fMW8hPSBmyBCt3doW8MghHtOOqGDg7pwgygYBG4rDARyLtyxuQdt -o5Mf3J3ygIOBr5ypExNC4i0ETRlL8yjGd+T4908ngWo2WlAeVzmbHMA1AsF7AymZTRqhz+JZ5Qly -VUf7PDqp/VfZztSCIVEXH8L/weShC6gEJvZVWCKiTOTIE9n3/sM3Fm/bpaNBRPCdlQAkIn+FiMM7 -9NADOAe0draO/nWTIvSi3LF4N0d2UKE0ZAKnfTOplvUSF51vBoaVMa5Ix6WbTOi5OitxX6QtkFD6 -elAEMXL3QVHoPqCda6IDN8L4vxXIZYtinITBVNGr+eYWWqDbDApt/iKUdx726Wer+W+CIbO+7yQr -fwDOJKs4KokyvqKosjvQ9Q8u6qAPPgAN/Ajs1kg2spPcBgoBCK6DYqrkjvMlvsCHGng3uAm1VU7b -ejSjPb00yXfbuijs9zzoVHDc2pLlaq8uFRBgfpTRXuzSsRsoWweBbbnI9BbHLbRo4YlcXeyrQHP4 -IojLEv53BGlEFD5iTLGN/Ep805acyC9e3fwJA1ZZ92fOChOCQ/028zVL4nJLYAHXZyRvlnVZrVX2 -Fq5WOi6aC7eWWmwiQYclqCHtWKtX9hEvHEjUJwr6FWl5mPgHJo4Cd0Jo3jCrZCjVJf1ZBA32z5VD -yc9hy00kdF1ICEcgvgltZBG+h8HgrIXbhmOVcIuafI1wcwBa5ZoB0XMLJbzzObj1J86jG+st9CK4 -aYochpGwunWA6xoSb9c9ClUHGAr3PJnDzz3XH0d6eAP4XazRZ5TJHtCVmlZaDH+ST99jF5f1pD6y -cmWCVp/s3p0kqo3Qe3qamLCNrVBVYfM1VRYe8xdDFWoRGwmICmVrf8UlJRv5lgEohuqRoeiDHS+k -k9T//eBlXND5j1d1AMGjde/HWNH2YcLXvJfqkyHZ4Tp3F8EHOW/i2SeSuAfZdi5E5GP1QS3IqgHV -/MnOcKHs1UEpHMb5unY7mzlXNsAXHuYwzXDUQXp60b2BvudQot/LiikEeZ2R6UgqXpdFKunVi4If -E4yf7EYOHjol9rIXCmxH5uqz0Ja6Omp26y61weuoAllEHek/uywCtJJv6c+C8wsXa+zzkyQ7l7DE -NqaULHMWnCcM7RK3IZBFB5RqaQyXfJ4cmu1Ptu3rcac2stVliUCaQJAO1DL86iAp1MPKK446eBSd -SUpECe57DcHOak5+IXlgOOrLh4yhTgawIUpe2m2FZa4ATNDtBJ1eIcDrXUt9llsg+U13hTGF2m3g -fwzAlECCJ9vn7eK5Zi1Vf8+Dvh+U8AHqfrRXDyKE/kFKqWAlk0+qu+TOFgGVi/BXpI3UFFo+CCPG -GUG/6z5q7XSXI+/WkTmLSp9Woq2Igmzo0BJQBPtIpi8kFldkduTbmKNQMerREJ58aEvFP8klzbLX -lOG4U2iFQcueVakF2evV6TGj8qGwr+dlwencaH6f2RRAm3WfdkcEJDdfOLa9UEIVKX7arnKudrJ0 -wuAS9huaK3wSOuWQtHJhl9qa/VVe6dzpiJyKeNzubw2QoXVfeH+ZkRc/jnU8+KL2K0SS+Ah9/Rql -uyUHYCMs8udfQ4sW8APIEl/21ZE7t32MQ7MTVto58HWTLixb3K22SDuH81pXXwT2pLb9Bn1o+g1T -QN4UE7C2FZxu54iv23yPFj0H3fvIhW/0atSQC+ZSWvc/LM46zb4fAAA= -") - (setq url-current-mime-headers - '(("content-transfer-encoding" . "base64") - ("content-encoding" . "x-gzip")))) - ((string= "emlwcHk=" (base64-encode node)) - (insert - " -/9j/4AAQSkZJRgABAQAAAQABAAD//gBLCgpDUkVBVE9SOiBYViBWZXJzaW9uIDMuMTBhICBSZXY6 -IDEyLzI5Lzk0ICBRdWFsaXR5ID0gNTAsIFNtb290aGluZyA9IDE0Cv/bAEMAEAsMDgwKEA4NDhIR -EBMYKBoYFhYYMSMlHSg6Mz08OTM4N0BIXE5ARFdFNzhQbVFXX2JnaGc+TXF5cGR4XGVnY//bAEMB -ERISGBUYLxoaL2NCOEJjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2NjY2Nj -Y2NjY2NjY//AABEIAJ0AWwMBIgACEQEDEQH/xAAfAAABBQEBAQEBAQAAAAAAAAAAAQIDBAUGBwgJ -Cgv/xAC1EAACAQMDAgQDBQUEBAAAAX0BAgMABBEFEiExQQYTUWEHInEUMoGRoQgjQrHBFVLR8CQz -YnKCCQoWFxgZGiUmJygpKjQ1Njc4OTpDREVGR0hJSlNUVVZXWFlaY2RlZmdoaWpzdHV2d3h5eoOE -hYaHiImKkpOUlZaXmJmaoqOkpaanqKmqsrO0tba3uLm6wsPExcbHyMnK0tPU1dbX2Nna4eLj5OXm -5+jp6vHy8/T19vf4+fr/xAAfAQADAQEBAQEBAQEBAAAAAAAAAQIDBAUGBwgJCgv/xAC1EQACAQIE -BAMEBwUEBAABAncAAQIDEQQFITEGEkFRB2FxEyIygQgUQpGhscEJIzNS8BVictEKFiQ04SXxFxgZ -GiYnKCkqNTY3ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqCg4SFhoeIiYqSk5SV -lpeYmZqio6Slpqeoqaqys7S1tre4ubrCw8TFxsfIycrS09TV1tfY2dri4+Tl5ufo6ery8/T19vf4 -+fr/2gAMAwEAAhEDEQA/AKF84W+nHA+duewOTUY5A9fpU14o+3zkE/6xu/v6UyIBpUVskE81xStc -9umpJczJI0iaFnZgpBPU+3GOv+fzEHOOhAx371S+2SHkhcjrxTXu5Sv8K4PH+fzrf2UjBYuEW7lw -sMn5uRjHb/PSmiRd2O/+f1rNa7k3cgAgenP+elNN1IzDAUdOOfy/z/Sh0mDxsTWBPc/nSqAUY+Zg -g4CEdemfyrOF7N6g+nGP8/40v2yQjbhccDG3H+f8/iKlImWLg1oXwxxnn8Of1oJP69apfa5ck8dO -SR0A9fx7Gk+1SkEblz04X8MdP8/yXsZD+uQLfXBZm298Dr9f8/4VC0uCQ27PfmojcyMOCoz2wOP8 -/jTftTp8okjA9DGuf1FP2UjKWJV7o27wj7ZMSTjzDnjPf+fWnzxQRXcSW0vmrxk5zk55/wA/lTL7 -/j7uM44c5HU4zUcIH2iPIz839awkmmdsbTimmYyj5RnjA9unH/6qQ9e+49cCnjkdDkdh/SpbZSJj -jkhOP8/56+9ei3yxuePTjzzUSlJgYPQDqP8APfn9ahB/eD0xknFaskAuEzIhVwOeR+VOhslKoYba -RyMYYIT/APWrH2p0PDNPfQqm1YR5DjeBuCgcgdqi/hzn8znA/wA/41dnjFqrlw4lcY+cYzVRRjG3 -t0/z6/5+l023uZV4xjblADnAwCOc/h/n/wCv1p2AeuR6fSgDvgcAde340vf+ec1qc4hHG08D6YH+ -frTd+P8AloB7E0/GOw46UmWHHT6ilYdzevSxvJxuOPMY9eep71FD/r48f3h/OproIb6dXYgGRj0/ -n37frmqiysJMgDcOfavNk22e3BpLlSM5RwMcHPGKmsbeS6uxHCdnBLORkIo6k/p/jSskUR5Pmtx8 -vQDHrW5oUDCzEp+/PJ8pA/hBxx+v1rslU93Y8yNPllq9S/b6fbwqvyB3H8b8n6+34VZPPTHB/wA8 -09h2wcZ6dRTT256VyHX6kbwxzRmOVAyt1VhmuU1jTf7PuB5e4wyjKZOce3+f6V1w44649qq6taC8 -06RAuXX50wOcj+v+Na05crMqsOZHG+hH4Cj09sGlHIyPrz/9el2+ua7jzxpzjqR1z7UnP0/CnkZI -JHft/n/P60gHHQ/nQM2r3/j9n6f6xun1qAW486PzYzl8HB9DU144N7OCQG85gMZznP8AhTRJJJKh -dtxU8Z5rzJJpnuxfNFNGYcKpZx0HI9eP/rV1umRGC3tYdpUrCN2PUj/GuctLb7VdwQEAh2G/P90c -muvhUF3b1OBj/PWums9Ejy6C3Y5uvqe3em8g96ec7e5PX/69MYfNnHX1rmOtAuc8fnTwcDgnPY0w -cnnrwPpT1JK8Z64oEcbqtmbTUHjUZRiXQEYBBP8ASqnQkjnjp2/Ouv1WwF9bbVAWVMsjYHB78+n+ -fauUeNo3aN1ZXTgr6f59RXdRnzKx59aDi7ojI6nk5Jz1A/X+VJlv4UJHY7c1IVGQc9OeOnWmlTnq -w+gOK2Zkmal4v+mze0jEA9etOgt55zuigd1B64AB/H/Ck1cNBNPhlyxY/KckD0I7etdEY5IoRHbl -I0jUBVIBB9c+305615r953PZdRQilAx9CtpI7q5aRWSRIwoDKQeSc9evKj8q24MBMcc9vaoLK7F1 -G7yoqyREhypBBHqPY+9WYU2RqTgMRnp+ePanKV3c54xsrIcwwec+/vVK5cBlV2kZmOFjj6t+XNW8 -BSKRA8c/mR4DhSBuBOM9e4/n/TEqxbvbQomxfkjTyWzglphnP1z/AJ96WxdDNJCYpYpYjgpJIW59 -snmrVsv2UN5ZVS7mRwvPzHqeSeeBUhTdIZGA3kcnPBxiqbXQiKlfUr3CqSMB2duiiUr/AFGenasj -VbWSWaOIWsouMkDeQfk5z82en41s3FslxNFI4BMTbxxnn/PPr1p1zH5yffIYfdc8kHn/AOv9aIy5 -dSZxctHscfPC8LlJEKuOQM5yPX/PvUBbk4DAfQVbvWke6k8376AJknrgdf1J9s1WIUHBJ/KvSi7x -TZ58kk7I0dQUNdTr2LsD6da19L1CK6iS3nYrOq7SGPD47g1mXb7bq7XYpLSN8xPI5PT/AD2qopKS -wyLuPlyK24DIUAj/AOv1rzOp7c0uS7N7T7KS3ub8TSBmmfMYH93/AB5/T3rRYlYiw9M8VJlGQEkN -xxRxgc/Ngc569u34UNnOtCJSpRdpBXGRg8fWkPGB0xzzVN0ntb5UicfZ5SSqsM7W44/LpVht/lME -Ks+3jjGD2pWLTJV45wTjsKrtcGK4bzj5ECDIdiMMfX8P8+lUNJ1T7U8sEoP2iFir9COO4Hp7Vpu0 -EsTRuUMbAhl45H/6qdmtyOZPYig1OyuAfKuomI6gN05/+v8ArUkMjuXJJwWOzjBxj0+uev8A9aob -O0stPQpAEjz1YnOce/8An+VTHbKqSoW4JIxkbhQ0rgm7amBrgCaiWHeNT0z69fXoKz1kKDaJpFA7 -Dp/OrWvSg6iyDnYqrz0z9fx+tZbTRIxUvuPrxzXfTa5Ejz6qvN2OoawV55ZZcOGdiF/hHPepwiKo -GF24OO+f8all5d/Uk8Zx+f8Aj+FMAGRgcnvXjzlqdVOnOs9RunwIl3cCNAg8pQFGeMlun5flWkjB -kyDnHGD06dqy/Oe3mWSMByRh07EevHerkV3BLJtRtsrHPlycEn29fwrWDujZpQfKTSIHXay459Px -phyevXqOKk3EEZGDj8Ka3T2z1FWykc3q3h/zrpruAPlzuZVPKn1HqKzLi+1rTkWMXcxU/wAMg3Ef -ga7fuR0b6Zx+FNeNnHyyEfhkH/P+fWqjNrciUE1Y47S7vWdSu4opWmNqW/eBV2Lj0JA/D9K7EkBS -c5A9R0H+c1EtvIXIluHfHO1VC/X3/Wm6hIVtGRW5k2xjPHUjP6USlfUUY8qsZakSxM7AMJSWKkdj -ng+vGBVKTTrfedolA9EfA/CtORQccD26cH0x7/564qoyyhiFIYepzWEajTumZTw8r6M15MGRu+WI -AP1/yKjkYKpbr2Hv/n/Hv1lk4lfjHzZ49z7VXYkyKAcYGcD8h+HWsXrI7F+6pXQD5PmPJIycHkf5 -9vT60s0auux4w3s388f59qeT+XcE4zn8v/1fSmjHPJ64B6dP8/Tp6U27LQ4aUHUnqMAniX9xcOpH -ZvmB9uaI76aMgPAjcctEevboe/1NK5wD3I7dPwpgUBQTySCT7+/+fSqjNnXXaprQsjUoBw4ki9ih -OB9RxUc2uabCmXuk5PQc+v8AnNYOuaq1p/o9sP3rDJY/wjnoK5zyppCzMCWxklq64Q5ldnMq0n0O -8XxBb3LgWjCR+cb2Cg+nHX8uajbzJX8ydgzD7qrwF/z61yEGlySbTkjcOMCtqz+1WYCtIZkJACk5 -I7fLn/8AV2qZpbJjcaslc1SxUHcxIHGe/THP+I9fSomYBiPl6+oqTcHQMuMHp1A9cY/Tn8qqtJsY -rg8e5/pXPbsOFbS0jWc/vH3dQx7dOf04/r1qPpMCo+8MZ5/z3p8jEXTgqykk/K3Gecgj68c0yQYA -Ix8pHbt/nNRLSRv8dGw8HJAHXjt+Of5flTFbKnJPXnn39ad6Y6e38/rTBxIw/vcrzyex/kKTMMM7 -TGzkbRx3HQH17DsPrSkjP05z/SiQfKV9uwxg/T/P603cCoI6HGP8aI7F4xO6ZUl0WK5tZrwkGbcT -gdcDjv7Dj6+lVkt41UAjA4xx/nP4fjW/pEypLJAwwGO9COMccgfln8/Ss66tzbXUsOMIDleP4T/k -/XFXGpK7i2aYVx2M+3IjmeBcBcZU+nY/zqysscc8LyD5Q4bgegyMfl/kVBbqftc7EYYMO+e3+eaL -v5RHnpuHt2P8v6Vo9WdVrxsy0t0Li4n/AHaoGIfHUAnr/L8zUEpzI3B61FbMFkZ2IVQvJz3P5eh/ -zzUMtyxkYrAXHZgcA/SmonmVKb9o+VHaTLaXimGR43Yfwg5IPf3zVabTp15hcSoeofhh+Pf8h/Os -K7JW+mKsQRISMfWuh0q5lnsVeRtzKSM9zjPX8q5akXDVHTODpJST3M9mNv8ALMjRqDwXGF/E9M/j -Q53AFSGIPBzwf8/59K0tV50q59FwAPbIrkwPKGY8puPO04z+VXS/eK5nCi5++nY2NwYZySDx/kVG -CynHZjweuCTWZJLNGjsszDB6cEHn6VDJqNwo5KvnA+ZfWr9k0dVSHPC0jYIDEcnOcgjqP6j1/wDr -VNPI14ieZgXaAhSOkoz0+vH0rNsbqS5GHIAzjj6j1+tbNtpsU8atJJIVJAKcAdfpUysmedC8JaGF -cjy3W7jbIwAwx1H19Qe3/wBai8BZkCglVBcnGcdB9e9P1BQrSwrkJ5xXqScZB6/WtLSQDdvuAYeT -jBHYnp+gq3LljzHoSm0ub0MAqu48Zz1Hr2/pTTjPJQn3UZrqNQ0i02u6qyEMB8p4x+NYMtqgkOGc -D/epxqqSuHtY9j//2Q== -") - (setq url-current-mime-viewer (mm-mime-info "image/jpeg" nil 5) - url-current-mime-type "image/gif" - url-current-mime-headers - '(("content-transfer-encoding" . "base64") - ("content-type" . "image/gif")))) - ((string= "emacs" node) - (insert - " -<html> - <head> - <title>Versions of Emacs</title> - <link rel=\"made\" href=\"mailto:wmperry@cs.indiana.edu\"> - <link rel=\"stylesheet\" href=\"about:style\"> - </head> - <body> - <h1>Pointers to versions of emacs</h1> - <dl> - <dt> XEmacs - <dd> An extremely X-aware version of emacs 19 from Sun and UIUC. - This is the recommended emacsen to run Emacs-W3 on, allowing - inlined images, inlined mpegs, and variable height fonts, - among lots of other cool features. Distribution is at <a - href=\"ftp://ftp.xemacs.org/pub/xemacs/\"> - ftp://ftp.xemacs.org/pub/xemacs/</a>, or check out the <a - href=\"http://www.xemacs.org/\">XEmacs web page</a>. - <dt> Emacs 19 - <dd> A slightly-less X-aware version, direct from the FSF. This - is the second choice for most capable version of emacsen for - emacs-w3, and allows for different fonts (of the same height), - coloring of links, mouse, and menu support. Distribution is - at <a href=\"ftp://ftp.gnu.ai.mit.edu/pub/gnu/\"> - ftp://ftp.gnu.ai.mit.edu/pub/gnu/</a>. - <dt> Emacs 19 for NeXTStep - <dd> A version of Emacs 19 that runs as a native NeXTStep - application. Fonts/colors/menus/mouse support. Distribution - is at <a - href=\"ftp://lynx.ps.uci.edu/pub/NeXT/emacs-19-for-NeXTstep\"> - ftp://lynx.ps.uci.edu/pub/NeXT/emacs-19-for-NeXTstep</a>. - <dt> OEmacs for DOS - <dd> A version of Emacs-19 for MS-DOG. Distribution at <a - href=\"ftp://oak.oakland.edu/pub/msdos/oemacs/\">OEmacs - 4.1</a>. Color and mouse support. NOTE: Emacs-19 now has - native support for MS-DOS, so this version will likely - disappear. - <dt> XEmacs for Windows - <dd> A port of XEmacs 19.6 to Windows 3.1. Shareware/Nagware - application, but is well worth the money. Distribution is at - <a href=\"ftp://ftp.pearlsoft.com/\"> - ftp://ftp.netcom.com/pub/pe/pearl/</a>. - <dt> AmigaDOS - <dd> A version of emacs 19 are available for AmigaDOS. Emacs 19 - is at <a href=\"ftp://ftp.wustl.edu:/pub/aminet/utils/gnu/\"> - ftp://ftp.wustl.edu:/pub/aminet/utils/gnu/</a> under the - filename a2.0bEmacs-bin.LHA. - </dl> - <hr width=\"75%\"> - <p><cookie src=\"about:quotes\"></p> - </body> -</html> -")) - ((string= "eggs" node) - (insert " -<html> - <head> - <title>Emacs-W3 Easter Eggs</title> - <link rel=\"stylesheet\" href=\"about:style\"> - </head> - <body> - <h1>Emacs-W3 Easter Eggs</h1> - <hr width=\"75%\"> - <p> - Did you really think it would be that easy? Read the source, or -experiment! :) - </p> - <hr width=\"75%\"> - <cookie href=\"about:quotes\"> - </body> -</html> -")) - ((string= "authors" node) - (insert " -<html> - <head> - <title>The Emacs-W3 Team</title> - <link rel=\"stylesheet\" href=\"about:style\"> - </head> - <body> - <hr width=\"85%\"> - <hr width=\"75%\" label=\" The Emacs-W3 Team \"> - <hr width=\"65%\" label=\" 1993 - 1996 \"> - <hr width=\"55%\"> - <dl> - <dt> Author - <dd> William Perry &lt;wmperry@cs.indiana.edu&gt; (Hey, that's <i>me</i>)! - <br> - The main author of Emacs-W3. Currently unsure what to put in here - about his employer. :) - <dt> Supporting Cast - <dd> - <dl> - <dt> Chuck Thompson &lt;cthomp@xemacs.org&gt; - <dd> The master of the XEmacs display code, which makes many of - the really cool things in Emacs-w3 possible. I owe him - copious amounts of beer. - <dt> Ben Wing &lt;wing@666.com&gt; - <dd> Another main XEmacs developer, and the man behind the - PearlSoft port of XEmacs to windows. I owe him his choice - of alcoholic beverage as well. - <dt> Jamie Zawinski &lt;jwz@netscape.com&gt; - <dd> The main Lucid Emacs developer, now working for netscape on - Mozilla. Helped me do the initial integration with Lucid - Emacs by telling me about stupid mistakes I made. :) - <dt> Marc Andreesen, Lou Montulli &lt;marca/montulli@netscape.com&gt; - <dd> The inspiration behind my efforts to create Emacs-W3 - initially, because I hated the interfaces to Mosaic - and Lynx so much. - </dl> - </dl> - <p><cookie href=\"about:quotes\"></p> - </body> -</html> -")) - - ((string= "cGhvdG8=" (base64-encode node)) - (insert " -R0lGODdhbAB4APQAADIyMjo6Ojw8PENDQ05OTldXV19fX2dnZ21tbXV1dXh4eIaGho+Pj5GRkZqa -mqWlpaysrLW1tb29vcnJydHR0dPT0+Dg4Ofn5+zs7Pn5+fz8/AAAAAAAAAAAAAAAAAAAACwAAAAA -bAB4AAAF/iAgjmRpnmiqrmzrvnAsz3Rt33iu73zv/8CgcEgsGo/IpHLJbDqf0Kh0Sq1ar9isdsvt -er/gsHhMlgkC5aPgnB6u0d/AQEAcDAIBdnctuBPPcnhwWnYDRneBggCDJno3AwQEhjB5jDN2BAWS -kyd2goAoeDmRBQamCAgGmoV0lJYnAgWyppmRKIWegK+LgTeRpgaoqAkJCgoLCwwELAOlqJqS0LK/ -qcHV0reeiIok3DaQBAYH1gjFyOcLCQeveeEIx8jGC8bC5QnDqAcJ4tMnm3NydJXwVgOcOHLm0KVb -Z6JdMHjzjtETRgwfAn38NPljFZCgIDuPIh2oZw7iggYN/hyojJggHjIHKVWqTMkgHjwFxHDeGwds -WaM+ubwJ2iWjmbNh8s4xYCDzgYMHEKJCUBnVqdOnMhswaKBQos4DPAtwGvGvUKIRH0F+ExksITqt -MWWqfEBXagQIDyJEoJsVZc2uOC+aKnAghdk3cIbmuSFnFlJ4W1E2vSo1qt7KVfFOTal1add7F8H6 -LIFrzp05IoYWYnzKHrrIMelChaA3ggQJtXHfhSChqlWaTLXGI6YOrIFOuN7owdNnsS+KxY5FXvq0 -bl7atm9rx6378l7ZWR2g0ymscImyrFDzat7KBgHo8qYzlY33rt7t2m3Xti/7Kkzx55CXjwno2dGH -LgGt/vaNKTm9FpdVlmWn3QQU4nfbbv3JxVVNxoB20WgjlDbHGdtUopYNCEEm2VzVRXgbhRRQCKOF -uvnGlwN/zUPcRe2JIBY4pelymmk3IKTQg01J9SKMMTZZYX694XWjcMNVFMxAkRQiCVCfyHEiDa0h -EBEyccF0kgOZ3SfBBBS06aSMF+Im5VU26VTRASACAA2QBiJy4B2SFNQWcejMRA8yfzUwlQO4wVgB -jDI+iVt/NdmjgHHAgIWlJAXiMaR6NIxkT3THqKSAAZEQYEwwwJhywAIQRMpmmxVOcOEDJzVwgCal -oArOL8eRAE2qZXkKlIJmiDOqST+SQso2axAgQDAO/tjGJJy3QbDQAXRY0mMzJBiVJSRmJYgLDdOO -RByzmNSSCbQCSEuttbNi29u23ZbwbQHhTrPJP3wAFe9YMBi3rjkFNCZLrwX0SAIdB9DG5m0UrHlr -wjQQSywuxmr55QuEldPhPgbY8WoDxuijgCYGOAwAHQtEYKuMFU9g2wN5IrfLwln2nB65kFyiTk4d -pgLaSUuJqQBVEThAzQGnKpAXzTFmq8wmIfbMc568Dgv0iCJmIkMA95C6wDAKEWOAOamcXVFLZE5d -wdwWtLkXAzvtiuo0C88iVnvNOLvKJmvgkiVRKhSAU1JjkrkAWCONI0IkCciVzgJ5SUDB3BVYUHfT -/sYogIoqeQJVypYi4Ll1qpAU7rHYMbwHN5lwoaTVrrxOgkABFCzFgAUYMLC0Xm5acIEFFUjAFZXB -ktWvJgr4yPOwhB9LLuwwyP5W7X7h/q4Iu/e+FPDCVxtB8ccnv/xfzU/+vKrS872xiO2OrXIycl3l -VMkjYADBCAjAQAYygKMLZIAu9JpA55D3AAbcZWkOoEACSCCBBQhLb9ITHKcKpLUYBGBtL5mLbxwQ -vZcJwAEWkAACDNEADQwweBLIQAptpR0KeK4CvKHAMTj3ALJUiwQEGMcEJ0cLjX1NS5FAHArA0pL5 -QKU2D+DKRYzBG5v1ZoC0EmAGLtAm7qypcxU4/l9vdmObsxFAKwkYjT700Ypfra4sG7QFDFBhjAbM -Rk36sRUCaaM5z03AcxYYICCrFhUJcM5mm5tAVWbCFZwsbFDEIEstqAc2TABpBPxagT7egT+6NKpC -baoArRZItwtgQIsyvKEV1xTKF13oLmhaSdo4mQB+jUN+z0KPESfnhxQwUTpowo6tQkk3QBrvAgZE -ZQYw4LkLiFJCm3uUzCr2yu84JSUuGRkABqCK0/lrXJZMVSYBsCuBNUIY8zhJXbgTTc+d0pSnHKA8 -5YnMQerGUY+yWKRuxhfbcUh0E+wmLsEZTlKMoJwGOicq0mlHqLCzmO88pTLnWU/PVUwv+JzZ/ppk -xM9r+iUi5QCAQHk1v4JGwyfhkISmUoOGkDWIAbKhVzuNGc95ZsCFMkwfDV8UTZvNbKcjhIlwisbN -bpKOkkiEhCZasbAB4EkEhnsM/qpjLWJCtKY2XSYXqzYhBXJ1QvexJo48Mw9UhGOk7jpiHOUYRHcQ -wEvReg9Y3qGAyDwFo01aICAnKk8MpK9q96GQKK1oM/3UiC9kpYfe+vZNcK5VFoXAE1jEgqpouTQ6 -ubJjFR11Q+Pxta/Io5CEWGm30XZHSkLlSlnxlJG9IRVIJyUcAgigjlPs6bLlSMZWPMlKzun1sy90 -Jg3VpMC5FfZJtYkKVoSqI1WMlHr/+Bex/hpGh90JRjCmaAY5RIaoYG60mJ4VoAs1QN55pjA3jaoA -Mx/Fx+3YBy9ZASmq9HbUTKzCkr8ixRoAYN1xYLdkR0FKdwspWL3C86Y3La88z4tHBa5XkaZ9r38a -Kbr5MmyS921XfqFBzgJUAzRg0S4+WlLHp2zWhnNDJnDlqUjuBFa9fqVAVJB7GSl9tKyoei50w0aK -H5EziMq6hynitd17IEqzMmMTKVU8QJwiWIYPyI9lFGhKLuLFlcmF70xASlm0eg2JseXwbEdiDeoa -pR6cnEdKopxk9AEvqwO8gBezNWOaSQBH+akxfFFik9metW/25ZTh3OjjUyEEpeEQlcji/oNkqiHv -eFh9oa14ozkF4CFii5pAOmCal/eils/IUIcdBoPLPRnupAsT6TjmOg8DZQLNmE0GAhO4OXfGU6L5 -pMsEHCAsHIlHBDKxzJzMlAx6lCwWjCWpWjcMEgHsTh9wQwWRt0tXyCBwSUq2tUSZublTRcA8k0MA -jnyEAGHP5io5OtvuthkOxr6LoPntMRrcscZqQCJMgzoHSp7YVRs2E5AVVYYBMCeTX1arAQiAInhw -FKCzPfUX0zspj6eLMXqrw95nFUa+acfvJfnbeAA/ngUETnCVGDwCCFf4jXJ0jA8BAOLyC1xp4ti3 -VjjcIvf27+galCsTS0jJC0SmipFn/gEItCRJKHuKcDCzXNWWdXdoUKq7xcLBMJdiBJeaqzGUOtdU -QA4iu31idkJpzGPe0Lj0kVMUMUcfLTM8HVYyRLzaHXHWXe+xGIOqOFR2Km7qvBoPObJmC0mxWh9T -5HWj1XGllJnZLJLYoftQ1EfNN7FQfeKBxl5qSK1UV43uFJAJu2W+q1dAzs1JGy0sdmzkdtWKTjBs -mDegvabLDctiBdOeK0/QptvqiF1z4D09rVI/MRfb6EYAAqioS0BqafwqqRp75DhN0HlR7V1UEIEJ -faoKRuFHCtu20s93NGQmY6vCEXqqu6ChT/FSTJ80mVCW17ue/YbyO9ucU/yTvi9+/uT/h8LXgH6z -xzoFAiTDkmooEC+9EgyKxnuR0Xa2EUr7JCkxsn96sXCpFQ+fN33TkmwaA0e290guswh9cFar1nXE -oGYPQngWkhvZQUMVIjO7ASBIMxwXAVmYhDtbsydVp1TiohGkoQ3x5ypdR0fd1R/8piaaEWUTQxma -MwENxHamchOvhyfSkhqLJQ1GVHUfqAoDMQ0lOAtECB3nMBkxdRc3IgFOQQwj0SEScYMFUDkOUEuR -ZxyR0EbNt4Uzp2HihIPhEmimYRRjiA/SUSYtEhUhggh9klCewglqEYf5oAqikDru1zUfeEQadoCl -k3kBMF2t8jYqsma+F0XTYAeE/jERRMgPF8EJJRg5p7Nf29R8zkdQriNdbvRWaNFjg+OJYZJbiMIU -TVEdFVITW0EVw1UfY4UTkVBs/zUWJDNQVCdotciHzjIInWhfuyhOwEASSgGMLKJrtkKMMRErF4KM -S6GMBMCMPME/I/CMJJVL6/c1G3SADAFVW8OHj6Qu3KVvZrgoa5d9jDcXwqGDkVdEIIKNlQdbrGA9 -G0Ms3dBjpDN30bd3IjM7dmUV/oEjEpFOv5gjCzNXQkYLY0EYAuUu0ViAQPMsrQN/v9CQvKhojAMX -1RETvoMMUxQgoaMOj+Qq3XSHwuI37lJSyTFoccQIjQEsdqcxnrdo8ZFZ/hEZ/s1VklvYK7hDOiZw -SwO1QUBTOAy5Me3zcghJe/m1lKQSirZzlluBY4OBCdCwjj0WKOGSEY1ld6bBBykpj+y4TVLnfg3Z -LpmgaIQCD/7kF2eZDKFWHJATGj3pLkAURLMwSQR4RHb5L3jpiHtJOpHpRoCZgoJJmNyzIYcJObqH -lc5ykI7pTUF5PckhMIOGCaYwAgMzDYv5gcCCELFWExtCjLBxYzipceKUJT85gJcYJNYjj/aFKlCl -i8LZM8fZgPcAGYZpmNPRGbIUIIIhP98yGCV5kqq5kK7zOqQgDstwjcoJaAQ4hEVohArRjb7Tnn1W -W6QGiz4ii6kpmSNil3so/oj8AJaC80bMiZ4k4RXrmW7ppiOK6S+MwE3LKZR9YpcCYzosUwqiIZGB -Zoku2ZzOSWKhEzqvgZPqlgo800vSMxhBuX5lcSDMMSJocI2m6H5z5Zd+Y57joo2ZEibRsS4RIaCB -gV2s0yNTB10oGTDyyUt9owr+ZYUVSlKvRXE1imb1IA/FQBwVUQ3/YAk7WJp3t5B1yQfnYRR+c6R9 -WKElCmbHyZNOKgxQaidTKpKeUAJXmlZaaSB/8gYs2Yet8iG66FqrM3PK2SqZIipSuiORiDpXOXXn -ST9ggxxvKYYHERoQR3eZ51jRJ307KX/1ADmDgX4h8o7wGKSFYwmNOF1D/kiEmBKWWoiSa/WBYriO -reKHJnA6qtNYCjmUZ+AwQFGaZcqTukd3hoqqs8qnO7gnKbCDphinxGkak8hS8YZhrSKaIOpc7kaX -Q0mcJJgHiDqCRGShkNWXItIRDsOilsgrzbqURuWB8RgkdfkJ6MKp7/KrItIclbApgSM/C3gQ8leu -0YqJ6YGizLGuJdos54quzPEKCiiqXcOTY6iDMrp+XFmX96lEhsFNkElJ8Iau8NoJpdk17tesiamd -j8mDtIqsXKKpLLAGSkqbg3YgfFAJBPEw4TpJzjWuoWGu0howA6scJKsCpFaitogerlMJoJCAFAez -ftqok+Wx1MOataoYPi3LAqJ6np5qswKRAr+ppAI1rq64sOAktTZwqmuFX/u6sggCsTBKtDGrq5Bj -oTW7tBCrAr/JoNOKGGwLByEAADs= -") - (setq url-current-mime-viewer (mm-mime-info "image/gif" nil 5) - url-current-mime-type "image/gif" - url-current-mime-headers - '(("content-transfer-encoding" . "base64") - ("content-type" . "image/gif")))) - ((string= "bW96aWxsYQ==" (base64-encode node)) - (insert - " -PGh0bWw+CiAgPGhlYWQ+CiAgICA8dGl0bGU+VGhlIEJvb2sgb2YgTW96aWxsYSwgMTg6Mjc8L3Rp -dGxlPgogIDwvaGVhZD4KICA8Ym9keSBiZ2NvbG9yPSIjODAwMDAwIiB0ZXh0PSIjRkZGRkZGIj4K -ICAgIDxociBhbGlnbj1jZW50ZXIgd2lkdGg9Ijc1JSI+CiAgICA8cD4KICAgICBBbmQgSSBzYXcg -YW4gU0dNTCBwdXJpc3QgY29tZSBkb3duIGZyb20gTUlULCBoYXZpbmcgdGhlIGtleSBvZgogICAg -IHRoZSBib3R0b21sZXNzIHBpdCBhbmQgYSBncmVhdCBjaGFpbiBpbiBoaXMgaGFuZC4KICAgIDwv -cD4KICAgIDxwPgogICAgIEFuZCBoZSBsYWlkIGhvbGQgb24gTW96aWxsYSwgdGhhdCBvbGQgc2Vy -cGVudCwgd2hpY2ggaXMgdGhlCiAgICAgPHNlY3JldD5NYXJjQTwvc2VjcmV0PiwgYW5kIHRoZSA8 -c2VjcmV0PkppbUM8L3NlY3JldD4sIGFuZAogICAgIGJvdW5kIGhpbSBhIHRob3VzYW5kIHllYXJz -LgogICAgPC9wPgogICAgPHA+CiAgICAgQW5kIGNhc3QgaGltIGludG8gdGhlIGJvdHRvbWxlc3Mg -cGl0LCBhbmQgc2h1dCBoaW0gdXAsIGFuZCBzZXQgYQogICAgIHNlYWwgdXBvbiBoaW0sIHRoYXQg -aGUgc2hvdWxkIGRlY2VpdmUgdGhlIG5ldCBubyBtb3JlLCB0aWxsIHRoZQogICAgIHRob3VzYW5k -IHllYXJzIHNob3VsZCBiZSBmdWxmaWxsZWQ6ICBhbmQgYWZ0ZXIgdGhhdCBoZSBtdXN0IGJlCiAg -ICAgbG9vc2VkIGEgbGl0dGxlIHNlYXNvbi4KICAgIDwvcD4KICAgIDxociB3aWR0aD0iNzUlIj4K -ICAgIDxiPjxociB3aWR0aD0iODUlIiBsYWJlbD0iIGZyb20gYGBUaGUgQm9vayBvZiBNb3ppbGxh -JycsIDE4OjI3ICI+PC9iPgogICAgPGhyIHdpZHRoPSI3NSUiPgogIDwvYm9keT4KPC9odG1sPgo= -") - (setq url-current-mime-headers - '(("content-transfer-encoding" . "base64")))) - (t - (insert " -<html> - <head> - - </head> - <body> - <p> - I don't know what you are talking about. What about " node "? - </p> - <hr width=\"75%\"> - <hype> - </body> -</html> -"))))))) - -(provide 'w3-about) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-auto.el --- a/lisp/w3/w3-auto.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,71 +0,0 @@ -;;; All the autoloads for emacs-w3 -;; Bare essentials -(autoload 'w3-open-local "w3" nil t) -(autoload 'w3-find-file "w3" nil t) -(autoload 'w3-fetch "w3" nil t) -(autoload 'w3-fetch-other-frame "w3" nil t) -(autoload 'w3-follow-url-at-point "w3" nil t) -(autoload 'w3-preview-this-buffer "w3" nil t) -(autoload 'w3 "w3" nil t) - -;; About pages -(autoload 'w3-about "w3-about") - -;; Hotlist handling -(autoload 'w3-read-html-bookmarks "w3-hot" nil t) -(autoload 'w3-hotlist-apropos "w3-hot" nil t) -(autoload 'w3-hotlist-refresh "w3-hot" nil t) -(autoload 'w3-hotlist-delete "w3-hot" nil t) -(autoload 'w3-hotlist-rename-entry "w3-hot" nil t) -(autoload 'w3-hotlist-append "w3-hot" nil t) -(autoload 'w3-parse-hotlist "w3-hot") -(autoload 'w3-use-hotlist "w3-hot" nil t) -(autoload 'w3-hotlist-add-document-at-point "w3-hot" nil t) -(autoload 'w3-hotlist-add-document "w3-hot" nil t) - -;; Printing -(autoload 'w3-print-this-url "w3-print" nil t) -(autoload 'w3-print-url-under-point "w3-print" nil t) -(autoload 'w3-parse-tree-to-latex "w3-latex") -(autoload 'w3-show-dvi "w3-latex" nil t) - -;; Stylesheet stuff -(autoload 'w3-handle-style "w3-style") -(autoload 'w3-display-stylesheet "w3-style" nil t) - -;; Setup stuff -(autoload 'url-do-setup "url") -(autoload 'w3-do-setup "w3") - -;; Forms stuff -(autoload 'w3-form-resurrect-widgets "w3-forms") -(autoload 'w3-form-add-element "w3-forms") -(autoload 'w3-do-text-entry "w3-forms") -(autoload 'w3-do-form-entry "w3-forms") -(autoload 'w3-next-widget "w3-forms") - -;; Widget stuff -(autoload 'widget-setup "wid-edit") -(autoload 'widget-create "wid-edit") -(autoload 'widget-get "wid-edit") -(autoload 'widget-put "wid-edit") -(autoload 'widget-forward "wid-edit") -(autoload 'widget-backward "wid-edit") -(autoload 'widget-at "wid-edit") - -;; URL stuff -(autoload 'url-gateway-nslookup-host "url-gw") -(autoload 'url-mail "url-mail") -(autoload 'isInNet "url-ns") -(autoload 'isResolvable "url-ns") -(autoload 'dnsResolve "url-ns") -(autoload 'dnsDomainIs "url-ns") -(autoload 'isPlainHostName "url-ns") - -;; Preferences -(autoload 'w3-preferences-edit "w3-prefs" nil t) - -(defvar widget-field-new nil) - -(provide 'w3-auto) - diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-cus.el --- a/lisp/w3/w3-cus.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,505 +0,0 @@ -;;; w3-cus.el --- Customization support for Emacs-W3 -;; Author: wmperry -;; Created: 1997/07/14 16:56:45 -;; Version: 1.11 -;; Keywords: comm, help, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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-and-compile - (condition-case () - (require 'custom) - (error nil)) - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - nil ;; We've got what we needed - ;; We have the old custom-library, hack around it! - (defmacro defgroup (&rest args) - nil) - (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))))) - -(defgroup w3 nil - "Emacs-W3 - the web browser of choice." - :group 'hypermedia) - -(defgroup w3-files nil - "Emacs-W3 configuration files." - :group 'w3 - :prefix "w3-") - -(defgroup w3-images nil - "Controlling image handling." - :group 'w3 - :prefix "w3-") - -(defgroup w3-printing nil - "Various options for hardcopy from web pages." - :group 'w3 - :prefix "w3-") - -(defgroup w3-menus nil - "The look of menus in Emacs-W3" - :group 'w3 - :prefix "w3-") - -(defgroup w3-parsing nil - "Options relating to HTML parsing" - :group 'w3 - :prefix "w3-") - -(defgroup w3-display nil - "Variables relating to how web pages are displayed." - :group 'w3 - :prefix "w3-") - -(defgroup w3-hooks nil - "Hooks relating to Emacs-W3." - :group 'w3 - :prefix "w3-") - -;;; File related variables -(defcustom w3-configuration-directory "~/.w3/" - "*Directory where Emacs-w3 can find its configuration files" - :group 'w3-files - :type 'directory) - -(defcustom w3-default-configuration-file nil - "*Where per-user customizations of w3 are kept." - :group 'w3-files - :type 'file) - -(defcustom w3-default-homepage nil - "*The url to open at startup. It can be any valid URL. -This will default to the environment variable WWW_HOME if you do not -set it in your .emacs file. If WWW_HOME is undefined, then it will -default to the hypertext documentation for W3 at Indiana University." - :group 'w3-files - :type 'string) - -(defcustom w3-default-stylesheet nil - "*The filename of the users default stylesheet." - :group 'w3-files - :type 'file) - -(defcustom w3-hotlist-file nil - "*Hotlist filename. -This should be the name of a file that is stored in either -NCSA's Mosaic/X or Netscape/X format. It is used to keep a listing -of commonly accessed URL's without having to go through 20 levels of -menus to get to them." - :group 'w3-files - :type 'file) - -(defcustom w3-documentation-root "http://www.cs.indiana.edu/elisp/w3/" - "*Where the w3 documentation lives. This MUST end in a slash." - :group 'w3-files - :type 'string) - -(defcustom w3-temporary-directory (or (getenv "TMPDIR") "/tmp") - "*Where temporary files go." - :group 'w3-files - :type 'directory) - -;;; Display related variables -(defcustom w3-display-frames nil - "*Fetch frames - can be: -nil no frame display whatsoever -'as-links display frame hyperlinks, but do not fetch them -'ask display frame hyperlinks and ask whether to fetch them -t display frame hyperlinks and fetch them." - :group 'w3-display - :type '(choice (const :tag "Do not display frames" :value nil) - (const :tag "Show hyperlinks" :value as-links) - (const :tag "Show hyperlinks, ask whether to retrieve them" :value ask) - (const :tag "Automatically retrieve frames" :value t))) - -(defcustom w3-bullets - '((disc . ?*) - (circle . ?o) - (square . ?#) - (none . ? ) - ) - "*An assoc list of unordered list types mapping to characters to use -as the bullet character." - :group 'w3-display - :type 'list) - -(defcustom w3-echo-link '(title url text name) - "*Whether to display the URL of a link when tabbing through links. -Value is a list of one or more of the following symbols: - - url == url of the target - text == text of the link - title == title attribute of the link - name == name or id attribute of the link - -If none of the information is available, nothing will be shown for the link -in menus, etc." - :group 'w3-display - :type '(set (const :tag "URL" :value url) - (const :tag "Link Text" :value text) - (const :tag "Title of the link as defined in the HTML tag" - :value title) - (const :tag "Name of the link as defined in the HTML tag" - :value name))) - -(defcustom w3-horizontal-rule-char nil - "*The character to use to create a horizontal rule. -Must be the character's code, not a string. This character is -replicated across the screen to create a division. -If nil W3 will use a terminal graphic character if possible." - :group 'w3-display - :type '(choice (const :tag "Best possible" :value nil) - (character))) - -;;; these three variables control how w3-setup-terminal-chars works -(defcustom w3-use-terminal-characters t - "*Use terminal graphics characters for drawing tables and rules if available" - :group 'w3-display - :type 'boolean) - -(defcustom w3-use-terminal-characters-on-tty nil - "*Use terminal graphics characters for tables and rules even on a tty. -This triggers display bugs on both FSF Emacs and XEmacs. -(Though it's usually tolerable at least on FSF Emacs.)" - :group 'w3-display - :type 'boolean) - -(defcustom w3-use-terminal-glyphs t - "*Use glyphs if possible rather than properties for terminal graphics characters - -Glyphs are probably more efficient but don't work with the most recent versions -of XEmacs and there are some cute tricks we can play with text-properties that -glyphs won't let us do. It may be possible someday to make XEmacs automagically -translate the characters back to ascii characters when pasted into another -buffer. (On the other hand, right now w3-excise-terminal-characters doesn't -work at all if we're using text-properties)." - :group 'w3-display - :type '(choice (const :tag "Use Glyphs" :value t) - (const :tag "Use Text Properties" :value nil))) - -(defcustom w3-do-incremental-display nil - "*Whether to do incremental display of pages or not." - :group 'w3-display - :type 'boolean) - -(defcustom w3-defined-link-types - ;; This is the HTML3.0 list (downcased) plus "made". - '("previous" "next" "up" "down" "home" "toc" "index" "glossary" - "copyright" "bookmark" "help" "made") - "A list of the (lower-case) names which have special significance -as the values of REL or REV attributes of <link> elements. They will -be presented on the toolbar or the links menu, for instance." - :group 'w3-display - :type '(repeat string)) - -;;; Parsing related variables -(defcustom w3-debug-html nil - "*Whether to gripe about bad HTML or not." - :group 'w3-parsing - :type '(choice (const :tag "HTML Errors" :value t) - (const :tag "Errors and stylistic issues" :value style) - (const :tag "None" :value nil))) - -(defcustom w3-debug-buffer "*HTML Debug*" - "*Name of buffer to store debugging information in." - :group 'w3-parsing - :type 'string) - -;;; Image related variables -(defcustom w3-auto-image-alt t - "*Whether emacs-w3 should create an alt attribute for an image that -is missing it. -If nil, emacs-w3 will not automatically create an ALT attribute. -If t, the alt attribute will be [IMAGE(nameofimage)] -If a string, it should be a string suitable for running through format, - with only one %s, which will be replaced with just the filename of the - graphic that is not loaded." - :group 'w3-images - :type '(choice (const :tag "None" :value nil) - (const :tag "Default" :value t) - string)) - -(defcustom w3-icon-directory "http://cs.indiana.edu/elisp/w3/icons/" - "*Where to find standard icons. Must end in a /!" - :group 'w3-images - :type 'string) - -(defcustom w3-icon-format 'gif - "*Image format the default icons are expected to be in. -This is a symbol, string or nil, specifing what file extension to use. -If nil, then no file extension is used." - :group 'w3-images - :type '(choice (const :tag "GIF Image" :value gif) - (const :tag "XPM Image" :value xpm) - (const :tag "XBM Image" :value xbm) - (const :tag "Let the server decide" :value nil) - (string :tag "Other"))) - -(defcustom w3-delay-image-loads nil - "*Whether to delay image loading, or automatically retrieve them." - :group 'w3-images - :type 'boolean) - -(defcustom w3-image-mappings - '( - ("image/x-xbitmap" . xbm) - ("image/xbitmap" . xbm) - ("image/xbm" . xbm) - ("image/jpeg" . jpeg) - ("image/gif" . gif) - ("image/png" . png) - ("image/x-fax" . g3fax) - ("image/x-raster" . rast) - ("image/windowdump" . xwd) - ("image/x-icon" . icon) - ("image/portable-graymap" . pgm) - ("image/portable-pixmap" . ppm) - ("image/x-pixmap" . xpm) - ("image/x-xpixmap" . xpm) - ("image/pict" . pict) - ("image/x-rgb" . sgi) - ("image/x-sgi" . sgi) - ("image/x-macpaint" . macpt) - ("image/x-targa" . tga) - ("image/tiff" . tiff) - ) - "*How to map MIME types to image types for the `image' package. -Each entry is a cons cell of MIME types and image-type symbols." - :group 'w3-images - :type '(repeat (cons :format "%v" - (string :tag "MIME Type") - (symbol :tag "Image type")))) - -;;; Printing variables -(defcustom w3-latex-docstyle "{article}" - "*The documentstyle to use when printing or mailing files as LaTeX. -Good defaults are: {article}, [psfig,twocolumn]{article}, etc." - :group 'w3-printing - :type 'string) - -(defcustom w3-latex-print-links nil - "*If non-nil, prints the URLs of hypertext links as endnotes at the end of -the document. If `footnote', prints the URL's as footnotes on a page." - :group 'w3-printing - :type '(choice (const :tag "As endnotes" :value t) - (const :tag "As footnotes" :value footnote) - (const :tag "Do not print" :value nil))) - -(defcustom w3-latex-use-latex2e nil - "*If non-nil, configures LaTeX parser to use LaTeX2e syntax. A `nil' -value indicates that LaTeX 2.0.9 compatibility will be used instead." - :group 'w3-printing - :type 'boolean) - -(defcustom w3-latex-packages nil - "*List of LaTeX packages to include when converting HTML to LaTeX. -Currently this is only used if `w3-latex-use-latex2e' is non-nil." - :group 'w3-printing - :type '(repeat string)) - -(defcustom w3-latex-use-maketitle nil - "*Non-nil makes the LaTeX parser use real LaTeX title pages." - :group 'w3-printing - :type 'boolean) - -;;; Menus -(defcustom w3-max-menu-length 35 - "*The maximum length of a pulldown menu before it will be split into -smaller chunks, with the first part as a submenu, followed by the rest -of the menu." - :group 'w3-menus - :type 'integer) - -(defcustom w3-max-menu-width 40 - "*The maximum width of a pulldown menu choice." - :group 'w3-menus - :type 'integer) - -;;; Advanced stuff -(defcustom w3-modeline-format - '(" " ("W3" - (w3-netscape-emulation-minor-mode - " (NS)") - (w3-lynx-emulation-minor-mode - " (Lynx)") - ": " - (40 (-40 "%b")) - " " - (w3-current-isindex "[Searchable] ") - (w3-current-badhtml "[BAD HTML] ") - "%p" " " global-mode-string)) - "*The modeline format string when in w3 mode" - :group 'w3-advanced - :type 'list) - -(defcustom w3-netscape-compatible-comments t - "*Whether to honor netscape-style <! > comments. -Ye gods I wish I could turn this off by default." - :group 'w3-parsing - :type 'boolean) - -(defcustom w3-notify 'semibully - "*Selects the behavior when w3 page is ready. -This variable may have one of the following values: - -newframe -- put the w3 page in its own frame -bully -- make the w3 page the current buffer and only window -semibully -- make the w3 page the current buffer in the same window -aggressive -- make the w3 page the current buffer in the other window -friendly -- display w3page in other window but don't make current -polite -- don't display w3 page, but prints message when ready (beeps) -quiet -- like `polite', but don't beep -meek -- make no indication that page is ready - -Any other value of `w3-notify' is equivalent to `meek'." - :group 'w3-display - :type '(choice (const :tag "Display in a new frame" - :value newframe) - (const :tag "Display in the current window, select buffer, and kill other windows" - :value bully) - (const :tag "Display in the current window, select buffer" - :value semibully) - (const :tag "Display in another window, select buffer" - :value aggressive) - (const :tag "Display in another window, but do not select it" - :value friendly) - (const :tag "Do not display page, but show a message and beep" - :value polite) - (const :tag "Do not display page, but show a message (no beep)" - :value quiet) - (const :tag "Do not indicate that the page has been retrieved" - :value meek))) - -(defcustom w3-popup-menu-on-mouse-3 t - "*Non-nil value means W3 should provide context-sensitive menus on mouse-3. -A nil value means W3 should not change the binding of mouse-3." - :group 'w3-display - :type 'boolean) - -(defcustom w3-print-command "lpr -h -d" - "*Print command for dvi files. -This is usually 'lpr -h -d' to send it to a postscript printer, but you can set -it up so that it is any command that takes a dvi file as its last argument." - :group 'w3-printing - :type 'string) - -(defcustom w3-reuse-buffers 'yes - "What to do when following a link will re-fetch a document that has -already been fetched into a W3 buffer. Possible values are: nil, -'yes, and 'no. Nil means ask the user if we should reuse the buffer. - A value of 'yes means assume the user wants us to reuse the buffer. -A value of 'no means assume the user wants us to re-fetch the document. - -This will also accept: -'no ==> always reload -'yes ==> always reuse -'ask ==> always ask" - :group 'w3-display - :type '(choice (const :tag "Always reload" :value no) - (const :tag "Always reuse" :value yes) - (const :tag "Always ask" :value ask))) - -(defcustom w3-right-margin 2 - "*Default right margin for Emacs-W3 buffers. -This amount is subtracted from (window-width) for each new WWW buffer -and used as the new fill-column." - :group 'w3-display - :type 'integer) - -(defcustom w3-maximum-line-length nil - "*Maximum length of a line. -If nil, then lines can extend all the way to the window margin." - :group 'w3-display - :type 'integer) - -(defcustom w3-track-mouse t - "*Whether to track the mouse and message the url under the mouse." - :group 'w3-display - :type 'boolean) - -(defcustom w3-honor-stylesheets t - "*Whether to let a document specify a CSS stylesheet." - :group 'w3-display - :type 'boolean) - -(defcustom w3-user-colors-take-precedence nil - "*Whether to let a document define certain colors about itself. -Like foreground and background colors and pixmaps, color of links and -visited links, etc." - :group 'w3-display - :type 'boolean) - -;;; Hook Variables -(defcustom w3-load-hook nil - "*Hooks to be run after loading w3." - :group 'w3-hooks - :type 'hook) - -(defcustom w3-mode-hook nil - "*Hooks to be run after entering w3-mode." - :group 'w3-hooks - :type 'hook) - -(defcustom w3-source-file-hook nil - "*Hooks to be run after getting document source." - :group 'w3-hooks - :type 'hook) - -(defcustom w3-display-errors-hook nil - "*Hooks to be run after displaying HTML errors for a page." - :group 'w3-hooks - :type 'hook) - -(defcustom w3-html-errors-font-lock-keywords - '(("\\(HTML errors for\\) \\(.*\\)" - (1 font-lock-function-name-face) (2 font-lock-reference-face)) - ("Empty \\([A-Z0-9]+\\) element." (1 font-lock-type-face)) - ("Bad attribute name syntax: \\(.*\\)" (1 font-lock-type-face)) - ("Bad attribute value syntax: \\(.*\\)" (1 font-lock-type-face)) - ("Evil attribute value syntax: \\(.*\\)" (1 font-lock-type-face)) - ("Attribute value missing end quote: \\(.*\\)" (1 font-lock-type-face)) - ("Bad start-tag \\([A-Z0-9]+\\)" (1 font-lock-type-face)) - ("\\([A-Z0-9]+\\) element has no \\([A-Z0-9]+\\) attribute" - (1 font-lock-type-face) (2 font-lock-type-face)) - (", inferring \\(</?[A-Z0-9]+>\\)" (1 font-lock-type-face)) - ("Bad unclosed \\([A-Z0-9]+\\) tag" (1 font-lock-type-face)) - ("Bad comment (unterminated or unbalanced \"\\(--\\)\" pairs)" (1 font-lock-type-face t)) - ("Obsolete element \\(.*\\)" (1 font-lock-type-face)) - ("Deprecated element \\(.*\\)" (1 font-lock-type-face)) - ("\\[deprecated inside \\([A-Z0-9]+\\)\\]" (1 font-lock-type-face)) - ("\\(</[A-Z0-9]+>\\) end-tag not omissible (required due to \\(</?[A-Z0-9]+>\\) end-tag)" - (1 font-lock-type-face) (2 font-lock-type-face)) - ("Bad data characters [\\([^][]\\)], " (1 font-lock-comment-face)) - ("Bad \\(<!\\) syntax." (1 font-lock-type-face)) - ("Unterminated IGNORE marked section.") - ("Invalid SGML character: \\(.\\)" (1 font-lock-type-face)) - ("Unmatched end-tag \\(</[A-Z0-9]+>\\)" (1 font-lock-type-face)) - ;;("</?[A-Z0-9]+>" . font-lock-type-face) - ("^ [A-Z][a-zA-Z0-9 ]*: .*" . font-lock-comment-face) - ("^ [A-Z][a-zA-Z0-9 ]*: " . font-lock-comment-face) - ("\\*ERROR\\*" 0 font-lock-keyword-face t)) - "*Font locking keywords used for HTML error display" - :group 'w3 - :type 'list) - -(provide 'w3-cus) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-display.el --- a/lisp/w3/w3-display.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2582 +0,0 @@ -;;; w3-display.el --- display engine v99999 -;; Author: wmperry -;; Created: 1997/08/12 22:51:19 -;; Version: 1.200 -;; Keywords: faces, help, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; 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 'cl) -(eval-when-compile - (require 'w3-props)) -(require 'css) -(require 'font) -(require 'w3-widget) -(require 'w3-imap) - -(define-widget-keywords :active-face :emacspeak-help :href - :name :target :title :src) -(autoload 'sentence-ify "flame") -(autoload 'string-ify "flame") -(autoload '*flame "flame") -(if (not (fboundp 'flatten)) (autoload 'flatten "flame")) -(defvar w3-cookie-cache nil) - -(defmacro w3-d-s-var-def (var) - (` (make-variable-buffer-local (defvar (, var) nil)))) - -(w3-d-s-var-def w3-display-label-marker) -(w3-d-s-var-def w3-display-open-element-stack) -(w3-d-s-var-def w3-display-alignment-stack) -(w3-d-s-var-def w3-display-list-stack) -(w3-d-s-var-def w3-display-form-id) -(w3-d-s-var-def w3-display-whitespace-stack) -(w3-d-s-var-def w3-display-liststyle-stack) -(w3-d-s-var-def w3-display-font-family-stack) -(w3-d-s-var-def w3-display-font-weight-stack) -(w3-d-s-var-def w3-display-font-variant-stack) -(w3-d-s-var-def w3-display-font-size-stack) -(w3-d-s-var-def w3-face-color) -(w3-d-s-var-def w3-face-background-color) -(w3-d-s-var-def w3-active-faces) -(w3-d-s-var-def w3-active-voices) -(w3-d-s-var-def w3-current-form-number) -(w3-d-s-var-def w3-face-font-family) -(w3-d-s-var-def w3-face-font-weight) -(w3-d-s-var-def w3-face-font-variant) -(w3-d-s-var-def w3-face-font-size) -(w3-d-s-var-def w3-face-font-family) -(w3-d-s-var-def w3-face-font-size) -(w3-d-s-var-def w3-face-font-style) -(w3-d-s-var-def w3-face-font-spec) -(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-background-image) -(w3-d-s-var-def w3-display-css-properties) -(w3-d-s-var-def w3-display-background-properties) - -(eval-when-compile - (defmacro w3-get-attribute (attr) - (` (cdr-safe (assq (, attr) args)))) - - (defmacro w3-get-face-info (info &optional other) - (let ((var (intern (format "w3-face-%s" info)))) - (` (push (w3-get-style-info (quote (, info)) node - (or (and (not w3-user-colors-take-precedence) - (cdr-safe (assq (quote (, other)) - (nth 1 node)))) - (car (, var)))) - (, var))))) - - (defmacro w3-pop-face-info (info) - (let ((var (intern (format "w3-face-%s" info)))) - (` (pop (, var))))) - - (defmacro w3-get-all-face-info () - (` - (progn - (w3-get-face-info font-family) - ;; This is to handle the 'face' attribute on arbitrary elements - (if (cdr-safe (assq 'face (nth 1 node))) - (setf (car w3-face-font-family) - (append (car w3-face-font-family) - (split-string (cdr-safe - (assq 'face (nth 1 node))) - " *, *")))) - (w3-get-face-info font-style) - (w3-get-face-info font-weight) - (w3-get-face-info font-variant) - (w3-get-face-info font-size) - (w3-get-face-info text-decoration) - (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 - :weight (car w3-face-font-weight) - :family (car w3-face-font-family) - :size (car w3-face-font-size)))))) - - (defmacro w3-pop-all-face-info () - (` - (progn - (w3-pop-face-info font-family) - (w3-pop-face-info font-weight) - (w3-pop-face-info font-variant) - (w3-pop-face-info font-size) - (w3-pop-face-info font-style) - (w3-pop-face-info text-decoration) - (w3-pop-face-info background-image) - (w3-pop-face-info color) - (w3-pop-face-info background-color)))) - - ) - -(defvar w3-display-same-buffer nil) -(defvar w3-face-cache nil "Cache for w3-face-for-element") -(defvar w3-face-index 0) -(defvar w3-image-widgets-waiting nil) - -(make-variable-buffer-local 'w3-last-fill-pos) - -(defconst w3-fill-prefixes-vector - (let ((len 0) - (prefix-vector (make-vector 80 nil))) - (while (< len 80) - (aset prefix-vector len (make-string len ? )) - (setq len (1+ len))) - prefix-vector)) - -(defconst w3-line-breaks-vector - (let ((len 0) - (breaks-vector (make-vector 10 nil))) - (while (< len 10) - (aset breaks-vector len (make-string len ?\n)) - (setq len (1+ len))) - breaks-vector)) - -(defsubst w3-pause () - (save-excursion - (goto-char (or (symbol-value 'cur-viewing-pos) (point-min))) - (cond - (w3-running-xemacs - (if (and (not (sit-for 0)) (input-pending-p)) - (condition-case () - (dispatch-event (next-command-event)) - (error nil)))) - (t - (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))))) - (set 'cur-viewing-pos (point)))) - -(defmacro w3-get-pad-string (len) - (` (cond - ((< (, len) 0) - "") - ((< (, len) 80) - (aref w3-fill-prefixes-vector (, len))) - (t (make-string (, len) ? ))))) - -(defsubst w3-set-fill-prefix-length (len) - (setq fill-prefix (if (< len (- (or w3-strict-width (window-width)) 4)) - (w3-get-pad-string len) - (url-warn - 'html - "Runaway indentation! Too deep for window width!") - fill-prefix))) - -(defsubst w3-get-style-info (info node &optional default) - (or (cdr-safe (assq info w3-display-css-properties)) default)) - -(defun w3-decode-area-coords (str) - (let (retval) - (while (string-match "\\([ \t0-9]+\\),\\([ \t0-9]+\\)" str) - (setq retval (cons (vector (string-to-int (match-string 1 str)) - (string-to-int (match-string 2 str))) retval) - str (substring str (match-end 0) nil))) - (if (string-match "\\([0-9]+\\)" str) - (setq retval (cons (vector (+ (aref (car retval) 0) - (string-to-int (match-string 1 str))) - (aref (car retval) 1)) retval))) - (nreverse retval))) - -(defun w3-normalize-color (color) - (cond - ((valid-color-name-p color) - color) - ((valid-color-name-p (concat "#" color)) - (concat "#" color)) - ((string-match "[ \t\r\n]" color) - (w3-normalize-color - (mapconcat (function (lambda (x) (if (memq x '(?\t ?\r ?\n ? )) "" - (char-to-string x)))) color ""))) - ((valid-color-name-p (font-normalize-color color)) - (font-normalize-color color)) - (t - (w3-warn 'html (format "Bad color specification: %s" color)) - nil))) - -(defsubst w3-voice-for-element (node) - (if (featurep 'emacspeak) - (let (family gain left right pitch pitch-range stress richness voice) - (setq family (w3-get-style-info 'voice-family node) - gain (w3-get-style-info 'gain node) - left (w3-get-style-info 'left-volume node) - right (w3-get-style-info 'right-volume node) - pitch (w3-get-style-info 'pitch node) - pitch-range (w3-get-style-info 'pitch-range node) - stress (w3-get-style-info 'stress node) - richness (w3-get-style-info 'richness node)) - (if (or family gain left right pitch pitch-range stress richness) - (setq voice (dtk-personality-from-speech-style - (make-dtk-speech-style :family (or family 'paul) - :gain (or gain 5) - :left-volume (or left 5) - :right-volume (or right 5) - :average-pitch (or pitch 5) - :pitch-range (or pitch-range 5) - :stress (or stress 5) - :richness (or richness 5)))) - (setq voice nil)) - (or voice (car w3-active-voices))))) - -(defun w3-make-face-emacs19 (name &optional doc-string temporary) - "Defines and returns a new FACE described by DOC-STRING. -If the face already exists, it is unmodified." - (make-face name)) - -(cond - ((not (fboundp 'make-face)) - (fset 'w3-make-face 'ignore)) - (w3-running-xemacs - (fset 'w3-make-face 'make-face)) - (t - (fset 'w3-make-face 'w3-make-face-emacs19))) - -(defsubst w3-face-for-element (node) - (w3-get-all-face-info) - (if (car w3-face-text-decoration) - (set-font-style-by-keywords w3-face-font-spec - (car w3-face-text-decoration))) - (if w3-face-font-variant - (set-font-style-by-keywords w3-face-font-spec - (car w3-face-font-variant))) - (if w3-face-font-style - (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 - (setq w3-face-face - (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))) - (setq w3-face-cache (cons - (cons w3-face-descr w3-face-face) - w3-face-cache))) - w3-face-face) - -(defun w3-normalize-spaces (string) - ;; nuke spaces in the middle - (while (string-match "[ \t\r\n][ \r\t\n]+" string) - (setq string (concat (substring string 0 (1+ (match-beginning 0))) - (substring string (match-end 0))))) - - ;; nuke spaces at the beginning - (if (string-match "^[ \t\r\n]+" string) - (setq string (substring string (match-end 0)))) - - ;; nuke spaces at the end - (if (string-match "[ \t\n\r]+$" string) - (setq string (substring string 0 (match-beginning 0)))) - string) - - -(if (not (fboundp 'char-before)) - (defun char-before (&optional pos) - (char-after (1- (or pos (point)))))) - -(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 (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) - (center - (fill-region-as-paragraph w3-last-fill-pos (point)) - (center-region w3-last-fill-pos (point-max))) - ((justify full) - (fill-region-as-paragraph w3-last-fill-pos (point) t)) - (right - (fill-region-as-paragraph w3-last-fill-pos (point)) - (goto-char w3-last-fill-pos) - (catch 'fill-exit - (while (re-search-forward ".$" nil t) - (if (>= (setq width (current-column)) fill-column) - nil ; already justified, or error - (beginning-of-line) - (insert-char ? (- fill-column width) t) - (end-of-line) - (if (eobp) - (throw 'fill-exit t)) - (condition-case () - (forward-char 1) - (error (throw 'fill-exit t)))))) - ) - (otherwise ; Default is left justification - (fill-region-as-paragraph w3-last-fill-pos (point))) - )) - (setq n (1- n))) - (setq w3-last-fill-pos (point-max)) - (insert (cond - ((<= n 0) "") - ((< n 10) - (aref w3-line-breaks-vector n)) - (t - (make-string n ?\n))))) - -(defsubst w3-munge-line-breaks-p () - (eq (car w3-display-whitespace-stack) 'pre)) - -(defvar w3-display-nil-face (if w3-running-xemacs - (w3-make-face nil "Stub face... don't ask." t) - nil)) - -(defvar w3-scratch-start-point nil) - -(defsubst w3-handle-string-content (string) - (setq w3-scratch-start-point (point)) - (insert string) - (if (w3-munge-line-breaks-p) - (progn - (goto-char w3-scratch-start-point) - (if (not (search-forward "\n" nil t)) - (subst-char-in-region w3-scratch-start-point (point-max) ?\r ?\n) - (subst-char-in-region w3-scratch-start-point (point-max) ?\r ? ))) - (goto-char w3-scratch-start-point) - (while (re-search-forward - " [ \t\n\r]+\\|[\t\n\r][ \t\n\r]*" - nil 'move) - (replace-match " ")) - (goto-char w3-scratch-start-point) - (if (and (memq (char-before) '(? ?\t ?\r ?\n)) - (looking-at "[ \t\r\n]")) - (delete-region (point) - (progn - (skip-chars-forward " \t\r\n") - (point))))) - (goto-char (point-max)) - (add-text-properties w3-scratch-start-point - (point) (list 'face w3-active-faces - 'html-stack w3-display-open-element-stack - 'start-open nil - 'end-open nil - 'front-sticky t - 'rear-nonsticky nil - 'duplicable t)) - (if (car w3-active-voices) - (add-text-properties w3-scratch-start-point (point) - (list 'personality (car w3-active-voices)))) - ) - -(defun w3-display-get-cookie (args) - (if (not (fboundp 'cookie)) - "Sorry, no cookies today." - (let* ((href (or (w3-get-attribute 'href) (w3-get-attribute 'src))) - (fname (or (cdr-safe (assoc href w3-cookie-cache)) - (url-generate-unique-filename "%s.cki"))) - (st (or (cdr-safe (assq 'start args)) "Loading cookies...")) - (nd (or (cdr-safe (assq 'end args)) "Loading cookies... done."))) - (if (not (file-exists-p fname)) - (save-excursion - (set-buffer (generate-new-buffer " *cookie*")) - (url-insert-file-contents href) - (write-region (point-min) (point-max) fname 5) - (setq w3-cookie-cache (cons (cons href fname) w3-cookie-cache)))) - (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-no-properties (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 - (setq name (concat "anchor:" name))) - (if (not (listp check)) - (setq check (cons check '(title url text name)))) - (catch 'exit - (while check - (and (boundp (car check)) - (stringp (symbol-value (car check))) - (> (length (symbol-value (car check))) 0) - (throw 'exit (symbol-value (car check)))) - (pop check))))) - -(defun w3-follow-hyperlink (widget &rest ignore) - (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) - (w3-fetch-other-frame href)) - (_top - (delete-other-windows) - (w3-fetch href)) - (otherwise - (w3-fetch href target))))) - -(defun w3-balloon-help-callback (object &optional event) - (let* ((widget (widget-at (extent-start-position object))) - (href (widget-get widget :href))) - (if href - (url-truncate-url-for-viewing href) - nil))) - - -;; Various macros -(eval-when-compile - (defmacro w3-node-visible-p () - (` (not (eq (car break-style) 'none)))) - - (defmacro w3-handle-empty-tag () - (` - (progn - (push (cons tag args) w3-display-open-element-stack) - (push content content-stack) - (setq content nil)))) - - (defmacro w3-handle-content (node) - (` - (progn - (push (cons tag args) w3-display-open-element-stack) - (push content content-stack) - (setq content (nth 2 (, node)))))) - - (defmacro w3-display-handle-list-type () - (` - (add-text-properties - (point) - (progn - (case (car break-style) - (list-item - (let ((list-style (or (car w3-display-liststyle-stack) 'disc)) - (list-num (if (car w3-display-list-stack) - (incf (car w3-display-list-stack)) - 1)) - (margin (1- (car left-margin-stack))) - (indent (w3-get-style-info 'text-indent node 0))) - (if (> indent 0) - (setq margin (+ margin indent)) - (setq margin (max 0 (- margin indent)))) - (beginning-of-line) - (case list-style - ((disc circle square) - (insert (format (format "%%%dc" margin) - (or (cdr-safe (assq list-style w3-bullets)) - ?o)))) - ((decimal lower-roman upper-roman lower-alpha upper-alpha) - (let ((x (case list-style - (lower-roman - (w3-decimal-to-roman list-num)) - (upper-roman - (upcase - (w3-decimal-to-roman list-num))) - (lower-alpha - (w3-decimal-to-alpha list-num)) - (upper-alpha - (upcase - (w3-decimal-to-alpha list-num))) - (otherwise - (int-to-string list-num))))) - (insert (format (format "%%%ds." margin) x)) - ) - ) - (otherwise - (insert (w3-get-pad-string margin))) - ) - ) - ) - (otherwise - (insert (w3-get-pad-string (+ (car left-margin-stack) - (w3-get-style-info 'text-indent node 0))))) - ) - (point)) - (list 'start-open t - 'end-open t - 'rear-nonsticky nil - 'face 'nil)))) - - (defmacro w3-display-set-margins () - (` - (progn - (push (+ (w3-get-style-info 'margin-left node 0) - (car left-margin-stack)) left-margin-stack) - (push (- - (car right-margin-stack) - (w3-get-style-info 'margin-right node 0)) right-margin-stack) - (setq fill-column (car right-margin-stack)) - (w3-set-fill-prefix-length (car left-margin-stack)) - (w3-display-handle-list-type)))) - - (defmacro w3-display-restore-margins () - (` - (progn - (pop right-margin-stack) - (pop left-margin-stack)))) - - (defmacro w3-display-handle-break () - (` - (case (car break-style) - (block ; Full paragraph break - (if (eq (cadr break-style) 'list-item) - (setf (cadr break-style) 'line) - (w3-display-line-break 1)) - (w3-display-set-margins) - (push - (w3-get-style-info 'white-space node - (car w3-display-whitespace-stack)) - w3-display-whitespace-stack) - (push - (or (w3-get-attribute 'foobarblatz) - (w3-get-style-info 'list-style-type node - (car w3-display-liststyle-stack))) - w3-display-liststyle-stack) - (push - (or (w3-get-attribute 'align) - (w3-get-style-info 'text-align node - (car w3-display-alignment-stack))) - w3-display-alignment-stack) - (and w3-do-incremental-display (w3-pause))) - ((line list-item) ; Single line break - (w3-display-line-break 0) - (w3-display-set-margins) - (push - (or (w3-get-attribute 'foobarblatz) - (w3-get-style-info 'list-style-type node - (car w3-display-liststyle-stack))) - w3-display-liststyle-stack) - (push - (w3-get-style-info 'white-space node - (car w3-display-whitespace-stack)) - w3-display-whitespace-stack) - (push - (w3-get-style-info 'text-align node - (or (w3-get-attribute 'align) - (car w3-display-alignment-stack))) - w3-display-alignment-stack)) - (otherwise ; Assume 'inline' rendering as default - nil)) - ) - ) - - (defmacro w3-display-progress-meter () - (` - (url-lazy-message "Drawing... %c" (aref "/|\\-" (random 4))))) - - (defmacro w3-display-handle-end-break () - (` - (case (pop break-style) - (block ; Full paragraph break - (w3-display-line-break 1) - (w3-display-restore-margins) - (pop w3-display-whitespace-stack) - (pop w3-display-liststyle-stack) - (pop w3-display-alignment-stack) - (and w3-do-incremental-display (w3-pause))) - ((line list-item) ; Single line break - (w3-display-restore-margins) - (w3-display-line-break 0) - (pop w3-display-whitespace-stack) - (pop w3-display-liststyle-stack) - (pop w3-display-alignment-stack)) - (otherwise ; Assume 'inline' rendering as default - nil)) - ) - ) - ) - -;; <link> handling -(defun w3-parse-link (args) - (let* ((type (if (w3-get-attribute 'rel) 'rel 'rev)) - (desc (w3-get-attribute type)) - (dc-desc (and desc (downcase desc))) ; canonical case - (dest (w3-get-attribute 'href)) - (plist (alist-to-plist args)) - (node-1 (assq type w3-current-links)) - (node-2 (and node-1 desc (or (assoc desc - (cdr node-1)) - (assoc dc-desc - (cdr node-1))))) - ) - ;; Canonicalize the case of link types we may look for - ;; specifically (toolbar etc.) since that's done with - ;; assoc. See `w3-mail-document-author' and - ;; `w3-link-toolbar', at least. - (if (member dc-desc w3-defined-link-types) - (setq desc dc-desc)) - (if dest ; ignore if HREF missing - (cond - (node-2 ; Add to old value - (setcdr node-2 (cons plist (cdr node-2)))) - (node-1 ; first rel/rev - (setcdr node-1 (cons (cons desc (list plist)) - (cdr node-1)))) - (t (setq w3-current-links - (cons (cons type (list (cons desc (list plist)))) - w3-current-links))))) - (setq desc (and desc (intern dc-desc))) - (case desc - ((style stylesheet) - (if w3-honor-stylesheets - (w3-handle-style plist))) - (otherwise - ) - ) - ) - ) - - -;; Image handling -(defun w3-maybe-start-image-download (widget) - (let* ((src (widget-get widget :src)) - (cached-glyph (w3-image-cached-p src))) - (cond - ((and cached-glyph - (widget-glyphp cached-glyph) - (not (eq 'nothing - (image-instance-type - (glyph-image-instance cached-glyph))))) - (setq w3-image-widgets-waiting (cons widget w3-image-widgets-waiting))) - ((or w3-delay-image-loads ; Delaying images - (not (fboundp 'valid-specifier-domain-p)) ; Can't do images - (eq (device-type) 'tty)) ; Why bother? - (w3-add-delayed-graphic widget)) - ((not (w3-image-loadable-p src nil)) ; Hey, we can't load it! - (mesage "Skipping image %s" (url-basepath src t)) - (w3-add-delayed-graphic widget)) - (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 (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-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) - (node nil)) - (message "Enhancing image...") - (setq glyph (image-normalize (cdr-safe (assoc url-current-mime-type - w3-image-mappings)) - (buffer-string))) - (message "Enhancing image... done") - (kill-buffer (current-buffer)) - (cond - ((w3-image-invalid-glyph-p glyph) - (setq glyph nil) - (message "Reading of %s failed." url)) - ((eq (aref glyph 0) 'xbm) - (let ((temp-fname (url-generate-unique-filename "%s.xbm"))) - (save-excursion - (set-buffer (generate-new-buffer " *xbm-garbage*")) - (erase-buffer) - (insert (aref glyph 2)) - (setq glyph temp-fname) - (write-region (point-min) (point-max) temp-fname) - (kill-buffer (current-buffer))) - (setq glyph (make-glyph (list (cons 'x glyph)))) - (condition-case () - (delete-file temp-fname) - (error nil)))) - (t - (setq glyph (make-glyph glyph)))) - (setq node (assoc url w3-graphics-list)) - (cond - ((and node glyph) - (set-glyph-image (cdr node) (glyph-image glyph))) - (glyph - (setq w3-graphics-list (cons (cons url glyph) w3-graphics-list))) - (t nil)) - - (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 () - (` - (let* ((height (w3-get-attribute 'height)) - (width (w3-get-attribute 'width)) - (src (or (w3-get-attribute 'src) "Error Image")) - (our-alt (cond - ((null w3-auto-image-alt) "") - ((eq t w3-auto-image-alt) - (concat "[IMAGE(" (url-basepath src t) ")] ")) - ((stringp w3-auto-image-alt) - (format w3-auto-image-alt (url-basepath src t))))) - (alt (or (w3-get-attribute 'alt) our-alt)) - (c nil) - (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))) - (widget nil) - (align (or (w3-get-attribute 'align) - (w3-get-style-info 'vertical-align node)))) - (while (setq c (string-match "[\C-i\C-j\C-l\C-m]" alt)) - (aset alt c ? )) - (if (assq '*table-autolayout w3-display-open-element-stack) - (insert alt) - (setq widget (widget-create 'image - :value-face w3-active-faces - :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 - )) - (widget-put widget 'buffer (current-buffer)) - (w3-maybe-start-image-download widget) - (if (widget-get widget :from) - (add-text-properties (widget-get widget :from) - (widget-get widget :to) - (list 'html-stack w3-display-open-element-stack))) - (goto-char (point-max)))))) - -;; The table handling -(eval-and-compile - (cond - ((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 ?:))) - ((and (featurep 'mule) (not (charsetp 'w3-dingbats))) - (define-charset nil 'w3-dingbats - (vector - 1 ; dimension - 96 ; chars - 1 ; width - 0 ; direction - ?: ; iso-final-char - 1 ; iso-graphic-plane (whats this?) - "dingbats" "emacs/w3-dingbats" - "Dingbats character set for Emacs/W3"))) - (t - nil))) - -(defun w3-make-char (oct) - (if (and w3-running-xemacs (featurep 'mule)) - (make-char 'w3-dingbats (if (characterp oct) (char-int oct) oct)) - oct)) - -(defvar w3-table-ascii-border-chars - [nil nil nil ?+ nil ?- ?+ ?- nil ?+ ?| ?| ?+ ?- ?| ?+] - "*Vector of ascii characters to use to draw table borders. -This vector is used when terminal characters are unavailable") - -(defvar w3-table-glyph-border-chars - [nil nil nil 11 nil 2 7 14 nil 3 8 6 1 15 4 5] - "Vector of characters to use to draw table borders. -This vector is used when terminal characters are used via glyphs") - -(defvar w3-table-graphic-border-chars - (vector - nil - nil - nil - (w3-make-char ?j) - nil - (w3-make-char ?q) - (w3-make-char ?m) - (w3-make-char ?v) - nil - (w3-make-char ?k) - (w3-make-char ?x) - (w3-make-char ?u) - (w3-make-char ?l) - (w3-make-char ?w) - (w3-make-char ?t) - (w3-make-char ?n)) - "Vector of characters to use to draw table borders. -This vector is used when terminal characters are used directly") - -(defvar w3-table-border-chars w3-table-ascii-border-chars - "Vector of characters to use to draw table borders. -w3-setup-terminal-chars sets this to one of -w3-table-ascii-border-chars, -w3-table-glyph-border-chars, or -w3-table-graphic-border-chars.") - -(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) - (if b 8 0)))) - -(defvar w3-terminal-properties nil) - -(defsubst w3-insert-terminal-char (character &optional count inherit) - (if w3-terminal-properties - (set-text-properties (point) - (progn - (insert-char (or character ? ) - (or count 1) inherit) - (point)) - w3-terminal-properties) - (insert-char (or character ? ) (or count 1) inherit))) - -(defsubst w3-horizontal-rule-char nil - (or w3-horizontal-rule-char (w3-table-lookup-char t nil t 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. - -Initializes a number of variables: -w3-terminal-properties to either nil or a list of properties including 'face -w3-table-border-chars to one of the the three other vectors" - (interactive) - (setq w3-table-border-chars w3-table-ascii-border-chars - w3-terminal-properties nil) - (cond - ((and w3-use-terminal-characters - (eq (device-type) 'x)) - (if (and (find-face 'w3-table-hack-x-face) - (face-differs-from-default-p 'w3-table-hack-x-face)) - nil - (make-face 'w3-table-hack-x-face) - (if (not (face-differs-from-default-p 'w3-table-hack-x-face)) - (font-set-face-font 'w3-table-hack-x-face - (make-font :family "terminal" - :registry "*" - :encoding "*" - )))) - (cond - ((not (face-differs-from-default-p 'w3-table-hack-x-face)) - nil) - ((and w3-use-terminal-glyphs (fboundp 'face-id)) - (let ((id (face-id 'w3-table-hack-x-face)) - (c (length w3-table-border-chars))) - (while (> (decf c) 0) - (if (aref w3-table-glyph-border-chars c) - (aset standard-display-table (aref w3-table-glyph-border-chars c) - (vector (+ (* 256 id) - (aref w3-table-graphic-border-chars c)))))) - (setq w3-table-border-chars w3-table-glyph-border-chars - w3-terminal-properties nil))) - (t - (setq w3-table-border-chars w3-table-graphic-border-chars - w3-terminal-properties (list 'start-open t - 'end-open t - 'rear-nonsticky t - 'w3-table-border t - 'face 'w3-table-hack-x-face))))) - ((and w3-use-terminal-characters-on-tty - (eq (device-type) 'tty)) - (let ((c (length w3-table-border-chars))) - (while (> (decf c) 0) - (and (aref w3-table-glyph-border-chars c) - (aref w3-table-graphic-border-chars c) - (standard-display-g1 (aref w3-table-glyph-border-chars c) - (aref w3-table-graphic-border-chars c))))) - (setq w3-table-border-chars w3-table-glyph-border-chars - w3-terminal-properties (list 'w3-table-border t))) - (t - nil)) - w3-table-border-chars) - -(defun w3-unsetup-terminal-characters nil - (interactive) - (w3-excise-terminal-characters (buffer-list)) - (standard-display-default 1 15) - (setq w3-table-border-chars w3-table-ascii-border-chars)) - -(defun w3-excise-terminal-characters (buffs) - "Replace hacked characters with ascii characters in buffers BUFFS. -Should be run before restoring w3-table-border-chars to ascii characters. -This will only work if we used glyphs rather than text properties" - (interactive (list (list (current-buffer)))) - (let ((inhibit-read-only t) - (tr (make-string 16 ? )) - (i 0)) - (while (< i (length tr)) - (aset tr i i) - (setq i (1+ i))) - (setq i 0) - (while (< i (length w3-table-border-chars)) - (and (aref w3-table-border-chars i) - (< (aref w3-table-border-chars i) 16) - (aset tr - (aref w3-table-glyph-border-chars i) - (aref w3-table-ascii-border-chars i))) - (setq i (1+ i))) - (mapcar (function (lambda (buf) - (save-excursion - (set-buffer buf) - (if (eq major-mode 'w3-mode) - (translate-region (point-min) - (point-max) - tr))))) - buffs))) - - -(defvar w3-display-table-cut-words-p nil - "*Whether to cut words that are oversized in table cells") - -(defvar w3-display-table-force-borders nil - "*Whether to always draw table borders -Can sometimes make the structure of a document clearer") - -(defun w3-display-table-cut () - (save-excursion - (goto-char (point-min)) - (let ((offset -1)) - (while (< offset 0) - (end-of-line) - (setq offset (- fill-column (current-column))) - (cond ((< offset 0) - (condition-case nil - (progn (forward-char offset) - (insert ?\n)) - (error (setq offset 0)))) - ((not (eobp)) - (forward-line 1) - (setq offset -1))))))) - - -(defun w3-display-fix-widgets () - ;; Make markers belong to the right buffer - (save-excursion - (let ((st (point-min)) - (nd nil) - (widget nil) parent - (to-marker nil) - (from-marker nil)) - (while (setq st (next-single-property-change st 'button)) - (setq nd (or (next-single-property-change st 'button) (point-max)) - widget (widget-at st) - to-marker (and widget (widget-get widget :to)) - from-marker (and widget (widget-get widget :from)) - parent (and widget (widget-get widget :parent)) - ) - (if (not widget) - nil - (widget-put widget :from (set-marker (make-marker) st)) - (widget-put widget :to (set-marker (make-marker) nd)) - (if (not parent) - nil - (widget-put parent :from (set-marker (make-marker) st)) - (widget-put parent :to (set-marker (make-marker) nd)))) - (if (condition-case () - (get-text-property (1+ nd) 'button) - (error nil)) - (setq st nd) - (setq st (min (point-max) (1+ nd)))))))) - -(defun w3-size-of-tree (tree minmax) - (declare (special args)) - (save-excursion - (save-restriction - (narrow-to-region (point) (point)) - ;; XXX fill-column set to 1 fails when fill-prefix is set - ;; XXX setting fill-column at all isn't really right - ;; for example <hr>s shouldn't be especially wide - ;; we should set a flag that makes w3 never wrap a line - (let ((fill-column (cond ((eq minmax 'min) - 3) - ((eq minmax 'max) - 400))) - (fill-prefix "") - (w3-last-fill-pos (point-min)) - a retval - (w3-do-incremental-display nil) - (hr-regexp (concat "^" - (regexp-quote - (make-string 5 (w3-horizontal-rule-char))) - "*$")) - ) - ;;(push 'left w3-display-alignment-stack) - (push (if (eq minmax 'max) 'nowrap) w3-display-whitespace-stack) - (while tree - (push (cons '*td args) w3-display-open-element-stack) - (w3-display-node (pop tree))) - (pop w3-display-whitespace-stack) - (goto-char (point-min)) - (while (re-search-forward hr-regexp nil t) - (replace-match "" t t)) - (goto-char (point-min)) - (while (not (eobp)) - ;; loop invariant: at beginning of uncounted line - (end-of-line) - (skip-chars-backward " ") - (setq retval (cons (current-column) - retval)) - (beginning-of-line 2)) - (if (= (point-min) (point-max)) - (setq retval 0) - (setq retval (apply 'max (cons 0 retval)))) - (delete-region (point-min) (point-max)) - retval)))) - -(defun w3-display-table-dimensions (node) - ;; fill-column sets maximum width - (declare (special args)) - (let (min-vector - max-vector - rows cols - ;;(w3-form-elements (and (boundp 'w3-form-elements) w3-form-elements)) - (table-info (assq 'w3-table-info (cadr node)))) - - (if table-info - (setq min-vector (nth 1 table-info) - max-vector (nth 2 table-info) - rows (nth 3 table-info) - cols (nth 4 table-info)) - - (push (cons '*table-autolayout args) w3-display-open-element-stack) - (let (content - cur - (table-spans (list nil)) ; don't make this '(nil) - ptr - col - constraints - - colspan rowspan min max) - (setq content (nth 2 node)) - (setq rows 0 cols 0) - (while content - (setq cur (pop content)) - (if (stringp cur) - nil - (case (car cur) - ((thead tfoot col colgroup) - (if (nth 2 cur) - (setq content (append (nth 2 cur) content)))) - (tr - (setq col 0) - (setq rows (1+ rows)) - (setq ptr table-spans) - (mapcar - (function - (lambda (td) - (setq colspan (string-to-int (or (cdr-safe (assq 'colspan (nth 1 td))) "1")) - rowspan (string-to-int (or (cdr-safe (assq 'rowspan (nth 1 td))) "1")) - min (w3-size-of-tree (nth 2 td) 'min) - max (w3-size-of-tree (nth 2 td) 'max) - ) - (while (eq (car-safe (car-safe (cdr ptr))) col) - (setq col (+ col (cdr (cdr (car (cdr ptr)))))) - (if (= 0 (decf (car (cdr (car (cdr ptr)))))) - (pop (cdr ptr)) - (setq ptr (cdr ptr)))) - (push (list col colspan min max) - constraints) - (if (= rowspan 1) nil - (push (cons col (cons (1- rowspan) colspan)) (cdr ptr)) - (setq ptr (cdr ptr))) - (setq col (+ col colspan)) - )) - (nth 2 cur)) - (while (cdr ptr) - (if (= 0 (decf (car (cdr (car (cdr ptr)))))) - (pop (cdr ptr)) - (setq ptr (cdr ptr)))) - (setq cols (max cols col)) - ) - (caption - nil) - (otherwise - (setq content (nth 2 cur))) - ) - ) - ) - (setq constraints (sort constraints - (function - (lambda (a b) - (< (cadr a) (cadr b))))) - min-vector (make-vector cols 0) - max-vector (make-vector cols 0)) - (let (start end i mincellwidth maxcellwidth) - (mapcar (function (lambda (c) - (cond ((= (cadr c) 1) - (aset min-vector (car c) - (max (aref min-vector (car c)) - (nth 2 c))) - (aset max-vector (car c) - (max (aref max-vector (car c)) - (nth 3 c)))) - (t - (setq start (car c) - end (+ (car c) (cadr c)) - mincellwidth 0 - maxcellwidth 0 - i start) - (while (< i end) - (setq mincellwidth (+ mincellwidth - (aref min-vector i)) - maxcellwidth (+ - maxcellwidth - (aref max-vector i)) - i (1+ i))) - (setq i start) - (if (= mincellwidth 0) - ;; if existing width is 0 divide evenly - (while (< i end) - (aset min-vector i - (/ (nth 2 c) (cadr c))) - (aset max-vector i - (/ (nth 3 c) (cadr c))) - (setq i (1+ i))) - ;; otherwise weight it by existing widths - (while (< i end) - (aset min-vector i - (max (aref min-vector i) - (/ (* (nth 2 c) - (aref min-vector i)) - mincellwidth))) - (aset max-vector i - (max (aref max-vector i) - (/ (* (nth 3 c) - (aref max-vector i)) - maxcellwidth))) - (setq i (1+ i)))) - )))) - constraints))) - (push (cons 'w3-table-info - (list min-vector max-vector rows cols)) - (cadr node)) - (pop w3-display-open-element-stack)) - - (let (max-width - min-width - ret-vector - col - ) - - - (setq max-width (apply '+ (append max-vector (list cols 1)))) - (setq min-width (apply '+ (append min-vector (list cols 1)))) - - ;; the comments in the cond are excerpts from rfc1942 itself - (cond - ;; 1. The minimum table width is equal to or wider than the available - ;; space. In this case, assign the minimum widths and allow the - ;; user to scroll horizontally. For conversion to braille, it will - ;; be necessary to replace the cells by references to notes - ;; containing their full content. By convention these appear - ;; before the table. - ((>= min-width fill-column) - (setq ret-vector min-vector)) - - ;; 2. The maximum table width fits within the available space. In - ;; this case, set the columns to their maximum widths. - ((<= max-width fill-column) - (setq ret-vector max-vector)) - - ;; 3. The maximum width of the table is greater than the available - ;; space, but the minimum table width is smaller. In this case, - ;; find the difference between the available space and the minimum - ;; table width, lets call it W. Lets also call D the difference - ;; between maximum and minimum width of the table. - - ;; For each column, let d be the difference between maximum and - ;; minimum width of that column. Now set the column's width to the - ;; minimum width plus d times W over D. This makes columns with - ;; large differences between minimum and maximum widths wider than - ;; columns with smaller differences. - (t - (setq ret-vector (make-vector cols 0)) - (let ((W (- fill-column min-width)) - (D (- max-width min-width)) - d extra) - (setq col 0) - (while (< col (length ret-vector)) - (setq d (- (aref max-vector col) - (aref min-vector col))) - (aset ret-vector col - (+ (aref min-vector col) - (/ (* d W) D))) - (setq col (1+ col))) - (setq extra (- fill-column - (apply '+ (append ret-vector - (list (length ret-vector) 1)))) - col 0) - (while (and (< col (length ret-vector)) (> extra 0)) - (if (= 1 (- (aref max-vector col) (aref ret-vector col) )) - (aset ret-vector col (1+ (aref ret-vector col)))) - (setq extra (1- extra) - col (1+ col))) - ))) - (list rows cols ret-vector)))) - -(defun w3-display-table (node) - (let* ((dimensions (w3-display-table-dimensions node)) - (num-cols (max (cadr dimensions) 1)) - (num-rows (max (car dimensions) 1)) - (column-dimensions (caddr dimensions)) - (table-width (apply '+ (append column-dimensions (list num-cols 1))))) - (cond - ((or (<= (cadr dimensions) 0) (<= (car dimensions) 0)) - ;; We have an invalid table - nil) - ((assq '*table-autolayout w3-display-open-element-stack) - ;; don't bother displaying the table if all we really need is the size - (progn (insert-char ?T table-width) (insert "\n"))) - (t - (let* ((tag (nth 0 node)) - (args (nth 1 node)) - (border-node (cdr-safe (assq 'border args))) - (border (or w3-display-table-force-borders - (and border-node - (or (/= 0 (string-to-int border-node)) - (string= "border" border-node))))) - (w3-table-border-chars - (if border - w3-table-border-chars - (make-vector (length w3-table-border-chars) ? ))) - valign align - (content (nth 2 node)) - (avgwidth (/ (- fill-column num-cols num-cols) num-cols)) - (formatted-cols (make-vector num-cols nil)) - (table-rowspans (make-vector num-cols 0)) - (table-colspans (make-vector num-cols 1)) - (prev-colspans (make-vector num-cols 0)) - (prev-rowspans (make-vector num-cols 0)) - (table-colwidth (make-vector num-cols 0)) - (fill-prefix "") - (height nil) - (cur-height nil) - (cols nil) - (rows nil) - (row 0) - (this-rectangle nil) - (inhibit-read-only t) - (i 0) - ) - - (push (cons tag args) w3-display-open-element-stack) - - (if (memq 'nowrap w3-display-whitespace-stack) - (setq fill-prefix "") - (case (car w3-display-alignment-stack) - (center - (w3-set-fill-prefix-length - (max 0 (/ (- fill-column table-width) 2)))) - (right - (w3-set-fill-prefix-length - (max 0 (- fill-column table-width)))) - (t - (setq fill-prefix "")))) - (while content - (case (caar content) - ((thead tfoot col colgroup) - (if (nth 2 (car content)) - (setq content (append (nth 2 (car content)) (cdr content))) - (setq content (cdr content)))) - (tr - (setq w3-display-css-properties (css-get - (nth 0 (car content)) - (nth 1 (car content)) - w3-current-stylesheet - w3-display-open-element-stack)) - (setq cols (nth 2 (car content)) - valign (or (cdr-safe (assq 'valign (nth 1 (car content)))) - (w3-get-style-info 'vertical-align node)) - align (or (cdr-safe (assq 'align (nth 1 (car content)))) - (w3-get-style-info 'text-align node)) - content (cdr content) - row (1+ row)) - (if (and valign (stringp valign)) - (setq valign (intern (downcase valign)))) - ;; this is iffy - ;;(if align (push (intern (downcase align)) w3-display-alignment-stack)) - (save-excursion - (save-restriction - (narrow-to-region (point) (point)) - (setq fill-column avgwidth - w3-last-fill-pos (point-min) - i 0) - ;; skip over columns that have leftover content - (while (and (< i num-cols) - (/= 0 (aref table-rowspans i))) - (setq i (+ i (max 1 (aref table-colspans i))))) - ;; Need to push the properties for the table onto the stack - (setq w3-display-css-properties (css-get - tag - args - w3-current-stylesheet - w3-display-open-element-stack)) - (push (w3-face-for-element (list tag args nil)) w3-active-faces) - (push (w3-voice-for-element (list tag args nil)) w3-active-voices) - (push (cons tag args) w3-display-open-element-stack) - (while cols - ;; And need to push these bogus placeholders on there - ;; so that w3-display-node doesn't pop off the real face - ;; or voice we just put in above. - (push nil w3-active-faces) - (push nil w3-active-voices) - (let* ((node (car cols)) - (attributes (nth 1 node)) - (colspan (string-to-int - (or (cdr-safe (assq 'colspan attributes)) - "1"))) - (rowspan (string-to-int - (or (cdr-safe (assq 'rowspan attributes)) - "1"))) - fill-column column-width - (fill-prefix "") - (w3-do-incremental-display nil) - (indent-tabs-mode nil) - c e - ) - - (aset table-colspans i colspan) - (aset table-rowspans i rowspan) - - (setq fill-column 0) - (setq c i - e (+ i colspan)) - (while (< c e) - (setq fill-column (+ fill-column - (aref column-dimensions c) - 1) - c (1+ c))) - (setq fill-column (1- fill-column)) - (aset table-colwidth i fill-column) - - (setq w3-last-fill-pos (point-min)) - (push (cons (nth 0 node) (nth 1 node)) - w3-display-open-element-stack) - (w3-display-node node) - (setq fill-column (aref table-colwidth i)) - (if w3-display-table-cut-words-p - (w3-display-table-cut)) - (setq cols (cdr cols)) - (goto-char (point-min)) - (skip-chars-forward "\t\n\r") - (beginning-of-line) - (delete-region (point-min) (point)) - (goto-char (point-max)) - (skip-chars-backward " \t\n\r") - (delete-region (point) (point-max)) - (if (>= fill-column (current-column)) - (insert-char ? (- fill-column (current-column)) t)) - (goto-char (point-min)) - ;; This gets our text properties out to the - ;; end of lines for table rows/cells with backgrounds - (while (not (eobp)) - (re-search-forward "$" nil t) - (if (>= fill-column (current-column)) - (insert-char ? (- fill-column (current-column)) t)) - (or (eobp) (forward-char 1))) - (aset formatted-cols i (extract-rectangle (point-min) (point-max))) - (delete-region (point-min) (point-max)) - (let ((j (1- colspan))) - (while (> j 0) - (aset table-colspans (+ i j) 0) - (setq j (1- j)))) - (setq i (+ i colspan)) - ;; skip over columns that have leftover content - (while (and (< i num-cols) - (/= 0 (aref table-rowspans i))) - (setq i (+ i (max 1 (aref table-colspans i))))) - )) - (pop w3-display-open-element-stack) - (pop w3-active-faces) - (pop w3-active-voices) - (w3-pop-all-face-info) - ;; finish off the columns - (while (< i num-cols) - (aset table-colwidth i (aref column-dimensions i)) - (aset table-colspans i 1) - (setq i (1+ i)) - (while (and (< i num-cols) - (/= 0 (aref table-rowspans i))) - (setq i (+ i (max 1 (aref table-colspans i)))))) - - ;; on the last row empty any pending rowspans per the rfc - (if content nil - (fillarray table-rowspans 1)) - - ;; Find the tallest rectangle that isn't a rowspanning cell - (setq height 0 - i 0) - (while (< i num-cols) - (if (= 1 (aref table-rowspans i)) - (setq height (max height (length (aref formatted-cols i))))) - (setq i (+ i (max 1 (aref table-colspans i))))) - - ;; Make all rectangles the same height - (setq i 0) - (while (< i num-cols) - (setq this-rectangle (aref formatted-cols i)) - (if (> height (length this-rectangle)) - (let ((colspan-fill-line - (make-string (abs (aref table-colwidth i)) ? ))) - (case valign - ((center middle) - (aset formatted-cols i - (append (make-list (/ (- height (length this-rectangle)) 2) - colspan-fill-line) - this-rectangle))) - (bottom - (aset formatted-cols i - (append (make-list (- height (length this-rectangle)) - colspan-fill-line) - this-rectangle)))))) - (setq i (+ i (max 1 (aref table-colspans i))))))) - - - ;; fix broken colspans (this should only matter on illegal tables) - (setq i 0) - (while (< i num-cols) - (if (= (aref table-colspans i) 0) - (aset table-colspans i 1)) - (setq i (+ i (aref table-colspans i)))) - - ;; Insert a separator - (insert fill-prefix) - (setq i 0) - (let (rflag bflag tflag lflag) - (while (< i num-cols) - - (setq rflag (= (aref prev-rowspans i) 0)) - (setq bflag (/= (aref table-colspans i) 0)) - (setq tflag (/= (aref prev-colspans i) 0)) - - (w3-insert-terminal-char (w3-table-lookup-char lflag tflag rflag bflag)) - (setq lflag t) - (cond ((= (aref prev-rowspans i) 0) - (w3-insert-terminal-char - (w3-table-lookup-char t nil t nil) - (aref column-dimensions i)) - (setq i (1+ i))) - ((car (aref formatted-cols i)) - (insert (pop (aref formatted-cols i))) - (setq lflag nil) - (setq i (+ i (max (aref table-colspans i) - (aref prev-colspans i) 1)))) - (t - (insert-char ? (aref table-colwidth i) t) - (setq lflag nil) - (setq i (+ i (max (aref table-colspans i) - (aref prev-colspans i) 1)))))) - (w3-insert-terminal-char (w3-table-lookup-char lflag (/= row 1) nil t)) - (insert "\n")) - - ;; recalculate height (in case we've shortened a rowspanning cell - (setq height 0 - i 0) - (while (< i num-cols) - (if (= 1 (aref table-rowspans i)) - (setq height (max height (length (aref formatted-cols i))))) - (setq i (+ i (max 1 (aref table-colspans i))))) - - ;; Insert a row back in original buffer - (while (> height 0) - (insert fill-prefix) - (w3-insert-terminal-char (w3-table-lookup-char nil t nil t)) - (setq i 0) - (while (< i num-cols) - (if (car (aref formatted-cols i)) - (insert (pop (aref formatted-cols i))) - (insert-char ? (aref table-colwidth i) t)) - (w3-insert-terminal-char (w3-table-lookup-char nil t nil t)) - (setq i (+ i (max (aref table-colspans i) 1)))) - (insert "\n") - ;;(and w3-do-incremental-display (w3-pause)) - (setq height (1- height))) - - (setq i 0) - (while (< i num-cols) - (if (> (aref table-rowspans i) 0) - (decf (aref table-rowspans i))) - (incf i)) - - (setq prev-rowspans (copy-seq table-rowspans)) - (setq prev-colspans (copy-seq table-colspans)) - - (and w3-do-incremental-display (w3-pause)) - ) - (caption - (let ((left (length fill-prefix)) - (fill-prefix "") - (fill-column table-width) - (start (point))) - (w3-display-node (pop content)) - (indent-rigidly start (point) left))) - (otherwise - (delete-horizontal-space) - (setq content (nth 2 (car content)))) - )) - (if (= (length column-dimensions) 0) nil - (insert fill-prefix) - (setq i 0) - (let (tflag lflag) - (while (< i num-cols) - (setq tflag (/= (aref prev-colspans i) 0)) - (w3-insert-terminal-char (w3-table-lookup-char lflag tflag t nil)) - (setq lflag t) - (w3-insert-terminal-char - (w3-table-lookup-char t nil t nil) - (aref column-dimensions i)) - (setq i (1+ i))) - (w3-insert-terminal-char - (w3-table-lookup-char t t nil nil)) - (insert "\n"))) - ) - (pop w3-display-open-element-stack))))) - - - -(defun w3-display-create-unique-id () - (let* ((date (current-time-string)) - (dateinfo (and date (timezone-parse-date date))) - (timeinfo (and date (timezone-parse-time (aref dateinfo 3))))) - (if (and dateinfo timeinfo) - (concat (aref dateinfo 0) ; Year - (aref dateinfo 1) ; Month - (aref dateinfo 2) ; Day - (aref timeinfo 0) ; Hour - (aref timeinfo 1) ; Minute - (aref timeinfo 2) ; Second - ) - "HoplesSLYCoNfUSED"))) - -(defun w3-display-chop-into-table (node cols) - ;; Chop the content of 'node' up into 'cols' columns suitable for inclusion - ;; as the content of a table - (let ((content (nth 2 node)) - (items nil) - (rows nil)) - (setq cols (max cols 1)) - (while content - (push (list 'td nil (list (pop content))) items) - (if (= (length items) cols) - (setq rows (cons (nreverse items) rows) - items nil))) - (if items ; Store any leftovers - (setq rows (cons (nreverse items) rows) - items nil)) - (while rows - (push (list 'tr nil (pop rows)) items)) - items)) - -(defun w3-fix-color (color) - (if (and color - (string-match "^[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]$" color)) - (concat "#" color) - color)) - -(defun w3-display-normalize-form-info (args) - (let* ((plist (alist-to-plist args)) - (type (intern (downcase - (or (plist-get plist 'type) "text")))) - (name (plist-get plist 'name)) - (value (or (plist-get plist 'value) "")) - (size (if (plist-get plist 'size) - (string-to-int (plist-get plist 'size)))) - (maxlength (if (plist-get plist 'maxlength) - (string-to-int - (plist-get plist 'maxlength)))) - (default value) - (checked (assq 'checked args))) - (if (memq type '(checkbox radio)) (setq default checked)) - (if (and (eq type 'checkbox) (string= value "")) - (setq value "on")) - (if (and (not (memq type '(submit reset button))) - (not name)) - (setq name (symbol-name type))) - (while (and name (string-match "[\r\n]+" name)) - (setq name (concat (substring name 0 (match-beginning 0)) - (substring name (match-end 0) nil)))) - (setq plist (plist-put plist 'type type) - plist (plist-put plist 'name name) - plist (plist-put plist 'value value) - plist (plist-put plist 'size size) - plist (plist-put plist 'default default) - plist (plist-put plist 'internal-form-number w3-current-form-number) - plist (plist-put plist 'action w3-display-form-id) - plist (plist-put plist 'maxlength maxlength)) - plist)) - -(defun w3-resurrect-images () - ) - -(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))) - (right-margin-stack (list fill-column)) - (left-margin-stack (list 0)) - (inhibit-read-only t) - (widget-push-button-gui nil) - node - insert-before - insert-after - tag - args - content - hyperlink-info - break-style - cur - id - class - last-element - ) - (while content-stack - (setq content (pop content-stack)) - (pop w3-active-faces) - (pop w3-active-voices) - (w3-display-progress-meter) - (setq last-element (pop w3-display-open-element-stack)) - (case (car last-element) - ;; Any weird, post-display-of-content stuff for specific tags - ;; goes here. Couldn't think of any better way to do this when we - ;; are iterative. *sigh* - (a - (if (not hyperlink-info) - nil - (add-text-properties (car hyperlink-info) (point) - (list - 'duplicable t - 'start-open t - 'end-open t - 'rear-nonsticky t - 'w3-hyperlink-info (cadr hyperlink-info)))) - (setq hyperlink-info nil)) - ((ol ul dl dir menu) - (pop w3-display-list-stack)) - (label - (if (and (markerp w3-display-label-marker) - (marker-position w3-display-label-marker) - (marker-buffer w3-display-label-marker)) - (push (cons (or (cdr-safe (assq 'for (cdr last-element))) - (cdr-safe (assq 'id (cdr last-element))) - "unknown") - (buffer-substring w3-display-label-marker (point))) - w3-form-labels))) - (otherwise - nil)) - (if (car insert-after) - (w3-handle-string-content (car insert-after))) - (pop insert-after) - (w3-display-handle-end-break) - (w3-pop-all-face-info) - ;; Handle the element's content - (while content - (w3-display-progress-meter) - (if (stringp (car content)) - (w3-handle-string-content (pop content)) - (setq node (pop content) - tag (nth 0 node) - args (nth 1 node) - id (or (w3-get-attribute 'name) - (w3-get-attribute 'id)) - ) - ;; This little bit of magic takes care of inline styles. - ;; Evil Evil Evil, but it appears to work. - (if (w3-get-attribute 'style) - (let ((unique-id (or (w3-get-attribute 'id) - (w3-display-create-unique-id))) - (sheet "") - (class (assq 'class args))) - (setq sheet (format "%s.%s { %s }\n" tag unique-id - (w3-get-attribute 'style))) - (if class - (setcdr class (cons unique-id (cdr class))) - (setf (nth 1 node) (cons (cons 'class (list unique-id)) - (nth 1 node)))) - (setf (nth 1 node) (cons (cons 'id unique-id) (nth 1 node))) - (w3-handle-style (list 'data sheet - 'notation "text/css")))) - (setq w3-display-css-properties (css-get - (nth 0 node) - (nth 1 node) - w3-current-stylesheet - w3-display-open-element-stack)) - (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)) - (w3-display-handle-break) - (if (w3-node-visible-p) - nil - (setq insert-before nil - tag '*invisible) - (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 - (cons (intern id) - (set-marker (make-marker) - (point-max))) - w3-id-positions))) - (case tag - (a ; Hyperlinks - (let* ( - (title (w3-get-attribute 'title)) - (name (or (w3-get-attribute 'id) - (w3-get-attribute 'name))) - (btdt nil) - class - (before nil) - (after nil) - (face nil) - (voice 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 :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 - ) - (w3-display-convert-arglist args))))) - (w3-handle-content node) - ) - ) - ((ol ul dl menu) - (push (if (w3-get-attribute 'seqnum) - (1- (string-to-int (w3-get-attribute 'seqnum))) - 0) w3-display-list-stack) - (w3-handle-content node)) - (dir - (push 0 w3-display-list-stack) - (setq node - (list tag args - (list - (list 'table nil - (w3-display-chop-into-table node 3))))) - (w3-handle-content node)) - (multicol - (setq node (list tag args - (list - (list 'table nil - (w3-display-chop-into-table node 2))))) - (w3-handle-content node)) - (img ; inlined image - (w3-handle-image) - (w3-handle-empty-tag)) - (frameset - (if w3-display-frames - (let ((frames (nth 2 node)) - (frameset-cardinal 0) - (cols (cdr-safe (assq 'cols args)))) - (while (and frames (memq (car (car frames)) '(frame frameset))) - (setq frameset-cardinal (1+ frameset-cardinal) - frames (cdr frames))) - (push (list 'frameset - frameset-cardinal - (if (and cols (not (string-equal cols "*"))) - (assq 'cols args) - (assq 'rows args))) - w3-frameset-structure) - (w3-handle-content node)) - (w3-handle-content node))) - (frame - (if w3-display-frames - (let* ((href (or (w3-get-attribute 'src) - (w3-get-attribute 'href))) - (name (or (w3-get-attribute 'name) - (w3-get-attribute 'title) - (w3-get-attribute 'alt) - "Unknown frame name"))) - (push (list 'frame name href) w3-frameset-structure) - (w3-handle-content - (list tag args - (list - (list 'p nil - (list - (list 'a - (cons (cons 'href href) - args) - (list "Fetch frame: " name)))))))) - (w3-handle-empty-tag))) - (noframes - (if w3-display-frames - (w3-handle-empty-tag) - (w3-handle-content node))) - (applet ; Wow, Java - (w3-handle-content node) - ) - (script ; Scripts - (w3-handle-empty-tag)) - ((embed object) ; Embedded images/content - (w3-handle-content node) - ) - (hr ; Cause line break & insert rule - (let* ((perc (or (w3-get-attribute 'width) - (w3-get-style-info 'width node) - "100%")) - (width nil)) - (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 - (let ((name (or (w3-get-attribute 'name) - (w3-get-attribute 'id) - "unnamed")) - (areas - (mapcar - (function - (lambda (node) - (let* ((args (nth 1 node)) - (type (downcase (or - (w3-get-attribute 'shape) - "rect"))) - (coords (w3-decode-area-coords - (or (cdr-safe - (assq 'coords args)) ""))) - (alt (w3-get-attribute 'alt)) - (href (if (assq 'nohref args) - t - (or (w3-get-attribute 'src) - (w3-get-attribute 'href)))) - ) - (vector type coords href alt)) - ) - ) - (nth 2 node)))) - (setq w3-imagemaps (cons (cons name areas) w3-imagemaps))) - (w3-handle-empty-tag) - ) - (note - ;; Ewwwwhhh. Looks gross, but it works. This converts a - ;; <note> into a two-cell table, so that things look all - ;; pretty. - (setq node - (list 'note nil - (list - (list 'table nil - (list - (list 'tr nil - (list - (list 'td (list 'align 'right) - (list - (concat - (or (w3-get-attribute 'role) - "CAUTION") ":"))) - (list 'td nil - (nth 2 node))))))))) - (w3-handle-content node) - ) - (table - (w3-display-table node) - (setq w3-last-fill-pos (point)) - (w3-handle-empty-tag) - ) - (isindex - (let ((prompt (or (w3-get-attribute 'prompt) - "Search on (+ separates keywords): ")) - action node) - (setq action (or (w3-get-attribute 'src) - (w3-get-attribute 'href) - (url-view-url t))) - (if (and prompt (string-match "[^: \t-]+$" prompt)) - (setq prompt (concat prompt ": "))) - (setq node - (list 'isindex nil - (list - (list 'hr nil nil) - (list 'form - (list (cons 'action action) - (cons 'enctype - "application/x-w3-isindex") - (cons 'method "get")) - (list - prompt - (list 'input - (list (cons 'type "text") - (cons 'name "isindex")))))))) - (w3-handle-content node) - (setq w3-current-isindex (cons action prompt))) - ) - ((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)) - (sheet "") - ) - (if link - (setq sheet (format "%sa:link { color: %s }\n" sheet - (w3-fix-color link)))) - (if vlink - (setq sheet (format "%sa:visited { color: %s }\n" sheet - (w3-fix-color vlink)))) - (if alink - (setq sheet (format "%sa:active { color: %s }\n" sheet - (w3-fix-color alink)))) - (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))) - w3-persistent-variables))) - (if (not w3-display-same-buffer) - (set-buffer (generate-new-buffer "Untitled"))) - (setq w3-current-form-number 0 - w3-display-open-element-stack nil - w3-last-fill-pos (point-min)) - (setcar right-margin-stack - (min (- (or w3-strict-width (window-width)) - w3-right-margin) - (or w3-maximum-line-length - (window-width)))) - (condition-case nil - (switch-to-buffer (current-buffer)) - (error (message "W3 buffer %s is being drawn." (buffer-name (current-buffer))))) - - (buffer-disable-undo (current-buffer)) - (mapcar (function (lambda (x) (set (car x) (cdr x)))) info) - ;; ACK! We don't like filladapt mode! - (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) - fill-prefix "") - ) - (w3-handle-content node) - ) - (*invisible - (w3-handle-empty-tag)) - (meta - (let* ((equiv (cdr-safe (assq 'http-equiv args))) - (value (w3-get-attribute 'content)) - (name (w3-get-attribute 'name)) - (node (and equiv (assoc (setq equiv (downcase equiv)) - url-current-mime-headers)))) - (if equiv - (setq url-current-mime-headers (cons - (cons equiv value) - url-current-mime-headers))) - (if name - (setq w3-current-metainfo (cons - (cons name value) - w3-current-metainfo))) - - ;; Special-case the Set-Cookie header - (if (and equiv (string= (downcase equiv) "set-cookie")) - (url-cookie-handle-set-cookie value)) - ;; Special-case the refresh header - (if (and equiv (string= (downcase equiv) "refresh")) - (url-handle-refresh-header value))) - (w3-handle-empty-tag) - ) - (link - ;; This doesn't handle blank-separated values per the RFC. - (w3-parse-link args) - (w3-handle-empty-tag)) - (title - (let ((potential-title "") - (content (nth 2 node))) - (while content - (setq potential-title (concat potential-title (car content)) - content (cdr content))) - (setq potential-title (w3-normalize-spaces potential-title)) - (if (or w3-display-same-buffer - (string-match "^[ \t]*$" potential-title)) - nil - (rename-buffer (generate-new-buffer-name - (w3-fix-spaces potential-title))))) - (w3-handle-empty-tag)) - (base - (setq w3-base-target (cdr-safe (assq 'target args))) - (w3-handle-content node)) - (form - (setq w3-current-form-number (1+ w3-current-form-number)) - (let* ( - (action (w3-get-attribute 'action)) - (url nil)) - (if (not action) - (setq args (cons (cons 'action (url-view-url t)) args))) - (setq w3-display-form-id (cons - (cons 'form-number - w3-current-form-number) - args)) - (w3-handle-content node))) - (keygen - (w3-form-add-element - (w3-display-normalize-form-info - (cons '(type . "keygen") - args)) - w3-active-faces) - (w3-handle-empty-tag)) - (input - (w3-form-add-element - (w3-display-normalize-form-info args) - w3-active-faces) - (w3-handle-empty-tag) - ) - (select - (let* ((plist (w3-display-normalize-form-info args)) - (tmp nil) - (multiple (assq 'multiple args)) - (value nil) - (name (plist-get plist 'name)) - (options (mapcar - (function - (lambda (n) - (setq tmp (w3-normalize-spaces - (apply 'concat (nth 2 n))) - tmp (vector tmp - (or - (cdr-safe - (assq 'value (nth 1 n))) - tmp) - (assq 'selected (nth 1 n)))) - (if (assq 'selected (nth 1 n)) - (setq value (aref tmp 0))) - tmp)) - (nth 2 node)))) - (if (not value) - (setq value (and options (aref (car options) 0)))) - (setq plist (plist-put plist 'value value)) - (if multiple - (progn - (setq options - (mapcar - (function - (lambda (opt) - (list 'div nil - (list - (list 'input - (list (cons 'name name) - (cons 'type "checkbox") - (cons (if (aref opt 2) - 'checked - '__bogus__) "yes") - (cons 'value (aref opt 1)))) - " " (aref opt 0) (list 'br nil nil))))) - options)) - (setq node (list 'p nil options)) - (w3-handle-content node)) - (setq options (mapcar (function - (lambda (x) - (cons (aref x 0) (aref x 1)))) - options)) - (setq plist (plist-put plist 'type 'option) - plist (plist-put plist 'options options)) - (w3-form-add-element plist w3-active-faces) - ;; This should really not be necessary, but some versions - ;; of the widget library leave point _BEFORE_ the menu - ;; widget instead of after. - (goto-char (point-max)) - (w3-handle-empty-tag)))) - (textarea - (let* ((plist (w3-display-normalize-form-info args)) - (value (apply 'concat (nth 2 node)))) - (setq plist (plist-put plist 'type 'multiline) - plist (plist-put plist 'value value)) - (w3-form-add-element plist w3-active-faces)) - (w3-handle-empty-tag) - ) - (style - (w3-handle-style (alist-to-plist - (cons (cons 'data (apply 'concat (nth 2 node))) - (nth 1 node)))) - (w3-handle-empty-tag)) - (label - (if (not (markerp w3-display-label-marker)) - (setq w3-display-label-marker (make-marker))) - (set-marker w3-display-label-marker (point)) - (w3-handle-content node)) - ;; Emacs-W3 stuff that cannot be expressed in a stylesheet - (pinhead - ;; This check is so that we don't screw up table auto-layout - ;; by changing our text midway through the parse/layout/display - ;; steps. - (if (nth 2 node) - nil - (setcar (cddr node) - (list - (if (fboundp 'yow) - (yow) - "AIEEEEE! I am having an UNDULATING EXPERIENCE!")))) - (w3-handle-content node)) - (flame - (if (nth 2 node) - nil - (setcar - (cddr node) - (list - (condition-case () - (concat - (sentence-ify - (string-ify - (append-suffixes-hack (flatten (*flame)))))) - (error - "You know, everything is really a graphics editor."))))) - (w3-handle-content node)) - (cookie - (if (nth 2 node) - nil - (setcar - (cddr node) - (list - (w3-display-get-cookie args)))) - (w3-handle-content node)) - ;; Generic formatting - all things that can be fully specified - ;; by a CSS stylesheet. - (otherwise - (w3-handle-content node)) - ) ; case tag - ) ; stringp content - ) ; while content - ) ; while content-stack - ) - ) - -(defun w3-draw-tree (tree) - ;; The main entry point - wow complicated - (setq w3-current-stylesheet w3-user-stylesheet) - (while tree - (w3-display-node (car tree)) - (setq tree (cdr tree))) - (w3-display-fix-widgets) - (let ((inhibit-read-only t)) - (put-text-property (point-min) (point-max) 'read-only t) - (w3-resurrect-images) - (w3-resurrect-hyperlinks) - (w3-form-resurrect-widgets))) - -(defun time-display (&optional tree) - ;; Return the # of seconds it took to draw 'tree' - (let ((st (nth 1 (current-time))) - (nd nil)) - (w3-draw-tree (or tree w3-last-parse-tree)) - (setq nd (nth 1 (current-time))) - (- nd st))) - - -(defun w3-fixup-eol-faces () - ;; Remove 'face property at end of lines - underlining screws up stuff - ;; also remove 'mouse-face property at the beginning and end of lines - (let ((inhibit-read-only t)) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "[ \t]*\n[ \t]*" nil t) - (remove-text-properties (match-beginning 0) (match-end 0) - '(face nil mouse-face nil) nil))))) - -(defsubst w3-finish-drawing () - (let (url glyph widget) - (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) - glyph (cdr-safe (assoc url w3-graphics-list))) - (condition-case nil - (widget-value-set widget glyph) - (error nil)))) - (if (and url-current-object (url-target url-current-object)) - (progn - (push-mark (point) t) - (w3-find-specific-link (url-target url-current-object))) - (goto-char (point-min))) - (and (not w3-running-xemacs) - (not (eq (device-type) 'tty)) - (w3-fixup-eol-faces)) - (message "Drawing... done")) - -(defun w3-region (st nd) - (if (not w3-setup-done) (w3-do-setup)) - (let* ((source (buffer-substring st nd)) - (w3-display-same-buffer t) - (parse nil)) - (save-window-excursion - (save-excursion - (set-buffer (get-buffer-create " *w3-region*")) - (erase-buffer) - (insert source) - (setq parse (w3-parse-buffer (current-buffer)))) - (narrow-to-region st nd) - (delete-region (point-min) (point-max)) - (w3-draw-tree parse) - (w3-finish-drawing) - (widen)))) - -(defun w3-refresh-buffer () - (interactive) - (let ((parse w3-current-parse) - (inhibit-read-only t) - (w3-display-same-buffer t)) - (if (not parse) - (error "Could not find the parse tree for this buffer. EEEEK!")) - (erase-buffer) - (w3-draw-tree parse) - (w3-finish-drawing) - (w3-mode) - (set-buffer-modified-p nil))) - -(defun w3-prepare-buffer (&rest args) - ;; The text/html viewer - does all the drawing and displaying of the buffer - ;; that is necessary to go from raw HTML to a good presentation. - (let* ((source (buffer-string)) - (source-buf (current-buffer)) - (parse (w3-parse-buffer source-buf))) - (set-buffer-modified-p nil) - (w3-draw-tree parse) - (kill-buffer source-buf) - (set-buffer-modified-p nil) - (setq w3-current-source source - w3-current-parse parse) - (w3-finish-drawing) - (w3-mode) - (set-buffer-modified-p nil) - (if url-keep-history - (let ((url (url-view-url t))) - (if (not url-history-list) - (setq url-history-list (make-hash-table :size 131 :test 'equal))) - (cl-puthash url (buffer-name) url-history-list) - (if (fboundp 'w3-shuffle-history-menu) - (w3-shuffle-history-menu))))) - (w3-maybe-fetch-frames)) - -(defun w3-maybe-fetch-frames () - (if w3-frameset-structure - (cond ((or (eq w3-display-frames t) - (and (eq w3-display-frames 'ask) - (y-or-n-p "Fetch frames? "))) - (w3-frames) - t)))) - -(defun w3-frames (&optional new-frame) - "Set up and fetch W3 frames. With optional prefix, do so in a new frame." - (interactive "P") - (if (not w3-display-frames) - (let ((w3-display-frames t)) - (w3-refresh-buffer))) - (let* ((old-asynch url-be-asynchronous) - (structure (reverse w3-frameset-structure))) - (if new-frame - (select-frame (make-frame))) - (setq-default url-be-asynchronous nil) - ;; set up frames - (while structure - (if (eq (car (car structure)) 'frameset) - (setq structure (w3-display-frameset structure)) - (pop structure))) - ;; compute target window distances - (let ((origin-buffer (current-buffer)) - (stop nil)) - (while (not stop) - (or w3-target-window-distances - (setq w3-target-window-distances - (w3-compute-target-window-distances))) - (other-window 1) - (if (eq (current-buffer) origin-buffer) - (setq stop t)))) - (setq-default url-be-asynchronous old-asynch))) - -(defun w3-display-frameset (frameset-structure) - (let* ((structure frameset-structure) - (frameset-cardinal (nth 1 (car structure))) - (current-dims (cdr (cdr (car structure)))) - (cols (cdr-safe (assq 'cols current-dims))) - (rows (cdr-safe (assq 'rows current-dims))) - (char-width (if (> (frame-char-width) 1) - (frame-char-width) - w3-tty-char-width)) - (char-height (if (> (frame-char-height) 1) - (frame-char-height) - w3-tty-char-height))) - (pop structure) - ;; columns ? - (if (and cols (not (string-equal cols "*"))) - (setq cols (w3-decode-frameset-dimensions - cols (window-width) window-min-width char-width)) - ;; rows ? - (if (and rows (not (string-equal rows "*"))) - (setq rows (w3-decode-frameset-dimensions - rows (window-height) window-min-height char-height)) - ;; default: columns of equal width - (let ((fwidth (/ (window-width) frameset-cardinal))) - (while (> frameset-cardinal 0) - (push fwidth cols) - (setq frameset-cardinal (1- frameset-cardinal)))))) - (while (> frameset-cardinal 0) - (cond ((cdr cols) - (split-window-horizontally (car cols)) - (pop cols)) - ((cdr rows) - (split-window-vertically (car rows)) - (pop rows))) - (cond ((eq (car (car structure)) 'frame) - (let ((href (nth 2 (car structure))) - (name (nth 1 (car structure))) - (url-working-buffer url-default-working-buffer) ; in case url-multiple-p is t - (w3-notify 'semibully)) - (pop structure) - (w3-fetch href) - (setq w3-frame-name name - w3-target-window-distances nil) - (other-window 1))) - ((eq (car (car structure)) 'frameset) - (setq structure (w3-display-frameset structure)))) - (setq frameset-cardinal (1- frameset-cardinal))) - structure)) - -(defun w3-compute-target-window-distances () - "Compute an alist of target names and window distances" - (let ((origin-buffer (current-buffer)) - (distance 0) - (stop nil) - (window-distances nil)) - (while (not stop) - (if w3-frame-name - (push (cons (intern (downcase w3-frame-name)) distance) - window-distances)) - (other-window 1) - (setq distance (1+ distance)) - (if (eq (current-buffer) origin-buffer) - (setq stop t))) - window-distances)) - -(if (not (fboundp 'frame-char-height)) - (defun frame-char-height (&optional frame) - "Height in pixels of a line in the font in frame FRAME. -If FRAME is omitted, the selected frame is used. -For a terminal frame, the value is always 1." - (font-height (face-font 'default frame)))) - -(if (not (fboundp 'frame-char-width)) - (defun frame-char-width (&optional frame) - "Width in pixels of characters in the font in frame FRAME. -If FRAME is omitted, the selected frame is used. -For a terminal screen, the value is always 1." - (font-width (face-font 'default frame)))) - -(defun w3-decode-frameset-dimensions (dims available-dimension min-dim pixel-dim) - "Returns numbers of lines or columns in Emacs, computed from specified frameset dimensions" - (let ((dimensions nil)) - (if dims - (let ((nb-stars 0) - (remaining-available-dimension available-dimension)) - (while (string-match "\\(\\*\\|[0-9]+%?\\)" dims) - (let ((match (substring dims (match-beginning 1) (match-end 1)))) - (setq dims (substring dims (match-end 1))) - (cond ((string-match "\\*" match) - ;; * : divide rest equally - (push '* dimensions) - (setq nb-stars (1+ nb-stars))) - (t - (cond ((string-match "\\([0-9]+\\)%" match) - ;; percentage of available height - (push (/ (* (car (read-from-string (substring match 0 -1))) - available-dimension) - 100) - dimensions)) - (t - ;; absolute number: pixel height - (push (max (1+ (/ (car (read-from-string match)) - pixel-dim)) - min-dim) - dimensions))) - (setq remaining-available-dimension - (- remaining-available-dimension (car dimensions))))))) - (if (zerop nb-stars) - ;; push => reverse order - (reverse dimensions) - ;; substitute numbers for * - (let ((star-replacement (/ remaining-available-dimension nb-stars)) - (star-dimensions dimensions)) - (setq dimensions nil) - (while star-dimensions - (push (if (eq '* (car star-dimensions)) - star-replacement - (car star-dimensions)) - dimensions) - (pop star-dimensions)) - ;; push + push => in order - dimensions)))))) - -(provide 'w3-display) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-e19.el --- a/lisp/w3/w3-e19.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,160 +0,0 @@ -;;; w3-e19.el --- Emacs 19.xx specific functions for emacs-w3 -;; Author: wmperry -;; Created: 1997/08/12 18:18:03 -;; Version: 1.29 -;; Keywords: faces, help, mouse, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Enhancements For Emacs 19 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(eval-when-compile - (require 'w3-props)) -(require 'w3-forms) -(require 'font) -(require 'w3-script) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Help menu -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-e19-hotlist-menu nil "A menu for hotlists.") -(defvar w3-e19-links-menu nil "A buffer-local menu for hyperlinks.") -(defvar w3-e19-nav-menu nil "A buffer-local menu for html based <link> tags.") -(defvar w3-e19-window-width nil) - -(mapcar 'make-variable-buffer-local - '(w3-e19-hotlist-menu - w3-e19-window-width - w3-e19-links-menu - w3-e19-nav-menu)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Functions to build menus of urls -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-e19-show-hotlist-menu () - (interactive) - (let ((keymap (easy-menu-create-keymaps "Hotlist" - (w3-menu-hotlist-constructor nil))) - (x nil) - (y nil)) - (setq x (x-popup-menu t keymap) - y (and x (lookup-key keymap (apply 'vector x)))) - (if (and x y) - (funcall y)))) - -(defun w3-e19-show-links-menu () - (interactive) - (if (not w3-e19-links-menu) - (w3-build-FSF19-menu)) - (let (x y) - (setq x (x-popup-menu t w3-e19-links-menu) - y (and x (lookup-key w3-e19-links-menu (apply 'vector x)))) - (if (and x y) - (funcall y)))) - -(defun w3-e19-show-navigate-menu () - (interactive) - (if (not w3-e19-nav-menu) - (w3-build-FSF19-menu)) - (let (x y) - (setq x (x-popup-menu t w3-e19-nav-menu) - y (and x (lookup-key w3-e19-nav-menu (apply 'vector x)))) - (if (and x y) - (funcall y)))) - -(defun w3-build-FSF19-menu () - ;; Build emacs19 menus from w3-links-list - (let ((links (w3-menu-html-links-constructor nil)) - (hlink (w3-menu-links-constructor nil))) - (setq w3-e19-nav-menu (easy-menu-create-keymaps "Navigate" links) - w3-e19-links-menu (easy-menu-create-keymaps "Links" hlink)))) - -(defun w3-setup-version-specifics () - ;; Set up routine for emacs 19 - (require 'lmenu) ; for popup-menu - ) - -(defun w3-store-in-clipboard (str) - "Store string STR in the system clipboard" - (cond - ((boundp 'interprogram-cut-function) - (if interprogram-cut-function - (funcall interprogram-cut-function str t))) - (t - (case (device-type) - (x (x-select-text str)) - (pm (pm-put-clipboard str)) - (ns (ns-store-pasteboard-internal str)) - (otherwise nil))))) - -(defun w3-mode-version-specifics () - ;; Emacs 19 specific stuff for w3-mode - (declare (special w3-face-index w3-display-background-properties)) - (make-local-variable 'track-mouse) - (setq w3-e19-window-width (window-width)) - (if w3-track-mouse (setq track-mouse t)) - (if w3-display-background-properties - (let ((face (w3-make-face (intern - (format "w3-style-face-%05d" w3-face-index)) - "An Emacs-W3 face... don't edit by hand." t)) - (fore (car w3-display-background-properties)) - (inhibit-read-only t) - (back (cdr w3-display-background-properties))) - (setq w3-face-index (1+ w3-face-index)) - (if fore (font-set-face-foreground face fore)) - (if back (font-set-face-background face back)) - (fillin-text-property (point-min) (point-max) 'face 'face face)))) - -(defun w3-text-pixel-width (str &optional face) - "Return the pixel-width of a chunk of text STR with face FACE." - (* (length str) (frame-char-width))) - -(defun w3-mouse-handler (e) - "Function to message the url under the mouse cursor" - (interactive "e") - (let* ((pt (posn-point (event-start e))) - (good (eq (posn-window (event-start e)) (selected-window))) - (mouse-events nil)) - (if (not (and good pt (number-or-marker-p pt))) - nil - (widget-echo-help pt) - ;; FIXME!!! Need to handle onmouseover, on mouseout - (setq mouse-events (w3-script-find-event-handlers pt 'mouse)) - (if (assq 'onmouseover mouse-events) - (w3-script-evaluate-form (cdr (assq 'onmouseover mouse-events))))))) - -(defun w3-window-size-change-function (frame) - (let ((first (frame-first-window frame)) - (cur nil)) - (while (not (eq cur first)) - (setq cur (if cur (next-window cur nil frame) first)) - (save-excursion - (set-buffer (window-buffer cur)) - (if (and (eq major-mode 'w3-mode) - (not (eq (window-width cur) w3-e19-window-width))) - (w3-refresh-buffer)))))) - - -(provide 'w3-emacs19) -(provide 'w3-e19) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-e20.el --- a/lisp/w3/w3-e20.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,29 +0,0 @@ -;;; w3-e19.el --- Emacs 20.xx specific functions for emacs-w3 -;; Author: wmperry -;; Created: 1997/08/08 14:44:42 -;; Version: 1.2 -;; Keywords: faces, help, mouse, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1997 Free Software Foundation, Inc. -;;; -;;; 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 'w3-e19) -(provide 'w3-e20) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-elisp.el --- a/lisp/w3/w3-elisp.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,127 +0,0 @@ -;;; w3-elisp.el --- Scripting support for emacs-lisp -;; Author: wmperry -;; Created: 1997/03/07 14:14:02 -;; Version: 1.7 -;; Keywords: hypermedia, scripting - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1997 Free Software Foundation, Inc. -;;; -;;; 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 'cl) - -(mapcar - (function - (lambda (x) - (put x 'w3-safe t))) - '(;; Any safe functions for untrusted scripts should go here. - ;; Basic stuff - message - format garbage-collect progn prog1 prog2 progn-with-message - while current-time current-time-string - plist-member plist-to-alist plist-get - assoc memq member function lambda point - - ;; Device querying - device-pixel-height device-type device-color-cells - device-mm-height device-class device-bitplanes - device-on-window-system-p device-pixel-width - device-mm-width device-baud-rate - - ;; Frame querying - frame-type frame-name frame-device frame-parameters - frame-height frame-pixel-width frame-pixel-height - frame-width frame-property - - ;; Window querying - window-frame window-height window-width - window-pixel-width window-pixel-height - - ;; Buffer querying - buffer-name buffer-substring buffer-substring-no-properties - buffer-size buffer-string - - ;; Text properties, read-only - get-text-property text-properties-at text-property-bounds - text-property-not-all - - ;; URL loading stuff - url-insert-file-contents url-view-url - - ;; Interfacing to W3 - w3-fetch w3-refresh-buffer w3-view-this-url - - ;; All the XEmacs event manipulation functions - event-live-p event-glyph-extent event-glyph-y-pixel event-x-pixel - event-type event-glyph event-button event-over-text-area-p - event-glyph-x-pixel event-buffer event-device event-properties - event-process event-timestamp event-modifier-bits event-console - event-window-y-pixel event-window event-window-x-pixel event-point - event-function event-over-toolbar-p event-matches-key-specifier-p - event-over-glyph-p event-frame event-x event-channel event-y - event-screen event-to-character event-over-border-p - event-toolbar-button event-closest-point event-object event-key - event-modifiers event-y-pixel event-over-modeline-p - event-modeline-position - ) - ) - -(defsubst w3-elisp-safe-function (func args) - (let ((validator (get func 'w3-safe))) - (cond - ((eq t validator) t) ; Explicit allow - ((eq nil validator) nil) ; Explicit deny - ((fboundp validator) ; Function to call - (funcall validator func args)) - ((boundp validator) ; Variable to check - (symbol-value validator)) - (t nil)))) ; Fallback to unsafe - -(defun w3-elisp-safe-expression (exp) - "Return t if-and-only-if EXP is safe to evaluate." - (cond - ((and (listp exp) (not (listp (cdr exp)))) ; A cons cell - t) - ((or ; self-quoters - (vectorp exp) - (numberp exp) - (symbolp exp) - (stringp exp) - (keymapp exp)) - t) - ((listp exp) ; Function call - check arguments - (if (w3-elisp-safe-function (car exp) (cdr exp)) - (let ((args (cdr exp)) - (rval t)) - (while args - (if (not (w3-elisp-safe-expression (pop args))) - (setq args nil - rval nil))) - rval))) - ;; How to handle the insane # of native types? - (t nil))) - -(defun w3-elisp-safe-eval (form) - (if (w3-elisp-safe-expression form) - (condition-case () - (eval form) - (error nil)))) - -(provide 'w3-elisp) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-emulate.el --- a/lisp/w3/w3-emulate.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,270 +0,0 @@ -;;; w3-emulate.el --- All variable definitions for emacs-w3 -;; Author: wmperry -;; Created: 1997/06/30 05:29:44 -;; Version: 1.14 -;; Keywords: comm, help, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Provide emulations of various other web browsers -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'w3-vars) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; First, we emulate Netscape 2.x -;; ------------------------------ -;; This entails mainly a few new keybindings. -;; Alt-S == Save As -;; Alt-M == New Mail Message -;; Alt-N == New Window -;; Alt-L == Open Location -;; Alt-O == Open File -;; Alt-P == Print -;; Alt-Q == Quit -;; Alt-F == Search -;; Alt-G == Search Again -;; Alt-R == Reload -;; Alt-I == Load Images -;; Alt-A == Add Bookmark -;; Alt-B == Show Bookmark Window -;; Alt-H == Show History Window -;; Alt-Left == Back -;; Alt-Right== Forward -;; Right == Scroll left -;; Left == Scroll right -;; Up == Smooth scroll up -;; Down == Smooth scroll down -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(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) - -(define-key w3-netscape-emulation-minor-mode-map [up] - (function (lambda () (interactive) (scroll-down 1)))) -(define-key w3-netscape-emulation-minor-mode-map [down] - (function (lambda () (interactive) (scroll-up 1)))) -(define-key w3-netscape-emulation-minor-mode-map [right] 'scroll-left) -(define-key w3-netscape-emulation-minor-mode-map [left] 'scroll-right) -(define-key w3-netscape-emulation-minor-mode-map [(meta left)] - 'w3-history-backward) -(define-key w3-netscape-emulation-minor-mode-map [(meta right)] - 'w3-history-forward) - -(defun turn-on-netscape-emulation () - (interactive) - (w3-lynx-emulation-minor-mode 0) - (w3-netscape-emulation-minor-mode 1)) - -(defun w3-netscape-emulation-minor-mode (&optional arg) - "Minor mode for emulating netscape key navigation." - (interactive "P") - (cond - ((null arg) - (setq w3-netscape-emulation-minor-mode - (not w3-netscape-emulation-minor-mode)) - (if w3-netscape-emulation-minor-mode - (setq w3-lynx-emulation-minor-mode nil))) - ((= 0 arg) - (setq w3-netscape-emulation-minor-mode nil)) - (t - (setq w3-lynx-emulation-minor-mode nil - w3-netscape-emulation-minor-mode t))) - ) - -(defsubst w3-skip-word () - (skip-chars-forward "^ \t\n\r") - (skip-chars-forward " \t")) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Now, lets try Lynx -;; ------------------ -;; A few keybindings and modifications to some default functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun turn-on-lynx-emulation () - (interactive) - (w3-netscape-emulation-minor-mode 0) - (w3-lynx-emulation-minor-mode 1)) - -(defun w3-lynx-emulation-minor-mode (&optional arg) - "Minor mode for emulating lynx key navigation." - (interactive "P") - (cond - ((null arg) - (setq w3-lynx-emulation-minor-mode - (not w3-lynx-emulation-minor-mode)) - (if w3-lynx-emulation-minor-mode - (setq w3-netscape-emulation-minor-mode nil))) - ((= 0 arg) - (setq w3-lynx-emulation-minor-mode nil)) - (t - (setq w3-lynx-emulation-minor-mode t - w3-netscape-emulation-minor-mode nil)))) - -;; The list of keybindings for lynx minor mode was compiled from: -;; http://www.crl.com/~subir/lynx/lynx_help/keystroke_commands/keystroke_help.htm - -;; Movement -(define-key w3-lynx-emulation-minor-mode-map [up] 'widget-backward) -(define-key w3-lynx-emulation-minor-mode-map [down] 'widget-forward) -(define-key w3-lynx-emulation-minor-mode-map [right] 'widget-button-press) -(define-key w3-lynx-emulation-minor-mode-map [left] 'w3-history-backward) - -;; Scrolling -(define-key w3-lynx-emulation-minor-mode-map "+" 'w3-scroll-up) -(define-key w3-lynx-emulation-minor-mode-map "-" 'scroll-down) -(define-key w3-lynx-emulation-minor-mode-map "b" 'scroll-down) -(define-key w3-lynx-emulation-minor-mode-map "\C-a" 'w3-start-of-document) -(define-key w3-lynx-emulation-minor-mode-map "\C-e" 'w3-end-of-document) -(define-key w3-lynx-emulation-minor-mode-map "\C-f" 'scroll-down) -(define-key w3-lynx-emulation-minor-mode-map "\C-n" 'ignore) ; down 2 -(define-key w3-lynx-emulation-minor-mode-map "\C-p" 'ignore) ; up 2 -(define-key w3-lynx-emulation-minor-mode-map ")" 'ignore) ; forward half -(define-key w3-lynx-emulation-minor-mode-map "(" 'ignore) ; back half -(define-key w3-lynx-emulation-minor-mode-map "#" 'w3-toggle-toolbar) - -;; Dired bindings don't have any meaning for us - -;; Other -(define-key w3-lynx-emulation-minor-mode-map "?" 'w3-help) -(define-key w3-lynx-emulation-minor-mode-map "a" 'w3-hotlist-add-document) -(define-key w3-lynx-emulation-minor-mode-map "c" 'w3-mail-document-author) -(define-key w3-lynx-emulation-minor-mode-map "d" 'w3-download-url) -(define-key w3-lynx-emulation-minor-mode-map "e" 'ignore) ; edit current -(define-key w3-lynx-emulation-minor-mode-map "f" 'dired) -(define-key w3-lynx-emulation-minor-mode-map "g" 'w3-fetch) -(define-key w3-lynx-emulation-minor-mode-map "h" 'w3-help) -(define-key w3-lynx-emulation-minor-mode-map "i" 'ignore) -(define-key w3-lynx-emulation-minor-mode-map "j" 'w3-use-hotlist) -(define-key w3-lynx-emulation-minor-mode-map "k" 'describe-mode) -(define-key w3-lynx-emulation-minor-mode-map "l" 'w3-complete-link) -(define-key w3-lynx-emulation-minor-mode-map "m" 'w3) -(define-key w3-lynx-emulation-minor-mode-map "n" 'w3-search-again) -(define-key w3-lynx-emulation-minor-mode-map "o" 'w3-preferences-edit) -(define-key w3-lynx-emulation-minor-mode-map "p" 'w3-print-this-url) -(define-key w3-lynx-emulation-minor-mode-map "q" 'w3-quit) -(define-key w3-lynx-emulation-minor-mode-map "r" 'w3-hotlist-delete) -(define-key w3-lynx-emulation-minor-mode-map "t" 'ignore) ; tag -(define-key w3-lynx-emulation-minor-mode-map "u" 'w3-history-backward) -(define-key w3-lynx-emulation-minor-mode-map "/" 'w3-search-forward) -(define-key w3-lynx-emulation-minor-mode-map "v" 'w3-show-hotlist) -(define-key w3-lynx-emulation-minor-mode-map "V" 'w3-show-hotlist) -(define-key w3-lynx-emulation-minor-mode-map "x" 'widget-button-press) -(define-key w3-lynx-emulation-minor-mode-map "z" 'keyboard-quit) -(define-key w3-lynx-emulation-minor-mode-map "=" 'w3-document-information) -(define-key w3-lynx-emulation-minor-mode-map "\\" 'w3-source-document) -(define-key w3-lynx-emulation-minor-mode-map "!" 'shell) -(define-key w3-lynx-emulation-minor-mode-map "'" 'ignore) ; toggle comment -(define-key w3-lynx-emulation-minor-mode-map "`" 'ignore) ; toggle comment -(define-key w3-lynx-emulation-minor-mode-map "*" 'ignore) ; toggle image_links -(define-key w3-lynx-emulation-minor-mode-map "@" 'ignore) ; toggle raw 8-bit -(define-key w3-lynx-emulation-minor-mode-map "[" 'ignore) ; pseudo-inlines -(define-key w3-lynx-emulation-minor-mode-map "]" 'ignore) ; send head -(define-key w3-lynx-emulation-minor-mode-map "\"" 'ignore) ; toggle quoting -(define-key w3-lynx-emulation-minor-mode-map "\C-r" 'w3-reload-document) -(define-key w3-lynx-emulation-minor-mode-map "\C-w" 'w3-refresh-buffer) -(define-key w3-lynx-emulation-minor-mode-map "\C-u" 'ignore) ; erase input -(define-key w3-lynx-emulation-minor-mode-map "\C-g" 'keyboard-quit) -(define-key w3-lynx-emulation-minor-mode-map "\C-t" 'ignore) ; toggle trace -(define-key w3-lynx-emulation-minor-mode-map "\C-k" 'ignore) ; cookie jar - -;; Things to masquerade as other browsers in the user-agent field -;; of an HTTP request. -(defun w3-masquerade-stub (arg app version) - (if (null arg) - (setq arg (if (equal url-package-name "Emacs-W3") 1 0))) - (if (= 0 arg) - (setq url-package-name "Emacs-W3" - url-package-version w3-version-number) - (setq url-package-name app - url-package-version version))) - -(defun w3-lynx-masquerade-mode (&optional arg) - (interactive "P") - (w3-masquerade-stub arg "Lynx" "2.6")) - -(defun turn-on-lynx-masquerade-mode () - (interactive) - (w3-lynx-masquerade-mode 1)) - -(defun turn-off-lynx-masquerade-mode () - (interactive) - (w3-lynx-masquerade-mode 0)) - -(defun w3-netscape-masquerade-mode (&optional arg) - (interactive "P") - (w3-masquerade-stub arg "Mozilla" "4.0")) - -(defun turn-on-netscape-masquerade-mode () - (interactive) - (w3-netscape-masquerade-mode 1)) - -(defun turn-off-netscape-masquerade-mode () - (interactive) - (w3-netscape-masquerade-mode 0)) - -(defun w3-ie-masquerade-mode (&optional arg) - (interactive "P") - (w3-masquerade-stub arg "Internet_Explorer" "3.02")) - -(defun turn-on-ie-masquerade-mode () - (interactive) - (w3-ie-masquerade-mode 1)) - -(defun turn-off-ie-masquerade-mode () - (interactive) - (w3-ie-masquerade-mode 0)) - -(defun w3-arena-masquerade-mode (&optional arg) - (interactive "P") - (w3-masquerade-stub arg "Arena" "0.9")) - -(defun turn-on-arena-masquerade-mode () - (interactive) - (w3-arena-masquerade-mode 1)) - -(defun turn-off-arena-masquerade-mode () - (interactive) - (w3-arena-masquerade-mode 0)) - -;; -(provide 'w3-emulate) - -;;; Local Variables: -;;; truncate-lines: t -;;; End: diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-forms.el --- a/lisp/w3/w3-forms.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,971 +0,0 @@ -;;; w3-forms.el --- Emacs-w3 forms parsing code for new display engine -;; Author: wmperry -;; Created: 1997/04/03 14:23:37 -;; Version: 1.84 -;; Keywords: faces, help, comm, data, languages - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; FORMS processing for html 2.0/3.0 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(eval-when-compile - (require 'cl)) - -(eval-and-compile - (require 'w3-display) - (require 'widget) - (condition-case nil - (require 'wid-edit) - (error (require 'widget-edit)))) - -(require 'w3-vars) -(require 'mule-sysdp) - -(defvar w3-form-use-old-style nil - "*Non-nil means use the old way of interacting for form fields.") - -(define-widget-keywords :emacspeak-help :w3-form-data) - -(defvar w3-form-keymap - (let ((map (copy-keymap global-map)) - (eol-loc (where-is-internal 'end-of-line global-map t))) - (if widget-keymap - (cl-map-keymap (function - (lambda (key binding) - (define-key map - (if (vectorp key) key (vector key)) - (case binding - (widget-backward 'w3-widget-backward) - (widget-forward 'w3-widget-forward) - (otherwise binding))))) - widget-keymap)) - (define-key map [return] 'w3-form-maybe-submit-by-keypress) - (define-key map "\r" 'w3-form-maybe-submit-by-keypress) - (define-key map "\n" 'w3-form-maybe-submit-by-keypress) - (define-key map "\t" 'w3-widget-forward) - (define-key map "\C-k" 'widget-kill-line) - (define-key map "\C-a" 'widget-beginning-of-line) - (if eol-loc - (define-key map eol-loc 'widget-end-of-line)) - map)) - -;; A form entry area is a vector -;; [ type name default-value value maxlength options widget plist] -;; Where: -;; type = symbol defining what type of form entry area it is -;; (ie: file, radio) -;; name = the name of the form element -;; default-value = the value this started out with - -(defsubst w3-form-element-type (obj) (aref obj 0)) -(defsubst w3-form-element-name (obj) (aref obj 1)) -(defsubst w3-form-element-default-value (obj) (aref obj 2)) -(defsubst w3-form-element-value (obj) (aref obj 3)) -(defsubst w3-form-element-size (obj) (aref obj 4)) -(defsubst w3-form-element-maxlength (obj) (aref obj 5)) -(defsubst w3-form-element-options (obj) (aref obj 6)) -(defsubst w3-form-element-action (obj) (aref obj 7)) -(defsubst w3-form-element-widget (obj) (aref obj 8)) -(defsubst w3-form-element-plist (obj) (aref obj 9)) - -(defsubst w3-form-element-set-type (obj val) (aset obj 0 val)) -(defsubst w3-form-element-set-name (obj val) (aset obj 1 val)) -(defsubst w3-form-element-set-default-value (obj val) (aset obj 2 val)) -(defsubst w3-form-element-set-value (obj val) (aset obj 3 val)) -(defsubst w3-form-element-set-size (obj val) (aset obj 4 val)) -(defsubst w3-form-element-set-maxlength (obj val) (aset obj 5 val)) -(defsubst w3-form-element-set-options (obj val) (aset obj 6 val)) -(defsubst w3-form-element-set-action (obj val) (aset obj 7 val)) -(defsubst w3-form-element-set-widget (obj val) (aset obj 8 val)) -(defsubst w3-form-element-set-plist (obj val) (aset obj 9 val)) - -(defvar w3-form-valid-key-sizes - '( - ("1024 (Premium)" . 1024) - ("896 (Regular)" . 896) - ("768 (Unleaded)" . 768) - ("512 (Low Grade)" . 512) - ("508 (Woos)" . 508) - ("256 (Test Grade)" . 256) - ) - "An assoc list of available key sizes and meaningful descriptions.") - -(defun w3-form-determine-size (el size) - (case (w3-form-element-type el) - (checkbox 3) - (radio 4) - ((reset submit) (+ 2 (length (or (w3-form-element-value el) - (symbol-name - (w3-form-element-type el)))))) - (multiline 21) - (hidden nil) - (file (or size 26)) - ((float password text int) - (if w3-form-use-old-style - (or size 22) - (or size 20))) - (image (+ 2 (length (or - (plist-get (w3-form-element-plist el) 'alt) - "Form-Image")))) - (option - (let ((options (copy-sequence (w3-form-element-options el)))) - (or size - (length (caar (sort options - (function - (lambda (x y) - (>= (length (car x)) - (length (car y))))))))))) - (keygen - (+ (length "Key Length: ") - (apply 'max - (mapcar (function (lambda (pair) - (length (car pair)))) - w3-form-valid-key-sizes)))) - (otherwise (or size 22)))) - -;;###autoload -(defun w3-form-add-element (plist face) - (let* ((action (plist-get plist 'action)) - (el (vector (plist-get plist 'type) - (plist-get plist 'name) - (plist-get plist 'default) - (plist-get plist 'value) - (plist-get plist 'size) - (plist-get plist 'maxlength) - (plist-get plist 'options) - action - nil - plist)) - (size (w3-form-determine-size el (plist-get plist 'size))) - (node (assoc action w3-form-elements))) - (if (not (assq '*table-autolayout w3-display-open-element-stack)) - (if node - (setcdr node (cons el (cdr node))) - (setq w3-form-elements (cons (cons action (list el)) - w3-form-elements)))) - (if size - (set-text-properties (point) - (progn (insert-char ?T size) (point)) - (list 'w3-form-info (cons el face) - 'start-open t - 'end-open t - 'rear-nonsticky t))))) - -(defun w3-form-resurrect-widgets () - (let ((st (point-min)) - ;; FIXME! For some reason this loses on long lines right now. - (widget-push-button-gui nil) - info nd node action face) - (while st - (if (setq info (get-text-property st 'w3-form-info)) - (progn - (setq nd (or (next-single-property-change st 'w3-form-info) - (point-max)) - face (cdr info) - info (car info) - action (w3-form-element-action info) - node (assoc action w3-form-elements)) - (goto-char st) - (delete-region st nd) - (if (not (w3-form-element-size info)) - (w3-form-element-set-size info 20)) - (w3-form-add-element-internal info face) - (setq st (next-single-property-change st 'w3-form-info))) - (setq st (next-single-property-change st 'w3-form-info)))))) - -(defsubst w3-form-mark-widget (widget el) - (let ((widgets (list widget)) - (children (widget-get widget :children)) - (parent (widget-get widget :parent))) - (w3-form-element-set-widget el widget) - ;; Get _all_ the children associated with this widget - (while children - (setq widgets (cons (car children) widgets)) - (if (widget-get (car children) :children) - (setq children (append children - (widget-get (car children) :children)))) - (setq children (cdr children))) - (while (widget-get widget :parent) - (setq widget (widget-get widget :parent) - widgets (cons widget widgets))) - (setq children (widget-get widget :buttons)) - ;; Special case for radio buttons - (while children - (setq widgets (cons (car children) widgets)) - (if (widget-get (car children) :children) - (setq children (append children - (widget-get (car children) :children)))) - (setq children (cdr children))) - (while widgets - (setq widget (pop widgets)) - (widget-put widget :emacspeak-help 'w3-form-summarize-field) - (widget-put widget :help-echo 'w3-form-summarize-field) - (widget-put widget :w3-form-data el)))) - -(defun w3-form-add-element-internal (el face) - (let* ((widget nil) - (buffer-read-only nil) - (inhibit-read-only t) - (widget-creation-function nil)) - (setq widget-creation-function (or (get (w3-form-element-type el) - 'w3-widget-creation-function) - 'w3-form-default-widget-creator) - widget (and (fboundp widget-creation-function) - (funcall widget-creation-function el face))) - (if (not widget) - nil - (w3-form-mark-widget widget el)))) - -;; These properties tell the add-element function how to actually create -;; each type of widget. -(put 'checkbox 'w3-widget-creation-function 'w3-form-create-checkbox) -(put 'multiline 'w3-widget-creation-function 'w3-form-create-multiline) -(put 'radio 'w3-widget-creation-function 'w3-form-create-radio-button) -(put 'reset 'w3-widget-creation-function 'w3-form-create-submit-button) -(put 'submit 'w3-widget-creation-function 'w3-form-create-submit-button) -(put 'hidden 'w3-widget-creation-function 'ignore) -(put 'file 'w3-widget-creation-function 'w3-form-create-file-browser) -(put 'option 'w3-widget-creation-function 'w3-form-create-option-list) -(put 'keygen 'w3-widget-creation-function 'w3-form-create-keygen-list) -(put 'button 'w3-widget-creation-function 'w3-form-create-button) -(put 'image 'w3-widget-creation-function 'w3-form-create-image) -(put 'int 'w3-widget-creation-function 'w3-form-create-integer) -(put 'float 'w3-widget-creation-function 'w3-form-create-float) -(put 'custom 'w3-widget-creation-function 'w3-form-create-custom) -(put 'text 'w3-widget-creation-function 'w3-form-create-text) -(put 'password 'w3-widget-creation-function 'w3-form-create-password) - -;; Custom support. -(defvar w3-custom-options nil) -(make-variable-buffer-local 'w3-custom-options) - -(defun w3-form-create-custom (el face) - (condition-case () - (require 'cus-edit) - (error (require 'custom-edit))) - (let* ((name (w3-form-element-name el)) - (var-name (w3-form-element-value el)) - (type (plist-get (w3-form-element-plist el) 'custom-type)) - (widget (widget-create (cond ((string-equal type "variable") - 'custom-variable) - ((string-equal type "face") - 'custom-face) - ((string-equal type "group") - 'custom-group) - (t 'item)) (intern var-name)))) - (custom-magic-reset widget) - (push widget w3-custom-options) - widget)) - -(defun w3-form-create-checkbox (el face) - (widget-create 'checkbox - :button-face face - (and (w3-form-element-default-value el) t))) - -(defun w3-form-radio-button-update (widget child event) - (widget-radio-action widget child event) - (w3-form-mark-widget widget (widget-get widget :w3-form-data))) - -(defun w3-form-create-radio-button (el face) - (let* ((name (w3-form-element-name el)) - (action (w3-form-element-action el)) - (uniqid (cons name action)) - (formobj (cdr (assoc uniqid w3-form-radio-elements))) - (widget nil) - ) - (if formobj - (progn - (setq widget (w3-form-element-widget formobj)) - (widget-radio-add-item widget - (list 'item - :button-face face - :format "%t" - :tag "" - :value (w3-form-element-value el))) - (w3-form-mark-widget widget el) - (if (w3-form-element-default-value el) - (progn - (widget-put widget 'w3-form-default-value - (w3-form-element-value el)) - (widget-value-set widget (w3-form-element-value el)))) - nil) - (setq widget (widget-create - 'radio-button-choice - :value (w3-form-element-value el) - :action 'w3-form-radio-button-update - (list 'item - :button-face face - :format "%t" - :tag "" - :value (w3-form-element-value el))) - w3-form-radio-elements (cons (cons uniqid el) - w3-form-radio-elements)) - (widget-put widget 'w3-form-default-value (w3-form-element-value el)) - widget))) - -(defun w3-form-create-button (el face) - ;; This handles dealing with the bogus Netscape 'button' input type - ;; that lots of places have been using to slap javascript shit onto - (let ((val (w3-form-element-value el))) - (if (or (not val) (string= val "")) - (setq val "Push Me")) - (widget-create 'push-button - :notify 'ignore - :button-face face - :value-face face - val))) - -(defun w3-form-create-image (el face) - (widget-create 'push-button - :button-face face - :value-face face - :notify 'w3-form-submit/reset-callback - :value (or - (plist-get (w3-form-element-plist el) 'alt) - (w3-form-element-value el) - "Form-Image"))) - -(defun w3-form-create-submit-button (el face) - (let ((val (w3-form-element-value el))) - (if (or (not val) (string= val "")) - (setq val (if (eq (w3-form-element-type el) 'submit) - "Submit" - "Reset"))) - (widget-create 'push-button - :notify 'w3-form-submit/reset-callback - :button-face face val))) - -(defun w3-form-create-file-browser (el face) - (widget-create 'file - :button-face face - :value-face face - :size (w3-form-element-size el) - :must-match t - :value (w3-form-element-value el))) - -(defun w3-form-create-keygen-list (el face) - (let* ((size (apply 'max (mapcar (function (lambda (pair) (length (car pair)))) - w3-form-valid-key-sizes))) - (options (mapcar (function (lambda (pair) - (list 'choice-item - :format "%[%t%]" - :tab-order -1 - :button-face face - :value-face face - :menu-tag-get `(lambda (zed) ,(car pair)) - :tag (mule-truncate-string (car pair) size ? ) - :value (cdr pair)))) - w3-form-valid-key-sizes))) - (apply 'widget-create 'menu-choice - :emacspeak-help 'w3-form-summarize-field - :value 1024 - :ignore-case t - :tag "Key Length" - :size size - :button-face face - :value-face face - options))) - -(defun w3-form-create-option-list (el face) - (let* ((size (w3-form-determine-size el nil)) - (widget (apply 'widget-create 'menu-choice - :value (w3-form-element-value el) - :ignore-case t - :tag "Choose" - :format "%v" - :size size - :value-face face - :button-face face - (mapcar - (function - (lambda (x) - (list 'choice-item :format "%[%t%]" - :emacspeak-help 'w3-form-summarize-field - :menu-tag-get (` (lambda (zed) (, (car x)))) - :tag (mule-truncate-string (car x) size ? ) - :button-face face - :value-face face - :value (car x)))) - (w3-form-element-options el))))) - (widget-value-set widget (w3-form-element-value el)) - widget)) - -;(defun w3-form-create-multiline (el face) -; (widget-create 'text :value-face face (w3-form-element-value el))) - -(defun w3-form-create-multiline (el face) - (widget-create 'push-button - :button-face face - :notify 'w3-do-text-entry - "Multiline text area")) - -(defun w3-form-create-integer (el face) - (if w3-form-use-old-style - (w3-form-default-widget-creator el face) - (widget-create 'integer - :size (w3-form-element-size el) - :value-face face - :tag "" - :format "%v" - :keymap w3-form-keymap - :w3-form-data el - (w3-form-element-value el)))) - -(defun w3-form-create-float (el face) - (if w3-form-use-old-style - (w3-form-default-widget-creator el face) - (widget-create 'number - :size (w3-form-element-size el) - :value-face face - :format "%v" - :tag "" - :keymap w3-form-keymap - :w3-form-data el - (w3-form-element-value el)))) - -(defun w3-form-create-text (el face) - (if w3-form-use-old-style - (w3-form-default-widget-creator el face) - (widget-create 'editable-field - :keymap w3-form-keymap - :size (w3-form-element-size el) - :value-face face - :w3-form-data el - (w3-form-element-value el)))) - -(defun w3-form-create-password (el face) - ;; *sigh* This will fail under XEmacs, but I can yell at them about - ;; upgrading separately for the release of 19.15 and 20.0 - (if w3-form-use-old-style - (w3-form-default-widget-creator el face) - (widget-create 'editable-field - :secret ?* - :keymap w3-form-keymap - :size (w3-form-element-size el) - :value-face face - :button-face face - :w3-form-data el - (w3-form-element-value el)))) - -(defun w3-form-default-widget-creator (el face) - (widget-create 'link - :notify 'w3-form-default-button-callback - :value-to-internal 'w3-form-default-button-update - :size (w3-form-element-size el) - :value-face face - :button-face face - :w3-form-data el - (w3-form-element-value el))) - -(defun w3-form-default-button-update (w v) - (let ((info (widget-get w :w3-form-data))) - (widget-put w :tag - (if info - (mule-truncate-string - (if (eq 'password (w3-form-element-type info)) - (make-string (length v) ?*) - v) - (w3-form-element-size info) ? ))) - v)) - -(defun w3-form-default-button-callback (widget &rest ignore) - (let* ((obj (widget-get widget :w3-form-data)) - (typ (w3-form-element-type obj)) - (def (widget-value widget)) - (val nil) - ) - (case typ - (password - (setq val (funcall url-passwd-entry-func "Password: " def))) - (otherwise - (setq val (read-string - (concat (capitalize (symbol-name typ)) ": ") def)))) - (widget-value-set widget val)) - (apply 'w3-form-possibly-submit widget ignore)) - -;; These properties tell the help-echo function how to summarize each -;; type of widget. -(put 'checkbox 'w3-summarize-function 'w3-form-summarize-checkbox) -(put 'multiline 'w3-summarize-function 'w3-form-summarize-multiline) -(put 'radio 'w3-summarize-function 'w3-form-summarize-radio-button) -(put 'reset 'w3-summarize-function 'w3-form-summarize-submit-button) -(put 'submit 'w3-summarize-function 'w3-form-summarize-submit-button) -(put 'button 'w3-summarize-function 'w3-form-summarize-submit-button) -(put 'file 'w3-summarize-function 'w3-form-summarize-file-browser) -(put 'option 'w3-summarize-function 'w3-form-summarize-option-list) -(put 'keygen 'w3-summarize-function 'w3-form-summarize-keygen-list) -(put 'image 'w3-summarize-function 'w3-form-summarize-image) -(put 'password 'w3-summarize-function 'w3-form-summarize-password) -(put 'hidden 'w3-summarize-function 'ignore) - -(defun w3-form-summarize-field (widget &rest ignore) - "Sumarize a widget that should be a W3 form entry area. -This can be used as the :help-echo property of all w3 form entry widgets." - (let ((info nil) - (func nil) - (msg nil) - ) - (setq info (widget-get widget :w3-form-data)) - (if info - nil - (while (widget-get widget :parent) - (setq widget (widget-get widget :parent))) - (setq info (widget-get widget :w3-form-data))) - (if (not info) - (signal 'wrong-type-argument (list 'w3-form-widget widget))) - (setq func (or (get (w3-form-element-type info) 'w3-summarize-function) - 'w3-form-summarize-default) - msg (and (fboundp func) (funcall func info widget))) - ;; FIXME! This should be removed once emacspeak is updated to - ;; more closely follow the widget-y way of just returning the string - ;; instead of having the underlying :help-echo or :emacspeak-help - ;; implementation do it. - (and msg (message "%s" msg)))) - -(defsubst w3-form-field-label (data) - ;;; FIXXX!!! Need to reimplement using the new forms implementation! - (declare (special w3-form-labels)) - (cdr-safe - (assoc (or (plist-get (w3-form-element-plist data) 'id) - (plist-get (w3-form-element-plist data) 'label)) - w3-form-labels))) - -(defun w3-form-summarize-default (data widget) - (let ((label (w3-form-field-label data)) - (name (w3-form-element-name data)) - (value (widget-value (w3-form-element-widget data)))) - (format "Text field %s set to: %s" (or label (concat "called " name)) - value))) - -(defun w3-form-summarize-password (data widget) - (let ((label (w3-form-field-label data)) - (name (w3-form-element-name data))) - (format "Password field %s is a secret. Shhh." - (or label (concat "called " name))))) - -(defun w3-form-summarize-multiline (data widget) - (let ((name (w3-form-element-name data)) - (label (w3-form-field-label data)) - (value (w3-form-element-value data))) - (format "Multiline text input %s set to: %s" - (or label (concat "called " name)) - value))) - -(defun w3-form-summarize-checkbox (data widget) - (let ((name (w3-form-element-name data)) - (label (w3-form-field-label data)) - (checked (widget-value (w3-form-element-widget data)))) - (format "Checkbox %s is %s" (or label name) (if checked "on" "off")))) - -(defun w3-form-summarize-option-list (data widget) - (let ((name (w3-form-element-name data)) - (label (w3-form-field-label data)) - (default (w3-form-element-default-value data))) - (format "Option list (%s) set to: %s" (or label name) - (widget-value (w3-form-element-widget data))))) - -(defun w3-form-summarize-image (data widget) - (let ((name (w3-form-element-name data)) - (label (w3-form-field-label data))) - (concat "Image entry " (or label (concat "called " name))))) - -(defun w3-form-summarize-submit-button (data widget) - (let* ((type (w3-form-element-type data)) - (label (w3-form-field-label data)) - (button-text (widget-value (w3-form-element-widget data))) - (type-desc (case type - (submit "Submit Form") - (reset "Reset Form") - (button "A Button")))) - (format "%s: %s" type-desc (or label button-text "")))) - -(defun w3-form-summarize-radio-button (data widget) - (let ((name (w3-form-element-name data)) - (label (w3-form-field-label data)) - (cur-value (widget-value (w3-form-element-widget data))) - (this-value (widget-value (widget-get-sibling widget)))) - (if (equal this-value cur-value) - (format "Radio group %s has %s pressed" - (or label name) this-value) - (format "Press this to change radio group %s from %s to %s" (or label name) cur-value - this-value)))) - -(defun w3-form-summarize-file-browser (data widget) - (let ((name (w3-form-element-name data)) - (label (w3-form-field-label data)) - (file (widget-value (w3-form-element-widget data)))) - (format "File entry %s pointing to: %s" (or label name) (or file - "[nothing]")))) - -(defun w3-form-summarize-keygen-list (data widget) - (format "Submitting this form will generate a %d bit key (not)" - (widget-value (w3-form-element-widget data)))) - -(defun w3-form-maybe-submit-by-keypress () - (interactive) - (let ((widget (widget-at (point)))) - (if widget - (w3-form-possibly-submit widget)))) - -(defun w3-form-possibly-submit (widget &rest ignore) - (let* ((formobj (widget-get widget :w3-form-data)) - (ident (w3-form-element-action formobj)) - (widgets (w3-all-widgets ident)) - (text-fields 0) - (text-p nil)) - ;; - ;; Gack. Netscape auto-submits forms of one text field - ;; here we go through the list of widgets in this form and - ;; determine which are not submit/reset/button inputs. - ;; If the # == 1, then submit the form. - ;; - (while widgets - (setq text-fields (+ - text-fields - (case (w3-form-element-type (car widgets)) - ((submit reset image button) - 0) - (text - (setq text-p t) - 1) - (otherwise - 1))) - widgets (cdr widgets))) - (if (and (= text-fields 1) text-p) - (w3-submit-form ident)))) - -(defun w3-form-submit/reset-callback (widget &rest ignore) - (let* ((formobj (widget-get widget :w3-form-data)) - (w3-submit-button formobj)) - (case (w3-form-element-type formobj) - (submit (w3-submit-form (w3-form-element-action formobj))) - (reset (w3-revert-form (w3-form-element-action formobj))) - (image (w3-submit-form (w3-form-element-action formobj))) - (otherwise - (error - "Impossible widget type %s triggered w3-form-submit/reset-callback" - (w3-form-element-type formobj)))))) - -(defun w3-do-text-entry (widget &rest ignore) - (let* ((data (list widget (current-buffer))) - (formobj (widget-get widget :w3-form-data)) - (buff (get-buffer-create (format "Form Entry: %s" - (w3-form-element-name formobj))))) - (switch-to-buffer-other-window buff) - (indented-text-mode) - (erase-buffer) - (if (w3-form-element-value formobj) - (insert (w3-form-element-value formobj))) - (setq w3-current-last-buffer data) - (message "Press C-c C-c when finished with text entry.") - (local-set-key "\C-c\C-c" 'w3-finish-text-entry))) - -(defun w3-finish-text-entry () - (interactive) - (if w3-current-last-buffer - (let* ((widget (nth 0 w3-current-last-buffer)) - (formobj (widget-get widget :w3-form-data)) - (buff (nth 1 w3-current-last-buffer)) - (valu (buffer-string)) - (inhibit-read-only t) - ) - (local-set-key "\C-c\C-c" 'undefined) - (kill-buffer (current-buffer)) - (condition-case () - (delete-window) - (error nil)) - (if (not (and buff (bufferp buff) (buffer-name buff))) - (message "Could not find the form buffer for this text!") - (switch-to-buffer buff) - (w3-form-element-set-value formobj valu))))) - -(defsubst w3-all-widgets (actn) - ;; Return a list of data entry widgets in form number ACTN - (cdr-safe (assoc actn w3-form-elements))) - -(defun w3-revert-form (actn) - (save-excursion - (let* ((formobjs (w3-all-widgets actn)) - (inhibit-read-only t) - deft type widget formobj) - (while formobjs - (setq formobj (car formobjs) - widget (w3-form-element-widget formobj) - formobjs (cdr formobjs) - deft (w3-form-element-default-value formobj) - type (w3-form-element-type formobj)) - (case type - ((submit reset image hidden) nil) - (radio - (setq deft (widget-get widget 'w3-form-default-value)) - (if (and widget deft) - (widget-value-set widget deft))) - (checkbox - (if deft - (widget-value-set widget t) - (widget-value-set widget nil))) - (multiline - (w3-form-element-set-value formobj (w3-form-element-default-value - formobj))) - (file - (widget-value-set widget deft)) - (otherwise - (widget-value-set widget deft)))) - (widget-setup)))) - -(defun w3-form-encode-helper (formobjs) - (let ( - (submit-button-data w3-submit-button) - formobj result widget temp type) - (while formobjs - (setq formobj (car formobjs) - type (w3-form-element-type formobj) - widget (w3-form-element-widget formobj) - formobjs (cdr formobjs) - temp (case type - (reset nil) - (button nil) - (image - (if (and (eq submit-button-data formobj) - (w3-form-element-name formobj)) - (setq result (append - (list - (cons - (concat (w3-form-element-name formobj) - ".x") "0") - (cons - (concat (w3-form-element-name formobj) - ".y") "0")) - result))) - nil) - (submit - (if (and (eq submit-button-data formobj) - (w3-form-element-name formobj)) - (cons (w3-form-element-name formobj) - (w3-form-element-value formobj)))) - (radio - (let* ((radio-name (w3-form-element-name formobj)) - (radio-object (cdr-safe - (assoc - (cons - radio-name - (w3-form-element-action formobj)) - w3-form-radio-elements))) - (chosen-widget (and radio-object - (widget-radio-chosen - (w3-form-element-widget - radio-object))))) - (if (assoc radio-name result) - nil - (cons radio-name (widget-value chosen-widget))))) - ((int float) - (cons (w3-form-element-name formobj) - (number-to-string (or (condition-case () - (widget-value widget) - (error nil)) 0)))) - (checkbox - (if (widget-value widget) - (cons (w3-form-element-name formobj) - (w3-form-element-value formobj)))) - (file - (let ((dat nil) - (fname (widget-value widget))) - (save-excursion - (set-buffer (get-buffer-create " *w3-temp*")) - (erase-buffer) - (setq dat - (condition-case () - (insert-file-contents-literally fname) - (error (concat "Error accessing " fname)))) - (cons (w3-form-element-name formobj) dat)))) - (option - (cons (w3-form-element-name formobj) - (cdr-safe - (assoc (widget-value widget) - (w3-form-element-options formobj))))) - (keygen - (condition-case () - (require 'ssl) - (error (error "Not configured for SSL, please read the info pages."))) - (if (fboundp 'ssl-req-user-cert) nil - (error "This version of SSL isn't capable of requesting certificates.")) - (let ((challenge (plist-get (w3-form-element-plist formobj) 'challenge)) - (size (widget-value widget))) - (cons (w3-form-element-name formobj) - (ssl-req-user-cert size challenge)))) - ((multiline hidden) - (cons (w3-form-element-name formobj) - (w3-form-element-value formobj))) - (otherwise - (cons (w3-form-element-name formobj) - (widget-value widget))))) - (if temp - (setq result (cons temp result)))) - result)) - -(defun w3-form-encode-make-mime-part (id data separator) - (concat separator "\nContent-id: " id - "\nContent-length: " (length data) - "\n\n" data)) - -(defun w3-form-encode-multipart/x-www-form-data (formobjs) - ;; Create a multipart form submission. - ;; Returns a cons of two strings. Car is the separator used. - ;; cdr is the body of the MIME message." - (let ((separator "---some-separator-for-www-form-data")) - (cons separator - (mapconcat - (function - (lambda (formobj) - (w3-form-encode-make-mime-part (car formobj) (cdr formobj) - separator))) - (w3-form-encode-helper formobjs) - "\n")))) - -(fset 'w3-form-encode-multipart/form-data - 'w3-form-encode-multipart/x-www-form-data) -(fset 'w3-form-encode- 'w3-form-encode-application/x-www-form-urlencoded) - -(defun w3-next-widget (pos) - (let* ((next (cond ((get-text-property pos 'button) - (next-single-property-change pos 'button)) - ((get-text-property pos 'field) - (next-single-property-change pos 'field)) - (t pos))) - (button (and next (next-single-property-change next 'button))) - (field (and next (next-single-property-change next 'field)))) - (setq next - (cond - ((and button field) (min button field)) - (button button) - (field field) - (t nil))) - (and next - (or (get-text-property next 'button) - (get-text-property next 'field))))) - -(defun w3-form-encode (result &optional enctype) - "Create a string suitably encoded for a URL request." - (let ((func (intern (concat "w3-form-encode-" enctype)))) - (if (fboundp func) - (funcall func result) - (w3-warn 'html (format "Bad encoding type for form data: %s" enctype)) - (w3-form-encode-application/x-www-form-urlencoded result)))) - -(defun w3-form-encode-text/plain (result) - (let ((query "")) - (setq query - (mapconcat - (function - (lambda (widget) - (let ((nam (car widget)) - (val (cdr widget))) - (if (string-match "\n" nam) - (setq nam (mapconcat - (function - (lambda (x) - (if (= x ?\n) "," (char-to-string x)))) - nam ""))) - (concat nam " " val)))) - (w3-form-encode-helper result) "\n")) - query)) - -(defun w3-form-encode-application/x-gopher-query (result) - (concat "\t" (cdr (car (w3-form-encode-helper result))))) - -(defun w3-form-encode-xwfu (chunk) - "Escape characters in a string for application/x-www-form-urlencoded. -Blasphemous crap because someone didn't think %20 was good enough for encoding -spaces. Die Die Die." - (mapconcat - (function - (lambda (char) - (cond - ((= char ? ) "+") - ((memq char url-unreserved-chars) (char-to-string char)) - (t (upcase (format "%%%02x" char)))))) - (mule-encode-string chunk) "")) - -(defun w3-form-encode-application/x-www-form-urlencoded (result) - (mapconcat - (function - (lambda (data) - (concat (w3-form-encode-xwfu (car data)) "=" - (w3-form-encode-xwfu (cdr data))))) - (w3-form-encode-helper result) "&")) - -(defun w3-form-encode-application/x-w3-isindex (result) - (let* ((info (w3-form-encode-helper result)) - (query (cdr-safe (assoc "isindex" info)))) - (if query - (url-hexify-string query) - ""))) - -(defun w3-form-encode-application/gopher-ask-block (result) - (let ((query "")) - ;;; gopher+ will expect all the checkboxes/etc, even if they are - ;;; not turned on. Should still ignore RADIO boxes that are not - ;;; active though. - (while result - (if (and (not (and (string= (nth 2 (car result)) "RADIO") - (not (nth 6 (car result))))) - (not (member (nth 2 (car result)) '("SUBMIT" "RESET")))) - (setq query (format "%s\r\n%s" query (nth 5 (car result))))) - (setq result (cdr result))) - (concat query "\r\n.\r\n"))) - -(defun w3-submit-form (ident) - ;; Submit form entry fields matching ACTN as their action identifier. - (let* ((result (w3-all-widgets ident)) - (enctype (or (cdr (assq 'enctype ident)) - "application/x-www-form-urlencoded")) - (query (w3-form-encode result enctype)) - (themeth (upcase (or (cdr (assq 'method ident)) "get"))) - (theurl (cdr (assq 'action ident)))) - (if (and (string= "GET" themeth) - (string-match "\\([^\\?]*\\)\\?" theurl)) - (setq theurl (url-match theurl 1))) - (cond - ((or (string= "POST" themeth) - (string= "PUT" themeth)) - (if (consp query) - (setq enctype (concat enctype "; separator=\"" - (substring (car query) 3 nil) - "\"") - query (cdr query))) - (let ((url-request-method themeth) - (url-request-data query) - (url-request-extra-headers - (cons (cons "Content-type" enctype) url-request-extra-headers))) - (w3-fetch theurl))) - ((string= "GET" themeth) - (let ((theurl (concat theurl (if (string-match "gopher" enctype) - "" "?") query))) - (w3-fetch theurl))) - (t - (w3-warn 'html (format "Unknown submit method: %s" themeth)) - (let ((theurl (concat theurl "?" query))) - (w3-fetch theurl)))))) - -(provide 'w3-forms) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-hot.el --- a/lisp/w3/w3-hot.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,364 +0,0 @@ -;;; w3-hot.el --- Main functions for emacs-w3 on all platforms/versions -;; Author: wmperry -;; Created: 1997/06/27 15:41:38 -;; Version: 1.16 -;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Structure for hotlists -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; ( -;;; ("name of item1" . "http://foo.bar.com/") ;; A single item in hotlist -;;; ("name of item2" . ( ;; A sublist -;;; ("name of item3" . "http://www.ack.com/") -;;; )) -;;; ) ; end of hotlist -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'w3-vars) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Hotlist Handling Code -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-html-bookmarks nil) - -(defun w3-hotlist-break-shit () - (let ((todo '(w3-hotlist-apropos - w3-hotlist-delete - w3-hotlist-rename-entry - w3-hotlist-append - w3-use-hotlist - w3-hotlist-add-document - w3-hotlist-add-document-at-point - )) - (cur nil)) - (while todo - (setq cur (car todo) - todo (cdr todo)) - (fset cur - (` - (lambda (&rest ignore) - (error "Sorry, `%s' does not work with html bookmarks" - (quote (, cur))))))))) - -(defun w3-read-html-bookmarks (fname) - "Import an HTML file into the Emacs-w3 format." - (interactive "fBookmark file: ") - (if (not (file-readable-p fname)) - (error "Can not read %s..." fname)) - (save-excursion - (set-buffer (get-buffer-create " *bookmark-work*")) - (erase-buffer) - (insert-file-contents fname) - (let* ((w3-debug-html nil) - (bkmarks nil) - (parse (w3-parse-buffer (current-buffer)))) - (setq parse w3-last-parse-tree - bkmarks (nreverse (w3-grok-html-bookmarks parse)) - w3-html-bookmarks bkmarks))) - (w3-hotlist-break-shit)) - -(eval-when-compile - (defvar cur-stack nil) - (defvar cur-title nil) - (defmacro push-new-menu () - '(setq cur-stack (cons (list "") cur-stack))) - - (defmacro push-new-item (title href) - (` (setcar cur-stack (cons (vector (, title) (list 'w3-fetch (, href)) t) - (car cur-stack))))) - ;;(` (setcar cur-stack (cons (cons (, title) (, href)) (car cur-stack))))) - - (defmacro finish-submenu () - '(let ((x (nreverse (car cur-stack)))) - (and x (setcar x (car cur-title))) - (setq cur-stack (cdr cur-stack) - cur-title (cdr cur-title)) - (if cur-stack - (setcar cur-stack (cons x (car cur-stack))) - (setq cur-stack (list x))))) - ) - -(defun w3-grok-html-bookmarks-internal (tree) - (let (node tag content args) - (while tree - (setq node (car tree) - tree (cdr tree) - tag (and (listp node) (nth 0 node)) - args (and (listp node) (nth 1 node)) - content (and (listp node) (nth 2 node))) - (cond - ((eq tag 'title) - (setq cur-title (list (w3-normalize-spaces (car content)))) - (w3-grok-html-bookmarks-internal content)) - ((memq tag '(dl ol ul)) - (push-new-menu) - (w3-grok-html-bookmarks-internal content) - (finish-submenu)) - ((and (memq tag '(dt li)) - (stringp (car content))) - (setq cur-title (cons (w3-normalize-spaces (car content)) - cur-title))) - ((and (eq tag 'a) - (stringp (car-safe content)) - (cdr-safe (assq 'href args))) - (push-new-item (w3-normalize-spaces (car-safe content)) - (cdr-safe (assq 'href args)))) - (content - (w3-grok-html-bookmarks-internal content)))))) - -(defun w3-grok-html-bookmarks (chunk) - (let ( - cur-title - cur-stack - ) - (w3-grok-html-bookmarks-internal chunk) - (reverse (car cur-stack)))) - -(defun w3-hotlist-apropos (regexp) - "Show hotlist entries matching REGEXP." - (interactive "sW3 Hotlist Apropos (regexp): ") - (or w3-setup-done (w3-do-setup)) - (let ((save-buf (get-buffer "Hotlist")) ; avoid killing this - (w3-hotlist - (apply - 'nconc - (mapcar - (function - (lambda (entry) - (if (or (string-match regexp (car entry)) - (string-match regexp (car (cdr entry)))) - (list entry)))) - w3-hotlist)))) - (if (not w3-hotlist) - (message "No w3-hotlist entries match \"%s\"" regexp) - (and save-buf (save-excursion - (set-buffer save-buf) - (rename-buffer (concat "Hotlist during " regexp)))) - (unwind-protect - (let ((w3-reuse-buffers 'no)) - (w3-show-hotlist) - (rename-buffer (concat "Hotlist \"" regexp "\"")) - (url-set-filename url-current-object (concat "hotlist/" regexp))) - (and save-buf (save-excursion - (set-buffer save-buf) - (rename-buffer "Hotlist"))))))) - -(defun w3-hotlist-refresh () - "Reload the default hotlist file into memory" - (interactive) - (w3-parse-hotlist)) - -(defun w3-delete-from-alist (x alist) - ;; Remove X from ALIST, return new alist - (if (eq (assoc x alist) (car alist)) (cdr alist) - (delq (assoc x alist) alist))) - -;;;###autoload -(defun w3-hotlist-delete () - "Deletes a document from your hotlist file" - (interactive) - (save-excursion - (if (not w3-hotlist) (message "No hotlist in memory!") - (if (not (file-exists-p w3-hotlist-file)) - (message "Hotlist file %s does not exist." w3-hotlist-file) - (let* ((completion-ignore-case t) - (title (car (assoc (completing-read "Delete Document: " - w3-hotlist nil t) - w3-hotlist))) - (case-fold-search nil) - (buffer (get-buffer-create " *HOTW3*"))) - (and (string= title "") (error "No document specified.")) - (set-buffer buffer) - (erase-buffer) - (insert-file-contents w3-hotlist-file) - (goto-char (point-min)) - (if (re-search-forward (concat "^" (regexp-quote title) "\r*$") - nil t) - (let ((make-backup-files nil) - (version-control nil) - (require-final-newline t)) - (previous-line 1) - (beginning-of-line) - (delete-region (point) (progn (forward-line 2) (point))) - (write-file w3-hotlist-file) - (setq w3-hotlist (w3-delete-from-alist title w3-hotlist)) - (kill-buffer (current-buffer))) - (message "%s was not found in %s" title w3-hotlist-file))))))) - -;;;###autoload -(defun w3-hotlist-rename-entry (title) - "Rename a hotlist item" - (interactive (list (let ((completion-ignore-case t)) - (completing-read "Rename entry: " w3-hotlist nil t)))) - (cond ; Do the error handling first - ((string= title "") (error "No document specified!")) - ((not w3-hotlist) (error "No hotlist in memory!")) - ((not (file-exists-p (expand-file-name w3-hotlist-file))) - (error "Hotlist file %s does not exist." w3-hotlist-file)) - ((not (file-readable-p (expand-file-name w3-hotlist-file))) - (error "Hotlist file %s exists, but is unreadable." w3-hotlist-file))) - (save-excursion - (let ((obj (assoc title w3-hotlist)) - (used (mapcar 'car w3-hotlist)) - (buff (get-buffer-create " *HOTW3*")) - (new nil) - ) - (while (or (null new) (member new used)) - (setq new (read-string "New name: "))) - (set-buffer buff) - (erase-buffer) - (insert-file-contents (expand-file-name w3-hotlist-file)) - (goto-char (point-min)) - (if (re-search-forward (regexp-quote title) nil t) - (let ((make-backup-files nil) - (version-control nil) - (require-final-newline t)) - (previous-line 1) - (beginning-of-line) - (delete-region (point) (progn (forward-line 2) (point))) - (insert (format "%s %s\n%s\n" (nth 1 obj) (current-time-string) - new)) - (setq w3-hotlist (cons (list new (nth 1 obj)) - (w3-delete-from-alist title w3-hotlist))) - (write-file w3-hotlist-file) - (kill-buffer (current-buffer)) - (if (not w3-running-xemacs) - (progn - (delete-menu-item '("Go")) - (w3-build-FSF19-menu)))) - (message "%s was not found in %s" title w3-hotlist-file))))) - -;;;###autoload -(defun w3-hotlist-append (fname) - "Append a hotlist to the one in memory" - (interactive "fAppend hotlist file: ") - (let ((x w3-hotlist)) - (w3-parse-hotlist fname) - (setq w3-hotlist (nconc x w3-hotlist)))) - -(defun w3-hotlist-parse-old-mosaic-format () - (let (cur-link cur-alias) - (while (re-search-forward "^\n" nil t) (replace-match "")) - (goto-line 3) - (while (not (eobp)) - (re-search-forward "^[^ ]*" nil t) - (setq cur-link (buffer-substring (match-beginning 0) (match-end 0))) - (setq cur-alias (buffer-substring (progn - (forward-line 1) - (beginning-of-line) - (point)) - (progn - (end-of-line) - (point)))) - (if (not (equal cur-alias "")) - (setq w3-hotlist (cons (list cur-alias cur-link) w3-hotlist)))))) - -(defun w3-parse-hotlist (&optional fname) - "Read in the hotlist specified by FNAME" - (if (not fname) (setq fname w3-hotlist-file)) - (setq w3-hotlist nil) - (if (not (file-exists-p fname)) - (message "%s does not exist!" fname) - (let* ((old-buffer (current-buffer)) - (buffer (get-buffer-create " *HOTW3*")) - (case-fold-search t)) - (set-buffer buffer) - (erase-buffer) - (insert-file-contents fname) - (goto-char (point-min)) - (cond - ((looking-at "ncsa-xmosaic-hotlist-format-1");; Old-style NCSA Mosaic - (w3-hotlist-parse-old-mosaic-format)) - ((or (looking-at "<!DOCTYPE") ; Some HTML style, including netscape - (re-search-forward "<a[ \n]+href" nil t)) - (w3-read-html-bookmarks fname)) - (t - (message "Cannot determine format of hotlist file: %s" fname))) - (set-buffer-modified-p nil) - (kill-buffer buffer) - (set-buffer old-buffer)))) - -;;;###autoload -(defun w3-use-hotlist () - "Possibly go to a link in your W3/Mosaic hotlist. -This is part of the emacs World Wide Web browser. It will prompt for -one of the items in your 'hotlist'. A hotlist is a list of often -visited or interesting items you have found on the World Wide Web." - (interactive) - (if (not w3-setup-done) (w3-do-setup)) - (if (not w3-hotlist) (message "No hotlist in memory!") - (let* ((completion-ignore-case t) - (url (car (cdr (assoc - (completing-read "Goto Document: " w3-hotlist nil t) - w3-hotlist))))) - (if (string= "" url) (error "No document specified!")) - (w3-fetch url)))) - -(defun w3-hotlist-add-document-at-point (pref-arg) - "Add the document pointed to by the hyperlink under point to the hotlist." - (interactive "P") - (let ((url (w3-view-this-url t)) - (widget (widget-at (point))) - (title nil)) - (or url (error "No link under point.")) - (if (and (widget-get widget :from) - (widget-get widget :to)) - (setq title (buffer-substring (widget-get widget :from) - (widget-get widget :to)))) - (w3-hotlist-add-document pref-arg (or title url) url))) - -;;;###autoload -(defun w3-hotlist-add-document (pref-arg &optional the-title the-url) - "Add this documents url to the hotlist" - (interactive "P") - (save-excursion - (let* ((buffer (get-buffer-create " *HOTW3*")) - (title (or the-title - (and pref-arg (read-string "Title: ")) - (buffer-name))) - (make-backup-files nil) - (version-control nil) - (require-final-newline t) - (url (or the-url (url-view-url t)))) - (if (rassoc (list url) w3-hotlist) - (error "That item already in hotlist, use w3-hotlist-rename-entry.")) - (set-buffer buffer) - (erase-buffer) - (setq w3-hotlist (cons (list title url) w3-hotlist) - url (url-unhex-string url)) - (if (not (file-exists-p w3-hotlist-file)) - (progn - (message "Creating hotlist file %s" w3-hotlist-file) - (insert "ncsa-xmosaic-hotlist-format-1\nDefault\n\n") - (backward-char 1)) - (progn - (insert-file-contents w3-hotlist-file) - (goto-char (point-max)) - (backward-char 1))) - (insert "\n" url " " (current-time-string) "\n" title) - (write-file w3-hotlist-file) - (kill-buffer (current-buffer))))) - -(provide 'w3-hot) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-imap.el --- a/lisp/w3/w3-imap.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,227 +0,0 @@ -;;; w3-imap.el --- Imagemap functions -;; Author: wmperry -;; Created: 1997/01/10 00:13:05 -;; Version: 1.7 -;; Keywords: hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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 'w3-vars) -(eval-and-compile - (require 'widget)) - -(eval-when-compile - (defmacro x-coord (pt) (list 'aref pt 0)) - (defmacro y-coord (pt) (list 'aref pt 1))) - -(defun w3-point-in-rect (point coord1 coord2 &rest ignore) - "Return t iff POINT is within a rectangle defined by COORD1 and COORD2. -All arguments are vectors of [X Y] coordinates." - ;; D'uhhh, this is hard. - (and (>= (x-coord point) (x-coord coord1)) - (<= (x-coord point) (x-coord coord2)) - (>= (y-coord point) (y-coord coord1)) - (<= (y-coord point) (y-coord coord2)))) - -(defun w3-point-in-circle (point coord1 coord2 &rest ignore) - "Return t iff POINT is within a circle defined by COORD1 and COORD2. -All arguments are vectors of [X Y] coordinates." - ;; D'uhhh, this is (barely) slightly harder. - (let (radius1 radius2) - (setq radius1 (+ - (* - (- (y-coord coord1) (y-coord coord2)) - (- (y-coord coord1) (y-coord coord2))) - (* - (- (x-coord coord1) (x-coord coord2)) - (- (x-coord coord1) (x-coord coord2))) - ) - radius2 (+ - (* - (- (y-coord coord1) (y-coord point)) - (- (y-coord coord1) (y-coord point))) - (* - (- (x-coord coord1) (x-coord point)) - (- (x-coord coord1) (x-coord point))) - ) - ) - (<= radius2 radius1))) - -;; A polygon is a vector -;; poly[0] = # of sides -;; poly[1] = # of sides used -;; poly[2] = vector of X coords -;; poly[3] = vector of Y coords - -(defsubst w3-image-poly-nsegs (p) - (aref p 0)) - -(defsubst w3-image-poly-used-segs (p) - (aref p 1)) - -(defsubst w3-image-poly-x-coords (p) - (aref p 2)) - -(defsubst w3-image-poly-y-coords (p) - (aref p 3)) - -(defsubst w3-image-poly-x-coord (p n) - (aref (w3-image-poly-x-coords p) n)) - -(defsubst w3-image-poly-y-coord (p n) - (aref (w3-image-poly-y-coords p) n)) - -(defun w3-image-poly-alloc (n) - (if (< n 3) - (error "w3-image-poly-alloc: invalid number of sides (%d)" n)) - - (vector n 0 (make-vector n nil) (make-vector n nil))) - -(defun w3-image-poly-assign (p x y) - (if (>= (w3-image-poly-used-segs p) (w3-image-poly-nsegs p)) - (error "w3-image-poly-assign: out of space in the w3-image-polygon")) - (aset (w3-image-poly-x-coords p) (w3-image-poly-used-segs p) x) - (aset (w3-image-poly-y-coords p) (w3-image-poly-used-segs p) y) - (aset p 1 (1+ (w3-image-poly-used-segs p)))) - -(defun w3-image-ccw (p0 p1 p2) - (let (dx1 dx2 dy1 dy2 retval) - (setq dx1 (- (x-coord p1) (x-coord p0)) - dy1 (- (y-coord p1) (y-coord p0)) - dx2 (- (x-coord p2) (x-coord p0)) - dy2 (- (y-coord p2) (y-coord p0))) - (cond - ((> (* dx1 dy2) (* dy1 dx2)) - (setq retval 1)) - ((< (* dx1 dy2) (* dy1 dx2)) - (setq retval -1)) - ((or (< (* dx1 dx2) 0) - (< (* dy1 dy2) 0)) - (setq retval -1)) - ((< (+ (* dx1 dx1) (* dy1 dy1)) - (+ (* dx2 dx2) (* dy2 dy2))) - (setq retval 1)) - (t - (setq retval 0))) - retval)) - -(defun w3-image-line-intersect (l1 l2) - (and (<= (* (w3-image-ccw (car l1) (cdr l1) (car l2)) - (w3-image-ccw (car l1) (cdr l1) (cdr l2))) 0) - (<= (* (w3-image-ccw (car l2) (cdr l2) (car l1)) - (w3-image-ccw (car l2) (cdr l2) (cdr l1))) 0))) - -(defun w3-point-in-poly (point &rest pgon) - "Return t iff POINT is within a polygon defined by the list of points PGON. -All arguments are either vectors of [X Y] coordinates or lists of such -vectors." - ;; Right now, this fails on some points that are right on a line segment - ;; but it works for everything else (I think) - (if (< (length pgon) 3) - ;; Malformed polygon!!! - nil - (let ((p (w3-image-poly-alloc (length pgon))) - (hitcount 0) - (i 0) - (ip1 0) - (l1 nil) - (l2 (cons (vector (x-coord point) (1+ (y-coord point))) - (vector (x-coord point) (y-coord point)))) - ) - (while pgon - (w3-image-poly-assign p (x-coord (car pgon)) (y-coord (car pgon))) - (setq pgon (cdr pgon))) - (while (< i (w3-image-poly-nsegs p)) - ;; Check for wraparound - (setq ip1 (1+ i)) - (if (= ip1 (w3-image-poly-nsegs p)) - (setq ip1 0)) - - (setq l1 (cons (vector (w3-image-poly-x-coord p i) - (w3-image-poly-y-coord p i)) - (vector (w3-image-poly-x-coord p ip1) - (w3-image-poly-y-coord p ip1)))) - - (if (w3-image-line-intersect l1 l2) - (setq hitcount (1+ hitcount))) - (setq i (1+ i))) - (= 1 (% hitcount 2))))) - -(defun w3-point-in-default (point &rest ignore) - t) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun w3-point-in-map (point map &optional alt-text) - (let (func args done cur default slot) - (setq slot (if alt-text 3 2)) - (while (and map (not done)) - (setq cur (car map) - func (intern-soft (format "w3-point-in-%s" (aref cur 0))) - args (aref cur 1) - done (and func (fboundp func) (apply func point args)) - map (cdr map)) - (if (equal (aref cur 0) "default") - (setq default (aref cur slot) - done nil))) - (cond - ((and done (aref cur 2)) ; Found a link - (if alt-text - (or (aref cur 3) (aref cur 2)) - (aref cur slot))) - (default - default) - (t nil)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Regular image stuff -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-allowed-image-types - (mapcar (function (lambda (x) (list (car x)))) w3-image-mappings)) -(defvar w3-image-size-restriction nil) - -(defmacro w3-image-cached-p (href) - "Return non-nil iff HREF is in the image cache." - (` (cdr-safe (assoc (, href) w3-graphics-list)))) - -(defun w3-image-loadable-p (href force) - (let ((attribs (url-file-attributes href))) - (or force - (assoc (nth 8 attribs) w3-allowed-image-types) - (null w3-image-size-restriction) - (<= (nth 7 attribs) 0) - (and (numberp w3-image-size-restriction) - (<= (nth 7 attribs) w3-image-size-restriction))))) - -(defmacro w3-image-invalid-glyph-p (glyph) - (` (or (null (aref (, glyph) 0)) - (null (aref (, glyph) 2)) - (equal (aref (, glyph) 2) "")))) - -;; data structure in storage is a vector -;; if (href == t) then no action should be taken -;; [ type coordinates href (hopefully)descriptive-text] - - -(provide 'w3-imap) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-jscript.el --- a/lisp/w3/w3-jscript.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,30 +0,0 @@ -;;; w3-elisp.el --- Scripting support for javascript -;; Author: wmperry -;; Created: 1997/02/17 16:00:11 -;; Version: 1.2 -;; Keywords: hypermedia, scripting - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; FIXME! Well, actually IMPLEMENTME! - -(provide 'w3-jscript) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-keyword.el --- a/lisp/w3/w3-keyword.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,117 +0,0 @@ -;;; w3-keyword.el --- Emacs-W3 binding style sheet mechanism -;; Author: wmperry -;; Created: 1997/01/10 00:13:05 -;; Version: 1.9 -;; Keywords: hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Lots of generic keywords for use by Emacs-W3 -;;; -;;; This is in a separate file just for sanity's sake - I cannot rely on -;;; keywords being automatically recognized (ala XEmacs), and doing a -;;; defconst doesn't work either, because the byte-compiler gets too -;;; smart for us, and the .elc files are no longer portable. Joy oh joy! -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(let ((keywords '( - :align - :average-pitch - :link-title - :background - :center - :data - :depth - :left-volume - :right-volume - :pitch-range - :stress - :richness - :figalt - :figdata - :fillcol - :form - :formnum - :gain - :header-start - :help-echo - :href - :link-args - :image - :lists - :map - :name - :needspace - :next-break - :nofill - :nowrap - :optarg - :options - :pre-start - :select - :secret - :table - :text-mangler - :title - :w3-graphic - :zone - :label-text - :seen-this-url - - ;; These are duplicated from the font.el code - ;; so that we can share .elc files... - - :family - :weight - :extra-light - :light - :demi-light - :medium - :normal - :demi-bold - :bold - :extra-bold - :style - :size - :registry - :encoding - - ;; These are duplicated from the widget code - ;; so that we can share .elc files - :from - :action - :to - :group - :args - :tag - :notify - :ignore-case - :parent - :type - ))) - (while keywords - (or (boundp (car keywords)) - (set (car keywords) (car keywords))) - (setq keywords (cdr keywords)))) - -(provide 'w3-keyword) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-latex.el --- a/lisp/w3/w3-latex.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,456 +0,0 @@ -;;; w3-latex.el --- Emacs-W3 printing via LaTeX -;; Author: wmperry -;; Created: 1996/06/30 18:08:34 -;; Version: 1.3 -;; Keywords: hypermedia, printing, typesetting - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996, 1997 by Stephen Peters <speters@cygnus.com> -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Elisp code to convert a W3 parse tree into a LaTeX buffer. -;;; -;;; Heavily hacked upon by William Perry <wmperry@cs.indiana.edu> to add more -;;; bells and whistles. -;;; -;;; KNOWN BUGS: -;;; 1) This does not use stylesheets to get the formatting information -;;; 2) This means that the new drawing routines need to be abstracted -;;; further so that the same main engine can be used for either -;;; text-output (standard stuff in w3-draw), LaTeX output (this file), -;;; Postscript (to-be-implemented), etc., etc. -;;; 3) This still doesn't handle tables. -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'w3-cus) -(require 'w3-print) - -;; Internal variables - do not touch! -(defvar w3-latex-current-url nil "What URL we are formatting") -(defvar w3-latex-verbatim nil "Whether we are in a {verbatim} block or not") -(defvar w3-latex-links-list nil "List of links for endnote usage") - -(defvar w3-latex-entities - '((nbsp . "~") - (iexcl . "!`") -; (cent . "") - (pound . "\\pounds ") -; (curren . "") -; (yen . "") - (brvbar . "|") - (sect . "\\S") - (uml . "\\\"{ }") - (copy . "\\copyright ") -; (ordf . "") - (laquo . "$\\ll$") - (not . "\\neg") - (shy . "-") - (reg . "(R)") - (macr . "\\={ }") - (deg . "$\\deg$") - (plusmn . "$\\pm$") - (sup2 . "$^{2}$") - (sup3 . "$^{3}$") - (acute . "\\'{ }") - (micro . "$\\mu$") - (para . "\\P ") - (middot . "$\\cdot$") - (cedil . "\\c{ }") - (sup1 . "$^{1}$") -; (ordm . "") - (raquo . "$\\gg$") - (frac14 . "$\frac{1}{4}$") - (frac12 . "$\frac{1}{2}$") - (frac34 . "$\frac{3}{4}$") - (iquest . "?`") - (Agrave . "\\`{A}") - (Aacute . "\\'{A}") - (Acirc . "\\^{A}") - (Atilde . "\\~{A}") - (Auml . "\\\"{A}") - (Aring . "\\AA ") - (AElig . "\\AE ") - (Ccedil . "\\c{C}") - (Egrave . "\\`{E}") - (Eacute . "\\'{E}") - (Ecirc . "\\^{E}") - (Euml . "\\\"{E}") - (Igrave . "\\`{I}") - (Iacute . "\\'{I}") - (Icirc . "\\^{I}") - (Iuml . "\\\"{I}") -; (ETH . "") - (Ntilde . "\\~{N}") - (Ograve . "\\`{O}") - (Oacute . "\\'{O}") - (Ocirc . "\\^{O}") - (Otilde . "\\~{O}") - (Ouml . "\\\"{O}") - (times . "$\\times$") - (Oslash . "\\O") - (Ugrave . "\\`{U}") - (Uacute . "\\'{U}") - (Ucirc . "\\^{U}") - (Uuml . "\\\"{U}") - (Yacute . "\\'{Y}") -; (THORN . "") - (szlig . "\\ss ") - (agrave . "\\`{a}") - (aacute . "\\'{a}") - (acirc . "\\^{a}") - (atilde . "\\~{a}") - (auml . "\\\"{a}") - (aring . "\\aa ") - (aelig . "\\ae ") - (ccedil . "\\c{c}") - (egrave . "\\`{e}") - (eacute . "\\'{e}") - (ecirc . "\\^{e}") - (euml . "\\\"{e}") - (igrave . "\\`{i}") - (iacute . "\\'{i}") - (icirc . "\\^{i}") - (iuml . "\\\"{i}") -; (eth . "") - (ntilde . "\\~{n}") - (ograve . "\\`{o}") - (oacute . "\\'{o}") - (ocirc . "\\^{o}") - (otilde . "\\~{o}") - (ouml . "\\\"{o}") - (divide . "$\\div$") - (oslash . "\\o") - (ugrave . "\\`{u}") - (uacute . "\\'{u}") - (ucirc . "\\^{u}") - (uuml . "\\\"{u}") - (yacute . "\\'{y}") -; (thorn . "") - (yuml . "\\\"{y}")) - "Defines mappings between `w3-html-entities' and LaTeX characters.") - -(defun w3-latex-replace-entities (str) - (let ((start 0)) - (while (string-match "[\200-\377]" str start) - ; get the character code, and then search for a match in - ; w3-html-entities. If one is found, use it to perform a lookup - ; in w3-latex-entities, and use the resulting match to replace - ; the character. - (let* ((match (rassq (aref str (match-beginning 0)) - w3-html-entities)) - (replace (and match - (assq (car match) w3-latex-entities)))) - (if replace - (setq str (replace-match (cdr replace) t t str))) - (setq start (match-end 0)))) - str)) - -(defun w3-latex-insert-string (str) - ;;; convert string to a LaTeX-compatible one. - (let ((todo (list (cons "\\\\" "-BaCkSlAsH-") - (cons "[%&#_{}$]" "\\\\\\&") - (cons "\\^" "{\\\\textasciicircum}") - (cons "~" "{\\\\textasciitilde}") - (cons "[*]" "{\\&}") - (cons "[><|]" "$\\&$") - (cons "-BaCkSlAsH-" "$\\\\backslash$")))) - (if w3-latex-verbatim - (setq todo (append todo '(("\n" . "\\\\newline\\\\nullspace\n") - (" " . "\\\\ "))))) - (save-excursion - (set-buffer (get-buffer-create " *w3-latex-munging*")) - (erase-buffer) - (insert str) - (while todo - (goto-char (point-min)) - (while (re-search-forward (caar todo) nil t) - (replace-match (cdar todo))) - (setq todo (cdr todo))) - (setq str (w3-latex-replace-entities (buffer-string)))) - (insert str))) - -(defun w3-latex-ignore (tree) - ;;; ignores any contents of this tree. - nil) - -(defun w3-latex-contents (tree) - ;;; passes contents of subtree through to the latex-subtree - (let ((contents (car (cdr (cdr tree))))) - (while contents - (w3-latex-subtree (car contents)) - (setq contents (cdr contents))))) - -(defun w3-latex-html (tree) - (insert "% This document automatically generated by Emacs-W3 v" - w3-version-number "\n") - (if w3-latex-current-url - (insert "% from <URL:" w3-latex-current-url ">\n")) - (insert "%\n" - "\\batchmode\n\\begin{document}\n") - (insert "\\setlength{\\parindent}{0pt}\n" - "\\setlength{\\parskip}{1.5ex}\n") - (insert "\\newcommand{\\nullspace}{\\rule{0pt}{0pt}}") - (w3-latex-contents tree) - (if w3-latex-links-list (w3-latex-endnotes)) - (insert "\\end{document}\n")) - -(defun w3-latex-title (tree) - (if w3-latex-use-maketitle - (insert "\\title{") - (insert "\\section*{\\centering ")) - (w3-latex-contents tree) - (insert "}\n") - (if w3-latex-use-maketitle - (insert "\\author{}\\date{}\n\\maketitle"))) - -(defun w3-latex-heading (tree) - ;; look through the additional markup to see if an align=right or - ;; align=center is in here... - (let ((align (assq 'align (car (cdr tree)))) - (sym (car tree))) - (insert "\n\n") - (cond ((and align (string-equal (cdr align) "center")) - (insert "\\begin{center}\n")) - ((and align (string-equal (cdr align) "right")) - (insert "\\begin{flushright}\n"))) - (cond ((eq sym 'h1) (insert "\\section*{")) - ((eq sym 'h2) (insert "\\subsection*{")) - ((eq sym 'h3) (insert "\\subsubsection*{")) - ((eq sym 'h4) (insert "\\subsubsection*{")) - ((eq sym 'h5) (insert "\\paragraph*{")) - ((eq sym 'h6) (insert "\\subparagraph*{"))) - (w3-latex-contents tree) - (insert "}\n") - (cond ((and align (string-equal (cdr align) "center")) - (insert "\\end{center}\n")) - ((and align (string-equal (cdr align) "right")) - (insert "\\end{flushright}\n"))))) - -(defun w3-latex-bold (tree) - (insert "{\\bf ") - (w3-latex-contents tree) - (insert "}")) -(defun w3-latex-italic (tree) - (insert "{\\em ") - (w3-latex-contents tree) - (insert "}")) -(defun w3-latex-typewriter (tree) - (insert "{\\tt ") - (w3-latex-contents tree) - (insert "}")) - -(defun w3-latex-list (tree) - (let* ((sym (car tree)) - (list-type (cond ((eq sym 'ol) "enumerate") - ((eq sym 'dl) "description") - (t "itemize")))) - (insert (concat "\n\\begin{" list-type "}\n")) - (w3-latex-contents tree) - (insert (concat "\n\\end{" list-type "}\n")))) - -(defun w3-latex-list-item (tree) - (let ((sym (car tree))) - (cond ((eq sym 'dt) - (insert "\n\\item[")) - ((eq sym 'dd) - ;; don't do anything for dd -- the item is handled by dt. - nil) - (t (insert "\n\\item"))) - (w3-latex-contents tree) - (if (eq sym 'dt) - (insert "]")))) - -(defun w3-latex-center (tree) - (insert "\\begin{center}") - (w3-latex-contents tree) - (insert "\\end{center}")) - -(defun w3-latex-rule (tree) - ; use \par to make paragraph division clear. - (insert "\n\\par\\noindent\\rule{\\textwidth}{.01in}\n")) - -(defun w3-latex-para (tree) - ;; look through the additional markup to see if an align=right or - ;; align=center is in here... - (let ((align (assq 'align (car (cdr tree))))) - (cond ((and align - (string-equal (cdr align) "center")) - (w3-latex-center tree)) - ((and align - (string-equal (cdr align) "right")) - (insert "\\begin{flushright}") - (w3-latex-contents tree) - (insert "\\end{flushright}")) - (t (insert "\\par ") - (w3-latex-contents tree))))) - -(defun w3-latex-quote (tree) - (insert "\\begin{quote}\n") - (w3-latex-contents tree) - (insert "\\end{quote}\n")) - -(defun w3-latex-break (tree) - ;; no content allowed - (insert "\\newline ")) - -(defun w3-latex-endnotes () - (let ((i 1)) - (insert "\\begin{thebibliography}{99}\n") - (while w3-latex-links-list - (insert (concat "\\bibitem{ref" (number-to-string i) "}")) - (w3-latex-insert-string (car w3-latex-links-list)) - (insert "\n") - (setq w3-latex-links-list (cdr w3-latex-links-list)) - (setq i (1+ i))) - (insert "\\end{thebibliography}\n"))) - -(defun w3-latex-href (tree) - (let ((href (cdr-safe (assq 'href (cadr tree)))) - (name (cdr-safe (assq 'name (cadr tree))))) - (cond - ((not w3-latex-print-links) ; No special treatment - (w3-latex-contents tree)) - (name - (w3-latex-contents tree) - (insert (concat "\\label{" name "}"))) - (href ; Special treatment requested -; (insert "\\underline{") ; and we have a URL - underline - (w3-latex-contents tree) ; it. -; (insert "}") - (cond - ((char-equal ?# (aref href 0)) - (insert (concat " (see page~\\pageref{" - (substring href 1) - "})"))) - ((eq w3-latex-print-links 'footnote) - (insert "\\footnote{") ; Request to prepare footnote - (w3-latex-insert-string href) - (insert "}")) - (t ; Otherwise, prepare endnotes - (let ((mem (member href w3-latex-links-list)) - (i (1+ (length w3-latex-links-list)))) - (if mem - (setq i (- i (length mem))) - (setq w3-latex-links-list - (append w3-latex-links-list (cons href nil)))) - (insert (concat "~\\cite{ref" (number-to-string i) "}")))))) - (t ; Special treatment requested, but - (w3-latex-contents tree))))) ; no URL - do nothing. - -(defun w3-latex-preformatted (tree) - (let ((w3-latex-verbatim t)) - (insert "\\par\\noindent\\begin{tt}") - (w3-latex-contents tree) - (insert "\\end{tt}\\par") - )) - -(defun w3-latex-xmp (tree) - (insert "\\begin{verbatim}") - (w3-latex-contents tree) - (insert "\\end{verbatim}")) - -(let ((todo '((title . w3-latex-title) - (html . w3-latex-html) - (pre . w3-latex-preformatted) - (xmp . w3-latex-xmp) - (h1 . w3-latex-heading) - (h2 . w3-latex-heading) - (h3 . w3-latex-heading) - (h4 . w3-latex-heading) - (h5 . w3-latex-heading) - (h6 . w3-latex-heading) - (a . w3-latex-href) - (strong . w3-latex-bold) - (b . w3-latex-bold) - (dfn . w3-latex-bold) - (em . w3-latex-italic) - (i . w3-latex-italic) - (address . w3-latex-italic) - (code . w3-latex-typewriter) - (samp . w3-latex-typewriter) - (tt . w3-latex-typewriter) - (kbd . w3-latex-typewriter) - (var . w3-latex-typewriter) - (ol . w3-latex-list) - (dl . w3-latex-list) - (ul . w3-latex-list) - (menu . w3-latex-list) - (dir . w3-latex-list) - (li . w3-latex-list-item) - (dt . w3-latex-list-item) - (dd . w3-latex-list-item) - (center . w3-latex-center) - (hr . w3-latex-rule) - (p . w3-latex-para) - (br . w3-latex-break) - (blockquote . w3-latex-quote)))) - (while todo - (put (caar todo) 'w3-latex-formatter (cdar todo)) - (setq todo (cdr todo)))) - -(defun w3-latex-subtree (tree) - (cond - ((stringp tree) - (w3-latex-insert-string tree)) - ((stringp (car-safe tree)) - (while tree - (w3-latex-insert-string (car tree)) - (setq tree (cdr tree)))) - ((symbolp (car tree)) - (let ((proc (get (car tree) 'w3-latex-formatter))) - (if (and proc (fboundp proc)) - (funcall proc tree) - ;; anything else gets passed through unchanged - (w3-latex-contents tree)))) - (t - (w3-latex-contents tree)))) - -(defun w3-parse-tree-to-latex (tree &optional url) - ; assumes that url-working-buffer exists. - (set-buffer (get-buffer-create url-working-buffer)) - (setq w3-latex-current-url url) - (erase-buffer) - (goto-char (point-min)) - (if w3-latex-use-latex2e - (insert (concat "\\documentclass" w3-latex-docstyle "\n")) - (insert (concat "\\documentstyle" w3-latex-docstyle "\n"))) - (if (and w3-latex-use-latex2e - w3-latex-packages) - (insert (apply 'concat - (mapcar (lambda (x) (concat "\\usepackage{" x "}\n")) - w3-latex-packages)))) - (while tree - (w3-latex-subtree (car tree)) - (setq tree (cdr tree)))) - -(defun w3-show-dvi () - "Uses xdvi to show DVI file created from `w3-parse-tree-to-latex'." - (interactive) - (w3-parse-tree-to-latex w3-current-parse) - (save-window-excursion - (set-buffer url-working-buffer) - (write-region (point-min) (point-max) - (expand-file-name "w3-tmp.latex" - w3-temporary-directory) nil 5) - (shell-command - (format - "(cd %s ; latex w3-tmp.latex ; latex w3-tmp.latex ; xdvi w3-tmp.dvi ; rm -f w3-tmp*) &" - w3-temporary-directory)))) - -(provide 'w3-latex) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-menu.el --- a/lisp/w3/w3-menu.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,761 +0,0 @@ -;;; w3-menu.el --- Menu functions for emacs-w3 -;; Author: wmperry -;; Created: 1997/08/20 13:57:38 -;; Version: 1.42 -;; Keywords: menu, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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 'w3-vars) -(require 'w3-mouse) -(require 'widget) - -(define-widget-keywords :href :src :title) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; InfoDock stuff -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(if (fboundp 'id-menubar-set) - (id-menubar-set 'w3-mode 'w3-menu-make-xemacs-menubar)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Spiffy new menus (for both Emacs and XEmacs) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-menu-fsfemacs-bookmark-menu nil) -(defvar w3-menu-fsfemacs-debug-menu nil) -(defvar w3-menu-fsfemacs-edit-menu nil) -(defvar w3-menu-fsfemacs-file-menu nil) -(defvar w3-menu-fsfemacs-go-menu nil) -(defvar w3-menu-fsfemacs-help-menu nil) -(defvar w3-menu-fsfemacs-view-menu nil) -(defvar w3-menu-fsfemacs-options-menu nil) -(defvar w3-menu-fsfemacs-style-menu nil) -(defvar w3-menu-fsfemacs-search-menu nil) -(defvar w3-menu-w3-menubar nil) -(defvar w3-links-menu nil "Menu for w3-mode in XEmacs.") -(make-variable-buffer-local 'w3-links-menu) - -(defcustom w3-use-menus '(file edit view go bookmark options buffers style - emacs nil help) - "*Non-nil value causes W3 to provide a menu interface. -A value that is a list causes W3 to install its own menubar. -A value of 1 causes W3 to install a \"W3\" item in the Emacs menubar. - -If the value of w3-use-menus is a list, it should be a list of symbols. -The symbols and the order that they are listed determine what menus -will be in the menubar and how they are ordered. Valid symbol values -are: - -file -- A list of file related commands -edit -- Various standard editing commands (copy/paste) -view -- Controlling various things about the document view -go -- Navigation control -bookmark -- Bookmark / hotlist control -options -- Various options -buffers -- The standard buffers menu -emacs -- A toggle button to switch back to normal emacs menus -style -- Control style information and who gets to set what -search -- Various search engines -help -- The help menu -nil -- ** special ** - -If nil appears in the list, it should appear exactly once. All -menus after nil in the list will be displayed flushright in the -menubar. - -NOTE! The current port of Emacs to Windows NT/95 does not support -buttons in the menubar, so the 'emacs' keyword is currently ignored -on that platform." - :group 'w3-menus - :type '(set (const :tag "File related commands" :value file) - (const :tag "Standard editing commands" :value edit) - (const :tag "View document information" :value view) - (const :tag "Navigation" :value go) - (const :tag "Bookmarks" :value bookmark) - (const :tag "Options" :value options) - (const :tag "Buffer list" :value buffers) - (const :tag "Stylesheet information" :value style) - (const :tag "Search engines" :value search) - (const :tag "Toggle to default menus" :value emacs) - (const :tag "Separator" :value nil) - (const :tag "Help" :value help))) - -(defun w3-menu-hotlist-constructor (menu-items) - (or (cdr w3-html-bookmarks) - (let ((hot-menu nil) - (hot w3-hotlist)) - (while hot - (setq hot-menu (cons (vector - (w3-truncate-menu-item (car (car hot))) - (list 'w3-fetch (car (cdr (car hot)))) - t) hot-menu) - hot (cdr hot))) - (or hot-menu '(["No Hotlist" nil nil]))))) - -(defun w3-menu-html-links-constructor (menu-items) - (or menu-items - (let ((links (mapcar 'cdr w3-current-links)) - (menu nil)) - (if links - (setq links (delete* - nil - (reduce 'append links) - :test-not (function - (lambda (a b) ; arg order unknown - (member - (car (or a b)) - w3-defined-link-types)))))) - (while links - (let ((name (caar links)) - (vals (cdar links)) - (href nil) - (new nil)) - (if (= (length vals) 1) - (setq vals (car vals) - new (vector (or (plist-get vals 'title) - (capitalize name)) - (list 'w3-fetch (plist-get vals 'href)) t)) - (setq new (cons (capitalize name) - (mapcar (function - (lambda (x) - (setq href (plist-get x 'href)) - (vector (or (plist-get x 'title) href) - (list 'w3-fetch href) t))) - vals)))) - (setq links (cdr links) - menu (cons new menu)))) - (or menu '(["None" nil nil]))))) - -(defun w3-menu-links-constructor (menu-items) - (or menu-items - (let ((widgets (w3-only-links)) - widget href menu) - (while widgets - (setq widget (car widgets) - widgets (cdr widgets) - href (widget-get widget :href) - menu (cons - (vector (w3-truncate-menu-item - (or (widget-get widget :title) - (w3-fix-spaces - (buffer-substring - (widget-get widget :from) - (widget-get widget :to))))) - (list 'url-maybe-relative href) t) menu))) - (setq menu (w3-breakup-menu menu w3-max-menu-length)) - (or menu '(["No Links" nil nil]))))) - -(defun w3-toggle-minibuffer () - (interactive) - (cond - (w3-running-xemacs - (if (equal (frame-property (selected-frame) 'minibuffer) t) - - ;; frame has a minibuffer, so remove it - ;; unfortunately, we must delete and redraw the frame - (let ((fp (frame-properties (selected-frame))) - (frame (selected-frame)) - (buf (current-buffer))) - (select-frame - (make-frame (plist-put - (plist-remprop - (plist-remprop fp 'window-id) 'minibuffer) - 'minibuffer nil))) - (delete-frame frame) - (switch-to-buffer buf)) - ;; no minibuffer so add one - (set-frame-property (selected-frame) 'minibuffer t))) - (t nil))) - -(defun w3-toggle-location () - (interactive) - (cond - (w3-running-xemacs - (let ((on (specifier-instance has-modeline-p (selected-window)))) - (set-specifier has-modeline-p (not on) (selected-window)))) - (t nil))) - -(defun w3-toggle-menubar () - (interactive) - (cond - ;; XEmacs style - (w3-running-xemacs - (set-specifier menubar-visible-p (cons (current-buffer) - (not (specifier-instance - menubar-visible-p))))) - ;; Emacs 19 style - (t - (menu-bar-mode (if (w3-menubar-active) -1 1))))) - -(defun w3-location-active () - (if w3-running-xemacs - (specifier-instance has-modeline-p (selected-window)) - t)) - -(defun w3-menubar-active () - (if w3-running-xemacs - (and (featurep 'menubar) (specifier-instance menubar-visible-p)) - (and (boundp 'menu-bar-mode) menu-bar-mode))) - -(defun w3-menu-global-menubar () - (if w3-running-xemacs - (default-value 'default-menubar) - (lookup-key (current-global-map) [menu-bar]))) - -(defconst w3-menu-file-menu - (list - "File" - ["Open Location..." w3-fetch t] - ["Open File..." w3-open-local t] - ["Open in New Window..." w3-fetch-other-frame t] - ["New Window" make-frame t] - "---" - ["Save" save-buffer t nil] - (list - "Save As..." - ["HTML" (w3-save-as "HTML Source") t] - ["Formatted Text" (w3-save-as "Formatted Text") t] - ["LaTeX" (w3-save-as "LaTeX Source") t] - ["PostScript" (w3-save-as "PostScript") t] - ["Binary" (w3-save-as "Binary") t] - ) - "---" - (list - "Print As..." - ["PostScript" (w3-print-this-url nil "PostScript") t] - ["Formatted Text" (w3-print-this-url nil "Formatted Text") t] - ["HTML Source" (w3-print-this-url nil "HTML Source") t] - ["LaTeX'd" (w3-print-this-url nil "LaTeX'd") t] - ) - (list - "Mail Document..." - ["HTML" (w3-mail-current-document nil "HTML Source") t] - ["Formatted Text" (w3-mail-current-document nil "Formatted Text") t] - ["PostScript" (w3-mail-current-document nil "PostScript") t] - ["LaTeX Source" (w3-mail-current-document nil "LaTeX Source") t] - ) - (if w3-running-xemacs - "---:shadowDoubleEtchedIn" - "---") - ["Close" delete-frame (not (eq (next-frame) (selected-frame)))] - ["Exit" save-buffers-kill-emacs t] - ) - "W3 file menu list.") - -(defconst w3-menu-edit-menu - (list - "Edit" - ["Undo" advertised-undo nil] - ["Cut" kill-region nil] - ["Copy" copy-region-as-kill t] - "----" - ["Search..." w3-search-forward t] - ["Search Again..." w3-search-again w3-last-search-item] - "----" - (list - "Preferences" - (if (fboundp 'custom-menu-create) - (custom-menu-create 'w3) - ["W3" ignore nil]) - (if (fboundp 'custom-menu-create) - (custom-menu-create 'url) - ["URL" ignore nil]) - ) - ) - "W3 edit menu list.") - -(defconst w3-menu-view-menu - (list - "View" - ["Document Information" w3-document-information t] - ["Document Source" w3-source-document t] - ["Document Errors" w3-display-errors w3-current-badhtml] - ["Load Images" w3-load-delayed-images w3-delayed-images] - "----" - ["Refresh" w3-refresh-buffer w3-current-parse] - ["Reload" w3-reload-document (and (url-view-url t) - (not (equal (url-view-url t) "")))] - "----" - ["Show URL" url-view-url t] - ["Show URL At Point" w3-view-this-url t] - "----" - ) - "W3 menu view list.") - -(defconst w3-menu-debug-menu - (list - "Debugging" - ["View Parse Tree" (w3-display-parse-tree w3-current-parse) - w3-current-parse] - ["View Stylesheet" w3-display-stylesheet w3-current-stylesheet] - ["Reload Stylesheets" w3-refresh-stylesheets t] - ) - "W3 menu debug list.") - -(defconst w3-menu-go-menu - (list - "Go" - ["Forward" w3-history-forward (cdr (w3-history-find-url-internal (url-view-url t)))] - ["Back" w3-history-backward (car (w3-history-find-url-internal (url-view-url t)))] - ["Home" w3 w3-default-homepage] - ["View History..." w3-show-history-list url-keep-history] - "----" - (if w3-running-xemacs - '("Links" :filter w3-menu-links-constructor) - ["Links..." w3-e19-show-links-menu t]) - (if w3-running-xemacs - '("Navigate" :filter w3-menu-html-links-constructor) - ["Navigate..." w3-e19-show-navigate-menu t]) - ) - "W3 menu go list.") - -(defconst w3-menu-bookmark-menu - (list - "Bookmark" - ["View Bookmarks..." w3-show-hotlist w3-hotlist] - ["Add Bookmark" w3-hotlist-add-document t] - ["Delete Bookmark" w3-hotlist-delete t] - ["Rename Bookmark" w3-hotlist-rename-entry t] - ["Append Bookmark List" w3-hotlist-append t] - "----" - (if w3-running-xemacs - '("Bookmarks" :filter w3-menu-hotlist-constructor) - ["Bookmarks" w3-e19-show-hotlist-menu t]) - ) - "W3 menu bookmark list.") - -(defconst w3-menu-options-menu - (list "Options" - ["Edit Preferences" w3-preferences-edit t] - "---" - ["Show Menubar" w3-toggle-menubar - :style toggle :selected (w3-menubar-active)] - (if (and w3-running-xemacs (featurep 'toolbar)) - ["Show Toolbar" w3-toggle-toolbar - :style toggle :selected (w3-toolbar-active)] - ["Show Toolbar" w3-toggle-toolbar nil]) - (if w3-running-xemacs - ["Show Location" w3-toggle-location - :style toggle :selected (w3-location-active)] - ["Show Location" w3-toggle-location nil]) - (if w3-running-xemacs - ["Show Status Bar" w3-toggle-minibuffer - :style toggle - :selected (eq (frame-property (selected-frame) 'minibuffer) t) - ]) - ["Incremental Display" - (setq w3-do-incremental-display (not w3-do-incremental-display)) - :style toggle :selected w3-do-incremental-display] - "----" - ["Auto Load Images" - (setq w3-delay-image-loads (not w3-delay-image-loads)) - :style toggle :selected (not w3-delay-image-loads)] - ["Flush Image Cache" (setq w3-graphics-list nil) w3-graphics-list] - "----" - ["Download to disk" (setq w3-dump-to-disk (not w3-dump-to-disk)) - :style toggle :selected w3-dump-to-disk] - ["Caching" (setq url-automatic-caching (not url-automatic-caching)) - :style toggle :selected url-automatic-caching] - ["Use Cache Only" - (setq url-standalone-mode (not url-standalone-mode)) - :style toggle :selected url-standalone-mode] - "----" - ["Save Options" w3-menu-save-options t] - ) - "W3 menu options list.") - -(defconst w3-menu-style-menu - (list - "Style" - ["Allow Document Stylesheets" (setq w3-honor-stylesheets - (not w3-honor-stylesheets)) - :style toggle :selected w3-honor-stylesheets] - ["Honor Color Requests" (setq w3-user-colors-take-precedence - (not w3-user-colors-take-precedence)) - :style toggle :selected (not w3-user-colors-take-precedence)] - "---" - ["Reload Stylesheets" w3-refresh-stylesheets t] - ) - "W3 menu style list.") - -(defconst w3-menu-buffer-menu - (if w3-running-xemacs - '("Buffers" - :filter buffers-menu-filter - ["List All Buffers" list-buffers t] - "--!here") - nil) - "W3 menu buffer list.") - -(defconst w3-menu-search-menu - (list - "Search" - ["Yahoo!" (w3-fetch "http://www.yahoo.com/") t] - ["Excite" (w3-fetch "http://www.excite.com/") t] - ["AltaVista" (w3-fetch "http://www.altavista.digital.com/") t] - "---" - ) - "W3 search menu") - -(defconst w3-menu-emacs-button - (vector - (if w3-running-xemacs "XEmacs" "Emacs") 'w3-menu-toggle-menubar t)) - -(defconst w3-menu-help-menu - (list - "Help" - ["About Emacs-w3" (w3-fetch "about:") t] - ["Manual" (w3-fetch (concat w3-documentation-root "docs/w3_toc.html")) t] - "---" - ["Version Information..." - (w3-fetch - (concat w3-documentation-root "help/version_" w3-version-number ".html")) - t] - ["On FAQ" (w3-fetch (concat w3-documentation-root "help/FAQ.html")) t] - "---" - ["Mail Developer(s)" w3-submit-bug t] - ) - "W3 menu help list.") - -(defvar w3-mode-menu-map nil) - -(defun w3-menu-initialize-w3-mode-menu-map () - (if (null w3-mode-menu-map) - (let ((map (make-sparse-keymap)) - (dummy (make-sparse-keymap))) - (require 'easymenu) - ;; initialize all the w3-menu-fsfemacs-*-menu variables - ;; with the menus. - (easy-menu-define w3-menu-fsfemacs-bookmark-menu (list dummy) nil - w3-menu-bookmark-menu) - (easy-menu-define w3-menu-fsfemacs-debug-menu (list dummy) nil - w3-menu-debug-menu) - (easy-menu-define w3-menu-fsfemacs-edit-menu (list dummy) nil - w3-menu-edit-menu) - (easy-menu-define w3-menu-fsfemacs-file-menu (list dummy) nil - w3-menu-file-menu) - (easy-menu-define w3-menu-fsfemacs-go-menu (list dummy) nil - w3-menu-go-menu) - (easy-menu-define w3-menu-fsfemacs-help-menu (list dummy) nil - w3-menu-help-menu) - (easy-menu-define w3-menu-fsfemacs-view-menu (list dummy) nil - w3-menu-view-menu) - (easy-menu-define w3-menu-fsfemacs-options-menu (list dummy) nil - w3-menu-options-menu) - (easy-menu-define w3-menu-fsfemacs-style-menu (list dummy) nil - w3-menu-style-menu) - (easy-menu-define w3-menu-fsfemacs-search-menu (list dummy) nil - w3-menu-search-menu) - - ;; block the global menubar entries in the map so that W3 - ;; can take over the menubar if necessary. - (define-key map [rootmenu] (make-sparse-keymap)) - (define-key map [rootmenu w3] (cons "W3" (make-sparse-keymap "W3"))) - (define-key map [rootmenu w3 file] 'undefined) - (define-key map [rootmenu w3 files] 'undefined) - (define-key map [rootmenu w3 search] 'undefined) - (define-key map [rootmenu w3 edit] 'undefined) - (define-key map [rootmenu w3 options] 'undefined) - (define-key map [rootmenu w3 buffer] 'undefined) - (define-key map [rootmenu w3 tools] 'undefined) - (define-key map [rootmenu w3 help] 'undefined) - (define-key map [rootmenu w3 help-menu] 'undefined) - ;; now build W3's menu tree. - (let ((menu-alist - '( - (bookmark - (cons "Bookmark" w3-menu-fsfemacs-bookmark-menu)) - (debug - (cons "Debug" w3-menu-fsfemacs-debug-menu)) - (edit - (cons "Edit" w3-menu-fsfemacs-edit-menu)) - (file - (cons "File" w3-menu-fsfemacs-file-menu)) - (go - (cons "Go" w3-menu-fsfemacs-go-menu)) - (help - (cons "Help" w3-menu-fsfemacs-help-menu)) - (options - (cons "Options" w3-menu-fsfemacs-options-menu)) - (view - (cons "View" w3-menu-fsfemacs-view-menu)) - (style - (cons "Style" w3-menu-fsfemacs-style-menu)) - (search - (cons "Search" w3-menu-fsfemacs-search-menu)) - (emacs - ;; FIXME!!! Currently, win32 doesn't support buttons - ;; in menubars, so we hack around it and ignore the - ;; 'emacs keyword on that platform. REMOVE THIS CODE - ;; as soon as that is fixed. 19.35 timeframe? - (if (eq (device-type) 'win32) - nil - (cons "[Emacs]" 'w3-menu-toggle-menubar))))) - cons - (vec (vector 'rootmenu 'w3 nil)) - ;; menus appear in the opposite order that we - ;; define-key them. - (menu-list - (if (consp w3-use-menus) - (reverse w3-use-menus) - (list 'help nil 'emacs 'buffers 'options 'bookmark - 'go 'view 'edit 'file)))) - (while menu-list - (if (null (car menu-list)) - nil;; no flushright support in FSF Emacs - (aset vec 2 (intern (concat "w3-menu-fsfemacs-" - (symbol-name - (car menu-list)) "-menu"))) - (setq cons (assq (car menu-list) menu-alist)) - (if cons - (define-key map vec (eval (car (cdr cons)))))) - (setq menu-list (cdr menu-list)))) - (setq w3-mode-menu-map map) - (run-hooks 'w3-menu-setup-hook)))) - -(defun w3-menu-make-xemacs-menubar () - (let ((menu-alist - '((bookmark . w3-menu-bookmark-menu) - (style . w3-menu-style-menu) - (buffer . w3-menu-buffer-menu) - (debug . w3-menu-debug-menu) - (edit . w3-menu-edit-menu) - (emacs . w3-menu-emacs-button) - (file . w3-menu-file-menu) - (go . w3-menu-go-menu) - (help . w3-menu-help-menu) - (options . w3-menu-options-menu) - (search . w3-menu-search-menu) - (view . w3-menu-view-menu) - ) - ) - cons - (menubar nil) - (menu-list w3-use-menus)) - (while menu-list - (if (null (car menu-list)) - (setq menubar (cons nil menubar)) - (setq cons (assq (car menu-list) menu-alist)) - (if cons - (setq menubar (cons (symbol-value (cdr cons)) menubar)))) - (setq menu-list (cdr menu-list))) - (nreverse menubar))) - -(defun w3-menu-install-menubar () - (cond - (w3-running-xemacs - (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)))) - ((not (fboundp 'vm-menu-undo-menu)) - (w3-menu-initialize-w3-mode-menu-map) - (define-key w3-mode-map [menu-bar] - (lookup-key w3-mode-menu-map [rootmenu w3]))))) - -(defun w3-menu-install-menubar-item () - (cond - (w3-running-xemacs - (if (not (featurep 'menubar)) - nil ; No menus available - (set-buffer-menubar (copy-sequence (w3-menu-global-menubar))) - (add-menu nil "W3" (cdr w3-menu-w3-menubar)))) - ((not (fboundp 'w3-menu-fsfemacs-edit-menu)) - (w3-menu-initialize-w3-mode-menu-map) - (define-key w3-mode-map [menu-bar] - (lookup-key w3-mode-menu-map [rootmenu]))))) - -(defun w3-menu-install-menus () - (cond ((= emacs-minor-version 28) ; Hey, get with the times people!! - nil) - ((consp w3-use-menus) - (w3-menu-install-menubar)) - ((eq w3-use-menus 1) - (w3-menu-install-menubar-item)) - (t nil))) - -(defun w3-menu-set-menubar-dirty-flag () - (cond (w3-running-xemacs - (set-menubar-dirty-flag)) - (t - (force-mode-line-update)))) - -(defun w3-menu-toggle-menubar () - (interactive) - (cond - ;;((eq w3-use-menus 1) - ;;nil) - (w3-running-xemacs - (if (null (car (find-menu-item current-menubar '("XEmacs")))) - (set-buffer-menubar w3-menu-w3-menubar) - (set-buffer-menubar (copy-sequence (w3-menu-global-menubar))) - (condition-case () - (add-menu-button nil ["W3" w3-menu-toggle-menubar t] nil) - (void-function - (add-menu-item nil "W3" 'w3-menu-toggle-menubar t)))) - (w3-menu-set-menubar-dirty-flag)) - (t - (if (not (eq (lookup-key w3-mode-map [menu-bar]) - (lookup-key w3-mode-menu-map [rootmenu w3]))) - (define-key w3-mode-map [menu-bar] - (lookup-key w3-mode-menu-map [rootmenu w3])) - (define-key w3-mode-map [menu-bar] - (make-sparse-keymap)) - (define-key w3-mode-map [menu-bar w3] - (cons "[W3]" 'w3-menu-toggle-menubar))) - (w3-menu-set-menubar-dirty-flag)))) - -(defun w3-menu-save-options () - (interactive) - (let ((output-buffer (find-file-noselect w3-default-configuration-file)) - output-marker) - (save-excursion - (set-buffer output-buffer) - ;; - ;; Find and delete the previously saved data, and position to write. - ;; - (goto-char (point-min)) - (if (re-search-forward "^;; W3 Options Settings *\n" nil 'move) - (let ((p (match-beginning 0))) - (goto-char p) - (or (re-search-forward - "^;; End of W3 Options Settings *\\(\n\\|\\'\\)" - nil t) - (error "can't find END of saved state in .emacs")) - (delete-region p (match-end 0))) - (goto-char (point-max)) - (insert "\n")) - (setq output-marker (point-marker)) - (let ((print-readably t) - (print-escape-newlines t) - (standard-output output-marker)) - (princ ";; W3 Options Settings\n") - (princ ";; ===================\n") - (mapcar (function - (lambda (var) - (princ " ") - (if (and (symbolp var) (boundp var)) - (prin1 (list 'setq-default var - (let ((val (symbol-value var))) - (if (or (memq val '(t nil)) - (and (not (symbolp val)) - (not (listp val)))) - val - (list 'quote val)))))) - (if var (princ "\n")))) - '( - ps-print-color-p - url-automatic-caching - url-be-asynchronous - url-honor-refresh-requests - url-privacy-level - url-cookie-confirmation - url-proxy-services - url-standalone-mode - url-use-hypertext-gopher - w3-default-homepage - w3-default-stylesheet - w3-delay-image-loads - w3-do-incremental-display - w3-dump-to-disk - w3-honor-stylesheets - w3-image-mappings - w3-load-hook - w3-mode-hook - w3-netscape-compatible-comments - w3-preferences-cancel-hook - w3-preferences-default-hook - w3-preferences-ok-hook - w3-preferences-setup-hook - w3-source-file-hook - w3-toolbar-orientation - w3-toolbar-type - w3-use-menus - w3-user-colors-take-precedence - ) - ) - (princ ";; ==========================\n") - (princ ";; End of W3 Options Settings\n"))) - (set-marker output-marker nil) - (save-excursion - (set-buffer output-buffer) - (save-buffer)) - )) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Context-sensitive popup menu -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(if (not (fboundp 'event-glyph)) - (fset 'event-glyph 'ignore)) - -(defun w3-popup-menu (e) - "Pop up a menu of common w3 commands" - (interactive "e") - (if (not w3-popup-menu-on-mouse-3) - (call-interactively (lookup-key global-map (vector w3-mouse-button3))) - (mouse-set-point e) - (let* ((glyph (event-glyph e)) - (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)))) - (menu (copy-tree w3-popup-menu)) - url val trunc-url) - (if href - (progn - (setq url href) - (if url (setq trunc-url (url-truncate-url-for-viewing - url - w3-max-menu-width))) - (setcdr menu (append (cdr menu) - '("---") - (mapcar - (function - (lambda (x) - (vector (format (car x) trunc-url) - (list (cdr x) url) t))) - w3-hyperlink-menu))))) - (if imag - (progn - (setq url imag - trunc-url (url-truncate-url-for-viewing url - w3-max-menu-width)) - (setcdr menu (append (cdr menu) - '("---") - (mapcar - (function - (lambda (x) - (vector (format (car x) trunc-url) - (list (cdr x) url) t))) - w3-graphlink-menu))))) - (if (not (w3-menubar-active)) - (setcdr menu (append (cdr menu) - '("---" ["Show Menubar" w3-toggle-menubar t])))) - (popup-menu menu)))) - -(provide 'w3-menu) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-mouse.el --- a/lisp/w3/w3-mouse.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,92 +0,0 @@ -;;; w3-menu.el --- Mouse specific functions for emacs-w3 -;; Author: wmperry -;; Created: 1997/06/27 15:41:35 -;; Version: 1.13 -;; Keywords: mouse, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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 'w3-vars) - -(defun w3-follow-mouse-other-frame (e) - "Function suitable to being bound to a mouse key. Follows the link under -the mouse click, opening it in another frame." - (interactive "e") - (mouse-set-point e) - (w3-follow-link-other-frame)) - -(defun w3-follow-inlined-image-mouse (e) - "Follow an inlined image from the mouse" - (interactive "e") - (mouse-set-point e) - (w3-follow-inlined-image)) - -(defun w3-follow-inlined-image () - "Follow an inlined image, regardless of whether it is a hyperlink or not." - (interactive) - (let ((widget (widget-at (point)))) - (and (not widget) (error "No inlined image at point.")) - (setq widget (widget-get widget :parent)) - - (and (or (not widget) - (not (eq 'image (car widget)))) - (error "No inlined image at point.")) - (and (widget-get widget 'src) - (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 'down-mouse-1))) -(defvar w3-mouse-button2 (cond - ((featurep 'infodock) nil) - ((and w3-running-xemacs (featurep 'mouse)) 'button2) - (w3-running-xemacs nil) - (t 'down-mouse-2))) -(defvar w3-mouse-button3 (cond - ((featurep 'infodock) nil) - ((and w3-running-xemacs (featurep 'mouse)) 'button3) - (w3-running-xemacs nil) - (t 'down-mouse-3))) - -(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 - (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 (not w3-running-xemacs) - (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) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-parse.el --- a/lisp/w3/w3-parse.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2773 +0,0 @@ -;; Created by: Joe Wells, jbw@cs.bu.edu -;; Created on: Sat Sep 30 17:25:40 1995 -;; Filename: w3-parse.el -;; Purpose: Parse HTML and/or SGML for Emacs W3 browser. - -;; Copyright © 1995, 1996, 1997 Joseph Brian Wells -;; Copyright © 1993, 1994, 1995 by William M. Perry (wmperry@cs.indiana.edu) -;; -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2 of the License, or -;; (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. -;; -;; On November 13, 1995, the license was available at -;; <URL:ftp://prep.ai.mit.edu/pub/gnu/COPYING-2.0>. It may still be -;; obtainable via that URL. - - -;;; -;;; Trying to make the best of an evil speed hack. -;;; - -;; Explanation: - -;; Basically, this file provides one big function (w3-parse-buffer) and -;; some data structures. However, to avoid code redundancy, I have broken -;; out some common subexpressions of w3-parse-buffer into separate -;; functions. I have declared these separate functions with "defsubst" so -;; they will be inlined into w3-parse-buffer. Also, I have defined them -;; within eval-when-compile forms, so no definitions will be emitted into -;; the .elc file for these separate functions. (They will work normally -;; when the uncompiled file is loaded.) - -;; Each of these subfunctions use some scratch variables in a purely local -;; fashion. In good software design, I would declare these variables as -;; close to their use as possible with "let". However, "let"-binding -;; variables is *SLOW* in Emacs Lisp, even when compiled. Since each of -;; these functions is executed one or more time during each iteration of -;; the main loop, I deemed this too expensive. So the main function does -;; the "let"-binding of these variables. However, I still want to declare -;; them close to their use, partially to keep the compiler from crying -;; "Wolf!" when there is no danger (well, maybe a little danger :-), so I -;; define some macros for this purpose. - -;; Also, there are some variables which are updated throughout the file -;; (remember this is really all one function). Some of the code which -;; updates them is located inside the subfunctions. So that the compiler -;; will not complain, these variables are defined with defvar. - -(require 'w3-vars) -(require 'mule-sysdp) - -(eval-when-compile - (defconst w3-p-s-var-list nil - "A list of the scratch variables used by functions called by -w3-parse-buffer which it is w3-parse-buffer's responsibility to -\"let\"-bind.") - - (defmacro w3-p-s-var-def (var) - "Declare VAR as a scratch variable which w3-parse-buffer must -\"let\"-bind." - (` (eval-when-compile - (defvar (, var)) - (or (memq '(, var) w3-p-s-var-list) - (setq w3-p-s-var-list (cons '(, var) w3-p-s-var-list)))))) - - (defmacro w3-p-s-let-bindings (&rest body) - "\"let\"-bind all of the variables in w3-p-s-var-list in BODY." - (` (let (, w3-p-s-var-list) - (,@ body)))) - (put 'w3-p-s-let-bindings 'lisp-indent-function 0) - (put 'w3-p-s-let-bindings 'edebug-form-spec t) - - (defvar w3-p-d-current-element) - (put 'w3-p-d-current-element 'variable-documentation - "Information structure for the current open element.") - - (defvar w3-p-d-exceptions) - (put 'w3-p-d-exceptions 'variable-documentation - "Alist specifying elements (dis)allowed because of an (ex|in)clusion -exception of some containing element (not necessarily the immediately -containing element). Each item specifies a transition for an element -which overrides that specified by the current element's content model. -Each item is of the form (TAG ACTION *same ERRORP).") - - (defvar w3-p-d-in-parsed-marked-section) - (put 'w3-p-d-in-parsed-marked-section 'variable-documentation - "Are we in a parsed marked section so that we have to scan for \"]]>\"?") - - (defvar w3-p-d-non-markup-chars) - (put 'w3-p-d-non-markup-chars 'variable-documentation - "The characters that do not indicate the start of markup, in the format -for an argument to skip-chars-forward.") - - (defvar w3-p-d-null-end-tag-enabled) - (put 'w3-p-d-null-end-tag-enabled 'variable-documentation - "Is the null end tag (\"/\") enabled?") - - (defvar w3-p-d-open-element-stack) - (put 'w3-p-d-open-element-stack 'variable-documentation - "A stack of the currently open elements, with the innermost enclosing -element on top and the outermost on bottom.") - - (defvar w3-p-d-shortrefs) - (put 'w3-p-d-shortrefs 'variable-documentation - "An alist of the magic entity reference strings in the current -between-tags region and their replacements. Each item is of the format -\(REGEXP . REPLACEMENT-STRING\). Although in SGML shortrefs normally name -entities whose value should be used as the replacement, we have -preexpanded the entities for speed. We have also regexp-quoted the -strings to be replaced, so they can be used with looking-at. This should -never be in an element's overrides field unless -w3-p-d-shortref-chars is also in the field.") - - (defvar w3-p-d-shortref-chars) - (put 'w3-p-d-shortref-chars 'variable-documentation - "A string of the characters which can start shortrefs in the current -between-tags region. This must be in a form which can be passed to -skip-chars-forward and must contain exactly the characters which start the -entries in w3-p-d-shortrefs. If this variable is mentioned in the -overrides field of an element, its handling is magical in that the -variable w3-p-d-non-markup-chars is saved to the element's undo-list and -updated at the same time. This should never be in an element's overrides -field unless w3-p-d-shortrefs is also in the field.") - - (defvar w3-p-d-tag-name) - (put 'w3-p-d-tag-name 'variable-documentation - "Name of tag we are looking at, as an Emacs Lisp symbol. -Only non-nil when we are looking at a tag.") - - (defvar w3-p-d-end-tag-p) - (put 'w3-p-d-end-tag-p 'variable-documentation - "Is the tag we are looking at an end tag? -Only non-nil when we are looking at a tag.") - - ) - - -;;; -;;; HTML syntax error messages. -;;; - -(eval-when-compile - - (defvar w3-p-d-debug-url) - (put 'w3-p-d-debug-url 'variable-documentation - "Whether to print the URL being parsed before an error messages. -Only true for the first error message.") - - ;; The level parameter indicates whether the error is (1) very - ;; serious, must be displayed to all users, (2) invalid HTML, but the - ;; user should only be told if the user has indicated interest, or (3) - ;; valid HTML which is bad because it appears to rely on the way certain - ;; browsers will display it, which should only be displayed to the user - ;; if they have really asked for it. - - (defmacro w3-debug-html (&rest body) - "Emit a warning message. -These keywords may be used at the beginning of the arguments: - :mandatory-if sexp -- force printing if sexp evaluates non-nil. - :bad-style -- do not print unless w3-debug-html is 'style. - :outer -- do not include the current element in the element - context we report. - :nocontext -- do not include context where error detected. -The remaining parameters are treated as the body of a progn, the value of -which must be a string to use as the error message." - (let (mandatory-if bad-style outer nocontext condition) - (while (memq (car body) '(:mandatory-if :bad-style :outer :nocontext)) - (cond ((eq ':mandatory-if (car body)) - (setq mandatory-if (car (cdr body))) - (setq body (cdr (cdr body)))) - ((eq ':bad-style (car body)) - (setq bad-style t) - (setq body (cdr body))) - ((eq ':nocontext (car body)) - (setq nocontext t) - (setq body (cdr body))) - ((eq ':outer (car body)) - (setq outer t) - (setq body (cdr body))))) - (setq condition (if bad-style - '(eq 'style w3-debug-html) - 'w3-debug-html)) - (if mandatory-if - (setq condition - (` (or (, mandatory-if) - (, condition))))) - (` (if (, condition) - (let ((message (progn (,@ body)))) - (if message - (w3-debug-html-aux message - (,@ (if nocontext - (list outer nocontext) - (if outer '(t))))))))))) - - ;; This is unsatisfactory. - (put 'w3-debug-html 'lisp-indent-function 0) - - (put 'w3-debug-html 'edebug-form-spec - '([&rest &or ":nocontext" ":outer" [":mandatory-if" form] ":bad-style"] - &rest form)) - ) - -(defun w3-debug-html-aux (message &optional outer nocontext) - (push (if nocontext - message - (concat message - ;; Display context information for each error - ;; message. - "\n Containing elements: " - (w3-open-elements-string (if outer 1)) - (concat - "\n Text around error: " - (save-restriction - (widen) - (progn - (insert "*ERROR*") - (prog1 - (w3-quote-for-string - (buffer-substring - (max (- (point) 27) (point-min)) - (min (+ (point) 20) (point-max)))) - (delete-char -7))))))) w3-current-badhtml)) - -(defun w3-quote-for-string (string) - (save-excursion - (set-buffer (get-buffer-create " w3-quote-whitespace")) - (erase-buffer) - (insert string) - (goto-char (point-min)) - (insert "\"") - (while (progn - (skip-chars-forward "^\"\\\t\n\r") - (not (eobp))) - (insert "\\" (cdr (assq (char-after (point)) '((?\" . "\"") - (?\\ . "\\") - (?\t . "t") - (?\n . "n") - (?\r . "r"))))) - (delete-char 1)) - (insert "\"") - (buffer-string))) - - -;;; -;;; General entity references and numeric character references. -;;; - -;; *** MULE conversion? -;; *** I18N HTML support? - -(let ((html-entities w3-html-entities)) - (while html-entities - (put (car (car html-entities)) 'html-entity-expansion - (cons 'CDATA (if (integerp (cdr (car html-entities))) - (char-to-string - (mule-make-iso-character (cdr (car html-entities)))) - (cdr (car html-entities))))) - (setq html-entities (cdr html-entities)))) - -;; These are handled differently than the normal HTML entities because -;; we need to define the entities with 'nil instead of 'CDATA so -;; that they are correctly scanned for new markup. -;; -;; from jbw@cs.bu.edu -;; -;;> Of course, this differs from the specification a bit. The W3C tech -;;> report defines all of these as SYSTEM entities. This potentially means -;;> that they can be used in more contexts. The method I outlined above -;;> means "&smiley;" can only be used in contexts where IMG is a valid -;;> element. I am not sure exactly where it is okay to use a SYSTEM entity. -;;> I think anywhere that data characters are accepted. -;; -;; I find this acceptable, as just what the hell are you supposed to do with -;; &computer; as part of a value of a form input when you display it and/or -;; submit it?! - -(let ((html-entities w3-graphic-entities) - (cur nil)) - (while html-entities - (setq cur (car html-entities) - html-entities (cdr html-entities)) - (put (nth 0 cur) 'html-entity-expansion - (cons 'nil (format "<img src=\"%s/%s%s\" alt=\"%s\">" - w3-icon-directory - (nth 1 cur) - (if w3-icon-format - (concat "." (symbol-name w3-icon-format)) - "") - (or (nth 3 cur) (nth 2 cur))))))) - -;; These are the general entities in HTML 3.0 in terms of which the math -;; shortrefs are defined: -;; -;; <!ENTITY REF1 STARTTAG "SUP"> -;; <!ENTITY REF2 ENDTAG "SUP"> -;; <!ENTITY REF3 STARTTAG "SUB"> -;; <!ENTITY REF4 ENDTAG "SUB"> -;; <!ENTITY REF5 STARTTAG "BOX"> -;; <!ENTITY REF6 ENDTAG "BOX"> -;; -;; We're ignoring them because these names should really be local to the -;; DTD and not visible in the document. They might change at any time in -;; future HTML standards. - -;; <!--Entities for language-dependent presentation (BIDI and contextual analysis) --> -;; <!ENTITY zwnj CDATA "&#8204;"-- zero width non-joiner--> -;; <!ENTITY zwj CDATA "&#8205;"-- zero width joiner--> -;; <!ENTITY lrm CDATA "&#8206;"-- left-to-right mark--> -;; <!ENTITY rlm CDATA "&#8207;"-- right-to-left mark--> - -;; Entity names are case sensitive! - -;; & should only be recognized when followed by letter or # and -;; digit or # and letter. - -(eval-when-compile - - (w3-p-s-var-def w3-p-s-entity) - (w3-p-s-var-def w3-p-s-pos) - (w3-p-s-var-def w3-p-s-num) - ;; Destroys free variables: - ;; w3-p-s-entity, w3-p-s-pos, w3-p-s-num - ;; Depends on case-fold-search being t. - (defsubst w3-expand-entity-at-point-maybe () - ;; We are looking at a &. - ;; Only &A or &#1 or &#A syntax is special. - (cond - ((and (looking-at "&\\([a-z][-a-z0-9.]*\\)[\ ;\n]?") ; \n should be \r - ;; We are looking at a general entity reference, maybe undefined. - (setq w3-p-s-entity - (get - (intern (buffer-substring (match-beginning 1) (match-end 1))) - 'html-entity-expansion))) - - ;; If the reference was undefined, then for SGML, we should really - ;; issue a warning and delete the reference. However, the HTML - ;; standard (contradicting the SGML standard) says to leave the - ;; undefined reference in the text. - - ;; We are looking at a defined general entity reference. - (replace-match "") - (cond ((eq 'CDATA (car w3-p-s-entity)) - ;; Leave point after expansion so we don't rescan it. - (insert (cdr w3-p-s-entity))) - ((memq (car w3-p-s-entity) '(nil STARTTAG ENDTAG MS MD)) - ;; nil is how I mark ordinary entities. - ;; The replacement text gets rescanned for all of these. - (setq w3-p-s-pos (point)) - (insert (cdr (assq (car w3-p-s-entity) - '((nil . "") - (STARTTAG . "<") - (ENDTAG . "</") - (MS . "<![") - (MD . "<!")))) - (cdr w3-p-s-entity) - (cdr (assq (car w3-p-s-entity) - '((nil . "") - (STARTTAG . ">") - (ENDTAG . ">") - (MS . "]]>") - (MD . ">"))))) - (goto-char w3-p-s-pos) - ;; *** Strictly speaking, if we parse anything from the - ;; replacement text, it must end before the end of the - ;; replacement text. - ) - ((eq 'SDATA (car w3-p-s-entity)) - (insert "[Unimplemented SDATA \"%s\"]" (cdr w3-p-s-entity))) - ((eq 'PI (car w3-p-s-entity)) - ;; We are currently ignoring processing instructions. - ;; *** Strictly speaking, we should issue a warning if this - ;; occurs in a attribute value. - ) - (t - ;; *** We don't handle external entities yet. - (error "[Unimplemented entity: \"%s\"]" w3-p-s-entity)))) - - ((looking-at "&#[0-9][0-9]*\\([\ ;\n]?\\)") ; \n should be \r - ;; We are looking at a numeric character reference. - ;; Ensure the number is already terminated by a semicolon or carriage - ;; return so we can use "read" to get it as a number quickly. - (cond ((= (match-beginning 1) (match-end 1)) - ;; This is very uncommon, so we don't have to be quick here but - ;; rather correct. - (save-excursion - (goto-char (match-end 0)) ; same as match-end 1 - (insert ?\;)) - ;; Set up the match data properly - (looking-at "&#[0-9][0-9]*;"))) - (forward-char 2) - (setq w3-p-s-num (read (current-buffer))) - ;; Always leave point after the expansion of a numeric - ;; character reference, like it were a CDATA entity. - (replace-match "") - ;; char-to-string will hopefully do something useful with characters - ;; larger than 255. I think in MULE it does. Is this true? - ;; Bill wants to call w3-resolve-numeric-entity here, but I think - ;; that functionality belongs in char-to-string. - ;; The largest valid character in the I18N version of HTML is 65533. - ;; ftp://ds.internic.net/internet-drafts/draft-ietf-html-i18n-01.txt - ;; wrongo! Apparently, mule doesn't do sane things with char-to-string - ;; -wmp 7/9/96 - (insert (char-to-string - (mule-make-iso-character w3-p-s-num)))) - ((looking-at "&#\\(re\\|rs\\|space\\|tab\\)[\ ;\n]?") ; \n should be \r - (replace-match (assq (upcase (char-after (+ 3 (point)))) - '(;; *** Strictly speaking, record end should be - ;; carriage return. - (?E . "\n") ; RE - ;; *** And record start should be line feed. - (?S . "") ; RS - (?P . " ") ; SPACE - (?A . "\t")))) ; TAB - ;; Leave point after the expansion of a character reference, so it - ;; doesn't get rescanned. - ;; *** Strictly speaking, we should issue a warning for &#foo; if foo - ;; is not a function character in the SGML declaration. - ) - - ((eq ?& (char-after (point))) - ;; We are either looking at an undefined reference or a & that does - ;; not start a reference (in which case we should not have been called). - ;; Skip over the &. - (forward-char 1)) - - (t - ;; What is the code doing calling us if we're not looking at a "&"? - (error "this should never happen")))) - - ) - - -;;; -;;; Syntax table used in markup declarations. -;;; - -(defvar w3-sgml-md-syntax-table - (let ((table (make-syntax-table)) - (items '( - (0 "." 255) ; clear everything - (?\r " ") - (?\t " ") - (?\n " ") - (32 " ") ; space - (?< "\(>") - (?> "\)<") - (?\( "\(\)") - (?\) "\)\(") - (?\[ "\(\]") - (?\] "\)\[") - (?\" "\"") - (?\' "\"") - (?a "w" ?z) - (?A "w" ?Z) - (?0 "w" ?9) - (?. "w") - ;; "-" can be a character in a NAME, but it is also used in - ;; "--" as both a comment start and end within SGML - ;; declarations ("<!" ... ">"). In HTML, it is only used - ;; as a NAME character in the parameter entities - ;; Content-Type, HTTP-Method, and style-notations and in - ;; the attribute name http-equiv and in the notation names - ;; dsssl-lite and w3c-style. We would like to be able to - ;; train Emacs to skip over these kinds of comments with - ;; forward-sexp and backward-sexp. Is there any way to - ;; teach Emacs how to do this? It doesn't seem to be the - ;; case. - (?- "w") - ))) - (while items - (let* ((item (car items)) - (char (car item)) - (syntax (car (cdr item))) - (bound (or (car-safe (cdr-safe (cdr item))) - char))) - (while (<= char bound) - (modify-syntax-entry char syntax table) - (setq char (1+ char)))) - (setq items (cdr items))) - table) - "A syntax table for parsing SGML markup declarations.") - - -;;; -;;; Element information data type. -;;; - -;; The element information data type is used in two ways: -;; -;; * To store the DTD, there is one element record for each element in -;; the DTD. -;; -;; * To store information for open elements in the current parse tree. -;; Each such element is initialized by copying the element record -;; from the DTD. This means that values in the fields can not be -;; destructively altered, although of course the fields can be -;; changed. - -;; The cells in this vector are: -;; -;; name: the element's name (a generic identifier). -;; -;; end-tag-name: a symbol whose name should be the result of prefixing -;; the generic-identifier with a slash. This is a convenience value for -;; interfacing with the display engine which expects a stream of start -;; and end tags in this format rather than a tree. -;; -;; content-model: a data structure describing what elements or character -;; data we expect to find within this element. This is either a symbol -;; listed here: -;; -;; EMPTY: no content, no end-tag allowed. -;; CDATA: all data characters until "</[a-z]" is seen. -;; XCDATA: special non-SGML-standard mode which includes all data -;; characters until "</foo" is seen where "foo" is the name of this -;; element. (for XMP and LISTING) -;; XXCDATA: special non-SGML-standard mode which includes all data -;; until end-of-entity (end-of-buffer for us). (for PLAINTEXT) -;; RCDATA: all data characters until "</[a-z]" is seen, except that -;; entities are expanded first, although the expansions are not -;; scanned for end-tags. -;; XINHERIT: special non-SGML-standard mode which means to use the -;; content model of the containing element instead. -;; -;; or a vector of this structure: -;; -;; [(INCLUDES INCSPACEP (((TAG ...) . TRANSITION) ...) DEFAULT) ...] -;; -;; where INCLUDES is of the format: -;; -;; (TAG ...) -;; -;; where each TRANSITION is one of these: -;; -;; (ACTION NEW-STATE ERRORP) -;; (ACTION NEW-STATE) -;; (ACTION) -;; -;; where DEFAULT is one of these: -;; -;; nil or TRANSITION -;; -;; where the meaning of the components is: -;; -;; INCLUDES is a list of tags for which the transition (*include *same -;; nil) applies. -;; -;; DEFAULT if non-nil is a transition that should be taken when -;; matching any possibility not explicitly listed in another -;; TRANSITION, except for data characters containing only whitespace. -;; -;; INCSPACEP specifies how to handle data characters which include -;; only whitespace characters. The value is non-nil to indicate -;; (*include *same nil) or nil to indicate (*discard *same nil). -;; -;; TAG is a symbol corresponding to the start-tag we are looking at, -;; or *data when seeing character data that includes at least one -;; non-space character. -;; -;; ACTION is one of: -;; *close: Close this element and try again using content model of -;; enclosing element. (Note that this does not apply to the -;; case of an element being closed by its own end-tag.) -;; *include: Process new element as subelement of this one or -;; include data characters directly. -;; *discard: Discard a start-tag or data characters. -;; *retry: Try again after processing NEW-STATE and ERRORP. -;; ELEMENT: Open ELEMENT (with default attributes), then try again -;; using its content model. -;; -;; NEW-STATE (optional, default *same) is the index of the state to -;; move to after processing the element or one of these: -;; *same: no state change occurs. -;; *next: change the current state + 1. -;; The initial state is 0. NEW-STATE does not matter if ACTION is -;; *close. -;; -;; ERRORP (optional, default nil) if non-nil indicates this transition -;; represents an error. The error message includes this value if it -;; is a string. -;; -;; If no matching transition is found, the default transition is -;; (*discard *same "not allowed here"). -;; -;; overrides: An alist of pairs of the form (VAR REPLACEP . VALUE). -;; When this element is opened, the old value of VAR is saved in the -;; undo-list. If REPLACEP is non-nil, then VAR gets value VALUE, -;; otherwise VAR gets value (append VALUE (symbol-value VAR)). Useful -;; values for VAR are: -;; -;; w3-p-d-exceptions: See doc string. -;; -;; w3-p-d-shortrefs: See doc string. -;; -;; w3-p-d-shortref-chars: See doc string. -;; -;; end-tag-omissible: Whether it is legal to omit the end-tag of this -;; element. If an end-tag is inferred for an element whose end tag is -;; not omissible, an error message is given. -;; -;; state: The current state in the content model. Preset to the initial -;; state of 0. -;; -;; undo-list: an alist of of former values of local variables -;; of w3-parse-buffer to restore upon closing this element. Each -;; item on the list is of the format (VAR . VALUE-TO-RESTORE). -;; -;; attributes: an alist of attributes and values. Each item on -;; this list is of the format (ATTRIBUTE-NAME . VALUE). Each -;; ATTRIBUTE-NAME is a symbol and each attribute value is a -;; string. -;; -;; content: a list of the accumulated content of the element. While the -;; element is open, the list is in order from latest to earliest, -;; otherwise it is in order from earliest to latest. Each member is -;; either a string of data characters or a list of the form (NAME -;; ATTRIBUTES CONTENT), where NAME is the subelement's name, ATTRIBUTES -;; is an alist of the subelement's attribute names (lowercase symbols) -;; and their values (strings), and CONTENT is the subelement's content. - -(eval-when-compile - - (defconst w3-element-fields - '(name end-tag-name content-model state overrides undo-list - content attributes end-tag-omissible deprecated)) - - (let* ((fields w3-element-fields) - (index (1- (length fields)))) - (while fields - (let* ((field (symbol-name (car fields))) - (get-sym (intern (concat "w3-element-" field))) - (set-sym (intern (concat "w3-set-element-" field)))) - (eval (` (progn - (defmacro (, get-sym) (element) - (list 'aref element (, index))) - (defmacro (, set-sym) (element value) - (list 'aset element (, index) value)))))) - (setq fields (cdr fields)) - (setq index (1- index)))) - - (defmacro w3-make-element () - (list 'make-vector (length w3-element-fields) nil)) - - ;; *** move this to be with DTD declaration. - (defmacro w3-fresh-element-for-tag (tag) - (` (copy-sequence - (or (get (, tag) 'html-element-info) - (error "unimplemented element %s" - (w3-sgml-name-to-string (, tag))))))) - - ;; *** move this to be with DTD declaration. - (defmacro w3-known-element-p (tag) - (` (get (, tag) 'html-element-info))) - - (defsubst w3-sgml-name-to-string (sym) - (upcase (symbol-name sym))) - - ) - - -;;; -;;; Parse tree manipulation. -;;; - -;; ;; Find the name of the previous element or a substring of the -;; ;; preceding data characters. -;; (let ((content (w3-element-content (car stack)))) -;; (while content -;; (cond -;; ((and (stringp (car content)) -;; (not (string-match "\\`[ \t\n\r]*\\'" (car content)))) -;; (setq prior-item (car content)) -;; ;; Trim trailing whitespace -;; (if (string-match "\\(.*[^ \t\n\r]\\)[ \t\n\r]*\\'" prior-item) -;; (setq prior-item (substring prior-item 0 (match-end 1)))) -;; (if (> (length prior-item) 8) -;; (setq prior-item (concat "..." (substring prior-item -8)))) -;; (setq prior-item (w3-quote-for-string prior-item)) -;; (setq prior-item (concat "\(after " prior-item "\)")) -;; (setq content nil)) -;; ((and (consp (car content)) -;; (symbolp (car (car content)))) -;; (setq prior-item -;; (concat "\(after " -;; (w3-sgml-name-to-string (car (car content))) -;; "\)")) -;; (setq content nil)) -;; (t -;; (setq content (cdr content)))))) - -;; Only used for HTML debugging. -(defun w3-open-elements-string (&optional skip-count) - (let* ((stack (nthcdr (or skip-count 0) - (cons w3-p-d-current-element - w3-p-d-open-element-stack))) - ;;(prior-item "(at start)") - result) - ;; Accumulate the names of the enclosing elements. - (while stack - (let ((element (w3-element-name (car stack)))) - (if (eq '*holder element) - nil - ;; Only include *DOCUMENT if there are no other elements. - (if (or (not (eq '*document element)) - (null result)) - (setq result (cons (w3-sgml-name-to-string element) - result))))) - (setq stack (cdr stack))) - (setq result (mapconcat 'identity result ":")) - (if result - ;;(concat - result - ;; prior-item) - "[nowhere!]"))) - -;; *** This doesn't really belong here, but where? -(eval-when-compile - (defmacro w3-invalid-sgml-chars () - "Characters not allowed in an SGML document using the reference -concrete syntax (i.e. HTML). Returns a string in the format expected by -skip-chars-forward." - "\000-\010\013\014\016-\037\177-\237")) - -(eval-when-compile - ;; Uses: - ;; w3-p-d-null-end-tag-enabled, w3-p-d-in-parsed-marked-section, - ;; w3-p-d-shortref-chars - ;; Modifies free variable: - ;; w3-p-d-non-markup-chars - (defsubst w3-update-non-markup-chars () - (setq w3-p-d-non-markup-chars - (concat "^&<" - (w3-invalid-sgml-chars) - (if w3-p-d-null-end-tag-enabled "/" "") - (if w3-p-d-in-parsed-marked-section "]" "") - (or w3-p-d-shortref-chars "")))) -) - -(eval-when-compile - (w3-p-s-var-def w3-p-s-overrides) - (w3-p-s-var-def w3-p-s-undo-list) - (w3-p-s-var-def w3-p-s-var) - ;; Uses free variables: - ;; w3-p-d-non-markup-chars - ;; Modifies free variables: - ;; w3-p-d-current-element, w3-p-d-open-element-stack - ;; Destroys free variables: - ;; w3-p-s-overrides, w3-p-s-undo-list, w3-p-s-var - (defsubst w3-open-element (tag attributes) - - ;; Push new element on stack. - (setq w3-p-d-open-element-stack (cons w3-p-d-current-element - w3-p-d-open-element-stack)) - (setq w3-p-d-current-element (w3-fresh-element-for-tag tag)) - - ;; Warn if deprecated or obsolete. - (if (w3-element-deprecated w3-p-d-current-element) - (w3-debug-html :outer - (format "%s element %s." - (if (eq 'obsolete - (w3-element-deprecated w3-p-d-current-element)) - "Obsolete" - "Deprecated") - (w3-sgml-name-to-string - (w3-element-name w3-p-d-current-element))))) - - ;; Store attributes. - ;; *** we are not handling #CURRENT attributes (HTML has none). - (w3-set-element-attributes w3-p-d-current-element attributes) - ;; *** Handle default attribute values. - ;; *** Fix the attribute name for unnamed values. Right now they will - ;; be in the attribute list as items of the format (VALUE . VALUE) where - ;; both occurrences of VALUE are the same. The first one needs to be - ;; changed to the proper attribute name by consulting the DTD. - ;; ******************** - - ;; Handle syntax/semantics overrides of new current element. - (cond ((w3-element-overrides w3-p-d-current-element) - (setq w3-p-s-overrides - (w3-element-overrides w3-p-d-current-element)) - (setq w3-p-s-undo-list nil) - (while w3-p-s-overrides - (setq w3-p-s-var (car (car w3-p-s-overrides))) - (setq w3-p-s-undo-list - (cons (cons w3-p-s-var - (symbol-value w3-p-s-var)) - w3-p-s-undo-list)) - (set w3-p-s-var (if (car (cdr (car w3-p-s-overrides))) - (cdr (cdr (car w3-p-s-overrides))) - (append (cdr (cdr (car w3-p-s-overrides))) - (symbol-value w3-p-s-var)))) - ;; *** HACK HACK. - ;; Magic handling of w3-p-d-shortref-chars. - (cond ((eq 'w3-p-d-shortref-chars w3-p-s-var) - (setq w3-p-s-undo-list - (cons (cons 'w3-p-d-non-markup-chars - w3-p-d-non-markup-chars) - w3-p-s-undo-list)) - (w3-update-non-markup-chars))) - (setq w3-p-s-overrides (cdr w3-p-s-overrides))) - (w3-set-element-undo-list w3-p-d-current-element - w3-p-s-undo-list))) - - ;; Handle content-model inheritance. (Very non-SGML!) - (if (eq 'XINHERIT (w3-element-content-model w3-p-d-current-element)) - (w3-set-element-content-model - w3-p-d-current-element - (w3-element-content-model (car w3-p-d-open-element-stack)))) - - ) - ) - -;; The protocol for handing items to the display engine is as follows. -;; -;; For an element, send (START-TAG . ATTS), each member of the content, -;; and (END-TAG . nil) if the element is allowed to have an end tag. -;; -;; For data characters, send (text . DATA-CHARACTERS). -;; -;; Exceptions: -;; -;; For PLAINTEXT, STYLE, XMP, TEXTAREA send: -;; (START-TAG . ((data . DATA-CHARACTERS) . ATTS)). -;; -;; *** This requires somehow eliminating any subelements of the TEXTAREA -;; element. TEXTAREA can contain subelements in HTML 3.0. -;; -;; For LISTING, send (text . DATA-CHARACTERS). (Is this really correct or -;; is this perhaps a bug in the old parser?) I'm ignoring this for now. - -(eval-when-compile - (w3-p-s-var-def w3-p-s-undo-list) - (w3-p-s-var-def w3-p-s-content) - (w3-p-s-var-def w3-p-s-end-tag) - ;; Modifies free variables: - ;; w3-p-d-current-element, w3-p-d-open-element-stack - ;; Accesses free variables: - ;; w3-p-d-tag-name, w3-p-d-end-tag-p - ;; Destroys free variables: - ;; w3-p-s-undo-list, w3-p-s-content, w3-p-s-end-tag - (defsubst w3-close-element (&optional inferred) - ;; inferred: non-nil if the end-tag of the current element is being - ;; inferred due to the presence of content not allowed in the current - ;; element. If t, then the tag causing this is in w3-p-d-tag-name and - ;; w3-p-d-end-tag-p. - ;; (OLD: ... otherwise it is a symbol indicating the start-tag - ;; of an element or *data or *space indicating data characters.) - - (cond ((and inferred - (not (w3-element-end-tag-omissible w3-p-d-current-element))) - (w3-debug-html - (format "</%s> end-tag not omissible (required due to %s)" - (w3-sgml-name-to-string - (w3-element-name w3-p-d-current-element)) - (cond ((eq t inferred) - (format (if w3-p-d-end-tag-p - "</%s> end-tag" - "start-tag for %s") - (w3-sgml-name-to-string - w3-p-d-tag-name))) - ;; *** Delete this functionality? - ((memq inferred '(*space *data)) - "data characters") - ((symbolp inferred) - (format "start-tag for %s" - (w3-sgml-name-to-string inferred))) - ))))) - - ;; Undo any variable bindings of this element. - (cond ((w3-element-undo-list w3-p-d-current-element) - (setq w3-p-s-undo-list - (w3-element-undo-list w3-p-d-current-element)) - (while w3-p-s-undo-list - (set (car (car w3-p-s-undo-list)) - (cdr (car w3-p-s-undo-list))) - (setq w3-p-s-undo-list (cdr w3-p-s-undo-list))))) - - (setq w3-p-s-end-tag - (w3-element-end-tag-name w3-p-d-current-element)) - - ;; Fix up the content of the current element in preparation for putting - ;; it in the parent. - ;; Remove trailing newline from content, if there is one, otherwise send - ;; any trailing data character item to display engine. - (setq w3-p-s-content (w3-element-content w3-p-d-current-element)) - (cond ((null w3-p-s-content)) - ((equal "\n" (car w3-p-s-content)) - (setq w3-p-s-content (cdr w3-p-s-content))) - ) - - (cond ;; *** Handle LISTING the way the old parser did. - ((eq 'EMPTY (w3-element-content-model w3-p-d-current-element)) - ;; Do nothing, can't have an end tag. - ) - (t - ;; Normal case. - (if (null w3-p-s-content) - (w3-debug-html - :bad-style :outer - ;; Don't warn for empty TD elements or empty A elements - ;; with no HREF attribute. - ;; *** Crude hack that should really be encoded in the - ;; element database somehow. - (if (or (not (memq (w3-element-name w3-p-d-current-element) - '(a td))) - (assq 'href - (w3-element-attributes w3-p-d-current-element))) - (format "Empty %s element." - (w3-sgml-name-to-string - (w3-element-name w3-p-d-current-element)))))))) - - ;; Put the current element in the proper place in its parent. - ;; This will cause an error if we overpop the stack. - (w3-set-element-content - (car w3-p-d-open-element-stack) - (cons (list (w3-element-name w3-p-d-current-element) - (w3-element-attributes w3-p-d-current-element) - (nreverse w3-p-s-content)) - (w3-element-content (car w3-p-d-open-element-stack)))) - - ;; Pop the stack. - (setq w3-p-d-current-element (car w3-p-d-open-element-stack)) - (setq w3-p-d-open-element-stack (cdr w3-p-d-open-element-stack))) - - ) - - -;;; -;;; A pseudo-DTD for HTML. -;;; - -(eval-when-compile - ;; This works around the following bogus compiler complaint: - ;; While compiling the end of the data in file w3-parse.el: - ;; ** the function w3-expand-parameters is not known to be defined. - ;; This is a bogus error. Anything of this form will trigger this message: - ;; (eval-when-compile (defun xyzzy () (xyzzy))) - (defun w3-expand-parameters (pars data) nil)) - -(eval-when-compile - (defun w3-expand-parameters (pars data) - (cond ((null data) - nil) - ((consp data) - ;; This has to be written carefully to avoid exceeding the - ;; maximum lisp function call nesting depth. - (let (result) - (while (consp data) - (let ((car-exp (w3-expand-parameters pars (car data)))) - (setq result - (if (and (symbolp (car data)) - (not (eq car-exp (car data))) - ;; An expansion occurred. - (listp car-exp)) - ;; The expansion was a list, which we splice in. - (condition-case err - (append (reverse car-exp) result) - (wrong-type-argument - (if (eq 'listp (nth 1 err)) - ;; Wasn't really a "list" since the last - ;; cdr wasn't nil, so don't try to splice - ;; it in. - (cons car-exp result) - (signal (car err) (cdr err))))) - (cons car-exp result)))) - (setq data (cdr data))) - (append (nreverse result) - (w3-expand-parameters pars data)))) - ((symbolp data) - (let ((sym-exp (cdr-safe (assq data pars)))) - (if sym-exp - (w3-expand-parameters pars sym-exp) - data))) - ((vectorp data) - (let ((i 0) - (result (copy-sequence data))) - (while (< i (length data)) - (aset result i - (w3-expand-parameters pars (aref data i))) - (setq i (1+ i))) - result)) - (t - data)))) - -(eval-when-compile - (defun w3-unfold-dtd (items) - (let (result) - (while items - (let* ((item (car items)) - (names (car item)) - (content-model - (or (cdr-safe (assq 'content-model item)) - (error "impossible"))) - (overrides (cdr-safe (assq 'overrides item))) - (end-tag-omissible - (or (cdr-safe (assq 'end-tag-omissible item)) - ;; *** Is this SGML standard? - (eq 'EMPTY content-model))) - (deprecated (cdr-safe (assq 'deprecated item))) - element - name) - (while names - (setq name (car names)) - (setq names (cdr names)) - - ;; Create and initialize the element information data - ;; structure. - (setq element (w3-make-element)) - (w3-set-element-name element name) - (w3-set-element-end-tag-name - element - (intern (concat "/" (symbol-name name)))) - (w3-set-element-state element 0) - (w3-set-element-content-model element content-model) - (w3-set-element-end-tag-omissible element end-tag-omissible) - - (or (memq deprecated '(nil t obsolete)) - (error "impossible")) - (w3-set-element-deprecated element deprecated) - - ;; Inclusions and exclusions are specified differently in the - ;; human-coded DTD than in the format the implementation uses. - ;; The human-coded version is designed to be easy to edit and to - ;; work with w3-expand-parameters while the internal version is - ;; designed to be fast. We have to translate here. This work - ;; is repeated for every element listed in `names' so that the - ;; exclusion exception error messages can be accurate. - (let ((inclusions (cdr-safe (assq 'inclusions item))) - (exclusions (cdr-safe (assq 'exclusions item))) - (exclusion-mode '*close) - (exclusion-message - (format "%s exclusion" (w3-sgml-name-to-string name))) - exceptions) - (while inclusions - (setq exceptions (cons (cons (car inclusions) - '(*include *same nil)) - exceptions)) - (setq inclusions (cdr inclusions))) - (while exclusions - (cond ((memq (car exclusions) '(*discard *include *close)) - (setq exclusion-mode (car exclusions))) - ((stringp (car exclusions)) - (setq exclusion-message (car exclusions))) - (t - (setq exceptions (cons (list (car exclusions) - exclusion-mode - '*same - exclusion-message) - exceptions)))) - (setq exclusions (cdr exclusions))) - (let ((overrides (if exceptions - (cons (cons 'w3-p-d-exceptions - (cons nil exceptions)) - overrides) - overrides))) - (w3-set-element-overrides element overrides))) - - (setq result (cons (cons name element) result)))) - (setq items (cdr items))) - result))) - -;; Load the HTML DTD. -;; <URL:ftp://ds.internic.net/rfc/rfc1866.txt> -;; *** Be sure to incorporate rfc1867 when attribute-checking is added. -;; *** Write function to check sanity of the content-model forms. -;; *** I18N: Add Q, BDO, SPAN -(mapcar - (function - (lambda (pair) - (put (car pair) 'html-element-info (cdr pair)))) - ;; The purpose of this complexity is to speed up loading by - ;; pre-evaluating as much as possible at compile time. - (eval-when-compile - (w3-unfold-dtd - (w3-expand-parameters - '( - (%headempty . (link base meta range)) - (%headmisc . (script)) - (%head-deprecated . (nextid)) - - ;; client-side imagemaps - (%imagemaps . (area map)) - (%input.fields . (input select textarea keygen label)) - ;; special action is taken for %text inside %body.content in the - ;; content model of each element. - (%body.content . (%heading %block style hr div address %imagemaps)) - - (%heading . (h1 h2 h3 h4 h5 h6)) - - ;; Emacs-w3 extensions - (%emacsw3-crud . (pinhead flame cookie yogsothoth hype peek)) - - (%block . (p %list dl form %preformatted - %blockquote isindex fn table fig note - multicol center %block-deprecated %block-obsoleted)) - (%list . (ul ol)) - (%preformatted . (pre)) - (%blockquote . (bq)) - (%block-deprecated . (dir menu blockquote)) - (%block-obsoleted . (xmp listing)) - - ;; Why is IMG in this list? - (%pre.exclusion . (*include img *discard tab math big small sub sup)) - - (%text . (*data b %notmath sub sup %emacsw3-crud %input.fields)) - (%notmath . (%special %font %phrase %misc)) - (%font . (i u s strike tt big small sub sup font - roach secret wired)) ;; B left out for MATH - (%phrase . (em strong dfn code samp kbd var cite blink)) - (%special . (a img applet object font basefont br script style map math tab span bdo)) - (%misc . (q lang au person acronym abbrev ins del)) - - (%formula . (*data %math)) - (%math . (box above below %mathvec root sqrt array sub sup - %mathface)) - (%mathvec . (vec bar dot ddot hat tilde)) - (%mathface . (b t bt)) - - (%mathdelims . (over atop choose left right of)) - - ;; What the hell? This takes BODYTEXT????? No way! - (%bq-content-model . [(nil - nil - (((bodytext) *include *next)) - (bodytext *next)) - (nil - nil - (((credit) *include *next)) - nil) - (nil nil nil nil) - ]) - - ;; non-default bad HTML handling. - (%in-text-ignore . ((p %heading) *discard *same error)) - ) - '( - ;; A dummy element that will contain *document. - ((*holder) - (content-model . [(nil nil nil nil)])) - ;; The root of the parse tree. We start with a pseudo-element - ;; named *document for convenience. - ((*document) - (content-model . [(nil nil (((html) *include *next)) (html *next)) - (nil - nil - nil - (*include *same "after document end"))]) - (end-tag-omissible . t)) - ;; HTML O O (HEAD, BODY) - ((html) - (content-model . [(nil - nil - (((head) *include *next)) - (head *next)) - (nil - nil - (((body) *include *next) - ;; Netscape stuff - ((frameset) *include 4) - ) - (body *next)) - (nil - nil - (((plaintext) *include *next)) - (*retry *next)) - (nil - nil - nil - (*include *same "after BODY")) - (nil - nil - nil - (*include *same "after FRAMESET")) - ]) - (end-tag-omissible . t)) - ((head) - (content-model . [((title isindex %headempty %headmisc - style %head-deprecated) - nil - nil - ;; *** Should only close if tag can - ;; legitimately follow head. So many can that - ;; I haven't bothered to enumerate them. - (*close))]) - (end-tag-omissible . t)) - ;; SCRIPT - - (#PCDATA) - ((script) - (content-model . XCDATA ; not official, but allows - ; comment hiding of script, and also - ; idiots that use '</' in scripts. - )) - ;; TITLE - - (#PCDATA) - ((title) - (content-model . RCDATA ; not official - ;; [((*data) include-space nil nil)] - )) - ;; STYLE - O (#PCDATA) - ;; STYLE needs to be #PCDATA to allow omitted end tag. Bleagh. - ((style) - (content-model . CDATA) - (end-tag-omissible . t)) - ((body) - (content-model . [((banner) nil nil (*retry *next)) - ((bodytext) nil nil (bodytext *next)) - (nil nil (((plaintext) *close)) nil)]) - (inclusions . (spot)) - (end-tag-omissible . t)) - ;; Do I really want to include BODYTEXT? It has something to do - ;; with mixed content screwing things up, and I don't understand - ;; it. Wait! It's used by BQ! - ((bodytext) - (content-model . [((%body.content) - 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) - ]) - (end-tag-omissible . t)) - ((div banner center multicol) - (content-model . [((%body.content) - nil - ;; Push <P> before data characters. Non-SGML. - (((%text) p)) - nil)])) - ((address) - (content-model . [((p) - nil - ;; Push <P> before data characters. Non-SGML. - (((%text) p)) - nil)])) - ((%heading) - (content-model . [((%text) - include-space - ((%in-text-ignore)) - nil)])) - ((span bdo) - (content-model . [((%text) - include-space - nil - nil)]) - ) - ((p) - (content-model . [((%text) - include-space - nil - ;; *** Should only close if tag can - ;; legitimately follow P. So many can that I - ;; don't bother to enumerate here. - (*close))]) - (end-tag-omissible . t)) - ((ul ol) - (content-model . [((lh) - nil - (((li) *include *next)) - (*retry *next)) - ((p) - nil - nil - (*retry *next)) - ((li) - nil - ;; Push <LI> before data characters or block - ;; elements. - ;; Non-SGML. - (;; ((p) b *same nil) - ((%text %block) li *same error)) - nil)])) - ((lh) - (content-model . [((%text) - include-space - (((dd dt li) *close) - (%in-text-ignore)) - nil)]) - (end-tag-omissible . t)) - ((dir menu) - (content-model . [((li) - nil - (((%text) li *same error)) - nil)]) - (exclusions . (%block)) - (deprecated . t)) - ((li) - (content-model . [((%block) - nil - (((li) *close) - ;; Push <P> before data characters. Non-SGML. - ((%text) p)) - nil)]) - (end-tag-omissible . t) - ;; Better bad HTML handling. - ;; Technically, there are a few valid documents that this will - ;; hose, because you can have H1 inside FORM inside LI. However, - ;; I don't think that should be allowed anyway. - (exclusions . (*discard "not allowed here" %heading))) - ((dl) - (content-model . [((lh) - nil - (((dt dd) *include *next)) - (*retry *next)) - ((dt dd) - nil - ;; Push <DD> before data characters or block - ;; items. - ;; Non-SGML. - (((%text %block) dd *same error)) - nil)])) - ((dt) - (content-model . [((%text) - include-space - (((dd dt) *close) - (%in-text-ignore)) - nil)]) - (end-tag-omissible . t)) - ;; DD is just like LI, but we treat it separately because it can be - ;; followed by a different set of elements. - ((dd) - (content-model . [((%block) - nil - (((dt dd) *close) - ;; Push <P> before data characters. Non-SGML. - ((%text) p)) - nil)]) - (end-tag-omissible . t) - ;; See comment with LI. - (exclusions . (*discard "not allowed here" %heading))) - ((pre) - (content-model . [((%text hr) - include-space - ((%in-text-ignore)) - nil)]) - (exclusions . (%pre.exclusion))) - ;; BLOCKQUOTE deprecated, BQ okay - ((bq) - (content-model . %bq-content-model)) - ((blockquote) - (content-model . %bq-content-model) - ;; BLOCKQUOTE is deprecated in favor of BQ in the HTML 3.0 DTD. - ;; However, BQ is not even mentioned in the HTML 2.0 DTD. So I - ;; don't think we can enable this yet: - ;;(deprecated . t) - ) - ((fn note) - (content-model . [((%body.content) - nil - ;; Push <P> before data characters. Non-SGML. - (((%text) p)) - nil)])) - ((fig) - (content-model . [((overlay) nil nil (*retry *next)) - (nil - nil - (((caption) *include *next)) - (*retry *next)) - (nil - nil - (((figtext) *include *next) - ((credit) *retry *next)) - ;; *** Should only do this for elements that - ;; can be in FIGTEXT. - (figtext *next)) - (nil nil (((credit) *include *next)) nil) - (nil nil nil nil)])) - ((caption credit) - (content-model . [((%text) - nil - ((%in-text-ignore)) - nil)])) - ((figtext) - (content-model . [((%body.content) - nil - ;; Push <P> before data characters. Very non-SGML. - (((%text) p) - ((credit) *close)) - nil)]) - (end-tag-omissible . t)) - ((%emacsw3-crud basefont) - (content-model . EMPTY)) - ;; FORM - - %body.content -(FORM) +(INPUT|KEYGEN|SELECT|TEXTAREA) - ((form) - ;; Same as BODY. Ugh! - (content-model . [((%body.content %text) - nil - ;; Push <P> before data characters. Non-SGML. - nil - nil)]) - (exclusions . (form)) - (inclusions . (input select textarea keygen label))) - ;; *** Where is the URL describing this? - ((label) - (content-model . [((%text) - include-space - nil - nil)]) - ;; *** These are already included, no need to repeat. - ;;(inclusions . (input select textarea)) - ;; *** Is a LABEL allowed inside a LABEL? I assume no. - (exclusions . (label)) - ;; The next line just does the default so is unneeded: - ;;(end-tag-omissible . nil) - ) - ;; SELECT - - (OPTION+) -(INPUT|KEYGEN|TEXTAREA|SELECT)> - ;; *** This should be -(everything). - ((select) - (content-model . [((option) nil nil nil)]) - (exclusions . (input label select keygen textarea))) - ;; option - O (#PCDATA) - ;; needs to be #PCDATA to allow omitted end tag. - ((option) - ;; I'd like to make this RCDATA to avoid problems with inclusions - ;; like SPOT, but that would conflict with the omitted end-tag, I - ;; think. - (content-model . [((*data) - include-space - (((option) *close)) - nil)]) - (end-tag-omissible . t)) - ;; TEXTAREA - - (#PCDATA) -(INPUT|TEXTAREA|KEYGEN|SELECT) - ((textarea) - ;; Same comment as for OPTION about RCDATA. - (content-model . [((*data) include-space nil nil)]) - (exclusions . (input select label keygen textarea))) - ((hr br img isindex input keygen overlay wbr spot tab - %headempty %mathdelims) - (content-model . EMPTY)) - ((nextid) - (content-model . EMPTY) - (deprecated . t)) - ((a) - (content-model . [((%text) - include-space - (((%heading) - *include *same "deprecated inside A") - ;; *** I haven't made up my mind whether this - ;; is a good idea. It can result in a lot of - ;; bad formatting if the A is *never* closed. - ;;((p) *discard *same error) - ) - nil)]) - (exclusions . (a))) - ((b font %font %phrase %misc nobr) - (content-model . [((%text) - include-space - ((%in-text-ignore)) - nil)])) - ((plaintext) - (content-model . XXCDATA) - (end-tag-omissible . t) - (deprecated . obsolete)) - ((xmp listing) - (content-model . XCDATA) - (deprecated . obsolete)) - ;; Latest table spec (as of Nov. 13 1995) is at: - ;; <URL:ftp://ds.internic.net/internet-drafts/draft-ietf-html-tables-03.txt> - ((table) - (content-model . [(nil - nil - (((caption) *include *next) - ((%text) tr *same error) - ((col colgroup thead tfoot tbody tr) *retry *next)) - (*retry *next)) ;error handling - ((col colgroup) - nil - (((thead tfoot tbody tr) *retry *next)) - (*retry *next)) ;error handling - (nil - nil - (((thead) *include *next) - ((tfoot tbody tr) *retry *next)) - (*retry *next)) ;error handling - (nil - nil - (((tfoot) *include *next) - ((tbody tr) *retry *next)) - (*retry *next)) ;error handling - ((tbody) - nil - (((tr) tbody *same) - ((td th) tr *same) - ;; error handling - ((%body.content) tbody *same error)) - nil)])) - ((colgroup) - (content-model . [((col) - nil - (((colgroup thead tfoot tbody tr) *close)) - nil)]) - (end-tag-omissible . t)) - ((col) - (content-model . EMPTY)) - ((thead) - (content-model . [((tr) - nil - (((tfoot tbody) *close) - ;; error handling - ((%body.content) tr *same error)) - nil)]) - (end-tag-omissible . t)) - ((tfoot tbody) - (content-model . [((tr) - nil - (((tbody) *close) - ;; error handling - ((td th) tr *same error) - ((%body.content) tr *same error)) - nil)]) - (end-tag-omissible . t)) - ((tr) - (content-model . [((td th) - nil - (((tr tfoot tbody) *close) - ;; error handling - ((%body.content %text) td *same error)) - nil)]) - (end-tag-omissible . t)) - ((td th) - ;; Arrgh! Another %body.content!!! Stupid!!! - (content-model . [((%body.content) - nil - (((td th tr tfoot tbody) *close) - ;; Push <P> before data characters. Non-SGML. - ((%text) p)) - nil)]) - (end-tag-omissible . t)) - ((math) - (content-model . [((*data) include-space nil nil)]) - (overrides . - ((w3-p-d-shortref-chars t . "\{_^") - (w3-p-d-shortrefs t . (("\\^" . "<sup>") - ("_" . "<sub>") - ("{" . "<box>"))))) - (inclusions . (%math)) - (exclusions . (%notmath))) - ((sup) - (content-model . [((%text) - include-space - ((%in-text-ignore)) - nil)]) - (overrides . - ((w3-p-d-shortref-chars t . "\{_^") - (w3-p-d-shortrefs t . (("\\^" . "</sup>") - ("_" . "<sub>") - ("{" . "<box>")))))) - ((sub) - (content-model . [((%text) - include-space - ((%in-text-ignore)) - nil)]) - (overrides . - ((w3-p-d-shortref-chars t . "\{_^") - (w3-p-d-shortrefs t . (("\\^" . "<sup>") - ("_" . "</sub>") - ("{" . "<box>")))))) - ((box) - (content-model . [((%formula) - include-space - (((left) *include 1) - ((over atop choose) *include 2) - ((right) *include 3)) - nil) - ((%formula) - include-space - (((over atop choose) *include 2) - ((right) *include 3)) - nil) - ((%formula) - include-space - (((right) *include 3)) - nil) - ((%formula) include-space nil nil)]) - (overrides . - ((w3-p-d-shortref-chars t . "{}_^") - (w3-p-d-shortrefs t . (("\\^" . "<sup>") - ("_" . "<sub>") - ("{" . "<box>") - ("}" . "</box>")))))) - ((above below %mathvec t bt sqrt) - (content-model . [((%formula) include-space nil nil)])) - ;; ROOT has a badly-specified content-model in HTML 3.0. - ((root) - (content-model . [((%formula) - include-space - (((of) *include *next)) - nil) - ((%formula) include-space nil nil)])) - ((of) - (content-model . [((%formula) include-space nil nil)]) - ;; There is no valid way to infer a missing end-tag for OF. This - ;; is bizarre. - (end-tag-omissible . t)) - ((array) - (content-model . [((row) nil nil nil)])) - ((row) - (content-model . [((item) nil (((row) *close)) nil)]) - (end-tag-omissible . t)) - ((item) - (content-model . [((%formula) - include-space - (((row item) *close)) - nil)]) - (end-tag-omissible . t)) - ;; The old parser would look for the </EMBED> end-tag and include - ;; the contents between <EMBED> and </EMBED> as the DATA attribute - ;; of the EMBED start-tag. However, it did not require the - ;; </EMBED> end-tag and did nothing if it was missing. This is - ;; completely impossible to specify in SGML. - ;; - ;; See - ;; <URL:http://www.eit.com/goodies/lists/www.lists/www-html.1995q3/0603.html> - ;; - ;; Questions: Does EMBED require the end-tag? How does NOEMBED fit - ;; into this? Where can EMBED appear? - ;; - ;; Nov. 25 1995: a new spec for EMBED (also an I-D): - ;; <URL:http://www.cs.princeton.edu/~burchard/www/interactive/> - ;; - ;; Here is my guess how to code EMBED: - ((embed) - (content-model . [((noembed) nil nil (*close))])) - ((noembed) - (content-model . [((%body.content) ; hack hack hack - nil - (((%text) p)) - nil)])) - ;; - ;; FRAMESET is a Netscape thing. - ;; <URL:http://www.eit.com/goodies/lists/www.lists/www-html.1995q3/0588.html> - ((frameset) - (content-model . [((noframes frame frameset) nil nil nil)])) - ((noframes) - (content-model . [((%body.content) - nil - ;; Push <P> before data characters. Non-SGML. - (((%text) p)) - nil)])) - ((frame) - (content-model . EMPTY)) - ;; - ;; APPLET is a Java thing. - ;; OBJECT is a cougar thing - ;; <URL:http://java.sun.com/JDK-beta/filesinkit/README> - ((applet object) - ;; I really don't want to add another ANY content-model. - (content-model . XINHERIT) - (inclusions . (param))) - ((param) - (content-model . EMPTY)) - ;; backward compatibility with old Java. - ((app) - (content-model . EMPTY)) - ;; Client-side image maps. - ;; <URL:ftp://ds.internic.net/internet-drafts/draft-seidman-clientsideimagemap-01.txt> - ;; *** The only problem is that I don't know in what elements MAP - ;; can appear, so none of this is reachable yet. - ((map) - (content-model . [((area) nil nil nil)])) - ((area) - (content-model . EMPTY)) - ))))) - - -;;; -;;; Omitted tag inference using state transition tables. -;;; - -(eval-when-compile - - (w3-p-s-var-def w3-p-s-includep) - (w3-p-s-var-def w3-p-s-state-transitions) - (w3-p-s-var-def w3-p-s-transition) - (w3-p-s-var-def w3-p-s-tran-list) - (w3-p-s-var-def w3-p-s-content-model) - (w3-p-s-var-def w3-p-s-except) - (w3-p-s-var-def w3-p-s-baseobject) - (w3-p-s-var-def w3-p-s-btdt) - ;; Uses free variables: - ;; w3-p-d-current-element, w3-p-d-exceptions - ;; Destroys free variables: - ;; w3-p-s-includep, w3-p-s-state-transitions, w3-p-s-transition, - ;; w3-p-s-tran-list, w3-p-s-content-model, w3-p-s-except - ;; Returns t if the element or data characters should be included. - ;; Returns nil if the element or data characters should be discarded. - (defsubst w3-grok-tag-or-data (tag-name) - (while - (cond - ((symbolp (setq w3-p-s-content-model - (w3-element-content-model w3-p-d-current-element))) - (or (and (memq w3-p-s-content-model - '(CDATA RCDATA XCDATA XXCDATA)) - (memq tag-name '(*data *space))) - ;; *** Implement ANY. - (error "impossible content model lossage")) - (setq w3-p-s-includep t) - ;; Exit loop. - nil) - (t - ;; We have a complex content model. - ;; Cache some data from the element info structure. Format is: - ;; (INCLUDES INCSPACEP (((TAG ...) . TRANSITION) ...) DEFAULT) - (setq w3-p-s-state-transitions - (aref w3-p-s-content-model - (w3-element-state w3-p-d-current-element))) - - ;; Optimize the common cases. - (cond - ((eq '*space tag-name) - ;; Optimizing the (*space *discard *same nil) transition. - (setq w3-p-s-includep (car (cdr w3-p-s-state-transitions))) - ;; Don't loop. - nil) - ((and (not (setq w3-p-s-except - (assq tag-name w3-p-d-exceptions))) - (memq tag-name (car w3-p-s-state-transitions))) - ;; Equivalent to a transition of (TAG *include *same nil). - ;; So we are done, return t to caller. - (setq w3-p-s-includep t) - ;; Exit loop. - nil) - (t - ;; The general case. - (cond - ;; Handle inclusions and exclusions. - (w3-p-s-except - (setq w3-p-s-transition (cdr w3-p-s-except))) - ;; See if the transition is in the complex transitions - ;; component. - ((progn - (setq w3-p-s-tran-list - (car (cdr (cdr w3-p-s-state-transitions)))) - (setq w3-p-s-transition nil) - (while w3-p-s-tran-list - (cond ((memq tag-name (car (car w3-p-s-tran-list))) - ;; We've found a transition. - (setq w3-p-s-transition - (cdr (car w3-p-s-tran-list))) - (setq w3-p-s-tran-list nil)) - (t - (setq w3-p-s-tran-list (cdr w3-p-s-tran-list))))) - ;; Check if we found it. - w3-p-s-transition) - ;; body of cond clause empty - ) - ;; Try finding the transition in the DEFAULT component of the - ;; transition table, but avoid doing this for unknown elements, - ;; always use the default-default for them. - ((and (or (eq '*data tag-name) - (w3-known-element-p tag-name)) - (setq w3-p-s-transition - (nth 3 w3-p-s-state-transitions))) - ;; body of cond clause empty - ) - (t - ;; Supply a default-default transition. - (if (not (or (eq '*data tag-name) - (w3-known-element-p tag-name))) - (setq w3-p-s-transition - '(*discard *same "unknown element")) - - ;; Decide whether to *close or *discard - ;; based on whether this element would be - ;; accepted as valid in an open ancestor. - (let ((open-list w3-p-d-open-element-stack) - (all-end-tags-omissible - (w3-element-end-tag-omissible w3-p-d-current-element)) - state-transitions tran-list) - (if (catch 'found - (while open-list - (setq state-transitions - (aref (w3-element-content-model - (car open-list)) - (w3-element-state (car open-list)))) - (if (memq tag-name (car state-transitions)) - (throw 'found t)) - (setq tran-list (nth 2 state-transitions)) - (while tran-list - (cond ((memq tag-name (car (car tran-list))) - (if (not (nth 3 (car tran-list))) - ;; Not an error transition. - (throw 'found t)) - (setq tran-list nil)) - (t - (setq tran-list (cdr tran-list))))) - ;; The input item is not accepted in this - ;; ancestor. Try again in next ancestor. - (or (w3-element-end-tag-omissible (car open-list)) - (setq all-end-tags-omissible nil)) - (setq open-list (cdr open-list))) - nil) - (setq w3-p-s-transition - (if (w3-element-end-tag-omissible - w3-p-d-current-element) - (if all-end-tags-omissible - ;; Probably indicates a need to debug - ;; the DTD state-transition tables. - '(*close *same - "missing transition in DTD?") - ;; Error will be reported later. - '(*close *same)) - '(*close *same "not allowed here"))) - (setq w3-p-s-transition - '(*discard *same "not allowed here"))))))) - - ;; We have found a transition to take. The transition is of - ;; the format (ACTION NEW-STATE ERRORP) where the latter two - ;; items are optional. - - ;; First, handle any state-change. - (or (memq (car-safe (cdr w3-p-s-transition)) '(nil *same)) - (w3-set-element-state - w3-p-d-current-element - (if (eq '*next (car-safe (cdr w3-p-s-transition))) - (1+ (w3-element-state w3-p-d-current-element)) - (car-safe (cdr w3-p-s-transition))))) - - ;; Handle any error message. - (if (car-safe (cdr-safe (cdr w3-p-s-transition))) - (w3-debug-html - :mandatory-if (and (eq '*data tag-name) - (eq '*discard (car w3-p-s-transition))) - (format "Bad %s [%s], %s" - (if (eq '*data tag-name) - "data characters" - (concat "start-tag " - (w3-sgml-name-to-string tag-name))) - (if (stringp (car (cdr (cdr w3-p-s-transition)))) - (car (cdr (cdr w3-p-s-transition))) - "not allowed here") - (let ((action (car w3-p-s-transition))) - (cond ((eq '*discard action) - "discarding bad item") - ((eq '*close action) - (concat "inferring </" - (w3-sgml-name-to-string - (w3-element-name - w3-p-d-current-element)) - ">")) - ((eq '*include action) - "including bad item anyway") - ((eq '*retry action) - "*retry ??? you shouldn't see this") - (t - (concat "inferring <" - (w3-sgml-name-to-string action) - ">"))))))) - - ;; Handle the action. - (cond - ((eq '*include (car w3-p-s-transition)) - (setq w3-p-s-includep t) - ;; Exit loop. - nil) - ((eq '*close (car w3-p-s-transition)) - ;; Perform end-tag inference. - (w3-close-element) ; don't pass parameter - ;; Loop and try again in parent element's content-model. - t) - ((eq '*discard (car w3-p-s-transition)) - (setq w3-p-s-includep nil) - ;; Exit loop. - nil) - ((eq '*retry (car w3-p-s-transition)) - ;; Loop and try again after state change. - t) - ((symbolp (car w3-p-s-transition)) - ;; We need to open another element to contain the text, - ;; probably a <P> (look in the state table). - (w3-open-element (car w3-p-s-transition) nil) - ;; Now we loop and try again in the new element's - ;; content-model. - t) - (t - (error "impossible transition"))))))) - - ;; Empty while loop body. - ) - - ;; Return value to user indicating whether to include or discard item: - ;; t ==> include - ;; nil ==> discard - w3-p-s-includep) - - ) - - -;;; -;;; Main parser. -;;; - -(defvar w3-last-parse-tree nil - "Used for debugging only. Stores the most recently computed parse tree -\(a tree, not a parse tag stream\).") - -(defun w3-display-parse-tree (&optional ptree) - (interactive) - (with-output-to-temp-buffer "W3 HTML Parse Tree" - (set-buffer standard-output) - (emacs-lisp-mode) - (require 'pp) - (pp (or ptree w3-last-parse-tree)))) - -(defalias 'w3-display-last-parse-tree 'w3-display-parse-tree) - -;; For compatibility with the old parser interface. -(defalias 'w3-preparse-buffer 'w3-parse-buffer) - -;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -;; % % -;; % This is the *ONLY* valid entry point in this file! % -;; % DO NOT call any of the other functions! % -;; % % -;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -(defun w3-parse-buffer (&optional buff) - "Parse contents of BUFF as HTML. -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 - - ;; Some unknown pre-parse buffer munging. - (if (fboundp 'sera-to-fidel-marker) - (let ((sera-being-called-by-w3 t)) - ;; eval stops the compiler from complaining. - (eval '(sera-to-fidel-marker)))) - (goto-char (point-min)) - - ;; *** Should premunge line boundaries. - ;; ******************** - - (let* ( - ;; Speed hack, see the variable doc string. - (gc-cons-threshold (if (> w3-gc-cons-threshold-multiplier 0) - (* w3-gc-cons-threshold-multiplier - gc-cons-threshold) - gc-cons-threshold)) - - ;; Used to determine if we made any progress since the last loop. - (last-loop-start (point-min)) - - ;; How many iterations of the main loop have occurred. Used only - ;; to send messages to the user periodically, since this function - ;; can take some time. - (loop-count 0) - - ;; Precomputing the loop-invariant parts of this for speed. - (status-message-format - (if url-show-status - (format "Parsed %%3d%%%% of %d..." (- (point-max) (point-min))))) - - ;; Use a float value for 100 if possible, otherwise integer. - ;; Determine which we can use outside of the loop for speed. - (one-hundred (funcall (if (fboundp 'float) 'float 'identity) 100)) - - ;; The buffer which contains the HTML we are parsing. This - ;; variable is used to avoid using the more expensive - ;; save-excursion. - (parse-buffer (current-buffer)) - - ;; Points to start of region of text since the previous tag. - (between-tags-start (point-min)) - - ;; Points past end of region of text since the previous tag. Only - ;; non-nil when the region has been completely determined and is - ;; ready to be processed. - between-tags-end - - ;; See doc string. - w3-p-d-tag-name - - ;; See doc string. - w3-p-d-end-tag-p - - ;; Is the tag we are looking at a null-end-tag-enabling - ;; start-tag? - net-tag-p - - ;; Attributes of the tag we are looking at. An alist whose items - ;; are pairs of the form (SYMBOL . STRING). - tag-attributes - - ;; Points past end of attribute value we are looking at. Points - ;; past the syntactic construct, not the value of the attribute, - ;; which may be at (1- attribute-value-end). - attribute-value-end - - ;; Points past end of tag we are looking at. - tag-end - - ;; See doc string. - (w3-p-d-current-element (w3-fresh-element-for-tag '*document)) - - ;; See doc string. - (w3-p-d-open-element-stack (list (w3-fresh-element-for-tag '*holder))) - - ;; ***not implemented yet*** - (marked-section-undo-stack nil) - - ;; See doc string. - (w3-p-d-debug-url t) - - ;; Any of the following variables with the comment ";*NESTED*" - ;; are syntactic or semantic features that were introduced by - ;; some containing element or marked section which will be undone - ;; when we close that element or marked section. - - ;; See doc string. - (w3-p-d-non-markup-chars nil) ;*NESTED* - - ;; See doc string. - (w3-p-d-null-end-tag-enabled nil) ;*NESTED* - - ;; See doc string. - (w3-p-d-in-parsed-marked-section nil) ;*NESTED* - - ;; See doc string. - (w3-p-d-shortrefs nil) ;*NESTED* - - ;; See doc string. - (w3-p-d-shortref-chars nil) ;*NESTED* - - ;; ******* maybe not needed. - ;; - ;; ;; Are we recognizing start-tags? - ;; (recognizing-start-tags t) ;*NESTED* - ;; - ;; ;; Are we recognizing end-tags? If this is non-nil and not t, - ;; ;; then only the end tag of the current open element is - ;; ;; recognized. - ;; (recognizing-end-tags t) ;*NESTED* - - ;; See doc string. - (w3-p-d-exceptions nil) ;*NESTED* - - ;; Scratch variables used in this function - ref attr-name attr-value content-model content open-list - ) - ;; Scratch variables used by macros and defsubsts we call. - (w3-p-s-let-bindings - (w3-update-non-markup-chars) - (setq w3-p-s-baseobject (url-generic-parse-url (url-view-url t))) - ;; Main loop. Handle markup as follows: - ;; - ;; non-empty tag: Handle the region since the previous tag as PCDATA, - ;; RCDATA, CDATA, if allowed by syntax. Then handle the tag. - ;; - ;; general entity (&name;): expand it and parse the result. - ;; - ;; shortref (_, {, }, and ^ in math stuff): Expand it and parse the - ;; result. - ;; - ;; SGML marked section (<![ keywords [ conditional-text ]]>): Either - ;; strip the delimiters and parse the result or delete. - ;; - ;; comment: Delete. - ;; - ;; empty tag (<>, </>): Handle as the appropriate tag. - ;; - ;; markup declaration (e.g. <!DOCTYPE ...>): Delete. - ;; - ;; SGML processing instruction (<?name>): Delete. - ;; - (while - ;; Continue as long as we processed something last time and we - ;; have more to process. - (prog1 - (not (and (= last-loop-start (point)) - (eobp))) - (setq last-loop-start (point))) - - ;; Display progress messages if asked and/or do incremental display - ;; of results - (cond ((= 0 (% (setq loop-count (1+ loop-count)) 40)) - (if status-message-format - (message status-message-format - ;; Percentage of buffer processed. - (/ (* (point) one-hundred) (point-max)))))) - - ;; Go to next interesting thing in the buffer. - (skip-chars-forward w3-p-d-non-markup-chars) - - ;; We are looking at a markup-starting character, and invalid - ;; character, or end of buffer. - (cond - - ((eq ?< (char-after (point))) - - ;; We are looking at a tag, comment, markup declaration, SGML marked - ;; section, SGML processing instruction, or non-markup "<". - (forward-char) - (cond - - ((looking-at "/?\\([a-z][-a-z0-9.]*\\)") - ;; We are looking at a non-empty tag. - - ;; Downcase it in the buffer, to save creation of a string - (downcase-region (match-beginning 1) (match-end 1)) - (setq w3-p-d-tag-name - (intern (buffer-substring (match-beginning 1) - (match-end 1)))) - (setq w3-p-d-end-tag-p (eq ?/ (char-after (point))) - between-tags-end (1- (point))) - (goto-char (match-end 0)) - - ;; Read the attributes from a start-tag. - (if w3-p-d-end-tag-p - (if (looking-at "[ \t\r\n/]*[<>]") - nil - ;; This is in here to deal with those idiots who stick - ;; attribute/value pairs on end tags. *sigh* - (w3-debug-html "Evil attributes on end tag.") - (skip-chars-forward "^>")) - - ;; Attribute values can be: - ;; "STRING" where STRING does not contain the double quote - ;; 'STRING' where STRING does not contain the single quote - ;; name-start character, *name character - ;; *name character - ;; Digit, +name character - ;; +Digit - ;; or a SPACE-separated list of one of the last four - ;; possibilities (there is a comment somewhere that this is a - ;; misinterpretation of the grammar, so we ignore this - ;; possibility). - (while - (looking-at - (eval-when-compile - (concat - ;; Leading whitespace. - "[ \n\r\t]*" - ;; The attribute name, possibly with a bad syntax - ;; component. - "\\([a-z_][-a-z0-9.]*\\(\\([_][-a-z0-9._]*\\)?\\)\\)" - ;; Trailing whitespace and perhaps an "=". - "[ \n\r\t]*\\(\\(=[ \n\r\t]*\\)?\\)"))) - - (cond ((/= (match-beginning 2) (match-end 2)) - (w3-debug-html - :nocontext - (format "Bad attribute name syntax: %s" - (buffer-substring (match-beginning 1) - (match-end 1)))))) - - ;; Downcase it in the buffer, to save creation of a string - (downcase-region (match-beginning 1) (match-end 1)) - (setq attr-name - (intern (buffer-substring (match-beginning 1) - (match-end 1)))) - (goto-char (match-end 0)) - (cond - ((< (match-beginning 4) (match-end 4)) - ;; A value was specified (e.g. ATTRIBUTE=VALUE). - (cond - ((looking-at - (eval-when-compile - (concat - ;; Literal with double quotes. - "\"\\([^\"]*\\)\"" - "\\|" - ;; Literal with single quotes. - "'\\([^']*\\)'" - "\\|" - ;; Handle bad HTML conflicting with NET-enabling - ;; start-tags. - "\\([-a-z0-9.]+/[-a-z0-9._/#]+\\)[ \t\n\r>]" - "\\|" - ;; SGML NAME-syntax attribute value. - "\\([-a-z0-9.]+\\)[ \t\n\r></]" - ))) - (cond - ((or (match-beginning 1) - (match-beginning 2)) - ;; We have an attribute value literal. - (narrow-to-region (1+ (match-beginning 0)) - (1- (match-end 0))) - - ;; In attribute value literals, EE and RS are ignored - ;; and RE and SEPCHAR characters sequences are - ;; replaced by SPACEs. - ;; - ;; (There is no way right now to get RS into one of - ;; these so that it can be ignored. This is due to - ;; our using Unix line-handling conventions.) - (skip-chars-forward "^&\t\n\r") - (if (eobp) - nil - ;; We must expand entities and replace RS, RE, - ;; and SEPCHAR. - (goto-char (point-min)) - (while (progn - (skip-chars-forward "^&") - (not (eobp))) - (w3-expand-entity-at-point-maybe)) - (subst-char-in-region (point-min) (point-max) ?\t ? ) - (subst-char-in-region (point-min) (point-max) ?\n ? )) - ;; Set this after we have changed the size of the - ;; attribute. - (setq attribute-value-end (1+ (point-max)))) - ((match-beginning 4) - (setq attribute-value-end (match-end 4)) - (narrow-to-region (point) attribute-value-end)) - ((match-beginning 3) - (setq attribute-value-end (match-end 3)) - (narrow-to-region (point) attribute-value-end) - ;; Horribly illegal non-SGML handling of bad - ;; HTML on the net. This can break valid HTML. - (setq attr-value (buffer-substring (point) - (match-end 3))) - (w3-debug-html :nocontext - (format "Evil attribute value syntax: %s" - (buffer-substring (point-min) (point-max))))) - (t - (error "impossible attribute value")))) - ((memq (char-after (point)) '(?\" ?')) - ;; Missing terminating quote character. - (narrow-to-region (point) - (progn - (forward-char 1) - (skip-chars-forward "^ \t\n\r'\"<>") - (setq attribute-value-end (point)))) - (w3-debug-html :nocontext - (format "Attribute value missing end quote: %s" - (buffer-substring (point-min) (point-max)))) - (narrow-to-region (1+ (point-min)) (point-max))) - (t - ;; We have a syntactically invalid attribute value. Let's - ;; make a best guess as to what the author intended. - (narrow-to-region (point) - (progn - (skip-chars-forward "^ \t\n\r'\"<>") - (setq attribute-value-end (point)))) - (w3-debug-html :nocontext - (format "Bad attribute value syntax: %s" - (buffer-substring (point-min) (point-max)))))) - ;; Now we have isolated the attribute value. We need to - ;; munge the value depending on the syntax of the - ;; attribute. - ;; *** Right now, we only implement the necessary munging - ;; for CDATA attributes, which is none. I'm not sure why - ;; this happens to work for other attributes right now. - ;; For any other kind of attribute, we are supposed to - ;; * smash case - ;; * remove leading/trailing whitespace - ;; * smash multiple space sequences into single spaces - ;; * verify the syntax of each token - (setq attr-value (buffer-substring (point-min) (point-max))) - (case attr-name - (class - (setq attr-value (split-string attr-value "[ ,]+"))) - (align - (if (string-match "^[ \t\r\n]*\\(.*\\)[ \t\r\n]*$" - attr-value) - (setq attr-value (downcase - (substring attr-value - (match-beginning 1) - (match-end 1)))) - (setq attr-value (downcase attr-value))) - (setq attr-value (intern attr-value))) - ((src href) - ;; I should expand URLs here - ) - (otherwise nil) - ) - (widen) - (goto-char attribute-value-end)) - (t - ;; No value was specified, in which case NAME should be - ;; taken as ATTRIBUTE=NAME where NAME is one of the - ;; enumerated values for ATTRIBUTE. - ;; We assume here that ATTRIBUTE is the same as NAME. - ;; *** Another piece of code will fix the attribute name if it - ;; is wrong. - (setq attr-value (symbol-name attr-name)))) - - ;; Accumulate the attributes. - (setq tag-attributes (cons (cons attr-name attr-value) - tag-attributes))) - - (if (and (eq w3-p-d-tag-name 'img) - (not (assq 'alt tag-attributes))) - (w3-debug-html :bad-style - :outer - "IMG element has no ALT attribute")) - (cond - ((and (eq w3-p-d-tag-name 'base) - (setq w3-p-s-baseobject - (or (assq 'src tag-attributes) - (assq 'href tag-attributes)))) - (setq w3-p-s-baseobject (url-generic-parse-url - (cdr w3-p-s-baseobject)))) - ((setq w3-p-s-btdt (or (assq 'src tag-attributes) - (assq 'href tag-attributes) - (assq 'action tag-attributes))) - (setcdr w3-p-s-btdt (url-expand-file-name (cdr w3-p-s-btdt) - w3-p-s-baseobject)) - (setq w3-p-s-btdt (if (url-have-visited-url (cdr w3-p-s-btdt)) - ":visited" - ":link")) - (if (assq 'class tag-attributes) - (setcdr (assq 'class tag-attributes) - (cons w3-p-s-btdt - (cdr (assq 'class tag-attributes)))) - (setq tag-attributes (cons (cons 'class (list w3-p-s-btdt)) - tag-attributes)))) - ) - (if (not (eq w3-p-d-tag-name 'input)) - nil - (setq w3-p-s-btdt (concat ":" - (downcase - (or (cdr-safe - (assq 'type tag-attributes)) - "text")))) - (if (assq 'class tag-attributes) - (setcdr (assq 'class tag-attributes) - (cons w3-p-s-btdt - (cdr (assq 'class tag-attributes)))) - (setq tag-attributes (cons (cons 'class (list w3-p-s-btdt)) - tag-attributes)))) - ) - - ;; Process the end of the tag. - (skip-chars-forward " \t\n\r") - (cond ((eq ?> (char-after (point))) - ;; Ordinary tag end. - (forward-char 1)) - ((and (eq ?/ (char-after (point))) - (not w3-p-d-end-tag-p)) - ;; This is a NET-enabling start-tag. - (setq net-tag-p t) - (forward-char 1)) - ((eq ?< (char-after (point))) - ;; *** Strictly speaking, the following text has to - ;; lexically be STAGO or ETAGO, which means that it - ;; can't match some other lexical unit. - ;; Unclosed tag. - nil) - (t - ;; Syntax error. - (w3-debug-html - (format "Bad unclosed %s%s tag" - (if w3-p-d-end-tag-p "/" "") - (w3-sgml-name-to-string w3-p-d-tag-name))))) - - (setq tag-end (point))) - - ((looking-at "/?>") - ;; We are looking at an empty tag (<>, </>). - (setq w3-p-d-end-tag-p (eq ?/ (char-after (point)))) - (setq w3-p-d-tag-name (if w3-p-d-end-tag-p - (w3-element-name w3-p-d-current-element) - ;; *** Strictly speaking, if OMITTAG NO, then - ;; we should use the most recently closed tag. - ;; But OMITTAG YES in HTML and I'm lazy. - (w3-element-name w3-p-d-current-element))) - (setq tag-attributes nil) - ;; *** Make sure this is not at top level. - (setq between-tags-end (1- (point))) - (setq tag-end (match-end 0))) - - ;; *** In SGML, <(doctype)element> is valid tag syntax. This - ;; cannot occur in HTML because the CONCUR option is off in the - ;; SGML declaration. - - ((looking-at "!--") - ;; We found a comment, delete to end of comment. - (delete-region - (1- (point)) - (progn - (forward-char 1) - ;; Skip over pairs of -- ... --. - (if (looking-at "\\(--[^-]*\\(-[^-]+\\)*--[ \t\r\n]*\\)+>") - (goto-char (match-end 0)) - ;; Syntax error! - (w3-debug-html - "Bad comment (unterminated or unbalanced \"--\" pairs)") - (forward-char 2) - (or (re-search-forward "--[ \t\r\n]*>" nil t) - (search-forward ">" nil t))) - (point)))) - - ((looking-at "!>\\|\\?[^>]*>") - ;; We are looking at an empty comment or a processing - ;; instruction. Delete it. - (replace-match "") - (delete-char -1)) - - ((looking-at "![a-z]") - ;; We are looking at a markup declaration. Delete it. - ;; *** Technically speaking, to handle valid HTML I think we - ;; need to handle "<!USEMAP ... >" declarations. In the future, - ;; to handle general SGML, we should parse "<!DOCTYPE ... >" - ;; declarations as well (which can contain other declarations). - ;; In the very distant future, perhaps we will handle "<!SGML - ;; ... >" declarations. - ;; *** Should warn if it's not SGML, DOCTYPE, or USEMAP. - (backward-char 1) - (delete-region - (point) - (progn - (condition-case nil - (forward-sexp 1) - (error - ;; *** This might not actually be bad syntax, but might - ;; instead be a -- ... -- comment with unbalanced - ;; parentheses somewhere inside the declaration. Handling - ;; this properly would require full parsing of markup - ;; declarations, a goal for the future. - (w3-debug-html "Bad <! syntax.") - (skip-chars-forward "^>") - (if (eq ?> (char-after (point))) - (forward-char)))) - (point)))) - - ((looking-at "!\\\[\\(\\([ \t\n\r]*[a-z]+\\)+[ \t\n\r]*\\)\\\[") - ;; We are looking at a marked section. - ;; *** Strictly speaking, we should issue a warning if the - ;; keywords are invalid or missing or if the "[" does not follow. - ;; We must look at the keywords to understand how to parse it. - ;; *** Strictly speaking, we should perform parameter entity - ;; substitution on the keywords first. - (goto-char (match-beginning 1)) - (insert ?\)) - (goto-char (1- (match-beginning 0))) - (delete-char 3) - (insert ?\() - (backward-char 1) - (let* ((keywords (read (current-buffer))) - ;; Multiple keywords may appear, but only the most - ;; significant takes effect. Rank order is IGNORE, CDATA, - ;; RCDATA, INCLUDE, and TEMP. INCLUDE and TEMP have the - ;; same effect. - (keyword (car-safe (cond ((memq 'IGNORE keywords)) - ((memq 'CDATA keywords)) - ((memq 'RCDATA keywords)) - ((memq 'INCLUDE keywords)) - ((memq 'TEMP keywords)))))) - (or (eq ?\[ (char-after (point))) - ;; I probably shouldn't even check this, since it is so - ;; impossible. - (error "impossible ??")) - (forward-char 1) - (delete-region (1- (match-beginning 0)) (point)) - (cond ((eq 'IGNORE keyword) - ;; Scan forward skipping over matching <![ ... ]]> - ;; until we find an unmatched "]]>". - (let ((ignore-nesting 1) - (start-pos (point))) - (while (> ignore-nesting 0) - (if (re-search-forward "<!\\\\\[\\|\]\]>" nil t) - (setq ignore-nesting - (if (eq ?> (preceding-char)) - (1- ignore-nesting) - (1+ ignore-nesting))) - (w3-debug-html - "Unterminated IGNORE marked section.") - (setq ignore-nesting 0) - (goto-char start-pos))) - (delete-region start-pos (point)))) - ((eq 'CDATA keyword) - (error "***unimplemented***")) - ((eq 'RCDATA keyword) - (error "***unimplemented***")) - ((memq keyword '(INCLUDE TEMP)) - (error "***unimplemented***"))))) - ((and (looking-at "!") - w3-netscape-compatible-comments) - ;; Horribly illegal non-SGML handling of bad HTML on the net. - ;; This can break valid HTML. - ;; This arises because Netscape discards anything looking like - ;; "<!...>". So people expect they can use this construct as - ;; a comment. - (w3-debug-html "Evil <! comment syntax.") - (backward-char 1) - (delete-region - (point) - (progn - (skip-chars-forward "^>") - (if (eq ?> (char-after (point))) - (forward-char)) - (point)))) - (t - ;; This < is not a markup character. Pretend we didn't notice - ;; it at all. We have skipped over the < already, so just loop - ;; again. - ))) - - ((eq ?& (char-after (point))) - (w3-expand-entity-at-point-maybe)) - - ((and (eq ?\] (char-after (point))) - w3-p-d-in-parsed-marked-section - (looking-at "]]>")) - ;; *** handle the end of a parsed marked section. - (error "***unimplemented***")) - - ((and (eq ?/ (char-after (point))) - w3-p-d-null-end-tag-enabled) - ;; We are looking at a null end tag. - (setq w3-p-d-end-tag-p t) - (setq between-tags-end (point)) - (setq tag-end (1+ (point))) - (setq w3-p-d-tag-name (w3-element-name w3-p-d-current-element))) - - ;; This can be slow, since we'll hardly ever get here. - ;; *** Strictly speaking, I think we're supposed to handle - ;; shortrefs that begin with the same characters as other markup, - ;; preferring the longest match. - ;; I will assume that shortrefs never begin with <, &, \], /. - ((setq ref (catch 'found-shortref - (let ((refs w3-p-d-shortrefs)) - (while refs - (if (looking-at (car (car refs))) - (throw 'found-shortref (cdr (car refs)))) - (setq refs (cdr refs)))))) - ;; We are looking at a shortref for which there is an - ;; expansion defined in the current syntax. Replace with the - ;; expansion, leaving point at the beginning so it will be parsed - ;; on the next loop. - ;; *** eek. This is wrong if the shortref is for an entity with - ;; CDATA syntax which should not be reparsed for tags. - (replace-match "") - (let ((pt (point))) - (insert ref) - (goto-char pt))) - - ((looking-at (eval-when-compile - (concat "[" (w3-invalid-sgml-chars) "]"))) - (w3-debug-html - (format "Invalid SGML character: %c" (char-after (point)))) - (insert (or (cdr-safe (assq (char-after (point)) - ;; These characters are apparently - ;; from a Windows character set. - '((146 . "'") - (153 . "TM")))) - "")) - (delete-char 1)) - - ((eobp) - ;; We have finished the buffer. Make sure we process the last - ;; piece of text, if any. - (setq between-tags-end (point)) - ;; We have to test what's on the element stack because this - ;; piece of code gets executed twice. - (cond ((not (eq '*holder (w3-element-name w3-p-d-current-element))) - ;; This forces the calculation of implied omitted end tags. - (setq w3-p-d-tag-name '*document) - (setq w3-p-d-end-tag-p t) - (setq tag-end (point))))) - - (t - (error "unreachable code, this can't happen"))) - - ;; If we have determined the boundaries of a non-empty between-tags - ;; region of text, then handle it. - (cond - (between-tags-end - (cond - ((< between-tags-start between-tags-end) - ;; We have a non-empty between-tags region. - - ;; We check if it's entirely whitespace, because we record the - ;; transitions for whitespace separately from those for - ;; data with non-whitespace characters. - (goto-char between-tags-start) - (skip-chars-forward " \t\n\r" between-tags-end) - (cond - ((w3-grok-tag-or-data (prog1 - (if (= between-tags-end (point)) - '*space - '*data) - (goto-char between-tags-end))) - ;; We have to include the text in the current element's - ;; contents. If this is the first item in the current - ;; element's contents, don't include a leading newline if - ;; there is one. Add a trailing newline as a separate text - ;; item so that it can be removed later if it turns out to - ;; be the last item in the current element's contents when - ;; the current element is closed. - ;; *** We could perform this test before calling - ;; w3-grok-tag-or-data, but it's not clear which will be - ;; faster in practice. - (or (setq content (w3-element-content w3-p-d-current-element)) - ;; *** Strictly speaking, in SGML the record end is - ;; carriage return, not line feed. - (if (eq ?\n (char-after between-tags-start)) - (setq between-tags-start (1+ between-tags-start)))) - (if (= between-tags-start (point)) - ;; Do nothing. - nil - ;; We are definitely going to add data characters to the - ;; content. - (cond - ((and (= ?\n (preceding-char)) - (/= between-tags-start (1- (point)))) - (setq content (cons (buffer-substring between-tags-start - (1- (point))) - content)) - (setq content (cons "\n" content))) - (t - (setq content (cons (buffer-substring between-tags-start - (point)) - content)))) - (w3-set-element-content w3-p-d-current-element content)))))) - - (setq between-tags-end nil))) - - ;; If the previous expression modified (point), then it went to - ;; the value of between-tags-end. - - ;; If we found a start or end-tag, we need to handle it. - (cond - (w3-p-d-tag-name - - ;; Move past the tag and prepare for next between-tags region. - (goto-char tag-end) - (setq between-tags-start (point)) - - (cond - (w3-p-d-end-tag-p - ;; Handle an end-tag. - (if (eq w3-p-d-tag-name (w3-element-name w3-p-d-current-element)) - (w3-close-element) - ;; Handle the complex version. We have to search up (down?) - ;; the open element stack to find the element that matches (if - ;; any). Then we close all of the elements. On a conforming - ;; SGML document this can do no wrong and it's not - ;; unreasonable on a non-conforming document. - - ;; Can't safely modify stack until we know the element we want - ;; to find is in there, so work with a copy. - (setq open-list w3-p-d-open-element-stack) - (while (and open-list - (not (eq w3-p-d-tag-name - (w3-element-name (car open-list))))) - (setq open-list (cdr open-list))) - (cond (open-list - ;; We found a match. Pop elements. - ;; We will use the following value as a sentinel. - (setq open-list (cdr open-list)) - (while (not (eq open-list w3-p-d-open-element-stack)) - (w3-close-element t)) - (w3-close-element)) - (t - ;; Bogus end tag. - (w3-debug-html - (format "Unmatched end-tag </%s>" - (w3-sgml-name-to-string w3-p-d-tag-name))))))) - (t - ;; Handle a start-tag. - (cond - ;; Check if the new element is allowed in the current element's - ;; content model. - ((w3-grok-tag-or-data w3-p-d-tag-name) - (w3-open-element w3-p-d-tag-name tag-attributes) - - ;; Handle NET-enabling start tags. - (cond ((and net-tag-p - (not w3-p-d-null-end-tag-enabled)) - ;; Save old values. - (w3-set-element-undo-list - w3-p-d-current-element - (cons (cons 'w3-p-d-non-markup-chars - w3-p-d-non-markup-chars) - (cons '(w3-p-d-null-end-tag-enabled . nil) - (w3-element-undo-list w3-p-d-current-element)))) - ;; Alter syntax. - (setq w3-p-d-null-end-tag-enabled t) - (w3-update-non-markup-chars))) - - (setq content-model - (w3-element-content-model w3-p-d-current-element)) - - ;; If the element does not have parsed contents, then we - ;; can find its contents immediately. - (cond - ((memq content-model '(EMPTY CDATA XCDATA XXCDATA RCDATA)) - (cond - ((eq 'EMPTY content-model) - (w3-close-element)) - ((eq 'CDATA content-model) - ;; CDATA: all data characters until an end-tag. We'll - ;; process the end-tag on the next loop. - (if (re-search-forward (if w3-p-d-null-end-tag-enabled - "</[a-z>]\\|/" - "</[a-z>]") - nil 'move) - (goto-char (match-beginning 0)))) - ((eq 'XCDATA content-model) - ;; XCDATA: special non-SGML-standard mode which includes - ;; all data characters until "</foo" is seen where "foo" - ;; is the name of this element (for XMP and LISTING). - (if (search-forward - (concat "</" (symbol-name - (w3-element-name w3-p-d-current-element))) - nil 'move) - (goto-char (match-beginning 0)))) - ((eq 'XXCDATA content-model) - ;; XXCDATA: special non-SGML-standard mode which includes - ;; all data until end-of-entity (end-of-buffer for us) - ;; (for PLAINTEXT). - (goto-char (point-max))) - ((eq 'RCDATA content-model) - ;; RCDATA: all data characters until end-tag is seen, - ;; except that entities are expanded first, although the - ;; expansions are _not_ scanned for end-tags, although the - ;; expansions _are_ scanned for further entity - ;; references. - (while (progn - (if (re-search-forward (if w3-p-d-null-end-tag-enabled - "</[a-z>]\\|[/&]" - "</[a-z>]\\|&") - nil 'move) - (goto-char (match-beginning 0))) - (eq ?& (char-after (point)))) - (w3-expand-entity-at-point-maybe))))))) - (t - ;; The element is illegal here. We'll just discard the start - ;; tag as though we never saw it. - )))) - - (setq w3-p-d-tag-name nil) - (setq w3-p-d-end-tag-p nil) - (setq net-tag-p nil) - (setq tag-attributes nil) - (setq tag-end nil))) - - ;; End of main while loop. - ) - - ;; We have finished parsing the buffer! - (if status-message-format - (message "%sdone" (format status-message-format 100))) - - ;; *** For debugging, save the true parse tree. - ;; *** Make this look inside *DOCUMENT. - (setq w3-last-parse-tree - (w3-element-content w3-p-d-current-element)) - - (w3-element-content w3-p-d-current-element) - ))) - - - -(provide 'w3-parse) - -;; Local variables: -;; indent-tabs-mode: nil -;; end: diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-prefs.el --- a/lisp/w3/w3-prefs.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,645 +0,0 @@ -;;; w3-prefs.el --- Preferences panels for Emacs-W3 -;; Author: wmperry -;; Created: 1997/04/24 15:41:27 -;; Version: 1.24 -;; Keywords: hypermedia, preferences - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Preferences panels for Emacs-W3 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'w3-vars) -(require 'w3-keyword) -(require 'w3-toolbar) -(eval-and-compile - (require 'w3-widget)) - -(defvar w3-preferences-panel-begin-marker nil) -(defvar w3-preferences-panel-end-marker nil) -(defvar w3-preferences-panels '( - (appearance . "Appearance") - (images . "Images") - (cookies . "HTTP Cookies") - (hooks . "Various Hooks") - (compatibility . "Compatibility") - (proxy . "Proxy") - (privacy . "Privacy"))) - -(defun w3-preferences-generic-variable-callback (widget &rest ignore) - (condition-case () - (set (widget-get widget 'variable) (widget-value widget)) - (error (message "Invalid or incomplete data...")))) - -(defun w3-preferences-restore-variables (vars) - (let ((temp nil)) - (while vars - (setq temp (intern (format "w3-preferences-temp-%s" (car vars)))) - (set (car vars) (symbol-value temp)) - (if (fboundp 'custom-set-variables) - (eval (` (custom-set-variables '((, (car vars)) (quote (, (symbol-value temp))) t))))) - (setq vars (cdr vars))))) - -(defun w3-preferences-create-temp-variables (vars) - (let ((temp nil)) - (while vars - (setq temp (intern (format "w3-preferences-temp-%s" (car vars)))) - (set (make-local-variable temp) (symbol-value (car vars))) - (setq vars (cdr vars))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Appearance of the frame / pages -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-preferences-init-appearance-panel () - (let ((vars '(w3-toolbar-orientation - w3-use-menus - w3-honor-stylesheets - w3-default-stylesheet - w3-default-homepage - w3-toolbar-type)) - (temp nil)) - (set (make-local-variable 'w3-preferences-temp-use-home-page) - (and w3-default-homepage t)) - (w3-preferences-create-temp-variables vars))) - -(defun w3-preferences-create-appearance-panel () - ;; First the toolbars - (widget-insert "\nToolbars\n--------\n") - (widget-insert "\tShow Toolbars as:\t") - (widget-put - (widget-create 'radio - :value (symbol-value 'w3-preferences-temp-w3-toolbar-type) - :notify 'w3-preferences-generic-variable-callback - :format "%v" - (list 'item :format "%t\t" :tag "Pictures" :value 'pictures) - (list 'item :format "%t\t" :tag "Text" :value 'text) - (list 'item :format "%t" :tag "Both" :value 'both)) - 'variable 'w3-preferences-temp-w3-toolbar-type) - (widget-insert "\n\tToolbars appear on ") - (widget-put - (widget-create 'choice - :value (symbol-value 'w3-preferences-temp-w3-toolbar-orientation) - :notify 'w3-preferences-generic-variable-callback - :format "%v" - :tag "Toolbar Position" - (list 'choice-item :format "%[%t%]" :tag "XEmacs Default" :value 'default) - (list 'choice-item :format "%[%t%]" :tag "Top" :value 'top) - (list 'choice-item :format "%[%t%]" :tag "Bottom" :value 'bottom) - (list 'choice-item :format "%[%t%]" :tag "Right" :value 'right) - (list 'choice-item :format "%[%t%]" :tag "Left" :value 'left) - (list 'choice-item :format "%[%t%]" :tag "No Toolbar" :value 'none)) - 'variable 'w3-preferences-temp-w3-toolbar-orientation) - (widget-insert " side of window.\n") - - ;; Home page - (widget-insert "\nStartup\n--------\n\tBrowser starts with:\t") - (widget-put - (widget-create - 'radio - :format "%v" - :value (symbol-value 'w3-preferences-temp-use-home-page) - :notify 'w3-preferences-generic-variable-callback - (list 'item :format "%t\t" :tag "Blank Page" :value nil) - (list 'item :format "%t" :tag "Home Page Location" :value t)) - 'variable 'w3-preferences-temp-use-home-page) - (widget-insert "\n\t\tURL: ") - (widget-put - (widget-create - 'editable-field - :value (or (symbol-value 'w3-preferences-temp-w3-default-homepage) "None") - :notify 'w3-preferences-generic-variable-callback) - 'variable 'w3-preferences-temp-w3-default-homepage) - - ;; Stylesheet - (widget-insert "\nStyle\n--------\n\tDefault stylesheet:\t") - (widget-put - (widget-create - 'file - :value (or (symbol-value 'w3-preferences-temp-w3-default-stylesheet) "") - :must-match t - :notify 'w3-preferences-generic-variable-callback) - 'variable 'w3-preferences-temp-w3-default-stylesheet) - (widget-setup) - ) - -(defun w3-preferences-save-appearance-panel () - (let ((vars '(w3-toolbar-orientation - w3-use-menus - w3-honor-stylesheets - w3-default-stylesheet - w3-toolbar-type)) - (temp nil)) - (if (symbol-value 'w3-preferences-temp-use-home-page) - (setq vars (cons 'w3-default-homepage vars)) - (setq w3-default-homepage nil)) - (w3-preferences-restore-variables vars) - (w3-toolbar-make-buttons))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The images panel -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-preferences-init-images-panel () - (let ((vars '(w3-delay-image-loads - w3-image-mappings))) - (w3-preferences-create-temp-variables vars))) - -(defun w3-preferences-create-images-panel () - (widget-insert "\n") - (widget-put - (widget-create - 'checkbox - :notify 'w3-preferences-generic-variable-callback - :value (symbol-value 'w3-preferences-temp-w3-delay-image-loads)) - 'variable 'w3-preferences-temp-w3-delay-image-loads) - (widget-insert " Delay Image Loads\n" - )) - -(defun w3-preferences-save-images-panel () - (let ((vars '(w3-delay-image-loads - w3-image-mappings))) - (w3-preferences-restore-variables vars))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The cookies panel -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-preferences-init-cookies-panel () - (let ((cookies url-cookie-storage) - (secure-cookies url-cookie-secure-storage)) - ) - ) - -(defun w3-preferences-create-cookies-panel () - (widget-insert "\n\t\tSorry, not yet implemented.\n\n")) - -(defun w3-preferences-save-cookies-panel () - ) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The hooks panel -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-preferences-hooks-variables - '(w3-load-hook - w3-mode-hook - w3-preferences-cancel-hook - w3-preferences-default-hook - w3-preferences-ok-hook - w3-preferences-setup-hook - w3-source-file-hook)) - -(defun w3-preferences-init-hooks-panel () - (w3-preferences-create-temp-variables w3-preferences-hooks-variables)) - -(defun w3-preferences-create-hooks-panel () - (let ((todo w3-preferences-hooks-variables) - (cur nil) - (pt nil) - (doc nil)) - (widget-insert "\n") - (while todo - (setq cur (car todo) - todo (cdr todo) - doc (documentation-property cur 'variable-documentation)) - (if (string-match "^\\*" doc) - (setq doc (substring doc 1 nil))) - (setq pt (point)) - (widget-insert "\n" (symbol-name cur) " - " doc) - (fill-region-as-paragraph pt (point)) - (setq cur (intern (format "w3-preferences-temp-%s" cur))) - (widget-put - (widget-create - 'sexp - :notify 'w3-preferences-generic-variable-callback - :value (or (symbol-value cur) "nil")) - 'variable cur)) - (widget-setup))) - -(defun w3-preferences-save-hooks-panel () - (w3-preferences-restore-variables w3-preferences-hooks-variables)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The compatibility panel -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-preferences-compatibility-variables - '( - (w3-netscape-compatible-comments - . "Allow Netscape compatible comments") - (w3-user-colors-take-precedence - . "Ignore netscape document color control") - (url-honor-refresh-requests - . "Allow Netscape `Client Pull'")) - "A list of variables that the preferences compability pane knows about.") - -(defun w3-preferences-init-compatibility-panel () - (let ((compat w3-preferences-compatibility-variables) - (cur nil) - (var nil)) - (w3-preferences-create-temp-variables - (mapcar 'car w3-preferences-compatibility-variables)))) - -(defun w3-preferences-create-compatibility-panel () - (let ((compat w3-preferences-compatibility-variables) - (cur nil) - (var nil)) - (widget-insert "\n") - (while compat - (setq cur (car compat) - compat (cdr compat) - var (intern (format "w3-preferences-temp-%s" (car cur)))) - (widget-put - (widget-create 'checkbox - :notify 'w3-preferences-generic-variable-callback - :value (symbol-value var)) - 'variable var) - (widget-insert " " (cdr cur) "\n\n")) - (widget-setup))) - -(defun w3-preferences-save-compatibility-panel () - (w3-preferences-restore-variables - (mapcar 'car w3-preferences-compatibility-variables))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The proxy configuration panel -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-preferences-init-proxy-panel () - (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News")) - (proxy nil) - (host-var nil) - (port-var nil) - (host nil) - (port nil) - (proxy-entry nil)) - (widget-insert "\n") - (while proxies - (setq proxy (car proxies) - proxies (cdr proxies) - host-var (intern (format "w3-%s-proxy-host" (downcase proxy))) - port-var (intern (format "w3-%s-proxy-port" (downcase proxy))) - proxy-entry (cdr-safe (assoc (downcase proxy) url-proxy-services))) - (if (and proxy-entry (string-match "\\(.*\\):\\([0-9]+\\)" proxy-entry)) - (setq host (match-string 1 proxy-entry) - port (match-string 2 proxy-entry)) - (setq host proxy-entry - port nil)) - (set (make-local-variable host-var) (or host "")) - (set (make-local-variable port-var) (or port "")))) - (set (make-local-variable 'w3-preferences-temp-no-proxy) - (cdr-safe (assoc "no_proxy" url-proxy-services)))) - -(defun w3-preferences-create-proxy-panel () - (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News")) - (proxy nil) - (host-var nil) - (port-var nil) - (urlobj nil)) - (widget-insert "\n") - (while proxies - (setq proxy (car proxies) - proxies (cdr proxies) - host-var (intern (format "w3-%s-proxy-host" (downcase proxy))) - port-var (intern (format "w3-%s-proxy-port" (downcase proxy)))) - (widget-insert (format "%10s Proxy: " proxy)) - (widget-put - (widget-create 'editable-field - :size 20 - :value-face 'underline - :notify 'w3-preferences-generic-variable-callback - :value (format "%-20s" (symbol-value host-var))) - 'variable host-var) - (widget-insert " Port: ") - (widget-put - (widget-create 'editable-field - :size 5 - :value-face 'underline - :notify 'w3-preferences-generic-variable-callback - :value (format "%5s" (symbol-value port-var))) - 'variable port-var) - (widget-insert "\n\n")) - (widget-insert " No proxy: ") - (widget-put - (widget-create 'editable-field - :size 40 - :value-face 'underline - :notify 'w3-preferences-generic-variable-callback - :value (or (symbol-value 'w3-preferences-temp-no-proxy) "")) - 'variable 'w3-preferences-temp-no-proxy) - (widget-setup))) - -(defun w3-preferences-save-proxy-panel () - (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News")) - (proxy nil) - (host-var nil) - (port-var nil) - (urlobj nil) - (host nil) - (port nil) - (new-proxy-services nil)) - (if (/= 0 (length (symbol-value 'w3-preferences-temp-no-proxy))) - (setq new-proxy-services (cons - (cons - "no_proxy" - (symbol-value 'w3-preferences-temp-no-proxy)) - new-proxy-services))) - (while proxies - (setq proxy (car proxies) - proxies (cdr proxies) - host-var (intern (format "w3-%s-proxy-host" (downcase proxy))) - port-var (intern (format "w3-%s-proxy-port" (downcase proxy))) - urlobj (url-generic-parse-url - (cdr-safe - (assoc (downcase proxy) url-proxy-services))) - host (symbol-value host-var) - port (symbol-value port-var)) - (if (and host (/= 0 (length host))) - (setq new-proxy-services (cons (cons (downcase proxy) - (format "%s:%s" host - (or port "80"))) - new-proxy-services)))) - (setq url-proxy-services new-proxy-services))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Privacy panel -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defsubst w3-preferences-privacy-bits-sort (bits) - (sort bits (function (lambda (a b) - (memq b (memq a '(email os lastloc agent cookie))))))) - -(defvar url-valid-privacy-levels - '((paranoid . (email os lastloc agent cookie)) - (high . (email lastloc)) - (low . (lastloc)) - (none . nil))) - -(defvar w3-preferences-privacy-bit-widgets nil) -(defvar w3-preferences-privacy-level-widget nil) -(defvar w3-preferences-temp-url-privacy-level nil) -;; darnit i just noticed the checklist widget, this should probably be -;; reimplemented with that instead of checkboxes, but i've almost finished. -(defun w3-preferences-privacy-bit-callback (widget &rest ignore) - (let ((privacy-bits (if (listp w3-preferences-temp-url-privacy-level) - w3-preferences-temp-url-privacy-level - (copy-list (cdr-safe (assq w3-preferences-temp-url-privacy-level url-valid-privacy-levels))))) - (bit (widget-get widget 'bit)) - (val (widget-value widget))) - (if val - (setq privacy-bits (delq bit privacy-bits)) - (setq privacy-bits (w3-preferences-privacy-bits-sort (cons bit (delq bit privacy-bits))))) - (setq w3-preferences-temp-url-privacy-level - (or (car (rassoc privacy-bits url-valid-privacy-levels)) - privacy-bits)) - (widget-value-set w3-preferences-privacy-level-widget - (if (listp w3-preferences-temp-url-privacy-level) - 'custom - w3-preferences-temp-url-privacy-level)) - )) - - -(defun w3-preferences-privacy-level-callback (widget &rest ignore) - (let* ((val (widget-value widget)) - (privacy-bits (cdr-safe (assq val url-valid-privacy-levels)))) - (if (eq val 'custom) nil - (setq w3-preferences-temp-url-privacy-level val) - (mapcar (function (lambda (bit) - (widget-value-set (cdr bit) - (not (memq (car bit) - privacy-bits))))) - w3-preferences-privacy-bit-widgets)) - )) - -(defun w3-preferences-init-privacy-panel () - (w3-preferences-create-temp-variables '(url-privacy-level - url-cookie-confirmation)) - (setq w3-preferences-privacy-bit-widgets nil) - (setq w3-preferences-privacy-level-widget nil)) - -(defsubst w3-preferences-create-privacy-bit-widget (bit bit-text current-bits) - (let ((bit-widget (widget-create - 'checkbox - :value (not (memq bit current-bits)) - :notify 'w3-preferences-privacy-bit-callback - ))) - (widget-put bit-widget 'bit bit) - (setq w3-preferences-privacy-bit-widgets (cons (cons bit bit-widget) - w3-preferences-privacy-bit-widgets)) - (widget-insert " " bit-text "\n"))) - - -(defun w3-preferences-create-privacy-panel () - (let ((privacy-bits (if (listp url-privacy-level) - url-privacy-level - (cdr-safe (assq url-privacy-level url-valid-privacy-levels))))) - (widget-insert "\n") - (widget-insert "General Privacy Level: ") - ;;; XXX something is weird with case folding in the following widget if you - ;;; type an option in lower case it accepts it but doesn't do anything - (setq w3-preferences-privacy-level-widget - (widget-create - 'choice - :value (if (listp w3-preferences-temp-url-privacy-level) - 'custom - w3-preferences-temp-url-privacy-level) - :notify 'w3-preferences-privacy-level-callback - :format "%v" - :tag "Privacy Level" - (list 'choice-item :format "%[%t%]" :tag "Paranoid" :value 'paranoid) - (list 'choice-item :format "%[%t%]" :tag "High" :value 'high) - (list 'choice-item :format "%[%t%]" :tag "Low" :value 'low) - (list 'choice-item :format "%[%t%]" :tag "None" :value 'none) - (list 'choice-item :format "%[%t%]" :tag "Custom" :value 'custom))) - (widget-put w3-preferences-privacy-level-widget 'variable 'w3-preferences-temp-url-privacy-level) - - (widget-insert "\n(controls the options below)\n\nSend the following information with each request:\n") - (setq w3-preferences-privacy-bit-widgets nil) - (w3-preferences-create-privacy-bit-widget 'email "E-mail address" privacy-bits) - (w3-preferences-create-privacy-bit-widget 'lastloc "Last location visited" privacy-bits) - (w3-preferences-create-privacy-bit-widget 'os "Operating system information" privacy-bits) - (w3-preferences-create-privacy-bit-widget 'agent "User agent information" privacy-bits) - (w3-preferences-create-privacy-bit-widget 'cookie "Accept cookies" privacy-bits) - (widget-insert " ") - (widget-put - (widget-create - 'checkbox - :value (symbol-value 'w3-preferences-temp-url-cookie-confirmation) - :notify 'w3-preferences-generic-variable-callback) - 'variable 'w3-preferences-temp-url-cookie-confirmation) - (widget-insert " Ask before accepting cookies\n")) - (widget-setup)) - -(defun w3-preferences-save-privacy-panel () - (w3-preferences-restore-variables '(url-privacy-level - url-cookie-confirmation)) - (url-setup-privacy-info)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-preferences-create-panel (panel) - (let ((func (intern (format "w3-preferences-create-%s-panel" panel))) - (inhibit-read-only t)) - (goto-char w3-preferences-panel-begin-marker) - (delete-region w3-preferences-panel-begin-marker - w3-preferences-panel-end-marker) - (set-marker-insertion-type w3-preferences-panel-end-marker t) - (if (fboundp func) - (funcall func) - (insert (format "You should be seeing %s right now.\n" panel)))) - (set-marker-insertion-type w3-preferences-panel-end-marker nil) - (set-marker w3-preferences-panel-end-marker (point)) - (goto-char w3-preferences-panel-begin-marker) - (condition-case () - (widget-forward 1) - (error nil))) - -(defun w3-preferences-notify (widget widget-ignore &optional event) - (let* ((glyph (and event w3-running-xemacs (event-glyph event))) - (x (and glyph (widget-glyphp glyph) (event-glyph-x-pixel event))) - (y (and glyph (widget-glyphp glyph) (event-glyph-y-pixel event))) - (map (widget-get widget 'usemap)) - (value (widget-value widget))) - (if (and map x y) - (setq value (w3-point-in-map (vector x y) map))) - (if value - (w3-preferences-create-panel value)))) - -(defun w3-preferences-save-options () - (w3-menu-save-options)) - -(defun w3-preferences-ok-callback (widget &rest ignore) - (let ((panels w3-preferences-panels) - (buffer (current-buffer)) - (func nil)) - (run-hooks 'w3-preferences-ok-hook) - (while panels - (setq func (intern - (format "w3-preferences-save-%s-panel" (caar panels))) - panels (cdr panels)) - (if (fboundp func) - (funcall func))) - (if (fboundp 'custom-save-variables) - (custom-save-variables)) - (w3-preferences-save-options) - (message "Options saved") - (sit-for 1) - (kill-buffer (current-buffer)))) - -(defun w3-preferences-reset-all-panels () - (let ((panels w3-preferences-panels) - (func nil)) - (while panels - (setq func (intern (format "w3-preferences-init-%s-panel" - (caar panels))) - panels (cdr panels)) - (if (and func (fboundp func)) - (funcall func))))) - -(defun w3-preferences-cancel-callback (widget &rest ignore) - (if (not (funcall url-confirmation-func "Cancel and lose all changes? ")) - (error "Not cancelled!")) - (w3-preferences-reset-all-panels) - (kill-buffer (current-buffer)) - (run-hooks 'w3-preferences-cancel-hook)) - -(defun w3-preferences-reset-callback (widget &rest ignore) - (w3-preferences-reset-all-panels) - (run-hooks 'w3-preferences-default-hook) - (w3-preferences-create-panel (caar w3-preferences-panels))) - -(defvar w3-preferences-setup-hook nil - "*Hooks to be run before setting up the preferences buffer.") - -(defvar w3-preferences-cancel-hook nil - "*Hooks to be run when cancelling the preferences (Cancel was chosen).") - -(defvar w3-preferences-default-hook nil - "*Hooks to be run when resetting preference defaults (Defaults was chosen).") - -(defvar w3-preferences-ok-hook nil - "*Hooks to be run before saving the preferences (OK was chosen).") - -(defun w3-preferences-init-all-panels () - (let ((todo w3-preferences-panels) - (func nil)) - (while todo - (setq func (intern (format "w3-preferences-init-%s-panel" (caar todo))) - todo (cdr todo)) - (and (fboundp func) (funcall func))))) - -;;###autoload -(defun w3-preferences-edit () - (interactive) - (let* ((prefs-buffer (get-buffer-create "W3 Preferences")) - (widget nil) - (inhibit-read-only t) - (window-conf (current-window-configuration))) - (delete-other-windows) - (set-buffer prefs-buffer) - (set (make-local-variable 'widget-push-button-gui) nil) - (w3-preferences-init-all-panels) - (set-window-buffer (selected-window) prefs-buffer) - (make-local-variable 'widget-field-face) - (setq w3-preferences-panel-begin-marker (make-marker) - w3-preferences-panel-end-marker (make-marker)) - (set-marker-insertion-type w3-preferences-panel-begin-marker nil) - (set-marker-insertion-type w3-preferences-panel-end-marker t) - (use-local-map widget-keymap) - (erase-buffer) - (run-hooks 'w3-preferences-setup-hook) - (setq widget (apply 'widget-create 'menu-choice - :tag "Panel" - :notify 'w3-preferences-notify - :value 'appearance - (mapcar - (function - (lambda (x) - (list 'choice-item - :format "%[%t%]" - :tag (cdr x) - :value (car x)))) - w3-preferences-panels))) - (goto-char (point-max)) - (insert "\n\n") - (set-marker w3-preferences-panel-begin-marker (point)) - (set-marker w3-preferences-panel-end-marker (point)) - (w3-preferences-create-panel (caar w3-preferences-panels)) - (goto-char (point-max)) - (widget-insert "\n\n") - (widget-create 'push-button - :notify 'w3-preferences-ok-callback - :value "Ok") - (widget-insert " ") - (widget-create 'push-button - :notify 'w3-preferences-cancel-callback - :value "Cancel") - (widget-insert " ") - (widget-create 'push-button - :notify 'w3-preferences-reset-callback - :value "Reset") - (center-region (point-min) w3-preferences-panel-begin-marker) - (center-region w3-preferences-panel-end-marker (point-max)))) - -(provide 'w3-prefs) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-print.el --- a/lisp/w3/w3-print.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,82 +0,0 @@ -;;; w3-print.el --- Printing support for emacs-w3 -;; Author: wmperry -;; Created: 1997/04/02 21:09:14 -;; Version: 1.8 -;; Keywords: faces, help, printing, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-postscript-print-function 'ps-print-buffer-with-faces - "*Name of the function to use to print a buffer as PostScript. -This should take no arguments, and act on the current buffer. -Possible values include: -ps-print-buffer-with-faces - print immediately -ps-spool-buffer-with-faces - spool for later") - -(defun w3-print-this-url (&optional url format) - "Print out the current document (in LaTeX format)" - (interactive) - (if (not url) (setq url (url-view-url t))) - (let* ((completion-ignore-case t) - (format (or format - (completing-read - "Format: " - '(("HTML Source") ; The raw HTML code - ("Formatted Text") ; Plain ASCII rendition - ("PostScript") ; Pretty PostScript - ("LaTeX'd") ; LaTeX it, then print - ) - nil t)))) - (save-excursion - (cond - ((equal "HTML Source" format) - (if w3-current-source - (let ((x w3-current-source)) - (set-buffer (get-buffer-create url-working-buffer)) - (erase-buffer) - (insert x)) - (url-retrieve url)) - (lpr-buffer)) - ((or (equal "Formatted Text" format) - (equal "" format)) - (lpr-buffer)) - ((equal "PostScript" format) - (funcall w3-postscript-print-function)) - ((equal "LaTeX'd" format) - (w3-parse-tree-to-latex w3-current-parse url) - (save-window-excursion - (write-region (point-min) (point-max) - (expand-file-name "w3-tmp.latex" - w3-temporary-directory) nil 5) - (shell-command - (format - "cd %s ; latex w3-tmp.latex ; latex w3-tmp.latex ; %s w3-tmp.dvi ; rm -f w3-tmp*" - w3-temporary-directory - w3-print-command)) - (kill-buffer "*Shell Command Output*"))))))) - -(defun w3-print-url-under-point () - "Print out the url under point (in LaTeX format)" - (interactive) - (w3-print-this-url (w3-view-this-url t))) - -(provide 'w3-print) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-props.el --- a/lisp/w3/w3-props.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,93 +0,0 @@ -;;; w3-props.el --- Additional text property stuff -;; Author: wmperry -;; Created: 1997/04/22 14:50:19 -;; Version: 1.2 -;; Keywords: faces - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Additional text property functions. - -;; The following three text property functions are not generally available (and -;; it's not certain that they should be) so they are inlined for speed. -;; The case for `fillin-text-property' is simple; it may or not be generally -;; useful. (Since it is used here, it is useful in at least one place.;-) -;; However, the case for `append-text-property' and `prepend-text-property' is -;; more complicated. Should they remove duplicate property values or not? If -;; so, should the first or last duplicate item remain? Or the one that was -;; added? In our implementation, the first duplicate remains. - -(defsubst fillin-text-property (start end setprop markprop value &optional object) - "Fill in one property of the text from START to END. -Arguments PROP and VALUE specify the property and value to put where none are -already in place. Therefore existing property values are not overwritten. -Optional argument OBJECT is the string or buffer containing the text." - (let ((start (text-property-any start end markprop nil object)) next) - (while start - (setq next (next-single-property-change start markprop object end)) - (put-text-property start next setprop value object) - (put-text-property start next markprop value object) - (setq start (text-property-any next end markprop nil object))))) - -(defsubst w3-props-unique (list) - "Uniquify LIST, deleting elements using `delq'. -Return the list with subsequent duplicate items removed by side effects." - (let ((list list)) - (while list - (setq list (setcdr list (delq (car list) (cdr list)))))) - list) - -;; A generalisation of `facemenu-add-face' for any property, but without the -;; removal of inactive faces via `facemenu-discard-redundant-faces' and special -;; treatment of `default'. Uses `unique' to remove duplicate property values. -(defsubst prepend-text-property (start end prop value &optional object) - "Prepend to one property of the text from START to END. -Arguments PROP and VALUE specify the property and value to prepend to the value -already in place. The resulting property values are always lists, and unique. -Optional argument OBJECT is the string or buffer containing the text." - (let ((val (if (listp value) value (list value))) next prev) - (while (/= start end) - (setq next (next-single-property-change start prop object end) - prev (get-text-property start prop object)) - (put-text-property - start next prop - (w3-props-unique (append val (if (listp prev) prev (list prev)))) - object) - (setq start next)))) - -(defsubst append-text-property (start end prop value &optional object) - "Append to one property of the text from START to END. -Arguments PROP and VALUE specify the property and value to append to the value -already in place. The resulting property values are always lists, and unique. -Optional argument OBJECT is the string or buffer containing the text." - (let ((val (if (listp value) value (list value))) next prev) - (while (/= start end) - (setq next (next-single-property-change start prop object end) - prev (get-text-property start prop object)) - (put-text-property - start next prop - (w3-props-unique (append (if (listp prev) prev (list prev)) val)) - object) - (setq start next)))) - -(provide 'w3-props) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-script.el --- a/lisp/w3/w3-script.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,100 +0,0 @@ -;;; w3-script.el --- Scripting support -;; Author: wmperry -;; Created: 1997/03/20 14:22:28 -;; Version: 1.7 -;; Keywords: hypermedia, scripting - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1997 Free Software Foundation, Inc. -;;; -;;; 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 'cl) -(require 'w3-elisp) -(require 'w3-jscript) - -;; Event Handlers -;; onclick ; It was clicked on -;; onchange ; Text area was changed -;; onselect ; Menu choice changed -;; onmouseover ; Mouse is over us -;; onmouseout ; Mouse left us -;; onblur ; We lost focus -;; onfocus ; We gained focus -;; onload ; We got loaded -;; onunload ; We got unloaded -;; onreset ; Form got reset -;; onsubmit ; From is about to be submitted -;; onabort ; User cancelled loading an image -;; onerror ; Error occurred loading an image - -(defgroup w3-scripting nil - "When, where, how, and why to enable client-side scripting." - :group 'w3) - -(defcustom w3-do-scripting nil - "*Whether to handle client-side scripting or not. -If you are adventurous, set this to `t'" - :group 'w3-scripting - :type 'boolean) - -(defvar w3-current-scripting-language 'elisp) -(make-variable-buffer-local 'w3-current-scripting-language) - -(put 'form 'w3-event-handlers - '(onclick onchange onselect onblur onfocus onreset onsubmit)) - -(put 'mouse 'w3-event-handlers '(onmouseover onmouseout)) - -(put 'misc 'w3-event-handlers '(onload onunload)) - -(put 'all 'w3-event-handlers (append (get 'form 'w3-event-handlers) - (get 'mouse 'w3-event-handlers))) - -(defun w3-script-find-event-handlers (pt type) - (if w3-do-scripting - (let* ((html-stack (get-text-property pt 'html-stack)) - (args nil) - (rval nil) - (cur nil)) - (while html-stack - (setq args (cdr (pop html-stack))) - (while (setq cur (pop args)) - (if (memq (car cur) (get type 'w3-event-handlers)) - (setq rval (cons cur rval))))) - (nreverse rval)))) - -(defun w3-script-evaluate-form (f) - (if w3-do-scripting - (case w3-current-scripting-language - (elisp - (let ((st 0) - (form nil) - (max (length f))) - (condition-case () - (while (and (< st max) (setq form (read-from-string f st))) - (setq st (cdr form) - form (car form)) - (w3-elisp-safe-eval form)) - (error nil)))) - (otherwise - (message "Unimplemented scripting language: %S" - w3-current-scripting-language))))) - -(provide 'w3-script) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-speak.el --- a/lisp/w3/w3-speak.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,178 +0,0 @@ -;;; w3-speak.el,v --- Emacs-W3 speech interface -;; Author: wmperry -;; Original author: William Perry --<wmperry@cs.indiana.edu> -;; Cloned from emacspeak-w3.el -;; Created: 1996/10/16 20:56:40 -;; Version: 1.14 -;; Keywords: hypermedia, speech - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996 by T.V. Raman (raman@adobe.com) -;;; Copyright (c) 1996, 1997 by William M. Perry (wmperry@spry.com) -;;; Copyright (c) 1997 Free Software Foundation, Inc. -;;; -;;; This file is not part of GNU Emacs, but the same permissions apply. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; A replacement module for emacspeak-w3 that uses all the new functionality -;;; of Emacs-W3 3.0. -;;; -;;; This file would not be possible without the help of -;;; T.V. Raman (raman@adobe.com) and his continued efforts to make Emacs-W3 -;;; even remotely useful. :) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; This conforms to http://www4.inria.fr/speech2.html - -(require 'widget) -(require 'w3-forms) -(require 'advice) -;; This condition-case needs to be here or it completely chokes -;; byte-compilation for people who do not have Emacspeak installed. -;; *sigh* -(condition-case () - (progn - (require 'emacspeak) - (require 'dtk-voices) - (require 'emacspeak-speak) - (require 'emacspeak-sounds) - (eval-when (compile) - (require 'emacspeak-fix-interactive))) - (error (message "Emacspeak not found - speech will not work."))) - - -;;{{{ speaking form fields - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Now for the guts -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-speak-summarize-form-field () - "Summarizes field under point if any." - (let ((widget (widget-at (point)))) - (and widget (w3-form-summarize-field widget)))) - -;;}}} - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Movement notification -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defadvice w3-widget-forward (after emacspeak pre act comp) - (when (interactive-p) - (emacspeak-auditory-icon 'large-movement) - (emacspeak-widget-summarize (widget-at (point ))))) - -(defadvice w3-widget-backward (after emacspeak pre act comp) - (when (interactive-p) - (emacspeak-auditory-icon 'large-movement) - (emacspeak-widget-summarize (widget-at (point ))))) - -(defadvice w3-scroll-up (after emacspeak pre act comp) - "Provide auditory feedback" - (when (interactive-p) - (let ((start (point ))) - (emacspeak-auditory-icon 'scroll) - (save-excursion - (forward-line (window-height)) - (emacspeak-speak-region start (point )))))) - -(defadvice w3-revert-form (after emacspeak pre act) - "Announce that you cleared the form. " - (dtk-speak "Cleared the form. ")) - -(defadvice w3-finish-text-entry (after emacspeak pre act ) - "Announce what the field was set to." - (when (interactive-p) - (w3-speak-summarize-form-field))) - -(defadvice w3-start-of-document (after emacspeak pre act) - "Produce an auditory icon. Also speak the first line. " - (when (interactive-p) - (emacspeak-speak-line) - (emacspeak-auditory-icon 'large-movement))) - -(defadvice w3-end-of-document (after emacspeak pre act) - "Produce an auditory icon. Also speak the first line." - (when (interactive-p) - (emacspeak-speak-line) - (emacspeak-auditory-icon 'large-movement))) - -(defadvice w3-goto-last-buffer (after emacspeak pre act) - "Speak the modeline so I know where I am." - (when (interactive-p) - (emacspeak-auditory-icon 'select-object) - (emacspeak-speak-mode-line))) - -(defadvice w3-quit (after emacspeak pre act) - "Speak the mode line of the new buffer." - (when (interactive-p) - (emacspeak-auditory-icon 'close-object) - (emacspeak-speak-mode-line))) - -(defadvice w3-fetch (around emacspeak act comp ) - "First produce an auditory icon to indicate retrieval. -After retrieval, -set voice-lock-mode to t after displaying the buffer, -and then speak the mode-line. " - (declare (special dtk-punctuation-mode)) - (emacspeak-auditory-icon 'select-object) - ad-do-it) - -(defun w3-speak-mode-hook () - (set (make-local-variable 'voice-lock-mode) t) - (setq dtk-punctuation-mode "some") - (emacspeak-auditory-icon 'open-object) - (emacspeak-speak-mode-line)) - -;;; This is really the only function you should need to call unless -;;; you are adding functionality. -(defun w3-speak-use-voice-locking (&optional arg) - "Tells w3 to start using voice locking. -This is done by setting the w3 variables so that anchors etc are not marked by -delimiters. We then turn on voice-lock-mode. -Interactive prefix arg does the opposite. " - (interactive "P") - (declare (special w3-echo-link)) - (setq w3-echo-link 'text) - (if arg - (remove-hook 'w3-mode-hook 'w3-speak-mode-hook) - (add-hook 'w3-mode-hook 'w3-speak-mode-hook))) - -(defun w3-speak-browse-page () - "Browse a WWW page" - (interactive) - (emacspeak-audio-annotate-paragraphs) - (emacspeak-execute-repeatedly 'forward-paragraph)) - -(declaim (special w3-mode-map)) -(define-key w3-mode-map "." 'w3-speak-browse-page) - -(defvar url-speak-last-progress-indication 0 - "Caches when we last produced a progress auditory icon") - -(defadvice url-lazy-message (around emacspeak pre act) - "Provide pleasant auditory feedback about progress" - (declare (special url-speak-last-progress-indication )) - (let ((now (nth 1 (current-time)))) - (when (> now - (+ 3 url-speak-last-progress-indication)) - (setq url-speak-last-progress-indication now) - (apply 'message (ad-get-args 0)) - (emacspeak-auditory-icon 'progress)))) - -(provide 'w3-speak) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-style.el --- a/lisp/w3/w3-style.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,71 +0,0 @@ -;;; w3-style.el --- Emacs-W3 binding style sheet mechanism -;; Author: wmperry -;; Created: 1997/01/17 14:27:39 -;; Version: 1.25 -;; Keywords: faces, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; A style sheet mechanism for emacs-w3 -;;; -;;; This will eventually be able to under DSSSL[-lite] as well as the -;;; experimental W3C mechanism -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'font) -(require 'w3-keyword) -(require 'cl) -(require 'css) - - - -(defun w3-handle-style (&optional plist) - (let ((url (or (plist-get plist 'href) - (plist-get plist 'src) - (plist-get plist 'uri))) - (media (intern (downcase (or (plist-get plist 'media) "all")))) - (type (downcase (or (plist-get plist 'notation) "text/css"))) - (url-working-buffer " *style*") - (stylesheet nil) - (defines nil) - (cur-sheet w3-current-stylesheet) - (string (plist-get plist 'data))) - (if (not (memq media (css-active-device-types))) - nil ; Not applicable to us! - (save-excursion - (set-buffer (get-buffer-create url-working-buffer)) - (erase-buffer) - (setq url-be-asynchronous nil) - (cond - ((member type '("experimental" "arena" "w3c-style" "css" "text/css")) - (setq stylesheet (css-parse url string cur-sheet))) - (t - (w3-warn 'html "Unknown stylesheet notation: %s" type)))) - (setq w3-current-stylesheet stylesheet)))) - -(defun w3-display-stylesheet (&optional sheet) - (interactive) - (if (not sheet) (setq sheet w3-current-stylesheet)) - (css-display sheet)) - -(provide 'w3-style) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-sysdp.el --- a/lisp/w3/w3-sysdp.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,687 +0,0 @@ -;;; sysdep.el --- consolidate Emacs-version dependencies in one file. - -;; Copyright (c) 1995 - 1997 Ben Wing. - -;; Author: Ben Wing <wing@666.com>, William Perry <wmperry@cs.indiana.edu> -;; Keywords: lisp, tools -;; Version: 0.003 - -;; The purpose of this file is to eliminate the cruftiness that -;; would otherwise be required of packages that want to run on multiple -;; versions of Emacs. The idea is that we make it look like we're running -;; the latest version of XEmacs (currently 19.12) by emulating all the -;; missing functions. - -;; #### This file does not currently do any advising but should. -;; Unfortunately, advice.el is a hugely big package. Is any such -;; thing as `advice-lite' possible? - -;; #### - This package is great, but its role needs to be thought out a bit -;; more. Sysdep will not permit programs written for the old XEmacs API to -;; run on new versions of XEmacs. Sysdep is a backward-compatibility -;; package for the latest and greatest XEmacs API. It permits programmers -;; to use the latest XEmacs functionality and still have their programs run -;; on older versions of XEmacs...perhaps even on FSF Emacs. It should NEVER -;; ever need to be loaded in the newest XEmacs. It doesn't even make sense -;; to put it in the lisp/utils part of the XEmacs distribution because it's -;; real purpose is to be distributed with packages like w3 which take -;; advantage of the latest and greatest features of XEmacs but still need to -;; be run on older versions. --Stig - -;; Any packages that wish to use this file should load it using -;; `load-library'. It will not load itself if a version of sysdep.el -;; that is at least as recent has already been loaded, but will -;; load over an older version of sysdep.el. It will attempt to -;; not redefine functions that have already been custom-redefined, -;; but will redefine a function if the supplied definition came from -;; an older version of sysdep.el. - -;; Packages such as w3 that wish to include this file with the package -;; should rename it to something unique, such as `w3-sysdep.el', and -;; load it with `load-library'. That will ensure that no conflicts -;; arise if more than one package in the load path provides a version -;; of sysdep.el. If multiple packages load sysdep.el, the most recent -;; version will end up loaded; as long as I'm careful not to -;; introduce bugs in previously working definitions, this should work -;; fine. - -;; You may well discover deficiencies in this file as you use it. -;; The preferable way of dealing with this is to send me a patch -;; to sysdep.el; that way, the collective body of knowledge gets -;; increased. - -;; IMPORTANT: leave the version string in the format X.XXX (e.g. 1.001) -;; so that string comparisons to other versions work properly. - -(defconst sysdep-potential-version "0.003") - -;; this macro means: define the function, but only if either it -;; wasn't bound before, or the supplied binding comes from an older -;; version of sysdep.el. That way, user-supplied bindings don't -;; get overridden. - -;; note: sysdep-defalias is often more useful than this function, -;; esp. since you can do load-time conditionalizing and can -;; optionally leave the function undefined. (e.g. frame functions -;; in v18.) - -(defmacro sysdep-defun (function &rest everything-else) - (` (cond ((and (not (fboundp (quote (, function)))) - (or - (not - (stringp (get (quote (, function)) 'sysdep-defined-this))) - (and (get (quote (, function)) 'sysdep-defined-this) - (string-lessp - (get (quote (, function)) 'sysdep-defined-this) - sysdep-potential-version)))) - (put (quote (, function)) 'sysdep-defined-this - sysdep-potential-version) - (defun (, function) (,@ everything-else)))))) - -(defmacro sysdep-defvar (function &rest everything-else) - (` (cond ((and (not (boundp (quote (, function)))) - (or - (not - (stringp (get (quote (, function)) 'sysdep-defined-this))) - (and (get (quote (, function)) 'sysdep-defined-this) - (string-lessp - (get (quote (, function)) 'sysdep-defined-this) - sysdep-potential-version)))) - (put (quote (, function)) 'sysdep-defined-this t) - (defvar (, function) (,@ everything-else)))))) - -(defmacro sysdep-defconst (function &rest everything-else) - (` (cond ((and (not (boundp (quote (, function)))) - (or - (not - (stringp (get (quote (, function)) 'sysdep-defined-this))) - (and (get (quote (, function)) 'sysdep-defined-this) - (string-lessp - (get (quote (, function)) 'sysdep-defined-this) - sysdep-potential-version)))) - (put (quote (, function)) 'sysdep-defined-this t) - (defconst (, function) (,@ everything-else)))))) - -;; similar for fset and defalias. No need to quote as the argument -;; is already quoted. - -(defmacro sysdep-fset (function def) - (` (cond ((and (not (fboundp (, function))) - (or (not (stringp - (get (, function) 'sysdep-defined-this))) - (and (get (, function) 'sysdep-defined-this) - (string-lessp - (get (, function) 'sysdep-defined-this) - sysdep-potential-version))) - (, def)) - (put (, function) 'sysdep-defined-this t) - (fset (, function) (, def)))))) - -(defmacro sysdep-defalias (function def) - (` (cond ((and (not (fboundp (, function))) - (or (not (stringp - (get (, function) 'sysdep-defined-this))) - (and (get (, function) 'sysdep-defined-this) - (string-lessp - (get (, function) 'sysdep-defined-this) - sysdep-potential-version))) - (, def) - (or (listp (, def)) - (and (symbolp (, def)) - (fboundp (, def))))) - (put (, function) 'sysdep-defined-this t) - (defalias (, function) (, def)))))) - -;; bootstrapping: defalias and define-function don't exist -;; in older versions of lemacs - -(sysdep-fset 'defalias 'fset) -(sysdep-defalias 'define-function 'defalias) - -;; useful ways of determining what version is running -;; emacs-major-version and emacs-minor-version are -;; already defined in recent versions of FSF Emacs and XEmacs - -(sysdep-defconst emacs-major-version - ;; will string-match ever fail? If so, assume 19.0. - ;; (should we assume 18.something?) - (if (string-match "^[0-9]+" emacs-version) - (string-to-int - (substring emacs-version - (match-beginning 0) (match-end 0))) - 19)) - -(sysdep-defconst emacs-minor-version - (if (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version) - (string-to-int - (substring emacs-version - (match-beginning 1) (match-end 1))) - 0)) - -(sysdep-defconst sysdep-running-xemacs - (or (string-match "Lucid" emacs-version) - (string-match "XEmacs" emacs-version))) - -(sysdep-defconst window-system nil) -(sysdep-defconst window-system-version 0) - -(sysdep-defvar list-buffers-directory nil) -(sysdep-defvar x-library-search-path (` - ("/usr/X11R6/lib/X11/" - "/usr/X11R5/lib/X11/" - "/usr/lib/X11R6/X11/" - "/usr/lib/X11R5/X11/" - "/usr/local/X11R6/lib/X11/" - "/usr/local/X11R5/lib/X11/" - "/usr/local/lib/X11R6/X11/" - "/usr/local/lib/X11R5/X11/" - "/usr/X11/lib/X11/" - "/usr/lib/X11/" - "/usr/local/lib/X11/" - "/usr/X386/lib/X11/" - "/usr/x386/lib/X11/" - "/usr/XFree86/lib/X11/" - "/usr/unsupported/lib/X11/" - "/usr/athena/lib/X11/" - "/usr/local/x11r5/lib/X11/" - "/usr/lpp/Xamples/lib/X11/" - "/usr/openwin/lib/X11/" - "/usr/openwin/share/lib/X11/" - (, data-directory) - ) - ) - "Search path used for X11 libraries.") - -;; frame-related stuff. - -(sysdep-defalias 'buffer-dedicated-frame 'buffer-dedicated-screen) -(sysdep-defalias 'deiconify-frame - (cond ((fboundp 'deiconify-screen) 'deiconify-screen) - ;; make-frame-visible will be defined as necessary - (t 'make-frame-visible))) -(sysdep-defalias 'delete-frame 'delete-screen) -(sysdep-defalias 'event-frame 'event-screen) -(sysdep-defalias 'event-glyph-extent 'event-glyph) -(sysdep-defalias 'find-file-other-frame 'find-file-other-screen) -(sysdep-defalias 'find-file-read-only-other-frame - 'find-file-read-only-other-screen) -(sysdep-defalias 'frame-height 'screen-height) -(sysdep-defalias 'frame-iconified-p 'screen-iconified-p) -(sysdep-defalias 'frame-left-margin-width 'screen-left-margin-width) -(sysdep-defalias 'frame-list 'screen-list) -(sysdep-defalias 'frame-live-p - (cond ((fboundp 'screen-live-p) 'screen-live-p) - ((fboundp 'live-screen-p) 'live-screen-p) - ;; #### not sure if this is correct (this is for Epoch) - ;; but gnuserv.el uses it this way - ((fboundp 'screenp) 'screenp))) -(sysdep-defalias 'frame-name 'screen-name) -(sysdep-defalias 'frame-parameters 'screen-parameters) -(sysdep-defalias 'frame-pixel-height 'screen-pixel-height) -(sysdep-defalias 'frame-pixel-width 'screen-pixel-width) -(sysdep-defalias 'frame-right-margin-width 'screen-right-margin-width) -(sysdep-defalias 'frame-root-window 'screen-root-window) -(sysdep-defalias 'frame-selected-window 'screen-selected-window) -(sysdep-defalias 'frame-totally-visible-p 'screen-totally-visible-p) -(sysdep-defalias 'frame-visible-p 'screen-visible-p) -(sysdep-defalias 'frame-width 'screen-width) -(sysdep-defalias 'framep 'screenp) -(sysdep-defalias 'get-frame-for-buffer 'get-screen-for-buffer) -(sysdep-defalias 'get-frame-for-buffer-noselect 'get-screen-for-buffer-noselect) -(sysdep-defalias 'get-other-frame 'get-other-screen) -(sysdep-defalias 'iconify-frame 'iconify-screen) -(sysdep-defalias 'lower-frame 'lower-screen) -(sysdep-defalias 'mail-other-frame 'mail-other-screen) - -(sysdep-defalias 'make-frame - (cond ((fboundp 'make-screen) - (function (lambda (&optional parameters device) - (make-screen parameters)))) - ((fboundp 'x-create-screen) - (function (lambda (&optional parameters device) - (x-create-screen parameters)))))) - -(sysdep-defalias 'make-frame-invisible 'make-screen-invisible) -(sysdep-defalias 'make-frame-visible - (cond ((fboundp 'make-screen-visible) 'make-screen-visible) - ((fboundp 'mapraised-screen) 'mapraised-screen) - ((fboundp 'x-remap-window) - (lambda (&optional x) - (x-remap-window) - (accept-process-output))))) -(sysdep-defalias 'modify-frame-parameters 'modify-screen-parameters) -(sysdep-defalias 'new-frame 'new-screen) -(sysdep-defalias 'next-frame 'next-screen) -(sysdep-defalias 'next-multiframe-window 'next-multiscreen-window) -(sysdep-defalias 'other-frame 'other-screen) -(sysdep-defalias 'previous-frame 'previous-screen) -(sysdep-defalias 'previous-multiframe-window 'previous-multiscreen-window) -(sysdep-defalias 'raise-frame - (cond ((fboundp 'raise-screen) 'raise-screen) - ((fboundp 'mapraise-screen) 'mapraise-screen))) -(sysdep-defalias 'redraw-frame 'redraw-screen) -(sysdep-defalias 'select-frame 'select-screen) -(sysdep-defalias 'selected-frame 'selected-screen) -(sysdep-defalias 'set-buffer-dedicated-frame 'set-buffer-dedicated-screen) -(sysdep-defalias 'set-frame-height 'set-screen-height) -(sysdep-defalias 'set-frame-left-margin-width 'set-screen-left-margin-width) -(sysdep-defalias 'set-frame-position 'set-screen-position) -(sysdep-defalias 'set-frame-right-margin-width 'set-screen-right-margin-width) -(sysdep-defalias 'set-frame-size 'set-screen-size) -(sysdep-defalias 'set-frame-width 'set-screen-width) -(sysdep-defalias 'show-temp-buffer-in-current-frame 'show-temp-buffer-in-current-screen) -(sysdep-defalias 'switch-to-buffer-other-frame 'switch-to-buffer-other-screen) -(sysdep-defalias 'visible-frame-list 'visible-screen-list) -(sysdep-defalias 'window-frame 'window-screen) -(sysdep-defalias 'x-create-frame 'x-create-screen) -(sysdep-defalias 'x-set-frame-icon-pixmap 'x-set-screen-icon-pixmap) -(sysdep-defalias 'x-set-frame-pointer 'x-set-screen-pointer) -(sysdep-defalias 'x-display-color-p 'x-color-display-p) -(sysdep-defalias 'x-display-grayscale-p 'x-grayscale-display-p) -(sysdep-defalias 'menu-event-p 'misc-user-event-p) - -(sysdep-defun event-point (event) - (let ((posn (event-end event))) - (if posn - (posn-point posn)))) - -;; WMP - commenting these out so that Emacs 19 doesn't get screwed by them. -;; In particular, this makes the 'custom' package blow up quite well. -;;(sysdep-defun add-submenu (menu-path submenu &optional before) -;; "Add a menu to the menubar or one of its submenus. -;;If the named menu exists already, it is changed. -;;MENU-PATH identifies the menu under which the new menu should be inserted. -;; It is a list of strings; for example, (\"File\") names the top-level \"File\" -;; menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". -;; If MENU-PATH is nil, then the menu will be added to the menubar itself. -;;SUBMENU is the new menu to add. -;; See the documentation of `current-menubar' for the syntax. -;;BEFORE, if provided, is the name of a menu before which this menu should -;; be added, if this menu is not on its parent already. If the menu is already -;; present, it will not be moved." -;; (add-menu menu-path (car submenu) (cdr submenu) before)) - -;;(sysdep-defun add-menu-button (menu-path menu-leaf &optional before) -;; "Add a menu item to some menu, creating the menu first if necessary. -;;If the named item exists already, it is changed. -;;MENU-PATH identifies the menu under which the new menu item should be inserted. -;; It is a list of strings; for example, (\"File\") names the top-level \"File\" -;; menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". -;;MENU-LEAF is a menubar leaf node. See the documentation of `current-menubar'. -;;BEFORE, if provided, is the name of a menu item before which this item should -;; be added, if this item is not on the menu already. If the item is already -;; present, it will not be moved." -;; (add-menu-item menu-path (aref menu-leaf 0) (aref menu-leaf 1) -;; (aref menu-leaf 2) before)) - -(sysdep-defun make-glyph (&optional spec-list) - (if (and spec-list (cdr-safe (assq 'x spec-list))) - (make-pixmap (cdr-safe (assq 'x spec-list))))) - -(sysdep-defalias 'face-list 'list-faces) - -(sysdep-defun set-keymap-parent (keymap new-parent) - (let ((tail keymap)) - (while (and tail (cdr tail) (not (eq (car (cdr tail)) 'keymap))) - (setq tail (cdr tail))) - (if tail - (setcdr tail new-parent)))) - -;; Property list functions -;; -(sysdep-defun plist-put (plist prop val) - "Change value in PLIST of PROP to VAL. -PLIST is a property list, which is a list of the form -(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object. -If PROP is already a property on the list, its value is set to VAL, -otherwise the new PROP VAL pair is added. The new plist is returned; -use `(setq x (plist-put x prop val))' to be sure to use the new value. -The PLIST is modified by side effects." - (let ((node (memq prop plist))) - (if node - (setcar (cdr node) val) - (setq plist (cons prop (cons val plist)))) - plist)) - -(sysdep-defun plist-get (plist prop) - "Extract a value from a property list. -PLIST is a property list, which is a list of the form -(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value -corresponding to the given PROP, or nil if PROP is not -one of the properties on the list." - (while (and plist (not (eq (car plist) prop))) - (setq plist (cdr (cdr plist)))) - (and plist (car (cdr plist)))) - -;; Extent stuff -(sysdep-fset 'delete-extent 'delete-overlay) -(sysdep-fset 'extent-end-position 'overlay-end) -(sysdep-fset 'extent-start-position 'overlay-start) -(sysdep-fset 'set-extent-endpoints 'move-overlay) -(sysdep-fset 'set-extent-property 'overlay-put) -(sysdep-fset 'make-extent 'make-overlay) - -(sysdep-defun extent-property (extent property &optional default) - (or (overlay-get extent property) default)) - -(sysdep-defun extent-at (pos &optional object property before at-flag) - (let ((tmp (overlays-at (point))) - ovls) - (if property - (while tmp - (if (extent-property (car tmp) property) - (setq ovls (cons (car tmp) ovls))) - (setq tmp (cdr tmp))) - (setq ovls tmp - tmp nil)) - (car-safe - (sort ovls - (function - (lambda (a b) - (< (- (extent-end-position a) (extent-start-position a)) - (- (extent-end-position b) (extent-start-position b))))))))) - -(sysdep-defun overlays-in (beg end) - "Return a list of the overlays that overlap the region BEG ... END. -Overlap means that at least one character is contained within the overlay -and also contained within the specified region. -Empty overlays are included in the result if they are located at BEG -or between BEG and END." - (let ((ovls (overlay-lists)) - tmp retval) - (if (< end beg) - (setq tmp end - end beg - beg tmp)) - (setq ovls (nconc (car ovls) (cdr ovls))) - (while ovls - (setq tmp (car ovls) - ovls (cdr ovls)) - (if (or (and (<= (overlay-start tmp) end) - (>= (overlay-start tmp) beg)) - (and (<= (overlay-end tmp) end) - (>= (overlay-end tmp) beg))) - (setq retval (cons tmp retval)))) - retval)) - -(sysdep-defun map-extents (function &optional object from to - maparg flags property value) - (let ((tmp (overlays-in (or from (point-min)) - (or to (point-max)))) - ovls) - (if property - (while tmp - (if (extent-property (car tmp) property) - (setq ovls (cons (car tmp) ovls))) - (setq tmp (cdr tmp))) - (setq ovls tmp - tmp nil)) - (catch 'done - (while ovls - (setq tmp (funcall function (car ovls) maparg) - ovls (cdr ovls)) - (if tmp - (throw 'done tmp)))))) - -;; misc -(sysdep-fset 'make-local-hook 'make-local-variable) - -(sysdep-defun buffer-substring-no-properties (beg end) - "Return the text from BEG to END, without text properties, as a string." - (format "%s" (buffer-substring beg end))) - -(sysdep-defun symbol-value-in-buffer (symbol buffer &optional unbound-value) - "Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound." - (save-excursion - (set-buffer buffer) - (if (not (boundp symbol)) - unbound-value - (symbol-value symbol)))) - -(sysdep-defun insert-file-contents-literally - (file &optional visit beg end replace) - "Like `insert-file-contents', q.v., but only reads in the file. -A buffer may be modified in several ways after reading into the buffer due -to advanced Emacs features, such as file-name-handlers, format decoding, -find-file-hooks, etc. - This function ensures that none of these modifications will take place." - (let ((file-name-handler-alist nil) - (find-file-hooks nil)) - (insert-file-contents file visit beg end replace))) - -(sysdep-defun alist-to-plist (alist) - "Convert association list ALIST into the equivalent property-list form. -The plist is returned. This converts from - -\((a . 1) (b . 2) (c . 3)) - -into - -\(a 1 b 2 c 3) - -The original alist is not modified. See also `destructive-alist-to-plist'." - (let (plist) - (while alist - (let ((el (car alist))) - (setq plist (cons (cdr el) (cons (car el) plist)))) - (setq alist (cdr alist))) - (nreverse plist))) - -(sysdep-defun add-minor-mode (toggle name &optional keymap after toggle-fun) - "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'. -TOGGLE is a symbol which is used as the variable which toggle the minor mode, -NAME is the name that should appear in the modeline (it should be a string -beginning with a space), KEYMAP is a keymap to make active when the minor -mode is active, and AFTER is the toggling symbol used for another minor -mode. If AFTER is non-nil, then it is used to position the new mode in the -minor-mode alists. TOGGLE-FUN specifies an interactive function that -is called to toggle the mode on and off; this affects what appens when -button2 is pressed on the mode, and when button3 is pressed somewhere -in the list of modes. If TOGGLE-FUN is nil and TOGGLE names an -interactive function, TOGGLE is used as the toggle function. - -Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)" - (if (not (assq toggle minor-mode-alist)) - (setq minor-mode-alist (cons (list toggle name) minor-mode-alist))) - (if (and keymap (not (assq toggle minor-mode-map-alist))) - (setq minor-mode-map-alist (cons (cons toggle keymap) - minor-mode-map-alist)))) - -(sysdep-defvar x-font-regexp-foundry-and-family - (let ((- "[-?]") - (foundry "[^-]+") - (family "[^-]+") - ) - (concat "\\`[-?*]" foundry - "\\(" family "\\)" -))) - -(sysdep-defun match-string (num &optional string) - "Return string of text matched by last search. -NUM specifies which parenthesized expression in the last regexp. - Value is nil if NUMth pair didn't match, or there were less than NUM pairs. -Zero means the entire text matched by the whole regexp or whole string. -STRING should be given if the last search was by `string-match' on STRING." - (if (match-beginning num) - (if string - (substring string (match-beginning num) (match-end num)) - (buffer-substring (match-beginning num) (match-end num))))) - -(sysdep-defun add-hook (hook-var function &optional at-end) - "Add a function to a hook. -First argument HOOK-VAR (a symbol) is the name of a hook, second - argument FUNCTION is the function to add. -Third (optional) argument AT-END means to add the function at the end - of the hook list instead of the beginning. If the function is already - present, this has no effect. -Returns nil if FUNCTION was already present in HOOK-VAR, else new - value of HOOK-VAR." - (if (not (boundp hook-var)) (set hook-var nil)) - (let ((old (symbol-value hook-var))) - (if (or (not (listp old)) (eq (car old) 'lambda)) - (setq old (list old))) - (if (member function old) - nil - (set hook-var - (if at-end - (append old (list function)) ; don't nconc - (cons function old)))))) - -(sysdep-defalias 'valid-color-name-p - (cond - ((fboundp 'x-valid-color-name-p) ; XEmacs/Lucid - 'x-valid-color-name-p) - ((and window-system - (fboundp 'color-defined-p)) ; NS/Emacs 19 - 'color-defined-p) - ((and window-system - (fboundp 'pm-color-defined-p)) - 'pm-color-defined-p) - ((and window-system - (fboundp 'x-color-defined-p)) ; Emacs 19 - 'x-color-defined-p) - ((fboundp 'get-color) ; Epoch - (function (lambda (color) - (let ((x (get-color color))) - (if x - (setq x (progn - (free-color x) - t))) - x)))) - (t 'identity))) ; All others - -;; Misc. -;; NT doesn't have make-symbolic-link -(sysdep-defalias 'make-symbolic-link 'copy-file) - -(sysdep-defun run-hook-with-args-until-success (hook &rest args) - "Run HOOK with the specified arguments ARGS. -HOOK should be a symbol, a hook variable. Its value should -be a list of functions. We call those functions, one by one, -passing arguments ARGS to each of them, until one of them -returns a non-nil value. Then we return that value. -If all the functions return nil, we return nil." - (let ((rval nil) - (todo (and (boundp hook) (symbol-value hook))) - (global (and (boundp hook) (default-value hook))) - (cur nil)) - (while (and (setq cur (car todo)) (not rval)) - (setq todo (cdr todo)) - (if (eq cur t) - (if global - (setq todo (append global todo))) - (setq rval (apply cur args)))))) - -(sysdep-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)) - )) - -(sysdep-defun member (elt list) - (while (and list (not (equal elt (car list)))) - (setq list (cdr list))) - list) - -(sysdep-defun rassoc (key list) - (let ((found nil)) - (while (and list (not found)) - (if (equal (cdr (car list)) key) (setq found (car list))) - (setq list (cdr list))) - found)) - -(sysdep-defun display-error (error-object stream) - "Display `error-object' on `stream' in a user-friendly way." - (funcall (or (let ((type (car-safe error-object))) - (catch 'error - (and (consp error-object) - (symbolp type) - ;;(stringp (get type 'error-message)) - (consp (get type 'error-conditions)) - (let ((tail (cdr error-object))) - (while (not (null tail)) - (if (consp tail) - (setq tail (cdr tail)) - (throw 'error nil))) - t) - ;; (check-type condition condition) - (get type 'error-conditions) - ;; Search class hierarchy - (let ((tail (get type 'error-conditions))) - (while (not (null tail)) - (cond ((not (and (consp tail) - (symbolp (car tail)))) - (throw 'error nil)) - ((get (car tail) 'display-error) - (throw 'error (get (car tail) - 'display-error))) - (t - (setq tail (cdr tail))))) - ;; Default method - (function - (lambda (error-object stream) - (let ((type (car error-object)) - (tail (cdr error-object)) - (first t)) - (if (eq type 'error) - (progn (princ (car tail) stream) - (setq tail (cdr tail))) - (princ (or (get type 'error-message) type) - stream)) - (while tail - (princ (if first ": " ", ") stream) - (prin1 (car tail) stream) - (setq tail (cdr tail) - first nil))))))))) - (function - (lambda (error-object stream) - (princ "Peculiar error " stream) - (prin1 error-object stream)))) - error-object stream)) - -(sysdep-defun decode-time (&optional specified-time) - (let* ((date (current-time-string specified-time)) - (dateinfo (and date (timezone-parse-date date))) - (timeinfo (and dateinfo (timezone-parse-time (aref dateinfo 3))))) - (list (aref timeinfo 2) (aref timeinfo 1) - (aref timeinfo 0) (aref dateinfo 2) - (aref dateinfo 1) (aref dateinfo 0) - "unknown" nil 0))) - -(sysdep-defun find-face (face) - (car-safe (memq face (face-list)))) - -(sysdep-defun set-marker-insertion-type (marker type) - "Set the insertion-type of MARKER to TYPE. -If TYPE is t, it means the marker advances when you insert text at it. -If TYPE is nil, it means the marker stays behind when you insert text at it." - nil) - -;; window functions - -;; not defined in v18 -(sysdep-defun eval-buffer (bufname &optional printflag) - (interactive) - (save-excursion - (set-buffer bufname) - (eval-current-buffer))) - -(sysdep-defun window-minibuffer-p (window) - "Returns non-nil if WINDOW is a minibuffer window." - (eq window (minibuffer-window))) - -(sysdep-defun window-live-p (window) - "Returns t if OBJ is a window which is currently visible." - (and (windowp window) - (window-point window))) - -(provide 'w3-sysdp) -;;; sysdep.el ends here - -;;;(sysdep.el) Local Variables: -;;;(sysdep.el) eval: (put 'sysdep-defun 'lisp-indent-function 'defun) -;;;(sysdep.el) eval: (put 'sysdep-defalias 'lisp-indent-function 'defun) -;;;(sysdep.el) eval: (put 'sysdep-defconst 'lisp-indent-function 'defun) -;;;(sysdep.el) eval: (put 'sysdep-defvar 'lisp-indent-function 'defun) -;;;(sysdep.el) End: diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-toolbar.el --- a/lisp/w3/w3-toolbar.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,341 +0,0 @@ -;;; w3-toolbar.el --- Toolbar functions for emacs-w3 -;; Author: wmperry -;; Created: 1997/06/20 18:31:25 -;; Version: 1.10 -;; Keywords: mouse, toolbar - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Toolbar specific function for XEmacs 19.12+ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(condition-case () - (progn - (require 'xpm-button) - (require 'xbm-button)) - (error nil)) - -(defvar w3-toolbar-icon-directory nil "Where the toolbar icons for w3 are.") -(defvar w3-toolbar-back-icon nil "Toolbar icon for back") -(defvar w3-toolbar-forw-icon nil "Toolbar icon for forward") -(defvar w3-toolbar-home-icon nil "Toolbar icon for home") -(defvar w3-toolbar-reld-icon nil "Toolbar icon for reload") -(defvar w3-toolbar-imag-icon nil "Toolbar icon for images") -(defvar w3-toolbar-open-icon nil "Toolbar icon for open url") -(defvar w3-toolbar-print-icon nil "Toolbar icon for printing") -(defvar w3-toolbar-find-icon nil "Toolbar icon for find") -(defvar w3-toolbar-stop-icon nil "Toolbar icon for stop") -(defvar w3-toolbar-help-icon nil "Toolbar icon for help") -(defvar w3-toolbar-hotl-icon nil "Toolbar icon for hotlist") - -(defvar w3-link-toolbar-orientation 'bottom - "*Where to put the document specific toolbar. Must be one of these symbols: - -default -- place at location specified by `default-toolbar-position' -top -- place along the top of the frame -bottom -- place along the bottom of the frame -right -- place along the right edge of the frame -left -- place along the left edge of the frame -none -- no toolbar") - -(defvar w3-toolbar-orientation 'default - "*Where to put the w3 toolbar. Must be one of these symbols: - -default -- place at location specified by `default-toolbar-position' -top -- place along the top of the frame -bottom -- place along the bottom of the frame -right -- place along the right edge of the frame -left -- place along the left edge of the frame -none -- no toolbar") - -(defvar w3-toolbar-type 'both - "*What the toolbar looks like. Must be one of these symbols: - -pictures -- Show icons (without captions if in XEmacs 19.13) -both -- Show icons (with captions if in XEmacs 19.13) -text -- Show only text buttons - -Only has any meaning in XEmacs 19.12 when w3-toolbar-orientation is -not `none'.") - -(defvar w3-toolbar - '([w3-toolbar-back-icon w3-history-backward (car (w3-history-find-url-internal (url-view-url t))) "Back in history"] - [w3-toolbar-forw-icon w3-history-forward (cdr (w3-history-find-url-internal (url-view-url t))) "Forward in history"] - [w3-toolbar-home-icon w3 t "Go home"] - [:style 2d :size 5] - [w3-toolbar-reld-icon w3-reload-document t "Reload document"] - [w3-toolbar-hotl-icon w3-show-hotlist t "View hotlist"] - [w3-toolbar-imag-icon w3-load-delayed-images w3-delayed-images - "Load images"] - [toolbar-file-icon w3-fetch t "Fetch a URL"] - [toolbar-printer-icon w3-mouse-print-this-url t "Print document"] - [w3-toolbar-find-icon w3-search-forward t "Search"] - ;;[w3-toolbar-stop-icon keyboard-quit t "Stop transaction"] - nil - [w3-toolbar-help-icon w3-show-info-node t "Help"]) - "The toolbar for w3") - -(defun w3-toolbar-make-captioned-buttons () - (mapcar - (function - (lambda (x) - (let* ((ext (if (featurep 'xpm) ".xpm" ".xbm")) - (base w3-toolbar-icon-directory) - (up (expand-file-name (concat x "-up" ext) base)) - (dn (expand-file-name (concat x "-dn" ext) base)) - (no (expand-file-name (concat x "-no" ext) base)) - (cap-up (expand-file-name (concat x "-cap-up" ext) base)) - (cap-dn (expand-file-name (concat x "-cap-dn" ext) base)) - (cap-no (expand-file-name (concat x "-cap-no" ext) base)) - (var (intern (concat "w3-toolbar-" x "-icon")))) - (set var - (toolbar-make-button-list up dn no cap-up cap-dn cap-no))))) - - '("back" "help" "find" "forw" "home" "hotl" "stop" "imag" "reld"))) - -(defun w3-make-text-toolbar-button (text) - (let ((bgcol (or - (cdr-safe (assq 'background-toolbar-color (frame-parameters))) - "#befbbefbbefb"))) - (if (featurep 'xpm) - (mapcar 'make-glyph (xpm-button-create text 0 "black" bgcol)) - (xbm-button-create text 0)))) - -(defun w3-toolbar-make-text-buttons () - (let ((bgcol (or (cdr-safe (assq 'background-toolbar-color - (frame-parameters))) - "#befbbefbbefb"))) - (setq w3-toolbar-back-icon (w3-make-text-toolbar-button "Back") - w3-toolbar-forw-icon (w3-make-text-toolbar-button "Forward") - w3-toolbar-home-icon (w3-make-text-toolbar-button "Home") - w3-toolbar-reld-icon (w3-make-text-toolbar-button "Reload") - w3-toolbar-hotl-icon (w3-make-text-toolbar-button "Hotlist") - w3-toolbar-imag-icon (w3-make-text-toolbar-button "Images") - w3-toolbar-open-icon (w3-make-text-toolbar-button "Open") - w3-toolbar-print-icon (w3-make-text-toolbar-button "Print") - w3-toolbar-find-icon (w3-make-text-toolbar-button "Find") - w3-toolbar-help-icon (w3-make-text-toolbar-button "Help!")))) - -(defun w3-toolbar-make-picture-buttons () - (mapcar - (function - (lambda (x) - (let* ((ext (if (featurep 'xpm) ".xpm" ".xbm")) - (base w3-toolbar-icon-directory) - (up (expand-file-name (concat x "-cap-up" ext) base)) - (dn (expand-file-name (concat x "-cap-dn" ext) base)) - (no (expand-file-name (concat x "-cap-no" ext) base)) - (var (intern (concat "w3-toolbar-" x "-icon")))) - (set var - (cond - ((and (file-exists-p up) (file-exists-p dn) - (file-exists-p no)) - (toolbar-make-button-list up dn no)) - ((file-exists-p up) - (toolbar-make-button-list up)) - (t nil)))))) - '("back" "help" "find" "forw" "home" "hotl" "imag" "reld"))) - -(defun w3-toolbar-make-buttons () - (if (not w3-toolbar-icon-directory) - (setq w3-toolbar-icon-directory - (file-name-as-directory - (expand-file-name "w3" data-directory)))) - (cond - ((not (file-exists-p w3-toolbar-icon-directory)) - (and w3-running-xemacs - (w3-warn 'files "Toolbar directory does not exist."))) - ((not (fboundp 'toolbar-make-button-list)) - nil) - ((eq w3-toolbar-type 'text) - (w3-toolbar-make-text-buttons)) - ((boundp 'toolbar-buttons-captioned-p) - (w3-toolbar-make-captioned-buttons)) - (t - (w3-toolbar-make-picture-buttons)))) - -(defun w3-link-is-defined (rel &optional rev) - (or - (cdr-safe (assoc rel (cdr-safe (assq 'rel w3-current-links)))) - (cdr-safe (assoc (or rev rel) (cdr-safe (assq 'rev w3-current-links)))))) - -;; Need to create w3-toolbar-glos-icon -;; w3-toolbar-toc-icon -;; w3-toolbar-copy-icon -(defvar w3-link-toolbar - '([info::toolbar-prev-icon - (w3-fetch (w3-link-is-defined "previous" "next")) - (w3-link-is-defined "previous" "next") - "Back"] - [info::toolbar-next-icon - (w3-fetch (w3-link-is-defined "next" "previous")) - (w3-link-is-defined "next" "previous") - "Next"] - [info::toolbar-up-icon - (w3-fetch (w3-link-is-defined "up" "down")) - (w3-link-is-defined "up" "down") - "Up"] - [w3-toolbar-home-icon - (w3-fetch (w3-link-is-defined "home")) - (w3-link-is-defined "home") - "Home"] - [w3-toolbar-toc-icon - (w3-fetch (w3-link-is-defined "toc")) - (w3-link-is-defined "toc") - "Contents"] - [w3-toolbar-find-icon - (w3-fetch (w3-link-is-defined "index")) - (w3-link-is-defined "index") - "Index"] - [w3-toolbar-glos-icon - (w3-fetch (w3-link-is-defined "glossary")) - (w3-link-is-defined "glossary") - "Glossary"] - [w3-toolbar-copy-icon - (w3-fetch (w3-link-is-defined "copyright")) - (w3-link-is-defined "copyright") - "Copyright"] - [w3-toolbar-hotl-icon - (w3-fetch (w3-link-is-defined "bookmark")) - (w3-link-is-defined "bookmark") - "Bookmarks"] - nil - [w3-toolbar-help-icon - (w3-fetch (w3-link-is-defined "help")) - (w3-link-is-defined "help") - "Help"] - )) - -(defun w3-toolbar-from-orientation (orientation) - (cond - ((eq 'default w3-toolbar-orientation) default-toolbar) - ((eq 'bottom w3-toolbar-orientation) bottom-toolbar) - ((eq 'top w3-toolbar-orientation) top-toolbar) - ((eq 'left w3-toolbar-orientation) left-toolbar) - ((eq 'right w3-toolbar-orientation) right-toolbar))) - -(defun w3-toolbar-dimension-from-orientation (orientation) - (cond - ((eq 'default w3-toolbar-orientation) nil) - ((eq 'bottom w3-toolbar-orientation) bottom-toolbar-height) - ((eq 'top w3-toolbar-orientation) top-toolbar-height) - ((eq 'left w3-toolbar-orientation) left-toolbar-width) - ((eq 'right w3-toolbar-orientation) right-toolbar-width))) - -(defun w3-ensure-toolbar-visible (orientation) - ;; Make sure a certain toolbar is visible if necessary - ;; This can modify frame parameters, so watch out. - (let ((dimension (w3-toolbar-dimension-from-orientation orientation)) - (toolbar (w3-toolbar-from-orientation orientation)) - (dimensions nil) - (widths nil) - (heights nil) - (needs nil) - (has nil)) - (if (and dimension toolbar - (setq toolbar (specifier-instance toolbar))) - (progn - (setq dimensions (mapcar - (function - (lambda (glyph) - (and (glyphp glyph) - (cons (glyph-width glyph) - (glyph-height glyph))))) - (mapcar 'car - (delq nil - (mapcar - (function (lambda (x) - (and x - (symbol-value - (aref x 0))))) - toolbar)))) - widths (sort (mapcar 'car dimensions) '>=) - heights (sort (mapcar 'cdr dimensions) '>=) - needs (+ 7 (if (memq orientation '(top bottom)) - (car heights) - (car widths))) - has (specifier-instance dimension)) - (if (<= has needs) - (set-specifier dimension (cons (selected-frame) needs))))))) - -(defun w3-toolbar-active () - (interactive) - (let ((toolbar (w3-toolbar-from-orientation w3-toolbar-orientation))) - (if (and toolbar (specifier-instance toolbar)) - t - nil))) - -(defun w3-toggle-link-toolbar () - (interactive) - (require 'info) ; For some toolbar buttons - (let* ((w3-toolbar-orientation w3-link-toolbar-orientation) - (toolbar (w3-toolbar-from-orientation w3-toolbar-orientation))) - (if toolbar - (if (w3-toolbar-active) - (set-specifier toolbar (cons (current-buffer) nil)) - (set-specifier toolbar w3-link-toolbar (current-buffer)))))) - -(defun w3-toggle-toolbar () - (interactive) - (if (eq major-mode 'w3-mode) - (let ((toolbar (w3-toolbar-from-orientation w3-toolbar-orientation))) - (cond - ((w3-toolbar-active) - (set-specifier toolbar (cons (current-buffer) nil))) - (toolbar - (set-specifier toolbar (cons (current-buffer) w3-toolbar))) - (t - (setq w3-toolbar-orientation 'default - toolbar (w3-toolbar-from-orientation w3-toolbar-orientation)) - (and toolbar - (set-specifier toolbar (cons (current-buffer) w3-toolbar)))))) - (if (not (eq w3-toolbar-orientation 'none)) - (setq w3-toolbar-orientation 'none) - (setq w3-toolbar-orientation 'default)))) - -(defun w3-show-info-node () - (interactive) - (Info-goto-node "(w3.info)Top")) - -(defun w3-mouse-print-this-url (&optional e) - (interactive "e") - (let ((descr '("Print document as" - ["PostScript" (w3-print-this-url nil "PostScript") t] - ["Formatted Text" (w3-print-this-url nil "Formatted Text") t] - ["HTML Source" (w3-print-this-url nil "HTML Source") t] - ["LaTeX'd" (w3-print-this-url nil "LaTeX'd") t] - nil - ["Cancel" (beep) t]))) - (popup-dialog-box descr))) - -(defun w3-add-toolbar-to-buffer () - (if (or (not (featurep 'toolbar)) - (featurep 'infodock)) ; InfoDock uses different toolbars - nil - (let ((toolbar (w3-toolbar-from-orientation w3-toolbar-orientation))) - (if toolbar - (set-specifier toolbar (cons (current-buffer) w3-toolbar)))) - (set-specifier toolbar-buttons-captioned-p - (cons (current-buffer) (eq w3-toolbar-type 'both))))) - -(provide 'w3-toolbar) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-vars.el --- a/lisp/w3/w3-vars.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,583 +0,0 @@ -;;; w3-vars.el,v --- All variable definitions for emacs-w3 -;; Author: wmperry -;; Created: 1997/08/12 14:44:46 -;; Version: 1.150 -;; Keywords: comm, help, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Variable definitions for w3 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'w3-cus) ; Grab everything that is customized -(require 'wid-edit) ; For `widget-keymap' - -(defconst w3-version-number - (let ((x "p3.0.104")) - (if (string-match "State:[ \t\n]+.\\([^ \t\n]+\\)" x) - (setq x (substring x (match-beginning 1) (match-end 1))) - (setq x (substring x 1))) - (mapconcat - (function (lambda (x) (if (= x ?-) "." (char-to-string x)))) x "")) - "Version # of w3-mode.") - -(defconst w3-version-date (let ((x "1997/08/12 14:44:46")) - (if (string-match "Date: \\([^ \t\n]+\\)" x) - (substring x (match-beginning 1) (match-end 1)) - x)) - "Date this version of w3-mode was released.") - -(defconst w3-version - (format "WWW %s %s" w3-version-number w3-version-date) - "More descriptive version of w3-version-number.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; General configuration variables -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-dump-to-disk nil - "*If non-nil, all W3 pages loaded will be dumped to disk.") - -(defvar w3-fetch-with-default t - "*Whether `w3-fetch' should determine a good starting URL as a default.") - -(defvar w3-track-last-buffer nil - "*Whether to track the last w3 buffer to automatically switch to with - M-x w3.") - -(defvar w3-gc-cons-threshold-multiplier 1 - "Amount to temporarily multiply gc-cons-threshold by when parsing HTML. -Setting this to a number greater than 1 will result in less frequent -garbage collections when parsing an HTML document, which may often speed -up handling of a large document with many elements. The disadvantage is -that it allows Emacs's total memory usage to grow larger, which may result -in later garbage collections taking more time.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Figure out what flavor of emacs we are running -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version) - "*Got XEmacs?.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Store the database of HTML general entities. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-html-entities - '( - (excl . 33) - (quot . 34) - (num . 35) - (dollar . 36) - (percent . 37) - (amp . 38) - (rsquo . 39) - (apos . 39) - (lpar . 40) - (rpar . 41) - (times . 42) - (ast . 42) - (plus . 43) - (comma . 44) - (period . 46) - (colon . 58) - (semi . 59) - (lt . 60) - (equals . 61) - (gt . 62) - (quest . 63) - (commat . 64) - (lsqb . 91) - (rsqb . 93) - (uarr . 94) - (lowbar . 95) - (lsquo . 96) - (lcub . 123) - (verbar . 124) - (rcub . 125) - (tilde . 126) - (nbsp . 160) - (iexcl . 161) - (cent . 162) - (pound . 163) - (curren . 164) - (yen . 165) - (brvbar . 166) - (sect . 167) - (uml . 168) - (copy . 169) - (ordf . 170) - (laquo . 171) - (not . 172) - (shy . 173) - (reg . 174) - (macr . 175) - (deg . 176) - (plusmn . 177) - (sup2 . 178) - (sup3 . 179) - (acute . 180) - (micro . 181) - (para . 182) - (middot . 183) - (cedil . 184) - (sup1 . 185) - (ordm . 186) - (raquo . 187) - (frac14 . 188) - (frac12 . 189) - (frac34 . 190) - (iquest . 191) - (Agrave . 192) - (Aacute . 193) - (Acirc . 194) - (Atilde . 195) - (Auml . 196) - (Aring . 197) - (AElig . 198) - (Ccedil . 199) - (Egrave . 200) - (Eacute . 201) - (Ecirc . 202) - (Euml . 203) - (Igrave . 204) - (Iacute . 205) - (Icirc . 206) - (Iuml . 207) - (ETH . 208) - (Ntilde . 209) - (Ograve . 210) - (Oacute . 211) - (Ocirc . 212) - (Otilde . 213) - (Ouml . 214) - (times . 215) - (Oslash . 216) - (Ugrave . 217) - (Uacute . 218) - (Ucirc . 219) - (Uuml . 220) - (Yacute . 221) - (THORN . 222) - (szlig . 223) - (agrave . 224) - (aacute . 225) - (acirc . 226) - (atilde . 227) - (auml . 228) - (aring . 229) - (aelig . 230) - (ccedil . 231) - (egrave . 232) - (eacute . 233) - (ecirc . 234) - (euml . 235) - (igrave . 236) - (iacute . 237) - (icirc . 238) - (iuml . 239) - (eth . 240) - (ntilde . 241) - (ograve . 242) - (oacute . 243) - (ocirc . 244) - (otilde . 245) - (ouml . 246) - (divide . 247) - (oslash . 248) - (ugrave . 249) - (uacute . 250) - (ucirc . 251) - (uuml . 252) - (yacute . 253) - (thorn . 254) - (yuml . 255) - - ;; Special handling of these - (frac56 . "5/6") - (frac16 . "1/6") - (frac45 . "4/5") - (frac35 . "3/5") - (frac25 . "2/5") - (frac15 . "1/5") - (frac23 . "2/3") - (frac13 . "1/3") - (frac78 . "7/8") - (frac58 . "5/8") - (frac38 . "3/8") - (frac18 . "1/8") - - ;; The following 5 entities are not mentioned in the HTML 2.0 - ;; standard, nor in any other HTML proposed standard of which I - ;; am aware. I am not even sure they are ISO entity names. *** - ;; Hence, some arrangement should be made to give a bad HTML - ;; message when they are seen. - (ndash . 45) - (mdash . 45) - (emsp . 32) - (ensp . 32) - (sim . 126) - (le . "<=") - (agr . "alpha") - (rdquo . "''") - (ldquo . "``") - (trade . "(TM)") - ;; To be done - ;; (shy . ????) ; soft hyphen - ) - "*An assoc list of entity names and how to actually display them.") - -(defvar w3-graphic-entities - '( - (archive "archive" ) - (audio "audio" ) - (binary.document "binary.document" ) - (binhex.document "binhex.document" ) - (calculator "calculator" ) - (caution "caution" ) - (cd.i "cd.i" ) - (cd.rom "cd.rom" ) - (clock "clock" ) - (compressed.document "compressed.document" ) - (disk.drive "disk.drive" ) - (diskette "diskette" ) - (document "document" ) - (fax "fax" ) - (filing.cabinet "filing.cabinet" ) - (film "film" ) - (fixed.disk "fixed.disk" ) - (folder "folder" ) - (form "form" ) - (ftp "ftp" ) - (glossary "glossary" ) - (gopher "gopher" ) - (home "home" ) - (html "html" ) - (image "image" ) - (index "index" ) - (keyboard "keyboard" ) - (mail "mail" ) - (mail.in "mail.in" ) - (mail.out "mail.out" ) - (map "map" ) - (mouse "mouse" ) - (new "new" ) - (next "next" ) - (notebook "notebook" ) - (parent "parent" ) - (play.fast.forward "play.fast.forward" ) - (play.fast.reverse "play.fast.reverse" ) - (play.pause "play.pause" ) - (play.start "play.start" ) - (play.stop "play.stop" ) - (previous "previous" ) - (prince "prince" "the artist formerly known as prince") - (princesymbol "prince" "the artist formerly known as prince") - (printer "printer" ) - (sadsmiley "sadsmiley" ":(") - (smiley "smiley" ":)") - (stop "stop" ) - (summary "summary" ) - (telephone "telephone" ) - (telnet "telnet" ) - (text.document "text.document" ) - (tn3270 "tn3270" ) - (toc "toc" ) - (trash "trash" ) - (unknown.document "unknown.document" ) - (uuencoded.document "uuencoded.document" ) - (work "work" ) - (www "www" ) - ) - "List of graphical entity names and the tail end of a URL for them. -If there is a 3rd item in the list, it is the alternative text to use -for the image.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Menu definitions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-popup-menu - '("Emacs-W3 Commands" - ["Back" w3-history-backward (car (w3-history-find-url-internal (url-view-url t)))] - ["Forward" w3-history-forward (cdr (w3-history-find-url-internal (url-view-url t)))] - "---" - ["Reload" (w3-reload-document) t] - ["Show Images" (w3-load-delayed-images) w3-delayed-images] - "---" - ["Add bookmark" (w3-hotlist-add-document nil) t] - ) - "The shorter popup menu.") - -(defvar w3-graphlink-menu - '(("Open this Image (%s)" . w3-fetch) - ("Save this Image As..." . w3-download-url) - ("Copy this Image Location" . w3-save-url) - ("Information on this Image". w3-popup-image-info)) - "An assoc list of function names and labels. These will be displayed -in a popup menu when the mouse is pressed on a hyperlink. Format is -( (label . function)), function is called with one argument, the URL of -the link. Each label can have exactly one `%s' that will be replaced by -the URL of the link.") - -(defvar w3-hyperlink-menu - '(("Open this Link (%s)" . w3-fetch) - ("Add Bookmark for this Link" . w3-hotlist-add-document-at-point) - ("New Window with this Link" . w3-fetch-other-frame) - ("Save Link As..." . w3-download-url) - ("Copy this Link Location to Clipboard" . w3-save-url) - ("Information on this Link" . w3-popup-info)) - "An assoc list of function names and labels. These will be displayed -in a popup menu when the mouse is pressed on a hyperlink. Format is -( (label . function)), function is called with one argument, the URL of -the link. Each label can have exactly one `%s' that will be replaced by -the URL of the link.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Variables internal to W3, you should not change any of these -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-graphics-list nil - "*List of graphics already read in.") - -(defvar w3-delayed-images nil - "*A buffer-local variable holding positions and urls of images within -the buffer.") - -(defvar w3-frameset-structure nil - "Frameset structure, heap of '(frameset ({cols|rows} \"<dimensions>\")) and '(<frame name> <href>)") - -(defvar w3-frame-name nil - "Frame name") - -(defvar w3-base-target nil - "Base target name") - -(defvar w3-target-window-distances nil - "Target window distances") - -(defvar w3-tty-char-width 8 - "*Char width to use when in a tty") - -(defvar w3-tty-char-height 15 - "*Char height to use when in a tty") - -(defvar w3-form-radio-elements nil "Internal variable - do not touch!") -(defvar w3-form-elements nil "Internal variable - do not touch!") - -(defvar w3-user-stylesheet nil - "The global stylesheet for this user.") - -(defvar w3-current-stylesheet nil - "The stylesheet for this document.") - -(defvar w3-blinking-buffs nil - "A list of buffers with blinking text in them. -This is used to optimize when we change a face so the entire display -doesn't flash every second, whether we've run into a buffer that is -displaying blinking text or not.") - -(defvar w3-last-fill-pos nil - "An internal variable for the new display engine that specifies the -last character position that was correctly filled.") - -(defvar w3-active-faces nil "The list of active faces.") -(defvar w3-active-voices nil "The list of active voices.") - -(defconst w3-bug-address "wmperry@cs.indiana.edu" - "Address of current maintainer, where to send bug reports.") -(defvar w3-continuation '(url-uncompress) - "List of functions to call to process a document completely.") -(defvar w3-current-isindex nil "Is the current document a searchable index?") -(defvar w3-current-last-buffer nil "Last W3 buffer seen before this one.") -(defvar w3-current-links nil "An assoc list of <link> tags for this doc.") -(defvar w3-current-metainfo nil "An assoc list of <meta> tags for this doc.") -(defvar w3-current-source nil "Source of current document.") -(defvar w3-current-parse nil "Parsed version of current document.") -(defvar w3-current-badhtml nil "List of HTML warnings for this page.") -(defconst w3-default-continuation '(url-uncompress) - "Default action to start with - cleans text and uncompresses if necessary.") -(defvar w3-find-this-link nil "Link to go to within a document.") -(defvar w3-hidden-forms nil "List of hidden form areas and their info.") -(defvar w3-hotlist nil "Default hotlist.") -(defvar w3-icon-path-cache nil "Cache of where we found icons for entities.") -(defvar w3-last-buffer nil "The last W3 buffer visited.") -(defvar w3-print-next nil "Should we latex & print the next doc?") -(defvar w3-roman-characters "ivxLCDMVX" "Roman numerals.") -(defvar w3-setup-done nil "Have we been through setup code yet?") -(defvar w3-source nil "Should we source the next document or not?") - -(defvar w3-strict-width nil - "*This variable will control how wide emacs thinks the current window is. -This is useful when working in batch mode, and (window-width) returns the -wrong value. If the value is nil, it will use the value (window-width) -returns.") - -(defvar w3-submit-button nil - "A widget object specifying what button was pressed to submit a form.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; buffer-local variables to keep around when going into w3-mode -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-id-positions nil "Internal use only.") -(defvar w3-imagemaps nil "Internal use only.") - -(defvar w3-persistent-variables - '( - ;; So we can show the URL in the list-buffers listing - list-buffers-directory - ;; So widgets don't get lost - widget-field-new - w3-form-radio-elements - w3-form-elements - url-current-callback-func - url-current-content-length - url-current-mime-encoding - url-current-mime-headers - url-current-mime-type - url-current-mime-viewer - url-current-object - url-current-referer - w3-current-badhtml - w3-current-parse - w3-current-isindex - w3-current-last-buffer - w3-current-links - w3-current-metainfo - w3-current-source - w3-delayed-images - w3-hidden-forms - w3-current-stylesheet - w3-form-labels - w3-id-positions - w3-imagemaps - w3-base-target - w3-target-window-distances - w3-frameset-structure - ) - "A list of variables that should be preserved when entering w3-mode.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Emulation stuff -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-netscape-emulation-minor-mode nil - "Whether we are in the netscape emulation minor mode.") -(defvar w3-netscape-emulation-minor-mode-map (make-sparse-keymap) - "Keymap for netscape emulation.") -(defvar w3-lynx-emulation-minor-mode nil - "Whether we are in the lynx emulation minor mode.") -(defvar w3-lynx-emulation-minor-mode-map (make-sparse-keymap) - "Keymap for lynx emulation.") -(defvar w3-last-search-item nil) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Startup items -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-form-labels nil "") -(mapcar (function - (lambda (var) - (if (boundp var) - (make-variable-buffer-local var)))) w3-persistent-variables) - -(make-variable-buffer-local 'w3-last-fill-pos) -(make-variable-buffer-local 'w3-frame-name) -(make-variable-buffer-local 'w3-active-faces) -(make-variable-buffer-local 'w3-netscape-emulation-minor-mode) -(make-variable-buffer-local 'w3-lynx-emulation-minor-mode) -(make-variable-buffer-local 'w3-last-search-item) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Keymap definitions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(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)) -(define-key w3-mode-map "a" (make-sparse-keymap)) - -(define-key w3-mode-map "ha" 'w3-hotlist-apropos) -(define-key w3-mode-map "hd" 'w3-hotlist-delete) -(define-key w3-mode-map "hi" 'w3-hotlist-add-document) -(define-key w3-mode-map "hv" 'w3-show-hotlist) -(define-key w3-mode-map "hr" 'w3-hotlist-rename-entry) -(define-key w3-mode-map "hu" 'w3-use-hotlist) -(define-key w3-mode-map "hA" 'w3-hotlist-append) -(define-key w3-mode-map "hI" 'w3-hotlist-add-document-at-point) -(define-key w3-mode-map "hR" 'w3-hotlist-refresh) - -(define-key w3-mode-map "HF" 'w3-history-forward) -(define-key w3-mode-map "HB" 'w3-history-backward) -(define-key w3-mode-map "Hv" 'w3-show-history-list) - -(define-key w3-mode-map " " 'w3-scroll-up) -(define-key w3-mode-map "<" 'beginning-of-buffer) -(define-key w3-mode-map ">" 'end-of-buffer) -(define-key w3-mode-map "?" 'w3-help) -(define-key w3-mode-map "B" 'w3-history-backward) -(define-key w3-mode-map "D" 'w3-download-url-at-point) -(define-key w3-mode-map "F" 'w3-history-forward) -(define-key w3-mode-map "G" 'w3-show-graphics) -(define-key w3-mode-map "I" 'w3-popup-info) -(define-key w3-mode-map "K" 'w3-save-this-url) -(define-key w3-mode-map "P" 'w3-print-url-under-point) -(define-key w3-mode-map "Q" 'w3-leave-buffer) -(define-key w3-mode-map "R" 'w3-refresh-buffer) -(define-key w3-mode-map "S" 'w3-source-document-at-point) -(define-key w3-mode-map "U" 'w3-use-links) -(define-key w3-mode-map "V" 'w3-view-this-url) -(define-key w3-mode-map "\C-?" 'scroll-down) -(define-key w3-mode-map "\C-c\C-b" 'w3-show-history-list) -(define-key w3-mode-map "\C-c\C-v" 'w3-version) -(define-key w3-mode-map "\C-o" 'w3-fetch) -(define-key w3-mode-map "\M-M" 'w3-mail-document-under-point) -(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 "b" 'widget-backward) -(define-key w3-mode-map "c" 'w3-mail-document-author) -(define-key w3-mode-map "d" 'w3-download-this-url) -(define-key w3-mode-map "f" 'widget-forward) -(define-key w3-mode-map "g" 'w3-reload-document) -(define-key w3-mode-map "i" 'w3-document-information) -(define-key w3-mode-map "k" 'w3-save-url) -(define-key w3-mode-map "l" 'w3-goto-last-buffer) -(define-key w3-mode-map "m" 'w3-complete-link) -(define-key w3-mode-map "n" 'widget-forward) -(define-key w3-mode-map "o" 'w3-open-local) -(define-key w3-mode-map "p" 'w3-print-this-url) -(define-key w3-mode-map "q" 'w3-quit) -(define-key w3-mode-map "r" 'w3-reload-document) -(define-key w3-mode-map "s" 'w3-source-document) -(define-key w3-mode-map "u" 'w3-leave-buffer) -(define-key w3-mode-map "v" 'url-view-url) -(define-key w3-mode-map "w" 'w3-submit-bug) - -;; Emulate some netscape stuff by default -(define-key w3-mode-map [(control alt t)] 'url-list-processes) -(define-key w3-mode-map [(control meta t)] 'url-list-processes) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Keyword definitions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'w3-keyword) -(provide 'w3-vars) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-widget.el --- a/lisp/w3/w3-widget.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,375 +0,0 @@ -;;; w3-widget.el --- An image widget -;; Author: wmperry -;; Created: 1997/04/07 16:00:02 -;; Version: 1.28 -;; Keywords: faces, images - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; This is a widget that will do the best it can with an image. -;;; -;;; It can handle all the common occurences of images on the world wide web -;;; 1. A plain image - displays either a glyph of the image, or the -;;; alternative text -;;; 2. A hyperlinked image - an image that is also a hypertext link to -;;; another page. Displays either a glyph of the image, or the -;;; alternative text. When activated with the mouse or the keyboard, -;;; the 'href' property of the widget is retrieved. -;;; 3. Server side imagemaps - an image that has hotzones that lead to -;;; different areas. Unfortunately, we cannot tell where the links go -;;; from the client - all processing is done by the server. Displays -;;; either a glyph of the image, or the alternative text. When activated -;;; with the mouse or the keyboard, the coordinates clicked on are -;;; sent to the remote server as HREF?x,y. If the link is activated -;;; by the keyboard, then 0,0 are sent as the coordinates. -;;; 4. Client side imagemaps - an image that has hotzones that lead to -;;; different areas. All processing is done on the client side, so -;;; we can actually show a decent representation on a TTY. Displays -;;; either a glyph of the image, or a drop-down-list of the destinations -;;; These are either URLs (http://foo/...) or alternative text. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'cl) -(require 'widget) - -(defvar widget-image-keymap (make-sparse-keymap) - "Keymap used over glyphs in an image widget") - -(define-widget-keywords :tab-order) - -(defconst widget-mouse-button1 nil) -(defconst widget-mouse-button2 nil) -(defconst widget-mouse-button3 nil) - -(if (string-match "XEmacs" (emacs-version)) - (if (featurep 'mouse) - (setq widget-mouse-button1 'button1 - widget-mouse-button2 'button2 - widget-mouse-button3 'button3) - (setq widget-mouse-button1 'return - widget-mouse-button2 'return - widget-mouse-button3 'return)) - (setq widget-mouse-button1 'mouse-1 - widget-mouse-button2 'mouse-2 - widget-mouse-button3 'mouse-3)) - -(defvar widget-image-inaudible-p nil - "*Whether to make images inaudible or not.") - -(define-key widget-image-keymap (vector widget-mouse-button1) - 'widget-image-button-press) -(define-key widget-image-keymap (vector widget-mouse-button2) - 'widget-image-button-press) - -(define-widget 'image 'default - "A fairly complex image widget." - :convert-widget 'widget-image-convert - :value-to-internal (lambda (widget value) value) - :value-to-external (lambda (widget value) value) - :value-set 'widget-image-value-set - :create 'widget-image-create - :delete 'widget-image-delete - :value-create 'widget-image-value-create - :value-delete 'widget-image-value-delete - :value-get 'widget-image-value-get - :notify 'widget-image-notify - ) - -(defun widget-image-convert (widget) - (let ((args (widget-get widget :args))) - (widget-put widget :args nil) - (while args - (widget-put widget (car args) (cadr args)) - (setq args (cddr args))) - widget)) - -(defun widget-image-value-get (widget) - (let ((children (widget-get widget :children))) - (and (car children) - (widget-apply (car children) :value-get)))) - -(defun widget-image-create (widget) - ;; Create an image widget at point in the current buffer - (let ((where (widget-get widget 'where))) - (cond - ((null where) - (setq where (set-marker (make-marker) (point)))) - ((markerp where) - nil) - ((integerp where) - (setq where (set-marker (make-marker) where))) - (t - (error "IMPOSSIBLE position in widget-image-create: %s" where))) - (widget-put widget 'where where)) - (widget-image-value-create widget)) - -(defun widget-image-value-set (widget value) - ;; Recreate widget with new value. - (save-excursion - (widget-image-delete widget) - (if (widget-glyphp value) - (widget-put widget 'glyph value) - (widget-put widget :value value)) - (put-text-property (point) - (progn - (widget-apply widget :create) - (point)) - 'inaudible - widget-image-inaudible-p))) - -(defsubst widget-image-usemap (widget) - (let ((usemap (widget-get widget 'usemap))) - (if (listp usemap) - usemap - (if (and usemap (string-match "^#" usemap)) - (setq usemap (substring usemap 1 nil))) - (cdr-safe (assoc usemap w3-imagemaps))))) - -(defun widget-image-callback (widget widget-ignore &optional event) - (if (widget-get widget 'href) - (w3-fetch (widget-get widget 'href) (widget-get widget 'target)))) - -(defmacro widget-image-create-subwidget (&rest args) - (` (widget-create (,@ args) - :parent widget - :help-echo 'widget-image-summarize - 'usemap (widget-get widget 'usemap) - 'href href - 'src (widget-get widget 'src) - 'ismap server-map))) - -(defun widget-image-value-create (widget) - ;; Insert the printed representation of the value - (let ( - (href (widget-get widget 'href)) - (server-map (widget-get widget 'ismap)) - (client-map (widget-image-usemap widget)) - (where (or (widget-get widget 'where) (point))) - (glyph (widget-get widget 'glyph)) - (alt (widget-get widget 'alt)) - (real-widget nil) - (invalid-glyph nil) - ) - - ;; Specifier-instance will signal an error if we have an invalid - ;; image specifier, which would be the case if we get screwed up - ;; data back from a URL somewhere. - - (setq invalid-glyph (and glyph (condition-case () - (if (specifier-instance - (glyph-image glyph)) - nil) - (error t)))) - (if (or (not glyph) invalid-glyph) - ;; Do a TTY or delayed image version of the image. - (save-excursion - (if (= 0 (length alt)) (setq alt nil)) - (goto-char where) - (cond - (client-map - (let* ((default nil) - (options (mapcar - (function - (lambda (x) - (if (eq (aref x 0) 'default) - (setq default (aref x 2))) - (if (and (not default) (stringp (aref x 2))) - (setq default (aref x 2))) - (list 'choice-item - :tab-order -1 - :format "%[%t%]" - :tag (or (aref x 3) (aref x 2)) - :value (aref x 2)))) client-map))) - (setq real-widget - (apply 'widget-create 'menu-choice - :tag (or (widget-get widget :tag) "Imagemap") - :ignore-case t - :notify (widget-get widget :notify) - :action (widget-get widget :action) - :value default - :parent widget - :help-echo 'widget-image-summarize - options)))) - ((and server-map (stringp href)) - (setq real-widget - (widget-image-create-subwidget - 'item :format "%[%t%]" - :tag alt - :delete 'widget-default-delete - :value href - :action (widget-get widget :action) - :notify (widget-get widget :notify)))) - (href - (setq real-widget - (widget-image-create-subwidget - 'item :format "%[%t%]" - :tag (or alt "Image") - :value href - :delete 'widget-default-delete - :action (widget-get widget :action) - :notify 'widget-image-callback))) - (alt - (setq real-widget - (widget-image-create-subwidget - 'item :format "%[%t%]" - :tag alt - :tab-order -1 - :delete 'widget-default-delete - :action (widget-get widget :action) - :notify 'widget-image-callback)))) - (if (not real-widget) - nil - (widget-put widget :children (list real-widget)))) - ;;; Actually use the image - (let ((extent (or (widget-get widget 'extent) - (make-extent where where)))) - (set-extent-endpoints extent where where) - (widget-put widget 'extent extent) - (widget-put widget :children nil) - (set-extent-property extent 'keymap widget-image-keymap) - (set-extent-property extent 'begin-glyph glyph) - (set-extent-property extent 'detachable t) - (set-extent-property extent 'help-echo (cond - ((and href (or client-map - server-map)) - (format "%s [map]" href)) - (href href) - (t nil))) - (set-glyph-property glyph 'widget widget))))) - -(defun widget-image-delete (widget) - ;; Remove the widget from the buffer - (let ((extent (widget-get widget 'extent)) - (child (car (widget-get widget :children)))) - (cond - (extent ; Remove a glyph - (delete-extent extent)) - (child ; Remove a child widget - (widget-apply child :delete)) - (t ; Doh! Do nothing. - nil)))) - -(if (fboundp 'mouse-event-p) - (fset 'widget-mouse-event-p 'mouse-event-p) - (fset 'widget-mouse-event-p 'ignore)) - -(if (fboundp 'glyphp) - (fset 'widget-glyphp 'glyphp) - (fset 'widget-glyphp 'ignore)) - -(defun widget-image-button-press (event) - (interactive "@e") - (let* ((glyph (and event (widget-mouse-event-p event) (event-glyph event))) - (widget (and glyph (glyph-property glyph 'widget)))) - (widget-image-notify widget widget event))) - -(defun widget-image-usemap-default (usemap) - (let ((rval (and usemap (car usemap)))) - (while usemap - (if (equal (aref (car usemap) 0) "default") - (setq rval (car usemap) - usemap nil)) - (setq usemap (cdr usemap))) - rval)) - -(defun widget-image-summarize (widget) - (if (widget-get widget :parent) - (setq widget (widget-get widget :parent))) - (let* ((ismap (widget-get widget 'ismap)) - (usemap (widget-image-usemap widget)) - (href (widget-get widget 'href)) - (alt (widget-get widget 'alt)) - (value (widget-value widget))) - (cond - (usemap - (setq usemap (widget-image-usemap-default usemap)) - ;; Perhaps we should do something here with showing the # of entries - ;; in the imagemap as well as the default href? Could get too long. - (format "Client side imagemap: %s" value)) - (ismap - (format "Server side imagemap: %s" href)) - ((stringp href) ; Normal hyperlink - (format "Image hyperlink: %s" href)) - ((stringp alt) ; Alternate message was specified - (format "Image: %s" alt)) - ((stringp value) - (format "Image: %s" value)) - (t ; Huh? - "A very confused image widget.")))) - -(defvar widget-image-auto-retrieve 'ask - "*Whether to automatically retrieve the source of an image widget -if it is not an active hyperlink or imagemap. -If `nil', don't do anything. -If `t', automatically retrieve the source. -Any other value means ask the user each time.") - -(defun widget-image-notify (widget widget-changed &optional event) - ;; Happens when anything changes - (let* ((glyph (and event (widget-mouse-event-p event) (event-glyph event))) - (x (and glyph (event-glyph-x-pixel event))) - (y (and glyph (event-glyph-y-pixel event))) - (ismap (widget-get widget 'ismap)) - (usemap (widget-image-usemap widget)) - (href (widget-get widget 'href)) - (img-src (or (widget-get widget 'src) - (and widget-changed (widget-get widget-changed 'src)))) - (target (widget-get widget 'target)) - ) - (cond - ((and glyph usemap) ; Do the client-side imagemap stuff - (setq href (w3-point-in-map (vector x y) usemap nil)) - (if (stringp href) - (w3-fetch href target) - (message "No destination found for %d,%d" x y))) - ((and glyph x y ismap) ; Do the server-side imagemap stuff - (w3-fetch (format "%s?%d,%d" href x y) target)) - (usemap ; Dummed-down tty client side imap - (let ((choices (mapcar (function - (lambda (entry) - (cons - (or (aref entry 3) (aref entry 2)) - (aref entry 2)))) usemap)) - (choice nil) - (case-fold-search t)) - (setq choice (completing-read "Imagemap: " choices nil t) - choice (cdr-safe (assoc choice choices))) - (and (stringp choice) (w3-fetch choice target)))) - (ismap ; Do server-side dummy imagemap for tty - (w3-fetch (concat href "?0,0") target)) - ((stringp href) ; Normal hyperlink - (w3-fetch href target)) - ((stringp img-src) - (cond - ((null widget-image-auto-retrieve) nil) - ((eq t widget-image-auto-retrieve) - (w3-fetch img-src)) - ((funcall url-confirmation-func - (format "Retrieve image (%s)?" - (url-truncate-url-for-viewing img-src))) - (w3-fetch img-src)))) - (t ; Huh? - nil)))) - -(provide 'w3-widget) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3-xemac.el --- a/lisp/w3/w3-xemac.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,145 +0,0 @@ -;;; w3-xemac.el --- XEmacs specific functions for emacs-w3 -;; Author: wmperry -;; Created: 1997/04/21 21:59:34 -;; Version: 1.20 -;; Keywords: faces, help, mouse, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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 'w3-imap) -(require 'images) -(require 'w3-widget) -(require 'w3-menu) -(require 'w3-forms) -(require 'w3-script) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Enhancements For XEmacs -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-text-pixel-width (str &optional face) - "Return the pixel-width of a chunk of text STR with face FACE." - (let ((glyph (make-glyph str)) - (todo (if (listp face) face (list face))) - (max 0)) - (while (progn (set-glyph-face glyph (pop todo)) todo) - (setq max (max (glyph-width glyph) max))) - max)) - -(defun w3-mouse-handler (e) - "Function to message the url under the mouse cursor" - (interactive "e") - (let* ((pt (event-point e)) - (good (eq (event-window e) (selected-window))) - (mouse-events)) - (if (not (and good pt (number-or-marker-p pt))) - nil - (if (and inhibit-help-echo w3-track-mouse) - (widget-echo-help pt)) - (setq mouse-events (w3-script-find-event-handlers pt 'mouse)) - (if (assq 'onmouseover mouse-events) - (w3-script-evaluate-form (cdr (assq 'onmouseover mouse-events))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Functions to build menus of urls -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-setup-version-specifics () - "Set up routine for XEmacs 19.12 or later" - ;; Create the toolbar buttons - (and (featurep 'toolbar) - (w3-toolbar-make-buttons)) - - ;; Register the default set of image conversion utilities - (image-register-netpbm-utilities) - - ;; Add our menus, but make sure that we do it to the global menubar - ;; not the current one, which could be anything, but usually GNUS or - ;; VM if not the default. - (if (featurep 'menubar) - (let ((current-menubar (default-value 'current-menubar))) - (if current-menubar - (add-submenu '("Help") (cons "WWW" (cdr w3-menu-help-menu)))))) - - ;; FIXME FIXME: Do sexy things to the default modeline for Emacs-W3 - - ;; The following is a workaround for XEmacs 19.14 and XEmacs 20.0 - ;; The text property implementation is badly broken - you could not have - ;; a text property with a `nil' value. Bad bad bad. - (if (or (and (= emacs-major-version 20) - (= emacs-minor-version 0)) - (and (= emacs-major-version 19) - (= emacs-minor-version 14))) - (defun text-prop-extent-paste-function (ext from to) - (let ((prop (extent-property ext 'text-prop nil)) - (val nil)) - (if (null prop) - (error "Internal error: no text-prop")) - (setq val (extent-property ext prop nil)) - (put-text-property from to prop val nil) - nil)) - ) - ) - -(defun w3-store-in-clipboard (str) - "Store string STR into the clipboard in X" - (cond - ((eq (device-type) 'tty) - nil) - ((eq (device-type) 'x) - (x-own-selection str)) - ((eq (device-type) 'ns) - ) - (t nil))) - -(defun w3-mode-motion-hook (e) - (let* ((glyph (event-glyph e)) - (x (and glyph (event-glyph-x-pixel e))) - (y (and glyph (event-glyph-y-pixel e))) - (widget (and glyph (glyph-property glyph 'widget))) - (usemap (and widget (w3-image-widget-usemap widget))) - (ismap (and widget (widget-get widget 'ismap))) - (echo (and widget (widget-get widget 'href)))) - (cond - (usemap - (setq echo (w3-point-in-map (vector x y) usemap t))) - (ismap - (setq echo (format "%s?%d,%d" echo x y))) - (t - nil)) - (and echo (message "%s" echo)))) - -(defun w3-mode-version-specifics () - "XEmacs specific stuff for w3-mode" - (if (featurep 'mouse) - (progn - (if (not w3-track-mouse) - (setq inhibit-help-echo nil)) - (setq mode-motion-hook 'w3-mouse-handler))) - (case (device-type) - ((tty stream) ; TTY or batch - nil) - (otherwise - (w3-add-toolbar-to-buffer))) - (setq mode-popup-menu w3-popup-menu)) - -(require 'w3-toolbar) -(provide 'w3-xemacs) -(provide 'w3-xemac) diff -r f0deb0c0e6be -r eb5470882647 lisp/w3/w3.el --- a/lisp/w3/w3.el Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2330 +0,0 @@ -;;; w3.el --- Main functions for emacs-w3 on all platforms/versions -;; Author: wmperry -;; Created: 1997/08/25 14:55:29 -;; Version: 1.141 -;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; 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. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; This is a major mode for browsing documents written in Hypertext Markup ;;; -;;; Language (HTML). These documents are typicallly part of the World Wide ;;; -;;; Web (WWW), a project to create a global information net in hypertext ;;; -;;; format. ;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; first start by making sure the load path is properly set. This code -;;; is mostly taken from calc-2.02b -;;; -;;; this allows you to put the following in your .emacs file, instead of -;;; having to know what the load-path for the w3 files is. -;;; -;;; (autoload 'w3 "w3/w3" "WWW Browser" t) - -;;; If w3 files exist on the load-path, we're all set. -(let ((name (and (fboundp 'w3) - (eq (car-safe (symbol-function 'w3)) 'autoload) - (nth 1 (symbol-function 'w3)))) - (p load-path)) - (while (and p (not (file-exists-p - (expand-file-name "w3-vars.elc" (car p))))) - (setq p (cdr p))) - (or p -;;; If w3 is autoloaded using a path name, look there for w3 files. -;;; This works for both relative ("w3/w3.elc") and absolute paths. - (and name (file-name-directory name) - (let ((p2 load-path) - (name2 (concat (file-name-directory name) - "w3-vars.elc"))) - (while (and p2 (not (file-exists-p - (expand-file-name name2 (car p2))))) - (setq p2 (cdr p2))) - (if p2 - (setq load-path (nconc load-path - (list - (directory-file-name - (file-name-directory - (expand-file-name - name (car p2))))))))))) - ) - - -(require 'w3-sysdp) -(require 'mule-sysdp) -(require 'widget) - -(or (featurep 'efs) - (featurep 'efs-auto) - (condition-case () - (require 'ange-ftp) - (error nil))) - -(require 'cl) -(require 'css) -(require 'w3-vars) -(eval-and-compile - (require 'w3-display)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Code for printing out roman numerals -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-decimal-to-roman (n) - ;; Convert from decimal to roman numerals - (let ((curmod 1000) - (str "") - (j 7) - i2 k curcnt) - (while (>= curmod 1) - (if (>= n curmod) - (progn - (setq curcnt (/ n curmod) - n (- n (* curcnt curmod))) - (if (= 4 (% curcnt 5)) - (setq i2 (+ j (if (> curcnt 5) 1 0)) - str (format "%s%c%c" str - (aref w3-roman-characters (1- j)) - (aref w3-roman-characters i2))) - (progn - (if (>= curcnt 5) - (setq str (format "%s%c" str (aref w3-roman-characters j)) - curcnt (- curcnt 5))) - (setq k 0) - (while (< k curcnt) - (setq str (format "%s%c" str - (aref w3-roman-characters (1- j))) - k (1+ k))))))) - (setq curmod (/ curmod 10) - j (- j 2))) - str)) - -(defun w3-decimal-to-alpha (n) - ;; Convert from decimal to alphabetical (a, b, c, ..., aa, ab,...) - (cond - ((< n 1) (char-to-string ?Z)) - ((<= n 26) (char-to-string (+ ?A (1- n)))) - (t (concat (char-to-string (+ ?A (1- (/ n 27)))) - (w3-decimal-to-alpha (% n 26)))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Functions to pass files off to external viewers -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-start-viewer (fname cmd &optional view) - "Start a subprocess, named FNAME, executing CMD. -If third arg VIEW is non-nil, show the output in a buffer when -the subprocess exits." - (if view (save-excursion - (set-buffer (get-buffer-create view)) - (erase-buffer))) - (start-process fname view shell-file-name shell-command-switch cmd)) - -(defun w3-viewer-filter (proc string) - ;; A process filter for asynchronous external viewers - (let ((buff (get-buffer-create (url-generate-new-buffer-name - (symbol-name - (read (nth 2 (process-command proc)))))))) - (save-excursion - (set-buffer buff) - (erase-buffer) - (insert string) - (set-process-buffer proc buff) - (set-process-filter proc nil)))) - -(defun w3-viewer-sentinel (proc string) - ;; Delete any temp files left from a viewer process. - (let ((fname (process-name proc)) - (buffr (process-buffer proc)) - (status (process-exit-status proc))) - (if buffr - (w3-notify-when-ready buffr)) - (and (/= 0 status) - (funcall url-confirmation-func - (format "Viewer for %s failed... save to disk? " fname)) - (copy-file fname (read-file-name "Save as: ") t)) - (if (and (file-exists-p fname) - (file-writable-p fname)) - (delete-file fname))) - ;; FSF Emacs doesn't do this after calling a process-sentinel - (set-buffer (window-buffer (selected-window)))) - -(defun w3-notify-when-ready (buff) - "Notify the user when BUFF is ready. -See the variable `w3-notify' for the different notification behaviors." - (if (stringp buff) (setq buff (get-buffer buff))) - (cond - ((null buff) nil) - ((eq w3-notify 'newframe) - ;; Since we run asynchronously, perhaps while Emacs is waiting for input, - ;; we must not leave a different buffer current. - ;; We can't rely on the editor command loop to reselect - ;; the selected window's buffer. - (save-excursion - (set-buffer buff) - (make-frame))) - ((eq w3-notify 'bully) - (pop-to-buffer buff) - (delete-other-windows)) - ((eq w3-notify 'semibully) - (condition-case nil - (switch-to-buffer buff) - (error (message "W3 buffer %s is ready." (buffer-name buff))))) - ((eq w3-notify 'aggressive) - (pop-to-buffer buff)) - ((eq w3-notify 'friendly) - (display-buffer buff 'not-this-window)) - ((eq w3-notify 'polite) - (beep) - (message "W3 buffer %s is ready." (buffer-name buff))) - ((eq w3-notify 'quiet) - (message "W3 buffer %s is ready." (buffer-name buff))) - (t (message "")))) - -(defun w3-pass-to-viewer () - ;; Pass a w3 buffer to a viewer - (set-buffer url-working-buffer) - (let* ((info url-current-mime-viewer) ; All the MIME viewer info - (view (cdr-safe (assoc "viewer" info))) ; How to view this file - (url (url-view-url t)) - (fmt (cdr-safe (assoc "nametemplate" info)))) ; Template for name - (cond - (fmt nil) - ((cdr-safe (assoc "type" info)) - (setq fmt (mm-type-to-file (cdr-safe (assoc "type" info)))) - (if fmt - (setq fmt (concat "%s" (car fmt))) - (setq fmt (concat "%s" (url-file-extension - (url-filename url-current-object))))))) - (if (null view) - (setq view 'indented-text-mode)) - (cond - ((symbolp view) - (if (not (memq view '(w3-prepare-buffer w3-print w3-source - w3-default-local-file - mm-multipart-viewer))) - (let ((bufnam (url-generate-new-buffer-name - (file-name-nondirectory - (or (url-filename url-current-object) - "Unknown"))))) - (if (string= bufnam "") - (setq bufnam (url-generate-new-buffer-name - (url-view-url t)))) - (rename-buffer bufnam) - ;; Make the URL show in list-buffers output - (make-local-variable 'list-buffers-directory) - (setq list-buffers-directory (url-view-url t)) - (set-buffer-modified-p nil) - (buffer-enable-undo) - (funcall view) - (w3-notify-when-ready bufnam)) - (funcall view))) - ((stringp view) - (let ((fname (url-generate-unique-filename fmt)) - (proc nil)) - (if (url-file-directly-accessible-p (url-view-url t)) - (make-symbolic-link (url-filename url-current-object) fname t) - (mule-write-region-no-coding-system (point-min) (point-max) fname)) - (if (get-buffer url-working-buffer) - (kill-buffer url-working-buffer)) - (setq view (mm-viewer-unescape view fname url)) - (message "Passing to viewer %s " view) - (setq proc (w3-start-viewer fname view)) - (set-process-filter proc 'w3-viewer-filter) - (set-process-sentinel proc 'w3-viewer-sentinel))) - ((listp view) - (set-buffer-modified-p nil) - (buffer-enable-undo) - (eval view)) - (t - (message "Unknown viewer specified: %s" view) - (w3-notify-when-ready url-working-buffer))))) - -(defun w3-save-binary-file () - "Save a buffer to disk - this is used when `w3-dump-to-disk' is non-nil" - ;; Ok, this is truly fucked. In XEmacs, if you use the mouse to select - ;; a URL that gets saved via this function, read-file-name will pop up a - ;; dialog box for file selection. For some reason which buffer we are in - ;; gets royally screwed (even with save-excursions and the whole nine - ;; yards). SO, we just keep the old buffer name around and away we go. - (let ((old-buff (current-buffer)) - (file (read-file-name "Filename to save as: " - (or mm-download-directory "~/") - (url-remove-compressed-extensions - (file-name-nondirectory (url-view-url t))) - nil - (url-remove-compressed-extensions - (file-name-nondirectory (url-view-url t))))) - (require-final-newline nil)) - (set-buffer old-buff) - (mule-write-region-no-coding-system (point-min) (point-max) file) - (kill-buffer (current-buffer)))) - -;;;###autoload -(defun w3-open-local (fname) - "Find a local file, and interpret it as a hypertext document. -It will prompt for an existing file or directory, and retrieve it as a -hypertext document." - (interactive "FLocal file: ") - (setq fname (expand-file-name fname)) - (if (not w3-setup-done) (w3-do-setup)) - (w3-fetch (concat "file:" fname))) - -;;;###autoload -(defun w3-find-file (fname) - "Find a local file, and interpret it as a hypertext document. -It will prompt for an existing file or directory, and retrieve it as a -hypertext document." - (interactive "FLocal file: ") - (w3-open-local fname)) - -;;;###autoload -(defun w3-fetch-other-frame (&optional url) - "Attempt to follow the hypertext reference under point in a new frame. -With prefix-arg P, ignore viewers and dump the link straight -to disk." - (interactive (list (w3-read-url-with-default))) - (cond - ((and (fboundp 'make-frame) - (fboundp 'select-frame) - (not (eq (device-type) 'tty))) - (let ((frm (make-frame))) - (select-frame frm) - (delete-other-windows) - (w3-fetch url))) - (t (w3-fetch url)))) - -(defun w3-fetch-other-window (&optional url) - "Attempt to follow the hypertext reference under point in a new window. -With prefix-arg P, ignore viewers and dump the link straight -to disk." - (interactive (list (w3-read-url-with-default))) - (split-window) - (w3-fetch url)) - -;; Ripped off from red gnus -(defun w3-find-etc-directory (package &optional file) - "Go through the path and find the \".../etc/PACKAGE\" directory. -If FILE, find the \".../etc/PACKAGE\" file instead." - (let ((path load-path) - dir result) - ;; We try to find the dir by looking at the load path, - ;; stripping away the last component and adding "etc/". - (while path - (if (and (car path) - (file-exists-p - (setq dir (concat - (file-name-directory - (directory-file-name (car path))) - "etc/" package - (if file "" "/")))) - (or file (file-directory-p dir))) - (setq result dir - path nil) - (setq path (cdr path)))) - result)) - -(defun w3-url-completion-function (string predicate function) - (if (not w3-setup-done) (w3-do-setup)) - (cond - ((eq function nil) - (let ((list nil)) - (cl-maphash (function (lambda (key val) - (setq list (cons (cons key val) - list)))) - url-global-history-hash-table) - (try-completion string (nreverse list) predicate))) - ((eq function t) - (let ((stub (concat "^" (regexp-quote string))) - (retval nil)) - (cl-maphash - (function - (lambda (url time) - (if (string-match stub url) - (setq retval (cons url retval))))) - url-global-history-hash-table) - retval)) - ((eq function 'lambda) - (and url-global-history-hash-table - (cl-gethash string url-global-history-hash-table) - t)) - (t - (error "w3-url-completion-function very confused.")))) - -(defun w3-read-url-with-default () - (url-do-setup) - (let* ((completion-ignore-case t) - (default - (cond - ((null w3-fetch-with-default) nil) - ((eq major-mode 'w3-mode) - (or (and current-prefix-arg (w3-view-this-url t)) - (url-view-url t))) - ((url-get-url-at-point) - (url-get-url-at-point)) - (t "http://www."))) - (url nil)) - (setq url - (completing-read "URL: " 'w3-url-completion-function - nil nil default)) - (if (string= url "") - (setq url (if (eq major-mode 'w3-mode) - (if (and current-prefix-arg (w3-view-this-url t)) - (w3-view-this-url t) - (url-view-url t)) - (url-get-url-at-point)))) - url)) - -;;;###autoload -(defun w3-fetch (&optional url target) - "Retrieve a document over the World Wide Web. -Defaults to URL of the current document, if any. -With prefix argument, use the URL of the hyperlink under point instead." - (interactive (list (w3-read-url-with-default))) - (if (not w3-setup-done) (w3-do-setup)) - (if (boundp 'w3-working-buffer) - (setq w3-working-buffer url-working-buffer)) - (if (and (boundp 'command-line-args-left) - command-line-args-left - (string-match url-nonrelative-link (car command-line-args-left))) - (setq url (car command-line-args-left) - command-line-args-left (cdr command-line-args-left))) - (if (equal url "") (error "No document specified!")) - ;; legal use for relative URLs ? - (if (string-match "^www:[^/].*" url) - (setq url (concat (file-name-directory (url-filename - url-current-object)) - (substring url 4)))) - ;; In the common case, this is probably cheaper than searching. - (while (= (string-to-char url) ? ) - (setq url (substring url 1))) - (or target (setq target w3-base-target)) - (if (stringp target) - (setq target (intern (downcase target)))) - (and target - (let ((window-distance (cdr-safe (assq target w3-target-window-distances)))) - (if (numberp window-distance) - (other-window window-distance) - (case target - ((_blank external) - (w3-fetch-other-frame url)) - (_top - (delete-other-windows)) - (otherwise - (message "target %S not found." target)))))) - (cond - ((= (string-to-char url) ?#) - (w3-relative-link url)) - ((or (and (interactive-p) current-prefix-arg) w3-dump-to-disk) - (w3-download-url url)) - (t - (let ((x (url-view-url t)) - (lastbuf (current-buffer)) - (buf (url-buffer-visiting url))) - (if (or (not buf) - (cond - ((not (equal (downcase (or url-request-method "GET")) "get")) t) - ((memq w3-reuse-buffers '(no never reload)) t) - ((memq w3-reuse-buffers '(yes reuse always)) nil) - (t - (if (and w3-reuse-buffers (not (eq w3-reuse-buffers 'ask))) - (progn - (ding) - (message - "Warning: Invalid value for variable w3-reuse-buffers: %s" - (prin1-to-string w3-reuse-buffers)) - (sit-for 2))) - (not (funcall url-confirmation-func - (format "Reuse URL in buffer %s? " - (buffer-name buf))))))) - (let* ((status (url-retrieve url)) - (cached (car status)) - (url-working-buffer (cdr status))) - (if w3-track-last-buffer - (setq w3-last-buffer (get-buffer url-working-buffer))) - (if (get-buffer url-working-buffer) - (cond - ((and url-be-asynchronous (not cached)) - (save-excursion - (set-buffer url-working-buffer) - (if x - (w3-history-push x (url-view-url t))) - (setq w3-current-last-buffer lastbuf))) - (t - (w3-history-push x url) - (w3-sentinel lastbuf))))) - (if w3-track-last-buffer - (setq w3-last-buffer buf)) - (let ((w3-notify (if (memq w3-notify '(newframe bully - semibully aggressive)) - w3-notify - 'aggressive))) - (w3-notify-when-ready buf)) - (if (string-match "#\\(.*\\)" url) - (progn - (push-mark (point) t) - (w3-find-specific-link (url-match url 1)))) - (or (w3-maybe-fetch-frames) - (message "Reusing URL. To reload, type %s." - (substitute-command-keys "\\[w3-reload-document]")))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; History for forward/back buttons -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar w3-history-stack nil - "History stack viewing history. -This is an assoc list, with the oldest items first. -Each element is a cons cell of (url . timeobj), where URL -is the normalized URL (default ports removed, etc), and TIMEOBJ is -a standard Emacs time. See the `current-time' function documentation -for information on this format.") - -(defun w3-history-find-url-internal (url) - "Search in the history list for URL. -Returns a cons cell, where the car is the 'back' node, and -the cdr is the 'next' node." - (let* ((node (assoc url w3-history-stack)) - (next (cadr (memq node w3-history-stack))) - (last nil) - (temp nil) - (todo w3-history-stack)) - ;; Last node is a little harder to find without using back links - (while (and (not last) todo) - (if (string= (caar todo) url) - (setq last (or temp 'none)) - (setq temp (pop todo)))) - (cons (if (not (symbolp last)) last) - next))) - -(defun w3-history-forward () - "Go forward in the history from this page" - (interactive) - (let ((next (cadr (w3-history-find-url-internal (url-view-url t)))) - (w3-reuse-buffers 'yes)) - (if next - (w3-fetch next)))) - -(defun w3-history-backward () - "Go backward in the history from this page" - (interactive) - (let ((last (caar (w3-history-find-url-internal (url-view-url t)))) - (w3-reuse-buffers 'yes)) - (if last - (w3-fetch last)))) - -(defun w3-history-push (referer url) - "REFERER is the url we followed this link from. URL is the link we got to." - (if (not referer) - (setq w3-history-stack (list (cons url (current-time)))) - (let ((node (memq (assoc referer w3-history-stack) w3-history-stack))) - (if node - (setcdr node (list (cons url (current-time)))) - (setq w3-history-stack (append w3-history-stack - (list - (cons url (current-time))))))))) - -(defalias 'w3-add-urls-to-history 'w3-history-push) -(defalias 'w3-backward-in-history 'w3-history-backward) -(defalias 'w3-forward-in-history 'w3-history-forward) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Miscellaneous functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-describe-entities () - "Show an DTD fragment listing all the entities currently defined." - (interactive) - (switch-to-buffer (get-buffer-create "W3 Entities")) - (let ((buffer-file-name (concat (make-temp-name "entities") ".dtd"))) - (set-auto-mode)) - (erase-buffer) - (let (entity) - (mapatoms - (function - (lambda (x) - (setq entity (get x 'html-entity-expansion)) - (if entity - (insert (format "<!entity %s %s \"%s\">\n" x (car entity) - (cdr entity)))))))) - (goto-char (point-min))) - -(defun w3-executable-exists-in-path (exec &optional path) - (let ((paths (if (consp path) - path - (mm-string-to-tokens (or path - (getenv "PATH") - (concat - "/usr/bin:/bin:/usr/local/bin:" - "/usr/bin/X11:" - (expand-file-name "~/bin"))) ?:))) - (done nil)) - (while (and paths (not done)) - (if (file-exists-p (expand-file-name exec (car paths))) - (setq done t)) - (setq paths (cdr paths))) - done)) - -(defun w3-document-information (&optional buff) - "Display information on the document in buffer BUFF" - (interactive) - (if (interactive-p) - (let ((w3-notify 'friendly)) - (if (get-buffer "Document Information") - (kill-buffer (get-buffer "Document Information"))) - (w3-fetch "about:document")) - (setq buff (or buff (current-buffer))) - (save-excursion - (set-buffer buff) - (let* ((url (url-view-url t)) - (cur-links w3-current-links) - (title (buffer-name)) - (case-fold-search t) - (possible-lastmod (save-excursion - (goto-char (point-min)) - (if (re-search-forward "^Last modified:\\(.*\\)" nil t) - (buffer-substring (match-beginning 1) - (match-end 1))))) - (attributes (url-file-attributes url)) - (lastmod (or (cdr-safe (assoc "last-modified" - url-current-mime-headers)) - (nth 5 attributes))) - (hdrs url-current-mime-headers) - (size (or (cdr (assoc "content-length" url-current-mime-headers)) - (buffer-size))) - (info w3-current-metainfo)) - (set-buffer (get-buffer-create url-working-buffer)) - (setq url-current-can-be-cached nil) - (erase-buffer) - (cond - ((stringp lastmod) nil) - ((equal '(0 . 0) lastmod) (setq lastmod possible-lastmod)) - ((consp lastmod) (setq lastmod (current-time-string lastmod))) - (t (setq lastmod possible-lastmod))) - (setq url-current-mime-type "text/html") - (insert "<html>\n" - " <head>\n" - " <title>Document Information</title>\n" - " </head>\n" - " <body\n" - " <table border>\n" - " <tr><th colspan=2>Document Information</th></tr>\n" - " <tr><td>Title:</td><td>" title "</td></tr>\n" - " <tr><td>Location:</td><td>" url "</td></tr>\n" - " <tr><td>Size:</td><td>" (url-pretty-length - (if (stringp size) - (string-to-int size) - size)) "</td></tr>\n" - " <tr><td>Last Modified:</td><td>" (or lastmod "None Given") - "</td></tr>\n") - (if hdrs - (let* ((maxlength (car (sort (mapcar (function (lambda (x) - (length (car x)))) - hdrs) - '>))) - (fmtstring (format " <tr><td align=right>%%%ds:</td><td>%%s</td></tr>" maxlength))) - (insert " <tr><th colspan=2>MetaInformation</th></tr>\n" - (mapconcat - (function - (lambda (x) - (if (/= (length (car x)) 0) - (format fmtstring - (url-insert-entities-in-string - (capitalize (car x))) - (url-insert-entities-in-string - (if (numberp (cdr x)) - (int-to-string (cdr x)) - (cdr x))))))) - (sort hdrs - (function - (lambda (x y) (string-lessp (car x) (car y))))) - "\n")))) - - ;; FIXME!!! Need to reimplement showing rel/rev links for the new - ;; storage format. - - (if info - (let* ((maxlength (car (sort (mapcar (function (lambda (x) - (length (car x)))) - info) - '>))) - (fmtstring (format " <tr><td>%%%ds:</td><td>%%s</td></tr>" maxlength))) - (insert " <tr><th colspan=2>Miscellaneous Variables</th></tr>\n") - (while info - (if (and (caar info) (cdar info)) - (insert (format fmtstring - (url-insert-entities-in-string - (capitalize (caar info))) - (url-insert-entities-in-string - (cdar info))) "\n")) - (setq info (cdr info)) - ) - ) - ) - (insert " </table>\n" - " </body>\n" - "</html>\n"))))) - -(defun w3-truncate-menu-item (string) - (if (<= (length string) w3-max-menu-width) - string - (concat (substring string 0 w3-max-menu-width) "$"))) - -(defun w3-insert-formatted-url (p) - "Insert a formatted url into a buffer. With prefix arg, insert the url -under point." - (interactive "P") - (let (buff str) - (cond - (p - (setq p (widget-at (point))) - (or p (error "No url under point")) - (setq str (format "<a href=\"%s\">%s</a>" (widget-get p :href) - (read-string "Link text: " - (buffer-substring - (widget-get p :from) - (widget-get p :to)))))) - (t - (setq str (format "<a href=\"%s\">%s</a>" (url-view-url t) - (read-string "Link text: " (buffer-name)))))) - (setq buff (read-buffer "Insert into buffer: " nil t)) - (if buff - (save-excursion - (set-buffer buff) - (insert str)) - (message "Cancelled.")))) - -(defun w3-first-n-items (l n) - "Return the first N items from list L" - (let ((x 0) - y) - (if (> n (length l)) - (setq y l) - (while (< x n) - (setq y (nconc y (list (nth x l))) - x (1+ x)))) - y)) - -(defun w3-widget-button-press () - (interactive) - (if (widget-at (point)) - (widget-button-press (point)))) - -(defun w3-widget-button-click (e) - (interactive "@e") - (cond - ((and (event-point e) - (widget-at (event-point e))) - (widget-button-click e)) - ((and (fboundp 'event-glyph) - (event-glyph e) - (glyph-property (event-glyph e) 'widget)) - (widget-button-click e)))) - -(defun w3-breakup-menu (menu-desc max-len) - (if (> (length menu-desc) max-len) - (cons (cons "More..." (w3-first-n-items menu-desc max-len)) - (w3-breakup-menu (nthcdr max-len menu-desc) max-len)) - menu-desc)) - -;;;###autoload -(defun w3-maybe-follow-link-mouse (e) - "Maybe follow a hypertext link under point. -If there is no link under point, this will try using -url-get-url-at-point" - (interactive "e") - (save-excursion - (mouse-set-point e) - (w3-maybe-follow-link))) - -;;;###autoload -(defun w3-maybe-follow-link () - "Maybe follow a hypertext link under point. -If there is no link under point, this will try using -url-get-url-at-point" - (interactive) - (require 'w3) - (if (not w3-setup-done) (w3-do-setup)) - (let* ((widget (widget-at (point))) - (url1 (and widget (widget-get widget :href))) - (url2 (url-get-url-at-point))) - (cond - (url1 (widget-button-press)) - ((and url2 (string-match url-nonrelative-link url2)) (w3-fetch url2)) - (t (message "No URL could be found!"))))) - -;;;###autoload -(defun w3-follow-url-at-point-other-frame (&optional pt) - "Follow the URL under PT, defaults to link under (point)" - (interactive "d") - (let ((url (url-get-url-at-point pt))) - (and url (w3-fetch-other-frame url)))) - -;;;###autoload -(defun w3-follow-url-at-point (&optional pt) - "Follow the URL under PT, defaults to link under (point)" - (interactive "d") - (let ((url (url-get-url-at-point pt))) - (and url (w3-fetch url)))) - -(defun w3-fix-spaces (x) - "Remove spaces/tabs at the beginning of a string, -and convert newlines into spaces." - (url-convert-newlines-to-spaces - (url-strip-leading-spaces - (url-eat-trailing-space x)))) - -(defun w3-reload-all-files () - "Reload all w3 files" - (interactive) - (setq w3-setup-done nil - url-setup-done nil - w3-hotlist nil - url-mime-accept-string nil) - (let ((x '(w3 base64 css mule-sysdp w3-e19 mm url w3-xemac - w3-e20 dsssl dsssl-flow font images ssl url-auth - url-cache url-cookie url-file url-gopher url-gw - url-http url-mail url-misc url-news url-ns url-parse - url-vars w3-about w3-cus w3-display w3-e20 w3-elisp - w3-emulate w3-forms w3-hot w3-imap w3-jscript - w3-keyword w3-latex w3-menu w3-mouse w3-parse - w3-prefs w3-print w3-props w3-script w3-speak w3-style - w3-sysdp w3-toolbar w3-vars w3-widget w3-xemac w3 - w3-toolbar font))) - (while x - (setq features (delq (car x) features) - x (cdr x))) - (require 'w3)) - (mapatoms (function - (lambda (sym) - (if (or (string-match "^w3-" (symbol-name sym)) - (string-match "^url-" (symbol-name sym)) - (string-match "^ssl-" (symbol-name sym)) - (string-match "^base64-" (symbol-name sym)) - (string-match "^dsssl-" (symbol-name sym)) - (string-match "^mm-" (symbol-name sym))) - (progn - (fmakunbound sym) - (makunbound sym)))))) - (require 'w3)) - -(defun w3-source-document-at-point () - "View source to the document pointed at by link under point" - (interactive) - (w3-source-document t)) - -(defun w3-source-document (under) - "View this document's source" - (interactive "P") - (let* ((url (if under (w3-view-this-url) (url-view-url t))) - (src - (cond - ((null url) - (error "No URL found!")) - ((and under (null url)) (error "No link at point!")) - ((and (not under) (equal url-current-mime-type "text/plain")) - (buffer-string)) - ((and (not under) w3-current-source) w3-current-source) - (t - (prog2 - (url-retrieve url) - (buffer-string) - (kill-buffer (current-buffer)))))) - (tmp (url-generate-new-buffer-name url))) - (if (and url (get-buffer url)) - (cond - ((memq w3-reuse-buffers '(no never reload)) - (kill-buffer url)) - ((memq w3-reuse-buffers '(yes reuse always)) - (w3-notify-when-ready (get-buffer url)) - (setq url nil)) - ((funcall url-confirmation-func - (concat "Source for " url " found, reuse? ")) - (w3-notify-when-ready (get-buffer url))))) - (if (not url) nil - (set-buffer (get-buffer-create tmp)) - (insert src) - (put-text-property (point-min) (point-max) 'w3-base url) - (goto-char (point-min)) - (setq buffer-file-truename url - buffer-file-name url) - ;; Null filename bugs `set-auto-mode' in Mule ... - (condition-case () - (set-auto-mode) - (error nil)) - (setq buffer-file-truename nil - buffer-file-name nil) - (buffer-enable-undo) - (set-buffer-modified-p nil) - (w3-notify-when-ready (get-buffer tmp)))) - (run-hooks 'w3-source-file-hook)) - -(defun w3-mail-document-under-point () - "Mail the document pointed to by the hyperlink under point." - (interactive) - (w3-mail-current-document t)) - -(defun w3-mail-current-document (under &optional format) - "Mail the current-document to someone" - (interactive "P") - (let* ((completion-ignore-case t) - (format (or format - (completing-read - "Format: " - '(("HTML Source") - ("Formatted Text") - ("PostScript") - ("LaTeX Source") - ) - nil t))) - (case-fold-search t) - (url (cond - ((stringp under) under) - (under (w3-view-this-url t)) - (t (url-view-url t)))) - (content-type "text/plain; charset=iso-8859-1") - (str - (save-excursion - (cond - ((and (equal "HTML Source" format) under) - (setq content-type "text/html; charset=iso-8859-1") - (let ((url-source t)) - (url-retrieve url))) - ((equal "HTML Source" format) - (setq content-type "text/html; charset=iso-8859-1") - (if w3-current-source - (let ((x w3-current-source)) - (set-buffer (get-buffer-create url-working-buffer)) - (erase-buffer) - (insert x)) - (url-retrieve url))) - ((and under (equal "PostScript" format)) - (setq content-type "application/postscript") - (w3-fetch url) - (require 'ps-print) - (let ((ps-spool-buffer-name " *w3-temp*")) - (if (get-buffer ps-spool-buffer-name) - (kill-buffer ps-spool-buffer-name)) - (ps-spool-buffer-with-faces) - (set-buffer ps-spool-buffer-name))) - ((equal "PostScript" format) - (require 'ps-print) - (let ((ps-spool-buffer-name " *w3-temp*")) - (if (get-buffer ps-spool-buffer-name) - (kill-buffer ps-spool-buffer-name)) - (setq content-type "application/postscript") - (ps-spool-buffer-with-faces) - (set-buffer ps-spool-buffer-name))) - ((and under (equal "Formatted Text" format)) - (setq content-type "text/plain; charset=iso-8859-1") - (w3-fetch url)) - ((equal "Formatted Text" format) - (setq content-type "text/plain; charset=iso-8859-1")) - ((and under (equal "LaTeX Source" format)) - (let ((old-asynch url-be-asynchronous)) - (setq content-type "application/x-latex; charset=iso-8859-1") - (setq-default url-be-asynchronous nil) - (url-retrieve url) - (setq-default url-be-asynchronous old-asynch) - (w3-parse-tree-to-latex (w3-parse-buffer (current-buffer)) - url))) - ((equal "LaTeX Source" format) - (setq content-type "application/x-latex; charset=iso-8859-1") - (w3-parse-tree-to-latex w3-current-parse url))) - (buffer-string)))) - (funcall url-mail-command) - (mail-subject) - (if (and (boundp 'mime/editor-mode-flag) mime/editor-mode-flag) - (insert format " from <URL: " url ">") - (insert format " from <URL: " url ">\n" - "Mime-Version: 1.0\n" - "Content-transfer-encoding: 8bit\n" - "Content-type: " content-type)) - (re-search-forward mail-header-separator nil) - (forward-char 1) - (if (and (boundp 'mime/editor-mode-flag) mime/editor-mode-flag) - (insert (format mime-tag-format content-type) "\n")) - (save-excursion - (insert str)) - (cond ((equal "HTML Source" format) - (if (or (search-forward "<head>" nil t) - (search-forward "<html>" nil t)) - (insert "\n")) - (insert (format "<base href=\"%s\">" url)))) - (mail-to))) - -(defun w3-internal-use-history (hist-item) - ;; Go to the link in the history - (let ((url (nth 0 hist-item)) - (buf (nth 1 hist-item)) - (pnt (nth 2 hist-item))) - (cond - ((null buf) ; Find a buffer with same url - (let ((x (buffer-list)) - (found nil)) - (while (and x (not found)) - (save-excursion - (set-buffer (car x)) - (setq found (string= (url-view-url t) url)) - (if (not found) (setq x (cdr x))))) - (cond - (found - (switch-to-buffer (car x)) - (if (number-or-marker-p pnt) (goto-char pnt))) - (t - (w3-fetch url))))) - ((buffer-name buf) ; Reuse the old buffer if possible - (switch-to-buffer buf) - (if (number-or-marker-p pnt) (goto-char pnt)) - (if (and url (= ?# (string-to-char url))) ; Destination link - (progn - (goto-char (point-min)) - (w3-find-specific-link (substring url 1 nil))))) - (url (url-maybe-relative url)) ; Get the link - (t (message "Couldn't understand whats in the history."))))) - -(defun w3-relative-link (url) - (if (equal "#" (substring url 0 1)) - (progn - (push-mark (point) t) - (goto-char (point-min)) - (w3-find-specific-link (substring url 1 nil))) - (w3-fetch (url-expand-file-name url)))) - -(defun w3-maybe-eval () - ;; Maybe evaluate a buffer of emacs lisp code - (if (funcall url-confirmation-func "This is emacs-lisp code, evaluate it?") - (eval-buffer (current-buffer)) - (emacs-lisp-mode))) - -(defun w3-build-continuation () - ;; Build a series of functions to be run on this file - (save-excursion - (set-buffer url-working-buffer) - (let ((cont w3-default-continuation) - (extn (url-file-extension - (url-filename url-current-object)))) - (if (assoc extn url-uncompressor-alist) - (setq extn (url-file-extension - (substring (url-filename url-current-object) - 0 (- (length extn)))))) - (if w3-source - (setq url-current-mime-viewer '(("viewer" . w3-source)))) - (if (not url-current-mime-viewer) - (setq url-current-mime-viewer - (mm-mime-info (or url-current-mime-type - (mm-extension-to-mime extn)) nil 5))) - (if url-current-mime-viewer - (setq cont (append cont '(w3-pass-to-viewer))) - (setq cont (append cont (list 'w3-prepare-buffer)))) - cont))) - -(defun w3-use-links () - "Select one of the <LINK> tags from this document and fetch it." - (interactive) - (and (not w3-current-links) - (error "No links defined for this document.")) - (w3-fetch "about:document")) - -(defun w3-find-this-file () - "Do a find-file on the currently viewed html document if it is a file: or -ftp: reference" - (interactive) - (or url-current-object - (error "Not a URL-based buffer")) - (let ((type (url-type url-current-object))) - (cond - ((equal type "file") - (find-file (url-filename url-current-object))) - ((equal type "ftp") - (find-file - (format "/%s@%s:%s" - (url-user url-current-object) - (url-host url-current-object) - (url-filename url-current-object)))) - (t (message "Sorry, I can't get that file so you can alter it."))))) - -(defun w3-insert-this-url (pref-arg) - "Insert the current url in another buffer, with prefix ARG, -insert URL under point" - (interactive "P") - (let ((thebuf (get-buffer (read-buffer "Insert into buffer: "))) - (oldbuf (current-buffer)) - (url (if pref-arg (w3-view-this-url t) (url-view-url t)))) - (if (and url (not (equal "Not on a link!" url))) - (progn - (set-buffer thebuf) - (insert url) - (set-buffer oldbuf)) - (message "Not on a link!")))) - -(defun w3-show-hotlist () - "View the hotlist in hypertext form" - (interactive) - (if (not w3-setup-done) (w3-do-setup)) - (if (not w3-hotlist) - (error "Sorry, no hotlist is in memory.") - (let ((x (url-buffer-visiting "www:/auto/hotlist"))) - (while x - (kill-buffer x) - (setq x (url-buffer-visiting "www:/auto/hotlist")))) - (w3-fetch "www://auto/hotlist"))) - -(defun url-maybe-relative (url) - "Take a url and either fetch it, or resolve relative refs, then fetch it" - (cond - ((not - (string-match url-nonrelative-link url)) - (w3-relative-link url)) - (t (w3-fetch url)))) - -(defun w3-in-assoc (elt list) - "Check to see if ELT matches any of the regexps in the car elements of LIST" - (let (rslt) - (while (and list (not rslt)) - (and (car (car list)) - (stringp (car (car list))) - (not (string= (car (car list)) "")) - (string-match (car (car list)) elt) - (setq rslt (car list))) - (setq list (cdr list))) - rslt)) - -(defun w3-goto-last-buffer () - "Go to last WWW buffer visited" - (interactive) - (if w3-current-last-buffer - (w3-notify-when-ready w3-current-last-buffer) - (message "No previous buffer found."))) - -(fset 'w3-replace-regexp 'url-replace-regexp) - -;;;###autoload -(defun w3-preview-this-buffer () - "See what this buffer will look like when its formatted as HTML. -HTML is the HyperText Markup Language used by the World Wide Web to -specify formatting for text. More information on HTML can be found at -ftp.w3.org:/pub/www/doc." - (interactive) - (w3-fetch (concat "www://preview/" (buffer-name)))) - -(defun w3-source () - "Show the source of a file" - (let ((tmp (buffer-name (generate-new-buffer "Document Source")))) - (set-buffer url-working-buffer) - (kill-buffer tmp) - (rename-buffer tmp) - ;; Make the URL show in list-buffers output - (make-local-variable 'list-buffers-directory) - (setq list-buffers-directory (url-view-url t)) - (set-buffer-modified-p nil) - (buffer-enable-undo) - (w3-notify-when-ready (get-buffer tmp)))) - -(defvar w3-mime-list-for-code-conversion - '("text/plain" "text/html") - "List of MIME types that require Mules' code conversion.") - -(defun w3-convert-code-for-mule (mmtype) - "Convert current data into the appropriate coding system" - (and (or (not mmtype) - (member mmtype w3-mime-list-for-code-conversion)) - (mule-code-convert-region - (point-min) (point-max) - (mule-detect-coding-version (point-min) (point-max))))) - -(defun w3-sentinel (&optional proc string) - (set-buffer url-working-buffer) - (if (or (stringp proc) - (bufferp proc)) (setq w3-current-last-buffer proc)) - (remove-hook 'after-change-functions 'url-after-change-function) - (if url-be-asynchronous - (progn - (cond - ((not (get-buffer url-working-buffer)) nil) - ((url-mime-response-p) (url-parse-mime-headers))) - (if (not url-current-mime-type) - (setq url-current-mime-type (or (mm-extension-to-mime - (url-file-extension - (url-filename - url-current-object))) - "text/html"))))) - (if (not (string-match "^www:" (or (url-view-url t) ""))) - (w3-convert-code-for-mule url-current-mime-type)) - - (let ((x (w3-build-continuation)) - (url (url-view-url t))) - (while x - (funcall (pop x))))) - -(defun w3-show-history-list () - "Format the url-history-list prettily and show it to the user" - (interactive) - (w3-fetch "www://auto/history")) - -(defun w3-save-as (&optional type) - "Save a document to the local disk" - (interactive) - (save-excursion - (let* ((completion-ignore-case t) - (format (or type (completing-read - "Format: " - '(("HTML Source") - ("Formatted Text") - ("LaTeX Source") - ("PostScript") - ("Binary")) - nil t))) - (fname (expand-file-name - (read-file-name "File name: " default-directory))) - (url (url-view-url t))) - (cond - ((equal "Binary" format) - (if (not w3-current-source) - (let ((url-be-asynchronous nil)) - (url-retrieve url)))) - ((equal "HTML Source" format) - (if (not w3-current-source) - (let ((url-be-asynchronous nil)) - (url-retrieve url)) ; Get the document if necessary - (let ((txt w3-current-source)) - (set-buffer (get-buffer-create url-working-buffer)) - (erase-buffer) - (insert txt))) - (goto-char (point-min)) - (if (re-search-forward "<head>" nil t) - (insert "\n")) - (insert (format "<BASE HREF=\"%s\">\n" url))) - ((or (equal "Formatted Text" format) - (equal "" format)) - nil) ; Do nothing - we have the text already - ((equal "PostScript" format) - (require 'ps-print) - (let ((ps-spool-buffer-name " *w3-temp*")) - (if (get-buffer ps-spool-buffer-name) - (kill-buffer ps-spool-buffer-name)) - (ps-spool-buffer-with-faces) - (set-buffer ps-spool-buffer-name))) - ((equal "LaTeX Source" format) - (w3-parse-tree-to-latex w3-current-parse url) - (insert-buffer url-working-buffer))) - (write-region (point-min) (point-max) fname)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Functions to parse out <A> tags and replace it with a hyperlink zone -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-popup-image-info (url) - (interactive) - (let* ((glyph (cdr-safe (assoc url w3-graphics-list))) - image w h d info) - (save-excursion - (if (or (not glyph) (not (glyphp glyph))) - (error "No information available.")) - (setq image (glyph-image-instance glyph)) - (if (or (not image) (not (image-instance-p image))) - (error "No information available.")) - (setq w (glyph-width glyph) - h (glyph-height glyph) - d (image-instance-depth image) - info (url-popup-info url) - ) - (set-buffer (get-buffer-create "*Image Info*")) - (erase-buffer) - (insert - "Information for: " url "\n" - (make-string (1- (window-width)) ?-) - (format "\n%-20s: %s\n" "Type" (image-instance-type image)) - (format "%-20s: %d x %d\n" "Dimensions" w h) - (format "%-20s: %d-bit\n" "Color" d)) - (set-extent-begin-glyph (make-extent (point) (point)) glyph) - (insert - "\n" - (make-string (1- (window-width)) ?-) - (or info "")) - (display-buffer (current-buffer) t)))) - -(defun w3-popup-info (&optional url) - "Show information about the link under point. (All SGML attributes)" - (interactive (list (or (w3-view-this-url t) - (w3-read-url-with-default)))) - (let (dat widget) - (if (interactive-p) - nil - (setq widget (widget-at (point)) - dat (and widget (widget-get widget 'attributes)))) - (if url - (save-excursion - (set-buffer (get-buffer-create "*Header Info*")) - (erase-buffer) - (insert "URL: " url "\n" (make-string (1- (window-width)) ?-) "\n") - (if (and dat (listp dat)) - (insert - "Link attributes:\n" - (make-string (1- (window-width)) ?-) "\n" - (mapconcat - (function - (lambda (info) - (format "%20s :== %s" (car info) (or (cdr info) "On")))) - dat "\n") - "\n" (make-string (1- (window-width)) ?-) "\n")) - (insert (save-excursion (url-popup-info url))) - (goto-char (point-min)) - (display-buffer (current-buffer) t)) - (message "No URL to get information on!")))) - -(fset 'w3-document-information-this-url 'w3-popup-info) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Functions for logging of bad HTML -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-reconstruct-tag (tagname desc) - (concat "<" tagname " " - (mapconcat - (function (lambda (x) - (if (cdr x) - (concat (car x) "=\"" (cdr x) "\"") - (car x)))) desc " ") ">")) - -(defun w3-debug-if-found (regexp type desc) - (and w3-debug-html - (save-excursion - (if (re-search-forward regexp nil t) - (w3-log-bad-html type desc))))) - -(defun w3-log-bad-html (type desc) - ;; Log bad HTML to the buffer specified by w3-debug-buffer - (if w3-debug-html - (save-excursion - (set-buffer (get-buffer-create w3-debug-buffer)) - (goto-char (point-max)) - (insert (make-string (1- (window-width)) w3-horizontal-rule-char) "\n") - (cond - ((stringp type) (insert type "\n" desc "\n")) - ((eq type 'bad-quote) - (insert "Unterminated quoting character in SGML attribute value.\n" - desc "\n")) - ((eq type 'no-quote) - (insert "Unquoted SGML attribute value.\n" desc "\n")) - ((eq type 'no-textarea-end) - (insert "Unterminated <textarea> tag.\n" - (w3-reconstruct-tag "textarea" desc) "\n")) - ((eq type 'bad-link-tag) - (insert "Must specify either REL or REV with a <link> tag.\n" - (w3-reconstruct-tag "link" desc) "\n")) - ((eq type 'no-a-end) - (insert "Unterminated <a> tag.\n" - (w3-reconstruct-tag "a" desc) "\n")) - ((eq type 'no-form-end) - (insert "Unterminated <form> tag.\n" - (w3-reconstruct-tag "form" desc) "\n")) - ((eq type 'bad-base-tag) - (insert "Malformed <base> tag.\n" - (w3-reconstruct-tag "base" desc) "\n")))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Functions to handle formatting an html buffer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-add-delayed-graphic (widget) - ;; Add a delayed image for the current buffer. - (setq w3-delayed-images (cons widget w3-delayed-images))) - - -(defun w3-load-flavors () - ;; Load the correct emacsen specific stuff - (cond - ((and w3-running-xemacs (eq system-type 'ms-windows)) - (error "WinEmacs no longer supported.")) - (w3-running-xemacs (require 'w3-xemac)) - (t ; Assume we are the FSF variant - (require (intern (format "w3-e%d" emacs-major-version))))) - (if (featurep 'emacspeak) - (condition-case () - (progn - (require 'dtk-css-speech) - (require 'w3-speak)))) - (condition-case () - (require 'w3-site-init) - (error nil))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Automatic bug submission. ;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-submit-bug () - "Submit a bug on Emacs-w3" - (interactive) - (require 'reporter) - (and (yes-or-no-p "Do you really want to submit a bug on Emacs-w3? ") - (let ((url (url-view-url t)) - (vars '(window-system - window-system-version - system-type - ange-ftp-version - url-gateway-method - efs-version - ange-ftp-version - url-version - url-be-asynchronous - url))) - (if (and url (string= url "file:nil")) (setq url nil)) - (mapcar - (function - (lambda (x) - (if (not (and (boundp x) (symbol-value x))) - (setq vars (delq x vars))))) vars) - (reporter-submit-bug-report w3-bug-address - (concat "WWW v" w3-version-number " of " - w3-version-date) - vars - nil nil - "Description of Problem:")))) - -(defalias 'w3-bug 'w3-submit-bug) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for searching ;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-nuke-spaces-in-search (x) - "Remove spaces from search strings . . ." - (let ((new "")) - (while (not (equal x "")) - (setq new (concat new (if (= (string-to-char x) 32) "+" - (substring x 0 1))) - x (substring x 1 nil))) - new)) - -(defun w3-search () - "Perform a search, if this is a searchable index." - (interactive) - (let* (querystring ; The string to send to the server - (data - (cond - ((null w3-current-isindex) - (let ((rels (cdr-safe (assq 'rel w3-current-links))) - val cur) - (while rels - (setq cur (car rels) - rels (cdr rels)) - (if (and (or (string-match "^isindex$" (car cur)) - (string-match "^index$" (car cur))) - (plist-get (cadr cur) 'href)) - (setq val (plist-get (cadr cur) 'href) - rels nil)) - ) - (if val - (cons val "Search on (+ separates keywords): ")))) - ((eq w3-current-isindex t) - (cons (url-view-url t) "Search on (+ separates keywords): ")) - ((consp w3-current-isindex) - w3-current-isindex) - (t nil))) - index) - (if (null data) (error "Not a searchable index!")) - (setq index (car data)) - (setq querystring (w3-nuke-spaces-in-search (read-string (cdr data)))) - (if (string-match "\\(.*\\)\\?.*" index) - (setq index (url-match index 1))) - (w3-fetch - (concat index (if (= ?? (string-to-char (substring index -1 nil))) - "" "?") querystring)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Auto documentation, etc ;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-help () - "Print documentation on w3 mode." - (interactive) - (w3-fetch "about:")) - -(defun w3-version (&optional here) - "Show the version number of W3 in the minibuffer. -If optional argument HERE is non-nil, insert info at point." - (interactive "P") - (let ((version-string - (format "WWW %s, URL %s, MM %s" - w3-version-number - url-version - mm-version))) - (if here - (insert version-string) - (if (interactive-p) - (message "%s" version-string) - version-string)))) - -;;;###autoload -(defun w3 () - "Retrieve the default World Wide Web home page. -The World Wide Web is a global hypertext system started by CERN in -Switzerland in 1991. - -The home page is specified by the variable w3-default-homepage. The -document should be specified by its fully specified Uniform Resource -Locator. The document will be parsed as HTML (if appropriate) and -displayed in a new buffer." - (interactive) - (if (not w3-setup-done) (w3-do-setup)) - (if (and w3-track-last-buffer - (bufferp w3-last-buffer) - (buffer-name w3-last-buffer)) - (progn - (switch-to-buffer w3-last-buffer) - (message "Reusing buffer. To reload, type %s." - (substitute-command-keys "\\[w3-reload-document]"))) - (cond - ((null w3-default-homepage) (call-interactively 'w3-fetch)) - ((not (stringp w3-default-homepage)) - (error "Invalid setting for w3-default-homepage: %S" - w3-default-homepage)) - ((not (string-match ".*:.*" w3-default-homepage)) - (w3-fetch (concat "file:" w3-default-homepage))) - (t - (w3-fetch w3-default-homepage))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Leftover stuff that didn't quite fit into url.el -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun w3-generate-error (type data) - ;; Generate an HTML error buffer for error TYPE with data DATA. - (setq url-current-mime-type "text/html") - (cond - ((equal type "nofile") - (let ((error (save-excursion - (set-buffer (get-buffer-create " *url-error*")) - (buffer-string)))) - (if (string= "" error) - (setq error - (format (concat "The file %s could not be found. " - "Either it does not exist, or it " - "is unreadable.") data))) - (insert "<html>\n <head>\n" - " <title>Error</title>\n" - " </head>\n <body>\n" - " <h1>Error accessing " data "</h1>\n" - " <hr>\n <p>" - error - "\n </p>\n"))) - ((equal type "nobuf") - (insert "<title>Error</title>\n" - "<H1>No buffer " data " found</h1>\n" - "<HR>\n" - "The buffer " data " could not be found. It has either\n" - "been killed or renamed.\n")) - ((equal type "nohist") - (insert "<TITLE>Error</TITLE>\n" - "<H1>No history items found.</H1>\n" - "<HR>\n" - "There is no history list available at this time. Either\n" - "you have not visited any nodes, or the variable <i>\n" - "url-keep-history</i> is nil.\n")) - ) - (insert "<hr>\n" - "If you feel this is a bug in Emacs-W3, <a href=\"mailto:" - w3-bug-address "\">send mail to " w3-bug-address - "</a>\n<hr>")) - -(defun w3-generate-auto-html (type) - ;; Generate one of several automatic html pages - (setq url-current-mime-type "text/html" - url-current-mime-headers '(("content-type" . "text/html"))) - (cond - ((equal type "hotlist") - (let ((tmp (reverse w3-hotlist))) - (insert "<html>\n\t<head>\n\t\t" - "<title> Hotlist </title>\n\t</head>\n" - "\t<body>\n\t\t<div>\n\t\t\t<h1>Hotlist from " w3-hotlist-file - "</h1>\n\t\t\t<ol>\n") - (while tmp - (insert "\t\t\t\t<li> <a href=\"" (car (cdr (car tmp))) - "\">" (url-insert-entities-in-string - (car (car tmp))) "</a></li>\n") - (setq tmp (cdr tmp))) - (insert "\n\t\t\t</ol>\n\t\t</div>\n\t</body>\n</html>\n"))) - ((equal type "history") - (if (not url-history-list) - (url-retrieve "www://error/nohist") - (insert "<html>\n\t<head>\n\t\t" - "<title> History List For This Session of W3</title>" - "\n\t</head>\n\t<body>\n\t\t<div>\n\t\t\t<h1>" - "History List For This Session of W3</h1>\n\t\t\t<ol>\n") - (cl-maphash - (function - (lambda (url desc) - (insert (format "\t\t\t\t<li> <a href=\"%s\">%s</a>\n" - url (url-insert-entities-in-string desc))))) - url-history-list) - (insert "\n\t\t\t</ol>\n\t\t</div>\n\t</body>\n</html>\n"))))) - -(defun w3-internal-handle-preview (buffer) - (setq buffer (get-buffer buffer)) - (let ((base (get-text-property (point-min) 'w3-base buffer))) - (if base - (setq base (url-generic-parse-url base))) - (insert-buffer buffer) - (let ((inhibit-read-only t)) - (set-text-properties (point-min) (point-max) nil)) - (cond - (base - (setq url-current-object base)) - ((buffer-file-name buffer) - (setq url-current-object - (url-generic-parse-url (concat "file:" - (buffer-file-name buffer))))) - (t - (setq url-current-object - (url-generic-parse-url "file:/") - url-current-mime-type "text/html"))))) - -(defun w3-internal-url (url) - ;; Handle internal urls (previewed buffers, etc) - (if (not (string-match "www:/+\\([^/]+\\)/\\(.*\\)" url)) - (w3-fetch "www://error/") - (let ((type (url-match url 1)) - (data (url-match url 2))) - (set-buffer (get-buffer-create url-working-buffer)) - (cond - ((equal type "preview") ; Previewing a document - (if (get-buffer data) ; Buffer still exists - (w3-internal-handle-preview data) - (url-retrieve (concat "www://error/nobuf/" data)))) - ((equal type "error") ; Error message - (if (string-match "\\([^/]+\\)/\\(.*\\)" data) - (w3-generate-error (url-match data 1) (url-match data 2)) - (w3-generate-error data ""))) - ((equal type "auto") ; Hotlist or help stuff - (w3-generate-auto-html data)))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Stuff for good local file handling -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-ff (file) - "Find a file in any window already displaying it, otherwise just as -display-buffer, and using this function" - (if (not (eq 'tty (device-type))) - (let ((f (window-frame (display-buffer (find-file-noselect file))))) - (set-mouse-position f 1 0) - (raise-frame f) - (unfocus-frame)) - (display-buffer (find-file-noselect file)))) - -(defun w3-default-local-file() - "Use find-file to open the local file" - (w3-ff (url-filename url-current-object))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Mode definition ;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun w3-search-forward (string) - (interactive "sSearch: ") - (setq w3-last-search-item string) - (if (and (not (search-forward string nil t)) - (funcall url-confirmation-func - "End of document reached; continue from beginning? ")) - (progn - (goto-char (point-min)) - (w3-search-forward string)))) - -(defun w3-search-again () - (interactive) - (if (and w3-last-search-item - (stringp w3-last-search-item)) - (if (and (not (search-forward w3-last-search-item nil t)) - (funcall url-confirmation-func - "End of document reached; continue from beginning? ")) - (progn - (goto-char (point-min)) - (w3-search-again))))) - -(defun w3-find-specific-link (link) - (let ((pos (assq (intern link) w3-id-positions))) - (if pos - (progn - (goto-char (cdr pos)) - (if (and (eolp) (not (eobp))) - (forward-char 1))) - (message "Link #%s not found." link)))) - -(defun w3-force-reload-document () - "Reload the current document. Take it from the network, even if -cached and in local mode." - (let ((url-standalone-mode nil)) - (w3-reload-document))) - -(defun w3-reload-document () - "Reload the current document" - (interactive) - (let ((tmp (url-view-url t)) - (pnt (point)) - (window-start (progn - (move-to-window-line 0) - (point))) - (url-request-extra-headers '(("Pragma" . "no-cache")))) - (kill-buffer (current-buffer)) - (w3-fetch tmp) - (goto-char pnt) - (set-window-start (selected-window) (min window-start (point-max))))) - -(defun w3-leave-buffer () - "Bury this buffer, but don't kill it." - (interactive) - (let ((x w3-current-last-buffer)) - (bury-buffer nil) - (if (and (bufferp x) (buffer-name x)) - (w3-notify-when-ready x)))) - -(defun w3-quit (&optional mega) - "Quit WWW mode" - (interactive "P") - (if mega - (mapcar - (function - (lambda (x) - (save-excursion - (set-buffer (get-buffer x)) - (if (eq major-mode 'w3-mode) - (w3-quit nil))))) - (buffer-list)) - (let ((x w3-current-last-buffer)) - (kill-buffer (current-buffer)) - (if (and (bufferp x) (buffer-name x)) - (w3-notify-when-ready x))))) - -(defun w3-view-this-url (&optional no-show) - "View the URL of the link under point" - (interactive) - (let* ((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))))) - (cond - ((and no-show href) - href) - (href - (message "%s" (url-truncate-url-for-viewing href))) - (no-show - nil) - (widget - (widget-echo-help (point))) - (t - nil)))) - -(defun w3-load-delayed-images () - "Load inlined images that were delayed, if any." - (interactive) - (let ((w3-delay-image-loads nil) - (todo w3-delayed-images)) - (setq w3-delayed-images nil) - (while todo - (w3-maybe-start-image-download (car todo)) - (setq todo (cdr todo))))) - -(defun w3-save-this-url () - "Save url under point in the kill ring" - (interactive) - (w3-save-url t)) - -(defun w3-save-url (under-pt) - "Save current url in the kill ring" - (interactive "P") - (let ((x (cond - ((stringp under-pt) under-pt) - (under-pt (w3-view-this-url t)) - (t (url-view-url t))))) - (if x - (progn - (setq kill-ring (cons x kill-ring)) - (setq kill-ring-yank-pointer kill-ring) - (message "Stored URL in kill-ring.") - (if (fboundp 'w3-store-in-clipboard) - (w3-store-in-clipboard x))) - (error "No URL to store.")))) - -(fset 'w3-end-of-document 'end-of-buffer) -(fset 'w3-start-of-document 'beginning-of-buffer) - -(defun w3-scroll-up (&optional lines) - "Scroll forward in View mode, or exit if end of text is visible. -No arg means whole window full. Arg is number of lines to scroll." - (interactive "P") - (if (and (pos-visible-in-window-p (point-max)) - ;; Allow scrolling backward at the end of the buffer. - (or (null lines) - (> lines 0))) - nil - (let ((view-lines (1- (window-height)))) - (setq lines - (if lines (prefix-numeric-value lines) - view-lines)) - (if (>= lines view-lines) - (scroll-up nil) - (if (>= (- lines) view-lines) - (scroll-down nil) - (scroll-up lines))) - (cond ((pos-visible-in-window-p (point-max)) - (goto-char (point-max)) - (recenter -1))) - (move-to-window-line -1) - (beginning-of-line)))) - -(defun w3-mail-document-author () - "Send mail to the author of this document, if possible." - (interactive) - (let ((x w3-current-links) - (y nil) - (found nil)) - (setq found (cdr-safe (assoc "reply-to" url-current-mime-headers))) - (if (and found (not (string-match url-nonrelative-link found))) - (setq found (list (concat "mailto:" found)))) - (while (and x (not found)) - (setq y (car x) - x (cdr x) - found (cdr-safe (assoc "made" y)))) - (if found - (let ((possible nil) - (href nil)) - (setq x (car found)) ; Fallback if no mail(to|server) found - (while found - (setq href (plist-get (pop found) 'href)) - (if (and href (string-match "^mail[^:]+:" href)) - (setq possible (cons href possible)))) - (case (length possible) - (0 ; No mailto links found - (w3-fetch x)) ; fall back onto first 'made' link - (1 ; Only one found, get it - (w3-fetch (car possible))) - (otherwise - (w3-fetch (completing-read "Choose an address: " - (mapcar 'list possible) - nil t (car possible)))))) - (message "Could not automatically determine authors address, sorry.")))) - -(defun w3-kill-emacs-func () - "Routine called when exiting emacs. Do miscellaneous clean up." - (and (eq url-keep-history t) - url-global-history-hash-table - (url-write-global-history)) - (message "Cleaning up w3 storage...") - (let ((x (nconc - (and (file-exists-p w3-temporary-directory) - (directory-files w3-temporary-directory t "url-tmp.*")) - (and (file-exists-p url-temporary-directory) - (directory-files url-temporary-directory t - (concat "url" - (int-to-string - (user-real-uid)) ".*"))) - (and (file-exists-p url-temporary-directory) - (directory-files url-temporary-directory t "url-tmp.*"))))) - (while x - (condition-case () - (delete-file (car x)) - (error nil)) - (setq x (cdr x)))) - (message "Cleaning up w3 storage... done.")) - -(cond - ((fboundp 'display-warning) - (fset 'w3-warn 'display-warning)) - ((fboundp 'warn) - (defun w3-warn (class message &optional level) - (if (and (eq class 'html) - (not w3-debug-html)) - nil - (warn "(%s/%s) %s" class (or level 'warning) message)))) - (t - (defun w3-warn (class message &optional level) - (if (and (eq class 'html) - (not w3-debug-html)) - nil - (save-excursion - (set-buffer (get-buffer-create "*W3-WARNINGS*")) - (goto-char (point-max)) - (save-excursion - (insert (format "(%s/%s) %s\n" class (or level 'warning) message))) - (display-buffer (current-buffer))))))) - -(defun w3-internal-expander (urlobj defobj) - ;; URL Expansion routine for internally handled routines - (url-identity-expander urlobj defobj)) - -(defun w3-map-links (function &optional buffer from to maparg) - "Map FUNCTION over the hypertext links which overlap region in BUFFER, -starting at FROM and ending at TO. FUNCTION is called with the arguments -WIDGET and MAPARG. -The arguments FROM, TO, MAPARG, and BUFFER default to the beginning of -BUFFER, the end of BUFFER, nil, and (current-buffer), respectively." - (let ((cur (point-min)) - (widget nil) - (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 got a URL tacked on it somewhere - (cond - ((and widget (widget-get widget :href)) - (funcall function widget maparg)) - ((and parent (widget-get parent :href)) - (funcall function parent maparg)) - (t nil))))) - -(defun w3-emit-image-warnings-if-necessary () - (if (and (not w3-delay-image-loads) - (fboundp 'w3-insert-graphic) - (or (not (featurep 'gif)) - (not (featurep 'jpeg))) - (not (w3-executable-exists-in-path "ppmtoxpm")) - (not (or - (w3-executable-exists-in-path "pbmtoxbm") - (w3-executable-exists-in-path "ppmtoxbm")))) - (w3-warn - 'image - (concat - "Could not find some vital ppm utilities in exec-path.\n" - "This probably means that you will be unable to view any\n" - "inlined images other than: " - (mapconcat - (function - (lambda (x) - (if (featurep x) (concat (symbol-name x) ",\n")))) - '(png jpg gif xpm xbm) "") - "\n\n" - "If you do not have the PPM utilities from either the PBMPLUS\n" - "or NETPBM distributions installed on your machine, then\n" - "please set the variable `w3-delay-image-loads' to t with a\n" - "line like:\n\n" - "\t(setq w3-delay-image-loads t)\n\n" - "in your ~/.emacs file.\n\n" - "You can find the NETPBM utilities in:\n" - "\tftp://ftp.cs.indiana.edu/pub/elisp/w3/images/\n" - )))) - -(defun w3-refresh-stylesheets () - "Reload all stylesheets." - (interactive) - (setq w3-user-stylesheet nil - w3-face-cache nil) - (w3-find-default-stylesheets) - ) - -(defvar w3-loaded-stylesheets nil - "A list of all the stylesheets Emacs-W3 loaded at startup.") - -(defun w3-find-default-stylesheets () - (setq w3-loaded-stylesheets nil) - (let* ((lightp (css-color-light-p 'default)) - (longname (if lightp "stylesheet-light" "stylesheet-dark")) - (shortname (if lightp "light.css" "dark.css")) - (no-user-init (= 0 (length user-init-file))) - (w3-configuration-directory (if no-user-init - "/this/is/a/highly/unlikely/directory/name" - w3-configuration-directory)) - (directories (list - data-directory - (concat data-directory "w3/") - (expand-file-name "../../w3" data-directory) - (file-name-directory (locate-library "w3")) - (expand-file-name "../" (file-name-directory - (locate-library "w3"))) - (expand-file-name "../w3" (file-name-directory - (locate-library "w3"))) - (expand-file-name "../etc" (file-name-directory - (locate-library "w3"))) - w3-configuration-directory)) - (total-found 0) - (possible (append - (apply - 'append - (mapcar - (function - (lambda (dir) - (list - (expand-file-name shortname dir) - (expand-file-name longname dir) - (expand-file-name "stylesheet" dir) - (expand-file-name "default.css" dir)))) - directories)) - (and (not no-user-init) - (list w3-default-stylesheet)))) - (remember possible) - (old-asynch (default-value 'url-be-asynchronous)) - (found nil) - (cur nil) - (url nil)) - (setq-default url-be-asynchronous nil) - (while possible - (setq cur (car possible) - possible (cdr possible) - found (and cur (file-exists-p cur) (file-readable-p cur) - (not (file-directory-p cur)) cur)) - (if found - (setq total-found (1+ total-found) - w3-loaded-stylesheets (cons cur w3-loaded-stylesheets) - w3-user-stylesheet (css-parse (concat "file:" cur) nil - w3-user-stylesheet)))) - (setq-default url-be-asynchronous old-asynch) - (if (= 0 total-found) - (w3-warn - 'style - (concat - "No stylesheets found! Check configuration! DANGER DANGER!\n" - "Emacs-W3 checked for its stylesheet in the following places\n" - "and did not find one. This means that some formatting will\n" - "be wrong, and most colors and fonts will not be set up correctly.\n" - "------\n" - (mapconcat 'identity remember "\n") - "------"))))) - -(defvar w3-widget-global-map nil) - -;;;###autoload -(defun w3-do-setup () - "Do setup - this is to avoid conflict with user settings when W3 is -dumped with emacs." - (url-do-setup) - (url-register-protocol 'about 'w3-about 'url-identity-expander) - (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)) - (condition-case e - (load w3-default-configuration-file nil t) - (error - (let ((buf-name " *Configuration Error*")) - (if (get-buffer buf-name) - (kill-buffer (get-buffer buf-name))) - (display-error e (get-buffer-create buf-name)) - (save-excursion - (switch-to-buffer-other-window buf-name) - (shrink-window-if-larger-than-buffer)) - (w3-warn 'configuration - (format (eval-when-compile - (concat - "Configuration file `%s' contains an error.\n" - "Please consult the `%s' buffer for details.")) - w3-default-configuration-file buf-name)))))) - - (if (and (eq w3-user-colors-take-precedence 'guess) - (not (eq (device-type) 'tty)) - (not (eq (device-class) 'mono))) - (progn - (setq w3-user-colors-take-precedence t) - (w3-warn - 'html - "Disabled document color specification because of mono display."))) - - (w3-refresh-stylesheets) - (if (not url-global-history-file) - (setq url-global-history-file - (expand-file-name "history" - w3-configuration-directory))) - - (add-minor-mode 'w3-netscape-emulation-minor-mode " NS" - w3-netscape-emulation-minor-mode-map) - (add-minor-mode 'w3-lynx-emulation-minor-mode " Lynx" - w3-lynx-emulation-minor-mode-map) - - (setq url-package-version w3-version-number - url-package-name "Emacs-W3") - - (w3-setup-terminal-chars) - - (w3-emit-image-warnings-if-necessary) - - (cond - ((memq system-type '(ms-dos ms-windows)) - (setq w3-hotlist-file (or w3-hotlist-file - (expand-file-name "~/mosaic.hot")) - )) - ((memq system-type '(axp-vms vax-vms)) - (setq w3-hotlist-file (or w3-hotlist-file - (expand-file-name "~/mosaic.hotlist-default")) - )) - (t - (setq w3-hotlist-file (or w3-hotlist-file - (expand-file-name "~/.mosaic-hotlist-default")) - ))) - - ; Set up a hook that will save the history list when - ; exiting emacs - (add-hook 'kill-emacs-hook 'w3-kill-emacs-func) - - (mm-parse-mailcaps) - (mm-parse-mimetypes) - - ; Load in the hotlist if they haven't set it already - (or w3-hotlist (w3-parse-hotlist)) - - ; Set the default home page, honoring their defaults, then - ; the standard WWW_HOME, then default to the documentation @ IU - (or w3-default-homepage - (setq w3-default-homepage - (or (getenv "WWW_HOME") - "http://www.cs.indiana.edu/elisp/w3/docs.html"))) - - (run-hooks 'w3-load-hook)) - -(defun w3-mark-link-as-followed (ext dat) - ;; Mark a link as followed - (message "Reimplement w3-mark-link-as-followed")) - -(defun w3-only-links () - (let* (result temp) - (w3-map-links (function - (lambda (x y) - (setq result (cons x result))))) - result)) - -(defun w3-download-callback (fname buff) - (if (and (get-buffer buff) (buffer-name buff)) - (save-excursion - (set-buffer buff) - (let ((require-final-newline nil) - (file-name-handler-alist nil) - (write-file-hooks nil) - (write-contents-hooks nil) - (enable-multibyte-characters t) ; mule 2.4 - (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) - (message "Download of %s complete." (url-view-url t)) - (sit-for 3) - (kill-buffer buff))))) - -(defun w3-download-url-at-point () - "Download the URL under point." - (interactive) - (w3-download-url-wrapper t)) - -(defun w3-download-this-url () - "Download the current URL." - (interactive) - (w3-download-url-wrapper nil)) - -(defun w3-download-url-wrapper (under-pt) - "Download current URL." - (let ((x (if under-pt (w3-view-this-url t) (url-view-url t)))) - (if x - (w3-download-url x) - (error "No link found.")))) - -(defun w3-download-url (url) - (interactive (list (w3-read-url-with-default))) - (let* ((old-asynch url-be-asynchronous) - (url-inhibit-uncompression t) - (url-mime-accept-string "*/*") - (urlobj (url-generic-parse-url url)) - (url-working-buffer - (generate-new-buffer (concat " *" url " download*"))) - (stub-fname (url-basepath (or (url-filename urlobj) "") t)) - (dir (or mm-download-directory "~/")) - (fname (expand-file-name - (read-file-name "Filename to save as: " - dir - stub-fname - nil - stub-fname) dir))) - (setq-default url-be-asynchronous t) - (save-excursion - (set-buffer url-working-buffer) - (setq url-current-callback-data (list fname (current-buffer)) - url-be-asynchronous t - url-current-callback-func 'w3-download-callback) - (url-retrieve url)) - (setq-default url-be-asynchronous old-asynch))) - -;;;###autoload -(defun w3-follow-link-other-frame (&optional p) - "Attempt to follow the hypertext reference under point in a new frame. -With prefix-arg P, ignore viewers and dump the link straight -to disk." - (cond - ((and (fboundp 'make-frame) - (fboundp 'select-frame)) - (let ((frm (make-frame))) - (select-frame frm) - (w3-follow-link p))) - (t (w3-follow-link p)))) - -;;;###autoload -(defun w3-follow-link (&optional p) - "Attempt to follow the hypertext reference under point. -With prefix-arg P, ignore viewers and dump the link straight -to disk." - (interactive "P") - (let* ((widget (widget-at (point))) - (href (and widget (widget-get widget :href)))) - (cond - ((null href) nil) - ((or p w3-dump-to-disk) - (w3-download-url href)) - (t - (w3-fetch href))))) - -(defun w3-widget-forward (arg) - "Move point to the next field or button. -With optional ARG, move across that many fields." - (interactive "p") - (widget-forward arg)) - -(defun w3-widget-backward (arg) - "Move point to the previous field or button. -With optional ARG, move across that many fields." - (interactive "p") - (w3-widget-forward (- arg))) - -(defun w3-complete-link () - "Choose a link from the current buffer and follow it" - (interactive) - (let (links-alist - link-at-point - choice - (completion-ignore-case t)) - (setq link-at-point (widget-at (point)) - link-at-point (and - link-at-point - (widget-get link-at-point :href) - (widget-get link-at-point :from) - (widget-get link-at-point :to) - (w3-fix-spaces - (buffer-substring-no-properties - (widget-get link-at-point :from) - (widget-get link-at-point :to))))) - (w3-map-links (function - (lambda (widget arg) - (if (and (widget-get widget :from) - (widget-get widget :to)) - (setq links-alist (cons - (cons - (w3-fix-spaces - (buffer-substring-no-properties - (widget-get widget :from) - (widget-get widget :to))) - (widget-get widget :href)) - links-alist)))))) - (if (not links-alist) (error "No links in current document.")) - (setq links-alist (sort links-alist (function - (lambda (x y) - (string< (car x) (car y)))))) - ;; Destructively remove duplicate entries from links-alist. - (let ((remaining-links links-alist)) - (while remaining-links - (if (equal (car remaining-links) (car (cdr remaining-links))) - (setcdr remaining-links (cdr (cdr remaining-links))) - (setq remaining-links (cdr remaining-links))))) - (setq choice (completing-read - (if link-at-point - (concat "Link (default " - (if (< (length link-at-point) 20) - link-at-point - (concat - (substring link-at-point 0 17) "...")) - "): ") - "Link: ") links-alist nil t)) - (if (and (string= choice "") link-at-point) - (setq choice link-at-point)) - (let ((match (try-completion choice links-alist))) - (cond - ((eq t match) ; We have an exact match - (setq choice (cdr (assoc choice links-alist)))) - ((stringp match) - (setq choice (cdr (assoc match links-alist)))) - (t (setq choice nil))) - (if choice - (w3-fetch choice))))) - -(defun w3-display-errors () - "Display any HTML errors for the current page." - (interactive) - (let ((w3-notify 'friendly) - (inhibit-read-only t) - (buffer nil) - (todo w3-current-badhtml) - (url (url-view-url t))) - (if (not todo) - (error "No HTML errors on this page! Amazing, isn't it?")) - (save-excursion - (set-buffer - (get-buffer-create (concat "HTML Errors for: " (or url "???")))) - (setq buffer (current-buffer)) - (erase-buffer) - (while todo - (goto-char (point-min)) - (insert "\n" (car todo)) - (setq todo (cdr todo))) - (if url - (progn - (goto-char (point-min)) - (insert (format "HTML Errors for: <URL:%s>\n" url)))) - (set (make-local-variable 'font-lock-keywords) w3-html-errors-font-lock-keywords) - (set (make-local-variable 'font-lock-keywords-only) nil) - (set (make-local-variable 'font-lock-keywords-case-fold-search) nil) - (set (make-local-variable 'font-lock-syntax-table) nil) - (set (make-local-variable 'font-lock-beginning-of-syntax-function) 'beginning-of-line) - (run-hooks 'w3-display-errors-hook)) - (w3-notify-when-ready buffer))) - -(defun w3-mode () - "Mode for viewing HTML documents. If called interactively, will -display the current buffer as HTML. - -Current keymap is: -\\{w3-mode-map}" - (interactive) - (or w3-setup-done (w3-do-setup)) - (if (interactive-p) - (w3-preview-this-buffer) - (let ((tmp (mapcar (function (lambda (x) (cons x (symbol-value x)))) - w3-persistent-variables))) - ;; Oh gross, this kills buffer-local faces in XEmacs - ;;(kill-all-local-variables) - (use-local-map w3-mode-map) - (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 - truncate-lines t - mode-line-format w3-modeline-format) - (run-hooks 'w3-mode-hook) - (widget-setup)))) - -(require 'mm) -(require 'url) -(require 'w3-parse) -(require 'w3-display) -(require 'w3-auto) -(require 'w3-emulate) -(require 'w3-menu) -(require 'w3-mouse) -(provide 'w3) diff -r f0deb0c0e6be -r eb5470882647 lisp/x11/custom-load.el --- a/lisp/x11/custom-load.el Mon Aug 13 10:00:35 2007 +0200 +++ b/lisp/x11/custom-load.el Mon Aug 13 10:01:22 2007 +0200 @@ -1,6 +1,6 @@ ;;; custom-load.el --- automatically extracted custom dependencies -;; Created by SL Baur on Thu Oct 2 17:06:02 1997 +;; Created by SL Baur on Sat Oct 4 18:11:55 1997 ;;; Code: diff -r f0deb0c0e6be -r eb5470882647 man/Makefile --- a/man/Makefile Mon Aug 13 10:00:35 2007 +0200 +++ b/man/Makefile Mon Aug 13 10:01:22 2007 +0200 @@ -46,7 +46,7 @@ hm--html-mode \ hyperbole ilisp info ispell mailcrypt mh-e oo-browser \ pcl-cvs ph psgml psgml-api rmail standards supercite term \ - termcap texinfo vhdl-mode viper vm w3 widget xemacs-faq + termcap texinfo vhdl-mode viper vm widget xemacs-faq info = $(srcs:%=../info/%.info) dvi = $(srcs:%=%.dvi) diff -r f0deb0c0e6be -r eb5470882647 man/w3.texi --- a/man/w3.texi Mon Aug 13 10:00:35 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3604 +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 v3.0.104 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 -* Emacs/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 4.0 -@sp 1 -@center June 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} - -This manual corresponds to Emacs/W3 v3.0.104 - -@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 4.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 -the form will be submitted. - -@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 diff -r f0deb0c0e6be -r eb5470882647 src/ChangeLog --- a/src/ChangeLog Mon Aug 13 10:00:35 2007 +0200 +++ b/src/ChangeLog Mon Aug 13 10:01:22 2007 +0200 @@ -1,13 +1,22 @@ -1997-08-13 Yves BLUSSEAU <hk444@cleveland.freenet.edu> - - * efs/efs.el (efs-set-file-modes): Fix a bug that cause an error - when using the efs-set-file-modes function on a remote station with - a FTP daemon that don't support the QUOTE function. - -1997-10-02 Colin Rafferty <craffert@ml.com> - - * prim/frame.el (default-drag-and-drop-functions): Fixed a typo - that was calling `data' rather than looking at it. +1997-10-03 SL Baur <steve@altair.xemacs.org> + + * lisp.h: Nuke register declarations. + +1997-10-03 Karl M. Hegbloom <karlheg@inetarena.com> + + * window.c (Frecenter): Correct variable names in docstring. + +1997-10-03 Karl M. Hegbloom <karlheg@inetarena.com> + + * fns.c: Add some cross references between destructive and + non-destructive versions of similar functions. + +Fri Oct 3 12:28:08 1997 Kyle Jones <kyle_jones@wonderworks.com> + + * lisp-disunion.h: Move markbit to be between the + type bits and the value bits. Previously it was always + the sign bit of a EMACS_INT, unless modified by a + #define in a machine dependent .h file. 1997-10-02 Hrvoje Niksic <hniksic@srce.hr> diff -r f0deb0c0e6be -r eb5470882647 src/fns.c --- a/src/fns.c Mon Aug 13 10:00:35 2007 +0200 +++ b/src/fns.c Mon Aug 13 10:01:22 2007 +0200 @@ -460,6 +460,7 @@ The result is a list whose elements are the elements of all the arguments. Each argument may be a list, vector, bit vector, or string. The last argument is not copied, just used as the tail of the new list. +Also see: `nconc'. */ (int nargs, Lisp_Object *args)) { @@ -1351,6 +1352,7 @@ If the first member of LIST is ELT, there is no way to remove it by side effect; therefore, write `(setq foo (delete element foo))' to be sure of changing the value of `foo'. +Also see: `remove'. */ (elt, list)) { @@ -1721,6 +1723,7 @@ DEFUN ("nreverse", Fnreverse, 1, 1, 0, /* Reverse LIST by modifying cdr pointers. Returns the beginning of the reversed list. +Also see: `reverse'. */ (list)) { @@ -3097,6 +3100,7 @@ DEFUN ("nconc", Fnconc, 0, MANY, 0, /* Concatenate any number of lists by altering them. Only the last argument is not altered, and need not be a list. +Also see: `append'. */ (int nargs, Lisp_Object *args)) { diff -r f0deb0c0e6be -r eb5470882647 src/lisp-disunion.h --- a/src/lisp-disunion.h Mon Aug 13 10:00:35 2007 +0200 +++ b/src/lisp-disunion.h Mon Aug 13 10:01:22 2007 +0200 @@ -41,7 +41,7 @@ is a "large" one, one which was separately malloc'd rather than being part of a string block. */ -#define MARKBIT (1UL << ((VALBITS) + (GCTYPEBITS))) +#define MARKBIT (1UL << (VALBITS)) /* These macros extract various sorts of values from a Lisp_Object. @@ -51,7 +51,7 @@ /* One needs to override this if there must be high bits set in data space (doing the result of the below & ((1 << (GCTYPE + 1)) - 1) would work on all machines, but would penalize machines which don't need it) */ -#define XTYPE(a) ((enum Lisp_Type) ((a) >> VALBITS)) +#define XTYPE(a) ((enum Lisp_Type) (((EMACS_UINT)(a)) >> ((VALBITS) + 1))) #define EQ(x,y) ((x) == (y)) #define GC_EQ(x,y) (XGCTYPE (x) == XGCTYPE (y) && XPNTR (x) == XPNTR (y)) @@ -94,7 +94,7 @@ individual settor macros (XSETCONS, XSETBUFFER, etc.) instead. */ #define XSETOBJ(var, type_tag, value) \ - ((void) ((var) = (((EMACS_INT) (type_tag) << VALBITS) \ + ((void) ((var) = (((EMACS_INT) (type_tag) << ((VALBITS) + 1)) \ + ((EMACS_INT) (value) & VALMASK)))) /* During garbage collection, XGCTYPE must be used for extracting types @@ -104,15 +104,10 @@ Outside of garbage collection, all mark bits are always zero. */ #ifndef XGCTYPE -# define XGCTYPE(a) ((enum Lisp_Type) (((a) >> VALBITS) & GCTYPEMASK)) +# define XGCTYPE(a) XTYPE(a) #endif -#if ((VALBITS) + (GCTYPEBITS)) == ((LONGBITS) - 1L) -/* Make XMARKBIT faster if mark bit is sign bit. */ -# define XMARKBIT(a) ((a) < 0L) -#else # define XMARKBIT(a) ((a) & (MARKBIT)) -#endif /* markbit is sign bit */ # define XMARK(a) ((void) ((a) |= (MARKBIT))) # define XUNMARK(a) ((void) ((a) &= (~(MARKBIT)))) diff -r f0deb0c0e6be -r eb5470882647 src/lisp.h --- a/src/lisp.h Mon Aug 13 10:00:35 2007 +0200 +++ b/src/lisp.h Mon Aug 13 10:01:22 2007 +0200 @@ -309,11 +309,12 @@ # endif #endif -#ifdef DEBUG_XEMACS +/*#ifdef DEBUG_XEMACS*/ #define REGISTER -#else -#define REGISTER register -#endif +#define register +/*#else*/ +/*#define REGISTER register*/ +/*#endif*/ #if defined (__GNUC__) && (__GNUC__ >= 2) /* Entomological studies have revealed that the following junk is diff -r f0deb0c0e6be -r eb5470882647 src/scrollbar-x.c --- a/src/scrollbar-x.c Mon Aug 13 10:00:35 2007 +0200 +++ b/src/scrollbar-x.c Mon Aug 13 10:01:22 2007 +0200 @@ -287,6 +287,11 @@ } else if (managed) { +#if defined (LWLIB_SCROLLBARS_MOTIF) || defined (LWLIB_SCROLLBARS_LUCID) + /* This isn't needed with Athena Scrollbars. It might not be needed */ + /* with Motif scrollbars (it is apparently needed with Lesstif). */ + XtUngrabKeyboard (SCROLLBAR_X_WIDGET (instance), CurrentTime); +#endif XtUnmanageChild (SCROLLBAR_X_WIDGET (instance)); } } diff -r f0deb0c0e6be -r eb5470882647 src/window.c --- a/src/window.c Mon Aug 13 10:00:35 2007 +0200 +++ b/src/window.c Mon Aug 13 10:01:22 2007 +0200 @@ -4129,10 +4129,10 @@ } DEFUN ("recenter", Frecenter, 0, 2, "_P", /* -Center point in WINDOW and redisplay frame. With ARG, put point on line ARG. +Center point in WINDOW and redisplay frame. With N, put point on line N. The desired position of point is always relative to the window. Just C-u as prefix means put point in the center of the window. -No arg (i.e., it is nil) erases the entire frame and then +No N (i.e., it is nil) erases the entire frame and then redraws with point in the center of the window. If WINDOW is nil, the selected window is used. */ diff -r f0deb0c0e6be -r eb5470882647 version.sh --- a/version.sh Mon Aug 13 10:00:35 2007 +0200 +++ b/version.sh Mon Aug 13 10:01:22 2007 +0200 @@ -1,5 +1,5 @@ #!/bin/sh emacs_major_version=20 emacs_minor_version=3 -emacs_beta_version=26 -xemacs_codename="Riga" +emacs_beta_version=27 +xemacs_codename="Skopje"